lib/DBM/Deep/Sector/DBI/Reference.pm

   1 package DBM::Deep::Sector::DBI::Reference;
   2
   3 use 5.006_000;
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7
   8 use base 'DBM::Deep::Sector::DBI';
   9
  10 sub table { 'refs' }
  11
  12 sub _init {
  13     my $self = shift;
  14
  15     my $e = $self->engine;
  16
  17     unless ( $self->offset ) {
  18         $self->{offset} = $self->engine->storage->write_to(
  19             refs => undef,
  20             ref_type => $self->type,
  21         );
  22     }
  23     else {
  24         my ($rows) = $self->engine->storage->read_from(
  25             refs => $self->offset,
  26             qw( ref_type ),
  27         );
  28
  29         $self->{type} = $rows->[0]{ref_type};
  30     }
  31
  32     return;
  33 }
  34
  35 sub get_data_for {
  36     my $self = shift;
  37     my ($args) = @_;
  38
  39     my ($rows) = $self->engine->storage->read_from(
  40         datas => { ref_id => $self->offset, key => $args->{key} },
  41         qw( id ),
  42     );
  43
  44     return unless $rows->[0]{id};
  45
  46     $self->load(
  47         $self->engine,
  48         $rows->[0]{id},
  49         'datas',
  50     );
  51 }
  52
  53 sub write_data {
  54     my $self = shift;
  55     my ($args) = @_;
  56
  57     if ( ( $args->{value}->type || 'S' ) eq 'S' ) {
  58         $args->{value}{offset} = $self->engine->storage->write_to(
  59             datas => $args->{value}{offset},
  60             ref_id    => $self->offset,
  61             data_type => 'S',
  62             key       => $args->{key},
  63             value     => $args->{value}{data},
  64             class     => $args->{value}{class},
  65         );
  66
  67         $args->{value}->reload;
  68     }
  69     else {
  70         # Write the Scalar of the Reference
  71         $self->engine->storage->write_to(
  72             datas => undef,
  73             ref_id    => $self->offset,
  74             data_type => 'R',
  75             key       => $args->{key},
  76             value     => $args->{value}{offset},
  77             class     => $args->{value}{class},
  78         );
  79     }
  80 }
  81
  82 sub delete_key {
  83     my $self = shift;
  84     my ($args) = @_;
  85
  86     my $old_value = $self->get_data_for({
  87         key => $args->{key},
  88     });
  89
  90     my $data;
  91     if ( $old_value ) {
  92         $data = $old_value->data({ export => 1 });
  93         $old_value->free;
  94     }
  95
  96     return $data;
  97 }
  98
  99 sub get_classname {
 100     my $self = shift;
 101     return;
 102 }
 103
 104 sub data {
 105     my $self = shift;
 106     my ($args) = @_;
 107     $args ||= {};
 108
 109     my $obj = DBM::Deep->new({
 110         type        => $self->type,
 111         base_offset => $self->offset,
 112 #        staleness   => $self->staleness,
 113         storage     => $self->engine->storage,
 114         engine      => $self->engine,
 115     });
 116
 117     if ( $self->engine->storage->{autobless} ) {
 118         my $classname = $self->get_classname;
 119         if ( defined $classname ) {
 120             bless $obj, $classname;
 121         }
 122     }
 123
 124     # We're not exporting, so just return.
 125     unless ( $args->{export} ) {
 126         return $obj;
 127     }
 128
 129     # We shouldn't export if this is still referred to.
 130     if ( $self->get_refcount > 1 ) {
 131         return $obj;
 132     }
 133
 134     return $obj->export;
 135 }
 136
 137 sub free {
 138     my $self = shift;
 139
 140     # We're not ready to be removed yet.
 141     if ( $self->decrement_refcount > 0 ) {
 142         return;
 143     }
 144
 145     $self->engine->storage->delete_from(
 146         'datas', { ref_id => $self->offset },
 147     );
 148
 149     $self->engine->storage->delete_from(
 150         'datas', { value => $self->offset, data_type => 'R' },
 151     );
 152
 153     $self->SUPER::free( @_ );
 154 }
 155
 156 sub increment_refcount {
 157     my $self = shift;
 158     my $refcount = $self->get_refcount;
 159     $refcount++;
 160     $self->write_refcount( $refcount );
 161     return $refcount;
 162 }
 163
 164 sub decrement_refcount {
 165     my $self = shift;
 166     my $refcount = $self->get_refcount;
 167     $refcount--;
 168     $self->write_refcount( $refcount );
 169     return $refcount;
 170 }
 171
 172 sub get_refcount {
 173     my $self = shift;
 174     my ($rows) = $self->engine->storage->read_from(
 175         'refs', $self->offset,
 176         qw( refcount ),
 177     );
 178     return $rows->[0]{refcount};
 179 }
 180
 181 sub write_refcount {
 182     my $self = shift;
 183     my ($num) = @_;
 184     $self->engine->storage->{dbh}->do(
 185         "UPDATE refs SET refcount = ? WHERE id = ?", undef,
 186         $num, $self->offset,
 187     );
 188 }
 189
 190 1;
 191 __END__