2007-05-21 03:34:53 +04:00
|
|
|
|
#!/usr/bin/perl
|
2011-01-18 16:26:21 +03:00
|
|
|
|
|
2009-12-09 03:09:56 +03:00
|
|
|
|
# "Ох уж эти перлисты... что ни пишут - всё Template Toolkit получается!"
|
2009-12-27 18:25:19 +03:00
|
|
|
|
# Компилятор переписан уже 2 раза - сначала на regexы, потом на index() :-)
|
|
|
|
|
# А обратная совместимость по синтаксису, как ни странно, до сих пор цела.
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
2010-03-24 03:14:22 +03:00
|
|
|
|
# Homepage: http://yourcmc.ru/wiki/VMX::Template
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# Author: Vitaliy Filippov, 2006-2011
|
2011-01-18 16:26:21 +03:00
|
|
|
|
# $Id$
|
2010-03-24 03:14:22 +03:00
|
|
|
|
|
2007-05-21 03:34:53 +04:00
|
|
|
|
package VMX::Template;
|
|
|
|
|
|
|
|
|
|
use strict;
|
2010-05-24 02:28:44 +04:00
|
|
|
|
use VMX::Common qw(:all uri_escape_hacks);
|
2009-03-13 20:47:24 +03:00
|
|
|
|
use Digest::MD5 qw(md5_hex);
|
2008-08-15 21:31:24 +04:00
|
|
|
|
use Hash::Merge;
|
2009-12-18 15:22:55 +03:00
|
|
|
|
use POSIX;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
2009-01-06 01:39:48 +03:00
|
|
|
|
my $mtimes = {}; # время изменения файлов
|
2011-01-06 03:37:21 +03:00
|
|
|
|
my $ltimes = {}; # время загрузки файлов
|
2009-01-06 01:39:48 +03:00
|
|
|
|
my $uncompiled_code = {}; # нескомпилированный код
|
|
|
|
|
my $compiled_code = {}; # скомпилированный код (sub'ы)
|
2007-10-28 19:16:50 +03:00
|
|
|
|
|
2009-01-06 01:39:48 +03:00
|
|
|
|
# Конструктор
|
|
|
|
|
# $obj = new VMX::Template, %params
|
2008-08-15 21:31:24 +04:00
|
|
|
|
sub new
|
|
|
|
|
{
|
2007-05-21 03:34:53 +04:00
|
|
|
|
my $class = shift;
|
|
|
|
|
$class = ref ($class) || $class;
|
2008-08-15 21:31:24 +04:00
|
|
|
|
my $self =
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
root => '.', # каталог с шаблонами
|
|
|
|
|
cache_dir => undef, # каталог файлового кэша, ускоряющий работу в случае частых инициализаций интерпретатора
|
|
|
|
|
reload => 2, # если 0, шаблоны не будут перечитываться с диска, и вызовов stat() происходить не будет
|
|
|
|
|
# если >0, то шаблоны будут перечитываться с диска не чаще чем раз в reload секунд
|
|
|
|
|
wrapper => undef, # глобальный фильтр, вызываемый перед выдачей результата parse
|
|
|
|
|
use_utf8 => undef, # шаблоны в UTF-8 и с флагом UTF-8
|
|
|
|
|
begin_code => '<!--', # начало кода
|
|
|
|
|
end_code => '-->', # конец кода
|
|
|
|
|
eat_code_line => 1, # съедать "лишний" перевод строки, если в строке только инструкция?
|
|
|
|
|
begin_subst => '{', # начало подстановки (необязательно)
|
|
|
|
|
end_subst => '}', # конец подстановки (необязательно)
|
|
|
|
|
strict_end => 0, # жёстко требовать имя блока в его завершающей инструкции (<!-- end block -->)
|
|
|
|
|
raise_error => 0, # умирать от фатальных ошибок
|
|
|
|
|
print_error => 1, # включать ошибки в вывод шаблонов
|
|
|
|
|
compiletime_functions => {}, # дополнительные компилируемые функции
|
|
|
|
|
|
|
|
|
|
tpldata => {}, # сюда будут сохранены данные
|
|
|
|
|
errors => [], # сюда будут сохранены ошибки компиляции
|
|
|
|
|
|
2009-01-06 01:39:48 +03:00
|
|
|
|
@_,
|
2007-10-27 23:44:31 +04:00
|
|
|
|
};
|
2009-03-13 20:47:24 +03:00
|
|
|
|
$self->{cache_dir} =~ s!/*$!/!so if $self->{cache_dir};
|
2009-01-06 01:39:48 +03:00
|
|
|
|
$self->{root} =~ s!/*$!/!so;
|
2007-10-27 23:44:31 +04:00
|
|
|
|
bless $self, $class;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# Сохранить и/или напечатать потом ошибку, сдохнуть в случае raise_error
|
|
|
|
|
sub error
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my ($e) = @_;
|
|
|
|
|
if ($self->{input_filename})
|
|
|
|
|
{
|
|
|
|
|
$e = $e." at ".$self->{input_filename}.":".$self->{input_line};
|
|
|
|
|
}
|
2011-03-23 04:51:00 +03:00
|
|
|
|
my $c = [caller 1];
|
|
|
|
|
$e = $c->[3].": $e\n";
|
2011-01-08 03:09:57 +03:00
|
|
|
|
push @{$self->{errors}}, $e;
|
|
|
|
|
die $e if $self->{raise_error};
|
|
|
|
|
return $self->{print_error} ? join('', @{$self->{errors}}) : undef;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Текст ошибок, ещё не включённый в вывод
|
|
|
|
|
sub errors
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
return @{$self->{errors}} ? join('', @{$self->{errors}}) : undef;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Сохранить и/или напечатать потом предупреждение
|
|
|
|
|
sub warning
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my ($w) = @_;
|
|
|
|
|
if ($self->{input_filename})
|
|
|
|
|
{
|
|
|
|
|
$w = $w." at ".$self->{input_filename}.":".$self->{input_line};
|
|
|
|
|
}
|
|
|
|
|
$w = __PACKAGE__ . "::warning: $w\n";
|
|
|
|
|
push @{$self->{errors}}, $w;
|
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
|
2009-01-06 01:39:48 +03:00
|
|
|
|
# Функция уничтожает данные шаблона
|
|
|
|
|
# $obj->clear()
|
2008-10-16 19:27:36 +04:00
|
|
|
|
sub clear
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
%{ shift->{tpldata} } = ();
|
2009-06-29 15:40:21 +04:00
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
2009-12-24 13:35:50 +03:00
|
|
|
|
# Функция очищает кэш в памяти
|
|
|
|
|
sub clear_memory_cache
|
2009-06-29 15:40:21 +04:00
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
2009-12-24 13:35:50 +03:00
|
|
|
|
%$compiled_code = ();
|
|
|
|
|
%$uncompiled_code = ();
|
|
|
|
|
%$mtimes = ();
|
2011-01-06 03:37:21 +03:00
|
|
|
|
%$ltimes = ();
|
2009-12-24 13:35:50 +03:00
|
|
|
|
return $self;
|
2009-06-29 16:15:20 +04:00
|
|
|
|
}
|
|
|
|
|
|
2009-12-24 13:35:50 +03:00
|
|
|
|
# Получить хеш для записи данных
|
|
|
|
|
sub vars
|
2009-06-29 16:15:20 +04:00
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
2009-12-24 13:35:50 +03:00
|
|
|
|
my ($vars) = @_;
|
|
|
|
|
my $t = $self->{tpldata};
|
|
|
|
|
$self->{tpldata} = $vars if $vars;
|
|
|
|
|
return $t;
|
2009-06-27 17:21:50 +04:00
|
|
|
|
}
|
|
|
|
|
|
2011-01-14 02:37:54 +03:00
|
|
|
|
# Вызов функции из шаблона
|
|
|
|
|
sub exec_from
|
|
|
|
|
{
|
|
|
|
|
my ($self, $filename, $function, $vars) = @_;
|
|
|
|
|
return $self->parse_real($filename, undef, $function, $vars);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Вызов функции из кода шаблона
|
|
|
|
|
# Совсем не рекомендовано, но возможно
|
|
|
|
|
sub exec_from_inline
|
|
|
|
|
{
|
|
|
|
|
my ($self, $code, $function, $vars) = @_;
|
|
|
|
|
return $self->parse_real(undef, $code, $function, $vars);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Обработка главного блока шаблона
|
|
|
|
|
# $page = $obj->parse($filename);
|
|
|
|
|
# $page = $obj->parse($filename, $tpldata);
|
2008-08-15 21:31:24 +04:00
|
|
|
|
sub parse
|
2011-01-14 02:37:54 +03:00
|
|
|
|
{
|
|
|
|
|
my ($self, $fn, $vars) = @_;
|
|
|
|
|
return $self->parse_real($fn, undef, '_main', $vars);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Обработка явно переданного кода шаблона
|
|
|
|
|
# Менее рекомендовано, но возможно
|
|
|
|
|
sub parse_inline
|
|
|
|
|
{
|
|
|
|
|
my ($self, $code, $vars) = @_;
|
2011-03-23 04:51:00 +03:00
|
|
|
|
return $self->parse_real(undef, $_[1], '_main', $vars);
|
2011-01-14 02:37:54 +03:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# "Реальная" функция, обрабатывающая все вызовы типа parse
|
|
|
|
|
# $page = $obj->parse_real(filename, inline code, function, vars)
|
|
|
|
|
# inline code - передача не имени файла, а кода. Менее рекомендовано, но возможно.
|
|
|
|
|
sub parse_real
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2007-06-02 02:30:09 +04:00
|
|
|
|
my $self = shift;
|
2011-01-14 02:37:54 +03:00
|
|
|
|
my ($fn, $textref, $function, $vars) = @_;
|
|
|
|
|
# Загрузка кода
|
2011-01-06 03:37:21 +03:00
|
|
|
|
if ($fn)
|
2009-01-06 01:39:48 +03:00
|
|
|
|
{
|
2009-12-24 13:35:50 +03:00
|
|
|
|
$fn = $self->{root}.$fn if $fn !~ m!^/!so;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
return $self->error("couldn't load template file '$fn'")
|
2009-01-06 01:39:48 +03:00
|
|
|
|
unless $textref = $self->loadfile($fn);
|
|
|
|
|
}
|
2011-01-14 02:37:54 +03:00
|
|
|
|
else
|
|
|
|
|
{
|
2011-03-23 04:51:00 +03:00
|
|
|
|
$textref = \( $_[1] );
|
2011-01-14 02:37:54 +03:00
|
|
|
|
}
|
2009-12-26 03:05:35 +03:00
|
|
|
|
my $str = $self->compile($textref, $fn);
|
2011-01-06 03:37:21 +03:00
|
|
|
|
$function ||= '_main';
|
2011-01-13 01:11:40 +03:00
|
|
|
|
if (ref $str eq 'CODE')
|
|
|
|
|
{
|
|
|
|
|
# кэш от старой версии, которая кэширует coderef'ы, а не хеши
|
|
|
|
|
$str = $self->compile($textref, $fn, 1);
|
|
|
|
|
}
|
2011-01-06 03:37:21 +03:00
|
|
|
|
$str = $str->{$function};
|
|
|
|
|
# иначе (если не coderef), то шаблон - не шаблон, а тупо константа
|
|
|
|
|
if (ref $str eq 'CODE')
|
2009-12-26 03:05:35 +03:00
|
|
|
|
{
|
2011-01-06 03:37:21 +03:00
|
|
|
|
local $self->{tpldata} = $vars if $vars;
|
2009-12-26 03:05:35 +03:00
|
|
|
|
$str = eval { &$str($self) };
|
2011-01-08 03:09:57 +03:00
|
|
|
|
return $self->error("error running '$fn".'::'."$function': $@") if $@;
|
|
|
|
|
}
|
|
|
|
|
# в Perl'е мы не можем просто выплюнуть ошибку на STDOUT
|
|
|
|
|
# (возможно, ещё не отправлены HTTP-заголовки, и сами они не отправятся),
|
|
|
|
|
# print_error все ошибки сливает в текст на выход.
|
|
|
|
|
if (($self->{print_error} || $self->{raise_error}) && @{$self->{errors}})
|
|
|
|
|
{
|
|
|
|
|
substr($str, 0, 0, join("\n", @{$self->{errors}}) . "\n");
|
|
|
|
|
$self->{errors} = [];
|
2009-12-26 03:05:35 +03:00
|
|
|
|
}
|
2009-12-24 13:35:50 +03:00
|
|
|
|
&{$self->{wrapper}}($str) if $self->{wrapper};
|
2007-06-02 02:30:09 +04:00
|
|
|
|
return $str;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
|
2009-01-06 01:39:48 +03:00
|
|
|
|
# Функция загружает файл с кэшированием
|
|
|
|
|
# $textref = $obj->loadfile($file)
|
|
|
|
|
sub loadfile
|
|
|
|
|
{
|
2009-02-01 19:37:33 +03:00
|
|
|
|
my $self = shift;
|
2009-01-06 01:39:48 +03:00
|
|
|
|
my ($fn) = @_;
|
|
|
|
|
my $load = 0;
|
|
|
|
|
my $mtime;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
if (!$uncompiled_code->{$fn} || $self->{reload} &&
|
2011-03-23 05:06:20 +03:00
|
|
|
|
$ltimes->{$fn}+$self->{reload} < time)
|
2009-01-06 01:39:48 +03:00
|
|
|
|
{
|
|
|
|
|
$mtime = [ stat($fn) ] -> [ 9 ];
|
|
|
|
|
$load = 1 if !$uncompiled_code->{$fn} || $mtime > $mtimes->{$fn};
|
|
|
|
|
}
|
|
|
|
|
if ($load)
|
|
|
|
|
{
|
|
|
|
|
# если файл изменился - перезасасываем
|
|
|
|
|
my ($fd, $text);
|
|
|
|
|
if (open $fd, "<", $fn)
|
|
|
|
|
{
|
|
|
|
|
local $/ = undef;
|
|
|
|
|
$text = <$fd>;
|
|
|
|
|
close $fd;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
# удаляем старый скомпилированный код
|
|
|
|
|
delete $compiled_code->{$uncompiled_code->{$fn}}
|
|
|
|
|
if $uncompiled_code->{$fn};
|
|
|
|
|
$uncompiled_code->{$fn} = \$text;
|
|
|
|
|
$mtimes->{$fn} = $mtime;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
$ltimes->{$fn} = time;
|
2009-01-06 01:39:48 +03:00
|
|
|
|
}
|
|
|
|
|
return $uncompiled_code->{$fn};
|
|
|
|
|
}
|
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# Функция компилирует код.
|
2009-12-24 13:35:50 +03:00
|
|
|
|
# $sub = $self->compile(\$code, $fn);
|
2009-01-06 01:39:48 +03:00
|
|
|
|
# print &$sub($self);
|
2008-08-15 21:31:24 +04:00
|
|
|
|
sub compile
|
|
|
|
|
{
|
2007-10-28 19:16:50 +03:00
|
|
|
|
my $self = shift;
|
2011-01-13 01:11:40 +03:00
|
|
|
|
my ($coderef, $fn, $force_reload) = @_;
|
|
|
|
|
return $compiled_code->{$coderef} if $compiled_code->{$coderef} && !$force_reload;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
|
2011-01-08 03:10:06 +03:00
|
|
|
|
# код не из файла
|
|
|
|
|
if (!$fn)
|
|
|
|
|
{
|
|
|
|
|
my (undef, $f, $l) = caller(1);
|
|
|
|
|
$fn = "(inline template at $f:$l)";
|
|
|
|
|
}
|
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# кэширование на диске
|
2010-07-02 21:50:34 +04:00
|
|
|
|
my $code = $$coderef;
|
|
|
|
|
Encode::_utf8_off($code);
|
|
|
|
|
|
2009-03-13 20:47:24 +03:00
|
|
|
|
my $h;
|
|
|
|
|
if ($self->{cache_dir})
|
|
|
|
|
{
|
2010-07-02 21:50:34 +04:00
|
|
|
|
$h = $self->{cache_dir}.md5_hex($code).'.pl';
|
2011-01-13 01:11:40 +03:00
|
|
|
|
if (-e $h && !$force_reload)
|
2009-03-13 20:47:24 +03:00
|
|
|
|
{
|
2009-12-20 00:52:55 +03:00
|
|
|
|
$compiled_code->{$coderef} = do $h;
|
2009-03-13 20:47:24 +03:00
|
|
|
|
if ($@)
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("error compiling '$fn': [$@] in FILE: $h");
|
2009-03-13 20:47:24 +03:00
|
|
|
|
unlink $h;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
2009-12-20 00:52:55 +03:00
|
|
|
|
return $compiled_code->{$coderef};
|
2009-03-13 20:47:24 +03:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
2009-02-23 22:33:41 +03:00
|
|
|
|
Encode::_utf8_on($code) if $self->{use_utf8};
|
2009-01-25 19:56:18 +03:00
|
|
|
|
|
2009-12-09 03:09:56 +03:00
|
|
|
|
# начала/концы спецстрок
|
|
|
|
|
my $bc = $self->{begin_code} || '<!--';
|
|
|
|
|
my $ec = $self->{end_code} || '-->';
|
2009-12-27 18:25:19 +03:00
|
|
|
|
# маркер начала, маркер конца, обработчик, съедать ли начало и конец строки
|
|
|
|
|
my @blk = ([ $bc, $ec, 'compile_code_fragment', $self->{eat_code_line} ]);
|
2009-12-20 02:23:10 +03:00
|
|
|
|
if ($self->{begin_subst} && $self->{end_subst})
|
|
|
|
|
{
|
|
|
|
|
push @blk, [ $self->{begin_subst}, $self->{end_subst}, 'compile_substitution' ];
|
|
|
|
|
}
|
|
|
|
|
for (@blk)
|
|
|
|
|
{
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$_->[4] = length $_->[0];
|
|
|
|
|
$_->[5] = length $_->[1];
|
2009-12-20 02:23:10 +03:00
|
|
|
|
}
|
2009-12-09 03:09:56 +03:00
|
|
|
|
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# FIXME в PHP-версии используется отдельный объект $st
|
|
|
|
|
# вероятно, это более корректно, однако конкретных претензий
|
|
|
|
|
# к тому, чтобы хранить текущее состояние компиляции прямо
|
|
|
|
|
# в полях объекта себя тоже не заметно.
|
2009-08-19 03:37:05 +04:00
|
|
|
|
$self->{blocks} = [];
|
|
|
|
|
$self->{in} = [];
|
2011-01-06 03:37:21 +03:00
|
|
|
|
$self->{functions} = [];
|
|
|
|
|
$self->{output_position} = 0;
|
2011-01-13 02:54:43 +03:00
|
|
|
|
$self->{output_plus_len} = 0;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->{input_line} = 0;
|
2011-01-08 03:10:06 +03:00
|
|
|
|
$self->{input_filename} = $fn;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
|
2009-12-20 02:23:10 +03:00
|
|
|
|
# ищем фрагменты кода - на регэкспах-то было не очень правильно, да и медленно!
|
2011-01-08 03:09:57 +03:00
|
|
|
|
my ($r, $pp, $b, $i, $e, $f, $frag, $x_pp, $l, $nl, @p) = ('', 0);
|
2009-12-20 02:23:10 +03:00
|
|
|
|
while ($code && $pp < length $code)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2009-12-20 02:23:10 +03:00
|
|
|
|
@p = map { index $code, $_->[0], $pp } @blk;
|
|
|
|
|
$b = undef;
|
|
|
|
|
for $i (0..$#p)
|
2009-08-13 03:00:28 +04:00
|
|
|
|
{
|
2009-12-20 02:23:10 +03:00
|
|
|
|
# ближайшее найденное
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$b = $i if $p[$i] >= 0 && (!defined $b || $p[$i] < $p[$b]);
|
2009-12-20 02:23:10 +03:00
|
|
|
|
}
|
|
|
|
|
if (defined $b)
|
|
|
|
|
{
|
|
|
|
|
# это означает, что в случае отсутствия корректной инструкции
|
|
|
|
|
# в найденной позиции надо пропустить ТОЛЬКО её начало и попробовать
|
|
|
|
|
# найти что-нибудь снова!
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$pp = $p[$b]+$blk[$b][4];
|
2009-12-20 02:23:10 +03:00
|
|
|
|
$e = index $code, $blk[$b][1], $pp;
|
|
|
|
|
if ($e >= 0)
|
|
|
|
|
{
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$frag = substr $code, $p[$b]+$blk[$b][4], $e-$p[$b]-$blk[$b][4];
|
2009-12-20 02:23:10 +03:00
|
|
|
|
$f = $blk[$b][2];
|
2011-01-06 03:37:21 +03:00
|
|
|
|
if ($frag =~ /\S/so)
|
|
|
|
|
{
|
|
|
|
|
# Некоторые инструкции хотят видеть позицию в выходном потоке.
|
|
|
|
|
# Например, FUNCTION и END. Поэтому преобразуем текст
|
|
|
|
|
# до вызова обработчика.
|
|
|
|
|
$x_pp = $pp - $blk[$b][4];
|
2011-01-13 02:54:43 +03:00
|
|
|
|
$nl = $l = 0;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
if ($x_pp > 0)
|
|
|
|
|
{
|
|
|
|
|
$x_pp = substr($code, 0, $x_pp);
|
|
|
|
|
$nl = $x_pp =~ tr/\n/\n/;
|
|
|
|
|
$x_pp =~ s/([\\\'])/\\$1/gso;
|
|
|
|
|
# съедаем перевод строки, если надо
|
|
|
|
|
$blk[$b][5] and $x_pp =~ s/\r?\n\r?[ \t]*$//so;
|
|
|
|
|
$l += 8 if $l = length $x_pp;
|
|
|
|
|
}
|
|
|
|
|
# записываем позицию
|
|
|
|
|
$self->{output_position} = $l + length $r;
|
2011-01-13 02:54:43 +03:00
|
|
|
|
# блин, они же ещё хотят знать и точку конца директивы!
|
|
|
|
|
# а в неё входит коммент "#line $self->{input_line} \"$fn\"\n"
|
|
|
|
|
$self->{output_plus_len} = 10 + length($fn) + length($self->{input_line}+$nl);
|
2011-01-06 03:37:21 +03:00
|
|
|
|
$frag = $self->$f($frag);
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
$frag = undef;
|
|
|
|
|
}
|
2009-12-20 02:23:10 +03:00
|
|
|
|
if (defined $frag)
|
|
|
|
|
{
|
|
|
|
|
# есть инструкция
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$pp -= $blk[$b][4];
|
2009-12-20 02:23:10 +03:00
|
|
|
|
if ($pp > 0)
|
|
|
|
|
{
|
2011-01-06 03:37:21 +03:00
|
|
|
|
substr $code, 0, $pp, '';
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->{input_line} += $nl;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
$r .= "\$t.='$x_pp';\n" if length $x_pp;
|
2009-12-20 02:23:10 +03:00
|
|
|
|
$pp = 0;
|
|
|
|
|
}
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$r .= "#line $self->{input_line} \"$fn\"\n";
|
2009-12-20 02:23:10 +03:00
|
|
|
|
$r .= $frag;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->{input_line} += substr($code, 0, $e+$blk[$b][5]-$p[$b], '') =~ tr/\n/\n/;
|
2009-12-20 02:23:10 +03:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
# финиш
|
|
|
|
|
$code =~ s/([\\\'])/\\$1/gso;
|
2009-12-26 03:05:35 +03:00
|
|
|
|
if (!$r)
|
|
|
|
|
{
|
|
|
|
|
# шаблон - тупо константа!
|
|
|
|
|
$pp = -1;
|
2011-01-13 02:54:43 +03:00
|
|
|
|
$r = "'$code'";
|
2009-12-26 03:05:35 +03:00
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
$r .= "\$t.='$code';\n";
|
|
|
|
|
}
|
|
|
|
|
undef $code;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
}
|
2009-02-01 19:37:33 +03:00
|
|
|
|
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# перемещаем функции в конец кода
|
|
|
|
|
$code = '';
|
|
|
|
|
while ($f = pop @{$self->{functions}})
|
|
|
|
|
{
|
|
|
|
|
$f = substr($r, $f->[0], $f->[1]-$f->[0], '');
|
|
|
|
|
# проверяем, а не константу ли она возвращает?
|
|
|
|
|
$e = $f;
|
|
|
|
|
$e =~ s/^.*?sub {\nmy \$self = shift;\n/my \$self = 0;\n/so;
|
|
|
|
|
$e =~ s/},\n$//so;
|
|
|
|
|
$e = eval $e;
|
|
|
|
|
if (!$@)
|
|
|
|
|
{
|
|
|
|
|
# константа, от $self никак не зависит
|
|
|
|
|
$e =~ s/([\\\'])/\\$1/gso;
|
|
|
|
|
$f =~ s/^([^=]*=>).*$/$1 $e,/so;
|
|
|
|
|
}
|
|
|
|
|
$code .= $f;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# основной результат заворачиваем в функцию
|
|
|
|
|
# (если $pp = 0, это просто текстовая константа)
|
|
|
|
|
$r = ($pp < 0 ? $r : "sub {
|
|
|
|
|
my \$self = shift;
|
|
|
|
|
my \$t = '';
|
|
|
|
|
$r
|
|
|
|
|
return \$t;
|
|
|
|
|
}\n");
|
|
|
|
|
# и заворачиваем всё это в хеш функций шаблона
|
|
|
|
|
$code = ($self->{use_utf8} ? "use utf8;\n" : "") . "{ _main => $r, $code }\n";
|
2009-08-19 03:37:05 +04:00
|
|
|
|
undef $r;
|
|
|
|
|
|
|
|
|
|
# кэшируем код на диск
|
2009-03-13 20:47:24 +03:00
|
|
|
|
if ($h)
|
|
|
|
|
{
|
|
|
|
|
my $fd;
|
|
|
|
|
if (open $fd, ">$h")
|
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
no warnings 'utf8';
|
2009-03-13 20:47:24 +03:00
|
|
|
|
print $fd $code;
|
|
|
|
|
close $fd;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("error caching '$fn': $! while opening $h");
|
2009-03-13 20:47:24 +03:00
|
|
|
|
}
|
|
|
|
|
}
|
2009-01-06 01:39:48 +03:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# компилируем код
|
2009-12-20 00:52:55 +03:00
|
|
|
|
$compiled_code->{$coderef} = eval $code;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
return $self->error("error compiling '$fn': [$@] in CODE:\n$code") if $@;
|
2009-01-06 01:39:48 +03:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# возвращаем ссылку на процедуру
|
2009-12-20 00:52:55 +03:00
|
|
|
|
return $compiled_code->{$coderef};
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
|
2009-12-27 15:51:44 +03:00
|
|
|
|
# ELSE
|
|
|
|
|
# ELSE IF expression
|
|
|
|
|
sub compile_code_fragment_else
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
my ($self, $kw, $t) = @_;
|
|
|
|
|
if ($t =~ /^IF\s+(.*)$/iso)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return compile_code_fragment_if($self, 'elsif', $1);
|
|
|
|
|
}
|
|
|
|
|
return $_[2] ? undef : "} else {";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# IF expression
|
|
|
|
|
# ELSIF expression
|
|
|
|
|
my %cf_if = ('elseif' => "} els", 'elsif' => "} els", 'if' => "");
|
|
|
|
|
sub compile_code_fragment_if
|
|
|
|
|
{
|
2010-05-13 22:17:05 +04:00
|
|
|
|
my ($self, $kw, $e) = @_;
|
|
|
|
|
my $t = $self->compile_expression($e);
|
2010-05-16 18:10:05 +04:00
|
|
|
|
unless (defined $t)
|
2009-12-27 15:51:44 +03:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Invalid expression in $kw: ($e)");
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
$kw = $cf_if{$kw};
|
|
|
|
|
push @{$self->{in}}, [ 'if' ] unless $kw;
|
|
|
|
|
return $kw . "if ($t) {\n";
|
|
|
|
|
}
|
|
|
|
|
*compile_code_fragment_elsif = *compile_code_fragment_if;
|
|
|
|
|
*compile_code_fragment_elseif = *compile_code_fragment_if;
|
|
|
|
|
|
|
|
|
|
# END [block]
|
|
|
|
|
sub compile_code_fragment_end
|
|
|
|
|
{
|
|
|
|
|
my ($self, $kw, $t) = @_;
|
|
|
|
|
unless (@{$self->{in}})
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("END $t without BEGIN, IF or SET");
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
my ($w, $id) = @{$self->{in}->[$#{$self->{in}}]};
|
|
|
|
|
if ($self->{strict_end} &&
|
|
|
|
|
($t && ($w ne 'begin' || !$id || $id ne $t) ||
|
|
|
|
|
!$t && $w eq 'begin' && $id))
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning(uc($kw)." $t after ".uc($w)." $id");
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
2011-01-06 03:37:21 +03:00
|
|
|
|
my $in = pop @{$self->{in}};
|
2009-12-27 15:51:44 +03:00
|
|
|
|
if ($w eq 'set')
|
|
|
|
|
{
|
|
|
|
|
return "return \$t;\n};\n";
|
|
|
|
|
}
|
|
|
|
|
elsif ($w eq 'begin' || $w eq 'for')
|
|
|
|
|
{
|
|
|
|
|
$w eq 'begin' && pop @{$self->{blocks}};
|
2009-12-27 18:25:19 +03:00
|
|
|
|
return "}}\n";
|
2009-12-27 15:51:44 +03:00
|
|
|
|
}
|
2011-01-06 03:37:21 +03:00
|
|
|
|
elsif ($w eq 'function')
|
|
|
|
|
{
|
|
|
|
|
my $s = "return \$t;\n},\n";
|
2011-01-13 02:54:43 +03:00
|
|
|
|
$self->{$_} = $in->[2]->{$_} for 'blocks', 'in';
|
|
|
|
|
push @{$self->{functions}->[$#{$self->{functions}}]},
|
|
|
|
|
$self->{output_position} + $self->{output_plus_len} + length $s;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
return $s;
|
|
|
|
|
}
|
2009-12-27 18:25:19 +03:00
|
|
|
|
return "}\n";
|
2009-12-27 15:51:44 +03:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# SET varref ... END
|
|
|
|
|
# SET varref = expression
|
|
|
|
|
sub compile_code_fragment_set
|
|
|
|
|
{
|
|
|
|
|
my ($self, $kw, $t) = @_;
|
|
|
|
|
return undef if $t !~ /^((?:\w+\.)*\w+)(\s*=\s*(.*))?/iso;
|
|
|
|
|
my $e;
|
|
|
|
|
if ($3)
|
|
|
|
|
{
|
|
|
|
|
$e = $self->compile_expression($3);
|
2010-05-16 18:10:05 +04:00
|
|
|
|
unless (defined $e)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Invalid expression in $kw: ($3)");
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
2008-08-15 21:31:24 +04:00
|
|
|
|
}
|
2010-05-17 22:03:45 +04:00
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
push @{$self->{in}}, [ 'set', $1 ];
|
|
|
|
|
}
|
2010-05-16 18:10:05 +04:00
|
|
|
|
my $ekw = lc($kw) eq 'function' ? 'sub { my $self = shift; local $self->{tpldata}->{args} = [ @_ ];' : 'eval {';
|
|
|
|
|
return $self->varref($1) . ' = ' . ($e || $ekw . ' my $t = ""') . ";\n";
|
2009-12-27 15:51:44 +03:00
|
|
|
|
}
|
2011-01-06 03:37:21 +03:00
|
|
|
|
|
|
|
|
|
# FUNCTION|BLOCK|MACRO name ... END
|
|
|
|
|
# FUNCTION|BLOCK|MACRO name = expression
|
|
|
|
|
sub compile_code_fragment_function
|
|
|
|
|
{
|
|
|
|
|
my ($self, $kw, $t) = @_;
|
|
|
|
|
return undef if $t !~ /^([^=]*)(=\s*(.*))?/is;
|
|
|
|
|
my $n = $1;
|
|
|
|
|
my $e = $3;
|
|
|
|
|
if ($n !~ /^[^\W\d]\w*$/ || $n eq '_main')
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Template function names:
|
2011-01-06 03:37:21 +03:00
|
|
|
|
* must start with a letter
|
|
|
|
|
* must consist of alphanumeric characters
|
|
|
|
|
* must not be equal to '_main'
|
|
|
|
|
I see 'FUNCTION $n' instead.");
|
|
|
|
|
return undef;
|
|
|
|
|
}
|
2011-01-13 02:54:43 +03:00
|
|
|
|
if (@{$self->{functions}} && @{$self->{functions}->[$#{$self->{functions}}]} == 1)
|
2011-01-06 03:37:21 +03:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Template functions cannot be nested");
|
2011-01-06 03:37:21 +03:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
my $s = "$n => sub {\nmy \$self = shift;\n";
|
|
|
|
|
if (length $e)
|
|
|
|
|
{
|
|
|
|
|
my $r = $self->compile_expression($e);
|
|
|
|
|
if (!defined $r)
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Invalid expression in $kw: ($e)");
|
2011-01-06 03:37:21 +03:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
$s .= "return $r;\n},\n";
|
|
|
|
|
push @{$self->{functions}}, [
|
|
|
|
|
$self->{output_position},
|
|
|
|
|
$self->{output_position} + length $s
|
|
|
|
|
];
|
|
|
|
|
return $s;
|
|
|
|
|
}
|
|
|
|
|
# блоки сохраняются и сбрасываются
|
|
|
|
|
$self->{in} = [ [
|
|
|
|
|
'function', $n, { in => $self->{in}, blocks => $self->{blocks} }
|
|
|
|
|
] ];
|
|
|
|
|
$self->{blocks} = [];
|
|
|
|
|
# запоминаем положение в выходном потоке
|
|
|
|
|
# для последующего разбиения его на функции
|
|
|
|
|
push @{$self->{functions}}, [ $self->{output_position} ];
|
|
|
|
|
return $s . "my \$t = '';\n";
|
|
|
|
|
}
|
|
|
|
|
*compile_code_fragment_block = *compile_code_fragment_function;
|
|
|
|
|
*compile_code_fragment_macro = *compile_code_fragment_function;
|
2009-12-27 15:51:44 +03:00
|
|
|
|
|
|
|
|
|
# INCLUDE template.tpl
|
2011-01-06 03:37:19 +03:00
|
|
|
|
# legacy, в новом варианте можно использовать с кавычками, и это уже идёт как функция
|
2009-12-27 15:51:44 +03:00
|
|
|
|
sub compile_code_fragment_include
|
|
|
|
|
{
|
|
|
|
|
my ($self, $kw, $t) = @_;
|
2011-01-13 01:11:40 +03:00
|
|
|
|
$t =~ s/^([a-z0-9_\.]+)$/\'$1\'/so;
|
|
|
|
|
if (defined($t = $self->compile_expression("include $t")))
|
|
|
|
|
{
|
2011-01-13 02:54:43 +03:00
|
|
|
|
return "\$t.=$t;\n";
|
2011-01-13 01:11:40 +03:00
|
|
|
|
}
|
|
|
|
|
return undef;
|
2009-12-27 15:51:44 +03:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# FOR[EACH] varref = array
|
|
|
|
|
# или
|
|
|
|
|
# FOR[EACH] varref (тогда записывается в себя)
|
|
|
|
|
sub compile_code_fragment_for
|
|
|
|
|
{
|
|
|
|
|
my ($self, $kw, $t, $in) = @_;
|
|
|
|
|
if ($t =~ /^((?:\w+\.)*\w+)(\s*=\s*(.*))?/so)
|
2009-08-23 15:28:24 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
push @{$self->{in}}, [ 'for', $t ] unless $in;
|
|
|
|
|
my $v = $self->varref($1);
|
|
|
|
|
my $v_i = $self->varref($1.'#');
|
2009-12-27 18:25:19 +03:00
|
|
|
|
if (substr($v_i,-1) eq substr($v,-1))
|
|
|
|
|
{
|
|
|
|
|
$v_i = "local $v_i = \$i++;\n"
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
# небольшой хак для $1 =~ \.\d+$
|
|
|
|
|
$v_i = '';
|
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$t = $3 ? $self->compile_expression($3) : $v;
|
|
|
|
|
return "{
|
|
|
|
|
my \$i = 0;
|
2010-05-11 03:02:17 +04:00
|
|
|
|
for (array_items($t)) {
|
2009-12-27 15:51:44 +03:00
|
|
|
|
local $v = \$_;
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$v_i";
|
2009-08-23 15:28:24 +04:00
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
*compile_code_fragment_foreach = *compile_code_fragment_for;
|
|
|
|
|
|
|
|
|
|
# BEGIN block [AT e] [BY e] [TO e]
|
|
|
|
|
# тоже legacy, но пока оставлю...
|
|
|
|
|
sub compile_code_fragment_begin
|
|
|
|
|
{
|
|
|
|
|
my ($self, $kw, $t) = @_;
|
|
|
|
|
if ($t =~ /^([a-z_][a-z0-9_]*)(?:\s+AT\s+(.+))?(?:\s+BY\s+(.+))?(?:\s+TO\s+(.+))?/iso)
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
push @{$self->{blocks}}, $1;
|
|
|
|
|
push @{$self->{in}}, [ 'begin', $1 ];
|
|
|
|
|
$t = join '.', @{$self->{blocks}};
|
|
|
|
|
my $e = $t;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
if ($2)
|
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$e = "subarray($e, $2";
|
|
|
|
|
$e .= ", $4" if $4;
|
|
|
|
|
$e .= ")";
|
2009-08-19 03:37:05 +04:00
|
|
|
|
}
|
|
|
|
|
if ($3)
|
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$e = "subarray_divmod($e, $3)";
|
2009-08-19 03:37:05 +04:00
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
if ($e ne $t)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$e = "$t = $e";
|
2009-08-19 03:37:05 +04:00
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return compile_code_fragment_for($self, 'for', $e, 1);
|
2008-08-15 21:31:24 +04:00
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# компиляция фрагмента кода <!-- ... -->. это может быть:
|
|
|
|
|
# 1) [ELSE] IF выражение
|
|
|
|
|
# 2) BEGIN/FOR/FOREACH имя блока
|
|
|
|
|
# 3) END [имя блока]
|
|
|
|
|
# 4) SET переменная
|
|
|
|
|
# 5) SET переменная = выражение
|
|
|
|
|
# 6) INCLUDE имя_файла_шаблона
|
|
|
|
|
# 7) выражение
|
|
|
|
|
sub compile_code_fragment
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my ($e) = @_;
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$e =~ s/^[ \t]+//so;
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$e =~ s/\s+$//so;
|
2009-12-27 18:25:19 +03:00
|
|
|
|
if ($e =~ /^\#/so)
|
|
|
|
|
{
|
|
|
|
|
# комментарий!
|
|
|
|
|
return '';
|
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
my ($sub, $r);
|
|
|
|
|
if ($e =~ s/^(?:(ELS)(?:E\s*)?)?IF!\s+/$1IF NOT /so)
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
# обратная совместимость... нафига она нужна?...
|
|
|
|
|
# но пока пусть останется...
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Legacy IF! used, consider changing it to IF NOT");
|
2008-08-15 21:31:24 +04:00
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
my ($kw, $t) = split /\s+/, $e, 2;
|
|
|
|
|
$kw = lc $kw;
|
|
|
|
|
if (($kw !~ /\W/so) &&
|
|
|
|
|
($sub = $self->can("compile_code_fragment_$kw")) &&
|
|
|
|
|
defined($r = &$sub($self, $kw, $t)))
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
return $r;
|
2008-08-15 21:31:24 +04:00
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
else
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
$t = $self->compile_expression($e);
|
2011-01-12 03:43:17 +03:00
|
|
|
|
if (defined $t)
|
|
|
|
|
{
|
|
|
|
|
# если заданы маркеры подстановок (по умолчанию { ... }),
|
|
|
|
|
# то выражения, вычисляемые в директивах (по умолчанию <!-- ... -->),
|
|
|
|
|
# не подставляются в результат
|
2011-01-12 20:29:24 +03:00
|
|
|
|
return "$t;\n" if $self->{begin_subst} && $self->{end_subst} &&
|
2011-01-14 02:37:54 +03:00
|
|
|
|
$e !~ /^(parse|process|include|exec)/iso;
|
2011-01-12 03:43:17 +03:00
|
|
|
|
return "\$t.=$t;\n";
|
|
|
|
|
}
|
2008-02-13 18:10:23 +03:00
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
2008-02-13 18:10:23 +03:00
|
|
|
|
}
|
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# компиляция подстановки переменной {...} это просто выражение
|
|
|
|
|
sub compile_substitution
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2007-05-21 03:34:53 +04:00
|
|
|
|
my $self = shift;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
my ($e) = @_;
|
|
|
|
|
$e = $self->compile_expression($e);
|
|
|
|
|
return undef unless $e;
|
2009-12-26 03:05:35 +03:00
|
|
|
|
return "\$t.=$e;\n";
|
2009-08-19 03:37:05 +04:00
|
|
|
|
}
|
2009-08-13 03:00:28 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# компиляция выражения. это может быть:
|
|
|
|
|
# 1) "строковой литерал"
|
|
|
|
|
# 2) 123.123 или 0123 или 0x123
|
|
|
|
|
# 3) переменная
|
|
|
|
|
# 4) функция(выражение,выражение,...,выражение)
|
|
|
|
|
# 5) функция выражение
|
|
|
|
|
# 6) для legacy mode: переменная/имя_функции
|
|
|
|
|
sub compile_expression
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my ($e, $after) = @_;
|
|
|
|
|
$after = undef if $after && ref $after ne 'SCALAR';
|
|
|
|
|
$$after = '' if $after;
|
2009-12-27 18:25:19 +03:00
|
|
|
|
$e =~ s/^[ \t]+//so;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
$e =~ s/\s+$//so unless $after;
|
|
|
|
|
# строковой или числовой литерал
|
2009-12-27 15:51:44 +03:00
|
|
|
|
if ($e =~ /^((\")(?:[^\"\\]+|\\.)*\"|\'(?:[^\'\\]+|\\.)*\'|-?[1-9]\d*(\.\d+)?|-?0\d*|-?0x\d+)\s*(.*)$/iso)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
if ($4)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
|
|
|
|
return undef unless $after;
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$$after = $4;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
}
|
|
|
|
|
$e = $1;
|
|
|
|
|
$e =~ s/[\$\@\%]/\\$&/gso if $2;
|
|
|
|
|
return $e;
|
|
|
|
|
}
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# функция нескольких аргументов или вызов метода объекта
|
2010-05-16 18:10:05 +04:00
|
|
|
|
elsif ($e =~ /^([a-z_][a-z0-9_]*((?:\.[a-z0-9_]+)*))\s*\((.*)$/iso)
|
2009-06-27 17:45:22 +04:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# вызов методов по цепочке типа obj.method().key.other_method() не поддерживаем
|
|
|
|
|
# (в PHP-версии за просто так не сделаешь, а мы хотим быть совместимыми)
|
|
|
|
|
my $f = $1;
|
2010-05-16 18:10:05 +04:00
|
|
|
|
my $varref;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
my $a = $3;
|
|
|
|
|
if ($2)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# вызов метода объекта obj.method()
|
|
|
|
|
$varref = $f;
|
|
|
|
|
$varref =~ s/^(.*)\.([^\.]*)$/$1/so;
|
|
|
|
|
$f = $2;
|
|
|
|
|
if ($f =~ /^[^a-z_]/is)
|
|
|
|
|
{
|
|
|
|
|
$self->warning("Object method name cannot start with a number: '$f' of '$varref'");
|
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
$varref = $self->varref($varref) . '->' . $f;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
}
|
2011-01-08 03:09:57 +03:00
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
$f = lc $f;
|
|
|
|
|
my $s;
|
|
|
|
|
unless ($s = $self->{compiletime_functions}->{$f})
|
|
|
|
|
{
|
|
|
|
|
# встроенная функция
|
|
|
|
|
unless ($s = $self->can("function_$f"))
|
|
|
|
|
{
|
|
|
|
|
$self->warning("Unknown function: $f");
|
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
$f = $s;
|
|
|
|
|
}
|
|
|
|
|
# разбираем аргументы
|
2009-08-19 03:37:05 +04:00
|
|
|
|
my @a;
|
2010-05-16 18:10:05 +04:00
|
|
|
|
while (defined($e = $self->compile_expression($a, \$a)))
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
|
|
|
|
push @a, $e;
|
2011-01-14 02:39:53 +03:00
|
|
|
|
if ($a =~ /^\s*((,|=>)\s*)?\)/so)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
|
|
|
|
last;
|
|
|
|
|
}
|
2011-01-14 02:39:53 +03:00
|
|
|
|
elsif ($a !~ s/^\s*(,|=>)//so)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Unexpected token: '$a' in $f() parameter list");
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
}
|
2011-01-14 02:39:53 +03:00
|
|
|
|
if ($a !~ s/^\s*((,|=>)\s*)?\)\s*//so)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Unexpected token: '$a' in the end of $f() parameter list");
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
if ($a)
|
|
|
|
|
{
|
|
|
|
|
return undef unless $after;
|
|
|
|
|
$$after = $a;
|
|
|
|
|
}
|
2010-05-16 18:10:05 +04:00
|
|
|
|
if ($varref)
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# вызов метода объекта
|
|
|
|
|
return "$varref(".join(',', @a).")";
|
2010-05-16 18:10:05 +04:00
|
|
|
|
}
|
|
|
|
|
# встроенная функция
|
2011-01-08 03:09:57 +03:00
|
|
|
|
return &$f($self, @a);
|
2009-01-06 01:39:48 +03:00
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# функция одного аргумента
|
2009-12-27 15:51:44 +03:00
|
|
|
|
elsif ($e =~ /^([a-z_][a-z0-9_]*)\s+(?=\S)(.*)$/iso)
|
2008-09-02 00:19:55 +04:00
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
my $f = lc $1;
|
|
|
|
|
unless ($self->can("function_$f"))
|
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Unknown function: '$f' in '$e'");
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
2009-12-27 15:51:44 +03:00
|
|
|
|
my $a = $2;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
my $arg = $self->compile_expression($a, \$a);
|
2010-05-16 18:10:05 +04:00
|
|
|
|
unless (defined $arg)
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Invalid expression: ($e)");
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
|
|
|
|
$a =~ s/^\s*//so;
|
|
|
|
|
if ($a)
|
|
|
|
|
{
|
|
|
|
|
return undef unless $after;
|
|
|
|
|
$$after = $a;
|
|
|
|
|
}
|
|
|
|
|
$f = "function_$f";
|
|
|
|
|
return $self->$f($arg);
|
2009-06-27 17:45:22 +04:00
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# переменная плюс legacy-mode переменная/функция
|
2009-12-27 22:32:01 +03:00
|
|
|
|
elsif ($e =~ /^((?:[a-z0-9_]+\.)*(?:[a-z0-9_]+\#?))(?:\/([a-z]+))?\s*(.*)$/iso)
|
2009-06-27 17:45:22 +04:00
|
|
|
|
{
|
2009-12-27 15:51:44 +03:00
|
|
|
|
if ($3)
|
2009-07-02 16:48:02 +04:00
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef unless $after;
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$$after = $3;
|
2009-08-19 03:37:05 +04:00
|
|
|
|
}
|
|
|
|
|
$e = $self->varref($1);
|
|
|
|
|
if ($2)
|
|
|
|
|
{
|
|
|
|
|
my $f = lc $2;
|
|
|
|
|
unless ($self->can("function_$f"))
|
2009-08-13 03:00:28 +04:00
|
|
|
|
{
|
2011-01-08 03:09:57 +03:00
|
|
|
|
$self->warning("Unknown function: '$f' called in legacy mode ($&)");
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
2008-09-02 00:19:55 +04:00
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
$f = "function_$f";
|
|
|
|
|
$e = $self->$f($e);
|
2008-09-02 00:19:55 +04:00
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return $e;
|
2009-06-27 17:20:21 +04:00
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return undef;
|
|
|
|
|
}
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# генерация ссылки на переменную
|
|
|
|
|
sub varref
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
return "" unless $_[0];
|
|
|
|
|
my @e = ref $_[0] ? @{$_[0]} : split /\.+/, $_[0];
|
|
|
|
|
my $t = '$self->{tpldata}';
|
|
|
|
|
for (@e)
|
2009-06-27 17:46:44 +04:00
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
if (/^\d+$/so)
|
2009-06-27 17:46:44 +04:00
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
$t .= "->[$_]";
|
2009-06-27 17:46:44 +04:00
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
2009-08-19 03:37:05 +04:00
|
|
|
|
s/\'|\\/\\$&/gso;
|
|
|
|
|
$t .= "->{'$_'}";
|
2009-06-27 17:46:44 +04:00
|
|
|
|
}
|
|
|
|
|
}
|
2009-08-19 03:37:05 +04:00
|
|
|
|
return $t;
|
|
|
|
|
}
|
2008-08-15 21:31:24 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# операция над аргументами
|
|
|
|
|
sub fmop
|
|
|
|
|
{
|
|
|
|
|
my $op = shift;
|
|
|
|
|
shift; # my $self = shift;
|
|
|
|
|
return "((" . join(") $op (", @_) . "))";
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
|
2009-12-27 18:25:19 +03:00
|
|
|
|
# вспомогательная функция - возвращает элементы массива или скаляр,
|
|
|
|
|
# если он не ссылка на массив
|
2010-08-12 02:31:22 +04:00
|
|
|
|
sub array_items { ref($_[0]) && $_[0] =~ /ARRAY/ ? @{$_[0]} : (defined $_[0] ? ($_[0]) : ()) }
|
2009-12-27 18:25:19 +03:00
|
|
|
|
|
2009-12-18 15:22:55 +03:00
|
|
|
|
# вызов функции с аргументами и раскрытием массивов
|
|
|
|
|
sub fearr
|
|
|
|
|
{
|
|
|
|
|
my $f = shift;
|
2010-07-03 01:52:12 +04:00
|
|
|
|
my $n = shift;
|
2009-12-18 15:22:55 +03:00
|
|
|
|
my $self = shift;
|
2010-07-03 01:52:12 +04:00
|
|
|
|
my $e = "$f(";
|
|
|
|
|
$e .= join(", ", splice(@_, 0, $n)) if $n;
|
|
|
|
|
$e .= ", " if $n && @_;
|
|
|
|
|
$e .= join(", ", map { "array_items($_)" } @_);
|
2009-12-18 15:22:55 +03:00
|
|
|
|
$e .= ")";
|
|
|
|
|
return $e;
|
|
|
|
|
}
|
|
|
|
|
|
2011-01-06 03:37:21 +03:00
|
|
|
|
#############
|
|
|
|
|
## ФУНКЦИИ ##
|
|
|
|
|
#############
|
|
|
|
|
|
|
|
|
|
## Числа / логические значения
|
|
|
|
|
|
|
|
|
|
# логические операции
|
2009-08-19 03:37:05 +04:00
|
|
|
|
sub function_or { fmop('||', @_) }
|
|
|
|
|
sub function_and { fmop('&&', @_) }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
sub function_not { "!($_[1])" }
|
|
|
|
|
# арифметические операции
|
2009-08-19 03:37:05 +04:00
|
|
|
|
sub function_add { fmop('+', @_) }
|
|
|
|
|
sub function_sub { fmop('-', @_) }
|
|
|
|
|
sub function_mul { fmop('*', @_) }
|
|
|
|
|
sub function_div { fmop('/', @_) }
|
2010-05-11 03:02:17 +04:00
|
|
|
|
sub function_mod { fmop('%', @_) }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# логарифм
|
2010-01-03 15:18:10 +03:00
|
|
|
|
sub function_log { "log($_[1])" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# чётный, нечётный
|
2009-08-19 03:37:05 +04:00
|
|
|
|
sub function_even { "!(($_[1]) & 1)" }
|
|
|
|
|
sub function_odd { "(($_[1]) & 1)" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# приведение к целому числу
|
|
|
|
|
sub function_int { "int($_[1])" } *function_i = *function_int; *function_intval = *function_int;
|
|
|
|
|
# сравнения: = != > < >= <= (аргументов как строк)
|
2011-01-03 03:42:07 +03:00
|
|
|
|
sub function_eq { "(($_[1]) eq ($_[2]))" } *function_seq = *function_eq;
|
|
|
|
|
sub function_ne { "(($_[1]) ne ($_[2]))" } *function_sne = *function_ne;
|
|
|
|
|
sub function_gt { "(($_[1]) gt ($_[2]))" } *function_sgt = *function_gt;
|
|
|
|
|
sub function_lt { "(($_[1]) lt ($_[2]))" } *function_slt = *function_lt;
|
|
|
|
|
sub function_ge { "(($_[1]) ge ($_[2]))" } *function_sge = *function_ge;
|
|
|
|
|
sub function_le { "(($_[1]) le ($_[2]))" } *function_sle = *function_le;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# сравнения: = != > < >= <= (аргументов как чисел)
|
2011-01-03 03:42:07 +03:00
|
|
|
|
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]))" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# тернарный оператор $1 ? $2 : $3
|
2010-06-29 03:39:19 +04:00
|
|
|
|
sub function_yesno { "(($_[1]) ? ($_[2]) : ($_[3]))" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
|
|
|
|
|
## Строки
|
|
|
|
|
|
|
|
|
|
# нижний и верхний регистр
|
2010-01-03 15:18:10 +03:00
|
|
|
|
sub function_lc { "lc($_[1])" } *function_lower = *function_lowercase = *function_lc;
|
|
|
|
|
sub function_uc { "uc($_[1])" } *function_upper = *function_uppercase = *function_uc;
|
2011-01-12 03:43:17 +03:00
|
|
|
|
# нижний и верхний регистр первого символа
|
|
|
|
|
sub function_lcfirst { "lcfirst($_[1])" }
|
|
|
|
|
sub function_ucfirst { "ucfirst($_[1])" }
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# экранировать двойные и одинарные кавычки в стиле C (добавить \)
|
|
|
|
|
sub function_quote { "quotequote($_[1])" } *function_q = *function_quote; *function_addslashes = *function_q;
|
|
|
|
|
# экранировать двойные кавычки в стиле SQL/CSV (удвоением)
|
|
|
|
|
sub function_sq { "sql_quote($_[1])" } *function_sql_quote = *function_sq;
|
|
|
|
|
# экранирование символов, специальных для регулярного выражения
|
2010-01-03 15:18:10 +03:00
|
|
|
|
sub function_requote { "requote($_[1])" } *function_re_quote = *function_preg_quote = *function_requote;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# кодировать символы в стиле URL
|
|
|
|
|
sub function_uriquote{ shift; "URI::Escape::uri_escape(".join(",",@_).")" } *function_uri_escape = *function_urlencode = *function_uriquote;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# замена регэкспов
|
2010-01-03 15:18:10 +03:00
|
|
|
|
sub function_replace { "resub($_[1], $_[2], $_[3])" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# замена подстрок (а не регэкспов)
|
2011-01-03 03:42:12 +03:00
|
|
|
|
sub function_str_replace { "exec_str_replace($_[1], $_[2], $_[3])" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# длина строки в символах
|
2010-06-04 00:30:16 +04:00
|
|
|
|
sub function_strlen { "strlen($_[1])" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# подстрока
|
2010-05-16 18:10:05 +04:00
|
|
|
|
sub function_substr { shift; "substr(".join(",", @_).")" } *function_substring = *function_substr;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# обрезать пробелы из начала и конца строки
|
2010-07-04 21:14:33 +04:00
|
|
|
|
sub function_trim { shift; "trim($_[0])" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# разделить строку $2 по регулярному выражению $1 опционально с лимитом $3
|
|
|
|
|
sub function_split { shift; "split(".join(",", @_).")" }
|
|
|
|
|
# заменить символы & < > " ' на HTML-сущности
|
2010-06-27 23:01:01 +04:00
|
|
|
|
sub function_html { "htmlspecialchars($_[1])" } *function_s = *function_html; *function_htmlspecialchars = *function_html;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# удалить все HTML-теги
|
2010-05-16 18:10:05 +04:00
|
|
|
|
sub function_strip { "strip_tags($_[1])" } *function_t = *function_strip; *function_strip_tags = *function_strip;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# оставить только "безопасные" HTML-теги
|
2010-01-03 15:18:10 +03:00
|
|
|
|
sub function_h { "strip_unsafe_tags($_[1])" } *function_strip_unsafe = *function_h;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# заменить \n на <br />
|
|
|
|
|
sub function_nl2br { "resub(qr/\\n/so, '<br />', $_[1])" }
|
|
|
|
|
# конкатенация строк
|
|
|
|
|
sub function_concat { fmop('.', @_) }
|
2009-08-19 03:37:05 +04:00
|
|
|
|
# объединяет не просто скаляры, а также все элементы массивов
|
2010-07-03 01:52:12 +04:00
|
|
|
|
sub function_join { fearr('join', 1, @_) } *function_implode = *function_join;
|
2009-12-18 03:07:41 +03:00
|
|
|
|
# подставляет на места $1, $2 и т.п. в строке аргументы
|
2010-07-03 01:52:12 +04:00
|
|
|
|
sub function_subst { fearr('exec_subst', 1, @_) }
|
2009-12-18 15:22:55 +03:00
|
|
|
|
# sprintf
|
2010-07-03 01:52:12 +04:00
|
|
|
|
sub function_sprintf { fearr('sprintf', 1, @_) }
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# strftime
|
|
|
|
|
sub function_strftime
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $e = $_[1];
|
|
|
|
|
$e = "($e).' '.($_[2])" if $_[2];
|
|
|
|
|
$e = "VMX::Common::estrftime($_[0], localtime(timestamp($e)))";
|
|
|
|
|
$e = "utf8on($e)" if $self->{use_utf8};
|
|
|
|
|
return $e;
|
|
|
|
|
}
|
2010-03-24 03:14:22 +03:00
|
|
|
|
# ограничение длины строки $maxlen символами на границе пробелов и добавление '...', если что.
|
2011-01-12 03:43:17 +03:00
|
|
|
|
sub function_strlimit{ shift; "strlimit(".join(",", @_).")" } *function_truncate = *function_strlimit;
|
2011-01-06 03:37:21 +03:00
|
|
|
|
|
|
|
|
|
## Массивы и хеши
|
|
|
|
|
|
2009-12-25 04:04:24 +03:00
|
|
|
|
# создание хеша
|
2011-01-18 16:04:01 +03:00
|
|
|
|
sub function_hash { shift; @_ == 1 ? "{ \@{ $_[0] } }" : "{" . join(",", @_) . "}"; }
|
2010-05-25 18:39:43 +04:00
|
|
|
|
# ключи хеша
|
2011-01-03 03:42:12 +03:00
|
|
|
|
sub function_keys { '[ keys(%{'.$_[1].'}) ]'; } *function_hash_keys = *function_keys; *function_array_keys = *function_keys;
|
2010-07-03 01:52:12 +04:00
|
|
|
|
# сортировка массива
|
|
|
|
|
sub function_sort { '[ '.fearr('sort', 0, @_).' ]'; }
|
2011-01-03 03:42:07 +03:00
|
|
|
|
# пары { id => ключ, name => значение } для хеша
|
2011-01-18 16:04:01 +03:00
|
|
|
|
sub function_pairs { "exec_pairs($_[1])" } *function_each = *function_pairs;
|
2009-12-25 04:04:24 +03:00
|
|
|
|
# создание массива
|
|
|
|
|
sub function_array { shift; "[" . join(",", @_) . "]"; }
|
2011-01-03 03:42:07 +03:00
|
|
|
|
# диапазон значений
|
|
|
|
|
sub function_range { "($_[1] .. $_[2])" }
|
|
|
|
|
# проверка, аргумент - массив или не массив?
|
|
|
|
|
sub function_is_array{ "exec_is_array($_[1])" }
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# количество элементов _массива_ (не хеша)
|
|
|
|
|
sub function_count { "(ref($_[1]) && $_[1] =~ /ARRAY/so ? scalar(\@{ $_[1] }) : 0)" }
|
2009-12-27 15:51:44 +03:00
|
|
|
|
# подмассив по номерам элементов
|
2010-03-24 03:14:22 +03:00
|
|
|
|
sub function_subarray { shift; "exec_subarray(" . join(",", @_) . ")"; } *function_array_slice = *function_subarray;
|
2009-12-27 15:51:44 +03:00
|
|
|
|
# подмассив по кратности номеров элементов
|
|
|
|
|
sub function_subarray_divmod { shift; "exec_subarray_divmod(" . join(",", @_) . ")"; }
|
2010-01-03 15:18:10 +03:00
|
|
|
|
# получить элемент хеша/массива по неконстантному ключу (например get(iteration.array, rand(5)))
|
|
|
|
|
# по-моему, это лучше, чем Template Toolkit'овский ад - hash.key.${another.hash.key}.зюка.хрюка и т.п.
|
|
|
|
|
sub function_get { shift; "exec_get(" . join(",", @_) . ")"; }
|
|
|
|
|
# для хеша
|
|
|
|
|
sub function_hget { "($_[1])->\{$_[2]}" }
|
|
|
|
|
# для массива
|
|
|
|
|
sub function_aget { "($_[1])->\[$_[2]]" }
|
2011-01-11 03:30:51 +03:00
|
|
|
|
# присваивание (только lvalue)
|
|
|
|
|
sub function_set { "($_[1] = $_[2])" }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# слияние массивов в один большой массив
|
2010-05-17 22:03:45 +04:00
|
|
|
|
sub function_array_merge { shift; '[@{'.join('},@{',@_).'}]' }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# вынуть первый элемент массива
|
2010-03-24 03:14:22 +03:00
|
|
|
|
sub function_shift { "shift(\@{$_[1]})"; }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# вынуть последний элемент массива
|
2010-03-24 03:14:22 +03:00
|
|
|
|
sub function_pop { "pop(\@{$_[1]})"; }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# вставить как первый элемент массива
|
2010-05-11 03:02:17 +04:00
|
|
|
|
sub function_unshift { shift; "unshift(\@{".shift(@_)."}, ".join(",", @_).")"; }
|
2011-01-06 03:37:21 +03:00
|
|
|
|
# вставить как последний элемент массива
|
2010-05-11 03:02:17 +04:00
|
|
|
|
sub function_push { shift; "push(\@{".shift(@_)."}, ".join(",", @_).")"; }
|
2010-03-24 03:14:22 +03:00
|
|
|
|
|
2011-01-08 03:09:57 +03:00
|
|
|
|
## Прочее
|
|
|
|
|
|
2011-01-03 03:42:07 +03:00
|
|
|
|
# вычисление выражения и игнорирование результата, как в JS
|
|
|
|
|
sub function_void { "scalar(($_[1]), '')" }
|
2010-06-04 00:30:16 +04:00
|
|
|
|
# дамп переменной
|
|
|
|
|
sub function_dump { shift; "exec_dump(" . join(",", @_) . ")" } *function_var_dump = *function_dump;
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# JSON-кодирование
|
2011-01-06 03:37:21 +03:00
|
|
|
|
sub function_json { "encode_json($_[1])" }
|
2010-06-04 00:30:16 +04:00
|
|
|
|
|
2011-01-14 02:37:54 +03:00
|
|
|
|
# включение другого файла: parse('файл'[, аргументы]) */
|
|
|
|
|
sub function_parse
|
|
|
|
|
{
|
|
|
|
|
shift;
|
|
|
|
|
my $fn = shift;
|
|
|
|
|
return "\$self->parse_real($fn, undef, '_main'".auto_hash(@_).")";
|
|
|
|
|
}
|
|
|
|
|
*function_process = *function_parse;
|
|
|
|
|
*function_include = *function_parse;
|
|
|
|
|
|
|
|
|
|
# включение блока из текущего файла: exec('блок'[, аргументы])
|
|
|
|
|
sub function_exec
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $block = shift;
|
|
|
|
|
my $fn = $self->{input_filename};
|
|
|
|
|
$fn =~ s/([\'\\])/\\$1/gso;
|
|
|
|
|
return "\$self->parse_real('$fn', undef, $block".auto_hash(@_).")";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# включение блока из другого файла: exec_from('файл', 'блок'[, аргументы])
|
|
|
|
|
sub function_exec_from
|
|
|
|
|
{
|
|
|
|
|
shift;
|
|
|
|
|
my $fn = shift;
|
|
|
|
|
my $block = shift;
|
|
|
|
|
return "\$self->parse_real($fn, undef, $block".auto_hash(@_).")";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# parse не из файла, хотя и не рекомендуется
|
|
|
|
|
sub function_parse_inline
|
|
|
|
|
{
|
|
|
|
|
shift;
|
|
|
|
|
my $code = shift;
|
|
|
|
|
return "\$self->parse_real(undef, $code, '_main'".auto_hash(@_).")";
|
|
|
|
|
}
|
|
|
|
|
*function_process_inline = *function_parse_inline;
|
|
|
|
|
*function_include_inline = *function_parse_inline;
|
|
|
|
|
|
|
|
|
|
# сильно не рекомендуется, но возможно:
|
|
|
|
|
# включение блока не из файла:
|
|
|
|
|
# exec_from_inline('код', 'блок'[, аргументы])
|
|
|
|
|
sub function_exec_from_inline
|
|
|
|
|
{
|
|
|
|
|
shift;
|
|
|
|
|
my $code = shift;
|
|
|
|
|
my $block = shift;
|
|
|
|
|
return "\$self->parse_real(undef, $code, $block".auto_hash(@_).")";
|
|
|
|
|
}
|
|
|
|
|
|
2011-01-14 15:49:32 +03:00
|
|
|
|
# вызов функции объекта по вычисляемому имени:
|
|
|
|
|
# call(object, "method", arg1, arg2, ...) или
|
|
|
|
|
# call_array(object, "method", array(arg1, arg2, ...))
|
|
|
|
|
sub function_call { shift; "exec_call(" . join(",", @_) . ")"; }
|
|
|
|
|
sub function_call_array { "exec_call($_[1], $_[2], @{ $_[3] })"; }
|
2010-05-10 02:35:11 +04:00
|
|
|
|
|
2009-12-27 22:32:01 +03:00
|
|
|
|
# map()
|
|
|
|
|
sub function_map
|
|
|
|
|
{
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $f = shift;
|
2010-07-04 20:59:02 +04:00
|
|
|
|
my $def = $self->varref('_');
|
|
|
|
|
$def = "\Q$def\E";
|
|
|
|
|
$f =~ s/$def/\$_/giso;
|
|
|
|
|
return '[ '.fearr('map { '.$f.' }', 0, $self, @_).' ]';
|
2009-12-27 22:32:01 +03:00
|
|
|
|
}
|
|
|
|
|
|
2011-01-08 03:09:57 +03:00
|
|
|
|
########################
|
|
|
|
|
## Реализации функций ##
|
|
|
|
|
########################
|
2011-01-06 03:37:21 +03:00
|
|
|
|
|
2009-12-27 15:51:44 +03:00
|
|
|
|
# подмассив
|
2010-01-03 15:18:10 +03:00
|
|
|
|
# exec_subarray([], 0, 10)
|
|
|
|
|
# exec_subarray([], 2)
|
|
|
|
|
# exec_subarray([], 0, -1)
|
2009-12-27 15:51:44 +03:00
|
|
|
|
sub exec_subarray
|
|
|
|
|
{
|
|
|
|
|
my ($array, $from, $to) = @_;
|
|
|
|
|
return $array unless $from;
|
|
|
|
|
$to ||= 0;
|
2010-01-03 15:18:10 +03:00
|
|
|
|
$from += @$array if $from < 0;
|
2009-12-27 15:51:44 +03:00
|
|
|
|
$to += @$array if $to <= 0;
|
|
|
|
|
return [ @$array[$from..$to] ];
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# подмассив по кратности номеров элементов
|
2010-01-03 15:18:10 +03:00
|
|
|
|
# exec_subarray_divmod([], 2)
|
|
|
|
|
# exec_subarray_divmod([], 2, 1)
|
2009-12-27 15:51:44 +03:00
|
|
|
|
sub exec_subarray_divmod
|
|
|
|
|
{
|
|
|
|
|
my ($array, $div, $mod) = @_;
|
|
|
|
|
return $array unless $div;
|
|
|
|
|
$mod ||= 0;
|
|
|
|
|
return [ @$array[grep { $_ % $div == $mod } 0..$#$array] ];
|
|
|
|
|
}
|
2009-12-18 16:04:29 +03:00
|
|
|
|
|
2010-01-03 15:18:10 +03:00
|
|
|
|
# получение элемента хеша или массива
|
|
|
|
|
sub exec_get
|
|
|
|
|
{
|
|
|
|
|
defined $_[1] && ref $_[0] || return $_[0];
|
|
|
|
|
$_[0] =~ /ARRAY/ && return $_[0]->[$_[1]];
|
|
|
|
|
return $_[0]->{$_[1]};
|
|
|
|
|
}
|
|
|
|
|
|
2009-12-18 15:22:55 +03:00
|
|
|
|
# выполняет подстановку function_subst
|
|
|
|
|
sub exec_subst
|
2008-08-15 21:31:24 +04:00
|
|
|
|
{
|
2009-12-18 03:07:41 +03:00
|
|
|
|
my $str = shift;
|
2009-12-20 02:23:10 +03:00
|
|
|
|
$str =~ s/(?<!\\)((?:\\\\)*)\$(?:([1-9]\d*)|\{([1-9]\d*)\})/$_[($2||$3)-1]/gisoe;
|
2009-12-18 03:07:41 +03:00
|
|
|
|
return $str;
|
2008-08-15 21:31:24 +04:00
|
|
|
|
}
|
|
|
|
|
|
2011-01-18 16:04:01 +03:00
|
|
|
|
# пары { key => ключ, value => значение } для хеша
|
|
|
|
|
sub exec_pairs
|
2011-01-03 03:42:07 +03:00
|
|
|
|
{
|
|
|
|
|
my $hash = shift;
|
2011-01-18 16:04:01 +03:00
|
|
|
|
return [ map { { key => $_, value => $hash->{$_} } } sort keys %{ $hash || {} } ];
|
2011-01-03 03:42:07 +03:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# проверка, массив или нет?
|
|
|
|
|
sub exec_is_array
|
|
|
|
|
{
|
|
|
|
|
return ref $_[1] && $_[1] =~ /ARRAY/;
|
|
|
|
|
}
|
|
|
|
|
|
2011-01-03 03:42:12 +03:00
|
|
|
|
# замена _подстрок_ (а не регэкспов)
|
|
|
|
|
sub exec_str_replace
|
|
|
|
|
{
|
|
|
|
|
my ($s, $sub, $v) = @_;
|
|
|
|
|
$v =~ s/\Q$s\E/$sub/gso;
|
|
|
|
|
return $v;
|
|
|
|
|
}
|
|
|
|
|
|
2011-01-08 03:09:57 +03:00
|
|
|
|
# вызов функции $2 объекта $1 с параметрами $3 и далее
|
|
|
|
|
sub exec_call
|
|
|
|
|
{
|
|
|
|
|
my $o = shift;
|
|
|
|
|
my $m = shift;
|
|
|
|
|
return $o->$m(@_);
|
|
|
|
|
}
|
|
|
|
|
|
2010-05-10 02:35:11 +04:00
|
|
|
|
# Data::Dumper
|
|
|
|
|
sub exec_dump
|
|
|
|
|
{
|
|
|
|
|
require Data::Dumper;
|
|
|
|
|
local $Data::Dumper::Indent = 1;
|
|
|
|
|
local $Data::Dumper::Varname = '';
|
|
|
|
|
local $Data::Dumper::Sortkeys = 1;
|
|
|
|
|
return scalar Data::Dumper::Dumper(@_);
|
|
|
|
|
}
|
|
|
|
|
|
2011-01-14 02:37:54 +03:00
|
|
|
|
# автоматическое создание хеша из хешрефа или списка
|
|
|
|
|
sub auto_hash
|
|
|
|
|
{
|
|
|
|
|
if (!@_)
|
|
|
|
|
{
|
|
|
|
|
return "";
|
|
|
|
|
}
|
|
|
|
|
elsif (@_ == 1)
|
|
|
|
|
{
|
|
|
|
|
return ', ' . $_[0];
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
return ', {'.join(',', @_).'}';
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
1;
|
|
|
|
|
__END__
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head1 Шаблонизатор VMX::Template
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Данный модуль представляет собой новую версию VMX::Template, построенную на
|
|
|
|
|
некоторых новых идеях, ликвидировавшую безобразие и legacy-код, накопленный
|
|
|
|
|
в старой версии, однако сохранившую высокую производительность и простоту.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head1 Идеи
|
|
|
|
|
|
|
|
|
|
Уйти от assign_vars(), assign_block_vars(). Передавать, как и в обычных движках,
|
|
|
|
|
просто хеш с данными $vars. Как, например, в Template::Toolkit. При этом
|
|
|
|
|
сохранить данные методы для совместимости.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Почистить синтаксис: ликвидировать "преобразования", "вложенный путь по
|
|
|
|
|
переменной" (->key->index->key->и т.п.), специальный синтаксис для окончания SET,
|
|
|
|
|
неочевидное обращение к счётчику block.#, tr_assign_* и т.п.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Переписать с нуля компилятор.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Добавить в употребление функции, но только самые необходимые.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Добавить обработку ошибок и диагностические сообщения.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head1 Реализация
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Путь к переменной теперь может включать в себя числа.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Вне BEGIN - {block} будет иметь значение ARRAY(0x...) т.е. массив всех
|
|
|
|
|
итераций блока block, а {block.0} будет иметь значение HASH(0x...), т.е.
|
|
|
|
|
первую итерацию блока block.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- BEGIN block -->
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Внутри BEGIN - {block} будет иметь значение HASH(0x...), т.е. уже значение
|
|
|
|
|
текущей итерации блока block, а {block.#} будет иметь значением номер текущей
|
|
|
|
|
итерации {block.var}, считаемый с 0, а не с 1, как в старой версии.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- END block -->
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
На <!-- END другоеимя --> после <!-- BEGIN block --> ругнётся, ибо нефиг.
|
|
|
|
|
Если block в хеше данных - не массив, а хеш - значит, итерация у блока только
|
|
|
|
|
одна, и <!-- BEGIN block --> работает как for($long_expression) {} в Perl.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Операторов НЕТ, но есть функции.
|
|
|
|
|
Пример:
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- IF OR(function(block.key1),AND(block.key2,block.key3)) -->
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Синтаксис вызова функции нескольких аргументов:
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- function(block.key, 0, "abc") -->
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Подстановка:
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
{function(block.key, 0, "abc")}
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Синтаксис вызова функции одного аргумента:
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- function(block.key) -->
|
|
|
|
|
<!-- function block.key -->
|
|
|
|
|
{block.key/L}
|
|
|
|
|
{L block.key}
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Условный вывод:
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- IF function(block.key) --><!-- ELSEIF ... --><!-- END -->
|
|
|
|
|
<!-- IF NOT block.key -->...<!-- END -->
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Запись значения переменной:
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- SET block.key -->...<!-- END -->
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
или
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
<!-- SET block.key = выражение -->
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head1 Функции
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 OR, AND, NOT
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Логические ИЛИ, И, НЕ, действующие аналогично Perl операторам || && !.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 EVEN, ODD
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Истина в случае, если аргумент чётный или нечётный соответственно.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 INT, ADD, MUL, DIV, MOD
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Преобразование к целому числу и арифметические операции.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 EQ, SEQ, GT, LT, GE, LE, SGT, SLT, SGE, SLE
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Действуют аналогично Perl операторам == eq > < >= <= gt lt ge le.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 CONCAT, JOIN, SPLIT, COUNT
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Конкатенация всех своих аргументов - concat(аргументы).
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Конкатенация элементов массива через разделитель - join(строка,аргументы).
|
|
|
|
|
Причём если какие-то аргументы - массивы, конкатенирует все их элементы,
|
|
|
|
|
а не их самих.
|
2009-06-29 16:15:06 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Разделение строки по регулярному выражению и лимиту - split(РЭ,аргумент,лимит).
|
|
|
|
|
Лимит необязателен. (см. perldoc -f split)
|
2009-06-29 16:15:06 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Количество элементов в массиве или 0 если не массив - count(аргумент).
|
2009-07-10 19:37:23 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 LC=LOWER=LOWERCASE, UC=UPPER=UPPERCASE
|
2009-06-29 16:15:06 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Нижний и верхний регистр.
|
2009-06-29 16:15:06 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 S=HTML, T=STRIP, H=STRIP_UNSAFE
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Преобразование символов < > & " ' в HTML-сущности,
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Удаление всех тегов,
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Удаление запрещённых тегов.
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
=head2 Q=QUOTE, REQUOTE=RE_QUOTE=PREG_QUOTE
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
Экранирование символов " ' \
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
2009-08-19 03:37:05 +04:00
|
|
|
|
А также экранирование символов, являющихся специальными в регулярных выражениях (см. perldoc perlre).
|
2009-06-29 15:40:21 +04:00
|
|
|
|
|
|
|
|
|
=cut
|