DBM-Deep

 view release on metacpan or  search on metacpan

lib/DBM/Deep.pm  view on Meta::CPAN

        my $e = $@;
        eval { local $SIG{'__DIE__'}; $self->unlock; };
        die $e;
    }

    if(  $self->{engine}->{external_refs}
     and my $sector = $self->{engine}->load_sector( $self->{base_offset} )
    ) {
        $sector->increment_refcount;

        Scalar::Util::weaken( my $feeble_ref = $self );
        $obj_cache{ $self } = \$feeble_ref;

        # Make sure this cache is not a memory hog
        if(!HAVE_HUFH) {
            for(keys %obj_cache) {
                delete $obj_cache{$_} if not ${$obj_cache{$_}};
            }
        }
    }

lib/DBM/Deep/Iterator.pm  view on Meta::CPAN

sub new {
    my $class = shift;
    my ($args) = @_;

    my $self = bless {
        engine      => $args->{engine},
        base_offset => $args->{base_offset},
    }, $class;

    Scalar::Util::weaken( $self->{engine} );

    $self->reset;

    return $self;
}

=head2 reset()

This method takes no arguments.

lib/DBM/Deep/Sector.pm  view on Meta::CPAN

use 5.008_004;

use strict;
use warnings FATAL => 'all';

use Scalar::Util ();

sub new {
    my $self = bless $_[1], $_[0];
    Scalar::Util::weaken( $self->{engine} );
    $self->_init;
    return $self;
}

sub _init {}

sub clone {
    my $self = shift;
    return ref($self)->new({
        engine => $self->engine,

lib/DBM/Deep/Sector/DBI/Reference.pm  view on Meta::CPAN

    my $obj;
    if ( !defined $cache->{ $off } ) {
        $obj = DBM::Deep->new({
            type        => $self->type,
            base_offset => $self->offset,
            storage     => $engine->storage,
            engine      => $engine,
        });

        $cache->{$off} = $obj;
        Scalar::Util::weaken($cache->{$off});
    }
    else {
        $obj = $cache->{$off};
    }

    # We're not exporting, so just return.
    unless ( $args->{export} ) {
        if ( $engine->storage->{autobless} ) {
            my $classname = $self->get_classname;
            if ( defined $classname ) {

lib/DBM/Deep/Sector/File/Reference.pm  view on Meta::CPAN

    if ( !defined $$cache_entry{ $trans_id } ) {
        $obj = DBM::Deep->new({
            type        => $self->type,
            base_offset => $self->offset,
            staleness   => $self->staleness,
            storage     => $engine->storage,
            engine      => $engine,
        });

        $$cache_entry{ $trans_id } = $obj;
        Scalar::Util::weaken($$cache_entry{ $trans_id });
    }
    else {
        $obj = $$cache_entry{ $trans_id };
    }

    # We're not exporting, so just return.
    unless ( $args->{export} ) {
        if ( $engine->storage->{autobless} ) {
            my $classname = $self->get_classname;
            if ( defined $classname ) {

t/52_memory_leak.t  view on Meta::CPAN

use common qw( new_dbm );

# RT #77746
my $dbm_factory = new_dbm();
while ( my $dbm_maker = $dbm_factory->() ) {
    my $db = $dbm_maker->();

    $db->{foo} = {};
    my $data = $db->{foo};

    use Scalar::Util 'weaken';
    weaken $db;
    weaken $data;

    is $db, undef, 'no $db after weakening';
    is $data, undef, 'hashes returned from db contain no circular refs';
}
    


# This was discussed here:
# http://groups.google.com/group/DBM-Deep/browse_thread/thread/a6b8224ffec21bab
# brought up by Alex Gallichotte

SKIP: {

utils/lib/DBM/Deep/10002.pm  view on Meta::CPAN

sub new {
    my $class = shift;
    my ($args) = @_;

    my $self = bless {
        breadcrumbs => [],
        engine      => $args->{engine},
        base_offset => $args->{base_offset},
    }, $class;

    Scalar::Util::weaken( $self->{engine} );

    return $self;
}

sub reset { $_[0]{breadcrumbs} = [] }

sub get_sector_iterator {
    my $self = shift;
    my ($loc) = @_;

utils/lib/DBM/Deep/10002.pm  view on Meta::CPAN

    }) or return;

    #XXX Do we want to add corruption checks here?
    return $self->{sector}->get_key_for( $idx )->data;
}

package DBM::Deep::10002::Engine::Sector;

sub new {
    my $self = bless $_[1], $_[0];
    Scalar::Util::weaken( $self->{engine} );
    $self->_init;
    return $self;
}

#sub _init {}
#sub clone { DBM::Deep::10002->_throw_error( "Must be implemented in the child class" ); }

sub engine { $_[0]{engine} }
sub offset { $_[0]{offset} }
sub type   { $_[0]{type} }