2007-05-21 03:34:53 +04:00
|
|
|
|
#!/usr/bin/perl
|
|
|
|
|
|
2007-06-02 02:30:09 +04:00
|
|
|
|
=head1 Простой шаблонный движок.
|
|
|
|
|
Inspired by phpBB templates, которые в свою очередь inspired by
|
|
|
|
|
phplib templates.
|
2007-05-21 03:34:53 +04:00
|
|
|
|
=cut
|
|
|
|
|
|
|
|
|
|
package VMX::Template;
|
|
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
|
use VMX::Common qw(:all);
|
|
|
|
|
use Digest::MD5 qw(md5_hex);
|
|
|
|
|
use vars qw($cachedir $root $wrapper %_tpldata %files %compiled_code %uncompiled_code @_tpldata_stack @conv $self);
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Конструктор
|
|
|
|
|
# $obj = new VMX::Template, %init
|
|
|
|
|
##
|
|
|
|
|
sub new {
|
|
|
|
|
my $class = shift;
|
|
|
|
|
my %args = @_;
|
|
|
|
|
$class = ref ($class) || $class;
|
|
|
|
|
my %data = (
|
2007-09-11 02:46:55 +04:00
|
|
|
|
root => '.',
|
|
|
|
|
conv => [
|
2007-05-21 03:34:53 +04:00
|
|
|
|
{
|
|
|
|
|
'<' => 'strip_tags',
|
|
|
|
|
'i' => 'int',
|
|
|
|
|
's' => 'htmlspecialchars',
|
|
|
|
|
'l' => 'lc',
|
2007-09-11 02:46:55 +04:00
|
|
|
|
'u' => 'uc',
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}, {
|
|
|
|
|
#'c' => 'strlimit'
|
|
|
|
|
}
|
|
|
|
|
],
|
2007-09-11 02:46:55 +04:00
|
|
|
|
lang => {
|
|
|
|
|
},
|
2007-05-21 03:34:53 +04:00
|
|
|
|
%args
|
|
|
|
|
);
|
|
|
|
|
bless \%data, $class;
|
|
|
|
|
return \%data;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция задаёт имена файлов для хэндлов
|
|
|
|
|
# $obj->set_filenames (handle1 => 'template1.tpl', handle2 => 'template2.tpl', ...)
|
|
|
|
|
##
|
|
|
|
|
sub set_filenames {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my %fns = @_;
|
|
|
|
|
while (my ($k,$v) = each(%fns)) {
|
|
|
|
|
$self->{files}{$k} = $self->make_filename($v);
|
|
|
|
|
}
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
2007-09-11 02:46:55 +04:00
|
|
|
|
##
|
|
|
|
|
# Функция загружает файлы переводов (внутри хеши)
|
|
|
|
|
# $obj->load_lang ($filename, $filename, ...);
|
|
|
|
|
##
|
|
|
|
|
sub load_lang {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $new;
|
|
|
|
|
my $i = 0;
|
|
|
|
|
foreach (@_) {
|
|
|
|
|
$new = do $_;
|
|
|
|
|
unless ($@) {
|
|
|
|
|
$self->{lang}->{$_} = $new->{$_}, $i++ foreach keys %$new;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return $i;
|
|
|
|
|
}
|
|
|
|
|
|
2007-05-21 03:34:53 +04:00
|
|
|
|
##
|
|
|
|
|
# Функция преобразовывает относительные имена файлов в абсолютные
|
|
|
|
|
# $obj->make_filename ($filename)
|
|
|
|
|
##
|
|
|
|
|
sub make_filename {
|
|
|
|
|
my $self = shift;
|
2007-06-02 02:30:09 +04:00
|
|
|
|
my ($fn) = @_;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
$fn = $self->{root}.'/'.$fn if ($fn !~ m%^/%o);
|
|
|
|
|
die("Template->make_filename(): file $fn does not exist") unless (-e $fn);
|
|
|
|
|
return $fn;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция уничтожает данные шаблона
|
|
|
|
|
# $obj->destroy ()
|
|
|
|
|
##
|
|
|
|
|
sub destroy {
|
|
|
|
|
shift->{_tpldata} = {};
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция сохраняет текущие данные шаблона в стек и уничтожает их
|
|
|
|
|
# $obj->datapush ()
|
|
|
|
|
##
|
|
|
|
|
sub datapush {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
push (@{$self->{_tpldata_stack}}, \$self->{_tpldata});
|
|
|
|
|
destroy $self;
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция восстанавливает данные шаблона из стека
|
|
|
|
|
# $obj->datapop ()
|
|
|
|
|
##
|
|
|
|
|
sub datapop {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
return 0 if (@{$self->{_tpldata_stack}} <= 0);
|
|
|
|
|
$self->{_tpldata} = pop @{$self->{_tpldata_stack}};
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция загружает, компилирует и возвращает результат для хэндла
|
|
|
|
|
# $obj->parse ('handle')
|
|
|
|
|
##
|
|
|
|
|
sub parse {
|
2007-06-02 02:30:09 +04:00
|
|
|
|
my $self = shift;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
my $handle = shift;
|
|
|
|
|
die("Template->parse(): couldn't load template file for handle $handle") unless $self->loadfile($handle);
|
|
|
|
|
$self->{compiled_code}{$handle} = $self->compile ($self->{uncompiled_code}{$handle});
|
2007-06-02 02:30:09 +04:00
|
|
|
|
my $str = eval ($self->{compiled_code}{$handle});
|
2007-05-21 03:34:53 +04:00
|
|
|
|
die("Template->parse(): $@") if $@;
|
2007-06-02 02:30:09 +04:00
|
|
|
|
$str = &$self->{wrapper} ($str) if $self->{wrapper};
|
|
|
|
|
return $str;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция присваивает переменные блока в новую итерацию
|
|
|
|
|
# $obj->assign_block_vars ($block, varname1 => value1, varname2 => value2, ...)
|
|
|
|
|
##
|
|
|
|
|
sub assign_block_vars {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $block = shift;
|
|
|
|
|
my $vararray = { @_ };
|
|
|
|
|
|
|
|
|
|
if (!$block || $block =~ /^\.+$/so) { # если не блок, а корневой уровень
|
|
|
|
|
$self->assign_vars (@_);
|
2007-05-30 20:02:10 +04:00
|
|
|
|
} elsif ($block !~ /\.[^\.]/) { # если блок, но не вложенный
|
2007-05-21 03:34:53 +04:00
|
|
|
|
$block =~ s/\.*$/./; # добавляем . в конец, если надо
|
|
|
|
|
$self->{_tpldata}{$block} = [] unless $self->{_tpldata}{$block};
|
|
|
|
|
push @{$self->{_tpldata}{$block}}, $vararray;
|
|
|
|
|
} else { # если вложенный блок
|
|
|
|
|
my $ev = '$self->{_tpldata}';
|
|
|
|
|
$block =~ s/\.+$//; # обрезаем точки в конце (хоть их 10 там)
|
|
|
|
|
my @blocks = split /\./, $block;
|
|
|
|
|
my $lastblock = pop @blocks;
|
|
|
|
|
foreach (@blocks) {
|
|
|
|
|
$ev .= "{'$_.'}";
|
2007-05-30 20:02:10 +04:00
|
|
|
|
$ev .= "[-1+\@\{$ev\}]";
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
$ev .= "{'$lastblock.'}";
|
|
|
|
|
$ev = "$ev = [] unless $ev; push \@\{$ev\}, \$vararray;";
|
|
|
|
|
eval ($ev);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция добавляет переменные к текущей итерации блока
|
|
|
|
|
# $obj->append_block_vars ($block, varname1 => value1, varname2 => value2, ...)
|
|
|
|
|
##
|
|
|
|
|
sub append_block_vars {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $block = shift;
|
|
|
|
|
my %vararray = @_;
|
|
|
|
|
my $lastit;
|
|
|
|
|
|
|
|
|
|
if (!$block || $block eq '.') { # если не блок, а корневой уровень
|
|
|
|
|
$self->assign_vars (@_);
|
|
|
|
|
} elsif ($block !~ /\../) { # если блок, но не вложенный
|
|
|
|
|
$block =~ s/\.*$/./; # добавляем . в конец, если надо
|
2007-06-02 02:30:09 +04:00
|
|
|
|
$lastit = @{$self->{_tpldata}{$block}} - 1;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
$self->{_tpldata}{$block}[$lastit]{$_} = $vararray{$_} foreach (keys %vararray);
|
|
|
|
|
} else { # если вложенный блок
|
|
|
|
|
my $ev = '$self->{_tpldata}';
|
|
|
|
|
$block =~ s/\.+$//; # обрезаем точки в конце (хоть их 10 там)
|
|
|
|
|
my @blocks = split /\.+/, $block;
|
|
|
|
|
foreach (@blocks) {
|
|
|
|
|
$ev .= "{'$_.'}";
|
2007-05-30 20:02:10 +04:00
|
|
|
|
$ev .= "[-1+\@\{$ev\}]";
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
$ev = "\$ev{\$k} = \$vararray{\$k} foreach \$k (keys \%vararray);";
|
|
|
|
|
eval ($ev);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция присваивает переменные корневого уровня
|
|
|
|
|
# $obj->assign_vars (varname1 => value1, varname2 => value2, ...)
|
|
|
|
|
##
|
|
|
|
|
sub assign_vars {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
$self->{_tpldata}{'.'}[0] = {} unless $self->{_tpldata}{'.'}[0];
|
|
|
|
|
%{$self->{_tpldata}{'.'}[0]} = (%{$self->{_tpldata}{'.'}[0]}, @_);
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция загружает файл для хэндла HANDLE
|
|
|
|
|
# $obj->loadfile ($handle)
|
|
|
|
|
##
|
|
|
|
|
sub loadfile {
|
2007-06-02 02:30:09 +04:00
|
|
|
|
my $self = shift;
|
|
|
|
|
my ($handle) = @_;
|
|
|
|
|
return 1 if $self->{uncompiled_code}{$handle};
|
|
|
|
|
die("Template->loadfile(): no file specified for handle $handle") unless $self->{files}{$handle};
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
|
|
|
|
# если оно false, но задано, значит, код задан, минуя файлы
|
|
|
|
|
if ($self->{files}{$handle})
|
|
|
|
|
{
|
|
|
|
|
my $filename = $self->{files}{$handle};
|
|
|
|
|
my $filepath;
|
|
|
|
|
|
|
|
|
|
$filepath = $` if $filename =~ m%(?<=/)[^/]*$%;
|
2007-06-02 02:30:09 +04:00
|
|
|
|
my $cnt = file_get_contents ($filename);
|
|
|
|
|
die("Template->loadfile(): file for handle $handle is empty") unless $cnt;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
2007-06-02 02:30:09 +04:00
|
|
|
|
$cnt =~ s/\Q$&\E/file_get_contents($1)/eg while (m/<!-- INCLUDE\s+(.*?)\s+-->/go);
|
|
|
|
|
$self->{uncompiled_code}{$handle} = $cnt;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция компилирует код
|
|
|
|
|
# $compiled_code = $obj->compile ($uncompiled_code)
|
|
|
|
|
##
|
|
|
|
|
sub compile {
|
|
|
|
|
my ($self, $code) = @_;
|
|
|
|
|
|
|
|
|
|
my ($sfile, $nesting) = ('', 0);
|
|
|
|
|
my @code_lines = ();
|
|
|
|
|
my @block_names = ('.');
|
|
|
|
|
my ($cbstart, $cbcount, $cbplus, $mm);
|
|
|
|
|
|
|
|
|
|
# а может быть, уже кэшировано?
|
|
|
|
|
if ($self->{cachedir}) {
|
|
|
|
|
$self->{cachedir} .= '/' if (substr($self->{cachedir},-1,1) ne '/');
|
|
|
|
|
$sfile = $self->{cachedir} . md5_hex ($code) . '.pl';
|
|
|
|
|
return file_get_contents($sfile) if -e $sfile;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# комментарии <!--# ... #-->
|
|
|
|
|
$code =~ s/\s*<!--#.*?#-->//gos;
|
|
|
|
|
|
|
|
|
|
# форматирование кода для красоты
|
2007-09-11 02:46:55 +04:00
|
|
|
|
$code =~ s/(?:^|\n)\s*(<!--\s*(?:BEGIN|END|IF|REGION|ENDREGION|INCREGION!?)\s+.*?-->)\s*(?:$|\n)/\x01$1\x01\n/gos;
|
|
|
|
|
1 while $code =~ s/(?<!\x01)<!--\s*(?:BEGIN|END|IF|REGION|ENDREGION|INCREGION!?)\s+.*?-->/\x01$&/gom;
|
|
|
|
|
1 while $code =~ s/<!--\s*(?:BEGIN|END|IF|REGION|ENDREGION|INCREGION!?)\s+.*?-->(?!\x01)/$&\x01/gom;
|
|
|
|
|
|
2007-05-21 03:34:53 +04:00
|
|
|
|
# ' и \ -> \' и \\
|
|
|
|
|
$code =~ s/\'|\\/\\$&/gos;
|
|
|
|
|
|
|
|
|
|
# номера итераций
|
|
|
|
|
$code =~ s/\{([a-z0-9\-_]+)\.#\}/\'.(1+(\$_${1}_i)?\$_${1}_i:0)).\'/gois;
|
|
|
|
|
|
2007-09-11 02:46:55 +04:00
|
|
|
|
# подстановки переменных {block.block.[...].variable[|alternative]}
|
2007-05-21 03:34:53 +04:00
|
|
|
|
$code =~ s%\{((?:[a-z0-9\-_]+\.)*)([a-z0-9\-_/]+)(?:\|([a-z0-9\-_/]+))?\}%$self->generate_block_varref($1,$2,$3)%goise;
|
|
|
|
|
|
2007-09-11 02:46:55 +04:00
|
|
|
|
# переводы <!-- L section.section.section VARIABLE|"string" -->
|
|
|
|
|
$code =~ s%<!--\s+L\s+((?:\w+\.)*\w+)\s+(\"(?:[^\\\"]+|\\\"|\\\\)*\"|(?:[a-z0-9\-_]+\.)*(?:[a-z0-9\-_/]+))\s+-->%$self->generate_l_ref($1,$2)%goise;
|
|
|
|
|
|
2007-05-21 03:34:53 +04:00
|
|
|
|
# \n -> \n\x01
|
|
|
|
|
$code =~ s/\n/\n\x01/gos;
|
|
|
|
|
|
|
|
|
|
# разбиваем код на строки
|
|
|
|
|
@code_lines = split /\x01/, $code;
|
|
|
|
|
foreach (@code_lines) {
|
|
|
|
|
next unless $_;
|
2007-06-02 02:30:09 +04:00
|
|
|
|
if (/^\s*<!--\s*BEGIN\s+([A-Za-z0-9\-_]+?)\s+([A-Za-z \t\-_0-9]*)-->\s*$/os) { # начало блока
|
2007-05-21 03:34:53 +04:00
|
|
|
|
$nesting++;
|
|
|
|
|
$block_names[$nesting] = $1;
|
|
|
|
|
$cbstart = 0; $cbcount = ''; $cbplus = '++';
|
|
|
|
|
|
|
|
|
|
{
|
|
|
|
|
my $o2 = $2;
|
|
|
|
|
if ($o2 =~ /^[ \t]*AT ([0-9]+)[ \t]*(?:([0-9]+)[ \t]*)?$/) {
|
|
|
|
|
$cbstart = $1;
|
|
|
|
|
$cbcount = $2 ? $1+$2 : 0;
|
|
|
|
|
} elsif ($o2 =~ /^[ \t]*MOD ([1-9][0-9]*) ([0-9]+)[ \t]*$/) {
|
|
|
|
|
$cbstart = $2;
|
|
|
|
|
$cbplus = '+='.$1;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# либо min (N, $cbcount) если $cbcount задано
|
|
|
|
|
# либо просто N если нет
|
|
|
|
|
if ($nesting < 2) { # блок не вложенный
|
2007-06-02 03:58:22 +04:00
|
|
|
|
if ($cbcount) { $_ = "\$_${1}_count = min (scalar(\@\{\$self->{_tpldata}{'$1.'}\}), " . $cbcount . ');'; }
|
2007-05-21 03:34:53 +04:00
|
|
|
|
else { $_ = "\$_${1}_count = scalar(\@{\$self->{_tpldata}{'$1.'}});"; }
|
|
|
|
|
# начало цикла for
|
|
|
|
|
$_ .= "\nfor (\$_${1}_i = $cbstart; \$_${1}_i < \$_${1}_count; \$_${1}_i$cbplus)\n{";
|
|
|
|
|
}
|
|
|
|
|
else { # блок вложенный
|
|
|
|
|
my $namespace = substr (join ('.', @block_names), 2);
|
|
|
|
|
my $varref = $self->generate_block_data_ref ($namespace);
|
|
|
|
|
if ($cbcount) { $_ = "\$_${1}_count = min (scalar(\@\{$varref\}), $cbcount);"; }
|
|
|
|
|
else { $_ = "\$_${1}_count = (\@\{$varref\}) ? scalar(\@\{$varref\}) : 0;"; }
|
|
|
|
|
$_ .= "\nfor (\$_${1}_i = $cbstart; \$_${1}_i < \$_${1}_count; \$_${1}_i$cbplus)\n{";
|
|
|
|
|
}
|
2007-06-02 02:30:09 +04:00
|
|
|
|
} elsif (/^\s*<!--\s*END\s+(.*?)-->\s*$/) {
|
2007-05-21 03:34:53 +04:00
|
|
|
|
# чётко проверяем: блок нельзя завершать чем попало
|
|
|
|
|
delete $block_names[$nesting--] if ($nesting > 0 && trim ($1) eq $block_names[$nesting]);
|
|
|
|
|
$_ = "} # END $1";
|
2007-06-02 02:30:09 +04:00
|
|
|
|
} elsif (/^\s*<!--\s*IF(!?)\s+((?:[a-zA-Z0-9\-_]+\.)*)([a-zA-Z0-9\-_\/]+)\s*-->\s*$/) {
|
2007-05-21 03:34:53 +04:00
|
|
|
|
$_ = "if ($1(".$self->generate_block_data_ref(substr($2,0,-1),1)."{'$3'})) {";
|
2007-06-02 02:30:09 +04:00
|
|
|
|
} elsif (/^\s*<!--\s*REGION\s+([a-zA-Z0-9\-_]+)\s*-->\s*$/) {
|
|
|
|
|
$_ = "\$self->{_tpldata}{'.regions'}{'$1'} = <<'____ENDREGION';\nno strict;\nmy \$t='';";
|
|
|
|
|
} elsif (/^\s*<!--\s*ENDREGION\s*-->\s*$/) {
|
|
|
|
|
$_ = "return \$t;\n____ENDREGION";
|
|
|
|
|
} elsif (/^\s*<!--\s*INCREGION\s+([a-zA-Z0-9\-_]+)\s*-->\s*$/) {
|
|
|
|
|
$_ = "\$t .= eval(\$self->{_tpldata}{'.regions'}{'$1'});";
|
|
|
|
|
} else {
|
2007-05-21 03:34:53 +04:00
|
|
|
|
$_ = "\$t .= '$_';";
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# собираем код в строку
|
|
|
|
|
$code = "no strict;\nmy \$t='';\n" . join ("\n", @code_lines) . "\nreturn \$t;";
|
|
|
|
|
|
|
|
|
|
# кэшируем код
|
|
|
|
|
if ($self->{cachedir} && open (my $fd, '>'.$sfile)) {
|
|
|
|
|
print $fd $code;
|
|
|
|
|
close $fd;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return $code;
|
|
|
|
|
}
|
|
|
|
|
|
2007-09-11 02:46:55 +04:00
|
|
|
|
##
|
|
|
|
|
# Функция выдаёт код, переводящий строку в кавычках или переменную шаблона
|
|
|
|
|
# $translation = $obj->generate_l_ref ($section, $what);
|
|
|
|
|
##
|
|
|
|
|
sub generate_l_ref {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my ($section, $what) = @_;
|
|
|
|
|
$section =~ s/\\/\\\\/gso;
|
|
|
|
|
$section =~ s/\'/\\\'/gso;
|
|
|
|
|
$section =~ s/\./\'}->{\'/gso;
|
|
|
|
|
if ($what !~ /^\"/so || $what !~ /\"$/so) {
|
|
|
|
|
my $block = '';
|
|
|
|
|
$block = $1 if $what =~ s/^([^\.]+)\.//iso;
|
|
|
|
|
$what = $self->generate_block_varref ($block, $what);
|
|
|
|
|
$what =~ s/^\' \. //iso;
|
|
|
|
|
$what =~ s/ \. \'$//iso;
|
|
|
|
|
} else {
|
|
|
|
|
$what =~ s/^\"//so;
|
|
|
|
|
$what =~ s/\"$//so;
|
|
|
|
|
$what =~ s/\'/\\\'/gso;
|
|
|
|
|
$what = "'$what'";
|
|
|
|
|
}
|
|
|
|
|
return '\' . ($self->{lang}->{\''.$section.'\'}->{'.$what.'} || \'\') . \'';
|
|
|
|
|
}
|
|
|
|
|
|
2007-05-21 03:34:53 +04:00
|
|
|
|
##
|
|
|
|
|
# Функция генерирует подстановку переменной шаблона
|
|
|
|
|
# $varref = $obj->generate_block_varref ($namespace, $varname, $varoption)
|
|
|
|
|
##
|
|
|
|
|
sub generate_block_varref {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my ($namespace, $varname, $varoption) = @_;
|
2007-09-11 02:46:55 +04:00
|
|
|
|
my ($varconv, $varref);
|
2007-05-21 03:34:53 +04:00
|
|
|
|
($varname, $varconv) = split '/', $varname, 2;
|
|
|
|
|
# обрезаем точки в конце
|
2007-09-11 02:46:55 +04:00
|
|
|
|
$namespace =~ s/\.*$//o;
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
|
|
|
|
$varref = $self->generate_block_data_ref ($namespace, 1);
|
|
|
|
|
# готовим альтернативу
|
|
|
|
|
unless ($varoption) { $varoption = "''"; }
|
|
|
|
|
else { $varoption = "((${varref}{'$varoption'}) ? ${varref}{'$varoption'} : '')"; }
|
|
|
|
|
|
|
|
|
|
# добавляем имя переменной
|
|
|
|
|
$varref .= "{'$varname'}";
|
2007-09-11 02:46:55 +04:00
|
|
|
|
$varref = "($varref || $varoption)";
|
2007-05-21 03:34:53 +04:00
|
|
|
|
|
2007-09-11 02:46:55 +04:00
|
|
|
|
# # генерируем преобразование [not implemented]
|
2007-05-21 03:34:53 +04:00
|
|
|
|
# $varref = $self->generate_conversion_ref ($varref, $varconv) if ($varconv);
|
|
|
|
|
$varref = "' . $varref . '";
|
|
|
|
|
return $varref;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
# Функция генерирует обращение к массиву переменных блока
|
|
|
|
|
# $blockref = $obj->generate_block_data_ref ($block, $include_last_iterator)
|
|
|
|
|
##
|
|
|
|
|
sub generate_block_data_ref {
|
|
|
|
|
my $self = shift;
|
|
|
|
|
my $blockref = '$self->{_tpldata}';
|
|
|
|
|
my ($block, $withlastit) = @_;
|
|
|
|
|
|
|
|
|
|
# для корневого блока
|
|
|
|
|
return '$self->{_tpldata}{\'.\'}' . ($withlastit ? '[0]' : '') if ($block =~ /^\.*$/o);
|
|
|
|
|
|
|
|
|
|
# строим цепочку блоков
|
|
|
|
|
$block =~ s/\.+$//o;
|
|
|
|
|
my @blocks = split (/\.+/, $block);
|
|
|
|
|
my $lastblock = pop (@blocks);
|
|
|
|
|
$blockref .= "{'$_.'}[\$_${_}_i]" foreach @blocks;
|
|
|
|
|
$blockref .= "{'$lastblock.'}";
|
|
|
|
|
|
|
|
|
|
# добавляем последний итератор, если надо
|
|
|
|
|
$blockref .= "[\$_${lastblock}_i]" if ($withlastit);
|
|
|
|
|
return $blockref;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
1;
|