← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/libdbm-deep-perl/oneiric

« back to all changes in this revision

Viewing changes to lib/DBM/Deep.pm

  • Committer: Bazaar Package Importer
  • Author(s): Ansgar Burchardt, Ansgar Burchardt, gregor herrmann
  • Date: 2010-07-24 15:10:26 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20100724151026-377gwhxey77moumk
Tags: 2.0000-1
[ Ansgar Burchardt ]
* New upstream release.
  + This version introduces a new file format for the File backend.  It can
    still read databases from version 1.0003 and later.  See NEWS.Debian or
    upstream changelog for details.
* Remove build-dep on perl (>= 5.10) | libmodule-build-perl: stable has
  perl 5.10.
* Bump Standards-Version to 3.9.0 (no changes).

[ gregor herrmann ]
* Refresh manpage-has-bad-whatis-entry.patch.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/DBM/Deep.pm
1
1
package DBM::Deep;
2
2
 
3
 
use 5.006_000;
 
3
use 5.008_004;
4
4
 
5
5
use strict;
6
6
use warnings FATAL => 'all';
7
7
no warnings 'recursion';
8
8
 
9
 
our $VERSION = q(1.0024);
 
9
our $VERSION = q(2.0000);
10
10
 
11
11
use Scalar::Util ();
12
12
 
13
13
use overload
14
 
    '""' => sub { overload::StrVal( $_[0] ) },
 
14
   (
 
15
    '""' =>
 
16
    '0+' => sub { $_[0] },
 
17
   )[0,2,1,2], # same sub for both
15
18
    fallback => 1;
16
19
 
17
20
use constant DEBUG => 0;
21
24
sub TYPE_HASH   () { DBM::Deep::Engine->SIG_HASH  }
22
25
sub TYPE_ARRAY  () { DBM::Deep::Engine->SIG_ARRAY }
23
26
 
 
27
my %obj_cache; # In external_refs mode, all objects are registered here,
 
28
               # and dealt with in the END block at the bottom.
 
29
use constant HAVE_HUFH => scalar eval{ require Hash::Util::FieldHash };
 
30
HAVE_HUFH and Hash::Util::FieldHash::fieldhash(%obj_cache);
 
31
 
24
32
# This is used in all the children of this class in their TIE<type> methods.
25
33
sub _get_args {
26
34
    my $proto = shift;
115
123
        die $e;
116
124
    }
117
125
 
 
126
    if(  $self->{engine}->{external_refs}
 
127
     and my $sector = $self->{engine}->load_sector( $self->{base_offset} )
 
128
    ) {
 
129
        $sector->increment_refcount;
 
130
 
 
131
        Scalar::Util::weaken( my $feeble_ref = $self );
 
132
        $obj_cache{ $self } = \$feeble_ref;
 
133
 
 
134
        # Make sure this cache is not a memory hog
 
135
        if(!HAVE_HUFH) {
 
136
            for(keys %obj_cache) {
 
137
                delete $obj_cache{$_} if not ${$obj_cache{$_}};
 
138
            }
 
139
        }
 
140
    }
 
141
 
118
142
    return $self;
119
143
}
120
144
 
379
403
    return $self->_engine->supports( @_ );
380
404
}
381
405
 
 
406
sub db_version {
 
407
    shift->_get_self->_engine->db_version;
 
408
}
 
409
 
382
410
#XXX Migrate this to the engine, where it really belongs and go through some
383
411
# API - stop poking in the innards of someone else..
384
412
{
627
655
 }
628
656
}
629
657
 
 
658
sub _free {
 
659
 my $self = shift;
 
660
 if(my $sector = $self->{engine}->load_sector( $self->{base_offset} )) {
 
661
  $sector->free;
 
662
 }
 
663
}
 
664
 
 
665
sub DESTROY {
 
666
 my $self = shift;
 
667
 my $alter_ego = $self->_get_self;
 
668
 if( !$alter_ego  ||  $self != $alter_ego ) {
 
669
  return; # Don’t run the destructor twice! (What follows only applies to
 
670
 }        # the inner object, not the tie.)
 
671
 
 
672
 # If the engine is gone, the END block has beaten us to it.
 
673
 return if !$self->{engine}; 
 
674
 if(  $self->{engine}->{external_refs} ) {
 
675
  $self->_free;
 
676
 }
 
677
}
 
678
 
 
679
# Relying on the destructor alone is problematic, as the order in which
 
680
# objects are discarded is random in global destruction. So we do the
 
681
# clean-up here before preemptively before global destruction.
 
682
END {
 
683
 defined $$_ and  $$_->_free, delete $$_->{engine}
 
684
   for(values %obj_cache);
 
685
}
 
686
 
630
687
1;
631
688
__END__