Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission	Action
Reference.pm	5.18 KB	-rw-rw-rw-
Scalar.pm	511 B	-rw-rw-rw-

Code Editor : Reference.pm

package DBM::Deep::Sector::DBI::Reference;

use 5.008_004;

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

use base 'DBM::Deep::Sector::DBI';

use Scalar::Util;

sub table { 'refs' }

sub _init {
    my $self = shift;

my $e = $self->engine;

unless ( $self->offset ) {
        my $classname = Scalar::Util::blessed( delete $self->{data} );
        $self->{offset} = $self->engine->storage->write_to(
            refs => undef,
            ref_type  => $self->type,
            classname => $classname,
        );
    }
    else {
        my ($rows) = $self->engine->storage->read_from(
            refs => $self->offset,
            qw( ref_type ),
        );

$self->{type} = $rows->[0]{ref_type};
    }

return;
}

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

my ($rows) = $self->engine->storage->read_from(
        datas => { ref_id => $self->offset, key => $args->{key} },
        qw( id ),
    );

return unless $rows->[0]{id};

$self->load(
        $self->engine,
        $rows->[0]{id},
        'datas',
    );
}

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

if ( ( $args->{value}->type || 'S' ) eq 'S' ) {
        $args->{value}{offset} = $self->engine->storage->write_to(
            datas => $args->{value}{offset},
            ref_id    => $self->offset,
            data_type => 'S',
            key       => $args->{key},
            value     => $args->{value}{data},
        );

$args->{value}->reload;
    }
    else {
        # Write the Scalar of the Reference
        $self->engine->storage->write_to(
            datas => undef,
            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;
}

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

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

sub write_refcount {
    my $self = shift;
    my ($num) = @_;
    $self->engine->storage->{dbh}->do(
        "UPDATE refs SET refcount = ? WHERE id = ?", undef,
        $num, $self->offset,
    );
}

sub clear {
    my $self = shift;

DBM::Deep->new({
        type        => $self->type,
        base_offset => $self->offset,
        storage     => $self->engine->storage,
        engine      => $self->engine,
    })->_clear;

return;
}

1;
__END__

${this.title}

Code Editor : Reference.pm