| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package CGI::Embedder;
|
|
2
|
1
|
|
|
1
|
|
5520
|
use strict;
|
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
723
|
|
|
3
|
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
our $VERSION = 1.21;
|
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
# Настроечные константы.
|
|
7
|
|
|
|
|
|
|
my $c0=chr(1); # символ для qw
|
|
8
|
|
|
|
|
|
|
my %ExpandCache=(); # кэш
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# string Compile(string $Content [string \&filter_func(string $st)])
|
|
11
|
|
|
|
|
|
|
# Преобразует весь текст в строке $Content ВНЕ тэгов в серию print.
|
|
12
|
|
|
|
|
|
|
# Сами тэги , конечно, удаляются. Если затем проработать результат
|
|
13
|
|
|
|
|
|
|
# eval-ом, напечатается "развернутый" шаблон в чистом виде. Если задан
|
|
14
|
|
|
|
|
|
|
# параметр &filter_func, то эта функция вызывается для каждой подстроки
|
|
15
|
|
|
|
|
|
|
# вне . Она должна возвращать обработанную строку. Но если в
|
|
16
|
|
|
|
|
|
|
# ней появятся , они уже не будут обработаны!
|
|
17
|
|
|
|
|
|
|
sub Compile($;$)
|
|
18
|
0
|
|
|
0
|
1
|
|
{ my ($Cont,$filter)=@_;
|
|
19
|
0
|
|
|
|
|
|
$Cont =~ s{^\t*}{}mgo;
|
|
20
|
0
|
|
|
|
|
|
$Cont="?>$Cont
|
|
21
|
0
|
|
|
|
|
|
$Cont=~s{<\?=}{
|
|
22
|
0
|
0
|
|
|
|
|
if(!$filter) {
|
|
23
|
0
|
|
|
|
|
|
$Cont=~s{\?>(\n?)(.*?)<\?}{"$1;print(qq$c0"._Slash($2)."$c0);"}sgeo;
|
|
|
0
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
} else {
|
|
25
|
0
|
|
|
|
|
|
$Cont=~s{\?>(\n?)(.*?)<\?}{"$1;print(qq$c0"._Slash(&$filter($2))."$c0);"}sgeo;
|
|
|
0
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
}
|
|
27
|
0
|
|
|
|
|
|
$Cont=~s{print qq$c0$c0}{}sgo;
|
|
28
|
0
|
|
|
|
|
|
return $Cont;
|
|
29
|
|
|
|
|
|
|
}
|
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# void Expand(string $Templ [,string $CacheId] [,string $Filename])
|
|
32
|
|
|
|
|
|
|
# "Разворачивает" шаблон $Templ. Результат печатается с помощью print.
|
|
33
|
|
|
|
|
|
|
# Потом его можно перехватить с помощью модуля CGI::WebOut. Удобно
|
|
34
|
|
|
|
|
|
|
# использовать в "почтовых" целях. Если задан параметр $CacheId, то
|
|
35
|
|
|
|
|
|
|
# шаблон кэшируется, и для следующего вызова ExpandTemplate()
|
|
36
|
|
|
|
|
|
|
# с таким же $CacheId компилирование шаблона уже не произойдет.
|
|
37
|
|
|
|
|
|
|
# Параметр $Filename влияет только не сообщения об ошибках, которые
|
|
38
|
|
|
|
|
|
|
# могут возникнуть в шаблоне $Templ.
|
|
39
|
|
|
|
|
|
|
sub Expand($;$;$;$)
|
|
40
|
0
|
|
|
0
|
1
|
|
{ my ($Templ,$CacheId,$Filename,$pkg)=@_;
|
|
41
|
0
|
|
|
|
|
|
my $Compiled;
|
|
42
|
0
|
0
|
0
|
|
|
|
if(defined($CacheId) && exists($ExpandCache{$CacheId})) {
|
|
43
|
0
|
|
|
|
|
|
$Compiled=$ExpandCache{$CacheId};
|
|
44
|
|
|
|
|
|
|
} else {
|
|
45
|
0
|
|
|
|
|
|
$Compiled=Compile($Templ);
|
|
46
|
0
|
0
|
|
|
|
|
if(defined($CacheId)) { $ExpandCache{$CacheId}=$Compiled; }
|
|
|
0
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
}
|
|
48
|
0
|
|
0
|
|
|
|
$pkg||=caller;
|
|
49
|
0
|
|
0
|
|
|
|
$Filename||="template";
|
|
50
|
0
|
|
|
|
|
|
$@=undef;
|
|
51
|
0
|
|
|
|
|
|
eval("package $pkg; no strict;\n#line 1 \"$Filename\"\n$Compiled;");
|
|
52
|
0
|
0
|
|
|
|
|
die $@ if $@;
|
|
53
|
0
|
|
|
|
|
|
return;
|
|
54
|
|
|
|
|
|
|
}
|
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# string ExpandFile($fname)
|
|
57
|
|
|
|
|
|
|
# То же, что и Expand(), только считывает файл с диска.
|
|
58
|
|
|
|
|
|
|
sub ExpandFile($)
|
|
59
|
0
|
|
|
0
|
1
|
|
{ my ($fname)=@_;
|
|
60
|
0
|
|
|
|
|
|
local *F;
|
|
61
|
0
|
0
|
|
|
|
|
if(!open(F,$fname)) {
|
|
62
|
0
|
|
|
|
|
|
require Carp;
|
|
63
|
0
|
|
|
|
|
|
Carp::croak("Could not open the file $fname");
|
|
64
|
|
|
|
|
|
|
}
|
|
65
|
0
|
|
|
|
|
|
binmode(F);
|
|
66
|
0
|
|
|
|
|
|
local ($/,$\);
|
|
67
|
0
|
|
|
|
|
|
return Expand(,$fname,$fname,caller);
|
|
68
|
|
|
|
|
|
|
}
|
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# string _Slash(string $st)
|
|
71
|
|
|
|
|
|
|
# Проставляет слэши перед специальными символами, а также обрабатывает
|
|
72
|
|
|
|
|
|
|
# вхождения символов-разделителей.
|
|
73
|
|
|
|
|
|
|
sub _Slash($)
|
|
74
|
0
|
|
|
0
|
|
|
{ my ($st)=@_;
|
|
75
|
0
|
|
|
|
|
|
$st=~s/$c0/$c0."$c0".qq$c0/g;
|
|
76
|
0
|
|
|
|
|
|
$st=~s/(\r?\n\s*#line\s*\d[^\n]*\r?\n)/$c0;$1print qq$c0/gs;
|
|
77
|
0
|
|
|
|
|
|
$st=~s/\\(?!\$)/\\\\/g;
|
|
78
|
0
|
|
|
|
|
|
$st=~s/\@/\\\@/g;
|
|
79
|
0
|
|
|
|
|
|
$st=~s/\%/\\\%/g;
|
|
80
|
0
|
|
|
|
|
|
return $st;
|
|
81
|
|
|
|
|
|
|
}
|
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
return 1;
|
|
84
|
|
|
|
|
|
|
__END__
|