my $class = shift;
my ($args) = @_;
- $args->{fileobj} = DBM::Deep::File->new( $args )
- unless exists $args->{fileobj};
+ $args->{storage} = DBM::Deep::File->new( $args )
+ unless exists $args->{storage};
# locking implicitly enables autoflush
if ($args->{locking}) { $args->{autoflush} = 1; }
parent => undef,
parent_key => undef,
- fileobj => undef,
+ storage => undef,
}, $class;
$self->{engine} = DBM::Deep::Engine->new( { %{$args}, obj => $self } );
$self->_engine->setup_fh( $self );
- $self->_fileobj->set_db( $self );
+ $self->_storage->set_db( $self );
return $self;
}
sub lock {
my $self = shift->_get_self;
- return $self->_fileobj->lock( $self, @_ );
+ return $self->_storage->lock( $self, @_ );
}
sub unlock {
my $self = shift->_get_self;
- return $self->_fileobj->unlock( $self, @_ );
+ return $self->_storage->unlock( $self, @_ );
}
sub _copy_value {
my $self = shift->_get_self;
#XXX Need to create a new test for this
-# if ($self->_fileobj->{links} > 1) {
+# if ($self->_storage->{links} > 1) {
# $self->_throw_error("Cannot optimize: reference count is greater than 1");
# }
#XXX Do we have to lock the tempfile?
my $db_temp = DBM::Deep->new(
- file => $self->_fileobj->{file} . '.tmp',
+ file => $self->_storage->{file} . '.tmp',
type => $self->_type
);
my $perms = $stats[2] & 07777;
my $uid = $stats[4];
my $gid = $stats[5];
- chown( $uid, $gid, $self->_fileobj->{file} . '.tmp' );
- chmod( $perms, $self->_fileobj->{file} . '.tmp' );
+ chown( $uid, $gid, $self->_storage->{file} . '.tmp' );
+ chmod( $perms, $self->_storage->{file} . '.tmp' );
# q.v. perlport for more information on this variable
if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
# with a soft copy.
##
$self->unlock();
- $self->_fileobj->close;
+ $self->_storage->close;
}
- if (!rename $self->_fileobj->{file} . '.tmp', $self->_fileobj->{file}) {
- unlink $self->_fileobj->{file} . '.tmp';
+ if (!rename $self->_storage->{file} . '.tmp', $self->_storage->{file}) {
+ unlink $self->_storage->{file} . '.tmp';
$self->unlock();
$self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
}
$self->unlock();
- $self->_fileobj->close;
- $self->_fileobj->open;
+ $self->_storage->close;
+ $self->_storage->open;
$self->_engine->setup_fh( $self );
return 1;
return DBM::Deep->new(
type => $self->_type,
base_offset => $self->_base_offset,
- fileobj => $self->_fileobj,
+ storage => $self->_storage,
parent => $self->{parent},
parent_key => $self->{parent_key},
);
my $func = shift;
if ( $is_legal_filter{$type} ) {
- $self->_fileobj->{"filter_$type"} = $func;
+ $self->_storage->{"filter_$type"} = $func;
return 1;
}
sub begin_work {
my $self = shift->_get_self;
- return $self->_fileobj->begin_transaction;
+ return $self->_storage->begin_transaction;
}
sub rollback {
my $self = shift->_get_self;
- return $self->_fileobj->end_transaction;
+ return $self->_storage->end_transaction;
}
sub commit {
my $self = shift->_get_self;
- return $self->_fileobj->commit_transaction;
+ return $self->_storage->commit_transaction;
}
##
return $self->{engine};
}
-sub _fileobj {
+sub _storage {
my $self = $_[0]->_get_self;
- return $self->{fileobj};
+ return $self->{storage};
}
sub _type {
sub _fh {
my $self = $_[0]->_get_self;
- return $self->_fileobj->{fh};
+ return $self->_storage->{fh};
}
##
$lhs = "\$db->put(q{$orig_key},$rhs);";
}
- $self->_fileobj->audit($lhs);
+ $self->_storage->audit($lhs);
}
##
##
$self->lock( LOCK_EX );
- # User may be storing a hash, in which case we do not want it run
- # through the filtering system
- if ( !ref($value) && $self->_fileobj->{filter_store_value} ) {
- $value = $self->_fileobj->{filter_store_value}->( $value );
+ # User may be storing a complex value, in which case we do not want it run
+ # through the filtering system.
+ if ( !ref($value) && $self->_storage->{filter_store_value} ) {
+ $value = $self->_storage->{filter_store_value}->( $value );
}
- ##
- # Add key/value to bucket list
- ##
-# my $md5 = $self->_engine->apply_digest($key);
-# my $tag = $self->_engine->find_blist( $self->_base_offset, $md5, { create => 1 } );
-# $self->_engine->add_bucket( $tag, $md5, $key, $value, undef, $orig_key );
$self->_engine->write_value( $self->_base_offset, $key, $value, $orig_key );
$self->unlock();
##
my $self = shift->_get_self;
my ($key, $orig_key) = @_;
- $orig_key = $key unless @_ > 1;
-
- my $md5 = $self->_engine->apply_digest($key);
+ $orig_key = $key unless defined $orig_key;
##
# Request shared lock for reading
##
$self->lock( LOCK_SH );
- my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );#, { create => 1 } );
- #XXX This needs to autovivify
- if (!$tag) {
- $self->unlock();
- return;
- }
-
- ##
- # Get value from bucket list
- ##
- my $result = $self->_engine->get_bucket_value( $tag, $md5, $orig_key );
+ my $result = $self->_engine->read_value( $self->_base_offset, $key, $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->_fileobj->{filter_fetch_value})
- ? $self->_fileobj->{filter_fetch_value}->($result)
+ return ($result && !ref($result) && $self->_storage->{filter_fetch_value})
+ ? $self->_storage->{filter_fetch_value}->($result)
: $result;
}
if ( defined $orig_key ) {
my $lhs = $self->_find_parent;
if ( $lhs ) {
- $self->_fileobj->audit( "delete $lhs;" );
+ $self->_storage->audit( "delete $lhs;" );
}
else {
- $self->_fileobj->audit( "\$db->delete('$orig_key');" );
+ $self->_storage->audit( "\$db->delete('$orig_key');" );
}
}
##
$self->lock( LOCK_EX );
- my $md5 = $self->_engine->apply_digest($key);
-
- my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
- if (!$tag) {
- $self->unlock();
- return;
- }
-
##
# Delete bucket
##
- my $value = $self->_engine->get_bucket_value( $tag, $md5 );
+ my $value = $self->_engine->delete_key( $self->_base_offset, $key, $orig_key );
- if (defined $value && !ref($value) && $self->_fileobj->{filter_fetch_value}) {
- $value = $self->_fileobj->{filter_fetch_value}->($value);
+ if (defined $value && !ref($value) && $self->_storage->{filter_fetch_value}) {
+ $value = $self->_storage->{filter_fetch_value}->($value);
}
- 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,
- # decrement the length variable.
- ##
-
$self->unlock();
return $value;
my $self = shift->_get_self;
my ($key) = @_;
- my $md5 = $self->_engine->apply_digest($key);
-
##
# Request shared lock for reading
##
$self->lock( LOCK_SH );
- my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
- if (!$tag) {
- $self->unlock();
-
- ##
- # For some reason, the built-in exists() function returns '' for false
- ##
- return '';
- }
-
- ##
- # Check if bucket exists and return 1 or ''
- ##
- my $result = $self->_engine->bucket_exists( $tag, $md5 ) || '';
+ my $result = $self->_engine->key_exists( $self->_base_offset, $key );
$self->unlock();
$lhs = '@{' . $lhs . '}';
}
- $self->_fileobj->audit( "$lhs = ();" );
+ $self->_storage->audit( "$lhs = ();" );
}
##
if ( $self->_type eq TYPE_HASH ) {
my $key = $self->first_key;
while ( $key ) {
+ # Retrieve the key before deleting because we depend on next_key
my $next_key = $self->next_key( $key );
- my $md5 = $self->_engine->apply_digest($key);
- my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
- $self->_engine->delete_bucket( $tag, $md5, $key );
+ $self->_engine->delete_key( $self->_base_offset, $key, $key );
$key = $next_key;
}
}
else {
my $size = $self->FETCHSIZE;
for my $key ( 0 .. $size - 1 ) {
- my $md5 = $self->_engine->apply_digest($key);
- my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
- $self->_engine->delete_bucket( $tag, $md5, $key );
+ $self->_engine->delete_key( $self->_base_offset, $key, $key );
}
$self->STORESIZE( 0 );
}
hashes or arrays. All levels share a I<root> 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 file object by
-calling the C<_fileobj()> method.
+calling the C<_storage()> method.
- my $file_obj = $db->_fileobj();
+ my $file_obj = $db->_storage();
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
projects / dbsrgits/DBM-Deep.git / blobdiff