##
use strict;
+
use FileHandle;
use Fcntl qw/:flock/;
use Digest::MD5 ();
{
my @outer_params = qw( type base_offset );
- sub init {
+ sub _init {
##
# Setup $self and bless into this class.
##
}
$self->root->{links}++;
- if (!defined($self->fh)) { $self->open(); }
+ if (!defined($self->fh)) { $self->_open(); }
return $self;
}
#XXX This use of ref() is bad and is a bug
elsif (ref($_[0])) { $args = $_[0]; }
else { $args = { file => shift }; }
+
+ $args->{type} = TYPE_HASH;
- return $class->init($args);
+ return $class->_init($args);
}
sub TIEARRAY {
##
# Tied array constructor method, called by Perl's tie() function.
##
-my $class = shift;
-my $args;
-if (scalar(@_) > 1) { $args = {@_}; }
+ my $class = shift;
+ my $args;
+ if (scalar(@_) > 1) { $args = {@_}; }
#XXX This use of ref() is bad and is a bug
elsif (ref($_[0])) { $args = $_[0]; }
else { $args = { file => shift }; }
- return $class->init($args);
+ $args->{type} = TYPE_ARRAY;
+
+ return $class->_init($args);
}
sub DESTROY {
$self->root->{links}--;
if (!$self->root->{links}) {
- $self->close();
+ $self->_close();
}
}
-sub open {
+sub is_tainted {
+ return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
+ }
+sub _open {
##
# Open a FileHandle to the database, create if nonexistent.
# Make sure file signature matches DeepDB spec.
##
my $self = _get_self($_[0]);
- if (defined($self->fh)) { $self->close(); }
+ if (defined($self->fh)) { $self->_close(); }
- if (!(-e $self->root->{file}) && $self->root->{mode} eq 'r+') {
- my $temp = FileHandle->new( $self->root->{file}, 'w' );
- undef $temp;
- }
+# eval {
+ if (!(-e $self->root->{file}) && $self->root->{mode} eq 'r+') {
+ my $temp = FileHandle->new( $self->root->{file}, 'w' );
+ }
- #XXX Convert to set_fh()
- $self->root->{fh} = FileHandle->new( $self->root->{file}, $self->root->{mode} );
+ #XXX Convert to set_fh()
+ $self->root->{fh} = FileHandle->new( $self->root->{file}, $self->root->{mode} );
+# }; if ($@ ) { $self->_throw_error( "Received error: $@\n" ); }
if (! defined($self->fh)) {
- return $self->throw_error("Cannot open file: " . $self->root->{file} . ": $!");
+ return $self->_throw_error("Cannot open file: " . $self->root->{file} . ": $!");
}
binmode $self->fh; # for win32
seek($self->fh, 0, 0);
$self->fh->print(SIG_FILE);
$self->root->{end} = length(SIG_FILE);
- $self->create_tag($self->base_offset, $self->type, chr(0) x $INDEX_SIZE);
+ $self->_create_tag($self->base_offset, $self->type, chr(0) x $INDEX_SIZE);
my $plain_key = "[base]";
$self->fh->print( pack($DATA_LENGTH_PACK, length($plain_key)) . $plain_key );
# Check signature was valid
##
unless ($signature eq SIG_FILE) {
- $self->close();
- return $self->throw_error("Signature not found -- file is not a Deep DB");
+ $self->_close();
+ return $self->_throw_error("Signature not found -- file is not a Deep DB");
}
$self->root->{end} = (stat($self->fh))[7];
##
# Get our type from master index signature
##
- my $tag = $self->load_tag($self->base_offset);
-#XXX This is a problem - need to verify type, not override it!
-#XXX We probably also want to store the hash algorithm name, not assume anything
-#XXX Convert to set_type() when one is written
- $self->{type} = $tag->{signature};
-
+ my $tag = $self->_load_tag($self->base_offset);
+#XXX We probably also want to store the hash algorithm name and not assume anything
+ if (!$tag) {
+ return $self->_throw_error("Corrupted file, no master index record");
+ }
+ if ($self->{type} ne $tag->{signature}) {
+ return $self->_throw_error("File type mismatch");
+ }
+
return 1;
}
-sub close {
+sub _close {
##
# Close database FileHandle
##
undef $self->root->{fh};
}
-sub create_tag {
+sub _create_tag {
##
# Given offset, signature and content, create tag and write to disk
##
};
}
-sub load_tag {
+sub _load_tag {
##
# Given offset, load single tag and return signature, size and data
##
my $offset = shift;
seek($self->fh, $offset, 0);
- if ($self->fh->eof()) { return; }
+ if ($self->fh->eof()) { return undef; }
my $sig;
$self->fh->read($sig, SIG_SIZE);
};
}
-sub index_lookup {
+sub _index_lookup {
##
# Given index tag, lookup single entry in index and return .
##
my $location = unpack($LONG_PACK, substr($tag->{content}, $index * $LONG_SIZE, $LONG_SIZE) );
if (!$location) { return; }
- return $self->load_tag( $location );
+ return $self->_load_tag( $location );
}
-sub add_bucket {
+sub _add_bucket {
##
# Adds one key/value pair to bucket list, given offset, MD5 digest of key,
# plain (undigested) key and value.
##
$result = 2;
- if ($internal_ref) { $location = $value->base_offset; }
- else { $location = $self->root->{end}; }
+ $location = $internal_ref
+ ? $value->base_offset
+ : $self->root->{end};
seek($self->fh, $tag->{offset} + ($i * $BUCKET_SIZE), 0);
$self->fh->print( $md5 . pack($LONG_PACK, $location) );
# If this is an internal reference, return now.
# No need to write value or plain key
##
-#YYY
- if ($internal_ref) { return $result; }
+ if ($internal_ref) {
+ return $result;
+ }
##
# If bucket didn't fit into list, split into a new index level
seek($self->fh, $tag->{ref_loc}, 0);
$self->fh->print( pack($LONG_PACK, $self->root->{end}) );
- my $index_tag = $self->create_tag($self->root->{end}, SIG_INDEX, chr(0) x $INDEX_SIZE);
+ my $index_tag = $self->_create_tag($self->root->{end}, SIG_INDEX, chr(0) x $INDEX_SIZE);
my @offsets = ();
-#XXX We've already guaranteed that this cannot be true at YYY
-# if ($internal_ref) {
-# $keys .= $md5 . pack($LONG_PACK, $value->base_offset);
-# $location = $value->base_offset;
-# }
-# else { $keys .= $md5 . pack($LONG_PACK, 0); }
$keys .= $md5 . pack($LONG_PACK, 0);
for (my $i=0; $i<=$MAX_BUCKETS; $i++) {
seek($self->fh, $index_tag->{offset} + ($num * $LONG_SIZE), 0);
$self->fh->print( pack($LONG_PACK, $self->root->{end}) );
- my $blist_tag = $self->create_tag($self->root->{end}, SIG_BLIST, chr(0) x $BUCKET_LIST_SIZE);
+ my $blist_tag = $self->_create_tag($self->root->{end}, SIG_BLIST, chr(0) x $BUCKET_LIST_SIZE);
seek($self->fh, $blist_tag->{offset}, 0);
$self->fh->print( $key . pack($LONG_PACK, $old_subloc || $self->root->{end}) );
##
# If value is blessed, preserve class name
##
- my $value_class = Scalar::Util::blessed($value);
-#XXX NO tests for this
- if ($self->root->{autobless} && defined $value_class) {
- if ($value_class ne 'DBM::Deep') {
- ##
- # Blessed ref -- will restore later
- ##
- $self->fh->print( chr(1) );
- $self->fh->print( pack($DATA_LENGTH_PACK, length($value_class)) . $value_class );
- $content_length += 1;
- $content_length += $DATA_LENGTH_SIZE + length($value_class);
- }
- else {
- ##
- # Simple unblessed ref -- no restore needed
- ##
- $self->fh->print( chr(0) );
- $content_length += 1;
- }
- }
-
+ if ( $self->root->{autobless} ) {
+ my $value_class = Scalar::Util::blessed($value);
+ if ( defined $value_class && $value_class ne 'DBM::Deep' ) {
+ ##
+ # Blessed ref -- will restore later
+ ##
+ $self->fh->print( chr(1) );
+ $self->fh->print( pack($DATA_LENGTH_PACK, length($value_class)) . $value_class );
+ $content_length += 1;
+ $content_length += $DATA_LENGTH_SIZE + length($value_class);
+ }
+ else {
+ $self->fh->print( chr(0) );
+ $content_length += 1;
+ }
+ }
+
##
# If this is a new content area, advance EOF counter
##
return $result;
}
- return $self->throw_error("Fatal error: indexing failed -- possibly due to corruption in file");
+ return $self->_throw_error("Fatal error: indexing failed -- possibly due to corruption in file");
}
-sub get_bucket_value {
+sub _get_bucket_value {
##
# Fetch single value given tag and MD5 digested key.
##
root => $self->root
);
-#XXX NO tests for this
if ($self->root->{autobless}) {
##
# Skip over value and plain key to see if object needs
return;
}
-sub delete_bucket {
+sub _delete_bucket {
##
# Delete single key/value pair given tag and MD5 digested key.
##
return;
}
-sub bucket_exists {
+sub _bucket_exists {
##
# Check existence of single key given tag and MD5 digested key.
##
return;
}
-sub find_bucket_list {
+sub _find_bucket_list {
##
# Locate offset for bucket list, given digested key
##
# Locate offset for bucket list using digest index system
##
my $ch = 0;
- my $tag = $self->load_tag($self->base_offset);
+ my $tag = $self->_load_tag($self->base_offset);
if (!$tag) { return; }
while ($tag->{signature} ne SIG_BLIST) {
- $tag = $self->index_lookup($tag, ord(substr($md5, $ch, 1)));
+ $tag = $self->_index_lookup($tag, ord(substr($md5, $ch, 1)));
if (!$tag) { return; }
$ch++;
}
return $tag;
}
-sub traverse_index {
+sub _traverse_index {
##
# Scan index and recursively step into deeper levels, looking for next key.
##
my ($self, $offset, $ch, $force_return_next) = @_;
$force_return_next = undef unless $force_return_next;
- my $tag = $self->load_tag( $offset );
+ my $tag = $self->_load_tag( $offset );
if ($tag->{signature} ne SIG_BLIST) {
my $content = $tag->{content};
for (my $index = $start; $index < 256; $index++) {
my $subloc = unpack($LONG_PACK, substr($content, $index * $LONG_SIZE, $LONG_SIZE) );
if ($subloc) {
- my $result = $self->traverse_index( $subloc, $ch + 1, $force_return_next );
+ my $result = $self->_traverse_index( $subloc, $ch + 1, $force_return_next );
if (defined($result)) { return $result; }
}
} # index loop
return;
}
-sub get_next_key {
+sub _get_next_key {
##
# Locate next key, given digested previous one
##
$self->{return_next} = 1;
}
- return $self->traverse_index( $self->base_offset, 0 );
+ return $self->_traverse_index( $self->base_offset, 0 );
}
sub lock {
# be called before the lock is released.
##
my $self = _get_self($_[0]);
- my ($type) = @_;
+ my $type = $_[1];
$type = LOCK_EX unless defined $type;
if ($self->root->{locking}) {
# regarding calling lock() multiple times.
##
my $self = _get_self($_[0]);
-# my $type = $_[1];
if ($self->root->{locking} && $self->root->{locked} > 0) {
$self->root->{locked}--;
}
#XXX These uses of ref() need verified
-sub copy_node {
+sub _copy_node {
##
# Copy single level of keys or elements to new DB handle.
# Recurse for nested structures
##
my $self = _get_self($_[0]);
my $db_temp = $_[1];
-
- if ($self->{type} eq TYPE_HASH) {
+
+ if ($self->type eq TYPE_HASH) {
my $key = $self->first_key();
while ($key) {
my $value = $self->get($key);
+#XXX This doesn't work with autobless
if (!ref($value)) { $db_temp->{$key} = $value; }
else {
my $type = $value->type;
if ($type eq TYPE_HASH) { $db_temp->{$key} = {}; }
else { $db_temp->{$key} = []; }
- $value->copy_node( $db_temp->{$key} );
+ $value->_copy_node( $db_temp->{$key} );
}
$key = $self->next_key($key);
}
for (my $index = 0; $index < $length; $index++) {
my $value = $self->get($index);
if (!ref($value)) { $db_temp->[$index] = $value; }
+ #XXX NO tests for this code
else {
my $type = $value->type;
if ($type eq TYPE_HASH) { $db_temp->[$index] = {}; }
else { $db_temp->[$index] = []; }
- $value->copy_node( $db_temp->[$index] );
+ $value->_copy_node( $db_temp->[$index] );
}
}
}
elsif ($self->type eq TYPE_ARRAY) { $temp = []; }
$self->lock();
- $self->copy_node( $temp );
+ $self->_copy_node( $temp );
$self->unlock();
return $temp;
$self->push( @$struct );
}
else {
- return $self->throw_error("Cannot import: type mismatch");
+ return $self->_throw_error("Cannot import: type mismatch");
}
return 1;
##
my $self = _get_self($_[0]);
if ($self->root->{links} > 1) {
- return $self->throw_error("Cannot optimize: reference count is greater than 1");
+ return $self->_throw_error("Cannot optimize: reference count is greater than 1");
}
my $db_temp = DBM::Deep->new(
type => $self->type
);
if (!$db_temp) {
- return $self->throw_error("Cannot optimize: failed to open temp file: $!");
+ return $self->_throw_error("Cannot optimize: failed to open temp file: $!");
}
$self->lock();
- $self->copy_node( $db_temp );
+ $self->_copy_node( $db_temp );
undef $db_temp;
##
# with a soft copy.
##
$self->unlock();
- $self->close();
+ $self->_close();
}
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: $!");
+ return $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
}
$self->unlock();
- $self->close();
- $self->open();
+ $self->_close();
+ $self->_open();
return 1;
}
##
# Get access to the raw FileHandle
##
+ #XXX It will be useful, though, when we split out HASH and ARRAY
my $self = _get_self($_[0]);
return $self->root->{fh};
}
# Utility methods
##
-sub throw_error {
+sub _throw_error {
##
# Store error string in self
##
my $self = _get_self($_[0]);
my $key = ($self->root->{filter_store_key} && $self->type eq TYPE_HASH) ? $self->root->{filter_store_key}->($_[1]) : $_[1];
#XXX What is ref() checking here?
+ #YYY User may be storing a hash, in which case we do not want it run
+ #YYY through the filtering system
my $value = ($self->root->{filter_store_value} && !ref($_[2])) ? $self->root->{filter_store_value}->($_[2]) : $_[2];
my $unpacked_key = $key;
##
# Make sure file is open
##
- if (!defined($self->fh) && !$self->open()) {
+ if (!defined($self->fh) && !$self->_open()) {
return;
}
##
# Locate offset for bucket list using digest index system
##
- my $tag = $self->load_tag($self->base_offset);
+ my $tag = $self->_load_tag($self->base_offset);
if (!$tag) {
- $tag = $self->create_tag($self->base_offset, SIG_INDEX, chr(0) x $INDEX_SIZE);
+ $tag = $self->_create_tag($self->base_offset, SIG_INDEX, chr(0) x $INDEX_SIZE);
}
my $ch = 0;
while ($tag->{signature} ne SIG_BLIST) {
my $num = ord(substr($md5, $ch, 1));
- my $new_tag = $self->index_lookup($tag, $num);
+ my $new_tag = $self->_index_lookup($tag, $num);
if (!$new_tag) {
my $ref_loc = $tag->{offset} + ($num * $LONG_SIZE);
seek($self->fh, $ref_loc, 0);
$self->fh->print( pack($LONG_PACK, $self->root->{end}) );
- $tag = $self->create_tag($self->root->{end}, SIG_BLIST, chr(0) x $BUCKET_LIST_SIZE);
+ $tag = $self->_create_tag($self->root->{end}, SIG_BLIST, chr(0) x $BUCKET_LIST_SIZE);
$tag->{ref_loc} = $ref_loc;
$tag->{ch} = $ch;
last;
##
# Add key/value to bucket list
##
- my $result = $self->add_bucket( $tag, $md5, $key, $value );
+ my $result = $self->_add_bucket( $tag, $md5, $key, $value );
##
# If this object is an array, and bucket was not a replace, and key is numerical,
##
# Make sure file is open
##
- if (!defined($self->fh)) { $self->open(); }
+ if (!defined($self->fh)) { $self->_open(); }
##
# Request shared lock for reading
##
$self->lock( LOCK_SH );
- my $tag = $self->find_bucket_list( $md5 );
+ my $tag = $self->_find_bucket_list( $md5 );
if (!$tag) {
$self->unlock();
return;
##
# Get value from bucket list
##
- my $result = $self->get_bucket_value( $tag, $md5 );
+ my $result = $self->_get_bucket_value( $tag, $md5 );
$self->unlock();
##
# Make sure file is open
##
- if (!defined($self->fh)) { $self->open(); }
+ if (!defined($self->fh)) { $self->_open(); }
##
# Request exclusive lock for writing
##
$self->lock( LOCK_EX );
- my $tag = $self->find_bucket_list( $md5 );
+ my $tag = $self->_find_bucket_list( $md5 );
if (!$tag) {
$self->unlock();
return;
##
# Delete bucket
##
- my $result = $self->delete_bucket( $tag, $md5 );
+ my $result = $self->_delete_bucket( $tag, $md5 );
##
# If this object is an array and the key deleted was on the end of the stack,
##
# Make sure file is open
##
- if (!defined($self->fh)) { $self->open(); }
+ if (!defined($self->fh)) { $self->_open(); }
##
# Request shared lock for reading
##
$self->lock( LOCK_SH );
- my $tag = $self->find_bucket_list( $md5 );
+ my $tag = $self->_find_bucket_list( $md5 );
##
# For some reason, the built-in exists() function returns '' for false
##
# Check if bucket exists and return 1 or ''
##
- my $result = $self->bucket_exists( $tag, $md5 ) || '';
+ my $result = $self->_bucket_exists( $tag, $md5 ) || '';
$self->unlock();
##
# Make sure file is open
##
- if (!defined($self->fh)) { $self->open(); }
+ if (!defined($self->fh)) { $self->_open(); }
##
# Request exclusive lock for writing
return;
}
- $self->create_tag($self->base_offset, $self->type, chr(0) x $INDEX_SIZE);
+ $self->_create_tag($self->base_offset, $self->type, chr(0) x $INDEX_SIZE);
$self->unlock();
##
my $self = _get_self($_[0]);
if ($self->type ne TYPE_HASH) {
- return $self->throw_error("FIRSTKEY method only supported for hashes");
+ return $self->_throw_error("FIRSTKEY method only supported for hashes");
}
##
# Make sure file is open
##
- if (!defined($self->fh)) { $self->open(); }
+ if (!defined($self->fh)) { $self->_open(); }
##
# Request shared lock for reading
##
$self->lock( LOCK_SH );
- my $result = $self->get_next_key();
+ my $result = $self->_get_next_key();
$self->unlock();
##
my $self = _get_self($_[0]);
if ($self->type ne TYPE_HASH) {
- return $self->throw_error("NEXTKEY method only supported for hashes");
+ return $self->_throw_error("NEXTKEY method only supported for hashes");
}
my $prev_key = ($self->root->{filter_store_key} && $self->type eq TYPE_HASH) ? $self->root->{filter_store_key}->($_[1]) : $_[1];
my $prev_md5 = $DIGEST_FUNC->($prev_key);
##
# Make sure file is open
##
- if (!defined($self->fh)) { $self->open(); }
+ if (!defined($self->fh)) { $self->_open(); }
##
# Request shared lock for reading
##
$self->lock( LOCK_SH );
- my $result = $self->get_next_key( $prev_md5 );
+ my $result = $self->_get_next_key( $prev_md5 );
$self->unlock();
##
my $self = _get_self($_[0]);
if ($self->type ne TYPE_ARRAY) {
- return $self->throw_error("FETCHSIZE method only supported for arrays");
+ return $self->_throw_error("FETCHSIZE method only supported for arrays");
}
my $SAVE_FILTER = $self->root->{filter_fetch_value};
##
my $self = _get_self($_[0]);
if ($self->type ne TYPE_ARRAY) {
- return $self->throw_error("STORESIZE method only supported for arrays");
+ return $self->_throw_error("STORESIZE method only supported for arrays");
}
my $new_length = $_[1];
##
my $self = _get_self($_[0]);
if ($self->type ne TYPE_ARRAY) {
- return $self->throw_error("POP method only supported for arrays");
+ return $self->_throw_error("POP method only supported for arrays");
}
my $length = $self->FETCHSIZE();
##
my $self = _get_self(shift);
if ($self->type ne TYPE_ARRAY) {
- return $self->throw_error("PUSH method only supported for arrays");
+ return $self->_throw_error("PUSH method only supported for arrays");
}
my $length = $self->FETCHSIZE();
##
my $self = _get_self($_[0]);
if ($self->type ne TYPE_ARRAY) {
- return $self->throw_error("SHIFT method only supported for arrays");
+ return $self->_throw_error("SHIFT method only supported for arrays");
}
my $length = $self->FETCHSIZE();
##
my $self = _get_self($_[0]);shift @_;
if ($self->type ne TYPE_ARRAY) {
- return $self->throw_error("UNSHIFT method only supported for arrays");
+ return $self->_throw_error("UNSHIFT method only supported for arrays");
}
my @new_elements = @_;
my $length = $self->FETCHSIZE();
##
my $self = _get_self($_[0]);shift @_;
if ($self->type ne TYPE_ARRAY) {
- return $self->throw_error("SPLICE method only supported for arrays");
+ return $self->_throw_error("SPLICE method only supported for arrays");
}
my $length = $self->FETCHSIZE();
}
#XXX We don't need to define it.
+#XXX It will be useful, though, when we split out HASH and ARRAY
#sub EXTEND {
##
# Perl will call EXTEND() when the array is likely to grow.
=head1 TIE INTERFACE
With DBM::Deep you can access your databases using Perl's standard hash/array
-syntax. Because all Deep objects are I<tied> to hashes or arrays, you can treat
-them as such. Deep will intercept all reads/writes and direct them to the right
+syntax. Because all DBM::Deep objects are I<tied> to hashes or arrays, you can treat
+them as such. DBM::Deep will intercept all reads/writes and direct them to the right
place -- the DB file. This has nothing to do with the L<TIE CONSTRUCTION>
section above. This simply tells you how to use DBM::Deep using regular hashes
and arrays, rather than calling functions like C<get()> and C<put()> (although those
locking => 1
);
-This causes Deep to C<flock()> the underlying FileHandle object with exclusive
+This causes DBM::Deep to C<flock()> the underlying FileHandle object with exclusive
mode for writes, and shared mode for reads. This is required if you have
multiple processes accessing the same database file, to avoid file corruption.
Please note that C<flock()> does NOT work for files over NFS. See L<DB OVER
$db->unlock();
If you want to implement your own file locking scheme, be sure to create your
-DBM::Deep objects setting the C<volatile> option to true. This hints to Deep
+DBM::Deep objects setting the C<volatile> option to true. This hints to DBM::Deep
that the DB file may change between transactions. See L<LOW-LEVEL ACCESS>
below for more.
=head1 LOW-LEVEL ACCESS
-If you require low-level access to the underlying FileHandle that Deep uses,
+If you require low-level access to the underlying FileHandle that DBM::Deep uses,
you can call the C<fh()> method, which returns the handle:
my $fh = $db->fh();
DBM::Deep by default uses the I<Message Digest 5> (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 Deep currently expects zero
+or even write your own. But please note that DBM::Deep currently expects zero
collisions, so your algorithm has to be I<perfect>, so to speak.
Collision detection may be introduced in a later version.
You can specify a custom digest algorithm by calling the static C<set_digest()>
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 Deep
+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
I<Digest::SHA256> module. Please see
L<http://search.cpan.org/search?module=Digest::SHA256> for more.
=head2 UNUSED SPACE RECOVERY
-One major caveat with Deep is that space occupied by existing keys and
+One major caveat with DBM::Deep is that space occupied by existing keys and
values is not recovered when they are deleted. Meaning if you keep deleting
and adding new keys, your file will continuously grow. I am working on this,
but in the meantime you can call the built-in C<optimize()> method from time to
B<WARNING:> Only call optimize() on the top-level node of the database, and
-make sure there are no child references lying around. Deep keeps a reference
+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
=head2 FILE CORRUPTION
-The current level of error handling in Deep is minimal. Files I<are> checked
-for a 32-bit signature on open(), but other corruption in files can cause
-segmentation faults. Deep may try to seek() past the end of a file, or get
+The current level of error handling in DBM::Deep is minimal. Files I<are> checked
+for a 32-bit signature when opened, but other corruption in files can cause
+segmentation faults. DBM::Deep may try to seek() past the end of a file, or get
stuck in an infinite loop depending on the level of corruption. File write
operations are not checked for failure (for speed), so if you happen to run
-out of disk space, Deep will probably fail in a bad way. These things will
+out of disk space, DBM::Deep will probably fail in a bad way. These things will
be addressed in a later version of DBM::Deep.
=head2 DB OVER NFS
-Beware of using DB files over NFS. Deep uses flock(), which works well on local
+Beware of using DB files over NFS. DBM::Deep uses flock(), which works well on local
filesystems, but will NOT protect you from file corruption over NFS. I've heard
about setting up your NFS server with a locking daemon, then using lockf() to
lock your files, but your milage may vary there as well. From what I
understand, there is no real way to do it. However, if you need access to the
-underlying FileHandle in Deep for using some other kind of locking scheme like
+underlying FileHandle in DBM::Deep for using some other kind of locking scheme like
lockf(), see the L<LOW-LEVEL ACCESS> section above.
=head2 COPYING OBJECTS
Beware of copying tied objects in Perl. Very strange things can happen.
-Instead, use Deep's C<clone()> method which safely copies the object and
+Instead, use DBM::Deep's C<clone()> method which safely copies the object and
returns a new, blessed, tied hash or array to the same level in the DB.
my $copy = $db->clone();
One of the great things about DBM::Deep is that it uses very little memory.
Even with huge databases (1,000,000+ keys) you will not see much increased
-memory on your process. Deep relies solely on the filesystem for storing
+memory on your process. DBM::Deep relies solely on the filesystem for storing
and fetching data. Here is output from I</usr/bin/top> before even opening a
database handle:
DBM::Deep files always start with a 32-bit signature to identify the file type.
This is at offset 0. The signature is "DPDB" in network byte order. This is
-checked upon each file open().
+checked when the file is opened.
=head2 TAG
so it's pretty much undefined how the keys will come out -- just like Perl's
built-in hashes.
+=head1 CODE COVERAGE
+
+I use B<Devel::Cover> to test the code coverage of my 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 94.9 84.5 77.8 100.0 11.1 100.0 89.7
+ Total 94.9 84.5 77.8 100.0 11.1 100.0 89.7
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+
=head1 AUTHOR
Joseph Huckaby, L<jhuckaby@cpan.org>
projects / dbsrgits/DBM-Deep.git / blobdiff