Data::Traverse - Callback-based depth-first traversal of Perl data structures


Data-Traverse documentation Contained in the Data-Traverse distribution.

Index


Code Index:

NAME

Top

Data::Traverse - Callback-based depth-first traversal of Perl data structures

VERSION

Top

0.03

SYNOPSIS

Top

  use Data::Traverse qw(traverse);

  my $struct = [ 1, 2, { foo => 42 }, [ 3, 4, [ 5, 6, { bar => 43 } ] ], 7, 8 ];
  traverse { print "$a\n" if /ARRAY/; print "$a => $b\n" if /HASH/ } $struct;

DESCRIPTION

Top

Data::Traverse exports a single function, traverse, which takes a BLOCK and a reference to a data structure containing arrays or hashes. Objects are treated as normal references (e.g. a blessed hash will be traversed the same way as an unblessed one.) Only arrays and hashes are traversed; if an unsupported reference type is found (such as a glob or regex), Data::Traverse will croak with an error. Alternatively, you can make Data::Traverse ignore unsupported reference types by doing:

  use Data::Traverse qw(traverse);
  Data::Traverse->ignore_unsupported_refs( 1 );




Data::Traverse performs a depth-first traversal of the structure and calls the code in the BLOCK for each scalar it finds. $_ is set to the type of the container ('ARRAY' or 'HASH'). For arrays, the magic variable $a contains the data. For hashes, the magic variables $a and $b contain the key and the value, respectively.

EXPORT

&traverse.

None by default.

AUTHOR

Top

Mike Friedman, <friedo at friedo dot com>

COPYRIGHT AND LICENSE

Top


Data-Traverse documentation Contained in the Data-Traverse distribution.

package Data::Traverse;

use strict;
use warnings;

use Exporter;
use Carp qw(croak);
use Scalar::Util qw(reftype);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
our @EXPORT_OK = ('&traverse');


our $VERSION = '0.03';

my $IGNORE_BAD_REFS = 0;

sub ignore_unsupported_refs {
    my $class = shift;
    $IGNORE_BAD_REFS = shift;
} 

# Preloaded methods go here.

# Use this sub to do the prototype only. The real fun
# happens in real_traverse.
sub traverse(&$) { 
    my ( $callback, $ref ) = @_;
    my $type = reftype $ref or 
	croak "Second argument to traverse must be a reference";

    real_traverse( $callback, $ref, $type, caller );
}


sub real_traverse { 
    my ( $callback, $ref, $type, $caller ) = @_;

    no strict 'refs';
    local(*{$caller."::a"}) = \my $a;
    local(*{$caller."::b"}) = \my $b;
    use strict 'refs';

    if ( $type eq 'ARRAY' ) { 
	foreach my $item( @$ref ) {
	    $_ = $type;
	    my $st = reftype( $item );
	    if( $st ) { 
		real_traverse( $callback, $item, $st, $caller );
	    } else { 
		$a = $item;
		$callback->();
	    }
	}
    } elsif ( $type eq 'HASH' ) { 
	while( my ( $key, $val ) = each %$ref ) { 
	    $_ = $type;
	    my $st = reftype( $val );
	    if( $st ) { 
		real_traverse( $callback, $val, $st, $caller );
	    } else { 
		$a = $key;
		$b = $val;
		$callback->();
	    }
	}
    } else { 
	croak "Encountered unsupported type $type in traverse"
          unless $IGNORE_BAD_REFS;
    }
}


1;
__END__