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__
# Cheap pod2pm (convert POD to PerlMonk's HTMLish)
my $p= 0;
my $c= 0;
while( <> ) {
s/\r$//;
if( /^$/ ) {
$p= 1;
next;
}
if( $p ) {
if( /^ / ) {
$p= 0;
if( $c ) {
print $/;
} else {
print "\n";
$c= 1;
}
} elsif( /^\S/ and $c || !/^=/ ) {
$p= 0;
if( $c ) {
print "\n";
$c= 0;
} else {
print "\n";
}
}
}
if( !$c ) {
s#^=head(\d+)\s+(.*)# my $h= $1+2; "$2"#e;
s#^=over.*#
#;
s#^=item\s+(.*)#- $1#;
s#^=back.*#
#;
s/\[/[/g;
s/\]/]/g;
s#C<([^<>]+)>#$1#g;
s#C<< (.+?) >>#$1#g;
s#L]+)>#$1#g;
}
print;
}
__END__
=head1 NAME
Data::Diver - Simple, ad-hoc access to elements of deeply nested structures
=head1 SUMMARY
Data::Diver provides the Dive() and DiveVal() functions for ad-hoc
access to elements of deeply nested data structures, and the
DiveRef(), DiveError(), DiveClear(), and DiveDie() support functions.
=head1 SYNOPSIS
use Data::Diver qw( Dive DiveRef DiveError );
my $root= {
top => [
{ first => 1 },
{ second => {
key => [
0, 1, 2, {
three => {
exists => 'yes',
},
},
],
},
},
],
};
# Sets $value to 'yes'
# ( $root->{top}[1]{second}{key}[3]{three}{exists} ):
my $value= Dive( $root, qw( top 1 second key 3 three exists ) );
# Sets $value to undef() because "missing" doesn't exist:
$value= Dive( $root, qw( top 1 second key 3 three missing ) );
# Sets $value to undef() because
# $root->{top}[1]{second}{key}[4] is off the end of the array:
$value= Dive( $root, qw( top 1 second key 4 ... ) );
# Sets $value to undef() because
# $root->{top}[1]{second}{key}[-5] would be a fatal error:
$value= Dive( $root, qw( top 1 second key -5 ... ) );
# Sets $ref to \$root->{top}[9]{new}{sub} (which grows
# @{ $root->{top} } and autovifies two anonymous hashes):
my $ref= DiveRef( $root, qw( top 9 new sub ) );
# die()s because "other" isn't a valid number:
$ref= DiveRef( $root, qw( top other ... ) );
# Does: $root->{num}{1}{2}= 3;
# (Autovivifies hashes despite the numeric keys.)
DiveVal( $root, \( qw( num 1 2 ) ) ) = 3;
# Same thing:
${ DiveRef( $root, 'num', \1, \2 ) } = 3;
# Retrieves above value, $value= 3:
$value= DiveVal( $root, 'num', \1, \2 );
# Same thing:
$value= ${ DiveRef( $root, \( qw( num 1 2 ) ) ) };
# Tries to do $root->{top}{1} and dies
# because $root->{top} is an array reference:
DiveRef( $root, 'top', \1 );
# To only autovivify at the last step:
$ref= DiveRef(
Dive( $root, qw( top 1 second key 3 three ) ),
'missing' );
if( $ref ) {
$$ref= 'me too'
} else {
my( $nestedRef, $svKey, $errDesc )= DiveError();
die "Couldn't dereference $nestedRef via $$svKey: $errDesc\n";
}
=head1 DESCRIPTION
Note that Data::Diver does C