view release on metacpan or  search on metacpan

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

        require DBM::Deep::Hash;
        tie %$self, $class, %$args;
    }

    return bless $self, $class;
}

# This initializer is called from the various TIE* methods. new() calls tie(),
# which allows for a single point of entry.
sub _init {
    my $class = shift;
    my ($args) = @_;

    # locking implicitly enables autoflush
    if ($args->{locking}) { $args->{autoflush} = 1; }

    # These are the defaults to be optionally overridden below
    my $self = bless {
        type        => TYPE_HASH,
        base_offset => undef,
        staleness   => undef,
        engine      => undef,
    }, $class;

    unless ( exists $args->{engine} ) {
        my $class =
            exists $args->{dbi}   ? 'DBM::Deep::Engine::DBI'  :
            exists $args->{_test} ? 'DBM::Deep::Engine::Test' :
                                    'DBM::Deep::Engine::File' ;

        eval "use $class"; die $@ if $@;
        $args->{engine} = $class->new({
            %{$args},
            obj => $self,
        });
    }

    # Grab the parameters we want to use
    foreach my $param ( keys %$self ) {
        next unless exists $args->{$param};
        $self->{$param} = $args->{$param};
    }

    eval {
        local $SIG{'__DIE__'};

        $self->lock_exclusive;
        $self->_engine->setup( $self );
        $self->unlock;
    }; if ( $@ ) {
        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{$_}};
            }
        }
    }

    return $self;
}

sub TIEHASH {
    shift;
    require DBM::Deep::Hash;
    return DBM::Deep::Hash->TIEHASH( @_ );
}

sub TIEARRAY {
    shift;
    require DBM::Deep::Array;
    return DBM::Deep::Array->TIEARRAY( @_ );
}

sub lock_exclusive {
    my $self = shift->_get_self;
    return $self->_engine->lock_exclusive( $self, @_ );
}
*lock = \&lock_exclusive;

sub lock_shared {
    my $self = shift->_get_self;
    # cluck() the problem with cached File objects.
    unless ( $self->_engine ) {
        require Carp;
        require Data::Dumper;
        Carp::cluck( Data::Dumper->Dump( [$self], ['self'] ) );
    }
    return $self->_engine->lock_shared( $self, @_ );
}

sub unlock {
    my $self = shift->_get_self;
    return $self->_engine->unlock( $self, @_ );
}

sub _copy_value {
    my $self = shift->_get_self;
    my ($spot, $value) = @_;

    if ( !ref $value ) {
        ${$spot} = $value;
    }
    else {
        my $r = Scalar::Util::reftype( $value );
        my $tied;
        if ( $r eq 'ARRAY' ) {
            $tied = tied(@$value);
        }