File Coverage

blib/lib/Dancer2/Template/Simple.pm
Criterion Covered Total %
statement 66 66 100.0
branch 30 34 88.2
condition 3 3 100.0
subroutine 7 7 100.0
pod 1 2 50.0
total 107 112 95.5


line stmt bran cond sub pod time code
1             # ABSTRACT: Pure Perl 5 template engine for Dancer2
2             $Dancer2::Template::Simple::VERSION = '0.400000';
3             use Moo;
4 4     4   2459 use Dancer2::FileUtils 'read_file_content';
  4         6087  
  4         24  
5 4     4   2198 use Ref::Util qw<is_arrayref is_coderef is_plain_hashref>;
  4         8  
  4         211  
6 4     4   412  
  4         1441  
  4         3084  
7             with 'Dancer2::Core::Role::Template';
8              
9             has start_tag => (
10             is => 'rw',
11             default => sub {'<%'},
12             );
13              
14             has stop_tag => (
15             is => 'rw',
16             default => sub {'%>'},
17             );
18              
19             my $self = shift;
20             my $settings = $self->config;
21              
22             $settings->{$_} and $self->$_( $settings->{$_} )
23             for qw/ start_tag stop_tag /;
24             }
25              
26             my ( $self, $template, $tokens ) = @_;
27             my $content;
28              
29 11     11 1 6157 $content = read_file_content($template);
30 11         17 $content = $self->parse_branches( $content, $tokens );
31              
32 11         30 return $content;
33 9         28 }
34              
35 9         35 my ( $self, $content, $tokens ) = @_;
36             my ( $start, $stop ) = ( $self->start_tag, $self->stop_tag );
37              
38             my @buffer;
39 9     9 0 20 my $prefix = "";
40 9         32 my $should_bufferize = 1;
41             my $bufferize_if_token = 0;
42 9         11  
43 9         11 # $content =~ s/\Q${start}\E(\S)/${start} $1/sg;
44 9         11 # $content =~ s/(\S)\Q${stop}\E/$1 ${stop}/sg;
45 9         10  
46             # we get here a list of tokens without the start/stop tags
47             my @full = split( /\Q$start\E\s*(.*?)\s*\Q$stop\E/, $content );
48              
49             # and here a list of tokens without variables
50             my @flat = split( /\Q$start\E\s*.*?\s*\Q$stop\E/, $content );
51 9         134  
52             # eg: for 'foo=<% var %>'
53             # @full = ('foo=', 'var')
54 9         76 # @flat = ('foo=')
55              
56             my $flat_index = 0;
57             my $full_index = 0;
58             for my $word (@full) {
59              
60 9         19 # flat word, nothing to do
61 9         10 if ( defined $flat[$flat_index]
62 9         17 && ( $flat[$flat_index] eq $full[$full_index] ) )
63             {
64             push @buffer, $word if $should_bufferize;
65 59 100 100     156 $flat_index++;
66             $full_index++;
67             next;
68 32 100       55 }
69 32         38  
70 32         35 my @to_parse = ($word);
71 32         42 @to_parse = split( /\s+/, $word ) if $word =~ /\s+/;
72              
73             for my $w (@to_parse) {
74 27         48  
75 27 100       60 if ( $w eq 'if' ) {
76             $bufferize_if_token = 1;
77 27         37 }
78             elsif ( $w eq 'else' ) {
79 29 100       72 $should_bufferize = !$should_bufferize;
    100          
    100          
    100          
    50          
80 2         6 }
81             elsif ( $w eq 'end' ) {
82             $should_bufferize = 1;
83 2         4 }
84             elsif ($bufferize_if_token) {
85             my $bool = _find_value_from_token_name( $w, $tokens );
86 2         12 $should_bufferize = _interpolate_value($bool) ? 1 : 0;
87             $bufferize_if_token = 0;
88             }
89 2         4 elsif ($should_bufferize) {
90 2 100       4 my $val =
91 2         4 _interpolate_value(
92             _find_value_from_token_name( $w, $tokens ) );
93             push @buffer, $val;
94 21         30 }
95             }
96              
97 21         35 $full_index++;
98             }
99              
100             return join "", @buffer;
101 27         38 }
102              
103              
104 9         39 my ( $key, $tokens ) = @_;
105             my $value = undef;
106              
107             my @elements = split /\./, $key;
108             foreach my $e (@elements) {
109 23     23   38 if ( not defined $value ) {
110 23         26 $value = $tokens->{$e};
111             }
112 23         49 elsif ( is_plain_hashref($value) ) {
113 23         32 $value = $value->{$e};
114 29 100       50 }
    100          
    50          
115 23         45 elsif ( ref($value) ) {
116             local $@;
117             eval { $value = $value->$e };
118 3         7 $value = "" if $@;
119             }
120             }
121 3         6 return $value;
122 3         4 }
  3         25  
123 3 100       11  
124             my ($value) = @_;
125             if ( is_coderef($value) ) {
126 23         47 local $@;
127             eval { $value = $value->() };
128             $value = "" if $@;
129             }
130 23     23   32 elsif ( is_arrayref($value) ) {
131 23 100       52 $value = "@{$value}";
    100          
132 2         3 }
133 2         4  
  2         5  
134 2 50       8 $value = "" if not defined $value;
135             return $value;
136             }
137 2         3  
  2         7  
138             1;
139              
140 23 50       37  
141 23         32 =pod
142              
143             =encoding UTF-8
144              
145             =head1 NAME
146              
147             Dancer2::Template::Simple - Pure Perl 5 template engine for Dancer2
148              
149             =head1 VERSION
150              
151             version 0.400000
152              
153             =head1 SYNOPSIS
154              
155             To use this engine, you may configure L<Dancer2> via C<config.yaml>:
156              
157             template: simple
158              
159             =head1 DESCRIPTION
160              
161             This template engine is primarily to serve as a migration path for users of
162             L<Dancer>. It should be fine for development purposes, but you would be
163             better served by using L<Dancer2::Template::TemplateToolkit> or one of the
164             many alternatives available on CPAN to power an application with Dancer2
165             in production environment.
166              
167             C<Dancer2::Template::Simple> is written in pure Perl and has no C bindings
168             to accelerate the template processing.
169              
170             =head1 METHODS
171              
172             =head2 render($template, \%tokens)
173              
174             Renders the template. The first arg is a filename for the template file
175             or a reference to a string that contains the template. The second arg
176             is a hashref for the tokens that you wish to pass to
177             L<Template::Toolkit> for rendering.
178              
179             =head1 SYNTAX
180              
181             A template written for C<Dancer2::Template::Simple> should be working just fine
182             with L<Dancer2::Template::TemplateToolkit>. The opposite is not true though.
183              
184             =over 4
185              
186             =item B<variables>
187              
188             To interpolate a variable in the template, use the following syntax:
189              
190             <% var1 %>
191              
192             If B<var1> exists in the tokens hash given, its value will be written there.
193              
194             =back
195              
196             =head1 SEE ALSO
197              
198             L<Dancer2>, L<Dancer2::Core::Role::Template>,
199             L<Dancer2::Template::TemplateToolkit>.
200              
201             =head1 AUTHOR
202              
203             Dancer Core Developers
204              
205             =head1 COPYRIGHT AND LICENSE
206              
207             This software is copyright (c) 2022 by Alexis Sukrieh.
208              
209             This is free software; you can redistribute it and/or modify it under
210             the same terms as the Perl 5 programming language system itself.
211              
212             =cut