# ==================================================================== # Gossamer Threads Module Library - http://gossamer-threads.com/ # # GT::Template # Author: Jason Rhinelander # $Id: Template.pm,v 2.109 2004/05/05 00:57:47 jagerman Exp $ # # Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved. # ==================================================================== # # Description: # A module for parsing templates. # package GT::Template; # =============================================================== use 5.004_04; use strict; use GT::Base(); use GT::CGI(); use GT::AutoLoader; use vars qw(@ISA %FILE_CACHE %FILE_CACHE_PRINT $VERSION $DEBUG $ATTRIBS $ERRORS $error $VARS); @ISA = qw/GT::Base/; $VERSION = sprintf "%d.%03d", q$Revision: 2.109 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0; $ATTRIBS = { func_code => undef, heap => undef, root => '.', strict => 1, compress => 0, begin => '<%', end => '%>', escape => 0, print => 0, stream => 0, cache => 1, indent => ' ', dont_save => 0, pkg_chop => 1 }; $ERRORS = { NOTEMPLATE => "No template file was specified.", CANTOPEN => "Unable to open template file '%s'. Reason: %s", NOTDIR => "Error: '%s' is not a directory", CANTRUN => "Unable to run compiled template file '%s'. Reason: %s", CANTRUNSTRING => "Unable to run compiled template code '%s' (from string). Reason: %s", CANTDIR => "Unable to create compiled template directory '%s'. Reason: %s", DIRNOTWRITEABLE => "Compiled template directory '%s' is not writeable", LOOPNOTHASH => "Error: Value '%s' for loop variable is not a hash reference", NOSUB => "Error: No subroutine '%s' in '%s'", BADVAR => "Error: Invalid variable name '\$%s' passed to function: %s\:\:%s", CANTLOAD => "Error: Unable to load module: %s. Reason:
%s
", NOTCODEREF => "Error: Variable '%s' is not a code reference", COMPILE => "Error: Unable to compile function: %s. Reason: %s", UNKNOWNTAG => "Unknown Tag: '%s'", TPLINFO_CANT_LOAD => "Unable to read template information file '%s': %s", TPLINFO_CANT_COMPILE => "Unable to compile template information file '%s': %s", TPLINFO_NOT_HASH => "Template information file '%s' does not contain a hash reference (Got: '%s')" }; sub parse { # --------------------------------------------------------------- # Can be called as either a class method or object method. When called as a class # method, we need a new object (can't reuse due to function calls re-using the same # parser). # my $self = ref $_[0] ? shift : (shift->new); my ($template, $vars, $opt, $print) = @_; # The fourth argument should only be used internally. defined $template or exists $opt->{string} or return $self->error(NOTEMPLATE => FATAL => $template); defined $vars or $vars = {}; defined $opt or $opt = {}; my $alias = delete $opt->{alias}; # Set print if we were called via parse_print or parse_stream. if ($print and $print == 2 or $self->{stream} or $opt->{stream}) { $print = $self->{print} = $opt->{print} = 2; } elsif ($print or $self->{print} or $opt->{print}) { $print = $self->{print} = $opt->{print} = 1; } $self->{begin} = $opt->{begin} if $opt->{begin}; $self->{end} = $opt->{end} if $opt->{end}; $self->debug_level(delete $opt->{debug_level}) if exists $opt->{debug_level}; # Load the variables used in parsing. ref $vars eq 'ARRAY' ? $self->load_vars(@$vars) : $self->load_vars($vars); # Load alias used for function calles. ref $alias eq 'ARRAY' ? $self->load_alias(@$alias) : $self->load_alias($alias) if $alias; # Load the template which can either be a filename, or a string passed in. $self->{root} = $opt->{root} if defined $opt->{root}; $self->{dont_save} = $opt->{dont_save} if defined $opt->{dont_save}; $self->{pkg_chop} = $opt->{pkg_chop} if defined $opt->{pkg_chop}; if (exists $opt->{string}) { $self->debug("Parsing string '$opt->{string}' with (print => @{[$opt->{print}||0]}, compress => @{[$opt->{compress}||0]}, strict => @{[$opt->{strict}||0]}, escape => @{[$opt->{escape}||0]})") if $self->{_debug}; return $self->parse_string($opt->{string}, $opt); } # Look for a template information file my $tplinfo = $self->load_tplinfo($self->{root}); $self->{tplinfo} = $tplinfo if $tplinfo; $self->load_template($template, $print); # Parse the template. $self->debug("Parsing '$template' with (print => @{[$opt->{print}||0]}, compress => @{[$opt->{compress}||0]}, strict => @{[$opt->{strict}||0]}, escape => @{[$opt->{escape}||0]})") if $self->{_debug}; if ($print and $print == 1) { # parse_print return print $self->_parse($template, $opt); } else { # parse or parse_stream return $self->_parse($template, $opt); } } sub parse_print { # --------------------------------------------------------------- # Print output rather than returning it. Faster than parse_stream, # but obviously, it does not stream. # my $self = shift; $self->parse(@_[0 .. 2], 1); } $COMPILE{parse_stream} = __LINE__ . <<'END_OF_SUB'; sub parse_stream { # --------------------------------------------------------------- # Print output as template is parsed. Only use if you really want # streaming. Before using, you should probably set $| = 1, or you # sort of defeat the whole point. # my $self = shift; $self->parse(@_[0 .. 2], 2) } END_OF_SUB $COMPILE{parse_string} = __LINE__ . <<'END_OF_SUB'; sub parse_string { # --------------------------------------------------------------- # Parses a string, only opts allowed is print mode on or off. # Internal use only. # my ($self, $string, $opt) = @_; my $code = $self->_compile_string($string, $opt->{print}); my $return = $code->($self); if ($opt->{print}) { return $opt->{print} == 2 ? $return : print $$return; } else { return $$return; } } END_OF_SUB # Returns the hash ref in the .tplinfo file. Takes a single argument: The # directory in which to look for a .tplinfo file (subdirectory "local" will be # considered first, if it exists). sub load_tplinfo { my $self = shift; my $root = shift; my $tplinfo_file; if (-e "$root/local/.tplinfo") { $tplinfo_file = "$root/local/.tplinfo"; } elsif (-e "$root/.tplinfo") { $tplinfo_file = "$root/.tplinfo"; } if ($tplinfo_file) { local($!,$@); my $tplinfo = do $tplinfo_file; if (!$tplinfo) { $! and return $self->error('TPLINFO_CANT_LOAD', 'FATAL', $tplinfo_file, "$!"); $@ and return $self->error('TPLINFO_CANT_COMPILE', 'FATAL', $tplinfo_file, "$@"); } ref $tplinfo ne 'HASH' and return $self->error('TPLINFO_NOT_HASH', 'FATAL', $tplinfo_file, "$tplinfo"); return $tplinfo; } return; } sub load_template { # --------------------------------------------------------------- # Loads either a given filename, or a template string into the FILE_CACHE. # my ($self, $file, $print) = @_; # If this is a full root (either starts with / or c:, where c is any char) # Then set the root and the filename appropriately. We do this so includes are # relative to the directory that is being parsed. if (substr($file, 0, 1) eq '/' or substr($file, 1, 1) eq ':') { $self->{root} = substr($file, 0, rindex($file, '/')); substr($file, 0, rindex($file, '/') + 1) = ''; } # Get the full file name. my $full_file = $self->{root} . "/" . $file; my $this_file = $file; my $this_file_type; my $filename = $file; $filename =~ s|/|__|g; my $full_compiled = $self->{root} . "/compiled/" . $filename . ".compiled" . (($print and $print == 2) ? ".print" : ""); # Load from cache if we have it, otherwise load from disk. If it's in cache # make sure the file hasn't changed on disk (comparse size and length). if ($self->{cache} and not $self->{dont_save}) { my $compiled; if (($print and $print == 2) ? (exists $FILE_CACHE_PRINT{$full_file}) : (exists $FILE_CACHE{$full_file})) { $self->debug("'$full_file' exists in the " . (($print and $print == 2) ? "parse_stream" : "parse") . " cache") if $self->{_debug}; $compiled = 1; } elsif (-f $full_compiled and -r _) { local($@, $!); $full_compiled =~ /(.*)/; $full_compiled = $1; if ($print and $print == 2) { local $^W; # Prevent a "subroutine redefined" warning $FILE_CACHE_PRINT{$full_file} = do $full_compiled; $FILE_CACHE_PRINT{$full_file} and ($compiled = 1); } else { local $^W; # Prevent a "subroutine redefined" warning $FILE_CACHE{$full_file} = do $full_compiled; $FILE_CACHE{$full_file} and ($compiled = 1); } if (not $compiled and $self->{_debug}) { $self->debug("Could not compile template '$full_file'. Errors: \$\@: $@, \$!: $!"); } } my ($deps, $date, $version); if ($compiled) { if ($print and $print == 2) { $deps = $FILE_CACHE_PRINT{$full_file}->{deps} || []; $date = $FILE_CACHE_PRINT{$full_file}->{parse_date} || 0; $this_file_type = $FILE_CACHE_PRINT{$full_file}->{file_type} || 'REL'; $version = $FILE_CACHE_PRINT{$full_file}->{parser_version} || 0; } else { $deps = $FILE_CACHE{$full_file}->{deps} || []; $date = $FILE_CACHE{$full_file}->{parse_date} || 0; $this_file_type = $FILE_CACHE{$full_file}->{file_type} || 'REL'; $version = $FILE_CACHE{$full_file}->{parser_version} || 0; } if ($version == $VERSION) { my $reload = 0; DEPENDENCIES: for my $fileinfo ("$this_file_type:$this_file", @$deps) { my $file = $fileinfo; # We can't change anything in $deps directly as that would change the cache $file =~ s/^(REL|LOCAL|ABS|INH|MISSING)://; # Relative, local, absolute, or inherited. my $type = $1 || 'ABS'; # Shouldn't ever fall back to 'ABS', but just in case if ($type eq 'MISSING') { # The template couldn't be found; we need to recompile if it has been created exists. my $root = $self->{root}; if (-r "$root/local/$file") { $reload = 1; } elsif (-r "$root/$file") { $reload = 1; } elsif (-r $file) { $reload = 1; } else { # Scan the inheritance tree my $root = $root; # ;-) until ($reload) { # Try going one more level in the inheritance tree my $tplinfo = $self->load_tplinfo($root); if ($tplinfo and my $inherit = $tplinfo->{inheritance}) { if ($inherit =~ m!^(?:[a-zA-Z]:)?[\\/]!) { # Absolute inheritance path $root = $inherit; } else { # Relative inheritance path. This might eventually look like /blah/a/../b/../c/../d/../e - Messy, but it works $root .= "/$inherit"; } } else { last; # We haven't found it, and there isn't any (more) inheritance } # Look for the include in the inherited directory: if (-r "$root/local/$file" or -r "$root/$file") { $reload = 1; } } } if ($reload) { $self->debug("Recompiling '$full_file' because previously missing dependency '$file' now exists") if $self->{_debug}; if ($print and $print == 2) { delete $FILE_CACHE_PRINT{$full_file}; } else { delete $FILE_CACHE{$full_file}; } last; } } if ($type eq 'ABS') { if ((stat $file)[9] != $date) { $self->debug("Recompiling '$full_file' because dependency '$file' has changed") if $self->{_debug}; $reload = 1; if ($print and $print == 2) { delete $FILE_CACHE_PRINT{$full_file}; } else { delete $FILE_CACHE{$full_file}; } last; } } elsif ($type eq 'REL' or $type eq 'LOCAL') { my $bad; if ($type eq 'LOCAL') { $bad = (!-r "$self->{root}/local/$file" or (stat _)[9] != $date); } else { # REL $bad = (-r "$self->{root}/local/$file" or (stat(-r "$self->{root}/local/$file" ? "$self->{root}/local/$file" : "$self->{root}/$file"))[9] != $date); } if ($bad) { if ($self->{_debug}) { if ($type eq 'LOCAL' and not -r _) { $self->debug("Recompiling '$file' because it no longer exists in 'local'"); } elsif ($file eq $this_file) { $self->debug("Recompiling '$file' because it has changed"); } elsif ($type eq 'REL' and -r "$self->{root}/local/$file") { $self->debug("Recompiling '$full_file' because dependency '$file' now exists in 'local'"); } else { $self->debug("Recompiling '$full_file' because dependency '$file' has changed"); } } $reload = 1; if ($print and $print == 2) { delete $FILE_CACHE_PRINT{$full_file} } else { delete $FILE_CACHE{$full_file} } last; } } elsif ($type eq 'INH') { my ($f) = $file =~ /^(?:(?:REL|LOCAL|INH):)*(.*?)$/; if (-r "$self->{root}/local/$f" or -r "$self->{root}/$f") { $self->debug("Recompiling '$full_file' because it was inherited or contained inherited includes, but now exists locally") if $self->{_debug}; $reload = 1; ($print and $print == 2) ? delete $FILE_CACHE_PRINT{$full_file} : delete $FILE_CACHE{$full_file}; last; } elsif (not $self->{tplinfo} or not $self->{tplinfo}->{inheritance}) { $self->debug("Recompiling '$full_file' because it was inherited or contained inherited includes, but the .tplinfo file does not exist or does not contain inheritance information") if $self->{_debug}; $reload = 1; ($print and $print == 2) ? delete $FILE_CACHE_PRINT{$full_file} : delete $FILE_CACHE{$full_file}; last; } my $inheritance_depth = 0; my $inherit = $self->{tplinfo}->{inheritance}; my $root = $self->{root}; while ($type eq 'INH') { $inheritance_depth++; if (not $inherit) { $self->debug("Recompiling '$full_file' because it is inherited ($inheritance_depth deep) but no inheritance exists for $inherit.") if $self->{_debug}; $reload = 1; ($print and $print == 2) ? delete $FILE_CACHE_PRINT{$full_file} : delete $FILE_CACHE{$full_file}; last DEPENDENCIES; } if ($inherit =~ m!^(?:[a-zA-Z]:)?[\\/]!) { # Absolute inheritance path $root = $inherit; } else { # Relative inheritance path $root .= "/$inherit"; } $inherit = undef; my $tplinfo = $self->load_tplinfo($root); $inherit = $tplinfo->{inheritance} if $tplinfo and $tplinfo->{inheritance}; $file =~ s/^(REL|LOCAL|INH)://; $type = $1 || 'REL'; next if $type eq 'INH'; my $bad; if ($type eq 'LOCAL') { $bad = (!-r "$root/local/$file" or (stat _)[9] != $date); } else { # REL $bad = (-r "$root/local/$file" or (stat("$root/$file"))[9] != $date); } if ($bad) { if ($self->{_debug}) { if ($type eq 'LOCAL' and not -r _) { $self->debug("Recompiling '$full_file' because '$file' no longer exists in 'local' (inherited, depth: $inheritance_depth)"); } else { $self->debug("Recompiling '$full_file' because dependency '$file' has changed (inherited, depth $inheritance_depth)"); } } $reload = 1; ($print and $print == 2) ? delete $FILE_CACHE_PRINT{$full_file} : delete $FILE_CACHE{$full_file}; last DEPENDENCIES; } } } } unless ($reload) { $self->debug("'$full_file' does not need to be reloaded. Using cached version.") if $self->{_debug}; return 1; # It doesn't need to be reloaded. } } } elsif ($self->{_debug}) { $self->debug("Compiling '$full_file' (compiled version does not exist or has an incorrect version)") if ($self->{_debug}); } } if ($self->{dont_save}) { require GT::Template::Parser; my $parser = GT::Template::Parser->new(indent => $self->{indent}, begin => $self->{begin}, end => $self->{end}); $parser->debug_level($self->{_debug}) if $self->{_debug}; my ($eval) = $parser->parse( $this_file, { root => $self->{root} }, ($print and $print == 2) ); my $code; local ($@, $^W); eval { # Treat this like a string compilation eval "sub GT::Template::parsed_template { $$eval }"; $code = \>::Template::parsed_template unless $@; }; if (ref $code ne 'CODE') { return $self->error('CANTRUNSTRING', 'FATAL', $$eval, "$@"); } if ($print and $print == 2) { $FILE_CACHE_PRINT{$full_file} = { code => $code, dont_save => 1 }; } else { $FILE_CACHE{$full_file} = { code => $code, dont_save => 1 }; } } else { # Needs to be reparsed for some reason (not in cache, old, etc.) so load it. if (not -e $self->{root} . "/compiled") { mkdir($self->{root} . "/compiled", 0777) or return $self->error('CANTDIR', 'FATAL', "$self->{root}/compiled", "$!"); chmod 0777, $self->{root} . "/compiled"; } elsif (not -d _) { $self->error('NOTDIR', 'FATAL', $self->{root} . "/compiled"); } elsif (not -w _) { $self->error('DIRNOTWRITEABLE', 'FATAL', "$self->{root}/compiled"); } $self->_compile_template($this_file, $full_compiled, $print); local($@, $!); local $^W; # Prevent a "subroutine redefined" warning my $data = do $full_compiled or return $self->error(CANTRUN => FATAL => $full_compiled, "\$\@: $@. \$!: $!"); if ($print and $print == 2) { $FILE_CACHE_PRINT{$full_file} = $data } else { $FILE_CACHE{$full_file} = $data } } return 1; } sub vars { # --------------------------------------------------------------- # Retuns a hash ref of the current tags the template parser will # use during parsing. # return $_[0]->{VARS}; } sub load_alias { # --------------------------------------------------------------- # Sets what aliases will be available in the template, can take a hesh, # hash ref or a GT::Config object. # my $self = shift; my $p = ref $_[0] ? shift() : {@_}; $self->{ALIAS} ||= {}; while ($p) { if (ref $p eq 'HASH' or UNIVERSAL::isa($p, 'GT::Config')) { # A GT::Config module (or subclass) is a tied hash. for (keys %$p) { $self->{ALIAS}->{$_} = $p->{$_} } } $p = shift; } } sub load_vars { # --------------------------------------------------------------- # Sets what variables will be available in the template, can take a hash, # hash ref, cgi object, or a GT::Config object. # my $self = shift; my $p = ref $_[0] ? shift() : {splice @_}; $self->{VARS} ||= {}; $self->{DELAY_VARS} ||= {}; while ($p) { if (ref $p eq 'HASH') { for (keys %$p) { $self->{VARS}->{$_} = $p->{$_}; delete $self->{DELAY_VARS}->{$_}; } } elsif (UNIVERSAL::isa($p, 'GT::Config')) { # A GT::Config module (or subclass) is a tied hash. for (keys %$p) { $self->{VARS}->{$_} = undef; $self->{DELAY_VARS}->{$_} = $p; # The DELAY_VARS key works to delay the loading of vars until we use them. The primary purpose for this # is speed - often GT::Template is used with a GT::Config object with compile_subs turned on - in such a # case, reading the value from the hash would end up compiling the subroutine. If the config file has # 50 subroutines, and only 1 is used on the page, a lot of wasted processing time would occur without # the delayed loading. To do this, we store a reference to the Config object in DELAY_VARS, then if it # is actually used we replace the VARS value with the real value/reference/etc. } } elsif (ref $p eq 'GT::CGI' or ref $p eq 'CGI') { for ($p->param) { $self->{VARS}->{$_} = $p->param($_); delete $self->{DELAY_VARS}->{$_}; } } $p = shift; } } sub clear_vars { # --------------------------------------------------------------- # Clears the namespace. # $_[0]->{VARS} = {}; $_[0]->debug("Clearing internal variables.") if $_[0]->{_debug}; } # This should only be called from functions that are called. $VARS is a # localized global consisting of the current parser's $self->{VARS}. sub tags { $VARS } $COMPILE{dump} = __LINE__ . <<'END_OF_SUB'; sub dump { # --------------------------------------------------------------- # Dumps the variables, used as a tag <%GT::Dumper::dump%> to display # all tags available on the template. # my %opts = @_; my $tags = GT::Template->tags; require GT::Dumper; my $output = ''; if ($opts{'-text'}) { $output = "Available Variables\n"; for my $key (sort keys %$tags) { my $val = $tags->{$key}; $val = $$val if ref $val eq 'SCALAR' or ref $val eq 'LVALUE'; $val = GT::Dumper::Dumper($val) if ref $val; local $^W; $output .= "$key => $val\n"; } } else { my $font = 'font face="Tahoma,Arial,Helvetica" size="2"'; $output = qq~~; for my $key (sort keys %$tags) { my $val = $tags->{$key}; $val = $$val if ref $val eq 'SCALAR' or ref $val eq 'LVALUE'; $val = GT::Dumper::Dumper($val) if ref $val; $val = GT::CGI::html_escape($val); local $^W; $val =~ s|\n|
\n|g; $val =~ s/ / /g; $output .= qq~~; } $output .= qq~
<$font>Available Variables
<$font>$key$val
~; } return \$output; } END_OF_SUB sub _parse { # --------------------------------------------------------------- # Sets the parsing options, and gets the code ref and runs it. # my ($self, $template, $opt) = @_; my $compress = exists $opt->{compress} ? $opt->{compress} : $self->{compress}; local $self->{opt} = {}; $self->{opt}->{strict} = exists $opt->{strict} ? $opt->{strict} : $self->{strict}; $self->{opt}->{print} = exists $opt->{print} ? $opt->{print} : $self->{print}; $self->{opt}->{escape} = exists $opt->{escape} ? $opt->{escape} : $self->{escape}; $self->{opt}->{package} = exists $opt->{package} ? $opt->{package} : caller(1) || 'main'; $self->{opt}->{func_code} = exists $opt->{func_code} ? $opt->{func_code} : $self->{func_code}; $self->{opt}->{heap} = exists $opt->{heap} ? $opt->{heap} : $self->{heap}; # Set the root if this is a full path so includes can be relative to template. if (substr($template, 0, 1) eq '/' or substr($template, 1, 1) eq ':') { $self->{root} = substr($template, 0, rindex($template, '/')); substr($template, 0, rindex($template, '/') + 1) = ''; } my $root = $self->{root}; my $full_file = $self->{root} . '/' . $template; my ($code, $dont_save) = $self->{opt}->{print} == 2 ? @{$FILE_CACHE_PRINT{$full_file}}{qw/code dont_save/} : @{$FILE_CACHE{$full_file}}{qw/code dont_save/}; my $output = $code->($self); return $output if $self->{opt}->{print} == 2; # Compress output if requested. if ($compress) { $self->debug("Compressing output for template '$template'.") if $self->{_debug}; my ($pre_size, $post_size); $pre_size = length $$output if $self->{_debug}; $self->_compress($output); $post_size = length $$output if $self->{_debug}; $self->debug(sprintf "Output reduced %.1f%%. Size before/after compression: %d/%d.", 100 * (1 - $post_size / $pre_size), $pre_size, $post_size) if $self->{_debug}; } return $$output; } $COMPILE{_compile_template} = __LINE__ . <<'END_OF_SUB'; sub _compile_template { # ------------------------------------------------------------------- # Loads the template parser and compiles the template and saves it # to disk. # my ($self, $file, $full_compiled, $print) = @_; $self->debug("Compiling template $file (into $full_compiled)") if $self->{_debug}; require GT::Template::Parser; my $parser = GT::Template::Parser->new(indent => $self->{indent}, begin => $self->{begin}, end => $self->{end}); $parser->debug_level($self->{_debug}) if $self->{_debug}; my ($code, $deps, $file_type) = $parser->parse( $file, { root => $self->{root} }, ($print and $print == 2) ); local *FH; open FH, "> $full_compiled" or return $self->error('CANTOPEN', 'FATAL', $full_compiled, "$!"); my $localtime = localtime; my $time = time; my $dep_string = '[' . join(',', map qq|"\Q$_\E"|, @$deps) . ']'; (my $escaped = $full_compiled) =~ s/(\W)/sprintf "_%x", ord($1)/ge; print FH qq |# This file is a compiled version of a template that can be run much faster # than reparsing the file, yet accomplishes the same thing. You should not # attempt to modify this file as any changes you make would be lost as soon as # the original template file is modified. # Editor: vim:syn=perl # Generated: $localtime local \$^W; { parse_date => $time, deps => $dep_string, parser_version => $VERSION, file_type => '$file_type', code => \\>::Template::parsed_template }; sub GT::Template::parsed_template { $$code }|; close FH; chmod 0666, $full_compiled; return; } END_OF_SUB $COMPILE{_compile_string} = __LINE__ . <<'END_OF_SUB'; sub _compile_string { # ----------------------------------------------------------------- # Like _compile_template, except that this returns a code reference # for the passed in string. # Takes two arguments: The string, and print mode. If print mode is # on, the code will print everything and return 1, otherwise the # return will be the result of the template string. my ($self, $string, $print) = @_; $self->debug("Compiling string '$string' in " . (($print and $print == 2) ? "stream mode" : "return mode")) if $self->{_debug}; if (!$string) { $self->debug("Actual parsing skipped for empty or false string '$string'") if $self->{_debug}; if ($print and $print == 2) { return sub { print $string }; } else { return sub { \$string }; } } require GT::Template::Parser; my $parser = GT::Template::Parser->new(indent => $self->{indent}, begin => $self->{begin}, end => $self->{end}); $parser->debug_level($self->{_debug}) if $self->{_debug}; my ($eval) = $parser->parse( $string, { root => $self->{root}, string => $string }, ($print and $print == 2) ); my $code; local ($@, $^W); eval { # Catch tainted data eval "sub GT::Template::parsed_template { $$eval }"; $code = \>::Template::parsed_template unless $@; }; unless (ref $code eq 'CODE') { return $self->error('CANTRUNSTRING', 'FATAL', "sub GT::Template::parsed_template { $$eval }", "$@"); } return $code; } END_OF_SUB $COMPILE{_call_func} = __LINE__ . <<'END_OF_SUB'; sub _call_func { # --------------------------------------------------------------- # Calls a function. The arguments are set in GT::Template::Parser. # If the function returns a hash, it is added to $self->{VARS}. # The result of the function is escaped, if escape mode is turned # on. # my ($self, $torun, @args) = @_; if (exists $self->{ALIAS}->{$torun}) { $torun = $self->{ALIAS}->{$torun}; } no strict 'refs'; my $rindex = rindex($torun, '::'); my $package; $package = substr($torun, 0, $rindex) if $rindex != -1; my ($code, $ret); my @err = (); my $ok = 0; if ($package) { my $func = substr($torun, rindex($torun, '::') + 2); (my $pkg = $package) =~ s,::,/,g; until ($ok) { local ($@, $SIG{__DIE__}); eval { require "$pkg.pm" }; if ($@) { push @err, $@; } elsif (defined(&{$package . '::' . $func}) or defined &{$package . '::AUTOLOAD'} and defined %{$package . '::COMPILE'} and exists ${$package . '::COMPILE'}{$func} ) { $ok = 1; $code = \&{$package . '::' . $func}; last; } else { push @err, sprintf($ERRORS->{NOSUB}, "$package\::$func", "$pkg.pm"); } my $pos = rindex($pkg, '/'); $pos == -1 ? last : (substr($pkg, $pos) = ""); last unless $self->{pkg_chop}; } } elsif (ref $self->{VARS}->{$torun} eq 'CODE') { $code = $self->{VARS}->{$torun}; $ok = 1; } elsif ($self->{DELAY_VARS}->{$torun}) { $code = $self->{VARS}->{$torun} = $self->{DELAY_VARS}->{$torun}->{$torun}; delete $self->{DELAY_VARS}->{$torun}; $ok = 1; } if ($ok) { local $VARS = $self->{VARS}; if ($self->{opt}->{heap}) { push @args, $self->{opt}->{heap} } if ($package and ref($self->{opt}->{func_code}) eq 'CODE') { $ret = $self->{opt}->{func_code}->($torun, @args); } else { $ret = $code->(@args); } if (ref $ret eq 'HASH') { for (keys %$ret) { $self->{VARS}->{$_} = $ret->{$_}; } $ret = ''; } } elsif ($package) { $ret = $self->{opt}->{strict} ? \sprintf($ERRORS->{CANTLOAD}, $package, join(",
\n", @err)) : ''; } else { $ret = $self->{opt}->{strict} ? \sprintf($ERRORS->{NOTCODEREF}, $torun) : ''; } $ret = '' if not defined $ret; $ret = (ref $ret eq 'SCALAR' or ref $ret eq 'LVALUE') ? $$ret : $self->{opt}->{escape} ? GT::CGI::html_escape($ret) : $ret; return $ret; } END_OF_SUB $COMPILE{_compress} = __LINE__ . <<'END_OF_SUB'; sub _compress { # -------------------------------------------------------- # Compress html by removing extra space (idea/some re from HTML::Clean). # Avoids compressing pre tags. # my ($self, $text) = @_; if ($$text =~ /))( my $html = $1; my $pre = $2 || ''; $html =~ s/\s+\n/\n/g; $html =~ s/\n\s+\s{2,} />/g; $html =~ s/<\s+/\s{2,} />/g; $$text =~ s/<\s+/{VARS}->{$str}) { if ($self->{DELAY_VARS}->{$str}) { $self->{VARS}->{$str} = $self->{DELAY_VARS}->{$str}->{$str}; delete $self->{DELAY_VARS}->{$str}; } if (ref $self->{VARS}->{$str} eq 'CODE') { local $VARS = $self->{VARS}; $ret = $self->{VARS}->{$str}->($self->{VARS}, $self->{opt}->{heap} || ()); $ret = '' if not defined $ret; } else { $ret = $self->{VARS}->{$str}; $ret = '' if not defined $ret; } } elsif (exists $self->{ALIAS}->{$str}) { $ret = $self->_call_func($self->{ALIAS}->{$str}); } elsif ($str eq 'TIME') { return time; } else { $good = 0; } if (not $good) { return $strict ? sprintf($ERRORS->{UNKNOWNTAG}, $str) : undef; } if (ref $ret eq 'HASH') { for (keys %$ret) { $self->{VARS}->{$_} = $ret->{$_}; } return; } return if not defined $ret; return $$ret if ref $ret eq 'SCALAR' or ref $ret eq 'LVALUE'; return $ret if not $escape; $ret =~ s/&/&/g; $ret =~ s//>/g; $ret =~ s/"/"/g; return $ret; } sub _get_value { # --------------------------------------------------------------- # Takes a key, and returns the value, in scalar context. # In list context it returns a two-item list: the value is first, # then a 1 or undef to indicate the validity of the tag. # my ($self, $str, $strict) = @_; my $ret = ''; local $self->{opt}->{strict} = $strict; if (ref($str) eq 'HASH') { $str; } elsif (exists $self->{VARS}->{$str}) { if ($self->{DELAY_VARS}->{$str}) { $self->{VARS}->{$str} = $self->{DELAY_VARS}->{$str}->{$str}; delete $self->{DELAY_VARS}->{$str}; } if (ref $self->{VARS}->{$str} eq 'CODE') { my $ret; local $VARS = $self->{VARS}; $ret = $self->{VARS}->{$str}->($self->{VARS}, $self->{opt}->{heap} || ()); $ret = '' if not defined $ret; return wantarray ? ($ret, 1) : $ret; } else { my $ret = $self->{VARS}->{$str}; $ret = '' if not defined $ret; return wantarray ? ($ret, 1) : $ret; } } else { $ret = $strict ? \sprintf($ERRORS->{UNKNOWNTAG}, $str) : ''; return wantarray ? ($ret, undef) : $ret; } } 1; __END__ =head1 NAME GT::Template - simple template parsing module =head1 SYNOPSIS use GT::Template; my $var = GT::Template->parse('file.txt', { key => 'value' }); ... print $var; or use GT::Template; GT::Template->parse_print('file.txt', { key => 'value' }); =head1 DESCRIPTION GT::Template provides a simple way (one line) to parse a template (which can be either a file or a string) and make sophisticated replacements. It supports simple replacements, conditionals, function calls, including other templates, and more. Additionally, through using pre-compiled files, subsequent parses of a template will be very fast. =head2 Template Syntax The template parser replaces tags with content. By default a tag is anything enclosed between C%> and C<%E>. These can be changed by specifying a value to the C and C methods. =over 4 =item Variable Substitution At the simplest level of GT::Template are simple variable replacements such as: You are <%age%> years old. where age would be replaced with a value. =item Sets You can set values from within a template by using: <%set Title = 'Login'%> and now <%Title%> will be equal to Login. This is especially useful for Cs, where you could, for example, set a Title variable to a string that will be displayed in an included template. You can also set one variable to the value of another, such as: <%set title = $return_title%> This will set the variable "title" with the value of the variable "return_title." =item Operators GT::Template is capable of performing some basic math calculations and one string-multiple function in templates displaying the results in the parsed template. For example, if the 'age' variable is 15, the following tag: <%age + 10%> will display 25 in the template. Besides addition there are the following operators, which work as expected: - * / % (remainder) ^ (raised to the power of) The following operators are also worth explaining: i/ /N ~ (Remainder difference) x (String multiplier) i/ performs integral division between the two numbers. For example, '4' i/ 3 will result in 1. '100' i/ 3 would result in 33, etc. /N does not actually use a literal N, instead N should be replaced by a number. The result will be formatted (and rounded) to N decimal places. For example, '4' /3 3 would result in: 1.333, while '5' /3 3 would give you: 1.667. '3' /3 3 would be 1.000. Note that i/ and /0 are not the same, as can be illustrated here: 38 i/ '3.8' => 12 - becomes 38 i/ 3 38 /0 '3.8' => 10 - 38 / 3.8 is calculated, then rounded with 0 decimal place precision. You should be sure of which one you mean to use, or you may end up with unexpected results. ~ is used to get a remainder difference. Where 8 % 5 would return 3, 8 ~ 5 will return 2. This is calculated as the divisor (5) minus the remainder (3). This is useful when generating tables in a loop - when you hit the end of the loop, you want to be able to put an empty cell with a colspan of however many rows are left. Something like: <%row_num ~ 5%> will give you the proper value. As mentioned, there is also one string operator, 'x'. When you use 'x', the variable (or value as we'll see in a second) will be displayed "n" times, where "n" is the integral value of the right hand side. Assuming that the 'name' variable is 'Jason', this tag: <%name x 2%> will display JasonJason in the parsed template. Like this, it isn't all that useful because you could simply put C%name%EE%name%E> in your template. However, the right hand side may instead use the value of a variable, such as in this example: <%name x $print%> Assuming that 'name' is still 'Jason', and that 'print' is 3, this would display: JasonJasonJason Though this is useful as is, this is taken a step furthur: the first does not always have to be a variable. By using 'single quotation marks' or "double quotation marks" we can display fixed text a variable number of times. For example: <%'My Text' x $print%> Again assuming that the variable C is 3, this will print: My TextMy TextMy Text this comes in handy when doing things like indentation. Note that what we want to use for "My Text" might contain " or ' characters. If it only contains ", and not ', it is advisible to use ' instead of " as the string delimiter. If, however, you need to use the same quotes inside the string as you use to delimit the string, you should precede the quotes with a blackslash (\) and any backslashes with a backslash. For example, if you wanted to display the three characters \'" thirty times, you would have to write it as one of the following two lines: <%"\\'\"" x 30%> <%'\\\'"' x 30%> Hopefully such occurances are rare, but not impossible; hence the support for using either ' or " as the delimiting character. =item Set + Operators You can add, subtract, etc. to your variables with the following syntax: <%set variable += 3%> += can be changed to the following: += - Adds to a variable -= - Subtracts from a variable *= - Multiplies a variable /= - Divides a variable %= - Set a variable to a remainder ^= - Raise a variable to a power .= - Appends to a string x= - "Multiplies" a string - "ab" x 3 is "ababab" =item Conditionals You can use conditionals C, C (or C), C, and C as in: <%if age%> You are <%age%> years old. <%elseif sex%> You are <%sex%>. <%else%> I know nothing about you! <%endif%> <%ifnot login%> You are not logged in! <%endif%> <%unless age%> I don't know how old you are! <%endif%> If you like you may use C instead of C (drop the 'e'). C and C are aliases for C and C, respectively, and may be used interchangeably. All conditionals must be ended with an C tag, although may contain any number of C conditionals and/or a single C conditional between the C and C tags. Conditionals may be nested within each other, to arbitrary depth: <%if age%> You are <%age%> years old <%if sex%> and you are <%sex%> <%endif%> <%endif%> =item Comparisons Inside conditionals you can use C>, C>, C=>, C=>, C<==>, C, C, C, C, C, C, C, C, C, and C. This allows you to do things like: <%if age == 15%> You're 15! <%endif%> where the == can be replaced with any operator listed above. If the right hand side of the equation starts with a '$', the string will be interpolated as a variable. If you wish to use a string starting with a literal $, you can avoid this interpolation by adding quotes around the right hand value. The left hand side is always a variable. C, C, C, C, C, and C are he alphabetical equivelants of C>, C>, C=>, C=>, C<==>, and C, respectively. In terms of less-than and greater-than comparisons, the comparison is similar to a dictionary: C is less than C, but greater than C; C<10> is greater than C<1>, but less than C<2>; C is less than C, due to capitalization (unless using C, C, etc.). C will be true if the variable contains the right-hand side. C and C will be true if the variable starts with, or ends with, respectively, the right-hand value. There are also case-insensitive versions of the string comparisons - they are: C, C, C, C, C, C, C, C, and C. These comparisons work exactly like the versions _without_ the i except that the comparison is case-insensitive. C, C, C, and C are aliases for the comparison with an added C. C and C are deprecated aliases for C and C and should no longer be used. =item Logical Operators If statements (including elseif statements) may contain multiple conditions using one of the two booleans operators C and C. For example: <%if age and sex and color%> I know your age, sex and hair color. <%else%> I don't have enough information about you! <%endif%> <%if age < 10 or age > 90 or status eq banned%> You are not permitted to view this page. <%endif%> It should be noted that it is currently not possible to mix both C and C in a single if statement - you may, however, use the same boolean multiple times in a single statement. (Brackets) are also not currently supported. Internally, if statements will be short-circuited as soon as possible. That means that for the following tag: <%if foo = 1 or foo = 2 or foo = 3%> the following will occur: First, variable "foo" will be tested to see if it is numerically equal to 1. If it is, the rest of the checks are aborted since the if will pass regardless. If it is not, foo = 2 will be checked, and if true, will abort the next check, and so on until a condition is true or the end of the list of statements is encountered. Likewise with C, except that with C the parser will stop checking as soon as the first false value is encountered (since a false value means the entire condition will be false). =item Loops Inside your template you can use loops to loop through an array reference, or code reference. If using an array reference, each element should be a hash reference, and when using a code reference every return should be a hash reference - or undef to end the loop. The variables in the hash reference will then be available for that iteration of the loop. For example: <%loop people%> <%if name eq 'Jason'%> I have <%color%> hair. <%else%> <%name%> has <%color%> hair. <%endif%> <%endloop%> would loop through all values of pens, and for each one would print the sentence substituting the color of the pen. Also, inside your loop you can use the following tags: <%row_num%> - a counter for what row is being looped, starts at 1. <%first%> - boolean value that is true if this is the first row, false otherwise. <%last%> - boolean value that is true if this is the last row, false otherwise. <%inner%> - boolean value that is true if this is not first and not last. <%even%> - boolean value is true if row_num is even. <%odd%> - boolean value is true if row_num is odd. You could use even and odd tags to produce alternating colors like: <%loop results%> .. <%endloop%> Also, you can use <%lastloop%> to abort the loop and skip straight to the current loop's <%endloop%> tag, and <%nextloop%> to load the next loop variables and jump back to the beginning of the current loop. The 6 built-in variables (row_num, first, last, ...) and any variables set via the loop variable will only be available for the current loop iteration, after which the variables of the next loop iteration will be set, or, for variables that exist in one iteration but not the next, the variables that existed prior to the loop being called will be restored. =item escape_url escapeURL Most variable will already be escaped for html viewing by default. Being able to use these variables on one page in a URL and in the html page can be a bit tricky. If you are using escape mode, this function simply URL encodes the variable. Otherwise, this function unescapes html escapes and URL encodes the variable. <%escape_url somevar%> =item escape_html escapeHTML Whether or not in escape mode, this directive will HTML escape the variable. The variable will _not_ be escaped twice in escape mode. <%escape_html somevar%> =item unescape_html unescapeHTML The directive will unescape the HTML escapes &, <, >, and " =item escape_js escapeJS This directive will safely escape a javascript variable so that it can be used inside a javascript string delimited with either "double quotes" or 'single quotes.' <%escape_js somevar%> =item nbsp This directive will display the tag with all whitespace in a variable converted to non-breaking spaces ( ). This is useful when attempting to display something accurately which may contain spaces, or when attempting to ensure that a value does not wrap over multiple lines. =item Includes You can include other files. Any tags inside the includes will be evaluated. You can also have includes inside of includes, inside if statements, or even inside loops. The following tag: <%if info%> <%include info.txt%> <%else%> <%include noinfo.txt%> <%endif%> will include either the file info.txt (if info is true) or noinfo.txt (if info is false or not set). It must be in the template's root directory which is defined using $obj->root, or '.' by default. A useful application of the include tag is to include files inside a loop, as in: <%loop people%> <%include person.txt%> <%endloop%> Another useful example is in including a common header or footer to all pages. If, for example, you have a header.htm that you wish to be included, but it needs a variable title, you could combine the C with a C, such as: <%set Title = 'Login'%> <%include header.htm%> and then in your header.htm: <%Title%> This would allow you to have different titles, but still include the same header template on each page. =item Functions You can call functions in either the variable substitution or in the comparison. The function must reside in a package, and you must do the full qualification. A script header normally looks like <%CGI::header%> which would call &CGI::header(). You can pass arguments to this as in: A script header normally looks like <%CGI::header ('text/html')%>. Also, you can pass any currently available template variable to the function using: <%CGI::header ($variable)%> Multiple arguments may be passed by comma separating the arguments, as in: <%Mypackage::mysub($age, 'Title')%> If a function returns a hash reference, those values will be added to the current substitution set. Suppose you have a function: package Mypackage; sub load_globals { .. return { age => 15, color => red }; } You could then do: <%Mypackage::load_globals%> You are <%age%> years old, with <%color%> hair! Functions are loaded while parsing, so calling the function with different arguments (to set your variables to different values) is possible. Since package names can make functions rather long and ugly, you can call -Eparse() with an "alias" key in the options hash. This key should contain shortcut => function pairs. For example, if you want to call Foo::Bar::blah() in your template, you could pass: asdf => 'Foo::Bar::blah', and when <%asdf%> or <%asdf(...)%> is encountered, Foo::Bar::blah will be called. =item Comparisons with Functions You can combine use a function for an if/elseif statement I, as in: <%if age == My::years_old%> You are the same age as me! <%endif%> which would call My::years_old() and compare the return value to the value of the "age" variable. =item Sets with Functions You may use a function call as the I of a "set" instruction to set a template variable based on the return value of the function. The following code will set a variable named "age" to the return value of Mypackage::age(): <%set age = Mypackage::age%> Arguments passed are the same as the arguments to a regular function. =back =head2 Parse Options The third argument to parse is an optional hash of options. Valid options include: =over 4 =item root => path This sets the path to where the template files are. =item string => $template Passing in string => $template will use $template as your template to parse, rather then load from a file. =item print => 0 If set to 1, this will print the template to the currently selected filehandle (STDOUT), and returns 1. If set to 0 (default), returns parsed tempalte. =item compress => 0 Setting compress => 1 will compress all white space generated by the program. This is great for HTML, but shouldn't be used for text templates. =item strict => 0 If set to 0, any template errors will not be displayed. The default is 1. This means if you have a tag <%mytag%> and mytag is not in your list of variables, with strict on, it will get replaced with an Unknown tag error, with strict off it will get replaced with an empty string. =item escape => 0 This will HTML escape all variables before they are printed. Scalar references will be dereferenced and B escaped. =back The forth option to parse is an optional hash of aliases to set up for functions. The key should be the function call to alias and the value should be the function aliased. For example: print GT::Template->parse( 'file.htm', { key => 'value' }, { compress => 1 }, { myfunc => 'Long::Package::Name::To::myfunc' } ); Now in your template you can do: <%myfunc('argument')%> Which will call C. =head1 EXAMPLES Some examples to get you going: # Parse a string in $template and replace <%key%> with 'value'. print GT::Template->parse('stringname', { key => 'value' }, { string => $template }); # Compress output of template, print it as it is parsed, not after entirely parsed. GT::Template->parse_print('file.txt', { key => 'value' }, { compress => 1 }); # Don't display warnings on invalid keys. print GT::Template->parse('file.txt', { key => 'value' }, { strict => 0 }); # Create a template object using custom settings. my $obj = new GT::Template({ root => '/path/to/templates', compress => 0, strict => 0, begin => ' '!>' }); my $replace = { a => 'b', c => 'd', e => 'f' }; $obj->parse_print('file2.txt', $replace); =head1 COPYRIGHT Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved. http://www.gossamer-threads.com/ =head1 VERSION Revision: $Id: Template.pm,v 2.109 2004/05/05 00:57:47 jagerman Exp $ =cut