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
+references. You can safely skip this section.)
+
+Currently, the only references supported are HASH and ARRAY. The other reference
+types (SCALAR, CODE, GLOB, and REF) cannot be supported for various reasons.
+
+=over 4
+
+=item * GLOB
+
+These are things like filehandles and other sockets. They can't be supported
+because it's completely unclear how DBM::Deep should serialize them.
+
+=item * SCALAR / REF
+
+The discussion here refers to the following type of example:
+
+ my $x = 25;
+ $db->{key1} = \$x;
+
+ $x = 50;
+
+ # In some other process ...
+
+ my $val = ${ $db->{key1} };
+
+ is( $val, 50, "What actually gets stored in the DB file?" );
+
+The problem is one of synchronization. When the variable being referred to
+changes value, the reference isn't notified. This means that the new value won't
+be stored in the datafile for other processes to read. There is no TIEREF.
+
+It is theoretically possible to store references to values already within a
+DBM::Deep object because everything already is synchronized, but the change to
+the internals would be quite large. Specifically, DBM::Deep would have to tie
+every single value that is stored. This would bloat the RAM footprint of
+DBM::Deep at least twofold (if not more) and be a significant performance drain,
+all to support a feature that has never been requested.
+
+=item * CODE
+
+L<http://search.cpan.org/search?module=Data::Dump::Streamer> provides a
+mechanism for serializing coderefs, including saving off all closure state.
+However, just as for SCALAR and REF, that closure state may change without
+notifying the DBM::Deep object storing the reference.
+
+=back
+
=head2 FILE CORRUPTION
The current level of error handling in DBM::Deep is minimal. Files I<are> checked
}
sub FETCH {
- my $self = $_[0]->_get_self;
- my $key = $_[1];
+ my $self = shift->_get_self;
+ my ($key) = @_;
$self->lock( $self->LOCK_SH );
}
sub EXISTS {
- my $self = $_[0]->_get_self;
- my $key = $_[1];
+ my $self = shift->_get_self;
+ my ($key) = @_;
$self->lock( $self->LOCK_SH );
}
sub DELETE {
- my $self = $_[0]->_get_self;
- my $key = $_[1];
+ my $self = shift->_get_self;
+ my ($key) = @_;
my $unpacked_key = $key;
##
# Set the length of the array
##
- my $self = $_[0]->_get_self;
- my $new_length = $_[1];
+ my $self = shift->_get_self;
+ my ($new_length) = @_;
$self->lock( $self->LOCK_EX );
##
# Remove and return the last element on the array
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
$self->lock( $self->LOCK_EX );
# Remove and return first element on the array.
# Shift over remaining elements to take up space.
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
$self->lock( $self->LOCK_EX );
my $self = shift;
my ($obj, $tag, $md5, $plain_key, $value) = @_;
+ # This verifies that only supported values will be stored.
+ {
+ my $r = Scalar::Util::reftype( $value );
+ last if !defined $r;
+
+ last if $r eq 'HASH';
+ last if $r eq 'ARRAY';
+
+ $obj->_throw_error(
+ "Storage of variables of type '$r' is not supported."
+ );
+ }
+
my $location = 0;
my $result = 2;
##
# Locate and return first key (in no particular order)
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
##
# Request shared lock for reading
##
# Return next key (in no particular order), given previous one
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
my $prev_key = ($self->_root->{filter_store_key})
- ? $self->_root->{filter_store_key}->($_[1])
- : $_[1];
+ ? $self->_root->{filter_store_key}->($_[0])
+ : $_[0];
my $prev_md5 = $self->{engine}{digest}->($prev_key);
-package DBM::Deep::Scalar;
+package DBM::Deep::Ref;
use strict;
return $class->_init($args);
}
+sub FETCH {
+ my $self = shift->_get_self;
+
+ #my $value = $self->
+}
+
+sub STORE {
+ my $self = shift->_get_self;
+ my ($value) = @_;
+}
+
1;
__END__
# DBM::Deep Test
##
use strict;
-use Test::More tests => 31;
+use Test::More tests => 32;
use File::Temp qw( tempfile tempdir );
use_ok( 'DBM::Deep' );
##
$db->{key1} = "another value";
+isnt( $db->{key3}, 'another value', "Simple scalars are copied by value" );
+
is( $db->{key1}, 'another value', "The value is there directly" );
is( $db->{circle}{key1}, 'another value', "The value is there in one loop of the circle" );
is( $db->{circle}{circle}{key1}, 'another value', "The value is there in two loops of the circle" );
use strict;
-use Test::More tests => 7;
+use Test::More tests => 10;
+use Test::Exception;
use File::Temp qw( tempfile tempdir );
use_ok( 'DBM::Deep' );
my $dir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
+my $x = 25;
{
my $db = DBM::Deep->new( $filename );
- my $x = 25;
- my $y = 30;
- $db->{scalar} = $x;
- $db->{scalarref} = \$y;
- $db->{selfref} = \$x;
+ throws_ok {
+ $db->{scalarref} = \$x;
+ } qr/Storage of variables of type 'SCALAR' is not supported/,
+ 'Storage of scalar refs not supported';
- is( $db->{scalar}, $x, "Scalar retrieved ok" );
+ throws_ok {
+ $db->{scalarref} = \\$x;
+ } qr/Storage of variables of type 'REF' is not supported/,
+ 'Storage of ref refs not supported';
+
+ throws_ok {
+ $db->{scalarref} = sub { 1 };
+ } qr/Storage of variables of type 'CODE' is not supported/,
+ 'Storage of code refs not supported';
+
+ throws_ok {
+ $db->{scalarref} = $db->_get_self->_fh;
+ } qr/Storage of variables of type 'GLOB' is not supported/,
+ 'Storage of glob refs not supported';
+
+ $db->{scalar} = $x;
TODO: {
- todo_skip "Scalar refs aren't implemented yet", 2;
- is( ${$db->{scalarref}}, 30, "Scalarref retrieved ok" );
- is( ${$db->{selfref}}, 25, "Scalarref to stored scalar retrieved ok" );
+ todo_skip "Refs to DBM::Deep objects aren't implemented yet", 2;
+ lives_ok {
+ $db->{selfref} = \$db->{scalar};
+ } "Refs to DBM::Deep objects are ok";
+
+ is( ${$db->{selfref}}, $x, "A ref to a DBM::Deep object is ok" );
}
}
{
my $db = DBM::Deep->new( $filename );
- my $x = 25;
- my $y = 30;
is( $db->{scalar}, $x, "Scalar retrieved ok" );
TODO: {
- todo_skip "Scalar refs aren't implemented yet", 2;
+ todo_skip "Refs to DBM::Deep objects aren't implemented yet", 2;
is( ${$db->{scalarref}}, 30, "Scalarref retrieved ok" );
- is( ${$db->{selfref}}, 25, "Scalarref to stored scalar retrieved ok" );
+ is( ${$db->{selfref}}, 26, "Scalarref to stored scalar retrieved ok" );
}
}
projects / dbsrgits/DBM-Deep.git / commitdiff