File Coverage

blib/lib/Text/MiniTmpl.pm
Criterion Covered Total %
statement 95 106 89.6
branch 24 30 80.0
condition 2 3 66.6
subroutine 23 25 92.0
pod 5 5 100.0
total 149 169 88.1


line stmt bran cond sub pod time code
1             package Text::MiniTmpl;
2              
3 12     12   200669 use warnings;
  12         26  
  12         414  
4 12     12   55 use strict;
  12         16  
  12         396  
5 12     12   49 use Carp;
  12         22  
  12         829  
6              
7 12     12   5537 use version; our $VERSION = qv('1.1.6'); # REMINDER: update Changes
  12         18003  
  12         58  
8              
9             # REMINDER: update dependencies in Makefile.PL
10 12     12   6848 use Perl6::Export::Attrs;
  12         69863  
  12         75  
11 12     12   9064 use JSON::XS qw( encode_json );
  12         57088  
  12         823  
12 12     12   5160 use URI::Escape qw();
  12         12122  
  12         259  
13 12     12   6040 use HTML::Entities qw();
  12         61166  
  12         967  
14              
15 12     12   99 use constant UNSAFE_HTML=> '&"\'<>' . join q{},map{chr}0..8,11,12,14..31,127;
  12         17  
  12         30  
  360         1551  
16 12     12   58 use constant RAWPRE => q{$}.__PACKAGE__.'::__ .= ';
  12         15  
  12         530  
17 12     12   48 use constant RAWPOST => q{};
  12         15  
  12         569  
18 12     12   49 use constant UTF8PRE => q{$}.__PACKAGE__.'::__utf8 = ';
  12         19  
  12         654  
19 12         1805 use constant UTF8POST => 'utf8::encode($'.__PACKAGE__.'::__utf8);' .
20 12     12   44 q{$}.__PACKAGE__.'::__ .= $'.__PACKAGE__.'::__utf8;';
  12         11  
21              
22             our $__;
23             our $__utf8;
24             our $TMPL_DIR = q{./};
25              
26             my %CACHE;
27             my ($PRE, $POST) = (UTF8PRE, UTF8POST);
28              
29              
30             sub raw :Export {
31 1     1 1 576 my ($is_raw) = @_;
32 1 50       4 ($PRE, $POST) = $is_raw ? (RAWPRE, RAWPOST) : (UTF8PRE, UTF8POST);
33 1         3 return;
34 12     12   58 }
  12         11  
  12         79  
35              
36             sub render :Export {
37 55     55 1 19861 my ($tmpl, %p) = @_;
38 55 100       286 my $path = $tmpl =~ m{\A[.]?/}xms ? $tmpl : "$TMPL_DIR$tmpl";
39 55         175 1 while $path =~ s{(\A|/) (?![.][.]?/) [^/]+/[.][.]/}{$1}xms; ## no critic(ProhibitPostfixControls)
40 55         106 my $pkg = caller;
41 55   66     657 $CACHE{$path}{$pkg} ||= tmpl2code($tmpl);
42 52         46 return ${ $CACHE{$path}{$pkg}->(%p) };
  52         174  
43 12     12   4591 }
  12         39  
  12         44  
