File Coverage

blib/lib/Data/Walk.pm
Criterion Covered Total %
statement 93 95 97.8
branch 43 44 97.7
condition 11 12 91.6
subroutine 9 9 100.0
pod 2 2 100.0
total 158 162 97.5


line stmt bran cond sub pod time code
1             #! /bin/false
2              
3             # Traverse Perl data structures.
4             # Copyright (C) 2005-2016 Guido Flohr ,
5             # all rights reserved.
6              
7             # This program is free software; you can redistribute it and/or modify it
8             # under the terms of the GNU Library General Public License as published
9             # by the Free Software Foundation; either version 2, or (at your option)
10             # any later version.
11              
12             # This program is distributed in the hope that it will be useful,
13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15             # Library General Public License for more details.
16              
17             # You should have received a copy of the GNU Library General Public
18             # License along with this program; if not, write to the Free Software
19             # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
20             # USA.
21              
22             package Data::Walk;
23              
24 8     8   29589 use strict;
  8         10  
  8         184  
25 8     8   122 use 5.004;
  8         17  
26              
27 8     8   28 use Scalar::Util;
  8         11  
  8         443  
28              
29             require Exporter;
30              
31 8     8   28 use vars qw ($VERSION @ISA @EXPORT);
  8         14  
  8         577  
32              
33             $VERSION = '2.01';
34             @ISA = qw (Exporter);
35             @EXPORT = qw (walk walkdepth);
36              
37 8     8   37 use vars qw ($container $type $seen $address $depth $index $key);
  8         23  
  8         5410  
