view release on metacpan or  search on metacpan

lib/Cache/AgainstFile/Storable.pm  view on Meta::CPAN

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
        my ($loader, $options) = @_;    
        my $self = $class->SUPER::new(@_);
 
        my $dir = $self->{options}->{CacheDir} || croak("You must supply a cache directory for caching with Storable");
        check_safe($dir,"w") if(HAVE_FILE_POLICY);
        _create_dir_if_required($dir);
         
        #Select locking implementation
        my $locking = $options->{Locking} || 'AtomicWrite';
        if($locking eq 'Flock') {
                $self->{write} = \&_write_locked;
                $self->{read} = \&_read_locked;
        } elsif ($locking eq 'AtomicWrite') {
                $self->{write} = \&_write_atomic;
                $self->{read} = \&_read;
        } else {
                croak("Unrecognised locking model '$locking'"); 
        }
 
        return $self;
}

lib/Cache/AgainstFile/Storable.pm  view on Meta::CPAN

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
        my @files = grep {$_ !~ /^\./} readdir(FH);
        closedir FH;
        DUMP("cache files", \@files);
        return \@files;
}
 
#
# Subroutines
#
 
sub _read_locked {
        my($cache_filename, $fh) = @_;
        # we don't want the filehandle. Suppose it might need to be closed
        # under Win32? Close it anyway
        $fh->close if $fh;
        check_safe($cache_filename,"r") if(HAVE_FILE_POLICY);
        my $ref_data = lock_retrieve($cache_filename);
        TRACE("Fetched from cache file: $cache_filename");
        return $$ref_data;      
}
 
sub _write_locked {
        my ($cache_filename, $data, $mtime) = @_;
        check_safe($cache_filename,"w") if(HAVE_FILE_POLICY);
        lock_store(\$data, $cache_filename);
        TRACE("wrote cache file: $cache_filename");
        _backtouch($cache_filename, $mtime);
}
 
sub _write_atomic {
        my ($cache_filename, $data, $mtime) = @_;
        check_safe($cache_filename,"w") if(HAVE_FILE_POLICY);