view release on metacpan or  search on metacpan

t/CacheAgainstFile-Storable.t  view on Meta::CPAN

#!/usr/local/bin/perl
use strict;
use Test::Assertions qw(test);
use Log::Trace;
use Getopt::Std;
use File::Path;

use vars qw($opt_t $opt_T $opt_d);
getopts('tTd');

plan tests => 39;

#Move into the t directory
chdir($1) if ($0 =~ /(.*)(\/|\\)(.*)/);
use lib qw(.);

#Load the library of tests
use constant SLEEP_INT => 2;
use vars qw($callcount $callback);
require "CacheAgainstFile.lib";

#Compile
unshift @INC, "../lib";
require Cache::AgainstFile;
require Cache::AgainstFile::Storable;
ASSERT(1, "compiled version $Cache::AgainstFile::Storable::VERSION");

#Log::Trace
import Log::Trace qw(print) if($opt_t);
deep_import Log::Trace qw(print) if($opt_T);

#Test directories
my $dir = "data";
my $cache_dir = './cache';
my $filename = "$dir/foo.dat";

#Set up test env
mkpath($dir);
touch($filename);

goto trans if($opt_d);

############################################################################
### Disk caching
############################################################################
my $disk_cache = new Cache::AgainstFile($callback, {Method => 'Storable', 'CacheDir' => $cache_dir});
ASSERT($disk_cache->{method} eq 'Storable', "Storable caching");
test_basics($disk_cache, $filename);
$disk_cache = new Cache::AgainstFile($callback, {Method => 'Storable', 'CacheDir' => $cache_dir."/", 'NoStat' => 1, Locking => 'Flock'});
test_nostat($disk_cache, $filename);
$disk_cache = new Cache::AgainstFile($callback, {Method => 'Storable', 'CacheDir' => $cache_dir, 'MaxItems' => 2, Locking => 'AtomicWrite'});
test_max_items($disk_cache, $dir, 2);

#delete the cache dir so we have to create it
rmtree($cache_dir);
$disk_cache = new Cache::AgainstFile($callback, {Method => 'Cache::AgainstFile::Storable', 'CacheDir' => $cache_dir, 'MaxATime' => (2.5 * SLEEP_INT)}); #fq backend
rmtree($cache_dir); #delete underneath cache
ASSERT(DIED(sub {
	$disk_cache->count()
}) && $@ =~ /unable to open directory/, "failed dir read raises exception");
mkpath($cache_dir); #mend it again
test_old_items($disk_cache, $dir, 5, 3);

# do the same but during a get() request
rmtree($cache_dir);
$disk_cache = new Cache::AgainstFile(sub {}, {Method => 'Storable', 'CacheDir' => $cache_dir, Locking=>'AtomicWrite', MaxATime => SLEEP_INT});
$disk_cache->get($filename);
ASSERT(-e $cache_dir && -d _, "Directory was created on demand");
sleep 2*SLEEP_INT;
$disk_cache->purge;
rmtree($cache_dir);
ASSERT(! -e $cache_dir, "Directory no longer exists");
$disk_cache->get($filename);
# the above get() will die() if the test fails, so we just need to check we've got this far
ASSERT('ok', "get() method successfully recreated directory on demand");

############################################################################
### Error trapping
############################################################################

ASSERT(DIED(sub {
	new Cache::AgainstFile::Storable(sub {}, {})
}) && $@ =~ /You must supply a cache directory/, "no cache dir raises exception");

ASSERT(DIED(sub {
	new Cache::AgainstFile::Storable(sub {}, {CacheDir => $cache_dir, Locking => 'Garbage'})
}) && $@ =~ /Unrecognised locking model/, "invalid locking strategy raises exception");

############################################################################
### Filename translation testing
############################################################################

trans:

$disk_cache = Cache::AgainstFile::Storable->new(sub {}, {'CacheDir' => $cache_dir});
my @trans = (
	['x', "x", "plain file"],
	['x/y', "x%2Fy", "file in subdir"],
	['/x/:y!', "%2Fx%2F%3Ay%21", "file with wierd chars in name"],
	['/h/s/d%x', "%2Fh%2Fs%2Fd%25x", "file with esc char in name"],
	['C:/Temp/baz', "C%3A%2FTemp%2Fbaz", "Win32 drive letter"],
);

foreach my $row (@trans) {
	my ($k, $v, $desc) = @$row;
	my $rv = $disk_cache->_filename2cache($k);
	TRACE("got $rv (expected $v)");
	ASSERT(scalar $rv =~ /\Q$v\E$/i, "$desc - filename2cache");
	$rv = $disk_cache->_cache2filename($rv);
	ASSERT(scalar $rv =~ /\Q$k\E$/i, "$desc - cache2filename");