saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
fc289f2258
discourse-legacysite-perl/site/glist/lib/GT/Template.pm

1209 lines
44 KiB
Perl
Raw Normal View History

First pass at adding key files
2024-06-17 11:49:12 +00:00
# ====================================================================
# 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 = \&GT::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/ /&nbsp;/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 => \\&GT::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 = \&GT::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/&/&amp;/g;
$ret =~ s/</&lt;/g;
$ret =~ s/>/&gt;/g;
$ret =~ s/"/&quot;/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
Reference in New Issue Copy Permalink