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         my $classname = Scalar::Util::blessed( delete $self->{data} );
  19         $self->{offset} = $self->engine->storage->write_to(
  20             refs => undef,
  21             ref_type  => $self->type,
  22             classname => $classname,
  23         );
  24     }
  25     else {
  26         my ($rows) = $self->engine->storage->read_from(
  27             refs => $self->offset,
  28             qw( ref_type ),
  29         );
  30
  31         $self->{type} = $rows->[0]{ref_type};
  32     }
  33
  34     return;
  35 }
  36
  37 sub get_data_for {
  38     my $self = shift;
  39     my ($args) = @_;
  40
  41     my ($rows) = $self->engine->storage->read_from(
  42         datas => { ref_id => $self->offset, key => $args->{key} },
  43         qw( id ),
  44     );
  45
  46     return unless $rows->[0]{id};
  47
  48     $self->load(
  49         $self->engine,
  50         $rows->[0]{id},
  51         'datas',
  52     );
  53 }
  54
  55 sub write_data {
  56     my $self = shift;
  57     my ($args) = @_;
  58
  59     if ( ( $args->{value}->type || 'S' ) eq 'S' ) {
  60         $args->{value}{offset} = $self->engine->storage->write_to(
  61             datas => $args->{value}{offset},
  62             ref_id    => $self->offset,
  63             data_type => 'S',
  64             key       => $args->{key},
  65             value     => $args->{value}{data},
  66         );
  67
  68         $args->{value}->reload;
  69     }
  70     else {
  71         # Write the Scalar of the Reference
  72         $self->engine->storage->write_to(
  73             datas => undef,
  74             ref_id    => $self->offset,
  75             data_type => 'R',
  76             key       => $args->{key},
  77             value     => $args->{value}{offset},
  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     my ($rows) = $self->engine->storage->read_from(
 102         'refs', $self->offset,
 103         qw( classname ),
 104     );
 105     return unless @$rows;
 106     return $rows->[0]{classname};
 107 }
 108
 109 # Look to hoist this method into a ::Reference trait
 110 sub data {
 111     my $self = shift;
 112     my ($args) = @_;
 113     $args ||= {};
 114
 115     my $engine = $self->engine;
 116     if ( !exists $engine->cache->{ $self->offset } ) {
 117         my $obj = DBM::Deep->new({
 118             type        => $self->type,
 119             base_offset => $self->offset,
 120             storage     => $engine->storage,
 121             engine      => $engine,
 122         });
 123
 124         $engine->cache->{$self->offset} = $obj;
 125     }
 126     my $obj = $engine->cache->{$self->offset};
 127
 128     # We're not exporting, so just return.
 129     unless ( $args->{export} ) {
 130         if ( $engine->storage->{autobless} ) {
 131             my $classname = $self->get_classname;
 132             if ( defined $classname ) {
 133                 bless $obj, $classname;
 134             }
 135         }
 136
 137         return $obj;
 138     }
 139
 140     # We shouldn't export if this is still referred to.
 141     if ( $self->get_refcount > 1 ) {
 142         return $obj;
 143     }
 144
 145     return $obj->export;
 146 }
 147
 148 sub free {
 149     my $self = shift;
 150
 151     # We're not ready to be removed yet.
 152     return if $self->decrement_refcount > 0;
 153
 154     # Rebless the object into DBM::Deep::Null.
 155     eval { %{ $self->engine->cache->{ $self->offset } } = (); };
 156     eval { @{ $self->engine->cache->{ $self->offset } } = (); };
 157     bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null';
 158     delete $self->engine->cache->{ $self->offset };
 159
 160     $self->engine->storage->delete_from(
 161         'datas', { ref_id => $self->offset },
 162     );
 163
 164     $self->engine->storage->delete_from(
 165         'datas', { value => $self->offset, data_type => 'R' },
 166     );
 167
 168     $self->SUPER::free( @_ );
 169 }
 170
 171 sub increment_refcount {
 172     my $self = shift;
 173     my $refcount = $self->get_refcount;
 174     $refcount++;
 175     $self->write_refcount( $refcount );
 176     return $refcount;
 177 }
 178
 179 sub decrement_refcount {
 180     my $self = shift;
 181     my $refcount = $self->get_refcount;
 182     $refcount--;
 183     $self->write_refcount( $refcount );
 184     return $refcount;
 185 }
 186
 187 sub get_refcount {
 188     my $self = shift;
 189     my ($rows) = $self->engine->storage->read_from(
 190         'refs', $self->offset,
 191         qw( refcount ),
 192     );
 193     return $rows->[0]{refcount};
 194 }
 195
 196 sub write_refcount {
 197     my $self = shift;
 198     my ($num) = @_;
 199     $self->engine->storage->{dbh}->do(
 200         "UPDATE refs SET refcount = ? WHERE id = ?", undef,
 201         $num, $self->offset,
 202     );
 203 }
 204
 205 sub clear {
 206     my $self = shift;
 207
 208     DBM::Deep->new({
 209         type        => $self->type,
 210         base_offset => $self->offset,
 211         storage     => $self->engine->storage,
 212         engine      => $self->engine,
 213     })->_clear;
 214
 215     return;
 216 }
 217
 218 1;
 219 __END__