line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::Template::Library; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
28056
|
use 5.008008; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
45
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
44
|
|
5
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
39
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
596
|
use Text::Template::Base (); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
8
|
|
|
|
|
|
|
our @ISA=('Text::Template::Base'); |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
4
|
use Carp qw/croak/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
105
|
|
11
|
1
|
|
|
|
|
7
|
use Class::Member::HASH qw/_library _output _evalcache _broken _broken_arg |
12
|
1
|
|
|
1
|
|
893
|
_prepend _filename/; |
|
1
|
|
|
|
|
1030
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
108
|
use Exporter qw/import/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
196
|
|
15
|
|
|
|
|
|
|
our @EXPORT_OK=qw/fill_in_module/; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '0.04'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub _acquire_data { |
20
|
18
|
|
|
18
|
|
34
|
my $I=shift; |
21
|
|
|
|
|
|
|
|
22
|
18
|
100
|
|
|
|
94
|
return 1 if( $I->{DATA_ACQUIRED} ); |
23
|
|
|
|
|
|
|
|
24
|
9
|
|
|
|
|
39
|
$I->_library={}; |
25
|
|
|
|
|
|
|
|
26
|
9
|
|
|
|
|
184
|
my $rc=$I->Text::Template::Base::_acquire_data(@_); |
27
|
9
|
50
|
|
|
|
27
|
return unless( defined $rc ); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# NOTE: all variables used in (?{}) regexps must be real globs. |
30
|
|
|
|
|
|
|
# $c1 counts newlines up to the opening delimiter plus a possible newline |
31
|
|
|
|
|
|
|
# after the "define" line |
32
|
|
|
|
|
|
|
# $c2 counts newlines inside the definition and after it |
33
|
9
|
|
|
|
|
17
|
our ($lineno, $start_of_macro, $c1, $c2, $nl_per_delim); |
34
|
9
|
|
|
|
|
24
|
local ($lineno, $start_of_macro, $c1, $c2)=(1,0,0,0); |
35
|
|
|
|
|
|
|
|
36
|
9
|
100
|
|
|
|
12
|
my @delim=@{$I->{DELIM} || [qw/{ }/]}; |
|
9
|
|
|
|
|
48
|
|
37
|
9
|
|
|
|
|
37
|
local $nl_per_delim=($delim[0]=~tr/\n//)+($delim[1]=~tr/\n//); |
38
|
|
|
|
|
|
|
|
39
|
1
|
|
|
1
|
|
33
|
use re 'eval'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1142
|
|
40
|
9
|
|
|
|
|
45
|
my $sp=qr/[\x20\t\r\f]+/; # \s without newline |
41
|
|
|
|
|
|
|
my $re=qr!(?sxm) # pattern modifiers same as //sxm |
42
|
14
|
|
|
|
|
70
|
(?{$c1=$c2=0}) # init |
|
16
|
|
|
|
|
138
|
|
43
|
13
|
|
|
|
|
167
|
((?:\n(?{local $c1=$c1+1}) # count newlines |
44
|
|
|
|
|
|
|
|.)*?) # all stuff up to DELIM1 is \$1 |
45
|
|
|
|
|
|
|
\Q$delim[0]\E $sp # now we match [% define NAME %]: opening [% |
46
|
|
|
|
|
|
|
define $sp (\w+) $sp # define NAME (\$2) |
47
|
|
|
|
|
|
|
\Q$delim[1]\E # closing %] |
48
|
|
|
|
|
|
|
(?:\s*? # spaces up to the first newline |
49
|
39
|
|
|
|
|
572
|
\n(?{local $c1=$c1+1}))? # are skipped |
50
|
20
|
|
|
|
|
51
|
((?:\n(?{local $c2=$c2+1}) # count newlines to \$c2 |
51
|
|
|
|
|
|
|
|.)*?) # and save the macro to \$3 |
52
|
|
|
|
|
|
|
\Q$delim[0]\E $sp # now we match [% /define NAME %]: opening [% |
53
|
|
|
|
|
|
|
/define $sp # /define |
54
|
|
|
|
|
|
|
\Q$delim[1]\E # closing %] |
55
|
|
|
|
|
|
|
(?:\n(?{local $c2=$c2+1}) # count newlines |
56
|
|
|
|
|
|
|
|\s)* # spaces after DELIM2 |
57
|
|
|
|
|
|
|
(?{ # save counters |
58
|
14
|
|
|
|
|
24
|
$start_of_macro=$lineno+$c1+$nl_per_delim; |
59
|
14
|
|
|
|
|
126
|
$lineno=$start_of_macro+$c2; |
60
|
|
|
|
|
|
|
}) |
61
|
9
|
|
|
|
|
725
|
!; |
62
|
9
|
|
|
|
|
255
|
$I->{SOURCE}=~s/$re/ |
63
|
14
|
50
|
|
|
|
49
|
if( exists $I->_library->{$2} ) { |
64
|
0
|
|
0
|
|
|
0
|
my $t=$I->{FILENAME} || 'template'; |
65
|
0
|
|
|
|
|
0
|
warn "Template Library module $1 redefined at $t line $start_of_macro"; |
66
|
|
|
|
|
|
|
} |
67
|
14
|
|
|
|
|
275
|
$I->_library->{$2}="$delim[0]#line $start_of_macro$delim[1]$3"; |
68
|
14
|
|
|
|
|
239
|
"$1$delim[0]#line $lineno$delim[1]"/ge; |
69
|
|
|
|
|
|
|
|
70
|
9
|
|
|
|
|
59
|
return $rc; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub fill_in { |
74
|
13
|
|
|
13
|
1
|
2254
|
my $I=shift; |
75
|
|
|
|
|
|
|
|
76
|
13
|
50
|
|
|
|
45
|
croak "DELIMITERS are not allowed here" |
77
|
|
|
|
|
|
|
if( defined Text::Template::Base::_param('delimiters', @_) ); |
78
|
|
|
|
|
|
|
|
79
|
13
|
50
|
|
|
|
38
|
croak "Safe comartments are not supported" |
80
|
|
|
|
|
|
|
if( defined Text::Template::Base::_param('safe', @_) ); |
81
|
|
|
|
|
|
|
|
82
|
13
|
100
|
|
|
|
42
|
unless( $I->{TYPE} eq 'PREPARSED' ) { |
83
|
9
|
50
|
|
|
|
59
|
$I->compile or return undef; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
13
|
|
|
|
|
49
|
my $varhash=Text::Template::Base::_param('hash', @_); |
87
|
13
|
|
|
|
|
39
|
my $package=Text::Template::Base::_param('package', @_) ; |
88
|
|
|
|
|
|
|
|
89
|
13
|
|
|
|
|
33
|
for my $name (qw/output evalcache broken broken_arg prepend filename/) { |
90
|
78
|
|
|
|
|
832
|
my $f="_$name"; |
91
|
78
|
|
|
|
|
199
|
my $rc=$I->$f=Text::Template::Base::_param($name, @_); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
13
|
|
|
|
|
197
|
unshift @_, $I; |
95
|
|
|
|
|
|
|
|
96
|
13
|
|
|
|
|
32
|
local *T=\$I; |
97
|
13
|
100
|
100
|
|
|
63
|
unless( defined $package or defined $varhash ) { |
98
|
6
|
|
|
|
|
15
|
my $package=caller; |
99
|
6
|
|
|
|
|
16
|
push @_, PACKAGE=>$package; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# cannot use "goto &fill_in" here because of "local *T" |
103
|
13
|
|
|
|
|
35
|
return &Text::Template::Base::fill_in; # pass @_ indirectly |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub _probearg { |
107
|
518
|
|
|
518
|
|
721
|
my ($I, $name)=@_; |
108
|
518
|
|
|
|
|
682
|
my $f="_$name"; |
109
|
518
|
|
|
|
|
1314
|
my $rc=$I->$f; |
110
|
518
|
100
|
|
|
|
5682
|
defined $rc and return (uc($name)=>$rc); |
111
|
511
|
|
|
|
|
790
|
$name=uc $name; |
112
|
511
|
100
|
|
|
|
1213
|
if( exists $I->{$name} ) { |
113
|
361
|
|
|
|
|
479
|
$rc=$I->{$name}; |
114
|
361
|
100
|
|
|
|
1196
|
defined $rc and return ($name=>$rc); |
115
|
|
|
|
|
|
|
} |
116
|
374
|
|
|
|
|
737
|
return; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub module { |
120
|
77
|
|
|
77
|
1
|
109
|
my ($I, $name)=@_; |
121
|
|
|
|
|
|
|
|
122
|
77
|
50
|
|
|
|
194
|
croak "Template Library module $name doesn't exist" |
123
|
|
|
|
|
|
|
unless( exists $I->_library->{$name} ); |
124
|
|
|
|
|
|
|
|
125
|
77
|
|
|
|
|
1055
|
my $tmpl=$I->_library->{$name}; |
126
|
77
|
100
|
|
|
|
887
|
unless( ref($tmpl) ) { |
127
|
56
|
|
|
|
|
109
|
$tmpl=$I->_library->{$name}=Text::Template::Base->new |
128
|
|
|
|
|
|
|
(TYPE=>'STRING', SOURCE=>$tmpl, |
129
|
14
|
100
|
|
|
|
36
|
map( {$I->_probearg($_)} qw/evalcache broken |
130
|
|
|
|
|
|
|
prepend filename/ ), |
131
|
|
|
|
|
|
|
(defined $I->{DELIM} ? (DELIMITERS=>$I->{DELIM}) : ())); |
132
|
14
|
50
|
|
|
|
213
|
croak "Template Library module $name failed to compile: $Text::Template::Base::ERROR" |
133
|
|
|
|
|
|
|
unless $tmpl->compile; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
77
|
|
|
|
|
203
|
return $tmpl; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub library { |
140
|
23
|
|
|
23
|
1
|
172
|
my ($I, $name, @p)=@_; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my $rc=$I->module($name)->fill_in( |
143
|
|
|
|
|
|
|
PACKAGE=>scalar caller, |
144
|
23
|
|
|
|
|
57
|
do { |
145
|
23
|
|
|
|
|
33
|
local $_; |
146
|
23
|
|
|
|
|
34
|
map( {$I->_probearg($_)} |
|
138
|
|
|
|
|
260
|
|
147
|
|
|
|
|
|
|
qw/output evalcache broken |
148
|
|
|
|
|
|
|
broken_arg prepend filename/ ) |
149
|
|
|
|
|
|
|
}, |
150
|
|
|
|
|
|
|
@p, |
151
|
|
|
|
|
|
|
); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# I want the template to be able to do: |
154
|
|
|
|
|
|
|
# $OUT.=$Text::Template::Library::T->library($module); |
155
|
|
|
|
|
|
|
# That means we must return the resulting string if no OUTPUT option |
156
|
|
|
|
|
|
|
# was given. But if an OUTPUT option was given we must return an |
157
|
|
|
|
|
|
|
# emtpy string. |
158
|
|
|
|
|
|
|
# Hence, we have to throw an exception on error. |
159
|
23
|
50
|
|
|
|
61
|
croak "Template Library module $name failed: $Text::Template::Base::ERROR" |
160
|
|
|
|
|
|
|
unless( $rc ); |
161
|
23
|
100
|
|
|
|
81
|
return '' if( $I->_output ); |
162
|
19
|
|
|
|
|
300
|
return $rc; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub fill_in_module { |
166
|
54
|
|
|
54
|
1
|
293
|
my ($name, @p)=@_; |
167
|
|
|
|
|
|
|
|
168
|
54
|
|
|
|
|
60
|
our $T; |
169
|
54
|
50
|
|
|
|
112
|
croak "No current template" unless( defined $T ); |
170
|
|
|
|
|
|
|
my $rc=$T->module($name)->fill_in( |
171
|
|
|
|
|
|
|
PACKAGE=>scalar caller, |
172
|
54
|
|
|
|
|
130
|
do { |
173
|
54
|
|
|
|
|
57
|
local $_; |
174
|
54
|
|
|
|
|
75
|
map( {$T->_probearg($_)} |
|
324
|
|
|
|
|
618
|
|
175
|
|
|
|
|
|
|
qw/output evalcache broken |
176
|
|
|
|
|
|
|
broken_arg prepend filename/ ) |
177
|
|
|
|
|
|
|
}, |
178
|
|
|
|
|
|
|
@p, |
179
|
|
|
|
|
|
|
); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# I want the template to be able to do: |
182
|
|
|
|
|
|
|
# $OUT.=Text::Template::Library::fill_in_module($module); |
183
|
|
|
|
|
|
|
# That means we must return the resulting string if no OUTPUT option |
184
|
|
|
|
|
|
|
# was given. But if an OUTPUT option was given we must return an |
185
|
|
|
|
|
|
|
# emtpy string. |
186
|
|
|
|
|
|
|
# Hence, we have to throw an exception on error. |
187
|
54
|
50
|
|
|
|
149
|
croak "Template Library module $name failed: $Text::Template::Base::ERROR" |
188
|
|
|
|
|
|
|
unless( $rc ); |
189
|
54
|
50
|
|
|
|
330
|
return '' if( $T->_output ); |
190
|
54
|
|
|
|
|
1338
|
return $rc; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
1; |
194
|
|
|
|
|
|
|
__END__ |