view release on metacpan or  search on metacpan

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

    # 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 {