my $e = $self->engine;
unless ( $self->offset ) {
+ my $classname = Scalar::Util::blessed( delete $self->{data} );
$self->{offset} = $self->engine->storage->write_to(
refs => undef,
- ref_type => $self->type,
+ ref_type => $self->type,
+ classname => $classname,
);
}
else {
my $self = shift;
my ($args) = @_;
- $self->engine->storage->write_to(
- datas => $args->{value}{offset},
- ref_id => $self->offset,
- data_type => 'S',
- key => $args->{key},
- value => $args->{value}{data},
- class => $args->{value}{class},
- );
+ if ( ( $args->{value}->type || 'S' ) eq 'S' ) {
+ $args->{value}{offset} = $self->engine->storage->write_to(
+ datas => $args->{value}{offset},
+ ref_id => $self->offset,
+ data_type => 'S',
+ key => $args->{key},
+ value => $args->{value}{data},
+ );
- $args->{value}->reload;
+ $args->{value}->reload;
+ }
+ else {
+ # Write the Scalar of the Reference
+ $self->engine->storage->write_to(
+ datas => undef,
+ ref_id => $self->offset,
+ data_type => 'R',
+ key => $args->{key},
+ value => $args->{value}{offset},
+ );
+ }
}
sub delete_key {
my $data;
if ( $old_value ) {
- $data = $old_value->data;
+ $data = $old_value->data({ export => 1 });
$old_value->free;
}
return $data;
}
+sub get_classname {
+ my $self = shift;
+ my ($rows) = $self->engine->storage->read_from(
+ 'refs', $self->offset,
+ qw( classname ),
+ );
+ return unless @$rows;
+ return $rows->[0]{classname};
+}
+
+# Look to hoist this method into a ::Reference trait
+sub data {
+ my $self = shift;
+ my ($args) = @_;
+ $args ||= {};
+
+ my $engine = $self->engine;
+ if ( !exists $engine->cache->{ $self->offset } ) {
+ my $obj = DBM::Deep->new({
+ type => $self->type,
+ base_offset => $self->offset,
+ storage => $engine->storage,
+ engine => $engine,
+ });
+
+ $engine->cache->{$self->offset} = $obj;
+ }
+ my $obj = $engine->cache->{$self->offset};
+
+ # We're not exporting, so just return.
+ unless ( $args->{export} ) {
+ if ( $engine->storage->{autobless} ) {
+ my $classname = $self->get_classname;
+ if ( defined $classname ) {
+ bless $obj, $classname;
+ }
+ }
+
+ return $obj;
+ }
+
+ # We shouldn't export if this is still referred to.
+ if ( $self->get_refcount > 1 ) {
+ return $obj;
+ }
+
+ return $obj->export;
+}
+
+sub free {
+ my $self = shift;
+
+ # We're not ready to be removed yet.
+ return if $self->decrement_refcount > 0;
+
+ # Rebless the object into DBM::Deep::Null.
+ eval { %{ $self->engine->cache->{ $self->offset } } = (); };
+ eval { @{ $self->engine->cache->{ $self->offset } } = (); };
+ bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null';
+ delete $self->engine->cache->{ $self->offset };
+
+ $self->engine->storage->delete_from(
+ 'datas', { ref_id => $self->offset },
+ );
+
+ $self->engine->storage->delete_from(
+ 'datas', { value => $self->offset, data_type => 'R' },
+ );
+
+ $self->SUPER::free( @_ );
+}
+
+sub increment_refcount {
+ my $self = shift;
+ my $refcount = $self->get_refcount;
+ $refcount++;
+ $self->write_refcount( $refcount );
+ return $refcount;
+}
+
+sub decrement_refcount {
+ my $self = shift;
+ my $refcount = $self->get_refcount;
+ $refcount--;
+ $self->write_refcount( $refcount );
+ return $refcount;
+}
+
+sub get_refcount {
+ my $self = shift;
+ my ($rows) = $self->engine->storage->read_from(
+ 'refs', $self->offset,
+ qw( refcount ),
+ );
+ return $rows->[0]{refcount};
+}
+
+sub write_refcount {
+ my $self = shift;
+ my ($num) = @_;
+ $self->engine->storage->{dbh}->do(
+ "UPDATE refs SET refcount = ? WHERE id = ?", undef,
+ $num, $self->offset,
+ );
+}
+
+sub clear {
+ my $self = shift;
+
+ DBM::Deep->new({
+ type => $self->type,
+ base_offset => $self->offset,
+ storage => $self->engine->storage,
+ engine => $self->engine,
+ })->_clear;
+
+ return;
+}
+
1;
__END__