File Coverage

blib/lib/Text/Template/Library.pm
Criterion Covered Total %
statement 99 101 98.0
branch 31 42 73.8
condition 3 5 60.0
subroutine 14 14 100.0
pod 4 4 100.0
total 151 166 90.9


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__