| Subject: | Data-Diver-1.0101: Dive() does not do advertised scalar reference dereferencing |
| Date: | Thu, 29 Oct 2015 20:42:13 +0000 |
| To: | "bug-Data-Diver [...] rt.cpan.org" <bug-Data-Diver [...] rt.cpan.org> |
| From: | Kevin Broadey <kevin.broadey [...] ptti.co.uk> |
The POD says:
For both Dive() and DiveRef(), each $key in @ListOfKeys can have the following values:
[…snip…]
a reference to a scalarThis means that you expect $ref to be a reference to a hash and you want to dereference it using $$key as the key.
This is true for DiveRef (and therefore DiveVal) but it is NOT true for Dive itself. Looking at the code, the handling for ‘$$key’ around line 90 is flawed.
Here’s a test case to show the bug:-
-------------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
use warnings;
use Data::Diver qw(Dive DiveVal DiveError);
use Data::Dumper;
my %Collection;
my @keys = qw(Location WNHO110 I 20151018);
my @keyrefs = \((@keys));
sub value_or_dive_error
{
my $expr = shift;
my $value = eval "[ $expr || DiveError() ]";
print "$expr: @$value\n";
}
DiveVal(\%Collection, @keyrefs) = "Hello World!";
value_or_dive_error 'Dive(\%Collection, @keyrefs)';
value_or_dive_error 'Dive(\%Collection, \((@keys)) )';
value_or_dive_error 'Dive(\%Collection, @keys)';
value_or_dive_error 'DiveVal(\%Collection, @keyrefs)';
print Data::Dumper->Dump([\%Collection], [qw(Collection)]);
-------------------------------------------------------------------------------
Here’s the output with the faulty code...
./Data-Dumper-bug.pl
Dive(\%Collection, @keyrefs): Key not present in hash HASH(0x7fb1c20173c8) REF(0x7fb1c20226e0)
Dive(\%Collection, \((@keys)) ): Key not present in hash HASH(0x7fb1c20173c8) REF(0x7fb1c287a5c8)
Dive(\%Collection, @keys): Hello World!
DiveVal(\%Collection, @keyrefs): Hello World!
$Collection = {
'Location' => {
'WNHO110' => {
'I' => {
'20151018' => 'Hello World!'
}
}
}
};
-------------------------------------------------------------------------------
Here’s a patch to fix it - though you may want to revisit the ‘$$key’ stuff immediately after in the original code...
diff -u Diver.pm.orig Diver.pm
--- Diver.pm.orig 2005-09-03 07:57:22.000000000 +0100
+++ Diver.pm 2015-10-29 20:40:24.000000000 +0000
@@ -4,7 +4,7 @@
require Exporter;
use vars qw( $VERSION @EXPORT_OK );
BEGIN {
- $VERSION= 1.01_01;
+ $VERSION= 1.01_02;
@EXPORT_OK= qw( Dive DiveRef DiveVal DiveError DiveDie DiveClear );
*import= \&Exporter::import;
*isa= \&UNIVERSAL::isa;
@@ -87,6 +87,10 @@
if $key < -@$ref
|| $#$ref < $key;
$ref= $ref->[$key];
+ } elsif( ref($key)
+ && eval { exists $ref->{$$key} }
+ ) {
+ $ref= $ref->{$$key};
} elsif( eval { exists $ref->{$key} } ) {
if( eval { my $x= $$key; 1 } ) {
$ref= $ref->{$$key};
-------------------------------------------------------------------------------
and here’s the proof the fix works…
./Data-Dumper-bug.pl
Dive(\%Collection, @keyrefs): Hello World!
Dive(\%Collection, \((@keys)) ): Hello World!
Dive(\%Collection, @keys): Hello World!
DiveVal(\%Collection, @keyrefs): Hello World!
$Collection = {
'Location' => {
'WNHO110' => {
'I' => {
'20151018' => 'Hello World!'
}
}
}
};
-------------------------------------------------------------------------------
All the best
Kevin