1 package DBM::Deep::Engine::DBI;
6 use warnings FATAL => 'all';
7 no warnings 'recursion';
9 use base 'DBM::Deep::Engine';
11 use DBM::Deep::Sector::DBI ();
12 use DBM::Deep::Storage::DBI ();
14 sub sector_type { 'DBM::Deep::Sector::DBI' }
15 sub iterator_class { 'DBM::Deep::Iterator::DBI' }
21 $args->{storage} = DBM::Deep::Storage::DBI->new( $args )
22 unless exists $args->{storage};
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};
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;
46 my ($rows) = $self->storage->read_from(
47 refs => $obj->_base_offset,
51 # We don't have a row yet.
53 $self->storage->write_to(
54 refs => $obj->_base_offset,
55 ref_type => $obj->_type,
59 my $sector = DBM::Deep::Sector::DBI::Reference->new({
61 offset => $obj->_base_offset,
69 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
72 # if ( $sector->staleness != $obj->_staleness ) {
76 # my $key_md5 = $self->_apply_digest( $key );
78 my $value_sector = $sector->get_data_for({
80 # key_md5 => $key_md5,
84 unless ( $value_sector ) {
85 $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
92 # key_md5 => $key_md5,
94 value => $value_sector,
98 return $value_sector->data;
105 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
108 return $sector->get_classname;
113 my ($obj, $old_key, $new_key) = @_;
115 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
118 # if ( $sector->staleness != $obj->_staleness ) {
122 my $value_sector = $sector->get_data_for({
127 unless ( $value_sector ) {
128 $value_sector = DBM::Deep::Sector::DBI::Scalar->new({
133 $sector->write_data({
135 value => $value_sector,
139 if ( $value_sector->isa( 'DBM::Deep::Sector::DBI::Reference' ) ) {
140 $sector->write_data({
142 value => $value_sector,
144 $value_sector->increment_refcount;
147 $sector->write_data({
149 value => $value_sector->clone,
156 # exists returns '', not undefined.
159 my ($obj, $key) = @_;
161 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
164 # if ( $sector->staleness != $obj->_staleness ) {
168 my $data = $sector->get_data_for({
169 # key_md5 => $self->_apply_digest( $key ),
174 # exists() returns 1 or '' for true/false.
175 return $data ? 1 : '';
180 my ($obj, $key) = @_;
182 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
185 # if ( $sector->staleness != $obj->_staleness ) {
189 return $sector->delete_key({
190 # key_md5 => $self->_apply_digest( $key ),
198 my ($obj, $key, $value) = @_;
200 my $r = Scalar::Util::reftype( $value ) || '';
203 last if $r eq 'HASH';
204 last if $r eq 'ARRAY';
206 DBM::Deep->_throw_error(
207 "Storage of references of type '$r' is not supported."
211 # Load the reference entry
212 # Determine if the row was deleted under us
215 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )
216 or die "Cannot load sector at '@{[$obj->_base_offset]}'\n";;
219 if ( $r eq 'ARRAY' || $r eq 'HASH' ) {
221 if ( $r eq 'ARRAY' ) {
222 $tmpvar = tied @$value;
223 } elsif ( $r eq 'HASH' ) {
224 $tmpvar = tied %$value;
228 my $is_dbm_deep = eval { local $SIG{'__DIE__'}; $tmpvar->isa( 'DBM::Deep' ); };
230 unless ( $is_dbm_deep ) {
231 DBM::Deep->_throw_error( "Cannot store something that is tied." );
234 unless ( $tmpvar->_engine->storage == $self->storage ) {
235 DBM::Deep->_throw_error( "Cannot store values across DBM::Deep files. Please use export() instead." );
238 # Load $tmpvar's sector
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
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({
248 # key_md5 => $self->_apply_digest( $key ),
249 value => $value_sector,
251 $value_sector->increment_refcount;
256 $type = substr( $r, 0, 1 );
257 $class = 'DBM::Deep::Sector::DBI::Reference';
260 if ( tied($value) ) {
261 DBM::Deep->_throw_error( "Cannot store something that is tied." );
264 $class = 'DBM::Deep::Sector::DBI::Scalar';
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({
276 $sector->write_data({
278 # key_md5 => $self->_apply_digest( $key ),
279 value => $value_sector,
282 $self->_descend( $value, $value_sector );
289 # die "Transactions are not supported by this engine"
290 # unless $self->supports('transactions');
292 # if ( $self->in_txn ) {
293 # DBM::Deep->_throw_error( "Cannot begin_work within an active transaction" );
296 # $self->storage->begin_work;
298 # $self->in_txn( 1 );
305 # die "Transactions are not supported by this engine"
306 # unless $self->supports('transactions');
308 # if ( !$self->in_txn ) {
309 # DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
312 # $self->storage->rollback;
314 # $self->in_txn( 0 );
321 # die "Transactions are not supported by this engine"
322 # unless $self->supports('transactions');
324 # if ( !$self->in_txn ) {
325 # DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
328 # $self->storage->commit;
330 # $self->in_txn( 0 );
337 # $self->{in_txn} = shift if @_;
345 return if $feature eq 'transactions';
346 return 1 if $feature eq 'singletons';
354 my $sector = $self->load_sector( $obj->_base_offset, 'refs' )