1 package DBM::Deep::Engine::DBI;
6 use warnings FATAL => 'all';
8 use base 'DBM::Deep::Engine';
10 use DBM::Deep::Sector::DBI ();
11 use DBM::Deep::Storage::DBI ();
13 sub sector_type { 'DBM::Deep::Sector::DBI' }
14 sub iterator_class { 'DBM::Deep::Iterator::DBI' }
20 $args->{storage} = DBM::Deep::Storage::DBI->new( $args )
21 unless exists $args->{storage};
27 # Grab the parameters we want to use
28 foreach my $param ( keys %$self ) {
29 next unless exists $args->{$param};
30 $self->{$param} = $args->{$param};
40 # Default the id to 1. This means that we will be creating a row if there
41 # isn't one. The assumption is that the row_id=1 cannot never be deleted. I
42 # don't know if this is a good assumption.
43 $obj->{base_offset} ||= 1;
45 my ($rows) = $self->storage->read_from(
46 refs => $obj->_base_offset,
50 # We don't have a row yet.
52 $self->storage->write_to(
53 refs => $obj->_base_offset,
54 ref_type => $obj->_type,
58 my $sector = DBM::Deep::Sector::DBI::Reference->new({
60 offset => $obj->_base_offset,
68 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
71 # if ( $sector->staleness != $obj->_staleness ) {
75 # my $key_md5 = $self->_apply_digest( $key );
77 my $value_sector = $sector->get_data_for({
79 # key_md5 => $key_md5,
83 unless ( $value_sector ) {
84 $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
91 # key_md5 => $key_md5,
93 value => $value_sector,
97 return $value_sector->data;
104 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
107 return $sector->get_classname;
112 my ($obj, $old_key, $new_key) = @_;
114 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
117 # if ( $sector->staleness != $obj->_staleness ) {
121 my $value_sector = $sector->get_data_for({
126 unless ( $value_sector ) {
127 $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
132 $sector->write_data({
134 value => $value_sector,
138 if ( $value_sector->isa( 'DBM::Deep::Sector::DBI::Reference' ) ) {
139 $sector->write_data({
141 value => $value_sector,
143 $value_sector->increment_refcount;
146 $sector->write_data({
148 value => $value_sector->clone,
155 # exists returns '', not undefined.
158 my ($obj, $key) = @_;
160 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
163 # if ( $sector->staleness != $obj->_staleness ) {
167 my $data = $sector->get_data_for({
168 # key_md5 => $self->_apply_digest( $key ),
173 # exists() returns 1 or '' for true/false.
174 return $data ? 1 : '';
179 my ($obj, $key) = @_;
181 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
184 # if ( $sector->staleness != $obj->_staleness ) {
188 return $sector->delete_key({
189 # key_md5 => $self->_apply_digest( $key ),
197 my ($obj, $key, $value) = @_;
199 my $r = Scalar::Util::reftype( $value ) || '';
202 last if $r eq 'HASH';
203 last if $r eq 'ARRAY';
205 DBM::Deep->_throw_error(
206 "Storage of references of type '$r' is not supported."
210 # Load the reference entry
211 # Determine if the row was deleted under us
214 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
215 or die "Cannot load sector at '@{[$obj->_base_offset]}'\n";;
218 if ( $r eq 'ARRAY' || $r eq 'HASH' ) {
220 if ( $r eq 'ARRAY' ) {
221 $tmpvar = tied @$value;
222 } elsif ( $r eq 'HASH' ) {
223 $tmpvar = tied %$value;
227 my $is_dbm_deep = eval { local $SIG{'__DIE__'}; $tmpvar->isa( 'DBM::Deep' ); };
229 unless ( $is_dbm_deep ) {
230 DBM::Deep->_throw_error( "Cannot store something that is tied." );
233 unless ( $tmpvar->_engine->storage == $self->storage ) {
234 DBM::Deep->_throw_error( "Cannot store values across DBM::Deep files. Please use export() instead." );
237 # Load $tmpvar's sector
239 # First, verify if we're storing the same thing to this spot. If we
240 # are, then this should be a no-op. -EJS, 2008-05-19
242 # See whether or not we are storing ourselves to ourself.
243 # Write the sector as data in this reference (keyed by $key)
244 my $value_sector = $self->load_sector( $tmpvar->_base_offset, 'refs' );
245 $sector->write_data({
247 # key_md5 => $self->_apply_digest( $key ),
248 value => $value_sector,
250 $value_sector->increment_refcount;
255 $type = substr( $r, 0, 1 );
256 $class = 'DBM::Deep::Sector::DBI::Reference';
259 if ( tied($value) ) {
260 DBM::Deep->_throw_error( "Cannot store something that is tied." );
263 $class = 'DBM::Deep::Sector::DBI::Scalar';
267 # Create this after loading the reference sector in case something bad
268 # happens. This way, we won't allocate value sector(s) needlessly.
269 my $value_sector = $class->new({
275 $sector->write_data({
277 # key_md5 => $self->_apply_digest( $key ),
278 value => $value_sector,
281 # This code is to make sure we write all the values in the $value to the
282 # disk and to make sure all changes to $value after the assignment are
283 # reflected on disk. This may be counter-intuitive at first, but it is
285 # NOTE - simply tying $value won't perform a STORE on each value. Hence,
286 # the copy to a temp value.
287 if ( $r eq 'ARRAY' ) {
289 tie @$value, 'DBM::Deep', {
290 base_offset => $value_sector->offset,
291 staleness => $value_sector->staleness,
292 storage => $self->storage,
296 bless $value, 'DBM::Deep::Array' unless Scalar::Util::blessed( $value );
298 elsif ( $r eq 'HASH' ) {
300 tie %$value, 'DBM::Deep', {
301 base_offset => $value_sector->offset,
302 staleness => $value_sector->staleness,
303 storage => $self->storage,
308 bless $value, 'DBM::Deep::Hash' unless Scalar::Util::blessed( $value );
316 die "Transactions are not supported by this engine"
317 unless $self->supports('transactions');
319 if ( $self->in_txn ) {
320 DBM::Deep->_throw_error( "Cannot begin_work within an active transaction" );
323 $self->storage->begin_work;
332 die "Transactions are not supported by this engine"
333 unless $self->supports('transactions');
335 if ( !$self->in_txn ) {
336 DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
339 $self->storage->rollback;
348 die "Transactions are not supported by this engine"
349 unless $self->supports('transactions');
351 if ( !$self->in_txn ) {
352 DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
355 $self->storage->commit;
364 $self->{in_txn} = shift if @_;
372 if ( $feature eq 'transactions' ) {
373 # return 1 if $self->storage->driver eq 'sqlite';