499 lines
12 KiB
Perl
499 lines
12 KiB
Perl
#!/usr/bin/perl
|
||
# Simple, powerful, fast and convenient template engine.
|
||
# This is the Perl version of VMXTemplate. There is also a PHP one.
|
||
#
|
||
# "Ох уж эти перлисты... что ни пишут - всё Template Toolkit получается!"
|
||
# "Oh, those perlists... they could write anything, and a result is another Template Toolkit"
|
||
# Rewritten 3 times: regex -> index() -> recursive descent -> Parse::Yapp LALR(1)
|
||
#
|
||
# Homepage: http://yourcmc.ru/wiki/VMX::Template
|
||
# License: GNU GPLv3 or later
|
||
# Author: Vitaliy Filippov, 2006-2015
|
||
# Version: V3 (LALR), 2015-02-17
|
||
|
||
# This program is free software; you can redistribute it and/or modify
|
||
# it under the terms of the GNU General Public License as published by
|
||
# the Free Software Foundation; either version 3 of the License, or
|
||
# (at your option) any later version.
|
||
#
|
||
# This program is distributed in the hope that it will be useful,
|
||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
# GNU General Public License for more details.
|
||
#
|
||
# You should have received a copy of the GNU General Public License along
|
||
# with this program; if not, write to the Free Software Foundation, Inc.,
|
||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||
# http://www.gnu.org/copyleft/gpl.html
|
||
|
||
package VMXTemplate;
|
||
|
||
use strict;
|
||
use Digest::MD5 qw(md5_hex);
|
||
use POSIX;
|
||
|
||
use VMXTemplate::Utils;
|
||
use VMXTemplate::Options;
|
||
use VMXTemplate::Parser;
|
||
|
||
# Version of code classes, saved into compiled files
|
||
use constant CODE_VERSION => 4;
|
||
|
||
sub new
|
||
{
|
||
my $class = shift;
|
||
$class = ref($class) || $class;
|
||
my ($options) = @_;
|
||
|
||
my $self = bless {
|
||
options => VMXTemplate::Options->new($options),
|
||
tpldata => {},
|
||
compiler => undef,
|
||
|
||
# current function search scope
|
||
function_search_path => undef,
|
||
loaded_templates => undef,
|
||
|
||
# memory cache
|
||
mtimes => {}, # change timestamps
|
||
ltimes => {}, # load timestamps
|
||
compiled_code => {}, # compiled code cache
|
||
}, $class;
|
||
|
||
return $self;
|
||
}
|
||
|
||
# Clear variables
|
||
# $obj->clear()
|
||
sub clear
|
||
{
|
||
my $self;
|
||
$self->{tpldata} = {};
|
||
return 1;
|
||
}
|
||
|
||
# Clear memory cache
|
||
sub clear_memory_cache
|
||
{
|
||
my $self = shift;
|
||
%{$self->{compiled_code}} = ();
|
||
%{$self->{mtimes}} = ();
|
||
%{$self->{ltimes}} = ();
|
||
return $self;
|
||
}
|
||
|
||
# Get/set template data hashref
|
||
sub vars
|
||
{
|
||
my $self = shift;
|
||
my ($vars) = @_;
|
||
my $t = $self->{tpldata};
|
||
$self->{tpldata} = $vars if $vars;
|
||
return $t;
|
||
}
|
||
|
||
# Run template
|
||
# $page = $obj->parse($filename);
|
||
# $page = $obj->parse($filename, $tpldata);
|
||
sub parse
|
||
{
|
||
my ($self, $fn, $vars) = @_;
|
||
return $self->parse_real($fn, undef, undef, $vars);
|
||
}
|
||
|
||
# Call named block/function from a template
|
||
sub exec_from
|
||
{
|
||
my ($self, $filename, $function, $vars) = @_;
|
||
return $self->parse_real($filename, undef, $function, $vars);
|
||
}
|
||
|
||
# Parse string as a template and run it
|
||
# Not recommended, but possible
|
||
sub parse_inline
|
||
{
|
||
my ($self, $code, $vars) = @_;
|
||
return $self->parse_real(undef, $_[1], undef, $vars);
|
||
}
|
||
|
||
# Call function from a string parsed as a template
|
||
# Highly not recommended, but still possible
|
||
sub exec_from_inline
|
||
{
|
||
my ($self, $code, $function, $vars) = @_;
|
||
return $self->parse_real(undef, $code, $function, $vars);
|
||
}
|
||
|
||
# Real parse handler
|
||
# $page = $obj->parse_real(filename, inline code, function, vars)
|
||
# <inline code> means use a string instead of file. Not recommended, but possible.
|
||
sub parse_real
|
||
{
|
||
my $self = shift;
|
||
my ($filename, $text, $function, $vars) = @_;
|
||
# Init function search path for outermost call
|
||
my $is_outer = !$self->{function_search_path};
|
||
$self->{function_search_path} ||= {};
|
||
$self->{loaded_templates} ||= {};
|
||
if ($is_outer)
|
||
{
|
||
$self->{options}->{errors} = [];
|
||
}
|
||
my ($code, $key) = $self->compile($text, $filename);
|
||
if (!$self->{loaded_templates}->{$key})
|
||
{
|
||
# populate function_search_path
|
||
for (keys %$code)
|
||
{
|
||
$self->{function_search_path}->{$_} = [ $filename, $key ] if !/^:/s;
|
||
}
|
||
}
|
||
my $str = $self->_run($code, 0, $function, $filename, $vars);
|
||
if ($is_outer)
|
||
{
|
||
# we can't just print errors to STDOUT in Perl, so return them all with the outer output
|
||
if ($self->{options}->{print_error} && @{$self->{options}->{errors}})
|
||
{
|
||
substr($str, 0, 0, $self->{options}->get_errors . "\n");
|
||
}
|
||
$self->{function_search_path} = undef;
|
||
$self->{loaded_templates} = undef;
|
||
}
|
||
return $str;
|
||
}
|
||
|
||
# Run a function from template object
|
||
sub _run
|
||
{
|
||
my $self = shift;
|
||
my ($code, $is_outer, $function, $filename, $vars) = @_;
|
||
$function ||= ':main';
|
||
my $str = $code->{$function};
|
||
if (!defined $str)
|
||
{
|
||
$self->{options}->error("template function '$function' not found in '".($filename || 'inline template')."'");
|
||
return $is_outer ? $self->{options}->get_errors : '';
|
||
}
|
||
# a template function is just a constant if not a coderef
|
||
elsif (ref $str eq 'CODE')
|
||
{
|
||
local $self->{tpldata} = $vars if $vars;
|
||
$str = eval { &$str($self) };
|
||
if ($@)
|
||
{
|
||
$self->{options}->error("error running function '$function' from '".($filename || 'inline template')."': $@");
|
||
return $is_outer ? $self->{options}->get_errors : '';
|
||
}
|
||
}
|
||
for my $f (@{$self->{options}->{filters}})
|
||
{
|
||
$f = $self->can("filter_$f") if !ref $f;
|
||
$f->($str) if $f;
|
||
}
|
||
return $str;
|
||
}
|
||
|
||
# Call block from current include scope (for internal use in templates)
|
||
sub _call_block
|
||
{
|
||
my ($self, $block, $args, $errorinfo) = @_;
|
||
if (my $entry = $self->{function_search_path}->{$block})
|
||
{
|
||
my $code = $self->{compiled_code}->{$entry->[1]};
|
||
die "BUG: cache is empty in call_block()" if !$code;
|
||
return $self->_run($code, 0, $block, $entry->[0], $args);
|
||
}
|
||
$self->{options}->error("Unknown block '$block'$errorinfo");
|
||
}
|
||
|
||
# Compile code and cache it on disk
|
||
# ($sub, $cache_key) = $self->compile($code, $filename);
|
||
# print &$sub($self);
|
||
sub compile
|
||
{
|
||
my $self = shift;
|
||
my ($code, $fn, $force_reload) = @_;
|
||
Encode::_utf8_off($code); # for md5_hex
|
||
my $key = $fn ? 'F'.$fn : 'C'.md5_hex($code);
|
||
|
||
$force_reload = 1 if !$self->{compiled_code}->{$key};
|
||
$force_reload = 1 if $self->{options}->{disable_cache};
|
||
|
||
# Load code
|
||
my $mtime;
|
||
if ($fn)
|
||
{
|
||
$fn = $self->{options}->{root}.$fn if $fn !~ m!^/!so;
|
||
if (!$force_reload && $self->{options}->{reload} && $self->{ltimes}->{$fn}+$self->{options}->{reload} < time)
|
||
{
|
||
$mtime = [ stat $fn ] -> [ 9 ];
|
||
$force_reload = 1 if $mtime > $self->{mtimes}->{$fn};
|
||
}
|
||
}
|
||
|
||
if (!$force_reload)
|
||
{
|
||
return ($self->{compiled_code}->{$key}, $key);
|
||
}
|
||
|
||
if ($fn)
|
||
{
|
||
# reload if file has changed
|
||
my $fd;
|
||
if (open $fd, "<", $fn)
|
||
{
|
||
local $/ = undef;
|
||
$code = <$fd>;
|
||
close $fd;
|
||
}
|
||
else
|
||
{
|
||
$self->{options}->error("couldn't load template file '$fn': $!");
|
||
return ();
|
||
}
|
||
}
|
||
|
||
# inline code
|
||
if (!$fn)
|
||
{
|
||
my (undef, $f, $l) = caller(1);
|
||
$fn = "(inline template at $f:$l)";
|
||
}
|
||
|
||
# try disk cache
|
||
my $h;
|
||
if ($self->{options}->{cache_dir})
|
||
{
|
||
$h = $self->{options}->{cache_dir}.md5_hex($code).'.pl';
|
||
if (-e $h)
|
||
{
|
||
my $r = $self->{compiled_code}->{$key} = do $h;
|
||
if ($@)
|
||
{
|
||
$self->{options}->error("error compiling '$fn': [ $@ ] in FILE: $h");
|
||
unlink $h;
|
||
}
|
||
elsif (ref $r eq 'CODE' ||
|
||
!$r->{':version'} || $r->{':version'} < CODE_VERSION)
|
||
{
|
||
# we got cache from older version, force recompile
|
||
}
|
||
else
|
||
{
|
||
if ($fn)
|
||
{
|
||
# remember modification and load time
|
||
$self->{mtimes}->{$fn} = $mtime;
|
||
$self->{ltimes}->{$fn} = time;
|
||
}
|
||
return ($r, $key);
|
||
}
|
||
}
|
||
}
|
||
|
||
Encode::_utf8_on($code) if $self->{options}->{use_utf8};
|
||
|
||
# call Compiler
|
||
$self->{options}->{input_filename} = $fn;
|
||
$self->{compiler} ||= VMXTemplate::Parser->new($self->{options});
|
||
$code = $self->{compiler}->compile($code);
|
||
|
||
# write compiled code to file
|
||
if ($h)
|
||
{
|
||
my $fd;
|
||
if (open $fd, ">$h")
|
||
{
|
||
no warnings 'utf8';
|
||
print $fd $code;
|
||
close $fd;
|
||
}
|
||
else
|
||
{
|
||
$self->warning("error caching '$fn': $! while opening $h");
|
||
}
|
||
}
|
||
|
||
# load code
|
||
$self->{compiled_code}->{$key} = eval $code;
|
||
if ($@)
|
||
{
|
||
$self->{options}->error("error compiling '$fn': [$@] in CODE:\n$code");
|
||
return ();
|
||
}
|
||
|
||
if ($fn)
|
||
{
|
||
# remember modification and load time
|
||
$self->{mtimes}->{$fn} = $mtime;
|
||
$self->{ltimes}->{$fn} = time;
|
||
}
|
||
|
||
return ($self->{compiled_code}->{$key}, $key);
|
||
}
|
||
|
||
# built-in strip_space filter
|
||
sub filter_strip_space
|
||
{
|
||
$_[0] =~ s/^[ \t]+//gm;
|
||
$_[0] =~ s/[ \t]+$//gm;
|
||
$_[0] =~ s/\n{2,}/\n/gs;
|
||
}
|
||
|
||
1;
|
||
__END__
|
||
|
||
=head1 VMXTemplate template engine
|
||
|
||
This is a simple, but powerful, fast and convenient template engine.
|
||
You're looking at the Perl implementation; there is also PHP one.
|
||
Both are based on LALR(1) parsers.
|
||
|
||
Full documentation is at http://yourcmc.ru/wiki/VMX::Template
|
||
|
||
=head1 Usage
|
||
|
||
use VMXTemplate;
|
||
|
||
# Keep $template object alive for caching
|
||
# DO NOT recreate it on every request!
|
||
my $template = VMXTemplate->new({
|
||
root => 'templates/',
|
||
cache_dir => 'cache/',
|
||
auto_escape => 's',
|
||
});
|
||
|
||
print $template->parse('site.tpl', {
|
||
# any data passed to template...
|
||
});
|
||
|
||
=head1 Example
|
||
|
||
<!-- SET title = "Statistics" -->
|
||
<!-- SET headscripts -->
|
||
<script language="JavaScript" type="text/javascript" src="{DOMAIN}/tpldata/jquery.min.js"></script>
|
||
<!-- END -->
|
||
<!-- INCLUDE "admin_header.tpl" -->
|
||
<!-- IF NOT srcid -->
|
||
<p>Welcome to my simple OLAP. Select data source:</p>
|
||
<form action="?" method="GET">
|
||
<select style="width:100px" name="datasource">
|
||
<!-- FOR s = sources -->
|
||
<option value="{s s.id}">{s s.name}: {yesno(s.size > 1024, s.size/1024 .. ' Kb' : s.size .. 'bytes')}</option>
|
||
<!-- END -->
|
||
</select>
|
||
<input type="submit" value="Continue" />
|
||
</form>
|
||
<!-- ELSEIF srcid == "test" || sources[srcid].mode == 'test' -->
|
||
<p>Test mode.</p>
|
||
<!-- END -->
|
||
<!-- INCLUDE "admin_footer.tpl" -->
|
||
|
||
=head1 Template syntax
|
||
|
||
=head2 Markers
|
||
|
||
=over
|
||
|
||
=item "<!--" and "-->": directive start/end
|
||
|
||
=item "{" and "}": substitution start/end
|
||
|
||
=back
|
||
|
||
=head2 Expressions
|
||
|
||
Expressions consist of variables, operators, function and method calls.
|
||
|
||
=over
|
||
|
||
=item hash.key, hash['key']
|
||
|
||
=item array[index]
|
||
|
||
=item object.method(arg1, arg2, ...)
|
||
|
||
=item function(arg1, arg2, ...)
|
||
|
||
=item function single_arg
|
||
|
||
For example, INCLUDE "other_template.tpl" is a single argument function call.
|
||
|
||
=item block_name('arg' => 'value', 'arg2' => 'value2', ...)
|
||
|
||
=back
|
||
|
||
=head2 Operators
|
||
|
||
=over
|
||
|
||
=item a .. b
|
||
|
||
String concatenation (.. is like Lua).
|
||
|
||
=item a || b, a OR b
|
||
|
||
Logical OR, Perl- or JS-like: returns first true value.
|
||
|
||
=item a XOR b, a && b, a AND b, !a, NOT a
|
||
|
||
Logical XOR, AND, NOT.
|
||
|
||
=item a == b, a != b, a < b, a > b, a <= b, a >= b
|
||
|
||
Comparison operators. Numeric comparisons are used if, and only if
|
||
VMXTemplate can easily tell that one of a and b is ALWAYS numeric,
|
||
for example if it is a numeric constant or a result of int() function.
|
||
|
||
=item a+b, a-b, a*b, a/b, a%b
|
||
|
||
Arithmetic operators.
|
||
|
||
=item { 'key' => 'value', ... }
|
||
|
||
Creates a hashref.
|
||
|
||
=back
|
||
|
||
=head2 Directives
|
||
|
||
=over
|
||
|
||
=item <!--# Comment -->
|
||
|
||
=item <!-- FOR item = array --> ...code... <!-- END -->
|
||
|
||
Loop. {item_index} is the loop counter inside 'FOR item =' loop.
|
||
|
||
=item <!-- IF expression --> ...code...
|
||
|
||
=item <!-- ELSEIF expression --> ...code...
|
||
|
||
=item <!-- ELSE --> ...code...
|
||
|
||
=item <!-- END -->
|
||
|
||
=item <!-- SET var = expression -->
|
||
|
||
=item <!-- SET var --> ...code... <!-- END -->
|
||
|
||
=item <!-- BLOCK name(arg1, arg2, ...) = expression -->
|
||
|
||
=item <!-- BLOCK name(arg1, arg2, ...) --> ...code... <!-- END -->
|
||
|
||
=back
|
||
|
||
=head1 Functions
|
||
|
||
=head2 Numeric and logical
|
||
|
||
=head2 String
|
||
|
||
=head2 Arrays and hashes
|
||
|
||
=head2 Misc
|
||
|
||
=head2 Template inclusion
|
||
|
||
=cut
|