38              
39             # Forward declarations.
40             sub walk;
41             sub walkdepth;
42             sub __walk;
43             sub __recurse;
44              
45             sub walk {
46 24     24 1 2716 my ($options, @args) = @_;
47            
48 24 100       73 unless (UNIVERSAL::isa($options, 'HASH')) {
49 10         17 $options = { wanted => $options };
50             }
51              
52 24         41 __walk ($options, @args);
53             }
54              
55             sub walkdepth {
56 3     3 1 36 my ($options, @args) = @_;
57              
58 3 100       13 unless (UNIVERSAL::isa($options, 'HASH')) {
59 2         5 $options = { wanted => $options };
60             }
61              
62 3         4 $options->{bydepth} = 1;
63              
64 3         6 __walk ($options, @args);
65             }
66              
67             sub __walk {
68 27     27   30 my ($options, @args) = @_;
69              
70 27         55 $options->{seen} = {};
71              
72 27         35 local $index = 0;
73 27         38 foreach my $item (@args) {
74 27         29 local ($container, $type, $depth);
75 27 100       48 if (ref $item) {
76 26 100       79 if (UNIVERSAL::isa ($item, 'HASH')) {
    50          
77 15         17 $container = $item;
78 15         18 $type = 'HASH';
79             } elsif (UNIVERSAL::isa ($item, 'ARRAY')) {
80 11         11 $container = $item;
81 11         13 $type = 'ARRAY';
82             } else {
83 0         0 $container = \@args;
84 0         0 $type = 'ARRAY';
85             }
86             } else {
87 1         1 $container = \@args;
88 1         2 $type = 'ARRAY';
89             }
90 27         21 $depth = 0;
91 27         42 __recurse $options, $item;
92 27         35 ++$index;
93             }
94            
95 27         160 return 1;
96             }
97              
98             sub __recurse {
99 426     426   368 my ($options, $item) = @_;
100              
101 426         275 ++$depth;
102            
103 426         227 my @children;
104 426         286 my $data_type = '';
105              
106 426         526 local ($container, $type, $address, $seen) = ($container, $type, undef, 0);
107 426         381 my $ref = ref $item;
108              
109 426 100       499 if ($ref) {
110 48         104 my $blessed = Scalar::Util::blessed($item);
111              
112             # Avoid fancy overloading stuff.
113 48 100       72 bless $item if $blessed;
114 48         68 $address = Scalar::Util::refaddr($item);
115            
116 48         100 $seen = $options->{seen}->{$address}++;
117              
118 48 100       114 if (UNIVERSAL::isa ($item, 'HASH')) {
    100          
119 18         25 $data_type = 'HASH';
120             } elsif (UNIVERSAL::isa ($item, 'ARRAY')) {
121 27         22 $data_type = 'ARRAY';
122             } else {
123 3         3 $data_type = '';
124             }
125            
126 48 100 100     145 if ('ARRAY' eq $data_type || 'HASH' eq $data_type) {
127 45         35 local $index = -1;
128 45         35 local $type = $data_type;
129 45         38 local $container = $item;
130              
131 45 100       52 if ('ARRAY' eq $data_type) {
132 27         18 @children = @{$item};
  27         55  
133             } else {
134 18         16 @children = %{$item};
  18         70  
135             }
136            
137 45 100       74 if ('ARRAY' eq $data_type) {
138 1         3 @children = $options->{preprocess} (@{$item})
139 27 100       51 if $options->{preprocess};
140             } else {
141 18         15 local $container = \@children;
142             @children = $options->{preprocess} (@children)
143 18 100       44 if $options->{preprocess};
144             @children = $options->{preprocess_hash} (@children)
145 18 100       119 if $options->{preprocess_hash};
146             }
147             } else {
148 3         2 $data_type = '';
149             }
150              
151             # Recover original object state.
152 48 100       230 bless $item, $ref if $blessed;
153             }
154              
155 426 100       533 unless ($options->{bydepth}) {
156 403         301 local $_ = $item;
157 403         480 $options->{wanted}->($item);
158             }
159              
160 426 100 100     28879 if (@children && ($options->{follow} || !$seen)) {
      66        
161 42         44 local ($container, $type, $index);
162 42         43 $type = $data_type;
163 42         32 $container = $item;
164 42         32 $index = 0;
165              
166 42         46 foreach my $child (@children) {
167 399 100 100     974 if ($type eq 'HASH' && $index & 1) {
168 114         133 $key = $children[$index - 1];
169             } else {
170 285         225 undef $key;
171             }
172 399         492 __recurse $options, $child;
173 399         359 ++$index;
174             }
175             }
176              
177 426 100       637 if ($options->{bydepth}) {
178 23         17 local $_ = $item;
179 23         36 $options->{wanted}->($item);
180             }
181              
182 426 100       3141 if ($data_type) {
183 45         81 local ($container, $type, $index) = ($item, $data_type, -1);
184 45 100       88 $options->{postprocess}->() if $options->{postprocess};
185             }
186              
187 426         484 --$depth;
188             # void
189             }
190              
191              
192             1;
193              
194             =head1 NAME
195              
196             Data::Walk - Traverse Perl data structures
197              
198             =head1 SYNOPSIS
199              
200             use Data::Walk;
201             walk \&wanted, @items_to_walk;
202              
203             use Data::Walk;
204             walkdepth \&wanted, @items_to_walk;
205            
206             use Data::Walk;
207             walk { wanted => \&process, follow => 1 }, $self;
208            
209             =head1 DESCRIPTION
210              
211             The above synopsis bears an amazing similarity to File::Find(3pm)
212             and this is not coincidental.
213              
214             Data::Walk(3pm) is for data what File::Find(3pm) is for files.
215             You can use it for rolling your own serialization class, for displaying
216             Perl data structures, for deep copying or comparing, for recursive
217             deletion of data, or ...
218              
219             If you are impatient and already familiar with File::Find(3pm),
220             you can skip the following documentation and proceed with
221             L.
222              
223             =head1 FUNCTIONS
224              
225             The module exports two functions by default:
226              
227             =over 4
228              
229             =item B
230              
231             walk \&wanted, @items;
232             walk \%options, @items;
233              
234             As the name suggests, the function traverses the items in the order
235             they are given. For every object visited, it calls the &wanted
236             subroutine. See L for details.
237              
238             =item B
239              
240             walkdepth \&wanted, @items;
241             walkdepth \%options, @items;
242              
243             Works exactly like C but it first descends deeper into
244             the structure, before visiting the nodes on the current level.
245             If you want to delete visited nodes, then C is probably
246             your friend.
247              
248             =back
249              
250             =head1 OPTIONS
251              
252             The first argument to C and C is either a
253             code reference to your &wanted function, or a hash reference
254             describing the operations to be performed for each visited
255             node.
256              
257             Here are the possible keys for the hash.
258              
259             =over 4
260              
261             =item B
262              
263             The value should be a code reference. This code reference is
264             described in L below.
265              
266             =item B
267              
268             Visits nodes on the current level of recursion only B
269             descending into subnotes. The entry point C is
270             a shortcut for specifying C<{ bydepth =E 1 }>.
271              
272             =item B
273              
274             The value should be a code reference. This code reference is used
275             to preprocess the current node $Data::Walk::container. Your
276             preprocessing function is called before the loop that calls the
277             C function. It is called with a list of member nodes
278             and is expected to return such a list. The list will contain
279             all sub-nodes, regardless of the value of the option I!
280             The list is a shallow copy of the data contained in the original
281             structure. You can therefore safely delete items in it, without
282             affecting the original data.
283              
284             The behavior is identical for regular arrays and hashes, so you
285             probably want to coerce the list passed as an argument into a hash
286             then. The variable $Data::Walk::type will contain the string
287             "HASH" if the currently inspected node is a hash.
288              
289             You can use the preprocessing function to sort the items
290             contained or to filter out unwanted items. The order is also preserved
291             for hashes!
292              
293             =item B
294              
295             The value should be a code reference. The code is executed
296             right after an eventual I handler, but only
297             if the current container is a hash. It is skipped for regular
298             arrays.
299              
300             You will usually prefer a I handler over a
301             I handler if you only want to sort hash keys.
302              
303             =item B
304              
305             The value should be a code reference. It is invoked just before
306             leaving the currently visited node. It is called in void context
307             with no arguments. The variable $Data::Walk::container points
308             to the currently visited node.
309              
310             =item B
311              
312             Causes cyclic references to be followed. Normally, the traversal
313             will not descend into nodes that have already been visited. If
314             you set the option I to a truth value, you can change this
315             behavior. Unless you take additional measures, this will always
316             imply an infinite loop!
317              
318             Please note that the &wanted function is also called for nodes
319             that have already been visited! The effect of I is to
320             suppress descending into subnodes.
321              
322             =back
323              
324             All other options are silently ignored.
325              
326             =head1 THE WANTED FUNCTION
327              
328             The &wanted function does whatever verifications you want on each
329             item in the data structure. Note that despite its name, the &wanted
330             function is a generic callback and does B tell Data::Walk(3pm)
331             if an item is "wanted" or not. In fact, its return value is
332             ignored.
333              
334             The wanted function takes no arguments but rather does its work
335             through a collection of variables:
336              
337             =over 4
338              
339             =item B<$_>
340              
341             The currently visited node. Think "file" in terms of File::Find(3pm)!
342              
343             =item B<$Data::Walk::container>
344              
345             The node containing the currently visited node, either a reference to
346             a hash or an array. Think "directory" in terms of File::Find(3pm)!
347              
348             =item B<$Data::Walk::type>
349              
350             The base type of the object that $Data::Walk::container
351             references. This is either "ARRAY" or "HASH" or the empty string for
352             everything else.
353              
354             =item B<$Data::Walk::seen>
355              
356             For references, this will hold the number of times the currently
357             visited node has been visited I. The value is consequently
358             set to 0 not 1 on the first visit. For non-references, the value
359             is undefined.
360              
361             =item B<$Data::Walk::address>
362              
363             For references, this will hold the memory address it points to. It
364             can be used as a unique identifier for the current node. For non-
365             references, the value is undefined.
366              
367             =item B<$Data::Walk::depth>
368              
369             The depth of the current recursion.
370              
371             =item B<$Data::Walk::index>
372              
373             Holds the index of the current item in the container. Note that hashes
374             and arrays are treated the same. Therefore, if the current container is
375             a hash and B<$Data::Walk::index> is even then B<$_> is a hash key. If
376             it is odd, then B<$_> is a hash value.
377              
378             Note that the root container is the array of items to search that you
379             passed to the wanted function!
380              
381             This variable has been added in Data::Walk version 1.01.
382              
383             =back
384              
385             These variables should not be modified.
386              
387             =head1 DIFFERENCES TO FILE::FIND
388              
389             The API of Data::Walk(3pm) tries to mimic the API of File::Find(3pm)
390             to a certain extent. If you are already familiar with File::Find(3pm)
391             you will find it very easy to use Data::Walk(3pm). Even the
392             documentation for Data::Walk(3pm) is in parts similar or identcal
393             to that of File::Find(3pm).
394              
395             =head2 Analogies
396              
397             The equivalent of directories in File::Find(3pm) are the container
398             data types in Data::Walk(3pm). Container data types are arrays
399             (aka lists) and associative arrays (aka hashes). Files are equivalent
400             to scalars. Wherever File::Find(3pm) passes lists of strings to functions,
401             Data::Walk(3pm) passes lists of variables.
402              
403             =head2 Function Names
404              
405             Instead of C and C, Data::Walk(3pm) uses
406             C and C, like the smart reader
407             has already guessed after reading the L.
408              
409             =head2 Variables
410              
411             The variable $Data::Walk::container is vaguely equivalent to
412             $File::Find::dir. All other variables are specific to the
413             corresponding module.
414              
415             =head2 Wanted Function
416              
417             Like its archetype from File::Find(3pm), the wanted function of
418             Data::Walk(3pm) is called with $_ set to the currently inspected
419             item.
420              
421             =head2 Options
422              
423             The option I has the effect that Data::Walk(3pm) also
424             descends into nodes it has already visited. Unless you take
425             extra measures, this will lead to an infinite loop!
426              
427             A number of options are not applicable to data traversion and
428             are ignored by Data::Walk(3pm). Examples are I,
429             I, I, I, I, and
430             I. To give truth the honor, all unrecognized options
431             are skipped.
432              
433             =head1 EXAMPLES
434              
435             Following are some recipies for common tasks.
436              
437             =head2 Recurse To Maximum Depth
438              
439             If you want to stop the recursion at a certain level, do it as follows:
440              
441             my $max_depth = 20;
442             sub not_too_deep {
443             if ($Data::Walk::depth > $max_depth) {
444             return ();
445             } else {
446             return @_;
447             }
448             }
449             sub do_something1 {
450             # Your code goes here.
451             }
452             walk { wanted => \&do_something, preprocess => \¬_too_deep };
453              
454             =head1 BUGS
455              
456             If you think you have spotted a bug, you can share it with others in the
457             bug tracking system at http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Walk.
458              
459             =head1 COPYING
460              
461             Copyright (C) 2005-2016 L,
462             L, all rights reserved.
463              
464             This program is free software; you can redistribute it and/or modify it
465             under the terms of the GNU Library General Public License as published
466             by the Free Software Foundation; either version 2, or (at your option)
467             any later version.
468              
469             This program is distributed in the hope that it will be useful,
470             but WITHOUT ANY WARRANTY; without even the implied warranty of
471             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
472             Library General Public License for more details.
473              
474             You should have received a copy of the GNU Library General Public
475             License along with this program; if not, write to the Free Software
476             Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
477             USA.
478              
479             =head1 SEE ALSO
480              
481             Data::Dumper(3pm), Storable(3pm), File::Find(3pm), perl(1)
482              
483             =cut
484              
485             #Local Variables:
486             #mode: perl
487             #perl-indent-level: 4
488             #perl-continued-statement-offset: 4
489             #perl-continued-brace-offset: 0
490             #perl-brace-offset: -4
491             #perl-brace-imaginary-offset: 0
492             #perl-label-offset: -4
493             #cperl-indent-level: 4
494             #cperl-continued-statement-offset: 2
495             #tab-width: 8
496             #End: