File Coverage

blib/lib/Data/Visitor/Tiny.pm

Criterion	Covered	Total	%
statement	33	33	100.0
branch	9	10	90.0
condition	5	6	83.3
subroutine	7	7	100.0
pod	1	1	100.0
total	55	57	96.4

use v5.10;
use strict;
use warnings;

package Data::Visitor::Tiny;
# ABSTRACT: Recursively walk data structures

our $VERSION = '0.001';

use Carp qw/croak/;
use Exporter 5.57 qw/import/;

our @EXPORT = qw/visit/;

#pod =func visit
#pod
#pod     visit( $ref, sub { ... } );
#pod
#pod The C function takes a hashref or arrayref and recursively visits
#pod all values via pre-order traversal, calling the provided callback for each
#pod value.  Only hashrefs and arrayrefs are traversed; objects, even if they
#pod override hash or array dereference, are only ever treated as values.  Hash
#pod keys are sorted lexicographically before iteration, ensuring consistent
#pod visitation order in the face of Perl's hash order randomization.
#pod
#pod Within the callback, the C<$_> variable is set to the value of the node.
#pod The callback also receives three arguments: C<$key>, C<$valueref>, and
#pod C<$context>.  The C<$key> is the hash key or array index of the value.  The
#pod C<$valueref> is a scalar reference to the value; use it to modify the value
#pod in place.  The C<$context> is a hashref for tracking state throughout the
#pod visiting process.  Context keys beginning with '_' are reserved for
#pod C; you may store whatever other keys/values you need.
#pod The only key provided currently is C<_depth>, which starts at 0 and
#pod reflects how deep the visitor has recursed.
#pod
#pod The C function returns the context object.
#pod
#pod =cut

sub visit {
    my ( $ref, $fcn ) = @_;
    my $ctx = { _depth => 0 };
    _visit( $ref, $fcn, $ctx );
    return $ctx;
}

sub _visit {
    my ( $ref, $fcn, $ctx ) = @_;
    my $type = ref($ref);
    croak("'$ref' is not an ARRAY or HASH")
      unless $type eq 'ARRAY' || $type eq 'HASH';
    my @elems = $type eq 'ARRAY' ? ( 0 .. $#$ref ) : ( sort keys %$ref );
    for my $idx (@elems) {
        my ( $v, $vr );
        $v  = $type eq 'ARRAY' ? $ref->[$idx]      : $ref->{$idx};
        $vr = $type eq 'ARRAY' ? \( $ref->[$idx] ) : \( $ref->{$idx} );
        local $_ = $v;
        # Wrap $fcn in dummy for loop to guard against bare 'next' in $fcn
        for my $dummy (0) { $fcn->( $idx, $vr, $ctx ) }
        if ( ref($v) eq 'ARRAY' || ref($v) eq 'HASH' ) {
            $ctx->{_depth}++;
            _visit( $v, $fcn, $ctx );
            $ctx->{_depth}--;
        }
    }
}

1;


# vim: ts=4 sts=4 sw=4 et tw=75:

__END__