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' ) {
+ $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},
+ );
+ }
+ else {
+ $self->engine->storage->write_to(
+ datas => $args->{value}{offset},
+ ref_id => $self->offset,
+ data_type => 'R',
+ key => $args->{key},
+ value => $args->{value}{offset},
+ class => $args->{value}{class},
+ );
+ }
$args->{value}->reload;
}
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;
+ return;
+}
+
+sub data {
+ my $self = shift;
+ my ($args) = @_;
+ $args ||= {};
+
+ my $obj = DBM::Deep->new({
+ type => $self->type,
+ base_offset => $self->offset,
+# staleness => $self->staleness,
+ storage => $self->engine->storage,
+ engine => $self->engine,
+ });
+
+ if ( $self->engine->storage->{autobless} ) {
+ my $classname = $self->get_classname;
+ if ( defined $classname ) {
+ bless $obj, $classname;
+ }
+ }
+
+ # We're not exporting, so just return.
+ unless ( $args->{export} ) {
+ 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.
+ if ( $self->decrement_refcount > 0 ) {
+ return;
+ }
+
+ $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 {
+ return 1;
+}
+
+sub decrement_refcount {
+ return 0;
+}
+
+sub get_refcount {
+ return 1;
+}
+
+sub write_refcount {
+ my $self = shift;
+ my ($num) = @_;
+}
+
1;
__END__