Data-Rmap-0.64000755001750001750 012434725761 11723 5ustar00bsbbsb000000000000Data-Rmap-0.64/README000444001750001750 2421312434725761 12762 0ustar00bsbbsb000000000000NAME Data::Rmap - recursive map, apply a block to a data structure SYNOPSIS $ perl -MData::Rmap -e 'print rmap { $_ } 1, [2,3], \\4, "\n"' 1234 $ perl -MData::Rmap=:all rmap_all { print (ref($_) || "?") ,"\n" } \@array, \%hash, \*glob; # OUTPUT (Note: a GLOB always has a SCALAR, hence the last two items) # ARRAY # HASH # GLOB # SCALAR # ? # Upper-case your leaves in-place $array = [ "a", "b", "c" ]; $hash = { key => "a value" }; rmap { $_ = uc $_; } $array, $hash; use Data::Dumper; $Data::Dumper::Terse=1; $Data::Dumper::Indent=0; print Dumper($array), " ", Dumper($hash), "\n"; # OUTPUT # ['A','B','C'] {'key' => 'A VALUE'} # Simple array dumper. # Uses $self->recurse method to alter traversal order ($dump) = rmap_to { return "'$_'" unless ref($_); # scalars are quoted and returned my $self = shift; # use $self->recurse to grab results and wrap them return '[ ' . join(', ', $self->recurse() ) . ' ]'; } ARRAY|VALUE, [ 1, [ 2, [ [ 3 ], 4 ] ], 5 ]; print "$dump\n"; # OUTPUT # [ '1', [ '2', [ [ '3' ], '4' ] ], '5' ] DESCRIPTION rmap BLOCK LIST Recursively evaluate a BLOCK over a list of data structures (locally setting $_ to each element) and return the list composed of the results of such evaluations. $_ can be used to modify the elements. Data::Rmap currently traverses HASH, ARRAY, SCALAR and GLOB reference types and ignores others. Depending on which rmap_* wrapper is used, the BLOCK is called for only scalar values, arrays, hashes, references, all elements or a customizable combination. The list of data structures is traversed pre-order in a depth-first fashion. That is, the BLOCK is called for the container reference before is it called for it's elements (although see "recurse" below for post-order). The values of a hash are traversed in the usual "values" order which may affect some applications. If the "cut" subroutine is called in the BLOCK then the traversal stops for that branch, say if you "cut" an array then the code is never called for it's elements (or their sub-elements). To simultaneously return values and cut, simply pass the return list to cut: "cut('add','to','returned');" The first parameter to the BLOCK is an object which maintains the state of the traversal. Methods available on this object are described in "State Object" below. EXPORTS By default: rmap, rmap_all, cut Optionally: rmap_scalar rmap_hash rmap_array rmap_ref rmap_to :types => [ qw(NONE VALUE HASH ARRAY SCALAR REF OBJECT ALL) ], :all => ... # everything Functions The various names are just wrappers which select when to call the code BLOCK. rmap_all always calls it, the others are more selective while rmap_to takes an extra parameter permitting you to provide selection criteria. Furthermore, you can always just rmap_all and skip nodes which are not of interest. rmap_to { ... } $want, @data_structures; Most general first. Recurse the @data_structures and apply the BLOCK to elements selected by $want. The $want parameter is the bitwise "or" of whatever types you choose (imported with :types): VALUE - non-reference scalar, eg. 1 HASH - hash reference ARRAY - array reference SCALAR - scalar refernce, eg. \1 REF - higher-level reference, eg. \\1, \\{} B any reference type, see 's reftype: perl -MScalar::Util=reftype -le 'print map reftype($_), \1, \\1' GLOB - glob reference, eg. \*x (scalar, hash and array recursed) ALL - all of the above NONE - none of the above So to call the block for arrays and scalar values do: use Data::Rmap ':all'; # or qw(:types rmap_to) rmap { ... } ARRAY|VALUE, @data_structures; (ALL & !GLOB) might also be handy. The remainder of the wrappers are given in terms of the $want for rmap_to. rmap { ... } @list; Recurse and call the BLOCK on non-reference scalar values. $want = VALUE rmap_all BLOCK LIST Recurse and call the BLOCK on everything. $want = ALL rmap_scalar { ... } @list Recurse and call the BLOCK on non-collection scalars. $want = VALUE|SCALAR|REF rmap_hash Recurse and call the BLOCK on hash refs. $want = HASH rmap_array Recurse and call the BLOCK on array refs. $want = ARRAY rmap_ref Recurse and call the BLOCK on all references (not GLOBS). $want = HASH|ARRAY|SCALAR|REF Note: rmap_ref isn't the same as rmap_to {} REF cut(@list) Don't traverse sub-elements and return the @list immediately. For example, if $_ is an ARRAY reference, then the array's elements are not traversed. If there's two paths to an element, both will need to be cut. State Object The first parameter to the BLOCK is an object which maintains most of the traversal state (except current node, which is $_). *You will ignore it most of the time*. The "recurse" method may be useful. Other methods should only be used in throw away tools, see TODO Methods: recurse Process child nodes of $_ now and return the result. This makes it easier to perform post-order and in-order processing of a structure. Note that since the same "seen list" is used, the child nodes aren't reprocessed. code The code reference of the BLOCK itself. Possible useful in some situations. seen (Warning: I'm undecided whether this method should be public) Reference to the HASH used to track where we have visited. You may want to modify it in some situations (though I haven't yet). Beware circular references. The (current) convention used for the key is in the source. want (Warning: I'm undecided whether this method should be public) The $want state described in rmap_to. EXAMPLES # command-line play $ perl -MData::Rmap -le 'print join ":", rmap { $_ } 1,2,[3..5],\\6' 1:2:3:4:5:6 # Linearly number questions on a set of pages my $qnum = 1; rmap_hash { $_->{qnum} = $qnum++ if($_->{qn}); } @pages; # Grep recursively, finding ALL objects use Scalar::Util qw(blessed); my @objects = rmap_ref { blessed($_) ? $_ : (); } $data_structure; # Grep recursively, finding public objects (note the cut) use Scalar::Util qw(blessed); my @objects = rmap_ref { blessed($_) ? cut($_) : (); } $data_structure; # Return a modified structure # (result flattening means we must cheat by cloning then modifying) use Storable qw(dclone); use Lingua::EN::Numbers::Easy; $words = [ 1, \2, { key => 3 } ]; $nums = dclone $words; rmap { $_ = $N{$_} || $_ } $nums; # Make an assertion about a structure use Data::Dump; rmap_ref { blessed($_) && $_->isa('Question') && defined($_->name) or die "Question doesn't have a name:", dump($_); } @pages; # Traverse a tree using localize state $tree = [ one => two => [ three_one => three_two => [ three_three_one => ], three_four => ], four => [ [ five_one_one => ], ], ]; @path = ('q'); rmap_to { if(ref $_) { local(@path) = (@path, 1); # ARRAY adds a new level to the path $_[0]->recurse(); # does stuff within local(@path)'s scope } else { print join('.', @path), " = $_ \n"; # show the scalar's path } $path[-1]++; # bump last element (even when it was an aref) } ARRAY|VALUE, $tree; # OUTPUT # q.1 = one # q.2 = two # q.3.1 = three_one # q.3.2 = three_two # q.3.3.1 = three_three_one # q.3.4 = three_four # q.4 = four # q.5.1.1 = five_one_one Troubleshooting Beware comma after block: rmap { print }, 1..3; ^-------- bad news, you get and empty list: rmap(sub { print $_; }), 1..3; If you don't import a function, perl's confusion may produce: $ perl -MData::Rmap -le 'rmap_scalar { print } 1' Can't call method "rmap_scalar" without a package or object reference... $ perl -MData::Rmap -le 'rmap_scalar { $_++ } 1' Can't call method "rmap_scalar" without a package or object reference... If there's two paths to an element, both will need to be cut. If there's two paths to an element, one will be taken randomly when there is an intervening hash. TODO put for @_ iin wrapper to allow parameters in a different wrapper, solve localizing problem. Note that the package/class name of the "State Object" is subject to change. The want and seen accessors may change or become useful dynamic mutators. Store custom localized data about the traversal. Seems too difficult and ugly when compare to doing it at the call site. Should support multiple reentrancy so avoid the symbol table. "rmap_args { } $data_structure, @args" form to pass parameters. Could potentially help localizing needs. (Maybe only recurse last item) Benchmark. Use array based object and/or direct access internally. rmap_objects shortcut for Scalar::Utils::blessed (Let me know of other useful rmap_??? wrappers) Think about permitting different callback for different types. The prototype syntax is a bit too flaky.... Ensure that no memory leaks are possible, leaking the closure. Read http://www.cs.vu.nl/boilerplate/ SEE ALSO map, grep, Storable's dclone, Scalar::Util's reftype and blessed Faint traces of treemap: http://www.perlmonks.org/index.pl?node_id=60829 AUTHOR Brad Bowman Copyright (C) 2004 All rights reserved. Data-Rmap-0.64/META.yml000444001750001750 117212434725761 13332 0ustar00bsbbsb000000000000--- abstract: 'recursive map, apply a block to a data structure' author: - 'Brad Bowman Ermap@bereft.netE' build_requires: {} configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Data-Rmap provides: Data::Rmap: file: lib/Data/Rmap.pm version: 0.64 requires: Scalar::Util: 0 Test::Exception: 0 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/bowman/Data-Rmap version: 0.64 Data-Rmap-0.64/Makefile.PL000444001750001750 57012434725761 14014 0ustar00bsbbsb000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4003 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Data::Rmap', 'VERSION_FROM' => 'lib/Data/Rmap.pm', 'PREREQ_PM' => { 'Scalar::Util' => 0, 'Test::Exception' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Data-Rmap-0.64/INSTALL000444001750001750 22312434725761 13066 0ustar00bsbbsb000000000000INSTALL INSTRUCTIONS FOR Data::Rmap perl Makefile.PL; make; make test; make install; OR perl Build.PL; ./Build; ./Build test; ./Build install; Data-Rmap-0.64/META.json000444001750001750 202712434725761 13502 0ustar00bsbbsb000000000000{ "abstract" : "recursive map, apply a block to a data structure", "author" : [ "Brad Bowman Ermap@bereft.netE" ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Data-Rmap", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "requires" : { "Scalar::Util" : "0", "Test::Exception" : "0" } } }, "provides" : { "Data::Rmap" : { "file" : "lib/Data/Rmap.pm", "version" : "0.64" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/bowman/Data-Rmap" } }, "version" : "0.64" } Data-Rmap-0.64/Build.PL000444001750001750 160212434725761 13353 0ustar00bsbbsb000000000000#!/usr/bin/perl -w use strict; use Module::Build; my $class = Module::Build->subclass( code => q{ sub ACTION_deb { use strict; my $self = shift; $self->dispatch('distdir'); my $distdir = $self->dist_name .'-'. $self->dist_version; my $lc_distdir = lc($distdir); # do_system echos $self->do_system("rm","-rf", $lc_distdir) or die $!; $self->do_system("mv", $distdir, $lc_distdir) or die $!; $self->do_system("cp","-r", "debian", $lc_distdir) or die $!; $self->add_to_cleanup($lc_distdir); $self->do_system("cd $lc_distdir && debuild -us -uc") or die $!; } }, ); $class->new( module_name => 'Data::Rmap', license => 'perl', requires => { 'Scalar::Util' => 0, 'Test::Exception' => 0, }, create_makefile_pl => 'traditional', meta_merge => { resources => { repository => 'https://github.com/bowman/Data-Rmap', }, }, )->create_build_script; Data-Rmap-0.64/test.pl000444001750001750 1314412434725761 13417 0ustar00bsbbsb000000000000#!/usr/bin/perl -w use strict; use Test::More 'no_plan'; # tests =>$n use Test::Exception; use Scalar::Util qw(reftype); BEGIN { use_ok( 'Data::Rmap' ); } use Data::Dumper; $Data::Dumper::Purity=1; our $data = { 'arrays' => [[ 'shared', 'not_shared' ]], 'num' => 2, 'ref' => \do { my $a = 'ref' }, 'hash' => { 'a' => 'vala', 'b' => 'valb', 'c' => { qn=> 'this' }, }, 'ref_to_hash' => \{ qn=> 'that' }, }; # shared value $data->{share_ref} = \$data->{arrays}[0][0]; $data->{another_obj} = \do{ my $o = ${$data->{ref_to_hash}}}; my $orig_dump = Dumper($data); # do nothing slowly rmap { } $data; rmap_all { } $data; # test importing implicitly use Data::Rmap qw(rmap_scalar); rmap_scalar { } $data; use Data::Rmap qw(:types rmap_to); rmap_to { } HASH|ARRAY|SCALAR|REF|VALUE|GLOB, $data; use Data::Rmap qw(:all); rmap_hash { } $data; rmap_array { } $data; # check nothing changed ok(Dumper($data) eq $orig_dump, 'nothing changed'); rmap { $_ = "#$_#"; } $data; # all the leaves ok($data->{num} eq '#2#', "num #2#"); ok($data->{arrays}[0][0] eq '#shared#', "done once #shared#"); ok(${$data->{ref}} eq '#ref#', "${$data->{ref}} eq '#ref#'"); ok($data->{hash}{a} eq '#vala#', "nested hashes done #vala#"); ok(${$data->{ref_to_hash}}->{qn} eq '#that#', "ref_to_hash done #that#"); my $count = 1; rmap_all { cut if ref($_) eq 'ARRAY'; $_ = "=\U$_=" if !ref($_); # leaves $_->{qnum} = $count++ if ref($_) eq 'HASH' && exists $_->{qn}; } $data; #diag(Dumper $data); ok($data->{arrays}[0][1] eq '#not_shared#', 'ARRAY cut'); ok($data->{arrays}[0][0] eq '=#SHARED#=', 'cut one path only'); ok($data->{hash}{a} eq '=#VALA#=', 'HASH not cut'); like(${$data->{ref_to_hash}}->{qnum}, qr/^=\d+=$/, 'qnum added to qn'); # action only done once $data = []; $data->[0] = "string"; $data->[1] = \$data->[0]; $data->[2] = \\do{ my $s = "last" }; rmap { $_ = "!$_" } $data; ok($data->[0] eq '!string', "done once"); ok(${$data->[1]} eq '!string', "access via both paths"); ok(\$data->[0] == \${$data->[1]}, "still same ref"); ok($${$data->[2]} eq '!last', "got '!last'"); # test aliasing with write only: ref => \'ref' my $ro_err = qr/^Modification of a read-only value attempted/; throws_ok { rmap { $_++ } 1 } $ro_err, 'read-only scalar'; throws_ok { rmap { $_++ } \1 } $ro_err, 'read-only scalar ref'; throws_ok { rmap { $_++ } [\1] } $ro_err, 'read-only scalar ref in array'; throws_ok { rmap { $_++ } {1,\1} } $ro_err, 'read-only scalar ref in hash'; *ro = \1; throws_ok { rmap { $_++ } *ro } $ro_err, 'read-only scalar ref in glob'; # test returns is_deeply([ rmap { ++$_ } [1,2] ], [2,3], 'return altered pre-inc'); is_deeply([ rmap { $_++ } [1,2] ], [1,2], 'return not altered post-inc'); is( scalar(rmap { ++$_ } [2..4]), 3, 'scalar context num items'); our $rw = 2; is_deeply([ rmap { ++$_ } [\do{my $a = 1}, \*rw] ], [2,3], 'flattens return'); is_deeply([ rmap { ++$_ } [1,[2]] ], [2,3], 'flattens 2'); # test cut # take first element of each array reference found is_deeply([ rmap_array { cut($_->[0]) } [1,0],[2,0,[0]],[[3],0], {0,\[4]} ], [ 1, 2, [3], 4 ], 'cut limits recursion'); is_deeply([ rmap { cut(++$_) } [1,2] ], [2,3], 'cut return altered pre-inc'); is_deeply([ rmap { ++$_; cut() } [1,2] ], [], 'cut can return nothing'); # test $_[0]->recurse my ($array_dump) = rmap_to { return $_ unless ref($_); '[ ' . join(', ', $_[0]->recurse() ) . ' ]'; } ARRAY|VALUE, [ 1, [ 2, [ [ 3 ], 4 ] ], 5 ]; is($array_dump, '[ 1, [ 2, [ [ 3 ], 4 ] ], 5 ]', 'dumper dumps'); my $tree = [ one => two => [ three_one => three_two => [ three_three_one => ], three_four => ], four => [ [ five_one_one => ], ], ]; my $got = ''; our @path = ('q'); rmap_to { if(ref $_) { local(@path) = (@path, 1); # ARRAY adds a new level to the path $_[0]->recurse(); # does stuff within local(@path)'s scope } else { $got .= join('.', @path) . ' '; } $path[-1]++; # bump last element (even when it was an aref) } ARRAY|VALUE, $tree; is($got, 'q.1 q.2 q.3.1 q.3.2 q.3.3.1 q.3.4 q.4 q.5.1.1 ', 'tree numbering w/ recurse'); # assign each of the THINGs in GLOB x local *x; *x = \3; *x = sub {}; *x = {}; *x = []; # test each name works as expected my @types = (1, [], {}, \\2, \*x, sub {}); #$_ = join(' ', rmap_all { $_ } @types); s/\(.*?\)/\\S+/g; diag($_); like(join(' ', rmap { $_ } @types), qr/^1 2 3$/, 'rmap types' ); is(join(' ', rmap_all { reftype($_) || $_ } @types), '1 ARRAY HASH REF SCALAR 2 GLOB SCALAR 3 ARRAY HASH', 'rmap_all types' ); # stringification of references, eg. ARRAY(0x1e8ce28) =~ /ARRAY\S+/ like(join(' ', rmap_scalar { $_ } @types), qr/^1 (REF|SCALAR)\S+ SCALAR\S+ 2 SCALAR\S+ 3$/, 'rmap_scalar types' ); like(join(' ', rmap_hash { $_ } @types), qr/^HASH\S+ HASH\S+$/, 'rmap_hash types' ); like(join(' ', rmap_array { $_ } @types), qr/^ARRAY\S+ ARRAY\S+$/, 'rmap_array types' ); like(join(' ', rmap_code { $_ } @types), qr/^CODE\S+ CODE\S+$/, 'rmap_array types' ); is(join(' ', rmap_ref { reftype($_) || $_ } @types), 'ARRAY HASH REF SCALAR SCALAR ARRAY HASH', 'rmap_ref types' ); like(join(' ', rmap_to { $_ } GLOB|HASH, @types), qr/^HASH\S+ GLOB\S+ HASH\S+$/, 'rmap_to GLOB|HASH types' ); like(join(' ', rmap_to { $_ } GLOB|CODE, @types), qr/^GLOB\S+ CODE\S+ CODE\S+$/, 'rmap_to GLOB|HASH types' ); Data-Rmap-0.64/Changes000444001750001750 167212434725761 13361 0ustar00bsbbsb000000000000Mon Nov 24 14:01:46 PST 2014 0.64 - Pod fixes from RT#51735 (Sergey Romanov) Link to github in Build.PL (David Steinbrunner) Fri Dec 30 10:52:54 EST 2011 0.63 - Added CODE as another :type, rmap_code to only replace CODE refs (in :all export too) and also recurse into the CODE slot of a glob. Note that CODE is not part of ALL, you need rmap_to with (ALL | CODE). Recursing the CODE slot of GLOB *IS BACKWARDS INCOMPATIBLE* (but rare enough and hard to wrok-around). steven haryanto requested this in RT#73550, thanks Mon Sep 22 21:26:27 EST 2008 0.62 - Clarified LICENSE terms in pod, user request Mon Aug 15 11:19:02 EST 2005 0.61 - Added Test::Exception prereq - Debian packaging support Mon Dec 20 15:53:16 EST 2004 0.6 - Allowed for "REF" in tests for 5.8 - Changed Module::Build usage Tue May 11 17:00:06 EST 2004 0.5 - added README Changes - trim long lines in docs Data-Rmap-0.64/MANIFEST000444001750001750 16612434725761 13174 0ustar00bsbbsb000000000000MANIFEST This list of files Build.PL Makefile.PL lib/Data/Rmap.pm test.pl META.yml Changes README INSTALL META.json Data-Rmap-0.64/lib000755001750001750 012434725761 12471 5ustar00bsbbsb000000000000Data-Rmap-0.64/lib/Data000755001750001750 012434725761 13342 5ustar00bsbbsb000000000000Data-Rmap-0.64/lib/Data/Rmap.pm000444001750001750 3527612434725761 14771 0ustar00bsbbsb000000000000package Data::Rmap; our $VERSION = 0.64; =head1 NAME Data::Rmap - recursive map, apply a block to a data structure =head1 SYNOPSIS $ perl -MData::Rmap -e 'print rmap { $_ } 1, [2,3], \\4, "\n"' 1234 $ perl -MData::Rmap=:all rmap_all { print (ref($_) || "?") ,"\n" } \@array, \%hash, \*glob; # OUTPUT (Note: a GLOB always has a SCALAR, hence the last two items) # ARRAY # HASH # GLOB # SCALAR # ? # Upper-case your leaves in-place $array = [ "a", "b", "c" ]; $hash = { key => "a value" }; rmap { $_ = uc $_; } $array, $hash; use Data::Dumper; $Data::Dumper::Terse=1; $Data::Dumper::Indent=0; print Dumper($array), " ", Dumper($hash), "\n"; # OUTPUT # ['A','B','C'] {'key' => 'A VALUE'} # Simple array dumper. # Uses $self->recurse method to alter traversal order ($dump) = rmap_to { return "'$_'" unless ref($_); # scalars are quoted and returned my $self = shift; # use $self->recurse to grab results and wrap them return '[ ' . join(', ', $self->recurse() ) . ' ]'; } ARRAY|VALUE, [ 1, [ 2, [ [ 3 ], 4 ] ], 5 ]; print "$dump\n"; # OUTPUT # [ '1', [ '2', [ [ '3' ], '4' ] ], '5' ] =head1 DESCRIPTION rmap BLOCK LIST Recursively evaluate a BLOCK over a list of data structures (locally setting $_ to each element) and return the list composed of the results of such evaluations. $_ can be used to modify the elements. Data::Rmap currently traverses HASH, ARRAY, SCALAR and GLOB reference types and ignores others. Depending on which rmap_* wrapper is used, the BLOCK is called for only scalar values, arrays, hashes, references, all elements or a customizable combination. The list of data structures is traversed pre-order in a depth-first fashion. That is, the BLOCK is called for the container reference before is it called for it's elements (although see "recurse" below for post-order). The values of a hash are traversed in the usual "values" order which may affect some applications. If the "cut" subroutine is called in the BLOCK then the traversal stops for that branch, say if you "cut" an array then the code is never called for it's elements (or their sub-elements). To simultaneously return values and cut, simply pass the return list to cut: C The first parameter to the BLOCK is an object which maintains the state of the traversal. Methods available on this object are described in L below. =head1 EXPORTS By default: rmap, rmap_all, cut Optionally: rmap_scalar rmap_hash rmap_array rmap_code rmap_ref rmap_to :types => [ qw(NONE VALUE HASH ARRAY SCALAR REF CODE ALL) ], :all => ... # everything =head1 Functions The various names are just wrappers which select when to call the code BLOCK. rmap_all always calls it, the others are more selective while rmap_to takes an extra parameter permitting you to provide selection criteria. Furthermore, you can always just rmap_all and skip nodes which are not of interest. =over 4 =item rmap_to { ... } $want, @data_structures; Most general first. Recurse the @data_structures and apply the BLOCK to elements selected by $want. The $want parameter is the bitwise "or" of whatever types you choose (imported with :types): VALUE - non-reference scalar, eg. 1 HASH - hash reference ARRAY - array reference SCALAR - scalar refernce, eg. \1 REF - higher-level reference, eg. \\1, \\{} B any reference type, see 's reftype: perl -MScalar::Util=reftype -le 'print map reftype($_), \1, \\1' GLOB - glob reference, eg. \*x (scalar, hash and array recursed, code too as of 0.63) ALL - all of the above (not CODE) CODE - code references (as of 0.63) NONE - none of the above So to call the block for arrays and scalar values do: use Data::Rmap ':all'; # or qw(:types rmap_to) rmap { ... } ARRAY|VALUE, @data_structures; (ALL | CODE) and (ALL & !GLOB) might also be handy. The remainder of the wrappers are given in terms of the $want for rmap_to. =item rmap { ... } @list; Recurse and call the BLOCK on non-reference scalar values. $want = VALUE =item rmap_all BLOCK LIST Recurse and call the BLOCK on everything. $want = ALL =item rmap_scalar { ... } @list Recurse and call the BLOCK on non-collection scalars. $want = VALUE|SCALAR|REF =item rmap_hash Recurse and call the BLOCK on hash refs. $want = HASH =item rmap_array Recurse and call the BLOCK on array refs. $want = ARRAY =item rmap_code Recurse and call the BLOCK on code refs. $want = CODE =item rmap_ref Recurse and call the BLOCK on all "normal" references: $want = HASH|ARRAY|SCALAR|REF Note: rmap_ref isn't the same as rmap_to {} REF =item cut(@list) Don't traverse sub-elements and return the @list immediately. For example, if $_ is an ARRAY reference, then the array's elements are not traversed. If there's two paths to an element, both will need to be cut. =back =head1 State Object The first parameter to the BLOCK is an object which maintains most of the traversal state (except current node, which is $_). I. The "recurse" method may be useful. Other methods should only be used in throw away tools, see L Methods: =over 4 =item recurse Process child nodes of $_ now and return the result. This makes it easier to perform post-order and in-order processing of a structure. Note that since the same "seen list" is used, the child nodes aren't reprocessed. =item code The code reference of the BLOCK itself. Possible useful in some situations. =item seen Reference to the HASH used to track where we have visited. You may want to modify it in some situations (though I haven't yet). Beware circular references. The (current) convention used for the key is in the source. =item want The $want state described in L. =back =head1 EXAMPLES # command-line play $ perl -MData::Rmap -le 'print join ":", rmap { $_ } 1,2,[3..5],\\6' 1:2:3:4:5:6 # Linearly number questions on a set of pages my $qnum = 1; rmap_hash { $_->{qnum} = $qnum++ if($_->{qn}); } @pages; # Grep recursively, finding ALL objects use Scalar::Util qw(blessed); my @objects = rmap_ref { blessed($_) ? $_ : (); } $data_structure; # Grep recursively, finding public objects (note the cut) use Scalar::Util qw(blessed); my @objects = rmap_ref { blessed($_) ? cut($_) : (); } $data_structure; # Return a modified structure # (result flattening means we must cheat by cloning then modifying) use Storable qw(dclone); use Lingua::EN::Numbers::Easy; $words = [ 1, \2, { key => 3 } ]; $nums = dclone $words; rmap { $_ = $N{$_} || $_ } $nums; # Make an assertion about a structure use Data::Dump; rmap_ref { blessed($_) && $_->isa('Question') && defined($_->name) or die "Question doesn't have a name:", dump($_); } @pages; # Traverse a tree using localize state $tree = [ one => two => [ three_one => three_two => [ three_three_one => ], three_four => ], four => [ [ five_one_one => ], ], ]; @path = ('q'); rmap_to { if(ref $_) { local(@path) = (@path, 1); # ARRAY adds a new level to the path $_[0]->recurse(); # does stuff within local(@path)'s scope } else { print join('.', @path), " = $_ \n"; # show the scalar's path } $path[-1]++; # bump last element (even when it was an aref) } ARRAY|VALUE, $tree; # OUTPUT # q.1 = one # q.2 = two # q.3.1 = three_one # q.3.2 = three_two # q.3.3.1 = three_three_one # q.3.4 = three_four # q.4 = four # q.5.1.1 = five_one_one # replace CODE with "" $ perl -MData::Rmap=:all -E 'say join ":", rmap_code { "" } sub{},sub{}' : # look inside code refs with PadWalker $ perl -MData::Rmap=:all -MSub::Identify=:all -MPadWalker=:all -MSub::Name use 5.10.0; my $s = sub {}; sub A::a { $s }; say join ", ", rmap_code { sub_fullname($_), # name string map { $_[0]->recurse } closed_over($_) # then recurse the sub innards } \*A::a, subname b => sub { $s }; # A::a, main::__ANON__, main::b =head1 Troubleshooting Beware comma after block: rmap { print }, 1..3; ^-------- bad news, you get an empty list: rmap(sub { print $_; }), 1..3; If you don't import a function, perl's confusion may produce: $ perl -MData::Rmap -le 'rmap_scalar { print } 1' Can't call method "rmap_scalar" without a package or object reference... $ perl -MData::Rmap -le 'rmap_scalar { $_++ } 1' Can't call method "rmap_scalar" without a package or object reference... If there's two paths to an element, both will need to be cut. If there's two paths to an element, one will be taken randomly when there is an intervening hash. Autovivification can lead to "Deep recursion" warnings if you test C<< exists $_->{this}{that} >> instead of C<< exists $_->{this} && exists $_->{this}{that} >> as you may follow a long chain of "this"s Alternatively use the "no autovivification" pragma to avoid this problem. =head1 TODO put for @_ in wrapper to allow parameters in a different wrapper, solve localizing problem. Store custom localized data about the traversal. Seems too difficult and ugly when compare to doing it at the call site. Should support multiple reentrancy so avoid the symbol table. C form to pass parameters. Could potentially help localizing needs. (Maybe only recurse last item) Benchmark. Use array based object and/or direct access internally. Think about permitting different callback for different types. The prototype syntax is a bit too flaky.... Ensure that no memory leaks are possible, leaking the closure. =head1 SEE ALSO map, grep, L's dclone, L's reftype and blessed Faint traces of treemap: http://www.perlmonks.org/index.pl?node_id=60829 Update: various alternatives have appear over the years, L has a list. =head1 AUTHOR Brad Bowman Ermap@bereft.netE =head1 LICENCE AND COPYRIGHT Copyright (c) 2004- Brad Bowman (Ermap@bereft.netE). All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L and L. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut # Early design discussion: # http://www.perlmonks.org/index.pl?node_id=295642 # wantarray # http://www.class-dbi.com/cgi-bin/wiki/index.cgi?AtomicUpdates use warnings; use strict; use Carp qw(croak); use Scalar::Util qw(blessed refaddr reftype); require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(rmap rmap_all cut); our %EXPORT_TAGS = ( types => [ qw(NONE VALUE HASH ARRAY SCALAR REF GLOB CODE ALL) ], ); our @EXPORT_OK = ( qw(rmap_scalar rmap_hash rmap_array rmap_code rmap_ref rmap_to), @{ $EXPORT_TAGS{types} } ); $EXPORT_TAGS{all} = [ @EXPORT, @EXPORT_OK ]; # Uses stringifying instead of S::U::ref* b/c it's under control my $cut = \do { my $thing }; # my = out of symbol table sub cut { die $cut = [@_]; # cut can return } sub NONE() { 0 } sub VALUE() { 1 } sub HASH() { 2 } sub ARRAY() { 4 } sub SCALAR() { 8 } sub REF() { 16 } sub GLOB() { 32 } sub CODE() { 64 } sub ALL() { VALUE|HASH|ARRAY|SCALAR|REF|GLOB } # Others like CODE, Regex, etc are ignored my %type_bits = ( HASH => HASH, ARRAY => ARRAY, SCALAR => SCALAR, REF => REF, GLOB => GLOB, CODE => CODE, # reftype actually returns undef for: VALUE => VALUE, ); sub new { bless { code => $_[1], want => $_[2], seen => $_[3] }, $_[0]; } sub code { $_[0]->{code} } sub want { $_[0]->{want} } sub seen { $_[0]->{seen} } sub call { $_[0]->{code}->($_[0]) } sub recurse { # needs to deref $_ and *then* run the code, enter _recurse directly $_[0]->_recurse(); # cut not needed as seen remembers } sub rmap (&@) { __PACKAGE__->new(shift, VALUE, {})->_rmap(@_); } sub rmap_all (&@) { __PACKAGE__->new(shift, ALL, {})->_rmap(@_); } sub rmap_scalar (&@) { __PACKAGE__->new(shift, VALUE|SCALAR|REF, {})->_rmap(@_); } sub rmap_hash (&@) { __PACKAGE__->new(shift, HASH, {})->_rmap(@_); } sub rmap_array (&@) { __PACKAGE__->new(shift, ARRAY, {})->_rmap(@_); } sub rmap_code (&@) { __PACKAGE__->new(shift, CODE, {})->_rmap(@_); } sub rmap_ref (&@) { __PACKAGE__->new(shift, HASH|ARRAY|SCALAR|REF, {})->_rmap(@_); } sub rmap_to (&@) { __PACKAGE__->new(shift, shift, {})->_rmap(@_); } sub _rmap { my $self = shift; my @return; for (@_) { # just one after the wrapper call my ($key, $type); if($type = reftype($_)) { $key = refaddr $_; $type = $type_bits{$type} or next; } else { $key = "V:".refaddr(\$_); # prefix to distinguish from \$_ $type = VALUE; } next if ( exists $self->seen->{$key} ); $self->seen->{$key} = undef; # Call the $code if($self->want & $type) { my $e; # local($@) and rethrow caused problems my @got; { local ($@); # don't trample, cut impl. should be transparent # call in array context. pass block for reentrancy @got = eval { $self->call() }; $e = $@; } if($e) { if(ref($e) && $e == $cut) { push @return, @$cut; # cut can add to return list next; # they're cutting, don't recurse } else { die $e; } } push @return, @got; } push @return, $self->_recurse(); # process $_ node } return @return; } sub _recurse { my $self = shift; my $type = $type_bits{reftype($_) || 'VALUE'} or return; my @return; # Recurse appropriately, keeping $_ alias if ($type & HASH) { push @return, $self->_rmap($_) for values %$_; } elsif ($type & ARRAY) { # Does this change cut behaviour? No, cut is one scalar ref #push @return, _rmap($code, $want, $seen, $_) for @$_; push @return, $self->_rmap(@$_); } elsif ($type & (SCALAR|REF) ) { push @return, $self->_rmap($$_); } elsif ($type & GLOB) { # SCALAR is always there, undef may be unused or set to undef push @return, $self->_rmap(*$_{SCALAR}); defined *$_{ARRAY} and push @return, $self->_rmap(*$_{ARRAY}); defined *$_{HASH} and push @return, $self->_rmap(*$_{HASH}); defined *$_{CODE} and push @return, $self->_rmap(*$_{CODE}); # Is it always: *f{GLOB} == \*f ? # Also PACKAGE NAME GLOB } return @return; } 1;