Cache

 view release on metacpan or  search on metacpan

lib/Cache/File.pm  view on Meta::CPAN

sub entry {
    my Cache::File $self = shift;
    my ($key) = @_;
    return Cache::File::Entry->new($self, $key);
}

sub purge {
    my Cache::File $self = shift;
    my $time = time();

    # if it's locked, someone else will probably be doing a purge already
    $self->trylock() or return;

    # open expiry index
    my $expheap = $self->get_exp_heap();

    # check for expiry
    my $minimum = $expheap->minimum();
    if ($minimum and $minimum <= $time) {
        # open other indexes
        my $ageheap = $self->get_age_heap();

lib/Cache/File.pm  view on Meta::CPAN

    return 1;
}

sub trylock {
    my Cache::File $self = shift;
    return $self->lock(1);
}

sub unlock {
    my Cache::File $self = shift;
    $self->{lock} or croak "not locked";
    return unless --$self->{lockcount} == 0;

    # close heaps and save counts
    $self->{openexp} = undef;
    $self->{openage} = undef;
    $self->{openuse} = undef;
    $self->{openidx} = undef;

    # unlock
    $self->{lock}->unlock unless $self->{locklevel} == LOCK_NONE;

lib/Cache/File.pm  view on Meta::CPAN

    $$index_entries{age} and $$index_entries{lastuse}
        or croak "failed to supply age and lastuse for index update on $key";

    my $index = $self->get_index();
    $$index{$key} = Storable::nfreeze($index_entries);
}

sub get_index {
    my Cache::File $self = shift;
    unless ($self->{openidx}) {
        $self->{lock} or croak "not locked";

        my $indexfile = $self->{index};
        File::NFSLock::uncache($indexfile) if $self->{locklevel} == LOCK_NFS;

        my $oldmask = umask $self->cache_umask();
        my %indexhash;
        my $index =
            tie %indexhash, 'DB_File', $indexfile,O_CREAT|O_RDWR,0666,$DB_HASH;
        umask $oldmask;

lib/Cache/File.pm  view on Meta::CPAN

}

sub get_use_heap {
    my Cache::File $self = shift;
    return $self->{openuse} ||= $self->_open_heap($self->{useheap});
}

sub _open_heap {
    my Cache::File $self = shift;
    my ($heapfile) = @_;
    $self->{lock} or croak "not locked";

    File::NFSLock::uncache($heapfile) if $self->{locklevel} == LOCK_NFS;

    my $oldmask = umask $self->cache_umask();
    my $heap = Cache::File::Heap->new($heapfile);
    umask $oldmask;
    $heap or die "Failed to open heap $heapfile: $!";
    return $heap;
}

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

        binmode $fh;

        # slurp mode
        local $/;
        $data = <$fh>;

        close($fh);
    }
    umask $oldmask;

    # shared locks can be unlocked without holding cache lock
    $self->_unlock();
    return $data;
}

sub size {
    my Cache::File::Entry $self = shift;
    return -s $self->{path};
}

sub remove {

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

}


# UTILITY METHODS

sub _handle_closed {
    my Cache::File::Entry $self = shift;
    my ($handle, $orig_size) = @_;

    unless (defined $orig_size) {
        # shared locks can be unlocked without holding cache lock
        $self->_unlock();
        return;
    }

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

    $cache->lock();

    # check if file still exists and our lock is still valid. this order is
    # used to prevent a race between checking lock and getting size

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

sub _trylock {
    my Cache::File::Entry $self = shift;
    my ($type) = @_;
    return $self->_lock($type, 1);
}

sub _unlock {
    my Cache::File::Entry $self = shift;

    $self->{lockdetails} or die 'not locked';

    # is our lock still valid?
    $self->_check_lock() or return;

    $self->{lockdetails} = undef;

    my $lock_details = $PROCESS_LOCKS{$self->{path}};
    --$$lock_details{count} == 0
        or return;

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

    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;