1package Tenjin::Template; 2 3use strict; 4use warnings; 5use Fcntl qw/:flock/; 6use Carp; 7 8our $VERSION = "0.070001"; 9$VERSION = eval $VERSION; 10 11=head1 NAME 12 13Tenjin::Template - A Tenjin template object, either built from a file or from memory. 14 15=head1 VERSION 16 17version 0.070001 18 19=head1 SYNOPSIS 20 21 # mostly used internally, but you can manipulate 22 # templates like so 23 24 my $template = Tenjin::Template->new('/path/to/templates/template.html'); 25 my $context = { scalar => 'scalar', arrayref => ['one', 2, "3"] }; 26 $template->render($context); 27 28=head1 DESCRIPTION 29 30This module is in charge of the task of compiling Tenjin templates. 31Templates in Tenjin are compiled into standard Perl code (combined with 32any Perl code used inside the templates themselves). Rendering a template 33means C<eval>uating that Perl code and returning its output. 34 35The Tenjin engine reads a template file or a template string, and creates 36a Template object from it. Then the object compiles itself by traversing 37the template, parsing Tenjin macros like 'include' and 'start_capture', 38replaces Tenjin expressions (i.e. C<[== $expr =]> or C<[= $expr =]>) with the 39appropriate Perl code, etc. This module ties a template object with 40a context object, but all context manipulation (and the actual C<eval>uation 41of the Perl code) is done by L<Tenjin::Context>. 42 43If you're planning on using this module by itself (i.e. without the L<Tenjin> 44engine), keep in mind that template caching and layout templates are not 45handled by this module. 46 47=cut 48 49our $MACRO_HANDLER_TABLE = { 50 'include' => sub { my $arg = shift; 51 " \$_buf .= \$_context->{'_engine'}->render($arg, \$_context, 0);"; 52 }, 53 'start_capture' => sub { my $arg = shift; 54 " my \$_buf_bkup=\$_buf; \$_buf=''; my \$_capture_varname=$arg;"; 55 }, 56 'stop_capture' => sub { my $arg = shift; 57 " \$_context->{\$_capture_varname}=\$_buf; \$_buf=\$_buf_bkup;"; 58 }, 59 'start_placeholder' => sub { my $arg = shift; 60 " if (\$_context->{$arg}) { \$_buf .= \$_context->{$arg}; } else {"; 61 }, 62 'stop_placeholder' => sub { my $arg = shift; 63 " }"; 64 }, 65 'echo' => sub { my $arg = shift; 66 " \$_buf .= $arg;"; 67 }, 68}; 69 70=head1 METHODS 71 72=head2 new( [$filename, \%opts] ) 73 74Creates a new Tenjin::Template object, possibly from a file on the file 75system (in which case C<$filename> must be provided and be an absolute 76path to a template file). Optionally, a hash-ref of options can be 77passed to set some customizations. Available options are 'escapefunc', 78which will be in charge of escaping expressions (from C<[= $expr =]>) instead 79of the internal method (which uses L<HTML::Entities>); and 'rawclass', 80which can be used to prevent variables and objects of a certain class 81from being escaped, in which case the variable must be a hash-ref 82that has a key named 'str', which will be used instead. So, for example, 83if you have a variable named C<$var> which is a hash-ref, and 'rawclass' 84is set as 'HASH', then writing C<[= $var =]> on your templates will replace 85C<$var> with C<< $var->{str} >>. 86 87=cut 88 89sub new { 90 my ($class, $filename, $template_name, $opts) = @_; 91 92 my $escapefunc = defined($opts) && exists($opts->{escapefunc}) ? $opts->{escapefunc} : undef; 93 my $rawclass = defined($opts) && exists($opts->{rawclass}) ? $opts->{rawclass} : undef; 94 95 my $self = bless { 96 'filename' => $filename, 97 'name' => $template_name, 98 'script' => undef, 99 'escapefunc' => $escapefunc, 100 'rawclass' => $rawclass, 101 'timestamp' => undef, 102 'args' => undef, 103 }, $class; 104 105 $self->convert_file($filename) if $filename; 106 107 return $self; 108} 109 110=head2 render( [$_context] ) 111 112Renders the template, possibly with a context hash-ref, and returns the 113rendered output. If errors have occured when rendering the template (which 114might happen since templates have and are Perl code), then this method 115will croak. 116 117=cut 118 119sub render { 120 my ($self, $_context) = @_; 121 122 $_context ||= {}; 123 124 if ($self->{func}) { 125 return $self->{func}->($_context); 126 } else { 127 $_context = $Tenjin::CONTEXT_CLASS->new($_context) if ref $_context eq 'HASH'; 128 129 my $script = $self->{script}; 130 $script = $_context->_build_decl() . $script unless $self->{args}; 131 132 # rendering is actually done inside the context object 133 # with the evaluate method. We pass either the name of 134 # the template or the filename of the template for debug 135 # purposes 136 137 return $_context->evaluate($script, $self->{filename} || $self->{name}); 138 } 139} 140 141=head1 INTERNAL METHODS 142 143=head2 convert_file( $filename ) 144 145Receives an absolute path to a template file, converts that file 146to Perl code by calling L<convert()|convert( $input, $filename )> and 147returns that code. 148 149=cut 150 151sub convert_file { 152 my ($self, $filename) = @_; 153 154 return $self->convert($self->_read_file($filename, 1), $filename); 155} 156 157=head2 convert( $input, [$filename] ) 158 159Receives a text of a template (i.e. the template itself) and possibly 160an absolute path to the template file (if the template comes from a file), 161and converts the template into Perl code, which is later C<eval>uated 162for rendering. Conversion is done by parsing the statements in the 163template (see L<parse_stmt()|parse_stmt( $bufref, $input )>). 164 165=cut 166 167sub convert { 168 my ($self, $input, $filename) = @_; 169 170 $self->{filename} = $filename; 171 my @buf = ('my $_buf = ""; my $_V; ', ); 172 $self->parse_stmt(\@buf, $input); 173 174 return $self->{script} = $buf[0] . " \$_buf;\n"; 175} 176 177=head2 compile_stmt_pattern( $pl ) 178 179Receives a string which denotes the Perl code delimiter which is used 180inside templates. Tenjin uses 'C<< <?pl ... ?> >>' and 'C<< <?PL ... ?> >>' 181(the latter for preprocessing), so C<$pl> will be 'pl'. This method 182returns a tranlsation regular expression which will be used for reading 183embedded Perl code. 184 185=cut 186 187sub compile_stmt_pattern { 188 my $pl = shift; 189 190 my $pat = '((^[ \t]*)?<\?'.$pl.'( |\t|\r?\n)(.*?) ?\?>([ \t]*\r?\n)?)'; 191 return qr/$pat/sm; 192} 193 194=head2 stmt_pattern 195 196Returns the default pattern (which uses 'pl') with the 197L<previous_method|compile_stmt_pattern( $pl )>. 198 199=cut 200 201sub stmt_pattern { 202 return compile_stmt_pattern('pl'); 203} 204 205=head2 expr_pattern() 206 207Defines how expressions are written in Tenjin templates (C<[== $expr =]> 208and C<[= $expr =]>). 209 210=cut 211 212sub expr_pattern { 213 return qr/\[=(=?)(.*?)(=?)=\]/s; 214} 215 216=head2 parse_stmt( $bufref, $input ) 217 218Receives a buffer which is used for saving a template's expressions 219and the template's text, parses all expressions in the templates and 220pushes them to the buffer. 221 222=cut 223 224sub parse_stmt { 225 my ($self, $bufref, $input) = @_; 226 227 my $pos = 0; 228 my $pat = $self->stmt_pattern(); 229 while ($input =~ /$pat/g) { 230 my ($pi, $lspace, $mspace, $stmt, $rspace) = ($1, $2, $3, $4, $5); 231 my $start = $-[0]; 232 my $text = substr($input, $pos, $start - $pos); 233 $pos = $start + length($pi); 234 $self->parse_expr($bufref, $text) if $text; 235 $mspace = '' if $mspace eq ' '; 236 $stmt = $self->hook_stmt($stmt); 237 $stmt .= $rspace if $rspace; 238 $stmt = $mspace . $stmt if $mspace; 239 $stmt = $lspace . $stmt if $lspace; 240 $self->add_stmt($bufref, $stmt); 241 } 242 my $rest = $pos == 0 ? $input : substr($input, $pos); 243 $self->parse_expr($bufref, $rest) if $rest; 244} 245 246=head2 hook_stmt( $stmt ) 247 248=cut 249 250sub hook_stmt { 251 my ($self, $stmt) = @_; 252 253 ## macro expantion 254 if ($stmt =~ /\A(\s*)(\w+)\((.*?)\);?(\s*)\Z/) { 255 my ($lspace, $funcname, $arg, $rspace) = ($1, $2, $3, $4); 256 my $s = $self->expand_macro($funcname, $arg); 257 return $lspace . $s . $rspace if defined($s); 258 } 259 260 ## template arguments 261 unless ($self->{args}) { 262 if ($stmt =~ m/\A(\s*)\#\@ARGS\s+(.*)(\s*)\Z/) { 263 my ($lspace, $argstr, $rspace) = ($1, $2, $3); 264 my @args = (); 265 my @declares = (); 266 foreach my $arg (split(/,/, $argstr)) { 267 $arg =~ s/(^\s+|\s+$)//g; 268 next unless $arg; 269 $arg =~ m/\A([\$\@\%])?([a-zA-Z_]\w*)\Z/ or croak "[Tenjin] $arg: invalid template argument."; 270 croak "[Tenjin] $arg: only '\$var' is available for template argument." unless (!$1 || $1 eq '$'); 271 my $name = $2; 272 push(@args, $name); 273 push(@declares, "my \$$name = \$_context->{$name}; "); 274 } 275 $self->{args} = \@args; 276 return $lspace . join('', @declares) . $rspace; 277 } 278 } 279 280 return $stmt; 281} 282 283=head2 expand_macro( $funcname, $arg ) 284 285This method is in charge of invoking macro functions which might be used 286inside templates. The following macros are available: 287 288=over 289 290=item * C<include( $filename )> 291 292Includes another template, whose name is C<$filename>, inside the current 293template. The included template will be placed inside the template as if 294they were one unit, so the context variable applies to both. 295 296=item * C<start_capture( $name )> and C<end_capture()> 297 298Tells Tenjin to capture the output of the rendered template from the point 299where C<start_capture()> was called to the point where C<end_capture()> 300was called. You must provide a name for the captured portion, which will be 301made available in the context as C<< $_context->{$name} >> for immediate 302usage. Note that the captured portion will not be printed unless you do 303so explicilty with C<< $_context->{$name} >>. 304 305=item * C<start_placeholder( $var )> and C<end_placeholder()> 306 307This is a special method which can be used for making your templates a bit 308cleaner. Suppose your context might have a variable whose name is defined 309in C<$var>. If that variable exists in the context, you simply want to print 310it, but if it's not, you want to print and/or perform other things. In that 311case you can call C<start_placeholder( $var )> with the name of the context 312variable you want printed, and if it's not, anything you do between 313C<start_placeholder()> and C<end_placeholder()> will be printed instead. 314 315=item * echo( $exr ) 316 317Just prints the provided expression. You might want to use it if you're 318a little too comfortable with PHP. 319 320=back 321 322=cut 323 324sub expand_macro { 325 my ($self, $funcname, $arg) = @_; 326 327 my $handler = $MACRO_HANDLER_TABLE->{$funcname}; 328 return $handler ? $handler->($arg) : undef; 329} 330 331=head2 get_expr_and_escapeflag( $not_escape, $expr, $delete_newline ) 332 333=cut 334 335## ex. get_expr_and_escapeflag('=', '$item->{name}', '') => 1, '$item->{name}', 0 336sub get_expr_and_escapeflag { 337 my ($self, $not_escape, $expr, $delete_newline) = @_; 338 339 return $expr, $not_escape eq '', $delete_newline eq '='; 340} 341 342=head2 parse_expr( $bufref, $input ) 343 344=cut 345 346sub parse_expr { 347 my ($self, $bufref, $input) = @_; 348 349 my $pos = 0; 350 $self->start_text_part($bufref); 351 my $pat = $self->expr_pattern(); 352 while ($input =~ /$pat/g) { 353 my $start = $-[0]; 354 my $text = substr($input, $pos, $start - $pos); 355 my ($expr, $flag_escape, $delete_newline) = $self->get_expr_and_escapeflag($1, $2, $3); 356 $pos = $start + length($&); 357 $self->add_text($bufref, $text) if $text; 358 $self->add_expr($bufref, $expr, $flag_escape) if $expr; 359 if ($delete_newline) { 360 my $end = $+[0]; 361 if (substr($input, $end + 1, 1) eq "\n") { 362 $bufref->[0] .= "\n"; 363 $pos++; 364 } 365 } 366 } 367 my $rest = $pos == 0 ? $input : substr($input, $pos); 368 $self->add_text($bufref, $rest); 369 $self->stop_text_part($bufref); 370} 371 372=head2 start_text_part( $bufref ) 373 374=cut 375 376sub start_text_part { 377 my ($self, $bufref) = @_; 378 379 $bufref->[0] .= ' $_buf .= '; 380} 381 382=head2 stop_text_part( $bufref ) 383 384=cut 385 386sub stop_text_part { 387 my ($self, $bufref) = @_; 388 389 $bufref->[0] .= '; '; 390} 391 392=head2 add_text( $bufref, $text ) 393 394=cut 395 396sub add_text { 397 my ($self, $bufref, $text) = @_; 398 399 return unless $text; 400 $text =~ s/[`\\]/\\$&/g; 401 my $is_start = $bufref->[0] =~ / \$_buf \.= \Z/; 402 $bufref->[0] .= $is_start ? "q`$text`" : " . q`$text`"; 403} 404 405=head2 add_stmt( $bufref, $stmt ) 406 407=cut 408 409sub add_stmt { 410 my ($self, $bufref, $stmt) = @_; 411 412 $bufref->[0] .= $stmt; 413} 414 415=head2 add_expr( $bufref, $expr, $flag_escape ) 416 417=cut 418 419sub add_expr { 420 my ($self, $bufref, $expr, $flag_escape) = @_; 421 422 my $dot = $bufref->[0] =~ / \$_buf \.= \Z/ ? '' : ' . '; 423 $bufref->[0] .= $dot . ($flag_escape ? $self->escaped_expr($expr) : "($expr)"); 424} 425 426=head2 defun( $funcname, @args ) 427 428=cut 429 430sub defun { ## (experimental) 431 my ($self, $funcname, @args) = @_; 432 433 unless ($funcname) { 434 my $funcname = $self->{filename}; 435 if ($funcname) { 436 $funcname =~ s/\.\w+$//; 437 $funcname =~ s/[^\w]/_/g; 438 } 439 $funcname = 'render_' . $funcname; 440 } 441 442 my $str = "sub $funcname { my (\$_context) = \@_; "; 443 foreach (@args) { 444 $str .= "my \$$_ = \$_context->{'$_'}; "; 445 } 446 $str .= $self->{script}; 447 $str .= "}\n"; 448 449 return $str; 450} 451 452=head2 compile() 453 454=cut 455 456## compile $self->{script} into closure. 457sub compile { 458 my $self = shift; 459 460 if ($self->{args}) { 461 $self->{func} = $Tenjin::CONTEXT_CLASS->to_func($self->{script}, $self->{name}); 462 return $self->{func}; 463 } 464 return; 465} 466 467=head2 escaped_expr( $expr ) 468 469Receives a Perl expression (from C<[= $expr =]>) and escapes it. This will 470happen in one of three ways: with the escape function defined in 471C<< $opts->{escapefunc} >> (if defined), with a scalar string (if 472C<< $opts->{rawclass} >> is defined), or with C<escape_xml()> from 473L<Tenjin::Util>, which uses L<HTML::Entites>. 474 475=cut 476 477sub escaped_expr { 478 my ($self, $expr) = @_; 479 480 return "$self->{escapefunc}($expr)" if $self->{escapefunc}; 481 482 return "(ref(\$_V = ($expr)) eq '$self->{rawclass}' ? \$_V->{str} : escape_xml($expr)" if $self->{rawclass}; 483 484 return "escape_xml($expr)"; 485} 486 487=head2 _read_file( $filename, [$lock_required] ) 488 489Receives an absolute path to a template file, reads its content and 490returns it. If C<$lock_required> is passed (and has a true value), the 491file will be locked for reading. 492 493=cut 494 495sub _read_file { 496 my ($self, $filename, $lock_required) = @_; 497 498 open(IN, "<:encoding($Tenjin::ENCODING)", $filename) 499 or croak "[Tenjin] Can't open $filename for reading: $!"; 500 flock(IN, LOCK_SH) if $lock_required; 501 502 read(IN, my $content, -s $filename); 503 504 close(IN); 505 506 return $content; 507} 508 509=head2 _write_file( $filename, $content, [$lock_required] ) 510 511Receives an absolute path to a template file and the templates contents, 512and creates the file (or truncates it, if existing) with that contents. 513If C<$lock_required> is passed (and has a true value), the file will be 514locked exclusively when writing. 515 516=cut 517 518sub _write_file { 519 my ($self, $filename, $content, $lock_required) = @_; 520 521 my $enc = $Tenjin::ENCODING eq 'UTF-8' ? '>:utf8' : ">:encoding($Tenjin::ENCODING)"; 522 523 open(OUT, $enc, $filename) 524 or croak "[Tenjin] Can't open $filename for writing: $!"; 525 flock(OUT, LOCK_EX) if $lock_required; 526 print OUT $content; 527 close(OUT); 528} 529 5301; 531 532=head1 SEE ALSO 533 534L<Tenjin>. 535 536=head1 AUTHOR 537 538The CPAN version of Tenjin was forked by Ido Perlmuter E<lt>ido at ido50.netE<gt> 539from version 0.0.2 of the original plTenjin, which is developed by Makoto Kuwata 540at L<http://www.kuwata-lab.com/tenjin/>. 541 542Development of Tenjin is done with github at L<http://github.com/ido50/Tenjin>. 543 544=head1 LICENSE AND COPYRIGHT 545 546Tenjin is licensed under the MIT license. 547 548 Copyright (c) 2007-2010 the aforementioned authors. 549 550 Permission is hereby granted, free of charge, to any person obtaining 551 a copy of this software and associated documentation files (the 552 "Software"), to deal in the Software without restriction, including 553 without limitation the rights to use, copy, modify, merge, publish, 554 distribute, sublicense, and/or sell copies of the Software, and to 555 permit persons to whom the Software is furnished to do so, subject to 556 the following conditions: 557 558 The above copyright notice and this permission notice shall be 559 included in all copies or substantial portions of the Software. 560 561 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 562 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 563 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 564 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 565 LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 566 OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 567 WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 568 569=cut