From c249ad423004477adfc2720d42ecd3f7c2e2dae7 Mon Sep 17 00:00:00 2001 From: vitalif Date: Mon, 13 Oct 2014 22:37:29 +0000 Subject: [PATCH] Compile to hashref with subs, add theoretically working base file --- VMXTemplate.pm | 474 +++++++++++++++++++++++++++++++++++++++- VMXTemplate/Compiler.pm | 44 ++-- VMXTemplate/Options.pm | 9 +- VMXTemplate/Utils.pm | 34 ++- template.yp | 10 +- 5 files changed, 534 insertions(+), 37 deletions(-) diff --git a/VMXTemplate.pm b/VMXTemplate.pm index 299da1a..a638c4e 100644 --- a/VMXTemplate.pm +++ b/VMXTemplate.pm @@ -1,9 +1,41 @@ #!/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-2014 +# Version: V3 (LALR), 2014-10-14 + +# 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; -# Version of code classes, saved into compiled files use strict; +use Digest::MD5 qw(md5_hex); +use POSIX; + +use VMXTemplate::Options; +use VMXTemplate::Compiler; + +# Version of code classes, saved into compiled files use constant CODE_VERSION => 4; sub new @@ -13,14 +45,448 @@ sub new my ($options) = @_; my $self = bless { + options => VMXTemplate::Options->new($options), tpldata => {}, - failed => {}, - function_search_path => {}, - options => new VMXTemplate::Options($options), 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, '_main', $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], '_main', $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) +# 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} = []; + } + # Load code + if ($filename) + { + $filename = $self->{root}.$filename if $filename !~ m!^/!so; + unless ($text = $self->loadfile($filename)) + { + $self->{options}->error("couldn't load template file '$filename'"); + return $is_outer ? $self->{options}->get_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}; + # a template function is just a constant if not a coderef + if (ref $str eq 'CODE') + { + local $self->{tpldata} = $vars if $vars; + $str = eval { &$str($self) }; + if ($@) + { + $self->{options}->error("error running '".($filename || 'inline template').'::'."$function': $@"); + 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"); +} + +# Load file +# $textref = $obj->loadfile($file) +sub loadfile +{ + my $self = shift; + my ($fn) = @_; + my $load = 0; + my $mtime; + if (!$self->{ltimes}->{$fn} || $self->{reload} && + $self->{ltimes}->{$fn}+$self->{reload} < time) + { + $mtime = [ stat $fn ] -> [ 9 ]; + $load = 1 if !$self->{ltimes}->{$fn} || $mtime > $self->{mtimes}->{$fn}; + } + if ($load) + { + # reload if file has changed + my ($fd, $text); + if (open $fd, "<", $fn) + { + local $/ = undef; + $text = <$fd>; + close $fd; + } + else + { + return undef; + } + # delete old compiled code + $self->{mtimes}->{$fn} = $mtime; + $self->{ltimes}->{$fn} = time; + return $text; + } + return undef; +} + +# 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); + if (!$force_reload && (my $res = $self->{compiled_code}->{$key})) + { + return ($res, $key); + } + + # 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 && !$force_reload) + { + 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 + { + return $r; + } + } + } + + Encode::_utf8_on($code) if $self->{options}->{use_utf8}; + + # call Compiler + $self->{options}->{input_filename} = $fn; + $self->{compiler} ||= VMXTemplate::Compiler->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->error("error compiling '$fn': [$@] in CODE:\n$code"); + return (); + } + + 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 + + + + + + + +

Welcome to my simple OLAP. Select data source:

+
+ + +
+ +

Test mode.

