File Coverage

lib/App/Followme/Template.pm
Criterion Covered Total %
statement 85 86 98.8
branch 21 26 80.7
condition 1 3 33.3
subroutine 17 17 100.0
pod 2 6 33.3
total 126 138 91.3


line stmt bran cond sub pod time code
1             package App::Followme::Template;
2              
3 12     12   822 use 5.008005;
  12         41  
4 12     12   77 use strict;
  12         26  
  12         364  
5 12     12   72 use warnings;
  12         22  
  12         377  
6 12     12   68 use integer;
  12         24  
  12         86  
7              
8 12     12   446 use lib '../..';
  12         29  
  12         86  
9              
10 12     12   1640 use Carp;
  12         33  
  12         743  
11 12     12   80 use App::Followme::FIO;
  12         23  
  12         1260  
12 12     12   89 use App::Followme::Web;
  12         30  
  12         1171  
13              
14 12     12   82 use base qw(App::Followme::ConfiguredObject);
  12         23  
  12         1537  
15              
16             our $VERSION = "2.03";
17              
18 12     12   94 use constant COMMAND_START => '<!-- ';
  12         27  
  12         902  
19 12     12   81 use constant COMMAND_END => '-->';
  12         39  
  12         10805  
20              
21             #----------------------------------------------------------------------
22             # Compile a template into a subroutine which when called fills itself
23              
24             sub compile {
25 29     29 1 4032 my ($pkg, $template) = @_;
26              
27 29 100       104 my $self = ref $pkg ? $pkg : $pkg->new();
28 29         273 my @lines = split(/\n/, $template);
29              
30 29         62 my $start = <<'EOQ';
31             sub {
32             my ($meta, $item, $loop) = @_;
33             my @text;
34             my @loop;
35             @loop = @$loop if defined $loop;
36             EOQ
37              
38 29         94 my @mid = $self->parse_code(\@lines);
39              
40 29         88 my $end .= <<'EOQ';
41             return join('', @text);
42             }
43             EOQ
44              
45 29         210 my $code = join("\n", $start, @mid, $end);
46 29         8437 my $sub = eval ($code);
47 29 50       113 croak $@ unless $sub;
48              
49 29         193 return $sub;
50             }
51              
52             #----------------------------------------------------------------------
53             # Replace variable references with hashlist fetches
54              
55             sub encode_expression {
56 740     740 0 1155 my ($self, $value) = @_;
57              
58 740 50       1103 if (defined $value) {
59 740         975 my $pre = '{$meta->build(\'';
60 740         976 my $post = '\', $item, \@loop)}';
61 740         2259 $value =~ s/(?<!\\)([\$\@])(\w+)/$1$pre$1$2$post/g;
62              
63             } else {
64 0         0 $value = '';
65             }
66              
67 740         2224 return $value;
68             }
69              
70             #----------------------------------------------------------------------
71             # Get the translation of a template command
72              
73             sub get_command {
74 191     191 0 330 my ($self, $cmd) = @_;
75              
76 191         762 my $commands = {
77             do => '%%;',
78             for => 'if (%%) { foreach my $item (my @loop = (%%)) {',
79             endfor => '}}',
80             if => 'if (%%) { do {',
81             elsif => '}} elsif (%%) { do {',
82             else => '}} else { do {',
83             endif => '}}',
84             };
85              
86 191         588 return $commands->{$cmd};
87             }
88              
89             #----------------------------------------------------------------------
90             # Parse the templace source
91              
92             sub parse_code {
93 50     50 0 113 my ($self, $lines, $command) = @_;
94              
95 50         81 my @code;
96             my @stash;
97              
98 50         155 while (defined (my $line = shift @$lines)) {
99 740         1251 my ($cmd, $cmdline) = $self->parse_command($line);
100              
101 740 100       1431 if (defined $cmd) {
102 45 100       100 if (@stash) {
103 42         129 push(@code, 'push @text, <<"EOQ";', @stash, 'EOQ');
104 42         100 @stash = ();
105             }
106 45         75 push(@code, $cmdline);
107              
108 45 100       182 if (substr($cmd, 0, 3) eq 'end') {
    100          
109 21         49 my $startcmd = substr($cmd, 3);
110 21 50 33     92 die "Mismatched block end ($command/$cmd)"
111             if defined $startcmd && $startcmd ne $command;
112 21         125 return @code;
113              
114             } elsif ($self->get_command("end$cmd")) {
115 21         82 push(@code, $self->parse_code($lines, $cmd));
116             }
117              
118             } else {
119 695         1152 push(@stash, $self->encode_expression($line));
120             }
121             }
122              
123 29 50       94 die "Missing end (end$command)" if $command;
124 29 100       145 push(@code, 'push @text, <<"EOQ";', @stash, 'EOQ') if @stash;
125              
126 29         226 return @code;
127             }
128              
129             #----------------------------------------------------------------------
130             # Parse a command and its argument
131              
132             sub parse_command {
133 740     740 0 1234 my ($self, $line) = @_;
134              
135 740         1013 my $command_start_pattern = COMMAND_START;
136 740 100       2315 return unless $line =~ s/$command_start_pattern//;
137              
138 167         341 my $command_end_pattern = COMMAND_END;
139 167         593 $line =~ s/$command_end_pattern//;
140              
141 167         462 my ($cmd, $arg) = split(' ', $line, 2);
142 167 50       330 $arg = '' unless defined $arg;
143              
144 167         305 my $cmdline = $self->get_command($cmd);
145 167 100       405 return unless $cmdline;
146              
147 45         84 $arg = $self->encode_expression($arg);
148 45         171 $cmdline =~ s/%%/$arg/g;
149              
150 45         135 return ($cmd, $cmdline);
151             }
152              
153             #----------------------------------------------------------------------
154             # Set the regular expression patterns used to match a command
155              
156             sub setup {
157 46     46 1 110 my ($self) = @_;
158              
159 46         134 $self->{command_start_pattern} = '^\s*' . quotemeta(COMMAND_START);
160 46         107 $self->{command_end_pattern} = '\s*' . quotemeta(COMMAND_END) . '\s*$';
161              
162 46         119 return;
163             }
164              
165             1;
166              
167             =pod
168              
169             =encoding utf-8
170              
171             =head1 NAME
172              
173             App::Followme::Template - Handle templates and prototype files
174              
175             =head1 SYNOPSIS
176              
177             use App::Followme::Template;
178             my $template = App::Followme::Template->new;
179             my $render = $template->compile($template_file);
180             my $output = $render->($hash);
181              
182             =head1 DESCRIPTION
183              
184             This module contains the methods that perform template handling. A Template is a
185             file containing commands and variables for making a web page. First, the
186             template is compiled into a subroutine and then the subroutine is called with a
187             hash as an argument to fill in the variables and produce a web
188             page.
189              
190             =head1 METHODS
191              
192             This module has one public method:
193              
194             =over 4
195              
196             =item $sub = $self->compile($template_file);
197              
198             Compile a template and return the compiled subroutine. A template is a file
199             containing commands and variables that describe how data is to be represented.
200             The method returns a subroutine reference, which when called with a metadata
201             object, returns a web page containing the fields from the metadata substituted
202             into variables in the template. Variables in the template are preceded by Perl
203             sigils, so that a link would look like:
204              
205             <li><a href="$url">$title</a></li>
206              
207             =back
208              
209             =head1 TEMPLATE SYNTAX
210              
211             Templates support the basic control structures in Perl: "for" loops and
212             "if-else" blocks. Creating output is a two step process. First you generate a
213             subroutine from one or more templates, then you call the subroutine with your
214             data to generate the output.
215              
216             The template format is line oriented. Commands are enclosed in html comments
217             (<!-- -->). A command may be preceded by white space. If a command is a block
218             command, it is terminated by the word "end" followed by the command name. For
219             example, the "for" command is terminated by an "endfor" command and the "if"
220             command by an "endif" command.
221              
222             All lines may contain variables. As in Perl, variables are a sigil character
223             ('$' or '@') followed by one or more word characters. For example, C<$name> or
224             C<@names>. To indicate a literal character instead of a variable, precede the
225             sigil with a backslash. When you run the subroutine that this module generates,
226             you pass it a metadata object. The subroutine replaces variables in the template
227             with the value in the field built by the metadata object.
228              
229             If the first non-white characters on a line are the command start string, the
230             line is interpreted as a command. The command name continues up to the first
231             white space character. The text following the initial span of white space is the
232             command argument. The argument continues up to the command end string.
233              
234             Variables in the template have the same format as ordinary Perl variables,
235             a string of word characters starting with a sigil character. for example,
236              
237             $body @files
238              
239             are examples of variables. The following commands are supported in templates:
240              
241             =over 4
242              
243             =item do
244              
245             The remainder of the line is interpreted as Perl code.
246              
247             =item for
248              
249             Expand the text between the "for" and "endfor" commands several times. The
250             argument to the "for" command should be an expression evaluating to a list. The
251             code will expand the text in the for block once for each element in the list.
252              
253             <ul>
254             <!-- for @files -->
255             <li><a href="$url">$title</a></li>
256             <!-- endfor -->
257             </ul>
258              
259             =item if
260              
261             The text until the matching C<endif> is included only if the expression in the
262             "if" command is true. If false, the text is skipped.
263              
264             <div class="column">
265             <!-- for @files -->
266             <!-- if $count % 20 == 0 -->
267             </div>
268             <div class="column">
269             <!-- endif -->
270             $title<br />
271             <!-- endfor -->
272             </div>
273              
274             =item else
275              
276             The "if" and "for" commands can contain an C<else>. The text before the "else"
277             is included if the expression in the enclosing command is true and the
278             text after the "else" is included if the "if" command is false or the "for"
279             command does not execute. You can also place an "elsif" command inside a block,
280             which includes the following text if its expression is true.
281              
282             =back
283              
284             =head1 ERRORS
285              
286             What to check when this module throws an error
287              
288             =over 4
289              
290             =item Couldn't read template
291              
292             The template is in a file and the file could not be opened. Check the filename
293             and permissions on the file. Relative filenames can cause problems and the web
294             server is probably running another account than yours.
295              
296             =item Unknown command
297              
298             Either a command was spelled incorrectly or a line that is not a command
299             begins with the command start string.
300              
301             =item Missing end
302              
303             The template contains a command for the start of a block, but
304             not the command for the end of the block. For example an "if" command
305             is missing an "endif" command.
306              
307             =item Mismatched block end
308              
309             The parser found a different end command than the begin command for the block
310             it was parsing. Either an end command is missing, or block commands are nested
311             incorrectly.
312              
313             =item Syntax error
314              
315             The expression used in a command is not valid Perl.
316              
317             =back
318              
319             =head1 LICENSE
320              
321             Copyright (C) Bernie Simon.
322              
323             This library is free software; you can redistribute it and/or modify
324             it under the same terms as Perl itself.
325              
326             =head1 AUTHOR
327              
328             Bernie Simon E<lt>bernie.simon@gmail.comE<gt>
329              
330             =cut