line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Template::ExpandHash; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
24957
|
use 5.006; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
46
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
5
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
13
|
|
|
1
|
|
|
|
|
37
|
|
6
|
1
|
|
|
1
|
|
6
|
use Carp qw(confess); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
85
|
|
7
|
1
|
|
|
1
|
|
7
|
use Exporter 'import'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1212
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our @EXPORT_OK = qw(expand_hash); |
10
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub expand_hash { |
13
|
0
|
|
|
0
|
1
|
|
my $params; |
14
|
|
|
|
|
|
|
my $return_ref; |
15
|
0
|
0
|
0
|
|
|
|
if (1 == @_ and 'HASH' eq ref($_[0])) { |
|
|
0
|
|
|
|
|
|
16
|
0
|
|
|
|
|
|
$params = $_[0]; |
17
|
0
|
|
|
|
|
|
$return_ref = 1; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
elsif (0 == @_%2) { |
20
|
0
|
|
|
|
|
|
$params = {@_}; |
21
|
0
|
|
|
|
|
|
$return_ref = 0; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
else { |
24
|
0
|
|
|
|
|
|
confess("Need a hash or hash ref"); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
|
$params = {_deep_copy(%$params)}; |
28
|
0
|
|
|
|
|
|
my $todo = _calculate_todo($params); |
29
|
|
|
|
|
|
|
|
30
|
0
|
|
|
|
|
|
while (1) { |
31
|
0
|
|
|
|
|
|
(my $changed, $todo, $params) = _do_substitutions([$todo, $params]); |
32
|
0
|
0
|
|
|
|
|
if (not $changed) { |
33
|
0
|
0
|
|
|
|
|
return $return_ref ? $params : %$params; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# It would be nice to Storable::dclone, but Perl 5.14 broke on qr//. :-( |
39
|
|
|
|
|
|
|
sub _deep_copy { |
40
|
0
|
|
|
0
|
|
|
my %in = @_; |
41
|
0
|
|
|
|
|
|
for my $key (keys %in) { |
42
|
0
|
0
|
|
|
|
|
if ('HASH' eq ref($in{$key})) { |
43
|
0
|
|
|
|
|
|
$in{$key} = { _deep_copy(%{ $in{$key} }) }; |
|
0
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
} |
46
|
0
|
|
|
|
|
|
return %in; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# Creates a hash of the same shape to keep track of work left. |
50
|
|
|
|
|
|
|
sub _calculate_todo { |
51
|
0
|
|
|
0
|
|
|
my ($params) = @_; |
52
|
0
|
0
|
|
|
|
|
return 1 unless 'HASH' eq ref($params); |
53
|
0
|
|
|
|
|
|
return { map {($_ => _calculate_todo($params->{$_}))} keys %$params }; |
|
0
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Private function to do one pass of variable substitution on a config. |
57
|
|
|
|
|
|
|
# This substitutes things of the form [% foo %] with a variable named foo |
58
|
|
|
|
|
|
|
# in this scope or any enclosing one. (Hashes count as scopes.) You can use |
59
|
|
|
|
|
|
|
# \ for an escape mechanism (you may need to double them, sorry). |
60
|
|
|
|
|
|
|
sub _do_substitutions { |
61
|
0
|
|
|
0
|
|
|
my ($current, @rest) = @_; |
62
|
0
|
|
|
|
|
|
my ($todo, $to_change) = @$current; |
63
|
0
|
0
|
|
|
|
|
return (0, $todo, $to_change) unless 'HASH' eq ref($todo); |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
my $changes = 0; |
66
|
0
|
|
|
|
|
|
for my $key (keys %$todo) { |
67
|
0
|
|
|
|
|
|
my $value = $to_change->{$key}; |
68
|
0
|
0
|
|
|
|
|
if (not $value) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# print "Removing $key (no value)\n"; |
70
|
0
|
|
|
|
|
|
delete $todo->{$key}; |
71
|
0
|
|
|
|
|
|
next; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
elsif ('HASH' eq ref($value)) { |
74
|
0
|
|
|
|
|
|
(my $this_changes, my $left, $value) = _do_substitutions([$todo->{$key}, $value], [$todo, $to_change], @rest); |
75
|
0
|
0
|
|
|
|
|
if ($this_changes) { |
76
|
0
|
0
|
|
|
|
|
if (keys %$left) { |
77
|
0
|
|
|
|
|
|
$todo->{$key} = $left; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
else { |
80
|
0
|
|
|
|
|
|
delete $todo->{$key}; |
81
|
|
|
|
|
|
|
} |
82
|
0
|
|
|
|
|
|
$to_change->{$key} = $value; |
83
|
0
|
|
|
|
|
|
$changes += $this_changes; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
elsif (not ref($value)) { |
87
|
|
|
|
|
|
|
# It is a string, tokenize then parse and expand. |
88
|
0
|
|
|
|
|
|
my @tokens = ($value =~ /(\\.|\[%|%]|\w+|.)/g); |
89
|
0
|
|
|
|
|
|
my $final = ""; |
90
|
0
|
|
|
|
|
|
TOKENS: while (@tokens) { |
91
|
0
|
|
|
|
|
|
my $token = shift @tokens; |
92
|
0
|
0
|
|
|
|
|
if ($token =~ /^\\(.)/) { |
|
|
0
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Found an escaped character. |
94
|
0
|
|
|
|
|
|
$final .= $1; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
elsif ($token eq "[%") { |
97
|
|
|
|
|
|
|
# Figure out the lookup to do. |
98
|
0
|
|
|
|
|
|
my $variable = ""; |
99
|
0
|
|
0
|
|
|
|
while (@tokens and $tokens[0] ne "%]") { |
100
|
0
|
|
|
|
|
|
$variable .= shift @tokens; |
101
|
|
|
|
|
|
|
} |
102
|
0
|
|
|
|
|
|
$variable =~ s/^\s+//; |
103
|
0
|
|
|
|
|
|
$variable =~ s/\s+\z//; |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
|
my $found; |
106
|
0
|
|
|
|
|
|
for my $argument ([$todo, $to_change], @rest) { |
107
|
|
|
|
|
|
|
# If we find the lookup... |
108
|
0
|
0
|
|
|
|
|
if (defined $argument->[1]->{$variable}) { |
109
|
|
|
|
|
|
|
# And it is not in todo... |
110
|
0
|
0
|
|
|
|
|
if (not defined $argument->[0]->{$variable}) { |
111
|
0
|
|
|
|
|
|
$found = $argument->[1]->{$variable}; |
112
|
|
|
|
|
|
|
} |
113
|
0
|
|
|
|
|
|
last; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
|
last TOKENS if not defined $found; |
118
|
0
|
|
|
|
|
|
$final .= $found; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# Remove the end marker. |
121
|
0
|
|
|
|
|
|
shift @tokens; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
else { |
124
|
0
|
|
|
|
|
|
$final .= $token; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
0
|
0
|
|
|
|
|
if (not @tokens) { |
129
|
0
|
|
|
|
|
|
delete $todo->{$key}; |
130
|
0
|
|
|
|
|
|
$changes++; |
131
|
0
|
0
|
|
|
|
|
if ($final ne $value) { |
132
|
|
|
|
|
|
|
# print "Changed $value to $final\n"; |
133
|
0
|
|
|
|
|
|
$to_change->{$key} = $final; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
else { |
138
|
|
|
|
|
|
|
# We don't touch the internals of array refs, objects, etc. |
139
|
0
|
|
|
|
|
|
delete $todo->{$key}; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
return $changes, $todo, $to_change; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
1; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 NAME |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Template::ExpandHash - Do template expansion on the values of a hash. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=head1 VERSION |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Version 0.01 |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head1 SYNOPSIS |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
use Template::ExpandHash qw(expand_hash); |
159
|
|
|
|
|
|
|
# ... time passes |
160
|
|
|
|
|
|
|
%expanded_hash = expand_hash(%hash); |
161
|
|
|
|
|
|
|
$expanded_hashref = expand_hash($hashref); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
Pass a hash, get back a similar hash with [% key %] expanded into the value |
164
|
|
|
|
|
|
|
associated with that key. Recursive substitutions are supported, and the |
165
|
|
|
|
|
|
|
substituting goes into sub-hashes. (Sub-hashes can expand to keys from the |
166
|
|
|
|
|
|
|
surrounding hash, but not vice versa.) Template expressions can be escaped |
167
|
|
|
|
|
|
|
using backslashes. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head1 INTENDED USE CASE |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
When loading a configuration it often makes sense to start with a base |
172
|
|
|
|
|
|
|
configuration data structure, and then load multiple layers of tweaks for |
173
|
|
|
|
|
|
|
specific environments. This can happen within pure Perl as in this example: |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
$PARAM{prod} = { |
176
|
|
|
|
|
|
|
email_qa_email => undef, |
177
|
|
|
|
|
|
|
email_pager_email => 'pagerlist@company.com', |
178
|
|
|
|
|
|
|
some_escaped_value => '\[% user ]%', |
179
|
|
|
|
|
|
|
# etc |
180
|
|
|
|
|
|
|
email => { |
181
|
|
|
|
|
|
|
qa_email => '[% email_qa_email %]', |
182
|
|
|
|
|
|
|
pager_email => '[% email_pager_email %]', |
183
|
|
|
|
|
|
|
# etc |
184
|
|
|
|
|
|
|
}, |
185
|
|
|
|
|
|
|
# More data here. |
186
|
|
|
|
|
|
|
}; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
$PARAM{sandbox} = { |
189
|
|
|
|
|
|
|
%{$PARAM{prod}}, |
190
|
|
|
|
|
|
|
default_email => '[% user %]@company.com', |
191
|
|
|
|
|
|
|
email_qa_email => 'QA <[% default_email %]>', |
192
|
|
|
|
|
|
|
email_pager_email => 'Pagers <[% default_email %]>', |
193
|
|
|
|
|
|
|
# More data here, some of which overrides prod. |
194
|
|
|
|
|
|
|
}; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
$PARAM{btilly} = { |
197
|
|
|
|
|
|
|
%{$PARAM{sandbox}}, |
198
|
|
|
|
|
|
|
user => 'btilly', |
199
|
|
|
|
|
|
|
# More data here, some of which overrides the sandbox. |
200
|
|
|
|
|
|
|
}; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Alternately it can happen in a series of files which you might load from |
203
|
|
|
|
|
|
|
a list of external sources with code like this: |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
use Config::Any; |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# ... code here. |
208
|
|
|
|
|
|
|
my $raw_config_list |
209
|
|
|
|
|
|
|
= Config::Any->load_files({files => \@config_path, use_ext => 1}); |
210
|
|
|
|
|
|
|
my $config = {map %$_, map values %$_, @$raw_config_list}; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Either way there is a tendency for the set of overrides at the detail level |
213
|
|
|
|
|
|
|
to get very long. However with templating we could make this much shorter. |
214
|
|
|
|
|
|
|
Suppose that our final set of parameters worked out to be something like: |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
$config = { |
217
|
|
|
|
|
|
|
user => 'btilly', |
218
|
|
|
|
|
|
|
default_email => '[% user %]@company.com', |
219
|
|
|
|
|
|
|
email_qa_email => 'QA <[% default_email %]>', |
220
|
|
|
|
|
|
|
email_pager_email => 'Pagers <[% default_email %]>', |
221
|
|
|
|
|
|
|
some_escaped_value => '\[% user ]%', |
222
|
|
|
|
|
|
|
# etc |
223
|
|
|
|
|
|
|
email => { |
224
|
|
|
|
|
|
|
qa_email => '[% email_qa_email %]', |
225
|
|
|
|
|
|
|
pager_email => '[% email_pager_email %]', |
226
|
|
|
|
|
|
|
# etc |
227
|
|
|
|
|
|
|
}, |
228
|
|
|
|
|
|
|
# More data here. |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Then we can expand all of the template parameters: |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
$expanded_param = expand_hash($param); |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
And get: |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
{ |
238
|
|
|
|
|
|
|
user => 'btilly', |
239
|
|
|
|
|
|
|
default_email => 'btilly@company.com', |
240
|
|
|
|
|
|
|
email_qa_email => 'QA ', |
241
|
|
|
|
|
|
|
email_pager_email => 'Pagers ', |
242
|
|
|
|
|
|
|
some_escaped_value => '[% user ]%', |
243
|
|
|
|
|
|
|
# etc |
244
|
|
|
|
|
|
|
email => { |
245
|
|
|
|
|
|
|
qa_email => 'QA ', |
246
|
|
|
|
|
|
|
pager_email => 'Pagers ', |
247
|
|
|
|
|
|
|
# etc |
248
|
|
|
|
|
|
|
}, |
249
|
|
|
|
|
|
|
# More data here. |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
without having to manually override a long list of values. This makes your |
253
|
|
|
|
|
|
|
configuration much simpler and cleaner than it otherwise would be. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head2 expand_hash |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
The only externally usable function. You pass it a hash or hash ref and it |
260
|
|
|
|
|
|
|
will recursively expand template parameters and return you a hash or hash |
261
|
|
|
|
|
|
|
ref. |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=head1 AUTHOR |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Ben Tilly, C<< >> |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=head1 TODO |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=over 4 |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=item Error checking |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
No checks currently exist for malformed templates, or template references to |
274
|
|
|
|
|
|
|
variables that are not available. These would catch common typos and should |
275
|
|
|
|
|
|
|
be added. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=item Performance |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
Currently it keeps on passing through the list of not yet done variables until |
280
|
|
|
|
|
|
|
no further progress is made. Calculating a dependency graph up front could |
281
|
|
|
|
|
|
|
significantly help performance. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=item Refactor |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
All of the real work is done in one giant recursive function. It could be |
286
|
|
|
|
|
|
|
broken up into more digestable pieces. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=item Conditionals and loops |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Common template features do not work. Perhaps they would be useful. |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=item Recursive macro expansion |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
C<[% foo[% bar %] %]> does not currently work. It may be simple to add. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=back |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=head1 BUGS |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
Please report any bugs or feature requests to C
|
301
|
|
|
|
|
|
|
rt.cpan.org>, or through the web interface at |
302
|
|
|
|
|
|
|
L. I will |
303
|
|
|
|
|
|
|
be notified, and then you'll automatically be notified of progress on your bug |
304
|
|
|
|
|
|
|
as I make changes. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=head1 SUPPORT |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
perldoc Template::ExpandHash |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
Or email the author at C<< >>. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
The project home is L. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=over 4 |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
L |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
L |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=item * CPAN Ratings |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
L |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=item * Search CPAN |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
L |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=back |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
This module was produced under contract to ZipRecruiter.com. They are a good |
339
|
|
|
|
|
|
|
group of people, and I thank them for allowing this to be open sourced. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
All mistakes are, of course, mine. |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
Copyright 2012 Ben Tilly. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
Sponsored by ZipRecruiter.com. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
350
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
351
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |