File Coverage

blib/lib/Data/Diver.pm

Criterion	Covered	Total	%
statement	62	68	91.1
branch	36	42	85.7
condition	23	33	69.7
subroutine	10	10	100.0
pod	6	6	100.0
total	137	159	86.1

package Data::Diver;
use strict;

require Exporter;
use vars qw( $VERSION @EXPORT_OK );
BEGIN {
    $VERSION= 1.01_01;
    @EXPORT_OK= qw( Dive DiveRef DiveVal DiveError DiveDie DiveClear );
    *import= \&Exporter::import;
    *isa= \&UNIVERSAL::isa;
}


# To figure out if an item supports being treated as a particular
# type of reference (hash ref, array ref, or scalar ref) we use:
#   eval { my $x= DEREF_EXPR; 1 }
# Note that we are careful to not put 'DEREF_EXPR' into an "lvalue
# context" (to prevent autovivification) and to also avoid trying to
# convert the value into a number or boolean or such.  The "; 1" is
# so that the eval always returns a true value unless something die()s.

# Using  'ARRAY' eq ref($ref)  is just a horrid alternative, as it would
# prevent these routines from being used on blessed data structures.

# Using  UNIVERSAL::isa($ref,'ARRAY')  is a better alternative, but it
# still fails for more advanced cases of overloading or pathological
# cases of blessing into very-poorly-named packages.  We use this for
# testing for CODE references, since  eval { $ref->() }  would actually
# run the code.


my @lastError;


sub _Error
{
    @lastError= @_[2,0,1];
    return;
}


sub DiveError
{
    return @lastError;
}


sub DiveClear
{
    @lastError= ();
}


sub DiveDie
{
    @_= Dive( @_ )   if  1 < @_;
    return  wantarray ? @_ : pop @_
        if  @_  ||  ! @lastError;
    my( $errDesc, $ref, $svKey )= @lastError;
    die "$errDesc using $$svKey on $ref (from Data::Diver).\n";
}


sub Dive
{
    return   if  ! @_;
    my $ref= shift @_;
    return $ref   if  ! $ref;
    while(  @_  ) {
        my $key= shift @_;
        if(  ! defined $key  ) {
            return  _Error( $ref, \$key, "undef() on non-scalar-ref" )
                if  ! eval { my $x= $$ref; 1 };
            $ref= $$ref;
        } elsif(    eval { my $x= $key->[0]; 1 }
                &&  isa( $ref, 'CODE' )
        ) {
            if(  @_  &&  ! defined $_[0]  ) {
                $ref= \ $ref->( @$key );
            } else {
                $ref= [ $ref->( @$key ) ];
            }
        } elsif(    $key =~ /^-?\d+$/
                &&  eval { my $x= $ref->[0]; 1 }
        ) {
            return  _Error( $ref, \$key, "Index out of range" )
                if  $key < -@$ref
                ||  $#$ref < $key;
            $ref= $ref->[$key];
        } elsif(  eval { exists $ref->{$key} }  ) {
            if(  eval { my $x= $$key; 1 }  ) {
                $ref= $ref->{$$key};
            } else {
                $ref= $ref->{$key};
            }
        } elsif(  eval { my $x= $ref->{$key}; 1 }  ) {
            return  _Error( $ref, \$key, "Key not present in hash" );
        } else {
            return  _Error( $ref, \$key, "Not a valid type of reference" );
        }
    }
    return $ref;
}


sub DiveVal :lvalue
{
    ${ DiveRef( @_ ) };
}


sub DiveRef
{
    return   if  ! @_;
    my $sv= \shift @_;
    return $$sv   if  ! $$sv;
    while(  @_  ) {
        my $key= shift @_;
        if(  ! defined $key  ) {
            $sv= \$$$sv;
        } elsif(    eval { my $x= $key->[0]; 1 }
                &&  isa( $$sv, 'CODE' )
        ) {
            if(  @_  &&  ! defined $_[0]  ) {
                $sv= \ $$sv->( @$key );
            } else {
                $sv= \[ $$sv->( @$key ) ];
            }
        } elsif(    eval { my $x= $$key; 1 }
                and     ! defined($$sv)
                    ||  eval { my $x= $$sv->{0}; 1 }
        ) {
            $sv= \$$sv->{$$key};
        } elsif(    $key =~ /^-?\d+$/
                and     ! defined($$sv)
                    ||  eval { my $x= $$sv->[0]; 1 }
        ) {
            $sv= \$$sv->[$key];
        } else {
            $sv= \$$sv->{$key};
        }
    }
    return $sv;
}


'Data::Diver';

__END__