File Coverage

blib/lib/Template/Mustache.pm
Criterion Covered Total %
statement 81 83 97.5
branch 25 32 78.1
condition 3 3 100.0
subroutine 22 22 100.0
pod 1 2 50.0
total 132 142 92.9


line stmt bran cond sub pod time code
1             package Template::Mustache;
2             our $AUTHORITY = 'cpan:YANICK';
3             # ABSTRACT: Drawing Mustaches on Perl for fun and profit
4             $Template::Mustache::VERSION = '1.3.3';
5 20     20   2657181 use 5.12.0;
  20         167  
6              
7 20     20   9983 use Moo;
  20         235107  
  20         93  
8 20     20   40331 use MooseX::MungeHas { has_rw => [ 'is_rw' ], has_ro => [ 'is_ro' ] };
  20         75810  
  20         194  
9              
10 20     20   44973 use Text::Balanced qw/ extract_tagged gen_extract_tagged extract_multiple /;
  20         333948  
  20         1998  
11 20     20   159 use Scalar::Util qw/ looks_like_number /;
  20         39  
  20         931  
12              
13 20     20   9183 use Template::Mustache::Token::Template;
  20         74  
  20         723  
14 20     20   9516 use Template::Mustache::Token::Variable;
  20         125  
  20         713  
15 20     20   10193 use Template::Mustache::Token::Verbatim;
  20         63  
  20         823  
16 20     20   9198 use Template::Mustache::Token::Section;
  20         67  
  20         693  
17 20     20   9032 use Template::Mustache::Token::Partial;
  20         57  
  20         610  
18              
19 20     20   33098 use Template::Mustache::Parser;
  20         76  
  20         887  
20              
21 20     20   145 use Parse::RecDescent 1.967015;
  20         502  
  20         134  
22              
23 20     20   13771 use List::AllUtils qw/ pairmap /;
  20         267705  
  20         1794  
24 20     20   165 use Scalar::Util qw/ blessed /;
  20         46  
  20         873  
25 20     20   16570 use Path::Tiny;
  20         215381  
  20         8769  
26              
27             has_ro template_path => (
28             coerce => sub {
29             return unless defined $_[0];
30             my $path = path($_[0]);
31             die "'$_[0]' does not exist" unless $path->exists;
32             $path = $path->child('Mustache.mustache')
33             if $path->is_dir ;
34             $path;
35             },
36             );
37              
38             has_ro partials_path => (
39             lazy => 1,
40             default => sub {
41             return unless $_[0]->template_path;
42             $_[0]->template_path->parent;
43             },
44             coerce => sub {
45             return unless defined $_[0];
46             my $path = path($_[0]);
47             die "'$_[0]' does not exist" unless $path->exists;
48             $path;
49             },
50             );
51              
52             has_rw context => sub {
53 16     16   157 $_[0],
54             };
55              
56             has_rw template => (
57             trigger => sub { $_[0]->clear_parsed },
58             lazy => 1,
59             default => sub {
60             my $self = shift;
61             return unless $self->template_path;
62             path($self->template_path)->slurp;
63             },
64             );
65              
66             has_rw parsed => (
67             clearer => 1,
68             lazy => 1,
69             default => sub {
70             my $self = shift;
71             $self->parser->template(
72             $self->template,
73             undef,
74             @{ $self->delimiters }
75             );
76             },
77             );
78              
79             has_rw delimiters => (
80             lazy => 1,
81             default => sub { [ '{{', '}}' ] },
82             );
83              
84 20     20   191 use Scalar::Util qw/ weaken /;
  20         55  
  20         9499  
