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