File Coverage

blib/lib/Template/Tiny.pm
Criterion Covered Total %
statement 50 56 89.2
branch 19 24 79.1
condition 5 6 83.3
subroutine 8 8 100.0
pod 2 3 66.6
total 84 97 86.6


line stmt bran cond sub pod time code
1             package Template::Tiny; # git description: v1.13-3-g7fb3b0a
2             # ABSTRACT: Template Toolkit reimplemented in as little code as possible
3              
4              
5             # Load overhead: 40k
6              
7 3     3   178504 use strict;
  3         28  
  3         2663  
8              
9             our $VERSION = '1.14';
10              
11             # Evaluatable expression
12             my $EXPR = qr/ [a-z_][\w.]* /xs;
13              
14             # Opening [% tag including whitespace chomping rules
15             my $LEFT = qr/
16             (?:
17             (?: (?:^|\n) [ \t]* )? \[\%\-
18             |
19             \[\% \+?
20             ) \s*
21             /xs;
22              
23             # Closing %] tag including whitespace chomping rules
24             my $RIGHT = qr/
25             \s* (?:
26             \+? \%\]
27             |
28             \-\%\] (?: [ \t]* \n )?
29             )
30             /xs;
31              
32             # Preparsing run for nesting tags
33             my $PREPARSE = qr/
34             $LEFT ( IF | UNLESS | FOREACH ) \s+
35             (
36             (?: \S+ \s+ IN \s+ )?
37             \S+ )
38             $RIGHT
39             (?!
40             .*?
41             $LEFT (?: IF | UNLESS | FOREACH ) \b
42             )
43             ( .*? )
44             (?:
45             $LEFT ELSE $RIGHT
46             (?!
47             .*?
48             $LEFT (?: IF | UNLESS | FOREACH ) \b
49             )
50             ( .+? )
51             )?
52             $LEFT END $RIGHT
53             /xs;
54              
55             # Condition set
56             my $CONDITION = qr/
57             \[\%\s
58             ( ([IUF])\d+ ) \s+
59             (?:
60             ([a-z]\w*) \s+ IN \s+
61             )?
62             ( $EXPR )
63             \s\%\]
64             ( .*? )
65             (?:
66             \[\%\s \1 \s\%\]
67             ( .+? )
68             )?
69             \[\%\s \1 \s\%\]
70             /xs;
71              
72             sub new {
73 13     13 1 19901 bless { @_[1..$#_] }, $_[0];
74             }
75              
76             # Copy and modify
77             sub preprocess {
78 3     3 0 19 my $self = shift;
79 3         5 my $text = shift;
80 3         11 $self->_preprocess(\$text);
81 3         10 return $text;
82             }
83              
84             sub process {
85 10     10 1 2537 my $self = shift;
86 10         15 my $copy = ${shift()};
  10         17  
87 10   50     26 my $stash = shift || {};
88              
89 10         17 local $@ = '';
90 10         28 local $^W = 0;
91              
92             # Preprocess to establish unique matching tag sets
93 10         24 $self->_preprocess( \$copy );
94              
95             # Process down the nested tree of conditions
96 10         26 my $result = $self->_process( $stash, $copy );
97 10 50       23 if ( @_ ) {
    0          
98 10         11 ${$_[0]} = $result;
  10         35  
99             } elsif ( defined wantarray ) {
100 0         0 require Carp;
101 0         0 Carp::carp('Returning of template results is deprecated in Template::Tiny 0.11');
102 0         0 return $result;
103             } else {
104 0         0 print $result;
105             }
106             }
107              
108              
109              
110              
111              
112             ######################################################################
113             # Support Methods
114              
115             # The only reason this is a standalone is so we can
116             # do more in-depth testing.
117             sub _preprocess {
118 13     13   19 my $self = shift;
119 13         15 my $copy = shift;
120              
121             # Preprocess to establish unique matching tag sets
122 13         15 my $id = 0;
123 13         781 1 while $$copy =~ s/
124             $PREPARSE
125             /
126 20         57 my $tag = substr($1, 0, 1) . ++$id;
127 20 100       1062 "\[\% $tag $2 \%\]$3\[\% $tag \%\]"
128             . (defined($4) ? "$4\[\% $tag \%\]" : '');
129             /sex;
130             }
131              
132             sub _process {
133 30     30   66 my ($self, $stash, $text) = @_;
134              
135 30         231 $text =~ s/
136             $CONDITION
137             /
138             ($2 eq 'F')
139             ? $self->_foreach($stash, $3, $4, $5)
140 18 100       43 : eval {
    100          
141 16   100     29 $2 eq 'U'
142             xor
143             !! # Force boolification
144             $self->_expression($stash, $4)
145             }
146             ? $self->_process($stash, $5)
147             : $self->_process($stash, $6)
148             /gsex;
149              
150             # Resolve expressions
151 30         291 $text =~ s/
152             $LEFT ( $EXPR ) $RIGHT
153             /
154 34         53 eval {
155 34         60 $self->_expression($stash, $1)
156             . '' # Force stringification
157             }
158             /gsex;
159              
160             # Trim the document
161 30 100       80 $text =~ s/^\s*(.+?)\s*\z/$1/s if $self->{TRIM};
162              
163 30         172 return $text;
164             }
165              
166             # Special handling for foreach
167             sub _foreach {
168 2     2   8 my ($self, $stash, $term, $expr, $text) = @_;
169              
170             # Resolve the expression
171 2         7 my $list = $self->_expression($stash, $expr);
172 2 50       8 unless ( ref $list eq 'ARRAY' ) {
173 0         0 return '';
174             }
175              
176             # Iterate
177             return join '', map {
178 2         4 $self->_process( { %$stash, $term => $_ }, $text )
  4         15  
179             } @$list;
180             }
181              
182             # Evaluates a stash expression
183             sub _expression {
184 52     52   66 my $cursor = $_[1];
185 52         96 my @path = split /\./, $_[2];
186 52         74 foreach ( @path ) {
187             # Support for private keys
188 74 100       127 return undef if substr($_, 0, 1) eq '_';
189              
190             # Split by data type
191 72         98 my $type = ref $cursor;
192 72 100       117 if ( $type eq 'ARRAY' ) {
    100          
    50          
193 5 100       16 return '' unless /^(?:0|[0-9]\d*)\z/;
194 4         7 $cursor = $cursor->[$_];
195             } elsif ( $type eq 'HASH' ) {
196 65         98 $cursor = $cursor->{$_};
197             } elsif ( $type ) {
198 2         7 $cursor = $cursor->$_();
199             } else {
200 0         0 return '';
201             }
202             }
203 49         287 return $cursor;
204             }
205              
206             1;
207              
208             __END__