85              
86             has_rw partials => (
87             lazy => 1,
88             default => sub {
89             my $self = shift;
90             weaken $self;
91              
92             return sub {
93             state $partials = {};
94              
95             my $name = shift;
96              
97             return $partials->{$name} if defined $partials->{$name};
98              
99             # TODO also deal with many paths?
100              
101             my $partial = '';
102              
103             if ( my $path = $self->partials_path ) {
104             my $path = $self->partials_path->child($name . '.mustache');
105              
106             if( $path->is_file ) {
107             $partial = Template::Mustache->new(
108             template_path => $path
109             );
110             }
111             }
112              
113             return $partials->{$name} = $partial;
114             }
115             },
116             trigger => \&_parse_partials
117             );
118              
119             sub _parse_partials {
120 6     6   11591 my( $self, $partials ) = @_;
121              
122 6 100       45 return if ref $partials eq 'CODE';
123              
124 4         21 while( my ( $name, $template ) = each %$partials ) {
125 5 50       161 next if ref $template;
126 5 50       97 $partials->{$name} =
127             Template::Mustache->new( template =>
128             ref $template ? $template->($name) : $template )->parsed;
129             }
130              
131 4         519 return $partials;
132             }
133              
134             has_ro parser => sub {
135 72 50   72   728 if ( $ENV{MUSTACHE_DEBUG} ) {
136 0         0 return Parse::RecDescent->new(
137             $Template::Mustache::GRAMMAR
138             );
139             }
140              
141 72         407 return Template::Mustache::Parser->new
142             };
143              
144             sub render {
145 48     48 1 78816 my $self = shift;
146              
147 48 100       192 unless( ref $self ) {
148 29 50       495 $self = $self->new unless ref $self;
149 29         27547 my $template = shift;
150 29 100       554 $self->template( $template ) if defined $template;
151 29 100       252 $self->partials( $_[1] ) if @_ == 2;
152             }
153              
154 48 100       461 my $context = @_ ? shift : $self->context;
155              
156 48         848 $self->parsed->render([ $context ], $self->partials);
157             }
158              
159              
160             sub resolve_context {
161 145     145 0 508 my ( $key, $context ) = @_;
162              
163 20     20   167 no warnings 'uninitialized';
  20         67  
  20         7816  
164 145 100 100     820 return $context->[0] if $key eq '.' or $key eq '';
165              
166 72         117 my $first;
167 72         236 ( $first, $key ) = split '\.', $key, 2;
168              
169             CONTEXT:
170 72         164 for my $c ( @$context ) {
171 74 100       277 if ( blessed $c ) {
172 32 50       187 next CONTEXT unless $c->can($first);
173 32         186 return resolve_context($key,[$c->$first]);
174             }
175 42 100       116 if ( ref $c eq 'HASH' ) {
176 40 100       130 next CONTEXT unless exists $c->{$first};
177 38         154 return resolve_context($key,[$c->{$first}]);
178             }
179              
180 2 50       5 if ( ref $c eq 'ARRAY' ) {
181 2 50       9 next CONTEXT unless looks_like_number($first);
182 2         22 return resolve_context( $key, [ $c->[$first] ] );
183             }
184             }
185              
186 0           return;
187             }
188              
189             our $GRAMMAR = <<'END_GRAMMAR';
190              
191             <skip:qr//>
192              
193             eofile: /^\Z/
194              
195             template: { my ($otag,$ctag) = @arg ? @arg : ( qw/ {{ }} / );
196             $thisparser->{opening_tag} = $otag;
197             $thisparser->{closing_tag} = $ctag;
198             $thisparser->{prev_is_standalone} = 1;
199             1;
200             } template_item(s?) eofile {
201             Template::Mustache::Token::Template->new(
202             items => $item[2]
203             );
204             } | <error>
205              
206             opening_tag: "$thisparser->{opening_tag}"
207              
208             closing_tag: "$thisparser->{closing_tag}"
209              
210             template_item: ( partial | section | delimiter_change | comment | unescaped_variable_amp | unescaped_variable | variable | verbatim | <error>) {
211             $item[1]
212             }
213              
214             delimiter_change: standalone_surround[$item[0]] {
215             die "needs two delimiters\n" unless @{ $item[1][2] } == 2;
216             ( $thisparser->{opening_tag},
217             $thisparser->{closing_tag} ) = @{ $item[1][2] };
218              
219             Template::Mustache::Token::Verbatim->new( content =>
220             $item[1][0] . $item[1][1]
221             );
222             }
223              
224             delimiter_change_inner: '=' {
225             $thisparser->{closing_tag}
226             } /\s*/ /.*?(?=\=\Q$item[2]\E)/s '=' {
227             [ split ' ', $item[4] ]
228             }
229              
230             partial: /\s*/ opening_tag '>' /\s*/ /[\/-\w.]+/ /\s*/ closing_tag /\s*/ {
231             my $prev = $thisparser->{prev_is_standalone};
232             $thisparser->{prev_is_standalone} = 0;
233             my $indent = '';
234             if ( $item[1] =~ /\n/ or $prev ) {
235             if ( $item[8] =~ /\n/ or length $text == 0) {
236             $item[1] =~ /(^|\n)([ \t]*?)$/;
237             $indent = $2;
238             $item[8] =~ s/^.*?\n//;
239             $thisparser->{prev_is_standalone} = 1;
240             }
241             }
242             Template::Mustache::Token::Template->new(
243             items => [
244             Template::Mustache::Token::Verbatim->new( content => $item[1] ),
245             Template::Mustache::Token::Partial->new( name => $item[5],
246             indent => $indent ),
247             Template::Mustache::Token::Verbatim->new( content => $item[8] ),
248             ],
249             )
250             }
251              
252             open_section: /\s*/ opening_tag /[#^]/ /\s*/ /[-\w.]+/ /\s*/ closing_tag /\s*/ {
253             my $prev = $thisparser->{prev_is_standalone};
254             $thisparser->{prev_is_standalone} = 0;
255             if ( $item[1] =~ /\n/ or $prev ) {
256             if ( $item[8] =~ /\n/ ) {
257             $item[1] =~ s/(^|\n)[ \t]*?$/$1/;
258             $item[8] =~ s/^.*?\n//;
259             $thisparser->{prev_is_standalone} = 1;
260             }
261             }
262              
263             [ $item[5], $item[3] eq '^',
264             Template::Mustache::Token::Verbatim->new( content => $item[1] ),
265             Template::Mustache::Token::Verbatim->new( content => $item[8] )
266             ];
267             }
268              
269             close_section: /\s*/ opening_tag '/' /\s*/ "$arg[0]" /\s*/ closing_tag /\s*/ {
270             my $prev = $thisparser->{prev_is_standalone};
271             $thisparser->{prev_is_standalone} = 0;
272             if ( $item[1] =~ /\n/ or $prev) {
273             if ( $item[8] =~ /\n/ or length $text == 0 ) {
274             $item[1] =~ s/(^|\n)[ \t]*?$/$1/;
275             $item[8] =~ s/^.*?\n//;
276             $thisparser->{prev_is_standalone} = 1;
277             }
278             }
279             [
280             Template::Mustache::Token::Verbatim->new( content => $item[1] ),
281             Template::Mustache::Token::Verbatim->new( content => $item[8] ),
282             ]
283             }
284              
285             standalone_surround: /\s*/ opening_tag /\s*/ <matchrule:$arg[0]_inner> closing_tag /\s*/ {
286             my $prev = $thisparser->{prev_is_standalone};
287             $thisparser->{prev_is_standalone} = 0;
288              
289             if ( $item[1] =~ /\n/ or $prev) {
290             if ( $item[6] =~ /\n/ or length $text == 0) {
291             $item[1] =~ s/(\r?\n?)\s*?$/$1/;
292             $item[6] =~ s/^.*?\n//;
293             $thisparser->{prev_is_standalone} = 1;
294             }
295             }
296              
297             [ @item[1,6,4] ],
298             }
299              
300             comment: standalone_surround[$item[0]] {
301             Template::Mustache::Token::Verbatim->new(
302             content => $item[1][0] . $item[1][1]
303             ),
304             }
305              
306             comment_inner: '!' { $thisparser->{closing_tag} } /.*?(?=\Q$item[2]\E)/s
307              
308             inner_section: ...!close_section[ $arg[0] ] template_item
309              
310             section: open_section {$thisoffset} inner_section[ $item[1][0] ](s?) {$thisoffset
311             - $item[2]
312             } close_section[ $item[1][0] ] {
313             my $raw = substr( $thisparser->{fulltext}, $item[2], $item[4] );
314             Template::Mustache::Token::Template->new( items => [
315             $item[1]->[2],
316             Template::Mustache::Token::Section->new(
317             delimiters => [ map { $thisparser->{$_} } qw/ opening_tag closing_tag / ],
318             variable => $item[1][0],
319             inverse => $item[1][1],
320             raw => $raw,
321             template => Template::Mustache::Token::Template->new(
322             items => [
323             $item[1][3], @{$item[3]}, $item[5][0] ],
324             )
325             ),
326             $item[5][1]
327             ]
328             );
329             }
330              
331             unescaped_variable: /\s*/ opening_tag '{' /\s*/ variable_name /\s*/ '}' closing_tag {
332             Template::Mustache::Token::Template->new(
333             items => [
334             Template::Mustache::Token::Verbatim->new( content => $item[1] ),
335             Template::Mustache::Token::Variable->new(
336             name => $item{variable_name},
337             escape => 0,
338             ),
339             ]
340             );
341             }
342              
343             unescaped_variable_amp: /\s*/ opening_tag '&' /\s*/ variable_name /\s*/ closing_tag {
344             Template::Mustache::Token::Template->new(
345             items => [
346             Template::Mustache::Token::Verbatim->new( content => $item[1] ),
347             Template::Mustache::Token::Variable->new(
348             name => $item{variable_name},
349             escape => 0,
350             ),
351             ]
352             );
353             }
354              
355              
356             variable: /\s*/ opening_tag /\s*/ variable_name /\s*/ closing_tag {
357             $thisparser->{prev_is_standalone} = 0;
358             Template::Mustache::Token::Template->new(
359             items => [
360             Template::Mustache::Token::Verbatim->new( content => $item[1] ),
361             Template::Mustache::Token::Variable->new( name => $item{variable_name} ),
362             ]
363             );
364             }
365              
366             variable_name: /[-\w.]+/
367              
368             verbatim: { $thisparser->{opening_tag} } /^\s*\S*?(?=\Q$item[1]\E|\s|$)/ {
369             $thisparser->{prev_is_standalone} = 0;
370             Template::Mustache::Token::Verbatim->new( content => $item[2] );
371             }
372              
373             END_GRAMMAR
374              
375              
376             1;
377              
378             =pod
379              
380             =encoding UTF-8
381              
382             =head1 NAME
383              
384             Template::Mustache - Drawing Mustaches on Perl for fun and profit
385              
386             =head1 VERSION
387              
388             version 1.3.3
389              
390             =head1 SYNOPSIS
391              
392             use Template::Mustache;
393              
394             # one-shot rendering
395              
396             print Template::Mustache->render(
397             "Hello {{planet}}",
398             );
399              
400             # compile and re-use template
401              
402             my $mustache = Template::Mustache->new(
403             template => "Hello {{planet}}",
404             );
405              
406             print $mustache->render( { planet => "World!" } );
407              
408             =head1 DESCRIPTION
409              
410             Template::Mustache is an implementation of the fabulous
411             L<Mustache|https://mustache.github.io/> templating
412             language for Perl.
413              
414             This version of I<Template::Mustache> conforms to v1.1.3
415             of the L<Mustache specs|https://github.com/mustache/spec>.
416              
417             Templates can be compiled and rendered on the spot via the
418             use of C<render> called as a class method.
419              
420             print Template::Mustache->render(
421             "Hello {{planet}}",
422             );
423              
424             If you are considering re-using the same template many times, it's
425             recommended to create a C<Template::Mustache> object instead,
426             which will compile the template only once, and allow to render
427             it with different contexts.
428              
429             my $mustache = Template::Mustache->new(
430             template => "Hello {{planet}}",
431             );
432              
433             print $mustache->render( { planet => "World!" } );
434              
435             =head1 METHODS
436              
437             =head2 new( %arguments )
438              
439             my $mustache = Template::Mustache->new(
440             template => "Hello {{planet}}",
441             delimiters => [ qw/ ! ! / ],
442             );
443              
444             Constructor.
445              
446             =head3 arguments
447              
448             =over
449              
450             =item template => $string
451              
452             A Mustache template.
453              
454             =item template_path => $path
455              
456             Instead of C<template>, a C<template_path> can be provided to read
457             the template and the partials from the fielsystem instead. See
458             the method C<template_path> to see how this works.
459              
460             =item partials_path => $path
461              
462             An optional filesystem path from which to gather partial
463             templates.
464              
465             =item delimiters => [ $opening_tag, $closing_tag ]
466              
467             An optional arrayref holding the pair of delimiters used by
468             the template. Defaults to C<{{ }}>.
469              
470             =item context => $context
471              
472             Context to use when rendering if not provided
473             as a parameter to C<render>. Defaults to the object
474             itself.
475              
476             =item partials => $partials
477              
478             An optional hashref of partials to assign to the object. See
479             the method C<partials> for more details on its format.
480              
481             By default, if C<partials_path> (or C<template_path> is defined,
482             the template will try to resolve the partials as filenames with
483             the file extension C<.mustache>
484             relative to that path.
485              
486             my $mustache = Template::Mustache->new(
487             partials => './root',
488             template => '{{ > ./my/partial }}', # => file ./root/my/partial.mustache
489             );
490              
491             =back
492              
493             =head2 render( $context )
494              
495             print $mustache->render( $context );
496              
497             Returns the rendered template, given the optionally provided context. Uses
498             the object's C<context attribute> if not provided.
499              
500             =head3 Context
501              
502             =head4 as a hashref
503              
504             Template::Mustache->render( 'Hello {{ thing }}', { thing => 'World!' } );
505              
506             If the value is a coderef, it will be invoked to generate the value
507             to be inserted in the template.
508              
509             Template::Mustache->render(
510             'it is {{ time }}',
511             { time => sub { scalar localtime } }
512             );
513              
514             If you want the value returned by the coderef to be
515             interpolated as a Mustache template, a helper function is passed
516             as the last argument to the coderef.
517              
518             Template::Mustache->render(
519             'hello {{ place }}',
520             {
521             place => sub { pop->('{{ planet }}') },
522             planet => 'World',
523             }
524             );
525              
526             The two previous interpolations work both for C<{{variable}}>
527             definitions, but also for C<{{#section}}>s.
528              
529             print Template::Mustache->render(
530             'I am {{#obfuscated}}resu{{/obfuscated}}',
531             {
532             obfuscated => sub { pop->('{{'.reverse(shift).'}}') },
533             user => '({{logged_in_as}})',
534             logged_in_as => 'Sam',
535             }
536             ); # => 'I am (Sam)'
537              
538             =head4 as an arrayref
539              
540             Template::Mustache->render( 'Hello {{ 1 }}', [ 'Earth', 'World!' ] );
541             # => 'Hello World!
542              
543             =head4 as an object
544              
545             my $object = Something->new( ... );
546            
547             Template::Mustache->render( 'Hello {{ thing }}', $object ); # thing resolves to $object->thing
548              
549             =head4 as a scalar
550              
551             Template::Mustache->render( 'Hello {{ . }}', 'World!' );
552              
553             =head4 no context
554              
555             If no context is provided, it will default to the mustache object itself.
556             Which allows for definining templates as subclasses of I<Template::Mustache>.
557              
558             package My::Template;
559             use Moo;
560             extends 'Template::Mustache';
561              
562             sub template { 'Hello {{ planet }}!' }
563              
564             sub planet { 'World' }
565              
566              
567             # later on
568             My::Template->new->render; # => Hello World!
569              
570             =head4 multi-level variable
571              
572             If the variable to be rendered is multi-level (e.g., C<foo.bar>), it is
573             resolved recursively on the context.
574              
575             # $foo->bar returns `{ baz => [ 'quux' ] }`
576              
577             Template::Mustache->render( '{{ bar.baz.0 }}', $foo ); # => 'quux'
578              
579             =head2 render( $template, $context, $partials )
580              
581             print Template::Mustache->render( $template, $context, $partials );
582              
583             # equivalent to
584             Template::Mustache->new->(
585             template => $template, partials => $partials
586             )->render( $context );
587              
588             If invoked as a class method, C<render> takes in the mustache template, and
589             an optional context and set of partials.
590              
591             To pass in partials without a
592             context, set the context to C<undef>.
593              
594             print Template::Mustache->render( $template, undef, $partials );
595              
596             =head2 template( $template )
597              
598             Accessor to the C<template> attribute.
599              
600             =head2 template_path( $path )
601              
602             Accessor to the C<template_path> attribute. If this attribute is
603             set, the template will be set to the content of the provided file
604             (if C<$path> is a directory, the file is assumed to be the
605             C<Mustache.mustache> file local to that directory).
606              
607             =head2 partials_path( $path )
608              
609             Accessor the C<partials_path> attribute. If partials were
610             not given as part of the object construction, when encountered
611             partials will be attempted to be read from that directory.
612             The filename for a partial is its name with C<.mustache> appended to it.
613              
614             If C<template_path> is defined, C<partials_path> defaults to it.
615              
616             =head2 context( $context )
617              
618             Accessor to the C<context> attribute.
619              
620             =head2 delimiters( [ $opening_tag, $closing_tag ] )
621              
622             Accessor to the C<delimiters> attribute.
623              
624             =head2 parsed
625              
626             my $tree = $mustache->parsed;
627              
628             Returns the L<Template::Mustache::Token::Template> object representing
629             the parsed template.
630              
631             =head2 parser
632              
633             Returns the instance of L<Template::Mustache::Parser> used by the object.
634              
635             =head2 partials( { partial_name => $partial, ... } )
636              
637             my $mustache = Template::Mustache->new(
638             template => "{{> this }}",
639             partials => { this => 'partials rock!' },
640             );
641              
642             print $mustache->render; # => partials rock!
643              
644             Add partial templates to the object.
645              
646             Partial values can be
647             strings holding Mustache templates;
648              
649             A coderef can also be set instead of a hashref. In that
650             case, partial templates will be generated by invoking that
651             sub with the name of the partial as its argument.
652              
653             my $mustache = Template::Mustache->new(
654             template => "{{> this }} and {{> that }}",
655             partials => sub { "a little bit of " . shift }
656             );
657              
658             =head1 CONSTANTS
659              
660             =head2 $GRAMMAR
661              
662             print $Template::Mustache::GRAMMAR;
663              
664             The L<Parse::RecDescent> grammar used to parse Mustache templates.
665              
666             =head1 SEE ALSO
667              
668             =over
669              
670             =item L<https://mustache.github.io>
671              
672             The main, pan-language site for I<Mustache>.
673              
674             =item L<https://mustache.github.io/mustache.5.html>
675              
676             Specs of the I<Mustache> DSL.
677              
678             =item L<Text::Handlebars|https://metacpan.org/pod/Text::Handlebars>
679              
680             I<Handlebars> is another templating language heavily inspired and very similar to I<Mustache>. L<Text::Handlebars>
681             is an implementation of it using L<Text::Xslate>.
682              
683             =item L<Mustache::Simple>
684              
685             Another module implementing Mustache templates.
686              
687             =back
688              
689             =head1 AUTHORS
690              
691             =over 4
692              
693             =item *
694              
695             Pieter van de Bruggen <pvande@cpan.org>
696              
697             =item *
698              
699             Yanick Champoux <yanick@cpan.org>
700              
701             =item *
702              
703             Ricardo Signes <rjbs@cpan.org>
704              
705             =back
706              
707             =head1 COPYRIGHT AND LICENSE
708              
709             This software is copyright (c) 2019, 2018, 2017, 2016, 2015, 2011 by Pieter van de Bruggen.
710              
711             This is free software; you can redistribute it and/or modify it under
712             the same terms as the Perl 5 programming language system itself.
713              
714             =cut
715              
716             __END__
717              
718             use strict;
719             use warnings;
720              
721              
722             use HTML::Entities;
723             use File::Spec;
724             use Scalar::Util 'blessed';
725              
726             my %TemplateCache;
727              
728              
729             sub build_pattern {
730             my ($otag, $ctag) = @_;
731             return qr/
732             (?<pretag_content>.*?) # Capture the pre-tag content
733             (?<pretag_whitespace>[ \t]*) # Capture the pre-tag whitespace
734             (?<opening_tag>\Q$otag\E \s*) # Match the opening of the tag
735             (?:
736             (?<type>=) \s* (?<tag>.+?) \s* = | # Capture Set Delimiters
737             (?<type>{) \s* (?<tag>.+?) \s* } | # Capture Triple Mustaches
738             (?<type>\W?) \s* (?<tag>.*?) # Capture everything else
739             )
740             (?<closing_tag>\s* \Q$ctag\E) # Match the closing of the tag
741             /xsm;
742             }
743              
744              
745             sub read_file {
746             my ($filename) = @_;
747             return '' unless -f $filename;
748              
749             open my $fh, "<", $filename or die "Cannot read from file $filename!";
750             sysread($fh, my $data, -s $fh);
751             close $fh;
752              
753             return $data;
754             }
755              
756              
757             sub parse {
758             my ($tmpl, $delims, $section, $start) = @_;
759             my @buffer;
760              
761             $tmpl =~ s/\r(?=\n)//g; # change \r\n to \n
762              
763             # Pull the parse tree out of the cache, if we can...
764             $delims ||= [qw'{{ }}'];
765             my $cache = $TemplateCache{join ' ', @$delims} ||= {};
766             return $cache->{$tmpl} if exists $cache->{$tmpl};
767              
768             my $error = sub {
769             my ($message, $errorPos) = @_;
770             my $lineCount = substr($tmpl, 0, $errorPos) =~ tr/\n/\n/;
771              
772             die $message . "\nLine " . $lineCount
773             };
774              
775             # Build the pattern, and instruct the regex engine to begin at `$start`.
776             my $pattern = build_pattern(@$delims);
777             my $pos = pos($tmpl) = $start ||= 0;
778              
779             # Begin parsing out tags
780             while ($tmpl =~ m/\G$pattern/gc) {
781             my ($content, $whitespace, $type, $tag) = @+{qw/ pretag_content pretag_whitespace type tag /};
782              
783             if( $type eq '.' and $tag eq '' ) {
784             ($tag,$type) = ($type, $tag );
785             }
786              
787             # Buffer any non-tag content we have.
788             push @buffer, $content if $content;
789              
790             # Grab the index for the end of the content, and update our pointer.
791             my $eoc = $pos + length($content) - 1;
792             $pos = pos($tmpl);
793              
794             # A tag is considered standalone if it is the only non-whitespace
795             # content on a line.
796             my $is_standalone = (substr($tmpl, $eoc, 1) || "\n") eq "\n" &&
797             (substr($tmpl, $pos, 1) || "\n") eq "\n";
798              
799             # Standalone tags should consume the newline that follows them, unless
800             # the tag is of an interpolation type.
801             # Otherwise, any whitespace we've captured should be added to the
802             # buffer, and the end of content index should be advanced.
803             if ($is_standalone && ($type ne '{' && $type ne '&' && $type ne '')) {
804             $pos += 1;
805             } elsif ($whitespace) {
806             $eoc += length($whitespace);
807             push @buffer, $whitespace;
808             $whitespace = '';
809             }
810              
811             if ($type eq '!') {
812             # Comment Tag - No-op.
813             } elsif ($type eq '{' || $type eq '&' || $type eq '') {
814             # Interpolation Tag - Buffers the tag type and name.
815             push @buffer, [ $type, $tag ];
816             } elsif ($type eq '>') {
817             # Partial Tag - Buffers the tag type, name, and any indentation
818             push @buffer, [ $type, $tag, $whitespace ];
819             } elsif ($type eq '=') {
820             # Set Delimiter Tag - Changes the delimiter pair and updates the
821             # tag pattern.
822             $delims = [ split(/\s+/, $tag) ];
823              
824             $error->("Set Delimiters tags must have exactly two values!", $pos)
825             if @$delims != 2;
826              
827             $pattern = build_pattern(@$delims);
828             } elsif ($type eq '#' || $type eq '^') {
829             # Section Tag - Recursively calls #parse (starting from the current
830             # index), and receives the raw section string and a new index.
831             # Buffers the tag type, name, the section string and delimiters.
832             (my $raw, $pos) = parse($tmpl, $delims, $tag, $pos);
833             push @buffer, [ $type, $tag, [$raw, $delims] ];
834             } elsif ($type eq '/') {
835             # End Section Tag - Short circuits a recursive call to #parse,
836             # caches the buffer for the raw section template, and returns the
837             # raw section template and the index immediately following the tag.
838             my $msg;
839             if (!$section) {
840             $msg = "End Section tag '$tag' found, but not in a section!";
841             } elsif ($tag ne $section) {
842             $msg = "End Section tag closes '$tag'; expected '$section'!";
843             }
844             $error->($msg, $pos) if $msg;
845              
846             my $raw_section = substr($tmpl, $start, $eoc + 1 - $start);
847             $cache->{$raw_section} = [@buffer];
848             return ($raw_section, $pos);
849             } else {
850             $error->("Unknown tag type -- $type", $pos);
851             }
852              
853             # Update our match pointer to coincide with any changes we've made.
854             pos($tmpl) = $pos
855             }
856              
857             # Buffer any remaining template, cache the template for later, and return
858             # a reference to the buffer.
859             push @buffer, substr($tmpl, $pos);
860             $cache->{$tmpl} = [@buffer];
861             return \@buffer;
862             }
863              
864              
865             sub generate {
866             my ($parse_tree, $partials, @context) = @_;
867             # Build a helper function to abstract away subtemplate expansion.
868             # Recursively calls generate after parsing the given template. This allows
869             # us to use the call stack as our context stack.
870             my $build = sub { generate(parse(@_[0,1]), $partials, $_[2], @context) };
871              
872             # Walk through the parse tree, handling each element in turn.
873             join '', map {
874             # If the given element is a string, treat it literally.
875             my @result = ref $_ ? () : $_;
876              
877             # Otherwise, it's a three element array, containing a tag's type, name,
878             # and accessory data. As a precautionary step, we can prefetch any
879             # data value from the context stack (which will be useful in every case
880             # except partial tags).
881             unless (@result) {
882             my ($type, $tag, $data) = @$_;
883             my $render = sub { $build->(shift, $data->[1]) };
884              
885             my ($ctx, $value) = lookup($tag, @context) unless $type eq '>';
886              
887             if ($type eq '{' || $type eq '&' || $type eq '') {
888             # Interpolation Tags
889             # If the value is a code reference, we should treat it
890             # according to Mustache's lambda rules. Specifically, we
891             # should call the sub (passing a "render" function as a
892             # convenience), render its contents against the current
893             # context, and cache the value (if possible).
894             if (ref $value eq 'CODE') {
895             $value = $build->($value->($render));
896             $ctx->{$tag} = $value if ref $ctx eq 'HASH';
897             }
898             # An empty `$type` represents an HTML escaped tag.
899             $value = encode_entities($value) unless $type;
900             @result = $value;
901             } elsif ($type eq '#') {
902             # Section Tags
903             # `$data` will contain an array reference with the raw template
904             # string, and the delimiter pair being used when the section
905             # tag was encountered.
906             # There are four special cases for section tags.
907             # * If the value is falsey, the section is skipped over.
908             # * If the value is an array reference, the section is
909             # rendered once using each element of the array.
910             # * If the value is a code reference, the raw section string
911             # and a rendering function are passed to the sub; the return
912             # value is then automatically rendered.
913             # * Otherwise, the section is rendered using given value.
914              
915             if (ref $value eq 'ARRAY') {
916             @result = map { $build->(@$data, $_) } @$value;
917             } elsif ($value) {
918             my @x = @$data;
919             $x[0] = $value->($x[0], $render) if ref $value eq 'CODE';
920             @result = $build->(@x, $value);
921             }
922             } elsif ($type eq '^') {
923             # Inverse Section Tags
924             # These should only be rendered if the value is falsey or an
925             # empty array reference. `$data` is as for Section Tags.
926             $value = @$value if ref $value eq 'ARRAY';
927             @result = $build->(@$data) unless $value;
928             } elsif ($type eq '>') {
929             # Partial Tags
930             # `$data` contains indentation to be applied to the partial.
931             # The partial template is looked up thanks to the `$partials`
932             # code reference, rendered, and non-empty lines are indented.
933             my $partial = scalar $partials->($tag);
934             $partial =~ s/^(?=.)/${data}/gm if $data;
935             @result = $build->($partial);
936             }
937             }
938             @result; # Collect the results...
939             } @$parse_tree;
940             }
941              
942              
943              
944             sub _can_run_field {
945             my ($ctx, $field) = @_;
946              
947             my $can_run_field;
948             if ( $] < 5.018 ) {
949             eval { $ctx->can($field) };
950             $can_run_field = not $@;
951             }
952             else {
953             $can_run_field = $ctx->can($field);
954             }
955              
956             return $can_run_field;
957             }
958              
959             use namespace::clean;
960              
961             sub lookup {
962             my ($field, @context) = @_;
963             my ($value, $ctx) = '';
964              
965             for my $index (0..$#{[@context]}) {
966             $ctx = $context[$index];
967             my $blessed_or_not_ref = blessed($ctx) || !ref $ctx;
968              
969             if($field =~ /\./) {
970             if ( $field eq '.' ) {
971             return ($ctx,$ctx);
972             }
973              
974             # Dotted syntax foo.bar
975             my ($var, $field) = $field =~ /(.+?)\.(.+)/;
976              
977             if(ref $ctx eq 'HASH') {
978             next unless exists $ctx->{$var};
979             ($ctx, $value) = lookup($field, $ctx->{$var});
980             last;
981             } elsif(ref $ctx eq 'ARRAY') {
982             next unless @$ctx[$var];
983             ($ctx, $value) = lookup($field, @$ctx[$var]);
984             last;
985             }
986             } elsif (ref $ctx eq 'HASH') {
987             next unless exists $ctx->{$field};
988             $value = $ctx->{$field};
989             last;
990             } elsif (ref $ctx eq 'ARRAY') {
991             next unless @$ctx[$field];
992             $value = @$ctx[$field];
993             last;
994             }
995             elsif ($ctx && $blessed_or_not_ref && _can_run_field($ctx, $field)) {
996             # We want to accept class names and objects, but not unblessed refs
997             # or undef. -- rjbs, 2015-06-12
998             $value = $ctx->$field();
999             last;
1000             }
1001             }
1002              
1003             return ($ctx, $value);
1004             }
1005              
1006              
1007             sub new {
1008             my ($class, %args) = @_;
1009             return bless({ %args }, $class);
1010             }
1011              
1012             our $template_path = '.';
1013              
1014              
1015             sub template_path { $Template::Mustache::template_path }
1016              
1017             our $template_extension = 'mustache';
1018              
1019              
1020             sub template_extension { $Template::Mustache::template_extension }
1021              
1022              
1023             sub template_namespace { '' }
1024              
1025             our $template_file;
1026              
1027              
1028             sub template_file {
1029             my ($receiver) = @_;
1030             return $Template::Mustache::template_file
1031             if $Template::Mustache::template_file;
1032              
1033             my $class = ref $receiver || $receiver;
1034             $class =~ s/^@{[$receiver->template_namespace()]}:://;
1035             my $ext = $receiver->template_extension();
1036             return File::Spec->catfile(split(/::/, "${class}.${ext}"));
1037             };
1038              
1039              
1040             sub template {
1041             my ($receiver) = @_;
1042             my $path = $receiver->template_path();
1043             my $template_file = $receiver->template_file();
1044             return read_file(File::Spec->catfile($path, $template_file));
1045             }
1046              
1047              
1048             sub partial {
1049             my ($receiver, $name) = @_;
1050             my $path = $receiver->template_path();
1051             my $ext = $receiver->template_extension();
1052             return read_file(File::Spec->catfile($path, "${name}.${ext}"));
1053             }
1054              
1055              
1056             sub render {
1057             my ($receiver, $tmpl, $data, $partials) = @_;
1058             ($data, $tmpl) = ($tmpl, $data) if !(ref $data) && (ref $tmpl);
1059              
1060             $tmpl = $receiver->template() unless defined $tmpl;
1061             $data ||= $receiver;
1062             $partials ||= sub {
1063             unshift @_, $receiver;
1064             goto &{$receiver->can('partial')};
1065             };
1066              
1067             my $part = $partials;
1068             $part = sub { lookup(shift, $partials) } unless ref $partials eq 'CODE';
1069              
1070             my $parsed = parse($tmpl);
1071             return generate($parsed, $part, $data);
1072             }
1073              
1074              
1075             1;