libcache-perl 2.10-1 / usr / share / perl5 / Cache / Memory / Entry.pm

=head1 NAME

Cache::Memory::Entry - An entry in the memory based implementation of Cache

=head1 SYNOPSIS

  See 'Cache::Entry' for a synopsis.

=head1 DESCRIPTION

This module implements a version of Cache::Entry for the Cache::Memory variant
of Cache.  It should not be created or used directly, please see
'Cache::Memory' or 'Cache::Entry' instead.

=cut
package Cache::Memory::Entry;

require 5.006;
use strict;
use warnings;
use Cache::Memory;
use Storable;
use Carp;

use base qw(Cache::Entry);
use fields qw(store_entry);

our $VERSION = '2.10';


sub new {
    my Cache::Memory::Entry $self = shift;
    my ($cache, $key, $entry) = @_;

    $self = fields::new($self) unless ref $self;
    $self->SUPER::new($cache, $key);

    $self->{store_entry} = $entry;

    # increment the reference count for the entry
    $entry->{rc}++;

    return $self;
}

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

    # drop the reference count and signal the cache if required
    unless (--$self->{store_entry}->{rc}) {
        $self->{cache}->entry_dropped_final_rc($self->{key});
    }
}

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

    # ensure pending expiries are removed
    $self->{cache}->purge();

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

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

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

    my $exists = defined $entry->{data};
    my $orig_size;

    unless ($exists) {
        # we're creating the element
        my $time = time();

        $entry->{age_elem} = $cache->add_age_to_heap($key, $time);
        $entry->{use_elem} = $cache->add_use_to_heap($key, $time);
        $orig_size = 0;
    }
    elsif (not exists $entry->{handlelock}) {
        # only remove current size if there is no active handle
        $orig_size = length(${$entry->{data}});
    }
    else {
        $orig_size = 0;
    }

    $entry->{data} = \$data;

    # invalidate any active handles
    delete $entry->{handlelock};

    $self->_set_expiry($expiry) if $expiry or $exists;
    $cache->update_last_used($key) if $exists;

    $cache->change_size(length($data) - $orig_size);
    # ensure pending expiries are removed;
    $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
    unless (defined $entry->{data}) {
    	$self->set('');
    }

    $entry->{validity} = $data;
}


# UTILITY METHODS

sub _handle_closed {
    my Cache::Memory::Entry $self = shift;
    my ($iostring, $orig_size) = @_;
    $orig_size ||= 0;

    my $dataref = $iostring->sref();
    my $entry = $self->{store_entry};

    # ensure the data hasn't been removed or been replaced
    my $removed = !$self->exists();

    # check our handle marker
    if (defined $entry->{handlelock} and $entry->{handlelock} == $dataref) {
        delete $entry->{handlelock};
    }
    else {
        $removed = 1;
    }

    if ($removed) {
        # remove original size and discard dataref
        $self->{cache}->change_size(-$orig_size) if $orig_size;
        return;
    }

    # reinsert data
    $entry->{data} = $dataref;
    my $new_size = length(${$entry->{data}});
    if ($orig_size != $new_size) {
        $self->{cache}->change_size($new_size - $orig_size);
    }
}


1;
__END__

=head1 SEE ALSO

Cache::Entry, Cache::Memory

=head1 AUTHOR

 Chris Leishman <chris@leishman.org>
 Based on work by DeWitt Clinton <dewitt@unto.net>

=head1 COPYRIGHT

 Copyright (C) 2003-2006 Chris Leishman.  All Rights Reserved.

This module is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND,
either expressed or implied. This program is free software; you can
redistribute or modify it under the same terms as Perl itself.

$Id: Entry.pm,v 1.8 2006/01/31 15:23:58 caleishm Exp $

=cut