Cache

 view release on metacpan or  search on metacpan

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

    # 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;
}

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

    $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}++;

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

    $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