File Coverage

blib/lib/Template/Pure/Filters.pm
Criterion Covered Total %
statement 56 87 64.3
branch 11 16 68.7
condition 15 19 78.9
subroutine 19 29 65.5
pod 22 23 95.6
total 123 174 70.6


line stmt bran cond sub pod time code
1             package Template::Pure::Filters;
2            
3 26     26   388048 use strict;
  26         28  
  26         626  
4 26     26   82 use warnings;
  26         27  
  26         520  
5 26     26   83 use Scalar::Util ();
  26         24  
  26         272  
6 26     26   77 use Data::Dumper ();
  26         23  
  26         279  
7 26     26   10109 use URI::Escape ();
  26         25148  
  26         524  
8 26     26   8347 use Template::Pure::EncodedString;
  26         46  
  26         22496  
9              
10             sub all {
11             return (
12 16     16 0 157 format => \&format,
13             strftime => \&strftime,
14             dump => \&dump,
15             uri_escape_utf8 => \&uri_escape_utf8,
16             uri_escape => \&uri_escape,
17             upper => \&upper,
18             lower => \&lower,
19             upper_first => \&upper_first,
20             lower_first => \&lower_first,
21             collapse => \&collapse,
22             encoded_string => \&encoded_string,
23             escape_html => \&escape_html,
24             truncate => \&truncate,
25             repeat => \&repeat,
26             remove => \&remove,
27             replace => \&replace,
28             comma => \&comma,
29             ltrim => \&ltrim,
30             rtrim => \&rtrim,
31             trim => \&trim,
32             default => \&default,
33             cond => \&cond,
34             );
35             }
36              
37             sub escape_html {
38 201     201 1 190 my ($value) = @_;
39 201         558 my %_escape_table = (
40             '&' => '&',
41             '>' => '>',
42             '<' => '&lt;',
43             q{"} => '&quot;',
44             q{'} => '&#39;' );
45              
46 201 100 100     870 if(
      66        
47             Scalar::Util::blessed($value) && (
48             $value->isa('Template::Pure::EncodedString') ||
49             $value->isa('Mojo::DOM58')
50             )
51             ) {
52 58         148 return $value;
53             } else {
54 143 100 100     670 $value =~ s/([&><"'])/$_escape_table{$1}/ge unless
  4   66     14  
55             !defined($value) ||
56             (Scalar::Util::blessed($value) && $value->isa('Template::Pure::UndefObject'));
57 143         459 return $value;
58             }
59             }
60              
61             sub format {
62 1     1 1 71 my ($template, $data, $format) = @_;
63 1         13 return sprintf($format, $data);
64             }
65              
66             sub strftime {
67 1     1 1 399 my ($template, $date_obj, $format) = @_;
68 1 50 33     14 die "Must be an object that does 'strftime'"
69             unless Scalar::Util::blessed($date_obj) && $date_obj->can('strftime');
70 1         4 return $date_obj->strftime($format);
71             }
72              
73             sub dump {
74 0     0 1 0 my ($template, $value) = @_;
75 0         0 warn Data::Dumper::Dumper $value;
76 0         0 return $value;
77             }
78              
79             sub cond {
80 2     2 1 2 my ($template, $check, $if_true, $if_false) = @_;
81 2 100       10 return $check ? $if_true : $if_false;
82             }
83             sub uri_escape {
84 1     1 1 487 my ($template, $data, $unsafe) = @_;
85 1 50       4 if($unsafe) {
86 0         0 return URI::Escape::uri_escape($data, $unsafe);
87             } else {
88 1         5 return URI::Escape::uri_escape($data);
89             }
90             }
91              
92             sub uri_escape_utf8 {
93 1     1 1 466 my ($template, $data, $unsafe) = @_;
94 1 50       4 if($unsafe) {
95 0         0 return URI::Escape::uri_escape_utf8($data, $unsafe);
96             } else {
97 1         3 return URI::Escape::uri_escape_utf8($data);
98             }
99             }
100              
101             sub upper {
102 7     7 1 9 my ($template, $data) = @_;
103 7         41 return uc $data;
104             }
105              
106             sub lower {
107 0     0 1 0 my ($template, $data) = @_;
108 0         0 return lc $data;
109             }
110              
111             sub upper_first {
112 0     0 1 0 my ($template, $data) = @_;
113 0         0 return ucfirst $data;
114             }
115              
116             sub lower_first {
117 0     0 1 0 my ($template, $data) = @_;
118 0         0 return lcfirst $data;
119             }
120              
121             sub collapse {
122 0     0 1 0 my ($template, $data) = @_;
123 0         0 for ($data) {
124 0         0 s/^\s+//;
125 0         0 s/\s+$//;
126 0         0 s/\s+/ /g;
127             }
128 0         0 return $data;
129             }
130              
131             sub encoded_string {
132 2     2 1 5 my ($template, $data) = @_;
133 2         18 return Template::Pure::EncodedString->new($data);
134             }
135              
136             sub truncate {
137 7     7 1 469 my ($template, $data, $length, $affix) = @_;
138 7   100     37 my $allowed_length = $length - length($affix||'');
139 7 100       17 if(length $data > $allowed_length) {
140 5   100     20 $data = substr($data, 0, $allowed_length) . ($affix||'');
141             }
142 7         28 return $data;
143             }
144              
145             sub repeat {
146 3     3 1 5 my ($template, $data, $times) = @_;
147 3         13 return $data x $times;
148             }
149              
150             sub remove {
151 2     2 1 4 my ($template, $data, $match) = @_;
152 2         18 $data =~ s/$match//g;
153 2         6 return $data
154             }
155              
156             sub replace {
157 0     0 1 0 my ($template, $data, $match, $replace) = @_;
158 0         0 $data =~ s/$match/$replace/g;
159 0         0 return $data
160             }
161              
162             sub default {
163 0     0 1 0 my ($template, $data, $default) = @_;
164 0 0       0 return defined($data) ? $data : $default;
165             }
166              
167             sub ltrim {
168 0     0 1 0 my ($template, $data) = @_;
169 0         0 $data =~s/^\s+//;
170 0         0 return $data;
171             }
172              
173             sub rtrim {
174 0     0 1 0 my ($template, $data) = @_;
175 0         0 $data =~s/\s+$//;
176 0         0 return $data;
177             }
178              
179             sub trim {
180 0     0 1 0 my ($template, $data) = @_;
181 0         0 $data =~s/^\s+|\s+$//g;
182 0         0 return $data;
183             }
184              
185             sub comma {
186 1     1 1 2 my ($template, $data) = @_;
187 1         16 1 while $data =~ s/((?:\A|[^.0-9])[-+]?\d+)(\d{3})/$1,$2/s;
188 1         4 return $data;
189             }
190              
191              
192             1;
193              
194             =head1 NAME
195              
196             Template::Pure::Filters - Default Data Filters
197              
198             =head1 SYNOPSIS
199              
200             my $html = qq[
201             <html>
202             <head>
203             <title>Page Title</title>
204             </head>
205             <body>
206             </body>
207             </html>
208             ];
209              
210             my $pure = Template::Pure->new(
211             template=>$html,
212             directives=> [
213             'body' => 'content | repeat(3) | escape_html',
214             ]
215             );
216              
217             my $data = +{
218             content => q[
219             <p>Are you <b>doomed</b> to discover that you never recovered from the narcoleptic
220             country in which you once <u>stood?</u> Where the fire's always burning, but
221             there's <i>never enough wood</i></p>?
222             ],
223             };
224              
225             print $pure->render($data);
226              
227             Returns:
228              
229             <html>
230             <head>
231             <title>Page Title</title>
232             </head>
233             <body>
234             <p>Are you <b>doomed</b> to discover that you never recovered from the narcoleptic
235             country in which you once <u>stood?</u> Where the fire's always burning, but
236             there's <i>never enough wood</i></p>
237             <p>Are you <b>doomed</b> to discover that you never recovered from the narcoleptic
238             country in which you once <u>stood?</u> Where the fire's always burning, but
239             there's <i>never enough wood</i></p>
240             <p>Are you <b>doomed</b> to discover that you never recovered from the narcoleptic
241             country in which you once <u>stood?</u> Where the fire's always burning, but
242             there's <i>never enough wood</i></p>
243             </body>
244             </html>
245              
246             (Note that the embedded HTML was not HTML encoded due to the use of the 'escape_html'
247             filter.)
248              
249             =head1 DESCRIPTION
250              
251             Container modules for all the filters that are bundled with L<Template::Pure>. Please
252             see L<Template::Pure/"Filtering your data"> for usage. A lot of this is copied from
253             L<Template::Filters> and other filters from template languages like L<Xslate>.
254              
255             Filters are arrange in 'UNIX pipe' syntax, so the output of the first filter becomes the
256             input of the second and so forth. It also means filter are order sensitive. Some filters
257             like the 'escape_html' filter only make sense if they are the last in the pipe.
258              
259             Some filters may take arguments, for example:
260              
261             directives=> [
262             'body' => 'content | repeat(3)',
263             ]
264              
265             Generally these are literals which are parsed out via regular expressions and then we use C<eval>
266             to generate Perl values. As a result you are strongly encouraged to properly untaint and secure
267             these arguments (for example don't pass them in from a HTML form POST...).
268              
269             You may pass arguments to filters via the data context using placeholder notation. Placeholder
270             notation may be freely mixed in with argument literals.
271              
272             directives=> [
273             'body' => 'content | repeat(#{times_to_repeat})',
274             ]
275              
276             Filters may be added to your current L<Template::Pure> instance:
277              
278             my $pure = Template::Pure->new(
279             filters => {
280             my_custom_filter => sub {
281             my ($template_pure, $data, @args) = @_;
282             return $modified_data;
283             },
284             }, ... );
285              
286             Custom filters get the current L<Template::Pure> instance, the current data context and any
287             arguments; you are expected to return modified data.
288              
289             =head1 FILTERS
290              
291             This module defines the following subroutines that are used as filters for L<Template::Pure>:
292              
293             =head2 format ($format)
294            
295             The C<format> filter takes a format string as a parameter (as per C<sprintf()>) and formats the
296             data accordingly.
297              
298             my $pure = Template::Pure->new(
299             template => '<p>Price: $<span>1.00</span></p>'
300             directives => [
301             'span' => 'price | format(%.2f)',
302             ],
303             );
304              
305             print $pure->render({
306             price => '2.0000001'
307             });
308              
309             Output:
310            
311             <p>Price: $<span>2.00</span></p>
312              
313             =head2 strftime ($format)
314              
315             Given an object that does 'strftime' return a string formatted date / time;
316              
317             my $pure = Template::Pure->new(
318             template => '<p>Year</p>'
319             directives => [
320             'p' => 'date | strftime(%Y)',
321             ],
322             );
323              
324             print $pure->render({
325             date => DateTime->new(year=>2016, month=>12),
326             });
327              
328             Output:
329            
330             <p>2016</p>
331              
332             =head2 dump
333              
334             This filter doesn't actually change the data. It just uses L<Data::Dumper> and sends
335             C<Dumper> output to STDOUT via C<warn>. Can be useful during debugging when you can't
336             figure out what is amiss with your data. After it dumps to STDOUT we just return the
337             value unaltered.
338              
339             =head2 uri_escape
340              
341             =head2 uri_escape_utf8
342              
343             These filters are just wrappers around the same in L<URI::Escape>.
344              
345             =head2 upper
346              
347             =head2 lower
348              
349             =head2 upper_first
350              
351             =head2 lower_first
352              
353             Does text case conversions using Perl built in functions C<uc>, C<lc>, C<ucfirst> and C<lcfirst>.
354              
355             =head2 collapse
356              
357             Collapse any whitespace sequences in the input text into a single space. Leading and trailing whitespace
358             (which would be reduced to a single space) is removed, as per trim.
359              
360             =head2 encoded_string
361              
362             By default L<Template::Pure> escapes your values using a simple HTML escape function so that your
363             output is 'safe' from HTML injection attacks. However there might be cases when you wish to all raw
364             HTML to be injected into your template, froom known, safe data. In this case you can use this function
365             to mark your data as "don't encode". We will assume you know what you are doing...
366              
367             =head2 escape_html
368              
369             As mentioned in the previous filter documentation, we nearly always automatically escape your data values
370             when they get rendered into your template to produce a document. However as also mentioned there are
371             a few case where we don't, since we think its the more common desired behavior, such as when you
372             are injecting a template object or you are setting the value from the contents of a different node inside
373             the same template. In those cases, should HTML escaping be desired you can use this filter to make it so.
374              
375             =head2 truncate ($length, $affix)
376              
377             Truncates string data to $length (where $length is the total allowed number of characters). In the case
378             when we need to truncate, add $affix to the end to indicate truncation. For example you may set $affix
379             to '...' to indicate characters were removed. There is no default $affix.
380              
381             B<NOTE> Should you use an $affix we automatically increase the required truncation so that the new string
382             INCLUDING THE $affix fits into the required $length.
383              
384             =head2 repeat ($times)
385              
386             Repeat a value by $times.
387              
388             =head2 remove ($match)
389              
390             Searches the input text for any occurrences of the specified string and removes them.
391             A Perl regular expression may be specified as the search string.
392              
393             =head2 replace ($match, $replacement)
394              
395             Like L</remove> but does a global search and replace instead of removing. Can also use
396             a regular expression in the $match
397              
398             =head2 default ($value)
399              
400             Should $data be undefined, use $value instead.
401              
402             =head2 rtrim
403              
404             =head2 ltrim
405              
406             =head2 trim
407              
408             Removes all whitespace from either the right side, left side, or both sides of the data
409              
410             =head2 comma
411              
412             Given a data value which is a number, comma-fy it for readability (100000 = > 100,000).
413              
414             =head2 cond
415              
416             A filter that is like the conditional operator (?). Takes two arguments and returns the
417             first one if the filtered value is true and the second one otherwise.
418              
419             my $pure = Template::Pure->new(
420             template=>q[
421             <input name='toggle' type='checkbox'>
422             ],
423             directives=> [
424             'input[name="toggle"]@checked' => 'checkbox_is_set |cond("on", undef)',
425             ],
426             );
427              
428             =head1 SEE ALSO
429            
430             L<Template::Pure>.
431              
432             =head1 AUTHOR
433            
434             John Napiorkowski L<email:jjnapiork@cpan.org>
435              
436             But lots of this code was copied from L<Template::Filters> and other prior art on CPAN. Thanks!
437            
438             =head1 COPYRIGHT & LICENSE
439            
440             Please see L<Template::Pure> for copyright and license information.
441              
442             =cut
443