+ + + +=head1 Template syntax + +=head2 Markers + +=over + +=item "": 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 + +=item ...code... + +Loop. {item_index} is the loop counter inside 'FOR item =' loop. + +=item ...code... + +=item ...code... + +=item ...code... + +=item + +=item + +=item ...code... + +=item + +=item ...code... + +=back + +=head1 Functions + +=head2 Numeric and logical + +=head2 String + +=head2 Arrays and hashes + +=head2 Misc + +=head2 Template inclusion + +=cut diff --git a/VMXTemplate/Compiler.pm b/VMXTemplate/Compiler.pm index d7f36aa..4e693c9 100644 --- a/VMXTemplate/Compiler.pm +++ b/VMXTemplate/Compiler.pm @@ -25,8 +25,8 @@ sub compile $self->{lexer} ||= VMXTemplate::Lexer->new($self->{options}); $self->{lexer}->set_code($text); $self->{functions} = { - main => { - name => 'main', + ':main' => { + name => ':main', args => [], body => '', line => 0, @@ -34,14 +34,14 @@ sub compile }, }; $self->YYParse(yylex => \&_Lexer, yyerror => \&_error); - if (!$self->{functions}->{main}->{body}) + if (!$self->{functions}->{':main'}->{body}) { # Parse error? - delete $self->{functions}->{main}; + delete $self->{functions}->{':main'}; } - return "use strict;\nuse VMXTemplate::Utils;\n". - "our \$FUNCTIONS = { ".join(", ", map { "$_ => 1" } keys %{$self->{functions}})." };\n". - join("\n", map { $_->{body} } values %{$self->{functions}}) + return ($self->{options}->{use_utf8} ? "use utf8;\n" : ""). + "{\n':version' => ".VMXTemplate->CODE_VERSION.",\n". + join(",\n", map { "'$_->{name}' => $_->{body}" } values %{$self->{functions}})."};\n"; } # Function aliases @@ -310,9 +310,9 @@ sub function_sql_quote { "sql_quote($_[1])" } # escape characters special to regular expressions sub function_requote { "requote($_[1])" } # encode URL parameter -sub function_urlencode { shift; "URI::Escape::uri_escape(".join(",",@_).")" } +sub function_urlencode { "urlencode($_[1])" } # decode URL parameter -sub function_urldecode { shift; "URI::Escape::uri_unescape(".join(",",@_).")" } +sub function_urldecode { "urldecode($_[1])" } # replace regexp: replace(, , ) sub function_replace { "regex_replace($_[1], $_[2], $_[3])" } # replace substrings @@ -404,7 +404,7 @@ sub function_push { shift; "push(\@{".shift(@_)."}, ".join(",", @_).") # explicitly ignore expression result (like void() in javascript) sub function_void { "scalar(($_[1]), '')" } # dump variable -sub function_dump { shift; "exec_dump(" . join(",", @_) . ")" } +sub function_dump { shift; "var_dump(" . join(",", @_) . ")" } # encode into JSON sub function_json { "encode_json($_[1])" } # return the value as is, to ignore automatic escaping of "unsafe" HTML @@ -415,13 +415,13 @@ sub function_call my $self = shift; my $obj = shift; my $method = shift; - return "map({ ($obj)->\$_(".join(",", @_).") } $method)"; + return "[ map { scalar ($obj)->\$_(".join(",", @_).") } $method ]->[0]"; } # call object method using variable name and array arguments sub function_call_array { my ($self, $obj, $method, $args) = @_; - return "map({ ($obj)->\$_(\@\{$args}) } $method)"; + return "[ map { scalar ($obj)->\$_(\@\{$args}) } $method ]->[0]"; } # apply the function to each array element @@ -449,9 +449,9 @@ sub function_parse { my $self = shift; my $file = shift; - die VMXTemplate::Exception->new("include() requires at least 1 parameter") if !$file; + $self->{lexer}->warn("include() requires at least 1 parameter"), return "''" if !$file; my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : ''); - return "\$self->{template}->parse_real($file, undef, 'main', $args)"; + return "\$self->parse_real($file, undef, ':main', $args)"; } # Run block from current template: exec('block'[, ]) @@ -459,9 +459,9 @@ sub function_exec { my $self = shift; my $block = shift; - die VMXTemplate::Exception->new("exec() requires at least 1 parameters") if !$block; + $self->{lexer}->warn("exec() requires at least 1 parameters"), return "''" if !$block; my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : ''); - return "\$self->{template}->parse_real(\$FILENAME, undef, $block, $args)"; + return "\$self->parse_real(\$FILENAME, undef, $block, $args)"; } # Run block from another template: exec_from('file.tpl', 'block'[, args]) @@ -470,9 +470,9 @@ sub function_exec_from my $self = shift; my $file = shift; my $block = shift; - die VMXTemplate::Exception->new("exec_from() requires at least 2 parameters") if !$file || !$block; + $self->{lexer}->warn("exec_from() requires at least 2 parameters"), return "''" if !$file || !$block; my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : ''); - return "\$self->{template}->parse_real($file, undef, $block, $args)"; + return "\$self->parse_real($file, undef, $block, $args)"; } # (Not recommended, but possible) @@ -481,9 +481,9 @@ sub function_parse_inline { my $self = shift; my $code = shift; - die VMXTemplate::Exception->new("parse_inline() requires at least 1 parameter") if !$code; + $self->{lexer}->warn("parse_inline() requires at least 1 parameter"), return "''" if !$code; my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : ''); - return "\$self->{template}->parse_real(undef, $code, 'main', $args)"; + return "\$self->parse_real(undef, $code, ':main', $args)"; } # (Highly not recommended, but still possible) @@ -493,9 +493,9 @@ sub function_exec_from_inline my $self = shift; my $code = shift; my $block = shift; - die VMXTemplate::Exception->new("exec_from_inline() requires at least 2 parameters") if !$code || !$block; + $self->{lexer}->warn("exec_from_inline() requires at least 2 parameters"), return "''" if !$code || !$block; my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : ''); - return "\$self->{template}->parse_real(undef, $code, $block, $args)"; + return "\$self->parse_real(undef, $code, $block, $args)"; } 1; diff --git a/VMXTemplate/Options.pm b/VMXTemplate/Options.pm index c3fb0b3..fced8e1 100644 --- a/VMXTemplate/Options.pm +++ b/VMXTemplate/Options.pm @@ -20,15 +20,16 @@ sub new eat_code_line => 1, # remove the "extra" lines which contain instructions only root => '.', # directory with templates cache_dir => undef, # compiled templates cache directory - reload => 1, # 0 means to not check for new versions of cached templates + reload => 2, # 0 means to not check for new versions of cached templates + # > 0 - check at most each seconds filters => [], # filters to run on output of every template - use_utf8 => 1, # use UTF-8 for all string operations on template variables + use_utf8 => 1, # templates are in UTF-8 and all template variables should be in UTF-8 raise_error => 0, # die() on fatal template errors log_error => 0, # send errors to standard error output print_error => 0, # print fatal template errors strip_space => 0, # strip spaces from beginning and end of each line - auto_escape => undef, # "safe mode" (use 's' for HTML) - automatically escapes substituted - # values via this functions if not escaped explicitly + auto_escape => undef, # "safe mode" function name (use 's' for HTML) - automatically escapes substituted + # values via this function if not escaped explicitly compiletime_functions => {},# custom compile-time functions (code generators) input_filename => '', diff --git a/VMXTemplate/Utils.pm b/VMXTemplate/Utils.pm index f809168..3c38bff 100644 --- a/VMXTemplate/Utils.pm +++ b/VMXTemplate/Utils.pm @@ -3,15 +3,16 @@ package VMXTemplate::Utils; use strict; +use utf8; use Encode; use base qw(Exporter); our @EXPORT = qw( TS_UNIX TS_DB TS_DB_DATE TS_MW TS_EXIF TS_ORACLE TS_ISO_8601 TS_RFC822 - timestamp plural_ru strlimit htmlspecialchars strip_tags strip_unsafe_tags + timestamp plural_ru strlimit htmlspecialchars urlencode urldecode strip_tags strip_unsafe_tags addcslashes requote quotequote sql_quote regex_replace str_replace array_slice array_div encode_json trim html_pbr array_items utf8on - exec_subst exec_pairs exec_is_array exec_get exec_cmp + exec_subst exec_pairs exec_is_array exec_get exec_cmp var_dump ); use constant { @@ -157,6 +158,25 @@ sub htmlspecialchars return $_; } +# URL-encode +sub urlencode +{ + my ($param) = @_; + utf8::encode($param) if utf8::is_utf8($param); + $param =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; + return $param; +} + +# URL-decode +sub urldecode +{ + my ($param) = @_; + $param =~ tr/+/ /; + $param =~ s/%([0-9a-fA-F]{2})/pack("C",hex($1))/ge; + utf8::decode($param); # try to decode it + return $param; +} + # Replace (some) tags with whitespace sub strip_tags { @@ -343,6 +363,16 @@ sub exec_cmp return $n ? $a <=> $b : $a cmp $b; } +# Data::Dumper +sub var_dump +{ + require Data::Dumper; + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Varname = ''; + local $Data::Dumper::Sortkeys = 1; + return scalar Data::Dumper::Dumper(@_); +} + package VMXTemplate::Exception; use overload '' => sub { $_[0]->{message} }; diff --git a/template.yp b/template.yp index 98a48d6..0fe4bd0 100644 --- a/template.yp +++ b/template.yp @@ -72,7 +72,7 @@ %% template: chunks { - $_[0]->{functions}->{main}->{body} = "sub fn_main {\nmy \$self = shift;\nmy \$stack = [];\nmy \$t = '';\n".$_[1]."\nreturn \$t;\n}\n"; + $_[0]->{functions}->{main}->{body} = "sub {\nmy \$self = shift;\nmy \$stack = [];\nmy \$t = '';\n".$_[1]."\nreturn \$t;\n}\n"; ''; } ; @@ -138,16 +138,16 @@ fn_def: fn name '(' arglist ')' { args => $_[4], line => $_[0]->{lexer}->line, pos => $_[0]->{lexer}->pos, - body => 'sub fn_'.$_[2], + body => '', }; } ; c_fn: fn_def '=' exp { - $_[1]->{body} .= " {\nmy \$self = shift;\nreturn ".$_[3].";\n}\n"; + $_[1]->{body} = "sub {\nmy \$self = shift;\nreturn ".$_[3].";\n}\n"; ''; } | fn_def '-->' chunks '