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