1##============================================================= -*-Perl-*- 2# 3# Template::Document 4# 5# DESCRIPTION 6# Module defining a class of objects which encapsulate compiled 7# templates, storing additional block definitions and metadata 8# as well as the compiled Perl sub-routine representing the main 9# template content. 10# 11# AUTHOR 12# Andy Wardley <abw@wardley.org> 13# 14# COPYRIGHT 15# Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. 16# 17# This module is free software; you can redistribute it and/or 18# modify it under the same terms as Perl itself. 19# 20#============================================================================ 21 22package Template::Document; 23 24use strict; 25use warnings; 26use base 'Template::Base'; 27use Template::Constants; 28 29our $VERSION = 2.79; 30our $DEBUG = 0 unless defined $DEBUG; 31our $ERROR = ''; 32our ($COMPERR, $AUTOLOAD, $UNICODE); 33 34BEGIN { 35 # UNICODE is supported in versions of Perl from 5.008 onwards 36 if ($UNICODE = $] > 5.007 ? 1 : 0) { 37 if ($] > 5.008) { 38 # utf8::is_utf8() available from Perl 5.8.1 onwards 39 *is_utf8 = \&utf8::is_utf8; 40 } 41 elsif ($] == 5.008) { 42 # use Encode::is_utf8() for Perl 5.8.0 43 require Encode; 44 *is_utf8 = \&Encode::is_utf8; 45 } 46 } 47} 48 49 50#======================================================================== 51# ----- PUBLIC METHODS ----- 52#======================================================================== 53 54#------------------------------------------------------------------------ 55# new(\%document) 56# 57# Creates a new self-contained Template::Document object which 58# encapsulates a compiled Perl sub-routine, $block, any additional 59# BLOCKs defined within the document ($defblocks, also Perl sub-routines) 60# and additional $metadata about the document. 61#------------------------------------------------------------------------ 62 63sub new { 64 my ($class, $doc) = @_; 65 my ($block, $defblocks, $variables, $metadata) = @$doc{ qw( BLOCK DEFBLOCKS VARIABLES METADATA ) }; 66 $defblocks ||= { }; 67 $metadata ||= { }; 68 69 # evaluate Perl code in $block to create sub-routine reference if necessary 70 unless (ref $block) { 71 local $SIG{__WARN__} = \&catch_warnings; 72 $COMPERR = ''; 73 74 # DON'T LOOK NOW! - blindly untainting can make you go blind! 75 $block =~ /(.*)/s; 76 $block = $1; 77 78 $block = eval $block; 79 return $class->error($@) 80 unless defined $block; 81 } 82 83 # same for any additional BLOCK definitions 84 @$defblocks{ keys %$defblocks } = 85 # MORE BLIND UNTAINTING - turn away if you're squeamish 86 map { 87 ref($_) 88 ? $_ 89 : ( /(.*)/s && eval($1) or return $class->error($@) ) 90 } values %$defblocks; 91 92 bless { 93 %$metadata, 94 _BLOCK => $block, 95 _DEFBLOCKS => $defblocks, 96 _VARIABLES => $variables, 97 _HOT => 0, 98 }, $class; 99} 100 101 102#------------------------------------------------------------------------ 103# block() 104# 105# Returns a reference to the internal sub-routine reference, _BLOCK, 106# that constitutes the main document template. 107#------------------------------------------------------------------------ 108 109sub block { 110 return $_[0]->{ _BLOCK }; 111} 112 113 114#------------------------------------------------------------------------ 115# blocks() 116# 117# Returns a reference to a hash array containing any BLOCK definitions 118# from the template. The hash keys are the BLOCK nameand the values 119# are references to Template::Document objects. Returns 0 (# an empty hash) 120# if no blocks are defined. 121#------------------------------------------------------------------------ 122 123sub blocks { 124 return $_[0]->{ _DEFBLOCKS }; 125} 126 127 128#----------------------------------------------------------------------- 129# variables() 130# 131# Returns a reference to a hash of variables used in the template. 132# This requires the TRACE_VARS option to be enabled. 133#----------------------------------------------------------------------- 134 135sub variables { 136 return $_[0]->{ _VARIABLES }; 137} 138 139#------------------------------------------------------------------------ 140# process($context) 141# 142# Process the document in a particular context. Checks for recursion, 143# registers the document with the context via visit(), processes itself, 144# and then unwinds with a large gin and tonic. 145#------------------------------------------------------------------------ 146 147sub process { 148 my ($self, $context) = @_; 149 my $defblocks = $self->{ _DEFBLOCKS }; 150 my $output; 151 152 153 # check we're not already visiting this template 154 return $context->throw(Template::Constants::ERROR_FILE, 155 "recursion into '$self->{ name }'") 156 if $self->{ _HOT } && ! $context->{ RECURSION }; ## RETURN ## 157 158 $context->visit($self, $defblocks); 159 160 $self->{ _HOT } = 1; 161 eval { 162 my $block = $self->{ _BLOCK }; 163 $output = &$block($context); 164 }; 165 $self->{ _HOT } = 0; 166 167 $context->leave(); 168 169 die $context->catch($@) 170 if $@; 171 172 return $output; 173} 174 175 176#------------------------------------------------------------------------ 177# AUTOLOAD 178# 179# Provides pseudo-methods for read-only access to various internal 180# members. 181#------------------------------------------------------------------------ 182 183sub AUTOLOAD { 184 my $self = shift; 185 my $method = $AUTOLOAD; 186 187 $method =~ s/.*:://; 188 return if $method eq 'DESTROY'; 189# my ($pkg, $file, $line) = caller(); 190# print STDERR "called $self->AUTOLOAD($method) from $file line $line\n"; 191 return $self->{ $method }; 192} 193 194 195#======================================================================== 196# ----- PRIVATE METHODS ----- 197#======================================================================== 198 199 200#------------------------------------------------------------------------ 201# _dump() 202# 203# Debug method which returns a string representing the internal state 204# of the object. 205#------------------------------------------------------------------------ 206 207sub _dump { 208 my $self = shift; 209 my $dblks; 210 my $output = "$self : $self->{ name }\n"; 211 212 $output .= "BLOCK: $self->{ _BLOCK }\nDEFBLOCKS:\n"; 213 214 if ($dblks = $self->{ _DEFBLOCKS }) { 215 foreach my $b (keys %$dblks) { 216 $output .= " $b: $dblks->{ $b }\n"; 217 } 218 } 219 220 return $output; 221} 222 223 224#======================================================================== 225# ----- CLASS METHODS ----- 226#======================================================================== 227 228#------------------------------------------------------------------------ 229# as_perl($content) 230# 231# This method expects a reference to a hash passed as the first argument 232# containing 3 items: 233# METADATA # a hash of template metadata 234# BLOCK # string containing Perl sub definition for main block 235# DEFBLOCKS # hash containing further subs for addional BLOCK defs 236# It returns a string containing Perl code which, when evaluated and 237# executed, will instantiate a new Template::Document object with the 238# above data. On error, it returns undef with an appropriate error 239# message set in $ERROR. 240#------------------------------------------------------------------------ 241 242sub as_perl { 243 my ($class, $content) = @_; 244 my ($block, $defblocks, $metadata) = @$content{ qw( BLOCK DEFBLOCKS METADATA ) }; 245 246 $block =~ s/\n(?!#line)/\n /g; 247 $block =~ s/\s+$//; 248 249 $defblocks = join('', map { 250 my $code = $defblocks->{ $_ }; 251 $code =~ s/\n(?!#line)/\n /g; 252 $code =~ s/\s*$//; 253 " '$_' => $code,\n"; 254 } keys %$defblocks); 255 $defblocks =~ s/\s+$//; 256 257 $metadata = join('', map { 258 my $x = $metadata->{ $_ }; 259 $x =~ s/(['\\])/\\$1/g; 260 " '$_' => '$x',\n"; 261 } keys %$metadata); 262 $metadata =~ s/\s+$//; 263 264 return <<EOF 265#------------------------------------------------------------------------ 266# Compiled template generated by the Template Toolkit version $Template::VERSION 267#------------------------------------------------------------------------ 268 269$class->new({ 270 METADATA => { 271$metadata 272 }, 273 BLOCK => $block, 274 DEFBLOCKS => { 275$defblocks 276 }, 277}); 278EOF 279} 280 281 282#------------------------------------------------------------------------ 283# write_perl_file($filename, \%content) 284# 285# This method calls as_perl() to generate the Perl code to represent a 286# compiled template with the content passed as the second argument. 287# It then writes this to the file denoted by the first argument. 288# 289# Returns 1 on success. On error, sets the $ERROR package variable 290# to contain an error message and returns undef. 291#------------------------------------------------------------------------ 292 293sub write_perl_file { 294 my ($class, $file, $content) = @_; 295 my ($fh, $tmpfile); 296 297 return $class->error("invalid filename: $file") 298 unless $file =~ /^(.+)$/s; 299 300 eval { 301 require File::Temp; 302 require File::Basename; 303 ($fh, $tmpfile) = File::Temp::tempfile( 304 DIR => File::Basename::dirname($file) 305 ); 306 my $perlcode = $class->as_perl($content) || die $!; 307 308 if ($UNICODE && is_utf8($perlcode)) { 309 $perlcode = "use utf8;\n\n$perlcode"; 310 binmode $fh, ":utf8"; 311 } 312 print $fh $perlcode; 313 close($fh); 314 }; 315 return $class->error($@) if $@; 316 return rename($tmpfile, $file) 317 || $class->error($!); 318} 319 320 321#------------------------------------------------------------------------ 322# catch_warnings($msg) 323# 324# Installed as 325#------------------------------------------------------------------------ 326 327sub catch_warnings { 328 $COMPERR .= join('', @_); 329} 330 331 3321; 333 334__END__ 335 336=head1 NAME 337 338Template::Document - Compiled template document object 339 340=head1 SYNOPSIS 341 342 use Template::Document; 343 344 $doc = Template::Document->new({ 345 BLOCK => sub { # some perl code; return $some_text }, 346 DEFBLOCKS => { 347 header => sub { # more perl code; return $some_text }, 348 footer => sub { # blah blah blah; return $some_text }, 349 }, 350 METADATA => { 351 author => 'Andy Wardley', 352 version => 3.14, 353 } 354 }) || die $Template::Document::ERROR; 355 356 print $doc->process($context); 357 358=head1 DESCRIPTION 359 360This module defines an object class whose instances represent compiled 361template documents. The L<Template::Parser> module creates a 362C<Template::Document> instance to encapsulate a template as it is compiled 363into Perl code. 364 365The constructor method, L<new()>, expects a reference to a hash array 366containing the C<BLOCK>, C<DEFBLOCKS> and C<METADATA> items. 367 368The C<BLOCK> item should contain a reference to a Perl subroutine or a textual 369representation of Perl code, as generated by the L<Template::Parser> module. 370This is then evaluated into a subroutine reference using C<eval()>. 371 372The C<DEFLOCKS> item should reference a hash array containing further named 373C<BLOCK>s which may be defined in the template. The keys represent C<BLOCK> 374names and the values should be subroutine references or text strings of Perl 375code as per the main C<BLOCK> item. 376 377The C<METADATA> item should reference a hash array of metadata items relevant 378to the document. 379 380The L<process()> method can then be called on the instantiated 381C<Template::Document> object, passing a reference to a L<Template::Context> 382object as the first parameter. This will install any locally defined blocks 383(C<DEFBLOCKS>) in the C<BLOCKS> cache in the context (via a call to 384L<visit()|Template::Context#visit()>) so that they may be subsequently 385resolved by the context. The main C<BLOCK> subroutine is then executed, 386passing the context reference on as a parameter. The text returned from the 387template subroutine is then returned by the L<process()> method, after calling 388the context L<leave()|Template::Context#leave()> method to permit cleanup and 389de-registration of named C<BLOCKS> previously installed. 390 391An C<AUTOLOAD> method provides access to the C<METADATA> items for the 392document. The L<Template::Service> module installs a reference to the main 393C<Template::Document> object in the stash as the C<template> variable. This allows 394metadata items to be accessed from within templates, including C<PRE_PROCESS> 395templates. 396 397header: 398 399 <html> 400 <head> 401 <title>[% template.title %] 402 </head> 403 ... 404 405C<Template::Document> objects are usually created by the L<Template::Parser> 406but can be manually instantiated or sub-classed to provide custom 407template components. 408 409=head1 METHODS 410 411=head2 new(\%config) 412 413Constructor method which accept a reference to a hash array containing the 414structure as shown in this example: 415 416 $doc = Template::Document->new({ 417 BLOCK => sub { # some perl code; return $some_text }, 418 DEFBLOCKS => { 419 header => sub { # more perl code; return $some_text }, 420 footer => sub { # blah blah blah; return $some_text }, 421 }, 422 METADATA => { 423 author => 'Andy Wardley', 424 version => 3.14, 425 } 426 }) || die $Template::Document::ERROR; 427 428C<BLOCK> and C<DEFBLOCKS> items may be expressed as references to Perl subroutines 429or as text strings containing Perl subroutine definitions, as is generated 430by the L<Template::Parser> module. These are evaluated into subroutine references 431using C<eval()>. 432 433Returns a new C<Template::Document> object or C<undef> on error. The 434L<error()|Template::Base#error()> class method can be called, or the C<$ERROR> 435package variable inspected to retrieve the relevant error message. 436 437=head2 process($context) 438 439Main processing routine for the compiled template document. A reference to a 440L<Template::Context> object should be passed as the first parameter. The 441method installs any locally defined blocks via a call to the context 442L<visit()|Template::Context#visit()> method, processes its own template, 443(passing the context reference as a parameter) and then calls 444L<leave()|Template::Context#leave()> in the context to allow cleanup. 445 446 print $doc->process($context); 447 448Returns a text string representing the generated output for the template. 449Errors are thrown via C<die()>. 450 451=head2 block() 452 453Returns a reference to the main C<BLOCK> subroutine. 454 455=head2 blocks() 456 457Returns a reference to the hash array of named C<DEFBLOCKS> subroutines. 458 459=head2 variables() 460 461Returns a reference to a hash of variables used in the template. 462This requires the L<TRACE_VARS|Template::Manual::Config#TRACE_VARS> 463option to be enabled. 464 465=head2 AUTOLOAD 466 467An autoload method returns C<METADATA> items. 468 469 print $doc->author(); 470 471=head1 CLASS METHODS 472 473These methods are used internally. 474 475=head2 as_perl($content) 476 477This method generate a Perl representation of the template. 478 479 my $perl = Template::Document->as_perl({ 480 BLOCK => $main_block, 481 DEFBLOCKS => { 482 foo => $foo_block, 483 bar => $bar_block, 484 }, 485 METADATA => { 486 name => 'my_template', 487 } 488 }); 489 490=head2 write_perl_file(\%config) 491 492This method is used to write compiled Perl templates to disk. If the 493C<COMPILE_EXT> option (to indicate a file extension for saving compiled 494templates) then the L<Template::Parser> module calls this subroutine before 495calling the L<new()> constructor. At this stage, the parser has a 496representation of the template as text strings containing Perl code. We can 497write that to a file, enclosed in a small wrapper which will allow us to 498susequently C<require()> the file and have Perl parse and compile it into a 499C<Template::Document>. Thus we have persistence of compiled templates. 500 501=head1 INTERNAL FUNCTIONS 502 503=head2 catch_warnings() 504 505This is a simple handler used to catch any errors that arise when the 506compiled Perl template is first evaluated (that is, evaluated by Perl to 507create a template subroutine at compile, rather than the template being 508processed at runtime). 509 510=head2 is_utf8() 511 512This is mapped to C<utf8::is_utf8> for versions of Perl that have it (> 5.008) 513or to C<Encode::is_utf8> for Perl 5.008. Earlier versions of Perl are not 514supported. 515 516=head1 AUTHOR 517 518Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/> 519 520=head1 COPYRIGHT 521 522Copyright (C) 1996-2012 Andy Wardley. All Rights Reserved. 523 524This module is free software; you can redistribute it and/or 525modify it under the same terms as Perl itself. 526 527=head1 SEE ALSO 528 529L<Template>, L<Template::Parser> 530 531=cut 532 533# Local Variables: 534# mode: perl 535# perl-indent-level: 4 536# indent-tabs-mode: nil 537# End: 538# 539# vim: expandtab shiftwidth=4: 540