'.
'VMXTemplate errors:
- '.
join('
- ', map \&html_pbr, @{$self->{errors}}).
'
';
}
return '';
}
# Log an error or a warning
sub error
{
my ($self, $e, $fatal) = @_;
push @{$self->{errors}}, $e;
if ($self->{raise_error} && $fatal)
{
die "VMXTemplate error: $e";
}
if ($self->{log_error})
{
print STDERR "VMXTemplate error: $e";
}
}
package VMXTemplate;
# 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 {
tpldata => {},
failed => {},
function_search_path => {},
options => new VMXTemplate::Options($options),
compiler => undef,
}, $class;
return $self;
}
package VMXTemplate::Compiler;
# Function aliases
my $functions = {
'i' => 'int',
'intval' => 'int',
'lower' => 'lc',
'lowercase' => 'lc',
'upper' => 'uc',
'uppercase' => 'uc',
'addslashes' => 'quote',
'q' => 'quote',
're_quote' => 'requote',
'preg_quote' => 'requote',
'uri_escape' => 'urlencode',
'uriquote' => 'urlencode',
'substring' => 'substr',
'htmlspecialchars' => 'html',
's' => 'html',
'strip_tags' => 'strip',
't' => 'strip',
'h' => 'strip_unsafe',
'sq' => 'sql_quote',
'implode' => 'join',
'truncate' => 'strlimit',
'hash_keys' => 'keys',
'array_keys' => 'keys',
'array_slice' => 'subarray',
'hget' => 'get',
'aget' => 'get',
'var_dump' => 'dump',
'process' => 'parse',
'include' => 'parse',
'process_inline' => 'parse_inline',
'include_inline' => 'parse_inline',
'subarray' => 'array_slice',
'subarray_divmod' => 'array_div',
};
# Functions that do escape HTML, for safe mode
use constant Q_ALWAYS => -1;
use constant Q_IF_ALL => -2;
use constant Q_ALL_BUT_FIRST => -3;
use constant Q_ALWAYS_NUM => -4;
my $functionSafeness = {
'int' => Q_ALWAYS_NUM,
'raw' => Q_ALWAYS,
'html' => Q_ALWAYS,
'strip' => Q_ALWAYS,
'strip_unsafe' => Q_ALWAYS,
'parse' => Q_ALWAYS,
'parse_inline' => Q_ALWAYS,
'exec' => Q_ALWAYS,
'exec_from' => Q_ALWAYS,
'exec_from_inline' => Q_ALWAYS,
'quote' => Q_ALWAYS,
'sql_quote' => Q_ALWAYS,
'requote' => Q_ALWAYS,
'urlencode' => Q_ALWAYS,
'and' => Q_ALWAYS,
'or' => Q_IF_ALL,
'not' => Q_ALWAYS_NUM,
'add' => Q_ALWAYS_NUM,
'sub' => Q_ALWAYS_NUM,
'mul' => Q_ALWAYS_NUM,
'div' => Q_ALWAYS_NUM,
'mod' => Q_ALWAYS_NUM,
'log' => Q_ALWAYS_NUM,
'even' => Q_ALWAYS_NUM,
'odd' => Q_ALWAYS_NUM,
'eq' => Q_ALWAYS_NUM,
'ne' => Q_ALWAYS_NUM,
'gt' => Q_ALWAYS_NUM,
'lt' => Q_ALWAYS_NUM,
'ge' => Q_ALWAYS_NUM,
'le' => Q_ALWAYS_NUM,
'seq' => Q_ALWAYS_NUM,
'sne' => Q_ALWAYS_NUM,
'sgt' => Q_ALWAYS_NUM,
'slt' => Q_ALWAYS_NUM,
'sge' => Q_ALWAYS_NUM,
'sle' => Q_ALWAYS_NUM,
'neq' => Q_ALWAYS_NUM,
'nne' => Q_ALWAYS_NUM,
'ngt' => Q_ALWAYS_NUM,
'nlt' => Q_ALWAYS_NUM,
'nge' => Q_ALWAYS_NUM,
'nle' => Q_ALWAYS_NUM,
'strlen' => Q_ALWAYS_NUM,
'strftime' => Q_ALWAYS,
'str_replace' => Q_ALL_BUT_FIRST,
'substr' => 1, # parameter number to take safeness from
'trim' => 1,
'split' => 1,
'nl2br' => 1,
'concat' => Q_IF_ALL,
'join' => Q_IF_ALL,
'subst' => Q_IF_ALL,
'strlimit' => 1,
'plural_ru' => Q_ALL_BUT_FIRST,
'hash' => Q_IF_ALL,
'keys' => 1,
'values' => 1,
'sort' => 1,
'pairs' => 1,
'array' => Q_IF_ALL,
'range' => Q_ALWAYS,
'is_array' => Q_ALWAYS_NUM,
'count' => Q_ALWAYS_NUM,
'array_slice' => 1,
'array_div' => 1,
'set' => 2,
'array_merge' => Q_IF_ALL,
'shift' => 1,
'pop' => 1,
'unshift' => Q_ALWAYS,
'push' => Q_ALWAYS,
'void' => Q_ALWAYS,
'json' => Q_ALWAYS,
'map' => Q_ALL_BUT_FIRST,
'yesno' => Q_ALL_BUT_FIRST,
};
# Generate semantic expression for template function call
sub compile_function
{
my $self = shift;
my ($fn, $args) = @_;
$fn = lc $fn;
if ($functions->{$fn})
{
# Function alias
$fn = $functions->{$fn};
}
# Calculate HTML safeness flag
my $q = $functionSafeness->{$fn};
if ($q > 0)
{
$q = exists $args->[$q-1] ? $args->[$q-1]->[1] : 1;
}
elsif ($q == Q_ALWAYS)
{
$q = 1;
}
elsif ($q == Q_ALWAYS_NUM)
{
$q = 'i';
}
else
{
$q = 1;
my $n = scalar @$args;
for (my $i = ($q == Q_ALL_BUT_FIRST ? 1 : 0); $i < $n; $i++)
{
$q = $q && $args->[$i]->[1];
}
}
my $argv = [ map { $_->[0] } @$args ];
my $r;
if ($self->can(my $ffn = "function_$fn"))
{
# Builtin function call using name
$r = $self->$ffn(@$argv);
}
elsif (my $ffn = $self->{options}->{compiletime_functions}->{$fn})
{
# Custom compile-time function call
$r = &$ffn($self, @$argv);
}
else
{
$self->{lexer}->warn("Unknown function: '$fn'");
$r = "''";
}
return [ $r, $q ];
}
# call operator on arguments
sub fmop
{
my $op = shift;
return "((" . join(") $op (", @_) . "))";
}
# call function, expanding all passed arrays
sub fearr
{
my $f = shift;
my $n = shift;
my $self = shift;
my $e = "$f(";
$e .= join(", ", splice(@_, 0, $n)) if $n;
$e .= ", " if $n && @_;
$e .= join(", ", map { "array_items($_)" } @_);
$e .= ")";
return $e;
}
### Function implementations
## Numeric/Logical
# logical
sub function_or { fmop('||', @_) }
sub function_and { fmop('&&', @_) }
sub function_not { "!($_[1])" }
# arithmetic
sub function_add { fmop('+', @_) }
sub function_sub { fmop('-', @_) }
sub function_mul { fmop('*', @_) }
sub function_div { fmop('/', @_) }
sub function_mod { fmop('%', @_) }
# logarithm
sub function_log { "log($_[1])" }
# is the argument even/odd?
sub function_even { "!(($_[1]) & 1)" }
sub function_odd { "(($_[1]) & 1)" }
# cast to integer, throwing away the fractional part
sub function_int { "int($_[1])" }
# type-dependent comparisons: = != > < >= <=
sub function_eq { "(exec_cmp($_[1], $_[2]) == 0)" }
sub function_ne { "(exec_cmp($_[1], $_[2]) != 0)" }
sub function_gt { "(exec_cmp($_[1], $_[2]) > 0)" }
sub function_lt { "(exec_cmp($_[1], $_[2]) < 0)" }
sub function_ge { "(exec_cmp($_[1], $_[2]) >= 0)" }
sub function_le { "(exec_cmp($_[1], $_[2]) <= 0)" }
# string comparisons: = != > < >= <=
sub function_seq { "(($_[1]) eq ($_[2]))" }
sub function_sne { "(($_[1]) ne ($_[2]))" }
sub function_sgt { "(($_[1]) gt ($_[2]))" }
sub function_slt { "(($_[1]) lt ($_[2]))" }
sub function_sge { "(($_[1]) ge ($_[2]))" }
sub function_sle { "(($_[1]) le ($_[2]))" }
# numeric comparisons: = != > < >= <=
sub function_neq { "(($_[1]) == ($_[2]))" }
sub function_nne { "(($_[1]) != ($_[2]))" }
sub function_ngt { "(($_[1]) > ($_[2]))" }
sub function_nlt { "(($_[1]) < ($_[2]))" }
sub function_nge { "(($_[1]) >= ($_[2]))" }
sub function_nle { "(($_[1]) <= ($_[2]))" }
# ternary operator $1 ? $2 : $3
sub function_yesno { "(($_[1]) ? ($_[2]) : ($_[3]))" }
## String
# lowercase, uppercase
sub function_lc { "lc($_[1])" }
sub function_uc { "uc($_[1])" }
# lowercase, uppercase the first letter
sub function_lcfirst { "lcfirst($_[1])" }
sub function_ucfirst { "ucfirst($_[1])" }
# quote ', ", \, \n and \r in C-style, prepending \
sub function_quote { "quotequote($_[1])" }
# quote " in SQL/CSV style (by doubling them)
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(",",@_).")" }
# decode URL parameter
sub function_urldecode { shift; "URI::Escape::uri_unescape(".join(",",@_).")" }
# replace regexp: replace(
, , )
sub function_replace { "regex_replace($_[1], $_[2], $_[3])" }
# replace substrings
sub function_str_replace { "str_replace($_[1], $_[2], $_[3])" }
# character length of string
sub function_strlen { "strlen($_[1])" }
# substring
sub function_substr { shift; "substr(".join(",", @_).")" }
# remove starting and ending whitespace
sub function_trim { shift; "trim($_[0])" }
# splice $2 with regexp $1, optionally maximum to $3 parts
sub function_split { shift; "split(".join(",", @_).")" }
# replace & < > " ' with HTML entities
sub function_html { "htmlspecialchars($_[1])" }
# remove HTML tags
sub function_strip { "strip_tags($_[1])" }
# remove "unsafe" HTML tags
sub function_strip_unsafe { "strip_unsafe_tags($_[1])" }
# replace \n with
sub function_nl2br { "regex_replace(qr/\\n/s, '
', $_[1])" }
# concatenate strings
sub function_concat { fmop('.', @_) }
# join strings with delimiter specified as the first argument; expands all passed arrays
sub function_join { fearr('join', 1, @_) }
# replace $1, $2 etc with passed arguments
sub function_subst { fearr('exec_subst', 1, @_) }
# sprintf
sub function_sprintf { fearr('sprintf', 1, @_) }
# strftime
sub function_strftime
{
my $self = shift;
my ($fmt, $date, $time) = @_;
$date = "($date).' '.($time)" if $time;
$date = "POSIX::strftime($date, localtime(timestamp($date)))";
$date = "utf8on($date)" if $self->{use_utf8};
return $date;
}
# limit $1 with $2 chars on whitespace boundary and add $3 (or '...' by default) if it is longer
sub function_strlimit { shift; "strlimit(".join(",", @_).")" }
# select one of 3 russian plural forms based on first numeric argument: plural_ru($number, $one, $few, $many)
sub function_plural_ru { shift; "plural_ru(".join(",", @_).")" }
## Arrays and hashes
# create a hash
sub function_hash { shift; @_ == 1 ? "{ \@{ $_[0] } }" : "{" . join(",", @_) . "}"; }
# hash keys
sub function_keys { '[ keys(%{'.$_[1].'}) ]'; }
# hash values
sub function_values { '[ values(%{'.$_[1].'}) ]'; }
# sort array
sub function_sort { '[ '.fearr('sort', 0, @_).' ]'; }
# extract [ { key => , value => }, ... ] pairs from first hash argument
sub function_pairs { "exec_pairs($_[1])" }
# create an array
sub function_array { shift; "[" . join(",", @_) . "]"; }
# create a numeric range array
sub function_range { "[ $_[1] .. $_[2] ]" }
# check if the argument is an array
sub function_is_array { "exec_is_array($_[1])" }
# count array (not hash) elements
sub function_count { "(ref($_[1]) && $_[1] =~ /ARRAY/so ? scalar(\@{ $_[1] }) : 0)" }
# extract a contiguous slice of array
sub function_array_slice { shift; "array_slice(" . join(",", @_) . ")"; }
# extract a regular slice of array
sub function_array_div { shift; "array_div(" . join(",", @_) . ")"; }
# get array or hash element using a variable key (i.e. get(iteration.array, rand(5)))
sub function_get { shift; "exec_get(" . join(",", @_) . ")"; }
# same only for hash
sub function_hget { "($_[1])->\{$_[2]}" }
# same only for array
sub function_aget { "($_[1])->\[$_[2]]" }
# set first argument to second (first argument must be an "lvalue")
sub function_set { "scalar(($_[1] = $_[2]), '')" }
# merge arrays into one
sub function_array_merge { shift; '[@{'.join('},@{',@_).'}]' }
# extract first argument of an array
sub function_shift { "shift(\@{$_[1]})"; }
# extract last argument of an array
sub function_pop { "pop(\@{$_[1]})"; }
# insert into beginning of an array
sub function_unshift { shift; "unshift(\@{".shift(@_)."}, ".join(",", @_).")"; }
# insert into end of an array
sub function_push { shift; "push(\@{".shift(@_)."}, ".join(",", @_).")"; }
## Misc
# explicitly ignore expression result (like void() in javascript)
sub function_void { "scalar(($_[1]), '')" }
# dump variable
sub function_dump { shift; "exec_dump(" . join(",", @_) . ")" }
# encode into JSON
sub function_json { "encode_json($_[1])" }
# return the value as is, to ignore automatic escaping of "unsafe" HTML
sub function_raw { $_[1] }
# call object method using variable name and inline arguments
sub function_call
{
my $self = shift;
my $obj = shift;
my $method = shift;
return "map({ ($obj)->\$_(".join(",", @_).") } $method)";
}
# call object method using variable name and array arguments
sub function_call_array
{
my ($self, $obj, $method, $args) = @_;
return "map({ ($obj)->\$_(\@\{$args}) } $method)";
}
# apply the function to each array element
sub function_map
{
my $self = shift;
my $fn = shift;
if ($fn =~ /^[\"\'](\w+)[\"\']$/so)
{
return '(map { '.$self->compile_function($1, '$_').' } (@{'.join('}, @{', @_).'}))';
}
else
{
$self->{lexer}->warn("Non-constant function: unimplemented");
}
}
## Template inclusion
# Include another template: parse('file.tpl'[, ])
# In all inclusion functions may be a hash ref of a list of key+value pairs
# All modifications to (or to current global "template vars") done
# by the included template are preserved after processing it!
sub function_parse
{
my $self = shift;
my $file = shift;
my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : '');
return "\$self->{template}->parse_real($file, undef, 'main', $args)";
}
# Run block from current template: exec('block'[, ])
sub function_exec
{
my $self = shift;
my $block = shift;
my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : '');
return "\$self->{template}->parse_real(\$FILENAME, undef, $block, $args)";
}
# Run block from another template: exec_from('file.tpl', 'block'[, args])
sub function_exec_from
{
my $self = shift;
my $file = shift;
my $block = shift;
my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : '');
return "\$self->{template}->parse_real($file, undef, $block, $args)";
}
# (Not recommended, but possible)
# Parse string as a template: parse('code'[, args])
sub function_parse_inline
{
my $self = shift;
my $code = shift;
my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : '');
return "\$self->{template}->parse_real(undef, $code, 'main', $args)";
}
# (Highly not recommended, but still possible)
# Parse string as a template and run a named block from it: parse('code', 'block'[, args])
sub function_exec_from_inline
{
my $self = shift;
my $code = shift;
my $block = shift;
my $args = @_ > 1 ? "{ ".join(", ", @_)." }" : (@_ ? $_[0] : '');
return "\$self->{template}->parse_real(undef, $code, $block, $args)";
}
1;