| Current File : //var/wcp4/hkaw/public_html/file/private/lib/GT/Template.pm |
# ====================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
# GT::Template
# Author: Jason Rhinelander
# $Id: Template.pm,v 2.78 2002/05/25 06:47:32 jagerman Exp $
#
# Copyright (c) 1999,2000 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.78 $ =~ /(\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 };
$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: <blockquote>%s</blockquote>",
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};
if (exists $opt->{string}) {
$self->debug("Parsing string '$opt->{string}' with (print => $opt->{print}, compress => $opt->{compress}, strict => $opt->{strict}, escape => $opt->{escape})") 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}, compress => $opt->{compress}, strict => $opt->{strict}, escape => $opt->{escape})") 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 ((index ($file, '/') == 0) or (index ($file, ':') == 1)) {
$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 (! $compiled) {
$self->debug("Could not compile template '$full_file'. Errors: \$\@: $@, \$!: $!") if $self->{_debug};
}
}
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: foreach 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") {
$reload = 1;
}
elsif (-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;
{ # Treat this like a string compilation
local ($@, $^W);
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;
$self->{ALIAS} ||= {};
ref $_[0] ? ($p = shift) : ($p = {@_});
while ($p) {
if (ref $p eq 'HASH' or UNIVERSAL::isa($p, 'GT::Config')) { # A GT::Config module (or subclass) is a tied hash.
foreach (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;
$self->{VARS} ||= {};
ref $_[0] ? ($p = shift) : ($p = {@_});
while ($p) {
if (ref $p eq 'HASH' or UNIVERSAL::isa($p, 'GT::Config')) { # A GT::Config module (or subclass) is a tied hash.
foreach (keys %$p) { $self->{VARS}->{$_} = $p->{$_}; }
}
elsif ((ref $p eq 'GT::CGI') or (ref $p eq 'CGI')) {
foreach ($p->param) { $self->{VARS}->{$_} = $p->param($_); }
}
$p = shift;
}
}
sub clear_vars {
# ---------------------------------------------------------------
# Clears the namespace.
#
$_[0]->{VARS} = {};
$_[0]->debug ("Clearing internal variables.") if ($_[0]->{_debug});
}
sub tags {
# ---------------------------------------------------------------
# This should only be called from functions that are called. $VARS is a
# localized global consisting of the current parser's $self->{VARS}.
#
return $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";
foreach my $key (sort keys %$tags) {
my $val = $tags->{$key};
$val = $$val if ref $val eq 'SCALAR';
$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~<table border=1 cellpadding=3 cellspacing=0><tr><td colspan=2><$font><b>Available Variables</b></font></td></tr>~;
foreach my $key (sort keys %$tags) {
my $val = $tags->{$key};
$val = $$val if ref $val eq 'SCALAR';
$val = GT::Dumper::Dumper($val) if ref $val;
$val = GT::CGI::html_escape($val);
local $^W;
$val =~ s/\n/<BR>\n/g;
$val =~ s/ / /g;
$output .= qq~<tr><td valign="top"><$font>$key</font></td><td valign="top"><font face="Courier,fixedsys">$val</font></td></tr>~;
}
$output .= qq~</table>~;
}
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 ((index ($template, '/') == 0) or (index ($template, ':') == 1)) {
$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);
if ($self->{opt}->{print} == 2) {
$code = $FILE_CACHE_PRINT{$full_file}->{code};
$dont_save = $FILE_CACHE_PRINT{$full_file}->{dont_save};
}
else {
$code = $FILE_CACHE{$full_file}->{code};
$dont_save = $FILE_CACHE{$full_file}->{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 = length $$output if $self->{_debug};
$self->_compress($output);
my $post_size = length $$output if $self->{_debug};
$self->debug(sprintf "Output size before/after compression: %d/%d. That's a reduction of %.1f%%.", $pre_size, $post_size, (1 - $post_size / $pre_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.
# Generated: $localtime
# Editor: vim:syn=perl
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)
);
local ($@, $^W);
eval "sub GT::Template::parsed_template { $$eval }";
my $code;
$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 = 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) = "");
}
}
elsif (ref $self->{VARS}->{$torun} eq 'CODE') {
$code = $self->{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(",<br>\n", @err)) : '';
}
else {
$ret = $self->{opt}->{strict} ? \sprintf($ERRORS->{NOTCODEREF}, $torun) : '';
}
$ret = '' if not defined $ret;
$ret = ref $ret eq 'SCALAR' ? $$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 =~ /<(?:pre|textarea)/i) {
$$text .= "<pre></pre>";
$$text =~ s(\G(.*?)(<(?:pre|textarea).*?</(?:pre|textarea)>))(
my $html = $1;
my $pre = $2 || '';
$html =~ s,[\r\n]+,\n,sg;
$html =~ s,\s+\n,\n,sg;
$html =~ s,\n\s+<,\n<,sg;
$html =~ s,\n\s+,\n ,sg;
$html =~ s,>\n\s*<,> <,sg;
$html =~ s,\s+>,>,sg;
$html =~ s,<\s+,<,sg;
$html . $pre;
)iesg;
substr($$text, -11) = '';
}
else {
$$text =~ s,[\r\n]+,\n,sg;
$$text =~ s,\s+\n,\n,sg;
$$text =~ s,\n\s+<,\n<,sg;
$$text =~ s,\n\s+,\n ,sg;
$$text =~ s,>\n\s*<,> <,sg;
$$text =~ s,\s+>,>,sg;
$$text =~ s,<\s+,<,sg;
}
return $text;
}
END_OF_SUB
sub _get_var {
# ---------------------------------------------------------------
# Basically a softer version of _get_value that returns the string
# value of _get_value - so if it's a hash, it adds the variables
# to the current tags, and returns undef.
# It takes 3 args - the "thing" to check, escape, and strict.
# If this returns undef, nothing is printed.
#
my ($self, $str, $escape, $strict) = @_;
my ($ret, $good) = ('', 1);
if (ref($str) eq 'HASH') {
$ret = $str;
}
elsif (exists $self->{VARS}->{$str}) {
if (ref $self->{VARS}->{$str} eq 'CODE') {
if ($self->{opt}->{heap}) {
$ret = $self->{VARS}->{$str}->($self->{VARS}, $self->{opt}->{heap});
}
else {
$ret = $self->{VARS}->{$str}->($self->{VARS});
}
$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});
}
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';
return $ret if not $escape;
$ret =~ s/&/&/g;
$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 (ref $self->{VARS}->{$str} eq 'CODE') {
my $ret;
if ($self->{opt}->{heap}) {
$ret = $self->{VARS}->{$str}->($self->{VARS}, $self->{opt}->{heap});
}
else {
$ret = $self->{VARS}->{$str}->($self->{VARS});
}
$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, includes
and more.
=head2 Template Syntax
The template parser replaces tags with content. By default a tag is
anything enclosed between <% and %>. These can be changed by specifying
the $tpl->begin and $tpl->end 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 get 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 includes.
If you have a header.htm that gets included, you can do:
<%set Title = 'Login'%>
<%include header.htm%>
and then in your header.htm:
<html>
<head>
<title><%Title%>
</title>
</head>
</html>
So that you can have different titles, but always the same header file.
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 <%name%><%name%> 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 'print' 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
x= - Multiplies a string
^= - Raise a variable to a power
=item Conditionals
You can use conditionals if, ifnot (or unless), elseif, and else 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 'elsif' instead of 'elseif' (drop the 'e').
All conditionals must be ended with an "endif" tag, although may contain elseif
or else conditionals between the "if" and "endif" tags.
Nested conditionals are fully supported:
<%if age%>
You are <%age%> years old
<%if sex%>
and you are <%sex%>
<%endif%>
<%endif%>
=item Comparison
Inside conditionals you can use <, >, <=, >=, ==, !=, lt, gt, le, ge, eq, ne, and like. So you can do:
<%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. You can avoid this by using quotes around the right hand value.
The left hand side must always be a variable. lt, gt, le, ge, eq, and ne are the
alphabetical equivelants of <, >, <=, >=, ==, and !=, respectively. 'like' will
be true if the variable contains the right hand side.
=item Boolean
If statements (as well as elseif statements) may contain multiple conditions using
one of the two booleans: 'or' or 'and'. 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 not possible to mix both 'or' and 'and' in one
complex if statement - you may, however, use the same boolean multiple times in
one statement. (Brackets) are also not supported.
Internally, loops 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 and, except with and 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 that is true if this is the first row, false otherwise.
<%last%> - boolean that is true if this is the last row, false otherwise.
<%inner%> - boolean that is true if this is not first and not last.
<%even%> - boolean is true if row_num is even.
<%odd%> - boolean is true if row_num is odd.
You could use even and odd tags to produce alternating colors like:
<%loop results%>
<tr><td bgcolor="<%if even%>white<%else%>silver<%endif%>">..</td></tr>
<%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%>
=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
-E<gt>parse() 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 Booleans with Functions
You can combine boolean if statements with functions, 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. Functions can also be called inside elsif statements.
=item Sets with Functions
Since it is often useful to combine the features of Set and Function calls,
there is a combination form that can be used. 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<not> 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<Long::Package::Name::To::myfunc>.
=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 => '<!',
end => '!>'
});
my $replace = {
a => 'b',
c => 'd',
e => 'f'
};
$obj->parse_print('file2.txt', $replace);
=head1 COPYRIGHT
Copyright (c) 2000 Gossamer Threads Inc. All Rights Reserved.
http://www.gossamer-threads.com/
=head1 VERSION
Revision: $Id: Template.pm,v 2.78 2002/05/25 06:47:32 jagerman Exp $
=cut