use vars qw( $VERSION );
$VERSION = q(0.99_01);
-
-##
-# Setup file and tag signatures. These should never change.
-##
-sub SIG_FILE () { 'DPDB' }
-sub SIG_HASH () { 'H' }
-sub SIG_ARRAY () { 'A' }
-sub SIG_SCALAR () { 'S' }
-sub SIG_NULL () { 'N' }
-sub SIG_DATA () { 'D' }
-sub SIG_INDEX () { 'I' }
-sub SIG_BLIST () { 'B' }
-sub SIG_SIZE () { 1 }
-
##
# Setup constants for users to pass to new()
##
-sub TYPE_HASH () { SIG_HASH }
-sub TYPE_ARRAY () { SIG_ARRAY }
-sub TYPE_SCALAR () { SIG_SCALAR }
+sub TYPE_HASH () { DBM::Deep::Engine->SIG_HASH }
+sub TYPE_ARRAY () { DBM::Deep::Engine->SIG_ARRAY }
sub _get_args {
my $proto = shift;
# Setup $self and bless into this class.
##
my $class = shift;
- my $args = shift;
+ my ($args) = @_;
# These are the defaults to be optionally overridden below
my $self = bless {
type => TYPE_HASH,
- base_offset => length(SIG_FILE),
engine => DBM::Deep::Engine->new,
+ base_offset => undef,
}, $class;
foreach my $param ( keys %$self ) {
# times before unlock(), then the same number of unlocks() must
# be called before the lock is released.
##
- my $self = $_[0]->_get_self;
- my $type = $_[1];
+ my $self = shift->_get_self;
+ my ($type) = @_;
$type = LOCK_EX unless defined $type;
if (!defined($self->_fh)) { return; }
# If db locking is set, unlock the db file. See note in lock()
# regarding calling lock() multiple times.
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
if (!defined($self->_fh)) { return; }
##
# Recursively export into standard Perl hashes and arrays.
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
my $temp;
if ($self->_type eq TYPE_HASH) { $temp = {}; }
##
# Recursively import Perl hash/array structure
##
- #XXX This use of ref() seems to be ok
if (!ref($_[0])) { return; } # Perl calls import() on use -- ignore
- my $self = $_[0]->_get_self;
- my $struct = $_[1];
+ my $self = shift->_get_self;
+ my ($struct) = @_;
- #XXX This use of ref() seems to be ok
+ # struct is not a reference, so just import based on our type
if (!ref($struct)) {
- ##
- # struct is not a reference, so just import based on our type
- ##
- shift @_;
-
if ($self->_type eq TYPE_HASH) { $struct = {@_}; }
elsif ($self->_type eq TYPE_ARRAY) { $struct = [@_]; }
}
$self->push( @$struct );
}
else {
- return $self->_throw_error("Cannot import: type mismatch");
+ $self->_throw_error("Cannot import: type mismatch");
}
return 1;
# Rebuild entire database into new file, then move
# it back on top of original.
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
#XXX Need to create a new test for this
# if ($self->_root->{links} > 1) {
-# return $self->_throw_error("Cannot optimize: reference count is greater than 1");
+# $self->_throw_error("Cannot optimize: reference count is greater than 1");
# }
my $db_temp = DBM::Deep->new(
file => $self->_root->{file} . '.tmp',
type => $self->_type
);
- if (!$db_temp) {
- return $self->_throw_error("Cannot optimize: failed to open temp file: $!");
- }
$self->lock();
$self->_copy_node( $db_temp );
if (!rename $self->_root->{file} . '.tmp', $self->_root->{file}) {
unlink $self->_root->{file} . '.tmp';
$self->unlock();
- return $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
+ $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
}
$self->unlock();
##
# Make copy of object and return
##
- my $self = $_[0]->_get_self;
+ my $self = shift->_get_self;
return DBM::Deep->new(
type => $self->_type,
##
# Setup filter function for storing or fetching the key or value
##
- my $self = $_[0]->_get_self;
- my $type = lc $_[1];
- my $func = $_[2] ? $_[2] : undef;
+ my $self = shift->_get_self;
+ my $type = lc shift;
+ my $func = shift;
if ( $is_legal_filter{$type} ) {
$self->_root->{"filter_$type"} = $func;
return $self->{root};
}
-sub _fh {
- ##
- # Get access to the raw fh
- ##
- #XXX It will be useful, though, when we split out HASH and ARRAY
- my $self = $_[0]->_get_self;
- return $self->_root->{fh};
-}
-
sub _type {
##
# Get type of current node (TYPE_HASH or TYPE_ARRAY)
return $self->{base_offset};
}
+sub _fh {
+ ##
+ # Get access to the raw fh
+ ##
+ my $self = $_[0]->_get_self;
+ return $self->_root->{fh};
+}
+
##
# Utility methods
##
# Fetch single value or element given plain key or array index
##
my $self = shift->_get_self;
- my $key = shift;
+ my ($key) = @_;
my $md5 = $self->{engine}{digest}->($key);
my $self = bless {
autobless => undef,
autoflush => undef,
- end => 0,
+ #XXX It should be this in order to work with the initial create_tag(),
+ #XXX but it's not ... it works out because of the stat() in setup_fh(),
+ #XXX but that's not good.
+ end => 0, #length(DBM::Deep->SIG_FILE),
fh => undef,
file => undef,
file_offset => 0,
}
1;
-
__END__
=head1 NAME
wrapper around a C-based DBM. Out-of-the-box compatibility with Unix,
Mac OS X and Windows.
+=head1 VERSION DIFFERENCES
+
+B<NOTE>: 0.99_01 and above have significant file format differences from 0.98 and
+before. While attempts have been made to be backwards compatible, no guarantees.
+
=head1 INSTALLATION
Hopefully you are using Perl's excellent CPAN module, which will download
print $db->{foo} . "\n"; # prints "foo"
print $db->{circle}->{foo} . "\n"; # prints "foo" again
-One catch is, passing the object to a function that recursively walks the
+B<Note>: Passing the object to a function that recursively walks the
object tree (such as I<Data::Dumper> or even the built-in C<optimize()> or
-C<export()> methods) will result in an infinite loop. The other catch is,
-if you fetch the I<key> of a circular reference (i.e. using the C<first_key()>
-or C<next_key()> methods), you will get the I<target object's key>, not the
-ref's key. This gets even more interesting with the above example, where
-the I<circle> key points to the base DB object, which technically doesn't
-have a key. So I made DBM::Deep return "[base]" as the key name in that
-special case.
+C<export()> methods) will result in an infinite loop. This will be fixed in
+a future release.
=head1 CAVEATS / ISSUES / BUGS
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
We use B<Devel::Cover> to test the code coverage of our tests, below is the
B<Devel::Cover> report on this module's test suite.
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
- File stmt bran cond sub pod time total
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
- blib/lib/DBM/Deep.pm 95.1 81.6 70.3 100.0 100.0 33.4 91.0
- blib/lib/DBM/Deep/Array.pm 100.0 91.1 100.0 100.0 n/a 27.8 98.0
- blib/lib/DBM/Deep/Engine.pm 97.8 85.6 75.0 100.0 0.0 25.8 90.8
- blib/lib/DBM/Deep/Hash.pm 100.0 87.5 100.0 100.0 n/a 13.0 97.2
- Total 97.5 85.4 76.6 100.0 46.9 100.0 92.5
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ ----------------------------------- ------ ------ ------ ------ ------ ------
+ File stmt bran cond sub time total
+ ----------------------------------- ------ ------ ------ ------ ------ ------
+ blib/lib/DBM/Deep.pm 94.9 80.6 73.0 100.0 37.9 90.4
+ blib/lib/DBM/Deep/Array.pm 100.0 91.1 100.0 100.0 18.2 98.1
+ blib/lib/DBM/Deep/Engine.pm 98.9 87.3 80.0 100.0 34.2 95.2
+ blib/lib/DBM/Deep/Hash.pm 100.0 87.5 100.0 100.0 9.7 97.3
+ Total 97.9 85.9 79.7 100.0 100.0 94.3
+ ----------------------------------- ------ ------ ------ ------ ------ ------
=head1 MORE INFORMATION