view release on metacpan or  search on metacpan

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

            ref_id    => $self->offset,
            data_type => 'R',
            key       => $args->{key},
            value     => $args->{value}{offset},
        );
    }
}

sub delete_key {
    my $self = shift;
    my ($args) = @_;

    my $old_value = $self->get_data_for({
        key => $args->{key},
    });

    my $data;
    if ( $old_value ) {
        $data = $old_value->data({ export => 1 });

        $self->engine->storage->delete_from(
            'datas',
             { ref_id => $self->offset,
               key => $args->{key},  },
        );
        $old_value->free;
    }

    return $data;
}

sub get_classname {
    my $self = shift;
    my ($rows) = $self->engine->storage->read_from(
        'refs', $self->offset,
        qw( classname ),
    );
    return unless @$rows;
    return $rows->[0]{classname};
}

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

    my $engine = $self->engine;
    my $cache = $engine->cache;
    my $off = $self->offset;
    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 ) {
                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;

    # 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.
    my $e  = $self->engine;
    if(!$e->{external_refs}) {
        eval { %{ $e->cache->{ $self->offset } } = (); };
        eval { @{ $e->cache->{ $self->offset } } = (); };
        bless $e->cache->{ $self->offset }, 'DBM::Deep::Null';
        delete $e->cache->{ $self->offset };
    }

    $e->storage->delete_from(
        'datas', { ref_id => $self->offset },
    );

    $e->storage->delete_from(
        'datas', { value => $self->offset, data_type => 'R' },
    );

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

sub increment_refcount {
    my $self = shift;
    my $refcount = $self->get_refcount;
    $refcount++;
    $self->write_refcount( $refcount );
    return $refcount;
}