view release on metacpan or  search on metacpan

t/CacheAgainstFile.lib  view on Meta::CPAN

	TRACE("CALL : was $callcount");
	$callcount++;
	sleep $loaddelay if $loaddelay;
	TRACE("CALL : now $callcount for file $fn");
	return "filename:".$fn;
}; #Callback routine which logs when it's been called

############################################################################

############################################################################
# perl replacement for the touch() external command
sub touch {
	my $filename = shift;
	if (-e $filename) {
		utime(time(), time(), $filename);
	} else {
		local *X;
		open(X, ">$filename") or die "Cannot touch $filename: $!";
		close(X);
	}
}

############################################################################

############################################################################
#Puts the cache through its paces
sub test_basics
{
	my ($cache, $filename, $method, $allow_null_size) = @_;
	$method ||= $cache->{method};
	$callcount=0;

	#First time
	$cache->clear();
	ASSERT($cache->count() == 0, "$method: count on empty cache");
	# if $filename is brand new, cachefile will have same mtime
	# and we'll get two cache hits in a row, so wait a moment.
	sleep( SLEEP_INT) ;
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method: #1 cache miss");
	ASSERT($cache->count() == 1, "$method: count after a fetch");
	my $size = $cache->size();
	if($allow_null_size && not defined $size){
		ASSERT(1, "$method: skipped - size not implemented");	
	} else {
		ASSERT($cache->size() > 0, "$method: size is nonzero - ".$cache->size());
	}

	#Second time
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method: #2 cache hit");

	#Touch the file
	sleep( SLEEP_INT );
	touch( $filename );
	$callcount = 0;
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method: touch => stat & cache miss (call count $callcount)");

	#Sneak a sourcefile change in through vulnerable window
	sleep (SLEEP_INT);
	$callcount = 0;
	touch ($filename);
	$m_before = (stat($filename))[9];
	$loaddelay = 5;
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method: touch => stat & cache miss (call count $callcount)");
	# "While we were calculating", the sourcefile was modified
	$m_before++;
	(utime $m_before, $m_before, $filename) or die "couldn't posttouch $filename: $!";
	$callcount = 0;
	$cache->get($filename);
	ASSERT($callcount == 1, "window-of-vulnerability check");
	$loaddelay = 0;
	

	#Full purge
	$cache->clear();
	$callcount = 0;
	ASSERT($cache->count() == 0, "$method: count after cache is cleared");
	ASSERT(!defined $cache->size() || $cache->size() == 0, "$method: size is zero");
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method: purge => cache miss (call count $callcount)");
	$cache->clear();
}

sub test_nostat
{
	my ($cache, $filename, $method) = @_;
	$method ||= $cache->{method};
	$callcount=0;

	#First time
	$cache->clear();
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method (no stat): #1 cache miss");

	#Second time
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method (no stat): #2 cache hit");

	#Poison cache
	sleep( SLEEP_INT );
	touch($filename);
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 1, "$method (no stat): touch => no stat & cache hit (call count $callcount)");
	TRACE("Size before is: ".$cache->count());
	ASSERT($cache->count() == 1, "$method (no stat): count on stale cache");

	#Purge stale file
	$cache->purge();
	TRACE("Size after purge is: ".$cache->count());
	ASSERT($cache->count() == 0, "$method (no stat): count after purge");
	ASSERT($cache->get($filename) eq "filename:$filename" && $callcount == 2, "$method (no stat): purge => expel stale (call count $callcount)");
	$cache->clear();
}

sub test_max_items
{
	my ($cache, $dir, $max, $method) = @_;
	$method ||= $cache->{method};
	$callcount=0;

	#Fill Cache
	$cache->clear();
	for(1..$max+5)
	{
		my $filename = $dir."/file.".$_;
		touch($filename);