view release on metacpan or  search on metacpan

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

        }

        $sector->wipe;
        $sector->free;

        if ( $redo ) {
            (undef, $sector) = %blist_cache;
            $last_sector = $new_index;
            redo;
        }

        $sector = $blist_cache{ ord( substr( $args->{key_md5}, $i, 1 ) ) };
        $sector->find_md5( $args->{key_md5} );
    }}

    return $sector;
}

sub get_class_offset {
    my $self = shift;

    my $e = $self->engine;
    return unpack(
        $StP{$e->byte_size},
        $e->storage->read_at(
            $self->offset + $self->base_size + 1 * $e->byte_size, $e->byte_size,
        ),
    );
}

sub get_classname {
    my $self = shift;

    my $class_offset = $self->get_class_offset;

    return unless $class_offset;

    return $self->engine->load_sector( $class_offset )->data;
}

# Look to hoist this method into a ::Reference trait
sub data {
    my $self = shift;
    my ($args) = @_;
    $args ||= {};

    my $engine = $self->engine;
    my $cache_entry = $engine->cache->{ $self->offset } ||= {};
    my $trans_id = $engine->trans_id;
    my $obj;
    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 ) {
                bless $obj, $classname;
            }
        }

        return $obj;
    }

    # We shouldn't export if this is still referred to.
    if ( $self->get_refcount > 1 ) {
        return $obj;
    }

    return $obj->export;
}

sub free {
    my $self = shift;

    # We're not ready to be removed yet.
    return if $self->decrement_refcount > 0;

    my $e = $self->engine;

    # Rebless the object into DBM::Deep::Null.
    # In external_refs mode, this will already have been removed from
    # the cache, so we can skip this.
    if(!$e->{external_refs}) {
#    eval { %{ $e->cache->{ $self->offset }{ $e->trans_id } } = (); };
#    eval { @{ $e->cache->{ $self->offset }{ $e->trans_id } } = (); };
      my $cache = $e->cache;
      my $off = $self->offset;
      if(  exists $cache->{ $off }
       and exists $cache->{ $off }{ my $trans_id = $e->trans_id } ) {
        bless $cache->{ $off }{ $trans_id }, 'DBM::Deep::Null'
         if defined $cache->{ $off }{ $trans_id };
        delete $cache->{ $off }{ $trans_id };
      }
    }

    my $blist_loc = $self->get_blist_loc;
    $e->load_sector( $blist_loc )->free if $blist_loc;

    my $class_loc = $self->get_class_offset;
    $e->load_sector( $class_loc )->free if $class_loc;

    $self->SUPER::free();
}

sub increment_refcount {
    my $self = shift;