File Coverage

blib/lib/Data/Walk/More.pm

Criterion	Covered	Total	%
statement	63	75	84.0
branch	16	26	61.5
condition	5	10	50.0
subroutine	8	9	88.8
pod	2	2	100.0
total	94	122	77.0

## no critic: Modules::ProhibitAutomaticExportation

package Data::Walk::More;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-04-15'; # DATE
our $DIST = 'Data-Walk-More'; # DIST
our $VERSION = '0.001'; # VERSION

use 5.010001;
use strict;
use warnings;
use Log::ger;

use Scalar::Util qw(blessed reftype refaddr);

use Exporter qw(import);
our @EXPORT = qw(walk walkdepth);

our %_seen_refaddrs;

our $depth;
our @containers;
our $container;
our @indexes;
our $index;
our $prune;

sub _walk {
    my ($opts, $val) = @_;

    my $ref = ref $val;
    if ($ref eq '') {
        local $_ = $val; $opts->{wanted}->();
        return;
    }

    my $refaddr = refaddr($val);
    if ($_seen_refaddrs{$refaddr}++) {
        return unless $opts->{follow};
    }

    my $class;
    if (blessed $val) {
        $class = $ref;
        $ref = reftype($val);
    }

  RECURSE_ARRAY_HASH: {
        last unless $ref eq 'ARRAY' || $ref eq 'HASH';
        last if !$opts->{recurseobjects} && defined $class;

        unless ($opts->{bydepth}) {
            local $_ = $val; $opts->{wanted}->();
        }

        if ($prune) {
            $prune = 0;
            return;
        }

        {
            local $depth = $depth + 1;
            local @containers = (@containers, $val);
            local $container = $containers[-1];
            local @indexes = (@indexes, undef);
            local $index;
            if ($ref eq 'ARRAY') {
                for my $i (0..$#{$val}) {
                    $indexes[-1] = $i;
                    $index       = $i;
                    _walk($opts, $val->[$i]);
                }
            } else { # HASH
                for my $k ($opts->{sortkeys} ? (sort keys %$val) : (keys %$val)) {
                    $indexes[-1] = $k;
                    $index       = $k;
                    _walk($opts, $val->{$k});
                }
            }
        }

        if ($opts->{bydepth}) {
            local $_ = $val; $opts->{wanted}->();
        }

        return;
    } # RECURSE_ARRAY_HASH

    local $_ = $val; $opts->{wanted}->();
    return;
}

sub walk {
    my $opts = ref($_[0]) eq 'HASH' ? { %{shift()} } : { wanted=>shift() };
    $opts->{recurseobjects} //= 1;
    $opts->{sortkeys} //= 1;

    local %_seen_refaddrs;
    for my $data (@_) {
        local $depth = 0;
        local $prune = 0;
        _walk($opts, $data);
    }
}

sub walkdepth {
    my $opts = ref($_[0]) eq 'HASH' ? { %{shift()} } : { wanted=>shift() };
    $opts->{bydepth} = 1;
    walk($opts, @_);
}

1;
# ABSTRACT: Traverse Perl data structures, with more information during traversing

__END__