File Coverage

blib/lib/Dancer2/Template/Simple.pm
Criterion Covered Total %
statement 65 65 100.0
branch 30 34 88.2
condition 3 3 100.0
subroutine 7 7 100.0
pod 1 2 50.0
total 106 111 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 = '2.0.0';
4 2     2   340428 use Moo;
  2         16415  
  2         11  
5 2     2   3584 use Dancer2::FileUtils 'read_file_content';
  2         690  
  2         122  
6 2     2   989 use Ref::Util qw;
  2         4936  
  2         1899  
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 9     9 1 10055 my ( $self, $template, $tokens ) = @_;
30 9         18 my $content;
31              
32 9         31 $content = read_file_content($template);
33 8         3616 $content = $self->parse_branches( $content, $tokens );
34              
35 8         34 return $content;
36             }
37              
38             sub parse_branches {
39 8     8 0 26 my ( $self, $content, $tokens ) = @_;
40 8         56 my ( $start, $stop ) = ( $self->start_tag, $self->stop_tag );
41              
42 8         17 my @buffer;
43 8         14 my $should_bufferize = 1;
44 8         15 my $bufferize_if_token = 0;
45              
46             # $content =~ s/\Q${start}\E(\S)/${start} $1/sg;
47             # $content =~ s/(\S)\Q${stop}\E/$1 ${stop}/sg;
48              
49             # we get here a list of tokens without the start/stop tags
50 8         236 my @full = split( /\Q$start\E\s*(.*?)\s*\Q$stop\E/, $content );
51              
52             # and here a list of tokens without variables
53 8         151 my @flat = split( /\Q$start\E\s*.*?\s*\Q$stop\E/, $content );
54              
55             # eg: for 'foo=<% var %>'
56             # @full = ('foo=', 'var')
57             # @flat = ('foo=')
58              
59 8         19 my $flat_index = 0;
60 8         15 my $full_index = 0;
61 8         21 for my $word (@full) {
62              
63             # flat word, nothing to do
64 56 100 100     237 if ( defined $flat[$flat_index]
65             && ( $flat[$flat_index] eq $full[$full_index] ) )
66             {
67 30 100       86 push @buffer, $word if $should_bufferize;
68 30         64 $flat_index++;
69 30         53 $full_index++;
70 30         60 next;
71             }
72              
73 26         65 my @to_parse = ($word);
74 26 100       91 @to_parse = split( /\s+/, $word ) if $word =~ /\s+/;
75              
76 26         48 for my $w (@to_parse) {
77              
78 28 100       115 if ( $w eq 'if' ) {
    100          
    100          
    100          
    50          
79 2         5 $bufferize_if_token = 1;
80             }
81             elsif ( $w eq 'else' ) {
82 2         5 $should_bufferize = !$should_bufferize;
83             }
84             elsif ( $w eq 'end' ) {
85 2         5 $should_bufferize = 1;
86             }
87             elsif ($bufferize_if_token) {
88 2         6 my $bool = _find_value_from_token_name( $w, $tokens );
89 2 100       7 $should_bufferize = _interpolate_value($bool) ? 1 : 0;
90 2         5 $bufferize_if_token = 0;
91             }
92             elsif ($should_bufferize) {
93 20         48 my $val =
94             _interpolate_value(
95             _find_value_from_token_name( $w, $tokens ) );
96 20         48 push @buffer, $val;
97             }
98             }
99              
100 26         56 $full_index++;
101             }
102              
103 8         63 return join "", @buffer;
104             }
105              
106              
107             sub _find_value_from_token_name {
108 22     22   55 my ( $key, $tokens ) = @_;
109 22         40 my $value = undef;
110              
111 22         73 my @elements = split /\./, $key;
112 22         71 foreach my $e (@elements) {
113 28 100       97 if ( not defined $value ) {
    100          
    50          
114 22         63 $value = $tokens->{$e};
115             }
116             elsif ( is_plain_hashref($value) ) {
117 3         9 $value = $value->{$e};
118             }
119             elsif ( ref($value) ) {
120 3         7 local $@;
121 3         6 eval { $value = $value->$e };
  3         42  
122 3 100       17 $value = "" if $@;
123             }
124             }
125 22         70 return $value;
126             }
127              
128             sub _interpolate_value {
129 22     22   53 my ($value) = @_;
130 22 100       97 if ( is_coderef($value) ) {
    100          
131 2         5 local $@;
132 2         6 eval { $value = $value->() };
  2         6  
133 2 50       13 $value = "" if $@;
134             }
135             elsif ( is_arrayref($value) ) {
136 2         4 $value = "@{$value}";
  2         11  
137             }
138              
139 22 50       49 $value = "" if not defined $value;
140 22         48 return $value;
141             }
142              
143             1;
144              
145             __END__