The sub deep_defined described in the link above works well, but in order to make it a little more flexible in the way that it is used, I have added wrapper sub for it that accepts the list of keys as a string instead. Therefore it can be cut and pasted directly from the line where the key-combination was first autovivified, without typos or text transformations.
The following three subroutines work in conjunction to support the new sub deep_defined, or they may stand alone. The original "deep_defined" was renamed to "deep_defined_action" and now returns the defined value instead of just a boolean, because I think that's more useful. My implementation puts "deep_defined" in @EXPORT, and "deep_defined_action" in @EXPORT_OK in the package definition, but I leave the actual package implementation up to the user here... Some POD also accompanies these functions to describe basically how they should be used...
=pod
=head1 ===============================================================
+=============
=head1 MULTIDEMENSIONAL HASH-ARRAY FUNCTIONS
=head1 ---------------------------------------------------------------
+-------
=head2 deep_defined ( <\%hash or $hash_ref>, <@key_list or $key_string
+> )
OBJECTIVE: Return the value defined for a $mixedHashArray{$key}[$combi
+nation]{$set}, without
invoking autovivification. (with more flexability than deep_define
+d_action.)
PREMIS: Prevent "$mixedHashArray{key}[combination]" from being inst
+antiated when effectively
testing if "$mixedHashArray{key}[combination]{set}" is defined or
+while getting it's value.
This function is flexible enough to accept args in a list format,
+or a format that is
more condusive to copying the keys directly from the instantiation
+...
EX:
Instantiation: (w/ autovivification)
$hash{key}{combination}{set} = "some_value";
Test:
if ($value = &deep_defined(\%hash, qq( {key}{combination}{set}
+ ) ) ){
print "$value"; #prints "some_value"...
}
But Notice that if you test an undefined key combination set, no a
+utovivification occurs.
EX:
Test:
if ($value = &deep_defined(\%hash, qq( {undefined}{key}{combin
+ation}{set} ) ) ){
### test fails; no autovivification
}
You can also specify the key combination set as a list if you find
+ that more practical:
EX:
Test:
if ($value = &deep_defined(\%hash, "key", "combination", "set"
+)){
...
}
It also handles $hash_refs instead and arrays and mixed hash-array
+ combinations...
EX:
Instantiation: (w/ autovivification)
$hash{key}{combination}{set}[2]{and_key_for_hash_in_second_lis
+t_position} = "some_value";
$hash_ref = /%hash;
Test:
if ($value = &deep_defined($hash_ref, qq( {key}{combination}{s
+et}[2]{and_key_for_hash_in_second_list_position} ) ) ){
print "$value"; #prints "some_value"...
}
ADDITIONAL INFO:
This function is simply a wrapper for the sub deep_defined_action(
+), which does the actual combinational testing...
It takes the second argument and parses it as a string into a list
+ in wich deep_defined_action will accept.
=cut
sub deep_defined {
my( $possible_ref, @keys ) = @_ ;
if (ref($possible_ref) eq "HASH" or ref($possible_ref) eq "ARRAY")
+{
### now look at the keys to see what they are:
my $first_key = @keys[0];
$first_key =~s/\s+//g; #get rid of spaces
$first_key =~s/^(\{|\[)//g; #get rid of the leading bracket
+ or brace
$first_key =~s/(\}|\])$//g; #get rid of the trailing bracke
+t or brace
#my @list = split(m/\}\{|\]\[|\]\{|\}\[|\{|\}|\[|\]/, $first_k
+ey); ### these are kind of ordered...
my @list = split(m/\}\{|\]\[|\]\{|\}\[/, $first_key); ### thes
+e are kind of ordered...
if (@list > 1){
my @new_list = ();
foreach my $item (@list){
if (&is_int($item)){
@new_list = (@new_list, int($item));
}else{
push (@new_list, $item);
}
}
### then the second argument was a string containing the k
+eys in typical form for autovivification...
return &deep_defined_action($possible_ref, @new_list);
}else{
### then the arguments following the first are probably al
+ready keys, so lets just plug 'em in.
return &deep_defined_action($possible_ref, @keys);
}
}else{
warn "Invalid arguments passed into sub deep_defined. args: @_
+ \n";
warn "The first arg should be a ref to a hash or array...\n";
return;
}
}
=pod
=head1 ---------------------------------------------------------------
+-------
=head2 deep_defined_action ( <\%hash or $hash_ref>, @key_list )
OBJECTIVE: Return the value defined for a $mixedHashArray{$key}[$combi
+nation]{$set}, without
invoking autovivification. (used by the more flexable sub deep_def
+ined)
PREMIS: Prevent "$mixedHashArray{key}[combination]" from being inst
+antiated when effectively
testing if "$mixedHashArray{key}[combination]{set}" is defined or
+while getting it's value.
Specify the key combination set as a list:
EX:
Test:
if ($value = &deep_defined(\%hash, "key", "combination", "set"
+)){
print "$value"
}
ADDITIONAL INFO:
This subroutine basically came from www.sysarch.com/Perl/autoviv.t
+xt and was originally called
deep_defined, but the return value has been modified to return the
+ defined value of a
multidimensional hash ref combination rather than just a boolean.
To be used in combination with deep_defined; it is meant only to b
+e used as an @EXPORT_OK
or private function and to be included in the same module in which
+ sub deep_defined is located.
=cut
sub deep_defined_action {
my( $ref, @keys ) = @_ ;
unless ( @keys ) {
warn "deep_defined_action: no keys" ;
return ;
}
foreach my $key ( @keys ) {
if( ref $ref eq 'HASH' ) {
# fail when the key doesn't exist at this level
return unless defined( $ref->{$key} ) ;
$ref = $ref->{$key} ;
next ;
}
if( ref $ref eq 'ARRAY' ) {
# fail when the index is out of range or is not defined
return unless 0 <= $key && $key < @{$ref} ;
return unless defined( $ref->[$key] ) ;
$ref = $ref->[$key] ;
next ;
}
# fail when the current level is not a hash or array ref
return ;
}
#return 1 ; #changed this to return the actual value instead
+of just a boolean: Isn't that more useful?
return $ref ;
}
=pod
=head1 ===============================================================
+=============
=head1 SCALAR_TEST FUNCTIONS
=head1 ---------------------------------------------------------------
+-------
=head2 is_int ($scalar)
returns true if a scalar is an integer, otherwise undef.
=cut
sub is_int{
###### returns true if a scalar is an integer:
my ($thing) = @_;
if (int($thing) eq $thing){
return 1;
}else{
return;
}
}
|