lib/DBM/Deep/Engine/DBI.pm

   1 package DBM::Deep::Engine::DBI;
   2
   3 use 5.006_000;
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7 no warnings 'recursion';
   8
   9 use base 'DBM::Deep::Engine';
  10
  11 use DBM::Deep::Sector::DBI ();
  12 use DBM::Deep::Storage::DBI ();
  13
  14 sub sector_type { 'DBM::Deep::Sector::DBI' }
  15 sub iterator_class { 'DBM::Deep::Iterator::DBI' }
  16
  17 sub new {
  18     my $class = shift;
  19     my ($args) = @_;
  20
  21     $args->{storage} = DBM::Deep::Storage::DBI->new( $args )
  22         unless exists $args->{storage};
  23
  24     my $self = bless {
  25         storage => undef,
  26     }, $class;
  27
  28     # Grab the parameters we want to use
  29     foreach my $param ( keys %$self ) {
  30         next unless exists $args->{$param};
  31         $self->{$param} = $args->{$param};
  32     }
  33
  34     return $self;
  35 }
  36
  37 sub setup {
  38     my $self = shift;
  39     my ($obj) = @_;
  40
  41     # Default the id to 1. This means that we will be creating a row if there
  42     # isn't one. The assumption is that the row_id=1 cannot never be deleted. I
  43     # don't know if this is a good assumption.
  44     $obj->{base_offset} ||= 1;
  45
  46     my ($rows) = $self->storage->read_from(
  47         refs => $obj->_base_offset,
  48         qw( ref_type ),
  49     );
  50
  51     # We don't have a row yet.
  52     unless ( @$rows ) {
  53         $self->storage->write_to(
  54             refs => $obj->_base_offset,
  55             ref_type => $obj->_type,
  56         );
  57     }
  58
  59     my $sector = DBM::Deep::Sector::DBI::Reference->new({
  60         engine => $self,
  61         offset => $obj->_base_offset,
  62     });
  63 }
  64
  65 sub read_value {
  66     my $self = shift;
  67     my ($obj, $key) = @_;
  68
  69     my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
  70         or return;
  71
  72 #    if ( $sector->staleness != $obj->_staleness ) {
  73 #        return;
  74 #    }
  75
  76 #    my $key_md5 = $self->_apply_digest( $key );
  77
  78     my $value_sector = $sector->get_data_for({
  79         key => $key,
  80 #        key_md5    => $key_md5,
  81         allow_head => 1,
  82     });
  83
  84     unless ( $value_sector ) {
  85         $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
  86             engine    => $self,
  87             data      => undef,
  88             data_type => 'S',
  89         });
  90
  91         $sector->write_data({
  92 #            key_md5 => $key_md5,
  93             key     => $key,
  94             value   => $value_sector,
  95         });
  96     }
  97
  98     return $value_sector->data;
  99 }
 100
 101 sub get_classname {
 102     my $self = shift;
 103     my ($obj) = @_;
 104
 105     my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
 106         or return;
 107
 108     return $sector->get_classname;
 109 }
 110
 111 sub make_reference {
 112     my $self = shift;
 113     my ($obj, $old_key, $new_key) = @_;
 114
 115     my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
 116         or return;
 117
 118 #    if ( $sector->staleness != $obj->_staleness ) {
 119 #        return;
 120 #    }
 121
 122     my $value_sector = $sector->get_data_for({
 123         key        => $old_key,
 124         allow_head => 1,
 125     });
 126
 127     unless ( $value_sector ) {
 128         $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
 129             engine => $self,
 130             data   => undef,
 131         });
 132
 133         $sector->write_data({
 134             key     => $old_key,
 135             value   => $value_sector,
 136         });
 137     }
 138
 139     if ( $value_sector->isa( 'DBM::Deep::Sector::DBI::Reference' ) ) {
 140         $sector->write_data({
 141             key     => $new_key,
 142             value   => $value_sector,
 143         });
 144         $value_sector->increment_refcount;
 145     }
 146     else {
 147         $sector->write_data({
 148             key     => $new_key,
 149             value   => $value_sector->clone,
 150         });
 151     }
 152
 153     return;
 154 }
 155
 156 # exists returns '', not undefined.
 157 sub key_exists {
 158     my $self = shift;
 159     my ($obj, $key) = @_;
 160
 161     my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
 162         or return '';
 163
 164 #    if ( $sector->staleness != $obj->_staleness ) {
 165 #        return '';
 166 #    }
 167
 168     my $data = $sector->get_data_for({
 169 #        key_md5    => $self->_apply_digest( $key ),
 170         key        => $key,
 171         allow_head => 1,
 172     });
 173
 174     # exists() returns 1 or '' for true/false.
 175     return $data ? 1 : '';
 176 }
 177
 178 sub delete_key {
 179     my $self = shift;
 180     my ($obj, $key) = @_;
 181
 182     my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
 183         or return '';
 184
 185 #    if ( $sector->staleness != $obj->_staleness ) {
 186 #        return '';
 187 #    }
 188
 189     return $sector->delete_key({
 190 #        key_md5    => $self->_apply_digest( $key ),
 191         key        => $key,
 192         allow_head => 0,
 193     });
 194 }
 195
 196 sub write_value {
 197     my $self = shift;
 198     my ($obj, $key, $value) = @_;
 199
 200     my $r = Scalar::Util::reftype( $value ) || '';
 201     {
 202         last if $r eq '';
 203         last if $r eq 'HASH';
 204         last if $r eq 'ARRAY';
 205
 206         DBM::Deep->_throw_error(
 207             "Storage of references of type '$r' is not supported."
 208         );
 209     }
 210
 211     # Load the reference entry
 212     # Determine if the row was deleted under us
 213     #
 214
 215     my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
 216         or die "Cannot load sector at '@{[$obj->_base_offset]}'\n";;
 217
 218     my ($type, $class);
 219     if ( $r eq 'ARRAY' || $r eq 'HASH' ) {
 220         my $tmpvar;
 221         if ( $r eq 'ARRAY' ) {
 222             $tmpvar = tied @$value;
 223         } elsif ( $r eq 'HASH' ) {
 224             $tmpvar = tied %$value;
 225         }
 226
 227         if ( $tmpvar ) {
 228             my $is_dbm_deep = eval { local $SIG{'__DIE__'}; $tmpvar->isa( 'DBM::Deep' ); };
 229
 230             unless ( $is_dbm_deep ) {
 231                 DBM::Deep->_throw_error( "Cannot store something that is tied." );
 232             }
 233
 234             unless ( $tmpvar->_engine->storage == $self->storage ) {
 235                 DBM::Deep->_throw_error( "Cannot store values across DBM::Deep files. Please use export() instead." );
 236             }
 237
 238             # Load $tmpvar's sector
 239
 240             # First, verify if we're storing the same thing to this spot. If we
 241             # are, then this should be a no-op. -EJS, 2008-05-19
 242
 243             # See whether or not we are storing ourselves to ourself.
 244             # Write the sector as data in this reference (keyed by $key)
 245             my $value_sector = $self->load_sector( $tmpvar->_base_offset, 'refs' );
 246             $sector->write_data({
 247                 key     => $key,
 248 #                key_md5 => $self->_apply_digest( $key ),
 249                 value   => $value_sector,
 250             });
 251             $value_sector->increment_refcount;
 252
 253             return 1;
 254         }
 255
 256         $type = substr( $r, 0, 1 );
 257         $class = 'DBM::Deep::Sector::DBI::Reference';
 258     }
 259     else {
 260         if ( tied($value) ) {
 261             DBM::Deep->_throw_error( "Cannot store something that is tied." );
 262         }
 263
 264         $class = 'DBM::Deep::Sector::DBI::Scalar';
 265         $type  = 'S';
 266     }
 267
 268     # Create this after loading the reference sector in case something bad
 269     # happens. This way, we won't allocate value sector(s) needlessly.
 270     my $value_sector = $class->new({
 271         engine => $self,
 272         data   => $value,
 273         type   => $type,
 274     });
 275
 276     $sector->write_data({
 277         key     => $key,
 278 #        key_md5 => $self->_apply_digest( $key ),
 279         value   => $value_sector,
 280     });
 281
 282     $self->_descend( $value, $value_sector );
 283
 284     return 1;
 285 }
 286
 287 sub begin_work {
 288     my $self = shift;
 289     die "Transactions are not supported by this engine"
 290         unless $self->supports('transactions');
 291
 292     if ( $self->in_txn ) {
 293         DBM::Deep->_throw_error( "Cannot begin_work within an active transaction" );
 294     }
 295
 296     $self->storage->begin_work;
 297
 298     $self->in_txn( 1 );
 299
 300     return 1;
 301 }
 302
 303 sub rollback {
 304     my $self = shift;
 305     die "Transactions are not supported by this engine"
 306         unless $self->supports('transactions');
 307
 308     if ( !$self->in_txn ) {
 309         DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
 310     }
 311
 312     $self->storage->rollback;
 313
 314     $self->in_txn( 0 );
 315
 316     return 1;
 317 }
 318
 319 sub commit {
 320     my $self = shift;
 321     die "Transactions are not supported by this engine"
 322         unless $self->supports('transactions');
 323
 324     if ( !$self->in_txn ) {
 325         DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
 326     }
 327
 328     $self->storage->commit;
 329
 330     $self->in_txn( 0 );
 331
 332     return 1;
 333 }
 334
 335 sub in_txn {
 336     my $self = shift;
 337     $self->{in_txn} = shift if @_;
 338     $self->{in_txn};
 339 }
 340
 341 sub supports {
 342     my $self = shift;
 343     my ($feature) = @_;
 344
 345     if ( $feature eq 'transactions' ) {
 346 #        return 1 if $self->storage->driver eq 'sqlite';
 347         return;
 348     }
 349     return;
 350 }
 351
 352 sub clear {
 353     my $self = shift;
 354     my $obj = shift;
 355
 356     my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
 357         or return;
 358
 359     $sector->clear;
 360
 361     return;
 362 }
 363
 364 1;
 365 __END__