use strict;
use warnings FATAL => 'all';
+no warnings 'recursion';
use base 'DBM::Deep::Engine';
+use DBM::Deep::Sector::DBI ();
+use DBM::Deep::Storage::DBI ();
+
+sub sector_type { 'DBM::Deep::Sector::DBI' }
+sub iterator_class { 'DBM::Deep::Iterator::DBI' }
+
+sub new {
+ my $class = shift;
+ my ($args) = @_;
+
+ $args->{storage} = DBM::Deep::Storage::DBI->new( $args )
+ unless exists $args->{storage};
+
+ my $self = bless {
+ storage => undef,
+ }, $class;
+
+ # Grab the parameters we want to use
+ foreach my $param ( keys %$self ) {
+ next unless exists $args->{$param};
+ $self->{$param} = $args->{$param};
+ }
+
+ return $self;
+}
+
+sub setup {
+ my $self = shift;
+ my ($obj) = @_;
+
+ # Default the id to 1. This means that we will be creating a row if there
+ # isn't one. The assumption is that the row_id=1 cannot never be deleted. I
+ # don't know if this is a good assumption.
+ $obj->{base_offset} ||= 1;
+
+ my ($rows) = $self->storage->read_from(
+ refs => $obj->_base_offset,
+ qw( ref_type ),
+ );
+
+ # We don't have a row yet.
+ unless ( @$rows ) {
+ $self->storage->write_to(
+ refs => $obj->_base_offset,
+ ref_type => $obj->_type,
+ );
+ }
+
+ my $sector = DBM::Deep::Sector::DBI::Reference->new({
+ engine => $self,
+ offset => $obj->_base_offset,
+ });
+}
+
sub read_value {
my $self = shift;
my ($obj, $key) = @_;
+
+ my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+ or return;
+
+# if ( $sector->staleness != $obj->_staleness ) {
+# return;
+# }
+
+# my $key_md5 = $self->_apply_digest( $key );
+
+ my $value_sector = $sector->get_data_for({
+ key => $key,
+# key_md5 => $key_md5,
+ allow_head => 1,
+ });
+
+ unless ( $value_sector ) {
+ $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
+ engine => $self,
+ data => undef,
+ data_type => 'S',
+ });
+
+ $sector->write_data({
+# key_md5 => $key_md5,
+ key => $key,
+ value => $value_sector,
+ });
+ }
+
+ return $value_sector->data;
}
sub get_classname {
my $self = shift;
my ($obj) = @_;
+
+ my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+ or return;
+
+ return $sector->get_classname;
}
sub make_reference {
my $self = shift;
my ($obj, $old_key, $new_key) = @_;
+
+ my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+ or return;
+
+# if ( $sector->staleness != $obj->_staleness ) {
+# return;
+# }
+
+ my $value_sector = $sector->get_data_for({
+ key => $old_key,
+ allow_head => 1,
+ });
+
+ unless ( $value_sector ) {
+ $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
+ engine => $self,
+ data => undef,
+ });
+
+ $sector->write_data({
+ key => $old_key,
+ value => $value_sector,
+ });
+ }
+
+ if ( $value_sector->isa( 'DBM::Deep::Sector::DBI::Reference' ) ) {
+ $sector->write_data({
+ key => $new_key,
+ value => $value_sector,
+ });
+ $value_sector->increment_refcount;
+ }
+ else {
+ $sector->write_data({
+ key => $new_key,
+ value => $value_sector->clone,
+ });
+ }
+
+ return;
}
+# exists returns '', not undefined.
sub key_exists {
my $self = shift;
my ($obj, $key) = @_;
+
+ my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+ or return '';
+
+# if ( $sector->staleness != $obj->_staleness ) {
+# return '';
+# }
+
+ my $data = $sector->get_data_for({
+# key_md5 => $self->_apply_digest( $key ),
+ key => $key,
+ allow_head => 1,
+ });
+
+ # exists() returns 1 or '' for true/false.
+ return $data ? 1 : '';
}
sub delete_key {
my $self = shift;
my ($obj, $key) = @_;
+
+ my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+ or return '';
+
+# if ( $sector->staleness != $obj->_staleness ) {
+# return '';
+# }
+
+ return $sector->delete_key({
+# key_md5 => $self->_apply_digest( $key ),
+ key => $key,
+ allow_head => 0,
+ });
}
sub write_value {
# Determine if the row was deleted under us
#
- my ($type);
+ my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+ or die "Cannot load sector at '@{[$obj->_base_offset]}'\n";;
+
+ my ($type, $class);
if ( $r eq 'ARRAY' || $r eq 'HASH' ) {
my $tmpvar;
if ( $r eq 'ARRAY' ) {
# See whether or not we are storing ourselves to ourself.
# Write the sector as data in this reference (keyed by $key)
+ my $value_sector = $self->load_sector( $tmpvar->_base_offset, 'refs' );
+ $sector->write_data({
+ key => $key,
+# key_md5 => $self->_apply_digest( $key ),
+ value => $value_sector,
+ });
$value_sector->increment_refcount;
return 1;
}
$type = substr( $r, 0, 1 );
+ $class = 'DBM::Deep::Sector::DBI::Reference';
}
else {
if ( tied($value) ) {
DBM::Deep->_throw_error( "Cannot store something that is tied." );
}
+
+ $class = 'DBM::Deep::Sector::DBI::Scalar';
+ $type = 'S';
}
- # This code is to make sure we write all the values in the $value to the
- # disk and to make sure all changes to $value after the assignment are
- # reflected on disk. This may be counter-intuitive at first, but it is
- # correct dwimmery.
- # NOTE - simply tying $value won't perform a STORE on each value. Hence,
- # the copy to a temp value.
- if ( $r eq 'ARRAY' ) {
- my @temp = @$value;
- tie @$value, 'DBM::Deep', {
- base_offset => $value_sector->offset,
- staleness => $value_sector->staleness,
- storage => $self->storage,
- engine => $self,
- };
- @$value = @temp;
- bless $value, 'DBM::Deep::Array' unless Scalar::Util::blessed( $value );
+ # Create this after loading the reference sector in case something bad
+ # happens. This way, we won't allocate value sector(s) needlessly.
+ my $value_sector = $class->new({
+ engine => $self,
+ data => $value,
+ type => $type,
+ });
+
+ $sector->write_data({
+ key => $key,
+# key_md5 => $self->_apply_digest( $key ),
+ value => $value_sector,
+ });
+
+ $self->_descend( $value, $value_sector );
+
+ return 1;
+}
+
+sub begin_work {
+ my $self = shift;
+ die "Transactions are not supported by this engine"
+ unless $self->supports('transactions');
+
+ if ( $self->in_txn ) {
+ DBM::Deep->_throw_error( "Cannot begin_work within an active transaction" );
}
- elsif ( $r eq 'HASH' ) {
- my %temp = %$value;
- tie %$value, 'DBM::Deep', {
- base_offset => $value_sector->offset,
- staleness => $value_sector->staleness,
- storage => $self->storage,
- engine => $self,
- };
-
- %$value = %temp;
- bless $value, 'DBM::Deep::Hash' unless Scalar::Util::blessed( $value );
+
+ $self->storage->begin_work;
+
+ $self->in_txn( 1 );
+
+ return 1;
+}
+
+sub rollback {
+ my $self = shift;
+ die "Transactions are not supported by this engine"
+ unless $self->supports('transactions');
+
+ if ( !$self->in_txn ) {
+ DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
}
+ $self->storage->rollback;
+
+ $self->in_txn( 0 );
+
return 1;
-}
+}
-sub setup {
+sub commit {
my $self = shift;
- my ($obj) = @_;
+ die "Transactions are not supported by this engine"
+ unless $self->supports('transactions');
+
+ if ( !$self->in_txn ) {
+ DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
+ }
+
+ $self->storage->commit;
+
+ $self->in_txn( 0 );
+
+ return 1;
}
-sub begin_work {
+sub in_txn {
my $self = shift;
- my ($obj) = @_;
+ $self->{in_txn} = shift if @_;
+ $self->{in_txn};
}
-sub rollback {
+sub supports {
my $self = shift;
- my ($obj) = @_;
+ my ($feature) = @_;
+
+ return if $feature eq 'transactions';
+ return 1 if $feature eq 'singletons';
+ return;
}
-sub commit {
+sub clear {
my $self = shift;
- my ($obj) = @_;
-}
+ my $obj = shift;
+
+ my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
+ or return;
+ $sector->clear;
+
+ return;
+}
1;
__END__