File Coverage

blib/lib/Devel/Walk.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch	15	16	93.7
condition	5	5	100.0
subroutine	5	5	100.0
pod	1	1	100.0
total	58	59	98.3

package Devel::Walk;

use 5.010000;
use strict;
use warnings;

use Scalar::Util qw( refaddr reftype );

require Exporter;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw( walk unstorable ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( walk );

our $VERSION = '0.04';

our $TOP = 1;
our %SEEN;

sub DEBUG () { 0 }

sub walk
{
    my( $obj, $sub, $loc ) = @_;
    # Thank you [e-mail] for pointing out refaddr()
    my $addr = refaddr( $obj );

    $loc ||= '$o';
    return unless $sub->($loc, $obj);

    my $r = reftype $obj;
    return unless $r;
    return if $SEEN{$addr};

    DEBUG and warn "$loc is $r";

    my $was_top = $TOP;
    local $TOP = 0;
    if( 'HASH' eq $r ) {
        local $SEEN{ $addr } = 1;
        $loc .= "->" if $was_top;
        foreach my $key ( keys %$obj ) {
            walk( $obj->{$key}, $sub, $loc."{$key}" );
        }
    }
    elsif( 'ARRAY' eq $r ) {
        local $SEEN{ $addr } = 1;
        $loc .= "->" if $was_top;
        for( my $q=0; $q<=$#$obj; $q++ ) {
            walk( $obj->[$q], $sub, $loc."[$q]" );
        }
    }
    elsif( 'REF' eq $r or 'SCALAR' eq $r ) {
        local $SEEN{ $addr } = 1;
        walk( $$obj, $sub, "\$\${$loc}" );
    }

}


1;

__END__