1209 lines
44 KiB
Perl
1209 lines
44 KiB
Perl
# ====================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Template
|
|
# Author: Jason Rhinelander
|
|
# CVS Info :
|
|
# $Id: Template.pm,v 2.142 2005/07/05 00:39:40 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2005 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 $PARSER);
|
|
use constants
|
|
MTIME => 9,
|
|
INCLUDE_LIMIT => 15; # You're technically limited to double this number of includes as static and dynamic includes are counted separately.
|
|
|
|
@ISA = qw/GT::Base/;
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 2.142 $ =~ /(\d+)\.(\d+)/;
|
|
$DEBUG = 0;
|
|
$ATTRIBS = {
|
|
func_code => undef,
|
|
heap => undef,
|
|
root => undef,
|
|
strict => 1,
|
|
compress => 0,
|
|
begin => '<%',
|
|
end => '%>',
|
|
escape => 0,
|
|
print => 0,
|
|
stream => 0,
|
|
cache => 1,
|
|
indent => ' ',
|
|
dont_save => 0,
|
|
pkg_chop => 1,
|
|
disable => undef
|
|
};
|
|
$ERRORS = {
|
|
NOTEMPLATE => "No template file was specified.",
|
|
CANTOPEN => "Unable to open template file '%s': %s",
|
|
RENAME => "Unable to rename '%s' to '%s': %s",
|
|
NOTDIR => "Error: '%s' is not a directory",
|
|
CANTRUN => "Unable to run compiled template file '%s': %s",
|
|
CANTRUNSTRING => "Unable to run compiled template code '%s' (from string): %s",
|
|
CANTDIR => "Unable to create compiled template directory '%s': %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': <blockquote>%s</blockquote>",
|
|
NOTCODEREF => "Error: Variable '%s' is not a code reference",
|
|
CANTCALLCODE => "Error: Unable to call '%s': %s",
|
|
COMPILE => "Error: Unable to compile function '%s': %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')",
|
|
DISABLED_FUNC => "Function calls have been disabled",
|
|
DISABLED_FUNCARGS => "Function calls with arguments have been disabled",
|
|
DISABLED_FUNCRE => "Function '%s' has been disabled",
|
|
DISABLED_CODEARGS => "Passing arguments to code reference variables has been disabled",
|
|
DISABLED_ALIASARGS => "Passing arguments to function aliases has been disabled",
|
|
BADINC => "Error: Can't load included file '%s': %s",
|
|
DEEPINC => "Deep recursion in includes, aborting include!"
|
|
};
|
|
|
|
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->fatal(NOTEMPLATE => $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 calls.
|
|
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};
|
|
$self->{disable} = $opt->{disable} if ref $opt->{disable} eq 'HASH';
|
|
|
|
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);
|
|
}
|
|
|
|
if (not defined $self->{root}) {
|
|
require File::Basename;
|
|
$self->{root} = File::Basename::dirname($template);
|
|
$template = File::Basename::basename($template);
|
|
}
|
|
|
|
# Look for a template information file
|
|
my $tplinfo = $self->load_tplinfo($self->{root});
|
|
$self->{tplinfo} = $tplinfo if $tplinfo;
|
|
|
|
# Used to skip file modification checking on repeated dynamic includes:
|
|
delete $self->{skip_mod_check};
|
|
|
|
$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
|
|
|
|
sub load_tplinfo {
|
|
# -----------------------------------------------------------------------------
|
|
# 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).
|
|
my ($self, $root) = @_;
|
|
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->fatal(TPLINFO_CANT_LOAD => $tplinfo_file, "$!");
|
|
$@ and return $self->fatal(TPLINFO_CANT_COMPILE => $tplinfo_file, "$@");
|
|
}
|
|
ref $tplinfo ne 'HASH' and return $self->fatal(TPLINFO_NOT_HASH => $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), set
|
|
# the root and the filename appropriately. We do this so that 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 $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 the
|
|
# cache also make sure the file hasn't changed on disk.
|
|
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 ($files, $version);
|
|
if ($compiled) {
|
|
if ($print and $print == 2) {
|
|
$files = $FILE_CACHE_PRINT{$full_file}->{files} || [];
|
|
$version = $FILE_CACHE_PRINT{$full_file}->{parser_version} || 0;
|
|
}
|
|
else {
|
|
$files = $FILE_CACHE{$full_file}->{files} || [];
|
|
$version = $FILE_CACHE{$full_file}->{parser_version} || 0;
|
|
}
|
|
if ($version == $VERSION) {
|
|
my $reload = 0;
|
|
# Go through the template file list, looking for the final path of each one, then
|
|
# compare path, size, and mtime with the cached value.
|
|
require GT::Template::Inheritance;
|
|
for (@$files) {
|
|
my ($file, $path, $mtime, $size) = @$_;
|
|
if ($file =~ m{^(?:[a-zA-Z]:)?[\\/]}) {
|
|
# An absolute path
|
|
if ((stat $file)[MTIME] != $mtime or -s _ != $size) {
|
|
$self->debug("Recompiling '$full_file' because dependency '$file' has changed") if $self->{_debug};
|
|
$reload = 1; last;
|
|
}
|
|
next;
|
|
}
|
|
my $current = GT::Template::Inheritance->get_path(path => $self->{root}, file => $file);
|
|
if (not defined $current and defined $path) {
|
|
# File does not exist, but did when the cache was created
|
|
$self->debug("Recompiling '$full_file' because dependency '$file' no longer exists") if $self->{_debug};
|
|
$reload = 1; last;
|
|
}
|
|
if (defined $current and not defined $path) {
|
|
$self->debug("Recompiling '$full_file' because previously missing dependency '$file' now exists") if $self->{_debug};
|
|
$reload = 1; last;
|
|
}
|
|
if (defined $current and defined $path) {
|
|
if ($current ne $path) {
|
|
$self->debug("Recompiling '$full_file' because dependency '$file' has moved (now '$current', was '$path')") if $self->{_debug};
|
|
$reload = 1; last;
|
|
}
|
|
if ((stat $current)[MTIME] != $mtime or -s _ != $size) {
|
|
$self->debug("Recompiling '$full_file' because dependency '$file' has changed") if $self->{_debug};
|
|
$reload = 1; last;
|
|
}
|
|
}
|
|
}
|
|
|
|
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->fatal(CANTRUNSTRING => $$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->fatal(CANTDIR => "$self->{root}/compiled", "$!");
|
|
chmod 0777, $self->{root} . "/compiled";
|
|
}
|
|
elsif (not -d _) {
|
|
$self->fatal(NOTDIR => $self->{root} . "/compiled");
|
|
}
|
|
elsif (not -w _) {
|
|
$self->fatal(DIRNOTWRITEABLE => "$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->fatal(CANTRUN => $full_compiled, "\$\@: $@. \$!: $!");
|
|
if ($print and $print == 2) { $FILE_CACHE_PRINT{$full_file} = $data }
|
|
else { $FILE_CACHE{$full_file} = $data }
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
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. $PARSER is a
|
|
# localized reference of the current parser, and is used instead of $self when
|
|
# called as a class method.
|
|
sub vars {
|
|
my $self = shift;
|
|
$self = $PARSER if not ref $self;
|
|
|
|
require GT::Template::Vars;
|
|
tie my %tags, 'GT::Template::Vars', $self;
|
|
|
|
return \%tags;
|
|
}
|
|
|
|
# This is deprecated in favour of ->vars. See GT::Template::Vars.
|
|
sub tags { $PARSER->{VARS} }
|
|
|
|
$COMPILE{dump} = __LINE__ . <<'END_OF_SUB';
|
|
sub dump {
|
|
# -----------------------------------------------------------------------------
|
|
# Dumps the variables, used as a tag <%DUMP%> to display all tags available on
|
|
# the template.
|
|
#
|
|
my %opts = @_;
|
|
my $tags = GT::Template->vars;
|
|
require GT::Dumper;
|
|
my $dumper = GT::Dumper->new(sort => 1, var => '');
|
|
my $output = '';
|
|
if ($opts{-var}) {
|
|
my $value = $tags->{$opts{-var}};
|
|
my $html = not ($opts{-text} or ($opts{-auto} and not $ENV{GATEWAY_INTERFACE}));
|
|
$output .= '<font face="Tahoma,Arial,Helvetica" size="2">' if $html;
|
|
$output .= "Dumped value of '$opts{-var}':\n";
|
|
$output .= '</font>' if $html;
|
|
$output .= '<pre>' if $html;
|
|
$output .= $dumper->dump(data => $value);
|
|
$output .= '</pre>' if $html;
|
|
}
|
|
elsif ($opts{-text} or ($opts{-auto} and not $ENV{GATEWAY_INTERFACE})) {
|
|
$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 = $dumper->dump(data => $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>~;
|
|
for my $key (sort keys %$tags) {
|
|
my $val = $tags->{$key};
|
|
$val = $$val if ref $val eq 'SCALAR' or ref $val eq 'LVALUE';
|
|
$val = $dumper->dump(data => $val) if ref $val;
|
|
$val = GT::CGI::html_escape($val);
|
|
local $^W;
|
|
$val =~ s/ / /g;
|
|
$val =~ s|\n|<br />\n|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 (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, $files) = $parser->parse(
|
|
$file,
|
|
{ root => $self->{root} },
|
|
($print and $print == 2)
|
|
);
|
|
|
|
local *FH;
|
|
my $tmpfile = $full_compiled . "." . time . "." . $$ . "." . int(rand(10000)) . ".tmp";
|
|
open FH, ">$tmpfile" or return $self->fatal(CANTOPEN => $tmpfile, "$!");
|
|
my $localtime = localtime;
|
|
my $file_string = '[' . join(',', map {
|
|
my ($file, $path, $mtime, $size) = @$_;
|
|
for ($file, $path) { s/([\\'])/\\$1/g if defined }
|
|
"['$file'," . (defined $path ? "'$path'" : 'undef') . ",$mtime,$size]"
|
|
} @$files) . ']';
|
|
|
|
(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;
|
|
{
|
|
files => $file_string,
|
|
parser_version => $VERSION,
|
|
code => \\>::Template::parsed_template
|
|
};
|
|
sub GT::Template::parsed_template {
|
|
$$code
|
|
}|;
|
|
close FH;
|
|
unless (rename $tmpfile, $full_compiled) {
|
|
unlink $tmpfile;
|
|
return $self->fatal(RENAME => $tmpfile, $full_compiled, "$!");
|
|
}
|
|
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->fatal(CANTRUNSTRING => "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) = @_;
|
|
my $aliased;
|
|
if (exists $self->{ALIAS}->{$torun}) {
|
|
$torun = $self->{ALIAS}->{$torun};
|
|
$aliased = 1;
|
|
}
|
|
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 $disabled;
|
|
if ($aliased) {
|
|
if ($self->{disable}->{alias_args} and @args) {
|
|
$disabled = $ERRORS->{DISABLED_ALIASARGS};
|
|
}
|
|
}
|
|
elsif ($self->{disable}->{functions}) {
|
|
$disabled = $ERRORS->{DISABLED_FUNC};
|
|
}
|
|
elsif ($self->{disable}->{function_args} and @args) {
|
|
$disabled = $ERRORS->{DISABLED_FUNCARGS};
|
|
}
|
|
elsif ($self->{disable}->{function_restrict} and $torun !~ /$self->{disable}->{function_restrict}/) {
|
|
$disabled = sprintf $ERRORS->{DISABLED_FUNCRE}, $torun;
|
|
}
|
|
|
|
if ($disabled) {
|
|
push @err, $disabled;
|
|
}
|
|
else {
|
|
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') {
|
|
if ($self->{disable}->{coderef_args} and @args) {
|
|
push @err, $ERRORS->{DISABLED_CODEARGS};
|
|
}
|
|
else {
|
|
$code = $self->{VARS}->{$torun};
|
|
$ok = 1;
|
|
}
|
|
}
|
|
elsif ($self->{DELAY_VARS}->{$torun}) {
|
|
if ($self->{disable}->{coderef_args} and @args) {
|
|
push @err, $ERRORS->{DISABLED_CODEARGS};
|
|
}
|
|
else {
|
|
$code = $self->{VARS}->{$torun} = $self->{DELAY_VARS}->{$torun}->{$torun};
|
|
delete $self->{DELAY_VARS}->{$torun};
|
|
$ok = 1;
|
|
}
|
|
}
|
|
|
|
if ($ok) {
|
|
local $PARSER = $self;
|
|
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') {
|
|
my $tags = $self->vars;
|
|
@$tags{keys %$ret} = values %$ret;
|
|
$ret = '';
|
|
}
|
|
}
|
|
elsif ($package) {
|
|
$ret = $self->{opt}->{strict} ? \sprintf($ERRORS->{CANTLOAD}, $package, join(",<br>\n", @err)) : '';
|
|
}
|
|
else {
|
|
if (@err) {
|
|
$ret = $self->{opt}->{strict} ? \sprintf($ERRORS->{CANTCALLCODE}, $torun, join(",<BR>\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 =~ /<pre\b/i or $$text =~ /<textarea\b/i) {
|
|
$$text .= "<pre></pre>";
|
|
$$text =~ s(\G(.*?)(<\s*(pre|textarea)\b.*?<\s*/\3\s*>))(
|
|
my $html = $1;
|
|
my $pre = $2 || '';
|
|
$html =~ s/\s+\n/\n/g;
|
|
$html =~ s/\n\s+</\n</g;
|
|
$html =~ s/\n\s{2,}/\n /g;
|
|
$html =~ s/>\s{2,}</> </g;
|
|
$html =~ s/\s+>/>/g;
|
|
$html =~ s/<\s+/</g;
|
|
$html . $pre;
|
|
)iesg;
|
|
substr($$text, -11) = '';
|
|
}
|
|
else {
|
|
$$text =~ s/\s+\n/\n/g;
|
|
$$text =~ s/\n\s+</\n</g;
|
|
$$text =~ s/\n\s{2,}/\n /g;
|
|
$$text =~ s/>\s{2,}</> </g;
|
|
$$text =~ s/\s+>/>/g;
|
|
$$text =~ s/<\s+/</g;
|
|
}
|
|
return $text;
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub _get_var {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns the string value of a variable. 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->{ALIAS}->{$str}) {
|
|
$ret = $self->_call_func($str);
|
|
}
|
|
elsif (my ($val) = $self->_raw_value($str)) {
|
|
if (ref $val eq 'CODE') {
|
|
local $PARSER = $self;
|
|
$ret = $val->($self->vars, $self->{opt}->{heap} || ());
|
|
|
|
$ret = '' if not defined $ret;
|
|
}
|
|
else {
|
|
$ret = $val;
|
|
$ret = '' if not defined $ret;
|
|
}
|
|
}
|
|
elsif ($str eq 'TIME') {
|
|
return time;
|
|
}
|
|
else {
|
|
$good = 0;
|
|
}
|
|
|
|
if (not $good) {
|
|
return $strict ? sprintf($ERRORS->{UNKNOWNTAG}, $str) : undef;
|
|
}
|
|
if (ref $ret eq 'HASH') {
|
|
my $tags = $self->vars;
|
|
@$tags{keys %$ret} = values %$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;
|
|
$ret =~ s/"/"/g;
|
|
return $ret;
|
|
}
|
|
|
|
sub _raw_value {
|
|
# -----------------------------------------------------------------------------
|
|
# Gets a raw value. If the variable doesn't exist, returns an empty list (or
|
|
# undef, in scalar context).
|
|
#
|
|
my ($self, $key) = @_;
|
|
if (exists $self->{VARS}->{$key} and $self->{DELAY_VARS}->{$key}) {
|
|
$self->{VARS}->{$key} = $self->{DELAY_VARS}->{$key}->{$key};
|
|
delete $self->{DELAY_VARS}->{$key};
|
|
}
|
|
return $self->{VARS}->{$key} if exists $self->{VARS}->{$key};
|
|
return time if $key eq 'TIME';
|
|
|
|
if ($key =~ /^\w+(?:\.\$?\w+)+$/) {
|
|
my $cur = $self->{VARS};
|
|
my @k = split /\./, $key;
|
|
for (my $i = 0; $i < @k; $i++) {
|
|
if ($k[$i] =~ /^\$/) {
|
|
my $val = $self->_get_var(substr($k[$i], 1));
|
|
$val = '' if not defined $val;
|
|
my @pieces = split /\./, $val;
|
|
@pieces = '' if !@pieces;
|
|
splice @k, $i, 1, @pieces;
|
|
$i += @pieces - 1 if @pieces > 1;
|
|
}
|
|
}
|
|
while (@k) {
|
|
# for a.b.c:
|
|
# @k = ('a', 'b', 'c')
|
|
# @i = ('a.b.c', 'a.b', 'a')
|
|
# This is needed because "a.b.c" will look for key "b.c" in hash "a" before key "b"
|
|
my @i = map join('.', @k[0 .. $_]), reverse 1 .. $#k;
|
|
push @i, shift @k;
|
|
|
|
if (ref $cur eq 'ARRAY' and $i[-1] =~ /^\d+$/) {
|
|
return if $i[-1] > $#$cur;
|
|
$cur = $cur->[$i[-1]];
|
|
}
|
|
elsif (!@k and ref $cur eq 'ARRAY' and $i[0] eq 'length') {
|
|
$cur = scalar @$cur;
|
|
}
|
|
elsif (ref $cur eq 'HASH' or UNIVERSAL::isa($cur, 'GT::Config')) {
|
|
my $exists;
|
|
for (0 .. $#i) {
|
|
if (exists $cur->{$i[$_]}) {
|
|
splice @k, 0, $#i-$_ unless $_ == $#i;
|
|
$cur = $cur->{$i[$_]};
|
|
$exists = 1;
|
|
last;
|
|
}
|
|
}
|
|
return unless $exists;
|
|
}
|
|
elsif (UNIVERSAL::isa($cur, 'GT::CGI') and my ($val) = $cur->param($i[0])) {
|
|
$cur = $val;
|
|
last;
|
|
}
|
|
else {
|
|
return;
|
|
}
|
|
}
|
|
|
|
return $cur;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub _include {
|
|
# -----------------------------------------------------------------------------
|
|
# Perform a runtime include of a file.
|
|
#
|
|
my ($self, $template, $allow_path) = @_;
|
|
if ($template eq '.' or $template eq '..' or ($template =~ m{[/\\]} and !$allow_path)) {
|
|
return sprintf $ERRORS->{BADINC}, $template, 'Invalid characters in filename';
|
|
}
|
|
|
|
if (++$self->{include_safety} > GT::Template::INCLUDE_LIMIT) {
|
|
return $ERRORS->{DEEPINC};
|
|
}
|
|
|
|
$self->load_template($template) unless $self->{skip_mod_check}->{$template}++;
|
|
|
|
my $opt = $self->{opt};
|
|
my $print = $self->{print};
|
|
$self->debug("Parsing dynamic include '$template' with (print => @{[$opt->{print}||0]}, compress => @{[$opt->{compress}||0]}, strict => @{[$opt->{strict}||0]}, escape => @{[$opt->{escape}||0]})") if $self->{_debug};
|
|
|
|
my $ret = $self->_parse($template, $opt);
|
|
|
|
--$self->{include_safety};
|
|
|
|
return $ret || '';
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Template - Gossamer Threads template parser
|
|
|
|
=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' });
|
|
|
|
or
|
|
|
|
use GT::Template;
|
|
GT::Template->parse_stream('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 syntax documentation has moved - it is now documented in
|
|
L<GT::Template::Tutorial>.
|
|
|
|
=head2 parse
|
|
|
|
This option parses a template, and returns the value of the parsed template.
|
|
See L</"Parse Options"> for a description of the possible parse parameters.
|
|
|
|
=head2 parse_print
|
|
|
|
This option parses a template, and prints it. See L</"Parse Options"> for a
|
|
description of the possible parse_print parameters.
|
|
|
|
=head2 parse_stream
|
|
|
|
This option parses a template, and prints each part of it as the parse occurs.
|
|
It should only be used in situations where streaming content is required as it
|
|
is measurably slower than the parse_print alternative. See L</"Parse Options">
|
|
for a description of the possible parse_stream parameters.
|
|
|
|
=head2 Parse Options
|
|
|
|
=head3 Filename
|
|
|
|
The first argument to parse()/parse_print()/parse_stream() (hereafter referred
|
|
to simply as parse()) is the full or relative (to the current working
|
|
directory) path to the file to parse.
|
|
|
|
=head3 Variables
|
|
|
|
The second argument is a hash reference of template variables that will be
|
|
available in the parsed template (see L<GT::Template::Tutorial>). Arbitrary
|
|
hash/array data structure access is supported (see
|
|
L<GT::Template::Tutorial/"Advanced variables using references">).
|
|
|
|
Loops are supported by providing an array reference or code reference as a
|
|
value; array reference loops are generally preferred as they enable the loop to
|
|
be used multiple times and support the <%loopvar.length%> syntax.
|
|
|
|
=head3 Options
|
|
|
|
The third argument (which is not required) takes additional options that change
|
|
the way a parse is performed. The available options (there are more, however
|
|
their use is discouraged) are as follows.
|
|
|
|
=over 4
|
|
|
|
=item * string => $template
|
|
|
|
Passing in C<string =E<gt> $template> will use $template as for the template
|
|
content instead of reading the file specified as the first parse() argument.
|
|
If provided, the first argument to parse() (the filename) is ignored.
|
|
|
|
=item * compress => 1
|
|
|
|
Setting compress => 1 will compress all white space generated by the program.
|
|
This is usually acceptable for HTML, reducing page sizes by typically 10-20%,
|
|
but should not be used for non-HTML templates. The default is 0 (no
|
|
compression). This option has no effect when using parse_stream().
|
|
|
|
=item * strict => 0
|
|
|
|
If set to 1, attempting to use a tag that does not exist will display an
|
|
"Unknown tag 'tagname'" error. If strict is set to 0, using an unset tag will
|
|
not display anything.
|
|
|
|
=item * escape => 1
|
|
|
|
If enabled, this option will cause all variables to be HTML escaped before
|
|
being included on a page. Enabling this option is strongly recommended.
|
|
all variables before they are printed. Tag values that should not be escaped
|
|
should be passed as scalar references (\$foo or \'<html>').
|
|
|
|
This option currently defaults to 0, but may eventually change to 1 - so
|
|
passing an explicit 1 or 0 value is strongly recommended.
|
|
|
|
=item * disable => { ... }
|
|
|
|
This can be used to disable certain GT::Template functionality. To disable a
|
|
particular feature, the hash reference passed to disable should contain a
|
|
C<feature_name> with a C<1> value, unless otherwise indicated. Feature names
|
|
are as follows:
|
|
|
|
=over 4
|
|
|
|
=item * functions
|
|
|
|
This can be used to disable Package::function calls, such as
|
|
C<E<lt>%Some::Package::function%E<gt>>. Note, however, that this does _not_
|
|
disable aliased function calls (see below).
|
|
|
|
=item * function_args
|
|
|
|
This disables any function calls that specify arguments - for instance,
|
|
C<E<lt>%Some::Package::function(1)E<gt>>. Note that this does _not_ disable
|
|
passing arguments to aliased function calls (see below).
|
|
|
|
=item * function_restrict
|
|
|
|
This can be used to restrict function calls by limiting the available
|
|
functions. It takes a regular expression as an argument, which will be tested
|
|
against the fully qualified function name - any function that does not match
|
|
the regular expression will not be called. For example, to only allow
|
|
functions in 'Package::One' and 'Second::Package' to be called, you could use:
|
|
|
|
function_restrict => '^(?:Package::One|Second::Package)::\w+$'
|
|
|
|
Like the above options, this does not restrict aliased function calls.
|
|
|
|
=item * coderefs_args
|
|
|
|
This can be specified to disable the calling of code reference variables with
|
|
arguments. Tags such as C<E<lt>%coderefname%E<gt>> and
|
|
C<E<lt>%coderefname()%E<gt>> will be allowed, but C<E<lt>%coderefname(1)%E<gt>>
|
|
will not.
|
|
|
|
=item * alias_args
|
|
|
|
This option can be used to disable the passing of arguments to aliased function
|
|
calls (see below).
|
|
|
|
=back
|
|
|
|
=item * pkg_chop
|
|
|
|
When calling a function such as <%Package::A::B::function%>, GT::Template will
|
|
first attempt to load Package/A/B.pm, then, if it fails, Package/A.pm, and so
|
|
on down to Package.pm, looking for Package::A::B::function in each file. This
|
|
behaviour is slow and often undesirable - it is recommended to properly split
|
|
up packages (that is, putting Package::A::B inside Package/A/B.pm instead of
|
|
Package/A.pm or Package.pm). The "package chopping" occurs if pkg_chop is set
|
|
to 1 (currently the default, but may change), and does not occur if pkg_chop is
|
|
set to 0 (recommended, but not the default for historic reasons).
|
|
|
|
=item * heap
|
|
|
|
If this is set, it will be added to the end of any other arguments passed to
|
|
functions called.
|
|
|
|
=item * func_code
|
|
|
|
When calling a function such as <%Package::function%>, you can override the
|
|
default behaviour of simply calling the function by providing a code reference
|
|
to C<func_code>. Instead of calling Package::function(), your code reference
|
|
will be called with the string of the package to call (e.g.
|
|
'Package::function') and the arguments that would have been passed to the
|
|
function. The return value of your code will be used as if it was the return
|
|
value from the real function.
|
|
|
|
=item * begin
|
|
|
|
=item * end
|
|
|
|
C<begin> and C<end> can be used to change the characters that start and end a
|
|
template tag. These default to C<E<lt>%> for C<begin>, and C<%E<gt>> for
|
|
C<end>. For example, if you changed C<begin> to C<[*> and C<end> to C<*]>, you
|
|
would use C<[*tagname*]> for a normal tag, C<[*-- comment --*]> for a comment,
|
|
etc.
|
|
|
|
=back
|
|
|
|
=head3 Aliases
|
|
|
|
The forth option to parse is an optional hash of aliases to set up for
|
|
functions. The key should be the alias name and the value should be the
|
|
function to call when the alias is invoked. 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>.
|
|
|
|
=head2 vars
|
|
|
|
Accessing variables from outside a template can be done by calling the
|
|
C<GT::Template-E<gt>vars> method. For further details, please see
|
|
L<GT::Template::Vars>.
|
|
|
|
=head1 EXAMPLES
|
|
|
|
Parse the string contained in $template, making the 'key' tag available.
|
|
|
|
my $parsed = GT::Template->parse(undef, { key => 'value' }, { string => $template });
|
|
|
|
Parse file.txt, compress the result, and print it. This is equivelant to
|
|
C<print GT::Template-E<gt>parse(...)>, but slightly faster.
|
|
|
|
GT::Template->parse_print('file.txt', { key => 'value' }, { compress => 1 });
|
|
|
|
Print the output of the template it as it is parsed, not after entirely parsed.
|
|
This will output the same as the above command would without the "compress"
|
|
option, but is slower (unless, of course, streaming is needed).
|
|
|
|
GT::Template->parse_stream('file.txt', { key => 'value' });
|
|
|
|
Don't display warnings on invalid keys:
|
|
|
|
GT::Template->parse_print('file.txt', { key => 'value' }, { strict => 0 });
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<GT::Template::Tutorial> - Documentation/tutorial for GT::Template template
|
|
tags.
|
|
|
|
L<GT::Template::Vars> - Interface for accessing/manipulating template tags from
|
|
Perl code.
|
|
|
|
L<GT::Template::Inheritance> - Documentation for GT::Template template
|
|
inheritance.
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2005 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: Template.pm,v 2.142 2005/07/05 00:39:40 jagerman Exp $
|
|
|
|
=cut
|