=head1 NAME
Cache::File::Entry - An entry in the file 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::File variant
of Cache. It should not be created or used directly, please see
'Cache::File' or 'Cache::Entry' instead.
=cut
package Cache::File::Entry;
require 5.006;
use strict;
use warnings;
use Cache::File;
use File::Spec;
use File::Path;
use File::Temp qw(tempfile);
use Fcntl qw(LOCK_EX LOCK_SH LOCK_NB);
use File::NFSLock;
use Symbol ();
use Carp;
use base qw(Cache::Entry);
use fields qw(dir path lockdetails);
our $VERSION = '2.05';
# hash of locks held my the process, keyed on path. This is useful for
# catching potential deadlocks and warning the user, and for implementing
# LOCK_NONE (which still needs to do some synchronization). Each entry will
# be an hash of { lock, type, count, lock, lockfh, linkcount }. The
# filehandle and link count is for checking when the lock has been released by
# another process.
my %PROCESS_LOCKS;
sub new {
my Cache::File::Entry $self = shift;
$self = fields::new($self) unless ref $self;
$self->SUPER::new(@_);
# get file path and store full path and containing directory
my ($dir, $file) = $self->{cache}->cache_file_path($self->{key});
$self->{dir} = $dir;
$self->{path} = File::Spec->catfile($dir, $file);
return $self;
}
sub exists {
my Cache::File::Entry $self = shift;
# ensure pending expiries are removed
$self->{cache}->purge();
return -e $self->{path};
}
sub _set {
my Cache::File::Entry $self = shift;
my ($data, $expiry) = @_;
$self->_make_path() or return;
my ($fh, $filename) = tempfile('.XXXXXXXX', DIR => $self->{dir});
binmode $fh;
print $fh $data;
close($fh);
my $time = time();
my $cache = $self->{cache};
my $key = $self->{key};
# lock indexes
$cache->lock();
my $exists = -e $self->{path};
my $orig_size;
unless ($exists) {
# we're creating the entry
$cache->create_entry($key, $time);
$cache->change_count(1);
$orig_size = 0;
}
# only remove current size if there is no active write handle
elsif ($self->_trylock(LOCK_SH)) {
$orig_size = $self->size();
$self->_unlock();
}
else {
$orig_size = 0;
}
# replace existing data
rename($filename, $self->{path});
# fix permissions of tempfile
my $mode = 0666 & ~($self->{cache}->cache_umask());
chmod $mode, $self->{path};
# invalidate any active handle locks
unlink($self->{path} . $Cache::File::LOCK_EXT);
delete $PROCESS_LOCKS{$self->{path}};
$self->_set_expiry($expiry) if $expiry or $exists;
$cache->update_last_use($key, $time) if $exists;
$cache->change_size($self->size() - $orig_size);
# ensure pending expiries are removed
$cache->purge();
$cache->unlock();
}
sub _get {
my Cache::File::Entry $self = shift;
my $cache = $self->{cache};
my $key = $self->{key};
my $exists;
my $time = time();
$cache->lock();
if ($exists = $self->exists()) {
# update last used
$cache->update_last_use($key, $time);
# lock entry for reading
$self->_lock(LOCK_SH);
}
$cache->unlock();
return undef unless $exists;
File::NFSLock::uncache($self->{path})
if $cache->cache_lock_level() == Cache::File::LOCK_NFS();
my $fh = Symbol::gensym();
my $data;
my $oldmask = umask $self->{cache}->cache_umask();
if (open($fh, $self->{path})) {
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 {
my Cache::File::Entry $self = shift;
my $cache = $self->{cache};
my $key = $self->{key};
$cache->lock();
unless (-r $self->{path}) {
$cache->unlock();
return;
}
my $index = $cache->get_index();
my $index_entries = $cache->get_index_entries($key)
or warnings::warnif('Cache', "missing index entry for $key");
delete $$index{$key};
if ($$index_entries{age}) {
my $ageheap = $cache->get_age_heap();
$ageheap->delete($$index_entries{age}, $key);
}
if ($$index_entries{lastuse}) {
my $useheap = $cache->get_use_heap();
$useheap->delete($$index_entries{lastuse}, $key);
}
if ($$index_entries{expiry}) {
my $expheap = $cache->get_exp_heap();
$expheap->delete($$index_entries{expiry}, $key)
}
my $size = 0;
if ($self->_trylock(LOCK_SH)) {
$size = (-s $self->{path});
$cache->change_size(-$size);
$self->_unlock();
}
$cache->change_count(-1);
unlink($self->{path});
# obliterate any entry lockfile
unlink($self->{path} . $Cache::File::LOCK_EXT);
delete $PROCESS_LOCKS{$self->{path}};
$cache->unlock();
return $size;
}
sub expiry {
my Cache::File::Entry $self = shift;
my $cache = $self->{cache};
$cache->lock();
my $index_entries = $cache->get_index_entries($self->{key});
$cache->unlock();
return $index_entries? $$index_entries{expiry} : undef;
}
sub _set_expiry {
my Cache::File::Entry $self = shift;
my ($time) = @_;
my $cache = $self->{cache};
my $key = $self->{key};
$cache->lock();
my $index_entries = $cache->get_index_entries($key);
unless ($index_entries) {
$cache->unlock();
croak "Cannot set expiry on non-existant entry: $key";
}
my $expheap = $cache->get_exp_heap();
$expheap->delete($$index_entries{expiry}, $key)
if $$index_entries{expiry};
$expheap->add($time, $key) if $time;
$$index_entries{expiry} = $time;
$cache->set_index_entries($key, $index_entries);
$cache->unlock();
}
sub _handle {
my Cache::File::Entry $self = shift;
my ($mode, $expiry) = @_;
# a bit of magic! Since handles hold a lock indefinitely, and the entry
# lock code doesn't do recursion (its not necessary) we could get into
# trouble. So instead we just ensure that every handle has it's own entry
# associated with it.
$self = $self->{cache}->entry($self->{key});
require Cache::File::Handle;
my $exists = -e $self->{path};
my $writing = $mode =~ />|\+/;
unless ($exists) {
# return undef unless we're writing a new entry
$writing or return undef;
# make the path
$self->_make_path();
}
my $time = time();
my $cache = $self->{cache};
my $key = $self->{key};
# lock indexes
$cache->lock();
# grab entry lock
$self->_lock($writing? LOCK_EX : LOCK_SH);
# create the attributes if the entry doesn't exist
unless ($exists) {
# we're creating the entry
$cache->create_entry($key, $time);
$cache->change_count(1);
}
# if truncating, reset expiry (or set it creating and its specified)
$cache->set_expiry($key, $expiry)
if ($expiry and not $exists) or ($mode =~/\+?>/);
$cache->update_last_use($key, $time) if $exists;
my $orig_size = $writing? ($exists? $self->size() : 0) : undef;
# open handle - entry lock will be held as self persists in the closure
my $oldmask = umask $cache->cache_umask();
my $handle = Cache::File::Handle->new($self->{path}, $mode, undef,
sub { $self->_handle_closed(shift, $orig_size); } );
umask $oldmask;
$handle or warnings::warnif('io', 'Failed to open '.$self->{path}.": $!");
$cache->unlock();
return $handle;
}
sub validity {
my Cache::File::Entry $self = shift;
my $cache = $self->{cache};
$cache->lock();
my $index_entries = $cache->get_index_entries($self->{key});
$cache->unlock();
return $index_entries? $$index_entries{validity} : undef;
}
sub set_validity {
my Cache::File::Entry $self = shift;
my ($data) = @_;
my $key = $self->{key};
my $cache = $self->{cache};
$cache->lock();
my $index_entries = $cache->get_index_entries($key);
unless ($index_entries) {
$self->set('');
$index_entries = $cache->get_index_entries($key);
}
$$index_entries{validity} = $data;
$cache->set_index_entries($key, $index_entries);
$cache->unlock();
}
# 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
my $new_size = $self->size();
(defined $new_size and $self->_check_lock()) or $new_size = 0;
# release entry lock
$self->_unlock();
# update sizes
if (defined $orig_size and $orig_size != $new_size) {
$cache->change_size($new_size - $orig_size);
}
$cache->unlock();
}
sub _make_path {
my Cache::File::Entry $self = shift;
unless (-d $self->{dir}) {
my $oldmask = umask $self->{cache}->cache_umask();
eval { mkpath($self->{dir}); };
if ($@) {
warnings::warnif('io',
'Failed to create path '.$self->{dir}.": $@");
return 0;
}
umask $oldmask;
}
return 1;
}
sub _lock {
my Cache::File::Entry $self = shift;
my ($type, $tryonly) = @_;
$type ||= LOCK_EX;
# entry already has the lock?
$self->{lockdetails} and die "entry already holding a lock";
my $path = $self->{path};
my $lock_details = $PROCESS_LOCKS{$path};
if ($lock_details) {
if ($$lock_details{type} != $type) {
$tryonly and return 0;
croak "process already holding entry lock of different type";
}
$$lock_details{count}++;
$self->{lockdetails} = $lock_details;
return 1;
}
# create new entry
$lock_details = $PROCESS_LOCKS{$path} = {};
# no need for any locking with LOCK_NONE
if ($self->{cache}->cache_lock_level() != Cache::File::LOCK_NONE()) {
local $File::NFSLock::LOCK_EXTENSION = $Cache::File::LOCK_EXT;
my $oldmask = umask $self->{cache}->cache_umask();
my $lock = File::NFSLock->new({
file => $path,
lock_type => $type | ($tryonly? LOCK_NB : 0),
stale_lock_timeout => $Cache::File::STALE_LOCK_TIMEOUT,
});
unless ($lock) {
umask $oldmask;
$tryonly and return 0;
die "Failed to obtain lock on lockfile on '$path': ".
$File::NFSLock::errstr."\n";
}
# count the number of hard links to the lockfile and open it
# if we can't reopen the lockfile then it has already been removed...
# we do the stat on the file rather than the filehandle, as otherwise
# there would be a race between opening the file and getting the link
# count (such that we could end up with a link count that is already 0).
my $fh = Symbol::gensym;
my $linkcount;
my $lockfile = $path . $Cache::File::LOCK_EXT;
if (($linkcount = (stat $lockfile)[3]) and open($fh, $lockfile)) {
$$lock_details{lock} = $lock;
$$lock_details{lockfh} = $fh;
$$lock_details{linkcount} = $linkcount;
}
else {
# lock failed - remove lock details
delete $PROCESS_LOCKS{$path};
}
umask $oldmask;
}
# lock obtained
$$lock_details{type} = $type;
$$lock_details{count} = 1;
# use lock details reference as an internal lock check
$self->{lockdetails} = $lock_details;
return 1;
}
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;
if ($self->{cache}->cache_lock_level() != Cache::File::LOCK_NONE()) {
$$lock_details{lock}->unlock;
}
delete $PROCESS_LOCKS{$self->{path}};
}
# check that we still hold our lock
sub _check_lock {
my Cache::File::Entry $self = shift;
$self->{lockdetails} or return 0;
my $lock_details = $PROCESS_LOCKS{$self->{path}}
or return 0;
# check lock details reference still matches global
$self->{lockdetails} == $lock_details
or return 0;
if ($self->{cache}->cache_lock_level() != Cache::File::LOCK_NONE()) {
# check filehandle is still connected to filesystem
my $lockfh = $$lock_details{lockfh};
if (((stat $lockfh)[3] || 0) < $$lock_details{linkcount}) {
# lock is gone
delete $PROCESS_LOCKS{$self->{path}};
return 0;
}
}
return 1;
}
1;
__END__
=head1 SEE ALSO
Cache::Entry, Cache::File
=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