Ter.pm
PHPをテンプレートとして用いたのと同じような動きをします。<% 〜 %>内はPerlのコードして解釈<%= 〜 %>はechoでし
ただし、<% for(...) { %>〜〜<% } %>ってのは醜いと思うので<% for(...) %>〜〜<% end %>としてます。
package Ter; =head1 NAME Ter - small template engine =head1 SYNOPSIS use Ter; print Ter->load( filename => 'hoge.t' )->compile( qw/var1/ )->execute( var1 => val, ... ); my $obj = Ter->new(); $obj->source("template text..."); print $obj->compile( qw/var1/ )->execute( var1 => val, ... ); =cut use strict; use warnings; use Carp; sub new{ my $class = shift; my $self = bless({ __PACKAGE__ . '_source' => undef, __PACKAGE__ . '_perlcode' => undef }, $class); return $self; } sub load{ my $class = shift; my $self = $class->new(); my %args = @_; croak "args: filename" unless defined $args{filename}; open( my $in, '<', $args{filename} ) or croak $!; { my $t = join('', <$in>); $self->source($t); } close($in); return $self; } sub save{ my $self = shift; my %args = @_; croak "args: filename" unless defined $args{filename}; open( my $out, '>', $args{filename} ) or croak $!; print $out $self->perlcode; close($out); return $self; } sub execute{ my $self = shift; my $code = $self->perlcode; croak "execute after compile" unless $code; my $s = eval( $code ); croak $@ if( $@ ); return $s->(@_); } sub compile{ my $self = shift; my @vars = @_; my $body = $self->source; my $dec_vars; $dec_vars .= ' my $' . $_ . ' = $param{' . $_ . "};\n" foreach (@vars);; my $head = <<END; return sub { my \$buffer; my \%param = \@_; $dec_vars; \$buffer .= <<'___TEMPLATE___'; END my $foot = <<'END'; ___TEMPLATE___ return $buffer; } END my $begin = q{$buffer .= <<'___TEMPLATE___';} . "\n"; my $end = "\n___TEMPLATE___\n" . q{ chomp $buffer;} . "\n"; $body =~ s{ <%(=?) \s* (.+?) \s* \%> (\r?\n?) }{$end . _parse($1, $2, $3) . $begin}emgx; $self->perlcode( $head . $body . $foot ); return $self; } sub _parse{ my $print = shift; my $content = shift; my $rn = shift; $print = 0 unless defined $print; $rn = 1 unless defined $rn; if( $print ){ $content .= ' . "\n"' if $rn; return <<END \$buffer .= $content; END } if( $content =~ /^(foreach|for|while|if|unless)\s*\((.+)\)$/ ){ return <<END $1($2){ END } elsif( $content =~ /^(foreach|for)\s*(.+)\s*\((.+)\)$/ ){ return <<END $1 $2 ($3){ END } elsif( $content =~ /^elsif\((.+)\)$/ ){ return <<END } elsif($1){ END } elsif( $content =~ /^else$/ ){ return <<END } else{ END } elsif( $content eq 'end' ){ return <<END } END } else { return <<END $content; END } } ###accessors sub source{ my $self = shift; $self->{__PACKAGE__ . "_source"} = shift if @_; return $self->{__PACKAGE__ . "_source"}; } sub perlcode{ my $self = shift; $self->{__PACKAGE__ . "_perlcode"} = shift if @_; return $self->{__PACKAGE__ . "_perlcode"}; } return 1;