| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Decl::Template;
|
|
2
|
|
|
|
|
|
|
|
|
3
|
12
|
|
|
12
|
|
67
|
use warnings;
|
|
|
12
|
|
|
|
|
21
|
|
|
|
12
|
|
|
|
|
342
|
|
|
4
|
12
|
|
|
12
|
|
64
|
use strict;
|
|
|
12
|
|
|
|
|
20
|
|
|
|
12
|
|
|
|
|
453
|
|
|
5
|
12
|
|
|
12
|
|
63
|
use Data::Dumper;
|
|
|
12
|
|
|
|
|
56
|
|
|
|
12
|
|
|
|
|
29773
|
|
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 NAME
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
Decl::Template - implements a template in the Decl system.
|
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 VERSION
|
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Version 0.01
|
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=cut
|
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '0.01';
|
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
A I is a textual representation of a class of data structures. A template has named slots and other value specifications that
|
|
23
|
|
|
|
|
|
|
permit an arbitary set of data to be extracted from the environment of its invocation and formatted into a text block that can be used
|
|
24
|
|
|
|
|
|
|
to do something else. In Decl, that "something else" is often the creation of a new set of nodes, but the typical use of templates
|
|
25
|
|
|
|
|
|
|
is to express data in display text.
|
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Decl templates are based pretty closely on JSON::Templates (a system used in Python and Javascript that I rather like).
|
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
This class, instead of implementing a template itself, actually implements a template environment. A template, after all, is just a
|
|
30
|
|
|
|
|
|
|
piece of text - and its output is also a piece of text. All the interesting stuff falls into the environment - it is in the environment
|
|
31
|
|
|
|
|
|
|
that we determine the values of all our slots, after all. And in the Decl context, that is no trivial task.
|
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head2 new()
|
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
The C function, of course, doesn't do much except set up the engine according to the parameters.
|
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=cut
|
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub new {
|
|
40
|
12
|
|
|
12
|
1
|
60
|
my ($class, %values) = @_;
|
|
41
|
12
|
|
|
|
|
39
|
my $self = bless \%values, $class;
|
|
42
|
|
|
|
|
|
|
#TODO: 'brackets' split
|
|
43
|
12
|
50
|
|
|
|
179
|
$self->{left} = '\[\[' unless $self->{left};
|
|
44
|
12
|
50
|
|
|
|
60
|
$self->{right} = '\]\]' unless $self->{right};
|
|
45
|
12
|
|
|
|
|
35
|
$self->{leftp} = $self->{left};
|
|
46
|
12
|
|
|
|
|
51
|
$self->{leftp} =~ s/\\//g;
|
|
47
|
12
|
|
|
|
|
33
|
$self->{rightp} = $self->{right};
|
|
48
|
12
|
|
|
|
|
49
|
$self->{rightp} =~ s/\\//g;
|
|
49
|
12
|
50
|
|
|
|
51
|
$self->{valuator} = \&default_valuator unless $self->{valuator};
|
|
50
|
12
|
50
|
|
|
|
59
|
$self->{leave_misses} = 1 unless defined $self->{leave_misses};
|
|
51
|
|
|
|
|
|
|
|
|
52
|
12
|
50
|
|
|
|
88
|
$self->{spanners} = {} unless $self->{spanners};
|
|
53
|
12
|
50
|
|
|
|
70
|
$self->{spanners}->{with} = \&do_with unless defined $self->{spanners}->{with};
|
|
54
|
12
|
50
|
|
|
|
101
|
$self->{spanners}->{if} = \&do_if unless defined $self->{spanners}->{if};
|
|
55
|
12
|
50
|
|
|
|
64
|
$self->{spanners}->{repeat} = \&do_repeat unless defined $self->{spanners}->{repeat};
|
|
56
|
|
|
|
|
|
|
|
|
57
|
12
|
|
|
|
|
55
|
$self;
|
|
58
|
|
|
|
|
|
|
}
|
|
59
|
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head2 default_valuator
|
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Given a value environment (by default, a hashref) and the name of a value, a valuator finds the value.
|
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
If nothing else is specified, the hashref valuator is used. In the Decl context, a node will generally
|
|
65
|
|
|
|
|
|
|
be used and the node's own valuation function is used as the valuator.
|
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=cut
|
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub default_valuator {
|
|
70
|
0
|
|
|
0
|
1
|
0
|
my ($name, $env) = @_;
|
|
71
|
0
|
|
|
|
|
0
|
$$env{$name};
|
|
72
|
|
|
|
|
|
|
}
|
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head2 prepare_varname
|
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Given a variable specification, prepare it for use as a lookup key.
|
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=cut
|
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub prepare_varname {
|
|
81
|
0
|
|
|
0
|
1
|
0
|
my ($name) = @_;
|
|
82
|
0
|
|
|
|
|
0
|
$name =~ s/\n */ /sg;
|
|
83
|
0
|
|
|
|
|
0
|
$name =~ s/^ *//g;
|
|
84
|
0
|
|
|
|
|
0
|
$name =~ s/ *$//g;
|
|
85
|
0
|
|
|
|
|
0
|
$name;
|
|
86
|
|
|
|
|
|
|
}
|
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head2 parse_spanning_command
|
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
Given a spanning command string, parse out the initial word (the command) and leave the arguments (the rest). Drop the . or +.
|
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=cut
|
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub parse_spanning_command {
|
|
95
|
0
|
|
|
0
|
1
|
0
|
my $piece = shift;
|
|
96
|
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
0
|
$piece =~ s/^[+\.] *//;
|
|
98
|
0
|
|
|
|
|
0
|
split m[ +], $piece, 2;
|
|
99
|
|
|
|
|
|
|
}
|
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head2 handle_spanning_command
|
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Given a parsed spanning command and the value object and valuator function to be used, express the command. This is really just
|
|
104
|
|
|
|
|
|
|
a dispatcher for a command table.
|
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut
|
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub handle_spanning_command {
|
|
109
|
0
|
|
|
0
|
1
|
0
|
my ($self, $command, $values, $valuator) = @_;
|
|
110
|
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
my $c = $self->{spanners}->{$$command[0]};
|
|
112
|
0
|
0
|
|
|
|
0
|
return $c->($self, $command, $values, $valuator) if $c;
|
|
113
|
0
|
|
|
|
|
0
|
return ''; # TODO: consider better error handling. As always.
|
|
114
|
|
|
|
|
|
|
}
|
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head2 register_spanning_command ($name, $closure)
|
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Here's how you register a spanning command. Just name it and provide a closure for it, and you're good to go.
|
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=cut
|
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub register_spanning_command {
|
|
123
|
0
|
|
|
0
|
1
|
0
|
my ($self, $name, $sub) = @_;
|
|
124
|
|
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
0
|
$self->{spanners}->{$name} = $sub;
|
|
126
|
|
|
|
|
|
|
}
|
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 do_with, do_if, do_repeat, express_repeat
|
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
These are our three default spanning commands. More can be added to the table.
|
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
The C does the heavy lifting in expressing the list template and can be recycled in other forms of list template.
|
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut
|
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub do_with {
|
|
137
|
0
|
|
|
0
|
1
|
0
|
my ($self, $command, $values, $valuator) = @_;
|
|
138
|
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
0
|
my $with = do_lookup($$command[1], $values, $valuator);
|
|
140
|
0
|
|
|
|
|
0
|
$self->express_parsed ($$command[2], $with, \&default_valuator);
|
|
141
|
|
|
|
|
|
|
}
|
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub do_if {
|
|
144
|
0
|
|
|
0
|
1
|
0
|
my ($self, $command, $values, $valuator) = @_;
|
|
145
|
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
0
|
my $test = do_lookup ($$command[1], $values, $valuator);
|
|
147
|
0
|
0
|
|
|
|
0
|
if ($test) {
|
|
148
|
0
|
|
|
|
|
0
|
return $self->express_parsed ($$command[2], $values, $valuator);
|
|
149
|
|
|
|
|
|
|
}
|
|
150
|
0
|
|
|
|
|
0
|
my @alternatives = @{$$command[3]};
|
|
|
0
|
|
|
|
|
0
|
|
|
151
|
0
|
|
|
|
|
0
|
foreach my $check (@alternatives) {
|
|
152
|
0
|
0
|
|
|
|
0
|
if ($$check[0] eq 'elif') {
|
|
153
|
0
|
|
|
|
|
0
|
$test = do_lookup ($$check[1], $values, $valuator);
|
|
154
|
0
|
0
|
|
|
|
0
|
if ($test) {
|
|
155
|
0
|
|
|
|
|
0
|
return $self->express_parsed ($$check[2], $values, $valuator);
|
|
156
|
|
|
|
|
|
|
}
|
|
157
|
|
|
|
|
|
|
}
|
|
158
|
0
|
0
|
|
|
|
0
|
if ($$check[0] eq 'else') {
|
|
159
|
0
|
|
|
|
|
0
|
return $self->express_parsed ($$check[2], $values, $valuator);
|
|
160
|
|
|
|
|
|
|
}
|
|
161
|
|
|
|
|
|
|
}
|
|
162
|
0
|
|
|
|
|
0
|
return '';
|
|
163
|
|
|
|
|
|
|
}
|
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub do_repeat {
|
|
166
|
0
|
|
|
0
|
1
|
0
|
my ($self, $command, $values, $valuator) = @_;
|
|
167
|
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
0
|
my $loop = do_lookup ($$command[1], $values, $valuator);
|
|
169
|
0
|
|
|
|
|
0
|
my @list;
|
|
170
|
0
|
0
|
|
|
|
0
|
if (ref $loop eq 'ARRAY') {
|
|
|
|
0
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
0
|
@list = @$loop;
|
|
172
|
|
|
|
|
|
|
} elsif (not defined $loop) {
|
|
173
|
0
|
|
|
|
|
0
|
@list = ();
|
|
174
|
|
|
|
|
|
|
} else {
|
|
175
|
0
|
|
|
|
|
0
|
@list = ($loop);
|
|
176
|
|
|
|
|
|
|
}
|
|
177
|
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
0
|
$self->express_repeat ($command, $values, $valuator, @list);
|
|
179
|
|
|
|
|
|
|
}
|
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub express_repeat {
|
|
182
|
0
|
|
|
0
|
1
|
0
|
my $self = shift;
|
|
183
|
0
|
|
|
|
|
0
|
my $command = shift;
|
|
184
|
0
|
|
|
|
|
0
|
my $values = shift;
|
|
185
|
0
|
|
|
|
|
0
|
my $valuator = shift;
|
|
186
|
|
|
|
|
|
|
|
|
187
|
0
|
0
|
|
|
|
0
|
if (not @_) {
|
|
188
|
0
|
|
|
|
|
0
|
foreach my $else (@{$$command[3]}) {
|
|
|
0
|
|
|
|
|
0
|
|
|
189
|
0
|
0
|
|
|
|
0
|
if ($$else[0] eq 'else') {
|
|
190
|
0
|
|
|
|
|
0
|
return $self->express_parsed ($$else[2], $values, $valuator);
|
|
191
|
|
|
|
|
|
|
}
|
|
192
|
|
|
|
|
|
|
}
|
|
193
|
0
|
|
|
|
|
0
|
return '';
|
|
194
|
|
|
|
|
|
|
}
|
|
195
|
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
0
|
my $body = $$command[2];
|
|
197
|
0
|
|
|
|
|
0
|
my $before = '';
|
|
198
|
0
|
|
|
|
|
0
|
my $alternate = '';
|
|
199
|
0
|
|
|
|
|
0
|
my $after = '';
|
|
200
|
0
|
|
|
|
|
0
|
foreach (@{$$command[3]}) {
|
|
|
0
|
|
|
|
|
0
|
|
|
201
|
0
|
0
|
|
|
|
0
|
if ($$_[0] eq 'before') {
|
|
202
|
0
|
|
|
|
|
0
|
$before = $self->express_parsed ($$_[2], $values, $valuator);
|
|
203
|
0
|
|
|
|
|
0
|
next;
|
|
204
|
|
|
|
|
|
|
}
|
|
205
|
0
|
0
|
|
|
|
0
|
if ($$_[0] eq 'alt') {
|
|
206
|
0
|
|
|
|
|
0
|
$alternate = $self->express_parsed ($$_[2], $values, $valuator);
|
|
207
|
0
|
|
|
|
|
0
|
next;
|
|
208
|
|
|
|
|
|
|
}
|
|
209
|
0
|
0
|
|
|
|
0
|
if ($$_[0] eq 'after') {
|
|
210
|
0
|
|
|
|
|
0
|
$after = $self->express_parsed ($$_[2], $values, $valuator);
|
|
211
|
0
|
|
|
|
|
0
|
next;
|
|
212
|
|
|
|
|
|
|
}
|
|
213
|
0
|
0
|
|
|
|
0
|
if ($$_[0] eq 'body') {
|
|
214
|
0
|
|
|
|
|
0
|
$body = $$_[2];
|
|
215
|
0
|
|
|
|
|
0
|
next;
|
|
216
|
|
|
|
|
|
|
}
|
|
217
|
|
|
|
|
|
|
}
|
|
218
|
|
|
|
|
|
|
|
|
219
|
0
|
|
|
|
|
0
|
my $return = $before;
|
|
220
|
0
|
|
|
|
|
0
|
while (@_) {
|
|
221
|
0
|
|
|
|
|
0
|
my $this = shift;
|
|
222
|
0
|
|
|
|
|
0
|
$return .= $self->express_parsed ($body, $this, \&default_valuator);
|
|
223
|
0
|
0
|
|
|
|
0
|
$return .= $alternate if (@_);
|
|
224
|
|
|
|
|
|
|
}
|
|
225
|
0
|
|
|
|
|
0
|
$return .= $after;
|
|
226
|
|
|
|
|
|
|
|
|
227
|
0
|
|
|
|
|
0
|
$return;
|
|
228
|
|
|
|
|
|
|
}
|
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head2 do_lookup ($name, $values, $valuator)
|
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Takes a value specification, cleans up the name, applies filters, and returns the final value. TODO: filters.
|
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=cut
|
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub do_lookup {
|
|
237
|
0
|
|
|
0
|
1
|
0
|
my ($name, $values, $valuator) = @_;
|
|
238
|
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
0
|
$valuator->(prepare_varname($name), $values);
|
|
240
|
|
|
|
|
|
|
}
|
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 parse_template ($template)
|
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
This parses our template language into a kind of interlanguage consisting of interleaved plain text and commands to be carried out to generate
|
|
245
|
|
|
|
|
|
|
text. Then we can either express the command structure, or alternatively translate it into some other template language.
|
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
So. Our template language is text interspersed with fields delimited by default delimiters of [[ and ]]. (These can be overridden.)
|
|
248
|
|
|
|
|
|
|
Its output is a list (or arrayref) of commands. Plain text between fields is output exactly as-is, and so the output "command" is simply a
|
|
249
|
|
|
|
|
|
|
string containing that text.
|
|
250
|
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Most fields are variable lookups, and these turn into ['lookup', ''] - where "variable" can be an extended command if our valuation
|
|
252
|
|
|
|
|
|
|
function knows how to handle them. The basic template engine, however, simply looks up names in a hashref.
|
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Any field of the form [[. ]] is a "dotted command" or "spanning command".
|
|
255
|
|
|
|
|
|
|
The default ones defined are .repeat, .with, and .if; you can write
|
|
256
|
|
|
|
|
|
|
your own, though. (TODO: provide a way to hook them in.) A dotted command extends until it hits [[.end]], and they can of course be
|
|
257
|
|
|
|
|
|
|
nested.
|
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
The Decl node framework will also provide a .select command, which will do exactly what you think it will. I think, based on this
|
|
260
|
|
|
|
|
|
|
alone, you could probably build a believable report generator.
|
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Within a spanning command, you can define subranges with [[+ and C in the C<.if>
|
|
263
|
|
|
|
|
|
|
command, and for C and C in the C<.repeat> command. What you get back is then a hashref with any subranges stored
|
|
264
|
|
|
|
|
|
|
by name for your viewing pleasure.
|
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
The parser outputs a spanning command like this:
|
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
['',
|
|
269
|
|
|
|
|
|
|
[],
|
|
270
|
|
|
|
|
|
|
[ [, , ],
|
|
271
|
|
|
|
|
|
|
... (this part is optional and repeated for as many subcommands as appear)
|
|
272
|
|
|
|
|
|
|
]
|
|
273
|
|
|
|
|
|
|
]
|
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
The hashref of named subspans likewise has arrayrefs for values. Each of the arrayrefs in this structure has already been parsed by the
|
|
276
|
|
|
|
|
|
|
time all is said and done.
|
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=cut
|
|
279
|
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub parse_template {
|
|
281
|
2
|
|
|
2
|
1
|
5
|
my ($self, $template) = @_;
|
|
282
|
|
|
|
|
|
|
|
|
283
|
2
|
|
|
|
|
4
|
my @pieces;
|
|
284
|
2
|
|
|
|
|
6
|
my $main_body = [];
|
|
285
|
2
|
|
|
|
|
5
|
my @arglist = ();
|
|
286
|
2
|
|
|
|
|
3
|
my $curspan = '';
|
|
287
|
2
|
|
|
|
|
3
|
my $curspan_args = '';
|
|
288
|
|
|
|
|
|
|
|
|
289
|
2
|
50
|
|
|
|
8
|
if (ref($template) eq 'ARRAY') {
|
|
290
|
|
|
|
|
|
|
# An arrayref means we've already split the template and we
|
|
291
|
|
|
|
|
|
|
# just need to express it.
|
|
292
|
0
|
|
|
|
|
0
|
@pieces = @$template;
|
|
293
|
|
|
|
|
|
|
} else {
|
|
294
|
2
|
|
|
|
|
33
|
@pieces = split /$self->{left}(.*?)$self->{right}/s, $template;
|
|
295
|
|
|
|
|
|
|
}
|
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# First step: scan the template pieces and take care of any spanning
|
|
298
|
|
|
|
|
|
|
# commands (.repeat, .with, or .if)
|
|
299
|
2
|
|
|
|
|
5
|
my @current_span = ();
|
|
300
|
2
|
|
|
|
|
4
|
my $on = 1;
|
|
301
|
2
|
|
|
|
|
3
|
my $trailing_indent;
|
|
302
|
2
|
|
|
|
|
6
|
while (@pieces) {
|
|
303
|
2
|
|
|
|
|
5
|
$on = not $on;
|
|
304
|
2
|
50
|
|
|
|
27
|
if (not $on) {
|
|
305
|
2
|
|
|
|
|
4
|
my $literal = shift @pieces;
|
|
306
|
2
|
|
|
|
|
4
|
push @current_span, $literal;
|
|
307
|
2
|
50
|
|
|
|
18
|
if ($literal =~ /\n([^\n]*?)\z/s) {
|
|
308
|
2
|
|
|
|
|
7
|
$trailing_indent = length($1);
|
|
309
|
2
|
50
|
|
|
|
40
|
if ($1 =~ /^\s*$/) {
|
|
310
|
2
|
|
|
|
|
6
|
$trailing_indent = 0;
|
|
311
|
|
|
|
|
|
|
}
|
|
312
|
|
|
|
|
|
|
} else {
|
|
313
|
0
|
|
|
|
|
0
|
$trailing_indent = length($literal);
|
|
314
|
|
|
|
|
|
|
}
|
|
315
|
2
|
|
|
|
|
8
|
next;
|
|
316
|
|
|
|
|
|
|
}
|
|
317
|
|
|
|
|
|
|
|
|
318
|
0
|
|
|
|
|
0
|
my $piece = shift @pieces;
|
|
319
|
0
|
0
|
|
|
|
0
|
if ($piece !~ /^[+\.]/) {
|
|
320
|
0
|
|
|
|
|
0
|
push @current_span, ['lookup', $piece];
|
|
321
|
0
|
|
|
|
|
0
|
next;
|
|
322
|
|
|
|
|
|
|
}
|
|
323
|
|
|
|
|
|
|
|
|
324
|
0
|
|
|
|
|
0
|
$pieces[0] =~ s/^\s*\n//s;
|
|
325
|
|
|
|
|
|
|
|
|
326
|
0
|
|
|
|
|
0
|
my ($command, $args) = parse_spanning_command ($piece);
|
|
327
|
|
|
|
|
|
|
|
|
328
|
0
|
0
|
|
|
|
0
|
if ($piece =~ /^\+/) {
|
|
329
|
0
|
0
|
|
|
|
0
|
if ($curspan eq '') {
|
|
330
|
0
|
|
|
|
|
0
|
$main_body = [@current_span];
|
|
331
|
|
|
|
|
|
|
} else {
|
|
332
|
0
|
|
|
|
|
0
|
push @arglist, [$curspan, $curspan_args, [@current_span]];
|
|
333
|
|
|
|
|
|
|
}
|
|
334
|
0
|
|
|
|
|
0
|
@current_span = ();
|
|
335
|
0
|
|
|
|
|
0
|
$curspan = $command;
|
|
336
|
0
|
|
|
|
|
0
|
$curspan_args = $args;
|
|
337
|
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
0
|
next;
|
|
339
|
|
|
|
|
|
|
}
|
|
340
|
|
|
|
|
|
|
|
|
341
|
0
|
0
|
|
|
|
0
|
if ($command eq 'end') {
|
|
342
|
0
|
0
|
|
|
|
0
|
if ($curspan eq '') {
|
|
343
|
0
|
|
|
|
|
0
|
$main_body = [@current_span];
|
|
344
|
|
|
|
|
|
|
} else {
|
|
345
|
0
|
|
|
|
|
0
|
push @arglist, [$curspan, $curspan_args, [@current_span]];
|
|
346
|
|
|
|
|
|
|
}
|
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# If we've encountered an .end command, return what we've got.
|
|
349
|
0
|
|
|
|
|
0
|
return ($main_body, \@arglist, \@pieces);
|
|
350
|
|
|
|
|
|
|
}
|
|
351
|
|
|
|
|
|
|
|
|
352
|
0
|
|
|
|
|
0
|
my ($body, $arglist, $rest) = $self->parse_template (\@pieces);
|
|
353
|
0
|
|
|
|
|
0
|
push @current_span, [$command, $args, $body, $arglist];
|
|
354
|
0
|
|
|
|
|
0
|
@pieces = @$rest;
|
|
355
|
|
|
|
|
|
|
}
|
|
356
|
|
|
|
|
|
|
|
|
357
|
2
|
50
|
|
|
|
7
|
if ($curspan eq '') {
|
|
358
|
2
|
|
|
|
|
5
|
$main_body = \@current_span;
|
|
359
|
|
|
|
|
|
|
} else {
|
|
360
|
0
|
|
|
|
|
0
|
push @arglist, [$curspan, $curspan_args, \@current_span];
|
|
361
|
|
|
|
|
|
|
}
|
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
|
|
364
|
2
|
50
|
|
|
|
7
|
return ($main_body, \@arglist, \@pieces) if wantarray;
|
|
365
|
2
|
|
|
|
|
7
|
$main_body;
|
|
366
|
|
|
|
|
|
|
}
|
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=head2 express_parsed ($template, $values, $valuator)
|
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
Given a parse tree returned from the above function, plus a value structure and a way to retrieve first-level values from it (second-level
|
|
371
|
|
|
|
|
|
|
values are presumed to be hashrefs or arrayrefs returned from the first level, and perhaps there might someday be motivation to extend
|
|
372
|
|
|
|
|
|
|
that notion to some kind of lazy evaluation, but I), (breathe) returns the expressed template. Which is just a string.
|
|
373
|
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Non-default spanning commands must be defined in the engine before use.
|
|
375
|
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=cut
|
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub express_parsed {
|
|
379
|
2
|
|
|
2
|
1
|
4
|
my ($self, $template, $values, $valuator) = @_;
|
|
380
|
|
|
|
|
|
|
|
|
381
|
2
|
50
|
0
|
|
|
7
|
$values = $self->{values} || {} unless defined $values;
|
|
382
|
2
|
50
|
|
|
|
9
|
$valuator = $self->{valuator} unless defined $valuator;
|
|
383
|
|
|
|
|
|
|
|
|
384
|
2
|
|
|
|
|
5
|
my $return = '';
|
|
385
|
|
|
|
|
|
|
|
|
386
|
2
|
|
|
|
|
3
|
my $indent = 0;
|
|
387
|
2
|
|
|
|
|
4
|
my $literal;
|
|
388
|
2
|
|
|
|
|
4
|
my $value = undef;
|
|
389
|
|
|
|
|
|
|
|
|
390
|
2
|
|
|
|
|
6
|
foreach my $piece (@$template) {
|
|
391
|
2
|
50
|
|
|
|
8
|
next unless defined $piece; # Just in case.
|
|
392
|
2
|
50
|
|
|
|
6
|
if (not ref $piece) { # Strings just pass through.
|
|
393
|
2
|
|
|
|
|
4
|
$value = $piece;
|
|
394
|
2
|
|
|
|
|
4
|
$literal = 1;
|
|
395
|
|
|
|
|
|
|
} else {
|
|
396
|
0
|
0
|
|
|
|
0
|
next unless ref $piece eq 'ARRAY'; # Anything but an arrayref or string will be roundly ignored.
|
|
397
|
|
|
|
|
|
|
|
|
398
|
0
|
|
|
|
|
0
|
$literal = 0;
|
|
399
|
0
|
0
|
|
|
|
0
|
if ($$piece[0] eq 'lookup') {
|
|
400
|
0
|
|
|
|
|
0
|
$value = do_lookup($$piece[1], $values, $valuator);
|
|
401
|
0
|
0
|
|
|
|
0
|
if (not defined $value) { # If the value is undefined, then either leave the field in place, or don't.
|
|
402
|
0
|
0
|
|
|
|
0
|
if ($self->{leave_misses}) {
|
|
403
|
0
|
|
|
|
|
0
|
$value = $self->{leftp} . $$piece[1] . $self->{rightp}
|
|
404
|
|
|
|
|
|
|
} else {
|
|
405
|
0
|
|
|
|
|
0
|
$value = '';
|
|
406
|
|
|
|
|
|
|
}
|
|
407
|
|
|
|
|
|
|
}
|
|
408
|
|
|
|
|
|
|
} else { # We have a spanning command.
|
|
409
|
0
|
|
|
|
|
0
|
$value = $self->handle_spanning_command($piece, $values, $valuator);
|
|
410
|
|
|
|
|
|
|
}
|
|
411
|
|
|
|
|
|
|
}
|
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# If the value is an arrayref, use its length. This gives us a cheap way to say "search returned [[x]] rows"; just reuse the result variable.
|
|
414
|
2
|
50
|
|
|
|
7
|
if (ref $value eq 'ARRAY') {
|
|
415
|
0
|
|
|
|
|
0
|
$value = scalar @$value;
|
|
416
|
|
|
|
|
|
|
}
|
|
417
|
|
|
|
|
|
|
# If the value is a hashref, run it through our JSONifier for output as a debugging value.
|
|
418
|
|
|
|
|
|
|
# If it's an object, do .... hell, I dunno. If it can "describe" (i.e. it's a node) then it should do that.
|
|
419
|
|
|
|
|
|
|
# TODO: both of the above cases. I just don't need these right now.
|
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# Now we've got a value, so we insert it into the expression,
|
|
422
|
|
|
|
|
|
|
# taking care to keep track of indentation so we can do literate
|
|
423
|
|
|
|
|
|
|
# programming of Python. (No, seriously, that was my major
|
|
424
|
|
|
|
|
|
|
# motivation here; sort of a left-over from a decade ago.)
|
|
425
|
2
|
|
|
|
|
4
|
my $indent_incr;
|
|
426
|
2
|
50
|
|
|
|
15
|
if ($value =~ /\n([^\n]*?)\z/s) { # 2011-08-17 - learned about \z today!
|
|
427
|
2
|
50
|
|
|
|
6
|
if ($literal) {
|
|
428
|
2
|
|
|
|
|
5
|
$indent = length($1);
|
|
429
|
|
|
|
|
|
|
} else {
|
|
430
|
0
|
|
|
|
|
0
|
$indent_incr += length($1);
|
|
431
|
0
|
|
|
|
|
0
|
my $spaces = ' ' x $indent;
|
|
432
|
0
|
|
|
|
|
0
|
$value =~ s/\n/\n$spaces/g;
|
|
433
|
0
|
|
|
|
|
0
|
$indent += $indent_incr;
|
|
434
|
|
|
|
|
|
|
}
|
|
435
|
|
|
|
|
|
|
} else {
|
|
436
|
0
|
|
|
|
|
0
|
$indent += length($value);
|
|
437
|
|
|
|
|
|
|
}
|
|
438
|
2
|
|
|
|
|
10
|
$return .= $value;
|
|
439
|
|
|
|
|
|
|
}
|
|
440
|
2
|
|
|
|
|
14
|
$return;
|
|
441
|
|
|
|
|
|
|
}
|
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head2 express($template, $values, $valuator)
|
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
If C<$template> is omitted, the default template for the engine is used. If C<$values> is omitted, same goes for any previously
|
|
447
|
|
|
|
|
|
|
defined values. And the default C<$valuator> is defined above.
|
|
448
|
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=cut
|
|
450
|
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub express {
|
|
452
|
2
|
|
|
2
|
1
|
6
|
my ($self, $template, $values, $valuator) = @_;
|
|
453
|
|
|
|
|
|
|
|
|
454
|
2
|
50
|
0
|
|
|
7
|
$template = $self->{template} || '' unless defined $template;
|
|
455
|
|
|
|
|
|
|
|
|
456
|
2
|
|
|
|
|
10
|
my $pieces = $self->parse_template($template); # Note that anything after a superfluous [[+command]] or [[.end]] will be ignored.
|
|
457
|
|
|
|
|
|
|
|
|
458
|
2
|
|
|
|
|
9
|
$self->express_parsed ($pieces, $values, $valuator);
|
|
459
|
|
|
|
|
|
|
}
|
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
Michael Roberts, C<< >>
|
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=head1 BUGS
|
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through
|
|
469
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll
|
|
470
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes.
|
|
471
|
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
473
|
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
Copyright 2010 Michael Roberts.
|
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
477
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published
|
|
478
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License.
|
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information.
|
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=cut
|
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
1; # End of Decl::Template
|