view release on metacpan or  search on metacpan

ARS/CodeTemplate.pm  view on Meta::CPAN

package ARS::CodeTemplate;
use Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( include modByRegex );


*opt = *main::opt;
#our $LINE_INDENT = ''; 


sub compile {
	my( $input ) = @_;

	my @input = split( /\n/, $input );
	my( $pFlag, $pCode, $output ) = ( 0, '', '' );
	my $line;

	foreach $line ( @input ){
		if( $line =~ /^@@\s+(\S+)\s+(.*)$/ ){
			my( $openMode, $outFile ) = ( $1, $2 );
			if( $outFile =~ /^<@(.*)@>\s*$/ ){
				eval( 'package '.caller()."; \$outFile = $1; package ARS::CodeTemplate;" );
#				print "OUTFILE: $outFile\n";
			}
#			print "OM($openMode) FILE($outFile)\n";
			die "Syntax error in \"$line\"\n" unless $openMode =~ /^[>|]+$/;
			if( defined $opt{debug} ){
				print "#------------------------------------------------------------\n";
				print "# OUTPUT:  $line\n";
				print $pCode;
				print "#------------------------------------------------------------\n\n";
			}else{
				eval( 'package '.caller()."; $pCode; package ARWT::Template;" );
				if( $@ ){
					warn $@, "\n";
					exit 1;
				}
				open( OUTPUT, "$openMode $outFile" ) or die "Open Error($openMode $outFile): $!\n";
				print OUTPUT $output;
				close OUTPUT;
			}
			( $pFlag, $pCode, $output ) = ( 0, '', '' );
		}elsif( $line =~ s/^@>+// ){
			$pCode .= "$line\n";
		}else{
			$pCode .= '$output .= $LINE_INDENT;';
			$pCode .= '$output .= ';
			$pCode .= "'' . \"\\n\";\n" if $line eq '';
			while( $line ){
				if( $pFlag ){
					if( $line =~ s/^(.*?)@>// ){
						$pFlag = 0;
						$pCode .= "$1 ). ";
						$pCode .= "\"\\n\";\n" unless $line;
					}else{
						$pCode .= $line . "\\n";
						$line = '';
					}
				}else{
					if( $line =~ s/^(.*?)<@// ){
						$pFlag = 1;
						my $str = $1;
						$str =~ s/\\/\\\\/g;
						$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;
		}
	}