File Coverage

blib/lib/Template/ExpandHash.pm
Criterion Covered Total %
statement 15 82 18.2
branch 0 38 0.0
condition 0 6 0.0
subroutine 5 9 55.5
pod 1 1 100.0
total 21 136 15.4


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.