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