X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep.pm;h=75aee67487b725716c521253bc1d4f5cdbe55b07;hb=86867f3a6f23efdf7c7290f5a0b7a69f5f39834f;hp=8171d6020797a1b08f394a6f8c8f2076b9fc8392;hpb=9e4f83a0812a6a6656708a9740e8c0920a34acc8;p=dbsrgits%2FDBM-Deep.git diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 8171d60..75aee67 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -29,22 +29,25 @@ package DBM::Deep; # modify it under the same terms as Perl itself. ## +use 5.6.0; + use strict; +use warnings; + +our $VERSION = q(0.99_01); use Fcntl qw( :DEFAULT :flock :seek ); use Digest::MD5 (); use Scalar::Util (); use DBM::Deep::Engine; - -use vars qw( $VERSION ); -$VERSION = q(0.99_01); +use DBM::Deep::File; ## # Setup constants for users to pass to new() ## -sub TYPE_HASH () { DBM::Deep::Engine->SIG_HASH } -sub TYPE_ARRAY () { DBM::Deep::Engine->SIG_ARRAY } +sub TYPE_HASH () { DBM::Deep::Engine->SIG_HASH } +sub TYPE_ARRAY () { DBM::Deep::Engine->SIG_ARRAY } sub _get_args { my $proto = shift; @@ -96,34 +99,40 @@ sub new { return bless $self, $class; } +# This initializer is called from the various TIE* methods. new() calls tie(), +# which allows for a single point of entry. sub _init { - ## - # Setup $self and bless into this class. - ## my $class = shift; my ($args) = @_; + $args->{fileobj} = DBM::Deep::File->new( $args ) + unless exists $args->{fileobj}; + + # locking implicitly enables autoflush + if ($args->{locking}) { $args->{autoflush} = 1; } + # These are the defaults to be optionally overridden below my $self = bless { type => TYPE_HASH, - engine => DBM::Deep::Engine->new, base_offset => undef, + + parent => undef, + parent_key => undef, + + fileobj => undef, }, $class; + $self->{engine} = DBM::Deep::Engine->new( { %{$args}, obj => $self } ); + # Grab the parameters we want to use foreach my $param ( keys %$self ) { next unless exists $args->{$param}; - $self->{$param} = delete $args->{$param} + $self->{$param} = $args->{$param}; } - # locking implicitly enables autoflush - if ($args->{locking}) { $args->{autoflush} = 1; } - - $self->{root} = exists $args->{root} - ? $args->{root} - : DBM::Deep::_::Root->new( $args ); - $self->{engine}->setup_fh( $self ); + $self->{fileobj}->set_db( $self ); + return $self; } @@ -139,66 +148,14 @@ sub TIEARRAY { return DBM::Deep::Array->TIEARRAY( @_ ); } -#XXX Unneeded now ... -#sub DESTROY { -#} - sub lock { - ## - # If db locking is set, flock() the db file. If called multiple - # times before unlock(), then the same number of unlocks() must - # be called before the lock is released. - ## my $self = shift->_get_self; - my ($type) = @_; - $type = LOCK_EX unless defined $type; - - if (!defined($self->_fh)) { return; } - - if ($self->_root->{locking}) { - if (!$self->_root->{locked}) { - flock($self->_fh, $type); - - # refresh end counter in case file has changed size - my @stats = stat($self->_fh); - $self->_root->{end} = $stats[7]; - - # double-check file inode, in case another process - # has optimize()d our file while we were waiting. - if ($stats[1] != $self->_root->{inode}) { - $self->{engine}->close_fh( $self ); - $self->{engine}->setup_fh( $self ); - flock($self->_fh, $type); # re-lock - - # This may not be necessary after re-opening - $self->_root->{end} = (stat($self->_fh))[7]; # re-end - } - } - $self->_root->{locked}++; - - return 1; - } - - return; + return $self->_fileobj->lock( $self, @_ ); } sub unlock { - ## - # If db locking is set, unlock the db file. See note in lock() - # regarding calling lock() multiple times. - ## my $self = shift->_get_self; - - if (!defined($self->_fh)) { return; } - - if ($self->_root->{locking} && $self->_root->{locked} > 0) { - $self->_root->{locked}--; - if (!$self->_root->{locked}) { flock($self->_fh, LOCK_UN); } - - return 1; - } - - return; + return $self->_fileobj->unlock( $self, @_ ); } sub _copy_value { @@ -209,8 +166,7 @@ sub _copy_value { ${$spot} = $value; } elsif ( eval { local $SIG{__DIE__}; $value->isa( 'DBM::Deep' ) } ) { - my $type = $value->_type; - ${$spot} = $type eq TYPE_HASH ? {} : []; + ${$spot} = $value->_repr; $value->_copy_node( ${$spot} ); } else { @@ -230,30 +186,11 @@ sub _copy_value { } sub _copy_node { - ## - # Copy single level of keys or elements to new DB handle. - # Recurse for nested structures - ## - my $self = shift->_get_self; - my ($db_temp) = @_; - - if ($self->_type eq TYPE_HASH) { - my $key = $self->first_key(); - while ($key) { - my $value = $self->get($key); - $self->_copy_value( \$db_temp->{$key}, $value ); - $key = $self->next_key($key); - } - } - else { - my $length = $self->length(); - for (my $index = 0; $index < $length; $index++) { - my $value = $self->get($index); - $self->_copy_value( \$db_temp->[$index], $value ); - } - } + die "Must be implemented in a child class\n"; +} - return 1; +sub _repr { + die "Must be implemented in a child class\n"; } sub export { @@ -262,9 +199,7 @@ sub export { ## my $self = shift->_get_self; - my $temp; - if ($self->_type eq TYPE_HASH) { $temp = {}; } - elsif ($self->_type eq TYPE_ARRAY) { $temp = []; } + my $temp = $self->_repr; $self->lock(); $self->_copy_node( $temp ); @@ -284,22 +219,10 @@ sub import { # struct is not a reference, so just import based on our type if (!ref($struct)) { - if ($self->_type eq TYPE_HASH) { $struct = {@_}; } - elsif ($self->_type eq TYPE_ARRAY) { $struct = [@_]; } + $struct = $self->_repr( @_ ); } - my $r = Scalar::Util::reftype($struct) || ''; - if ($r eq "HASH" && $self->_type eq TYPE_HASH) { - foreach my $key (keys %$struct) { $self->put($key, $struct->{$key}); } - } - elsif ($r eq "ARRAY" && $self->_type eq TYPE_ARRAY) { - $self->push( @$struct ); - } - else { - $self->_throw_error("Cannot import: type mismatch"); - } - - return 1; + return $self->_import( $struct ); } sub optimize { @@ -310,12 +233,12 @@ sub optimize { my $self = shift->_get_self; #XXX Need to create a new test for this -# if ($self->_root->{links} > 1) { +# if ($self->_fileobj->{links} > 1) { # $self->_throw_error("Cannot optimize: reference count is greater than 1"); # } my $db_temp = DBM::Deep->new( - file => $self->_root->{file} . '.tmp', + file => $self->_fileobj->{file} . '.tmp', type => $self->_type ); @@ -330,8 +253,8 @@ sub optimize { my $perms = $stats[2] & 07777; my $uid = $stats[4]; my $gid = $stats[5]; - chown( $uid, $gid, $self->_root->{file} . '.tmp' ); - chmod( $perms, $self->_root->{file} . '.tmp' ); + chown( $uid, $gid, $self->_fileobj->{file} . '.tmp' ); + chmod( $perms, $self->_fileobj->{file} . '.tmp' ); # q.v. perlport for more information on this variable if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) { @@ -342,17 +265,18 @@ sub optimize { # with a soft copy. ## $self->unlock(); - $self->{engine}->close_fh( $self ); + $self->_fileobj->close; } - if (!rename $self->_root->{file} . '.tmp', $self->_root->{file}) { - unlink $self->_root->{file} . '.tmp'; + if (!rename $self->_fileobj->{file} . '.tmp', $self->_fileobj->{file}) { + unlink $self->_fileobj->{file} . '.tmp'; $self->unlock(); $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!"); } $self->unlock(); - $self->{engine}->close_fh( $self ); + $self->_fileobj->close; + $self->_fileobj->open; $self->{engine}->setup_fh( $self ); return 1; @@ -367,7 +291,7 @@ sub clone { return DBM::Deep->new( type => $self->_type, base_offset => $self->_base_offset, - root => $self->_root + fileobj => $self->_fileobj, ); } @@ -388,7 +312,7 @@ sub clone { my $func = shift; if ( $is_legal_filter{$type} ) { - $self->_root->{"filter_$type"} = $func; + $self->_fileobj->{"filter_$type"} = $func; return 1; } @@ -396,40 +320,46 @@ sub clone { } } +sub begin_work { + my $self = shift->_get_self; + $self->_fileobj->begin_transaction; + return 1; +} + +sub rollback { + my $self = shift->_get_self; + $self->_fileobj->end_transaction; + return 1; +} + +sub commit { + my $self = shift->_get_self; + $self->_fileobj->commit_transaction; + return 1; +} + ## # Accessor methods ## -sub _root { - ## - # Get access to the root structure - ## +sub _fileobj { my $self = $_[0]->_get_self; - return $self->{root}; + return $self->{fileobj}; } sub _type { - ## - # Get type of current node (TYPE_HASH or TYPE_ARRAY) - ## my $self = $_[0]->_get_self; return $self->{type}; } sub _base_offset { - ## - # Get base_offset of current node (TYPE_HASH or TYPE_ARRAY) - ## my $self = $_[0]->_get_self; return $self->{base_offset}; } sub _fh { - ## - # Get access to the raw fh - ## my $self = $_[0]->_get_self; - return $self->_root->{fh}; + return $self->_fileobj->{fh}; } ## @@ -450,17 +380,85 @@ sub _is_writable { # (O_RDONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0); #} +sub _find_parent { + my $self = shift; + + my $base = ''; + #XXX This if() is redundant + if ( my $parent = $self->{parent} ) { + my $child = $self; + while ( $parent->{parent} ) { + $base = ( + $parent->_type eq TYPE_HASH + ? "\{$child->{parent_key}\}" + : "\[$child->{parent_key}\]" + ) . $base; + + $child = $parent; + $parent = $parent->{parent}; + } + if ( $base ) { + $base = "\$db->get( '$child->{parent_key}' )->" . $base; + } + else { + $base = "\$db->get( '$child->{parent_key}' )"; + } + } + return $base; +} + sub STORE { ## # Store single hash key/value or array element in database. ## my $self = shift->_get_self; - my ($key, $value) = @_; + my ($key, $value, $orig_key) = @_; + if ( $^O ne 'MSWin32' && !_is_writable( $self->_fh ) ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } + #XXX The second condition needs to disappear + if ( defined $orig_key && !( $self->_type eq TYPE_ARRAY && $orig_key eq 'length') ) { + my $rhs; + + my $r = Scalar::Util::reftype( $value ) || ''; + if ( $r eq 'HASH' ) { + $rhs = '{}'; + } + elsif ( $r eq 'ARRAY' ) { + $rhs = '[]'; + } + elsif ( defined $value ) { + $rhs = "'$value'"; + } + else { + $rhs = "undef"; + } + + if ( my $c = Scalar::Util::blessed( $value ) ) { + $rhs = "bless $rhs, '$c'"; + } + + my $lhs = $self->_find_parent; + if ( $lhs ) { + if ( $self->_type eq TYPE_HASH ) { + $lhs .= "->\{$orig_key\}"; + } + else { + $lhs .= "->\[$orig_key\]"; + } + + $lhs .= "=$rhs;"; + } + else { + $lhs = "\$db->put('$orig_key',$rhs);"; + } + + $self->_fileobj->audit($lhs); + } + ## # Request exclusive lock for writing ## @@ -468,22 +466,22 @@ sub STORE { my $md5 = $self->{engine}{digest}->($key); - my $tag = $self->{engine}->find_bucket_list( $self, $md5, { create => 1 } ); + my $tag = $self->{engine}->find_bucket_list( $self->_base_offset, $md5, { create => 1 } ); # User may be storing a hash, in which case we do not want it run # through the filtering system - if ( !ref($value) && $self->_root->{filter_store_value} ) { - $value = $self->_root->{filter_store_value}->( $value ); + if ( !ref($value) && $self->_fileobj->{filter_store_value} ) { + $value = $self->_fileobj->{filter_store_value}->( $value ); } ## # Add key/value to bucket list ## - my $result = $self->{engine}->add_bucket( $self, $tag, $md5, $key, $value ); + $self->{engine}->add_bucket( $tag, $md5, $key, $value, undef, $orig_key ); $self->unlock(); - return $result; + return 1; } sub FETCH { @@ -491,7 +489,7 @@ sub FETCH { # Fetch single value or element given plain key or array index ## my $self = shift->_get_self; - my ($key) = @_; + my ($key, $orig_key) = @_; my $md5 = $self->{engine}{digest}->($key); @@ -500,7 +498,8 @@ sub FETCH { ## $self->lock( LOCK_SH ); - my $tag = $self->{engine}->find_bucket_list( $self, $md5 ); + my $tag = $self->{engine}->find_bucket_list( $self->_base_offset, $md5 );#, { create => 1 } ); + #XXX This needs to autovivify if (!$tag) { $self->unlock(); return; @@ -509,14 +508,14 @@ sub FETCH { ## # Get value from bucket list ## - my $result = $self->{engine}->get_bucket_value( $self, $tag, $md5 ); + my $result = $self->{engine}->get_bucket_value( $tag, $md5, $orig_key ); $self->unlock(); # Filters only apply to scalar values, so the ref check is making # sure the fetched bucket is a scalar, not a child hash or array. - return ($result && !ref($result) && $self->_root->{filter_fetch_value}) - ? $self->_root->{filter_fetch_value}->($result) + return ($result && !ref($result) && $self->_fileobj->{filter_fetch_value}) + ? $self->_fileobj->{filter_fetch_value}->($result) : $result; } @@ -524,13 +523,23 @@ sub DELETE { ## # Delete single key/value pair or element given plain key or array index ## - my $self = $_[0]->_get_self; - my $key = $_[1]; + my $self = shift->_get_self; + my ($key, $orig_key) = @_; if ( $^O ne 'MSWin32' && !_is_writable( $self->_fh ) ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } + if ( defined $orig_key ) { + my $lhs = $self->_find_parent; + if ( $lhs ) { + $self->_fileobj->audit( "delete $lhs;" ); + } + else { + $self->_fileobj->audit( "\$db->delete('$orig_key');" ); + } + } + ## # Request exclusive lock for writing ## @@ -538,7 +547,7 @@ sub DELETE { my $md5 = $self->{engine}{digest}->($key); - my $tag = $self->{engine}->find_bucket_list( $self, $md5 ); + my $tag = $self->{engine}->find_bucket_list( $self->_base_offset, $md5 ); if (!$tag) { $self->unlock(); return; @@ -547,13 +556,13 @@ sub DELETE { ## # Delete bucket ## - my $value = $self->{engine}->get_bucket_value($self, $tag, $md5 ); + my $value = $self->{engine}->get_bucket_value( $tag, $md5 ); - if (defined $value && !ref($value) && $self->_root->{filter_fetch_value}) { - $value = $self->_root->{filter_fetch_value}->($value); + if (defined $value && !ref($value) && $self->_fileobj->{filter_fetch_value}) { + $value = $self->_fileobj->{filter_fetch_value}->($value); } - my $result = $self->{engine}->delete_bucket( $self, $tag, $md5 ); + my $result = $self->{engine}->delete_bucket( $tag, $md5, $orig_key ); ## # If this object is an array and the key deleted was on the end of the stack, @@ -569,8 +578,8 @@ sub EXISTS { ## # Check if a single key or element exists given plain key or array index ## - my $self = $_[0]->_get_self; - my $key = $_[1]; + my $self = shift->_get_self; + my ($key) = @_; my $md5 = $self->{engine}{digest}->($key); @@ -579,7 +588,7 @@ sub EXISTS { ## $self->lock( LOCK_SH ); - my $tag = $self->{engine}->find_bucket_list( $self, $md5 ); + my $tag = $self->{engine}->find_bucket_list( $self->_base_offset, $md5 ); if (!$tag) { $self->unlock(); @@ -592,7 +601,7 @@ sub EXISTS { ## # Check if bucket exists and return 1 or '' ## - my $result = $self->{engine}->bucket_exists( $self, $tag, $md5 ) || ''; + my $result = $self->{engine}->bucket_exists( $tag, $md5 ) || ''; $self->unlock(); @@ -603,27 +612,33 @@ sub CLEAR { ## # Clear all keys from hash, or all elements from array. ## - my $self = $_[0]->_get_self; + my $self = shift->_get_self; if ( $^O ne 'MSWin32' && !_is_writable( $self->_fh ) ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } + { + my $lhs = $self->_find_parent; + + if ( $self->_type eq TYPE_HASH ) { + $lhs = '%{' . $lhs . '}'; + } + else { + $lhs = '@{' . $lhs . '}'; + } + + $self->_fileobj->audit( "$lhs = ();" ); + } + ## # Request exclusive lock for writing ## $self->lock( LOCK_EX ); - my $fh = $self->_fh; - - seek($fh, $self->_base_offset + $self->_root->{file_offset}, SEEK_SET); - if (eof $fh) { - $self->unlock(); - return; - } - +#XXX This needs updating to use _release_space $self->{engine}->write_tag( - $self, $self->_base_offset, $self->_type, + $self->_base_offset, $self->_type, chr(0)x$self->{engine}{index_size}, ); @@ -643,44 +658,6 @@ sub delete { (shift)->DELETE( @_ ) } sub exists { (shift)->EXISTS( @_ ) } sub clear { (shift)->CLEAR( @_ ) } -package DBM::Deep::_::Root; - -sub new { - my $class = shift; - my ($args) = @_; - - my $self = bless { - autobless => undef, - autoflush => undef, - end => 0, - fh => undef, - file => undef, - file_offset => 0, - locking => undef, - locked => 0, - filter_store_key => undef, - filter_store_value => undef, - filter_fetch_key => undef, - filter_fetch_value => undef, - %$args, - }, $class; - - if ( $self->{fh} && !$self->{file_offset} ) { - $self->{file_offset} = tell( $self->{fh} ); - } - - return $self; -} - -sub DESTROY { - my $self = shift; - return unless $self; - - close $self->{fh} if $self->{fh}; - - return; -} - 1; __END__ @@ -837,7 +814,16 @@ If you pass in fh and do not set this, it will be set appropriately. =item * type This parameter specifies what type of object to create, a hash or array. Use -one of these two constants: CTYPE_HASH> or CTYPE_ARRAY>. +one of these two constants: + +=over 4 + +=item * CTYPE_HASH> + +=item * CTYPE_ARRAY>. + +=back + This only takes effect when beginning a new file. This is an optional parameter, and defaults to CTYPE_HASH>. @@ -859,16 +845,15 @@ Pass any true value to enable. This is an optional parameter, and defaults to 0 =item * autobless -If I mode is enabled, DBM::Deep will preserve blessed hashes, and -restore them when fetched. This is an B feature, and does have -side-effects. Basically, when hashes are re-blessed into their original -classes, they are no longer blessed into the DBM::Deep class! So you won't be -able to call any DBM::Deep methods on them. You have been warned. -This is an optional parameter, and defaults to 0 (disabled). +If I mode is enabled, DBM::Deep will preserve the class something +is blessed into, and restores it when fetched. This is an optional parameter, and defaults to 1 (enabled). + +B If you use the OO-interface, you will not be able to call any methods +of DBM::Deep on the blessed item. This is considered to be a feature. =item * filter_* -See L below. +See L below. =back @@ -1019,10 +1004,6 @@ Recover lost disk space. Data going in and out. -=item * set_digest() / set_pack() / set_filter() - -q.v. adjusting the interal parameters. - =back =head2 HASHES @@ -1406,23 +1387,29 @@ failure. You can wrap calls in an eval block to catch the die. If you have a 64-bit system, and your Perl is compiled with both LARGEFILE and 64-bit support, you I be able to create databases larger than 2 GB. DBM::Deep by default uses 32-bit file offset tags, but these can be changed -by calling the static C method before you do anything else. +by specifying the 'pack_size' parameter when constructing the file. - DBM::Deep::set_pack(8, 'Q'); + DBM::Deep->new( + filename => $filename, + pack_size => 'large', + ); This tells DBM::Deep to pack all file offsets with 8-byte (64-bit) quad words instead of 32-bit longs. After setting these values your DB files have a theoretical maximum size of 16 XB (exabytes). +You can also use C 'small'> in order to use 16-bit file +offsets. + B Changing these values will B work for existing database files. -Only change this for new files, and make sure it stays set consistently -throughout the file's life. If you do set these values, you can no longer -access 32-bit DB files. You can, however, call C to change -back to 32-bit mode. +Only change this for new files. Once the value has been set, it is stored in +the file's header and cannot be changed for the life of the file. These +parameters are per-file, meaning you can access 32-bit and 64-bit files, as +you chose. -B I have not personally tested files > 2 GB -- all my systems have -only a 32-bit Perl. However, I have received user reports that this does -indeed work! +B We have not personally tested files larger than 2 GB -- all my +systems have only a 32-bit Perl. However, I have received user reports that +this does indeed work! =head1 LOW-LEVEL ACCESS @@ -1434,10 +1421,10 @@ you can call the C<_fh()> method, which returns the handle: This method can be called on the root level of the datbase, or any child hashes or arrays. All levels share a I structure, which contains things like the filehandle, a reference counter, and all the options specified -when you created the object. You can get access to this root structure by -calling the C method. +when you created the object. You can get access to this file object by +calling the C<_fileobj()> method. - my $root = $db->_root(); + my $file_obj = $db->_fileobj(); This is useful for changing options after the object has already been created, such as enabling/disabling locking. You can also store your own temporary user @@ -1449,26 +1436,26 @@ any child hash or array. DBM::Deep by default uses the I (MD5) algorithm for hashing keys. However you can override this, and use another algorithm (such as SHA-256) or even write your own. But please note that DBM::Deep currently expects zero -collisions, so your algorithm has to be I, so to speak. -Collision detection may be introduced in a later version. - - +collisions, so your algorithm has to be I, so to speak. Collision +detection may be introduced in a later version. -You can specify a custom digest algorithm by calling the static C -function, passing a reference to a subroutine, and the length of the algorithm's -hashes (in bytes). This is a global static function, which affects ALL DBM::Deep -objects. Here is a working example that uses a 256-bit hash from the +You can specify a custom digest algorithm by passing it into the parameter +list for new(), passing a reference to a subroutine as the 'digest' parameter, +and the length of the algorithm's hashes (in bytes) as the 'hash_size' +parameter. Here is a working example that uses a 256-bit hash from the I module. Please see -L for more. +L for more information. use DBM::Deep; use Digest::SHA256; my $context = Digest::SHA256::new(256); - DBM::Deep::set_digest( \&my_digest, 32 ); - - my $db = DBM::Deep->new( "foo-sha.db" ); + my $db = DBM::Deep->new( + filename => "foo-sha.db", + digest => \&my_digest, + hash_size => 32, + ); $db->{key1} = "value1"; $db->{key2} = "value2"; @@ -1483,7 +1470,10 @@ L for more. } B Your returned digest strings must be B the number -of bytes you specify in the C function (in this case 32). +of bytes you specify in the hash_size parameter (in this case 32). + +B If you do choose to use a custom digest algorithm, you must set it +every time you access this file. Otherwise, the default (MD5) will be used. =head1 CIRCULAR REFERENCES @@ -1533,26 +1523,6 @@ B Only call optimize() on the top-level node of the database, and make sure there are no child references lying around. DBM::Deep keeps a reference counter, and if it is greater than 1, optimize() will abort and return undef. -=head2 AUTOVIVIFICATION - -Unfortunately, autovivification doesn't work with tied hashes. This appears to -be a bug in Perl's tie() system, as I encountered the very same -issue with his I module (see L), -and it is also mentioned in the BUGS section for the I module ). Basically, on a new db file, -this does not work: - - $db->{foo}->{bar} = "hello"; - -Since "foo" doesn't exist, you cannot add "bar" to it. You end up with "foo" -being an empty hash. Try this instead, which works fine: - - $db->{foo} = { bar => "hello" }; - -As of Perl 5.8.7, this bug still exists. I have walked very carefully through -the execution path, and Perl indeed passes an empty hash to the STORE() method. -Probably a bug in Perl. - =head2 REFERENCES (The reasons given assume a high level of Perl understanding, specifically of