44              
45             sub tmpl2code :Export {
46 41     41 1 888 my ($tmpl) = @_;
47 41 100       162 my $path = $tmpl =~ m{\A[.]?/}xms ? $tmpl : "$TMPL_DIR$tmpl";
48 41         143 1 while $path =~ s{(\A|/) (?![.][.]?/) [^/]+/[.][.]/}{$1}xms; ## no critic(ProhibitPostfixControls)
49 41         56 my $dir = $path;
50 41         209 $dir =~ s{/[^/]*\z}{/}xms;
51 41         54 my $line = 1;
52 41         63 my $pkg = caller;
53 41 100       407 if ($pkg eq __PACKAGE__) {
54 34         54 $pkg = caller 1;
55             }
56 41         527 my $e
57             = 'package '.$pkg.'; use warnings; use strict;'
58             . 'sub {'
59             . 'local $'.__PACKAGE__.'::__ = q{};'
60             . 'local $'.__PACKAGE__."::TMPL_DIR = \"\Q$dir\E\";"
61             . 'local %_ = @_;'
62             . "\n#line $line \"$path\"\n"
63             ;
64 41 50       1600 open my $fh, '<', $path or croak "open: $!";
65 41         57 my $s = do { local $/ = undef; <$fh> };
  41         145  
  41         691  
66 41 50       318 close $fh or croak "close: $!";
67 41         48 while ( 1 ) {
68 261 100       1718 $e .=
    100          
    100          
    100          
    100          
    100          
69             $s=~/\G<!--& ( (?>[^-]*) .*? ) -->/xmsgc
70             ? "$1;"
71             : $s=~/\G&~ ( (?>[^~]*) .*? ) ~&/xmsgc
72             ? "$1;"
73             : $s=~/\G@~ ( (?>[^~]*) .*? ) ~@/xmsgc
74             ? $PRE."HTML::Entities::encode_entities(''.(do { $1; }), ".__PACKAGE__.'::UNSAFE_HTML);'.$POST
75             : $s=~/\G\#~ ( (?>[^~]*) .*? ) ~\#/xmsgc
76             ? $PRE."do { $1; };".$POST
77             : $s=~/\G\^~ ( (?>[^~]*) .*? ) ~\^/xmsgc
78             ? $PRE."URI::Escape::uri_escape_utf8(''.(do { $1; }));".$POST
79             : $s=~/\G ( (?>[^<&@\#^]*) .*? ) (?=<!--&|&~|@~|\#~|\^~|\z)/xmsgc
80             ? q{$}.__PACKAGE__."::__ .= \"\Q$1\E\";"
81             : last;
82 220         255 $line += $1 =~ tr/\n//;
83 220         296 $e .= "\n#line $line \"$path\"\n";
84             }
85 41         49 $e .= '; return \$'.__PACKAGE__.'::__ }';
86             # do instead of eval to have better diagnostics and support source filters
87 41 50   9   654 open my $fhe, '<', \$e or croak "open: $!"; ## no critic(RequireBriefOpen)
  9         78  
  9         9  
  9         75  
88 41     41   8853 local @INC = ( sub {shift @INC; $fhe}, @INC );
  41         57  
  41         3573  
89 41         200 my $code = do '[eval]';
90 41 100       56152 croak $@ if $@;
91 38         287 return $code;
92 12     12   8889 }
  12         18  
  12         54  
93              
94             sub encode_js :Export {
95 0     0 1 0 my ($s) = @_;
96 0         0 $s = quotemeta $s;
97 0         0 $s =~ s/\n/n/xmsg;
98 0         0 while ($s =~ s/\G([^\\]*(?:\\[^.+-][^\\]*)*)\\([.+-])/$1$2/xmsg) {};
99 0         0 return $s;
100 12     12   3010 }
  12         18  
  12         44  
101              
102             sub encode_js_data :Export {
103 0     0 1 0 my ($s) = @_;
104 0 0       0 if ($POST eq UTF8POST) {
105 0         0 $s = JSON::XS->new->encode($s);
106             } else {
107 0         0 $s = encode_json($s);
108             }
109 0         0 $s =~ s{</script}{<\\/script}xmsg;
110 0         0 return $s;
111 12     12   2802 }
  12         16  
  12         56  
112              
113              
114             1; # Magic true value required at end of module
115             __END__
116              
117             =encoding utf8
118              
119             =head1 NAME
120              
121             Text::MiniTmpl - Compile and render templates
122              
123              
124             =head1 SYNOPSIS
125              
126             use Text::MiniTmpl qw( render );
127              
128             $html1 = render('template.html', %params1);
129             $html2 = render('template.html', %params2);
130              
131              
132             =head1 DESCRIPTION
133              
134             Compile templates with embedded perl code into anonymous subroutines.
135             These subroutines can be (optionally) cached, and executed to render these
136             templates with (optional) parameters.
137              
138             Perl code in templates will be executed with:
139              
140             package PACKAGE_WHERE_render_OR_tmpl2code_WAS_CALLED;
141             use warnings;
142             use strict;
143              
144             Recursion in templates is supported (you can call render() or tmpl2code()
145             inside template to "include" another template inside current one).
146             Path name to included template can be set in several ways:
147              
148             =over
149              
150             =item *
151              
152             path relative to current template's directory: C< 'file', 'dir/file', '../file' >
153              
154             =item *
155              
156             path relative to current working directory (where your script executed):
157             C< './file', './dir/file' >
158              
159             =item *
160              
161             absolute path: C< '/dir/file' >
162              
163             =back
164              
165             When you render top-level template (i.e. call render() from your script,
166             not inside some template) paths C< 'file' > and C< './file' >, C< 'dir/file' >
167             and C< './dir/file' > are same.
168              
169             Correctly report compile errors in templates, with template name and line
170             number.
171              
172             =head2 Unicode support
173              
174             Files with templates should be in UTF8. Parameters for templates should be
175             perl Unicode scalars. Rendered template (returned by render() or by
176             function returned by tmpl2code()) will be in UTF8.
177              
178             You can disable it using raw(1) (see below) to get more speed.
179              
180             =head2 Source Filters support
181              
182             Probably not all filters will work inside templates - keep in mind filter
183             will see autogenerated (by tmpl2code()) perl function's code instead of
184             plain template text. See `perldoc perlfilter` for more details.
185              
186             Example:
187              
188             &~ use Filter::CommaEquals; ~&
189             &~ @{ $_{users} } ,= 'GHOST' ~&
190             &~ for (@{ $_{users} }) { ~&
191             <p>Hello, @~ $_ ~@!</p>
192             &~ } ~&
193              
194             =head2 Template syntax
195              
196             Any template become perl function after parsing. This function will accept
197             it parameters in C< %_ > (it start with C< local %_ = @_; >).
198             Of course, you can use my() and local() variables in template (their scope
199             will be full template, not only placeholder's block where they was defined).
200              
201             =over
202              
203             =item &~ PERL CODE ~&
204              
205             =item <!--& PERL CODE -->
206              
207             Execute PERL CODE but don't output anything.
208              
209             =item @~ PERL CODE ~@
210              
211             Execute PERL CODE and output it result (last calculated expression)
212             escaped using HTML::Entities::encode_entities().
213              
214             =item ^~ PERL CODE ~^
215              
216             Execute PERL CODE and output it result (last calculated expression)
217             escaped using URI::Escape::uri_escape_utf8().
218              
219             =item #~ PERL CODE ~#
220              
221             Execute PERL CODE and output it result (last calculated expression)
222             AS IS, without any escaping.
223              
224             =item any other text ...
225              
226             ... will be output AS IS
227              
228              
229             =back
230              
231             Example templates:
232              
233             To: #~ $_{email} ~#
234             Hello, #~ $username ~#. Here is items your asked for:
235             &~ for (@{ $_{items} }) { ~&
236             #~ $_ ~#
237             &~ } ~&
238              
239             ---cut header.html---
240             <html>
241             <head><title>@~ $_{pagetitle} ~@</title></head>
242             <body>
243              
244             ---cut index.html---
245             #~ render('header.html', pagetitle=>'Home') ~#
246             <p>Hello, @~ $_{username} ~@.</p>
247             &~ # In HTML you may prefer <!--& instead of &~ for code blocks ~&
248             <!--& for (@{ $_{topics} }) { -->
249             <a href="news.cgi?topic=^~ $_ ~^&user=^~ $_{user} ~^">
250             News about @~ $_ ~@
251             </a>
252             <!--& } -->
253             #~ render('footer.html') ~#
254              
255             ---cut footer.html---
256             </body>
257             </html>
258              
259              
260             =head1 EXPORTS
261              
262             Nothing by default, but all documented functions can be explicitly imported.
263              
264              
265             =head1 INTERFACE
266              
267             =over
268              
269             =item render( $filename, %params )
270              
271             Render template from $filename with %params.
272              
273             This is caching wrapper around tmpl2code(), which avoid calling
274             tmpl2code() second time for same $filename.
275              
276             Example:
277              
278             $html = render( 'template/index.html',
279             title => $title,
280             name => $name,
281             );
282              
283             Return STRING with rendered template.
284              
285              
286             =item tmpl2code( $filename )
287              
288             Read template from $filename (may be absolute or relative to current
289             template's directory or current working directory - see L</DESCRIPTION>),
290             compile it into ANON function.
291              
292             This function can be executed with C< ( %params ) > parameters,
293             it will render $filename template with given C< %params > and return
294             SCALARREF to rendered text.
295              
296             Example:
297              
298             $code = tmpl2code( 'template/index.html' );
299             $html = ${ $code->( title=>$title, name=>$name ) };
300              
301             Return CODEREF to that function.
302              
303              
304             =item raw( $is_raw )
305              
306             If $is_raw TRUE disable Unicode support.
307             To enable Unicode again call raw() with $is_raw FALSE.
308              
309             B<Disabling Unicode support will speedup this module in about 1.5 times!>
310              
311             When Unicode support disabled your parameters used to render template will
312             be used in template AS IS, without attempt to encode them to UTF8.
313             This mean you shouldn't use perl Unicode scalars in these parameters anymore.
314              
315             This affect only templates processed by tmpl2code() after calling raw()
316             (beware caching effect of render()).
317              
318              
319             =item encode_js( $scalar )
320              
321             Encode $scalar (string or number) for inserting into JavaScript code
322             (usually inside HTML templates).
323              
324             Example:
325              
326             <script>
327             var int_from_perl = #~ encode_js($number) ~#;
328             var str_from_perl = '#~ encode_js($string) ~#';
329             </script>
330              
331             Return encoded string.
332              
333              
334             =item encode_js_data( $complex )
335              
336             Encode $complex data structure (HASHREF, ARRAYREF, etc. - any data type
337             supported by JSON::XS) for inserting into JavaScript code (usually inside
338             HTML templates).
339              
340             Example:
341              
342             <script>
343             var hash_from_perl = #~ encode_js_data( \%hash ) ~#;
344             var array_from_perl = #~ encode_js_data( \@array ) ~#;
345             </script>
346              
347             Return encoded string.
348              
349              
350             =back
351              
352              
353             =head1 SPEED AND SIZE
354              
355             This module implemented under 100 lines (about 3KB) of pure Perl code.
356             And while code is terse enough, I believe it still simple and clean.
357              
358             While this is pure-perl module with many enough features, it's still very
359             fast - you can do your own benchmarking using cool L<Template::Benchmark>
360             module, here is results from my system:
361              
362             =over
363              
364             =item instance_reuse
365              
366             This test simulate standard FastCGI which read template from HDD and
367             compile it only once (when this template requested first time), and for
368             next requests it just render it using cached anon subroutine.
369              
370             Rate XS?
371             TT 29/s - Template::Toolkit (2.22)
372             TT_X 95/s Y Template::Toolkit (2.22) with Stash::XS
373             HM 704/s - HTML::Mason (1.45)
374             TeCS 738/s Y Text::ClearSilver (0.10.5.4)
375             TeMT 1131/s - Text::MicroTemplate (0.18)
376             TeMMHM 1173/s - Text::MicroMason (2.12) using Text::MicroMason::HTMLMason
377             * TMTU 1357/s - Text::MiniTmpl (1.1.0) with enabled Unicode
378             MoTe 1629/s - Mojo::Template ()
379             * TMT 2054/s - Text::MiniTmpl (1.1.0)
380             TeClev 5966/s Y Text::Clevery (0.0004) in XS mode
381             TeXs 6761/s Y Text::Xslate (0.2015)
382              
383             =item uncached_disk
384              
385             This test simulate standard CGI which read template from HDD, compile and
386             render it on each run - no caches used at all (except HDD files caching by OS).
387              
388             Rate XS?
389             TeXs 1.4/s Y Text::Xslate (0.2015)
390             TeClev 1.5/s Y Text::Clevery (0.0004) in XS mode
391             HM 12.6/s - HTML::Mason (1.45)
392             MoTe 21.0/s - Mojo::Template ()
393             TeMT 32.1/s - Text::MicroTemplate (0.18)
394             TeMMHM 36.2/s - Text::MicroMason (2.12) using Text::MicroMason::HTMLMason
395             * TMTU 54.1/s - Text::MiniTmpl (1.1.0) with enabled Unicode
396             * TMT 67.9/s - Text::MiniTmpl (1.1.0)
397             TeTmpl 448/s Y Text::Tmpl (0.33)
398             TeCS 725/s Y Text::ClearSilver (0.10.5.4)
399             HTP 1422/s Y HTML::Template::Pro (0.9504)
400              
401              
402             =back
403              
404              
405             =head1 BUGS AND LIMITATIONS
406              
407             No bugs have been reported.
408              
409              
410             =head1 SUPPORT
411              
412             Please report any bugs or feature requests through the web interface at
413             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Text-MiniTmpl>.
414             I will be notified, and then you'll automatically be notified of progress
415             on your bug as I make changes.
416              
417             You can also look for information at:
418              
419             =over
420              
421             =item * RT: CPAN's request tracker
422              
423             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-MiniTmpl>
424              
425             =item * AnnoCPAN: Annotated CPAN documentation
426              
427             L<http://annocpan.org/dist/Text-MiniTmpl>
428              
429             =item * CPAN Ratings
430              
431             L<http://cpanratings.perl.org/d/Text-MiniTmpl>
432              
433             =item * Search CPAN
434              
435             L<http://search.cpan.org/dist/Text-MiniTmpl/>
436              
437             =back
438              
439              
440             =head1 AUTHOR
441              
442             Alex Efros C<< <powerman-asdf@ya.ru> >>
443              
444              
445             =head1 LICENSE AND COPYRIGHT
446              
447             Copyright 2007-2010,2014 Alex Efros <powerman-asdf@ya.ru>.
448              
449             This program is distributed under the MIT (X11) License:
450             L<http://www.opensource.org/licenses/mit-license.php>
451              
452             Permission is hereby granted, free of charge, to any person
453             obtaining a copy of this software and associated documentation
454             files (the "Software"), to deal in the Software without
455             restriction, including without limitation the rights to use,
456             copy, modify, merge, publish, distribute, sublicense, and/or sell
457             copies of the Software, and to permit persons to whom the
458             Software is furnished to do so, subject to the following
459             conditions:
460              
461             The above copyright notice and this permission notice shall be
462             included in all copies or substantial portions of the Software.
463              
464             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
465             EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
466             OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
467             NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
468             HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
469             WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
470             FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
471             OTHER DEALINGS IN THE SOFTWARE.
472