view release on metacpan or  search on metacpan

lib/Cache/Memory/Entry.pm  view on Meta::CPAN

    $cache->purge();
}

sub _get {
    my Cache::Memory::Entry $self = shift;

    $self->exists() or return undef;

    my $entry = $self->{store_entry};

    $entry->{handlelock}
        and warnings::warnif('Cache', 'get called whilst write handle is open');

    $self->{cache}->update_last_used($self->{key});

    return ${$self->{store_entry}->{data}};
}

sub size {
    my Cache::Memory::Entry $self = shift;
    defined $self->{store_entry}->{data}
        or return undef;
    return length(${$self->{store_entry}->{data}});
}

sub remove {
    my Cache::Memory::Entry $self = shift;
    # send remove request directly to cache object
    return $self->{cache}->remove($self->{key});
}

sub expiry {
    my Cache::Memory::Entry $self = shift;
    $self->exists() or return undef;
    my $exp_elem = $self->{store_entry}->{exp_elem}
        or return undef;
    return $exp_elem->val();
}

sub _set_expiry {
    my Cache::Memory::Entry $self = shift;
    my ($time) = @_;

    my $cache = $self->{cache};
    my $entry = $self->{store_entry};

    defined $entry->{data}
        or croak "Cannot set expiry on non-existant entry: $self->{key}";

    my $exp_elem = $entry->{exp_elem};

    if ($exp_elem) {
        $cache->del_expiry_from_heap($self->{key}, $exp_elem);
        $entry->{exp_elem} = undef;
    }

    return unless $time;
    $entry->{exp_elem} = $cache->add_expiry_to_heap($self->{key}, $time);
}

# create a handle.  The entry is 'locked' via the use of a 'handlelock'
# element.  The current data reference is reset to an empty string whilst the
# handle is active to allow set and remove to work correctly without
# corrupting size tracking.  If set or remove are used to change the entry,
# this is detected when the handle is closed again and the size is adjusted
# (downwards) and the original data discarded.
sub _handle {
    my Cache::Memory::Entry $self = shift;
    my ($mode, $expiry) = @_;

    require Cache::IOString;

    my $writing = $mode =~ />|\+/;
    my $entry = $self->{store_entry};

    # set the entry to a empty string if the entry doesn't exist or
    # should be truncated
    if (not defined $entry->{data} or $mode =~ /^\+?>$/) {
        # return undef unless we're writing to the string
        $writing or return undef;
        $self->_set('', $expiry);
    }
    else {
        $self->{cache}->update_last_used($self->{key});
    }

    my $dataref = $entry->{data};

    if ($writing) {
        exists $entry->{handlelock}
            and croak "Write handle already active for this entry";

        my $orig_size = length($$dataref);

        # replace data with empty string whilst handle is active
        $entry->{handlelock} = $dataref;

        return Cache::IOString->new($dataref, $mode,
            sub { $self->_handle_closed(shift, $orig_size); });
    }
    else {
        return Cache::IOString->new($dataref, $mode);
    }
}

sub validity {
    my Cache::Memory::Entry $self = shift;
    $self->exists() or return undef;
    my $validity = $self->{store_entry}->{validity};
    # return a clone of the validity if it's a reference
    return Storable::dclone($validity) if ref($validity);
    return $validity;
}

sub set_validity {
    my Cache::Memory::Entry $self = shift;
    my ($data) = @_;

    my $entry = $self->{store_entry};

    # ensure data is not undefined