File Coverage

blib/lib/Sub/Data/Recursive.pm

Criterion	Covered	Total	%
statement	30	36	83.3
branch	9	14	64.2
condition	0	3	0.0
subroutine	5	5	100.0
pod	1	1	100.0
total	45	59	76.2

package Sub::Data::Recursive;
use strict;
use warnings FATAL => 'all';

our $VERSION = '0.01';

use Scalar::Util qw/refaddr/;

sub invoke {
    my ($class, $code, @args) = @_;
    _apply($code, +{}, @args);
}

sub _apply {
    my $code = shift;
    my $seen = shift;

    my @retval;
    for my $arg (@_) {
        if(my $ref = ref $arg){
            my $refaddr = refaddr($arg);
            my $proto;

            if(defined($proto = $seen->{$refaddr})){
                 # noop
            }
            elsif($ref eq 'ARRAY'){
                $proto = $seen->{$refaddr} = [];
                @{$proto} = _apply($code, $seen, @{$arg});
            }
            elsif($ref eq 'HASH'){
                $proto = $seen->{$refaddr} = {};
                %{$proto} = _apply($code, $seen, %{$arg});
            }
            elsif($ref eq 'REF' or $ref eq 'SCALAR'){
                $proto = $seen->{$refaddr} = \do{ my $scalar };
                ${$proto} = _apply($code, $seen, ${$arg});
            }
            else{ # CODE, GLOB, IO, LVALUE etc.
                $proto = $seen->{$refaddr} = $arg;
            }

            push @retval, $proto;
        }
        else{
            push @retval, defined($arg) ? $code->($arg) : $arg;
        }
    }

    return wantarray ? @retval : $retval[0];
}

1;

__END__