view release on metacpan or  search on metacpan

ARS/CodeTemplate.pm  view on Meta::CPAN

						$str =~ s/'/\\'/g;
						$pCode .= "'$str' .( ";
					}else{
						$line =~ s/\\/\\\\/g;
						$line =~ s/'/\\'/g;
						$pCode .= "'$line' . \"\\n\";\n";
						$line = '';
					}
				}
			}
		}
	}

	if( defined $opt{debug} ){
		print $pCode;
		exit;
	}else{
		eval( 'package '.caller()."; $pCode; package ARWT::Template;" );
		if( $@ ){
			warn $@, "\n";
			exit 1;
		}
	}
	return $output;
}


use Getopt::Long;



sub init_template {
	%opt = ();
	Getopt::Long::Configure( 'no_ignore_case' );
	Getopt::Long::GetOptions( \%opt, 'o=s', 'x!', 'debug!', @_ );
}

sub procdef {
	my( $text ) = @_;
	my $outfile;
	if( defined $opt{'o'} ){
		$outfile = $opt{'o'};
	}else{
		$outfile = '-';
	}
	open( OUTFILE, ">$outfile" ) or die "$outfile: $!\n";
	print OUTFILE get_header( $outfile, $0 ) if $opt{'o'};
	print OUTFILE $text;
	close OUTFILE;
}

sub include {
	my( $file ) = @_;

	local $/ = undef;
	local *FILE;
	open( FILE, $file ) or do {
		warn "Cannot open \"$file\": $!\n";
		return undef;
	};
	my $data = <FILE>;
	close FILE;
	return $data;
}

sub modByRegex {
	package main;
	my( $val, @regex ) = @_;
	foreach my $regex ( @regex ){
		eval "\$val =~ $regex";
		warn $@, "\n" if $@;
	}
	return $val;
}


sub get_header {
	my( $of, $tpt ) = @_;

my $HEADER = << "+";
/*******************************************************************************
**                                                                            **
**               Automatically genenerated <OUTFILE> file.
**                      D O   N O T   E D I T  ! ! ! !                        **
**               Edit <TEMPLATE> instead.
**                                                                            **
*******************************************************************************/
+

	my @HEADER = split( /\n/, $HEADER );
	$HEADER = '';
	$of  =~ s|.*[\\/]||;
	$tpt =~ s|.*[\\/]||;
	foreach $line ( @HEADER ){
		if( $line =~ s/<OUTFILE>/$of/ || $line =~ s/<TEMPLATE>/$tpt/ ){
			$line .= ' ' x (78 - length($line)) . '*/';
		}
		$HEADER .= "$line\n";
	}
	return $HEADER;
}


1;