view release on metacpan or  search on metacpan

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

###############################################################################
# Purpose : Cache::AgainstFile wrapper for CPAN caching modules
# Author  : John Alden
# Created : 25 Apr 2005
# CVS     : $Id: CacheModule.pm,v 1.9 2005/10/31 21:10:41 johna Exp $
###############################################################################

package Cache::AgainstFile::CacheModule;

use strict;
use vars qw($VERSION %StatHistory);
$VERSION = sprintf"%d.%03d", q$Revision: 1.9 $ =~ /: (\d+)\.(\d+)/;

sub new {
	my ($class, $loader, $options) = @_;
	
	#Load appropriate backend class on demand
	my $backend_name = $options->{CacheModule};
	die("Package name '$backend_name' doesn't look valid") unless($backend_name =~ /^[\w:]+$/);
	eval "require $backend_name";
	die("Unable to load $backend_name - $@") if($@);

	#Wire up tracing stubs
	foreach my $stub qw(TRACE DUMP) {
		no strict 'refs';
		*{$backend_name."::".$stub} = \&{$stub} if(defined &{$backend_name."::".$stub});
	}

	my $backend = $backend_name->new($options->{CacheModuleOptions});
	my $self = {
		'loader' => $loader,
		'options' => $options,
		'backend' => $backend,
		'serialize' => _explicitly_serialize($backend),
		'stat' => \%StatHistory,
	};
	return bless $self, $class;
}

#File statting magic happens here
sub get {
	my ($self, $filename, @opts) = @_;	
	my $record = $self->_get($filename);
	my ($last_modified, $data);
	if(defined $record)
	{
		($last_modified, $data) = @$record;
		unless($self->{options}->{NoStat})
		{
			my $grace = $self->{options}->{Grace} || 0;
			my $last_checked = $self->{'stat'}{$filename} || 0;
	
			#Are we within the grace period since our last stat?
			unless($grace > time - $last_checked)
			{
				TRACE("stat: $filename");
				$data = undef if((stat($filename))[9] > $last_modified); #stat and maybe mark as stale
				$self->{'stat'}{$filename} = time;
			}
		}
	}
	unless(defined $data)
	{
		TRACE("stale: $filename");
		$data = $self->{loader}->($filename, @opts);
		$last_modified = (stat($filename))[9];
		$self->_set($filename, [$last_modified, $data]);
	}
	else
	{
		TRACE("not stale: $filename");
	}
	return $data;	
}

#Forward all other methods to backend
sub purge {
	shift()->{backend}->purge();
}

sub clear {
	shift()->{backend}->clear();
}

sub size {
	shift()->{backend}->size();
}

# Allow for slight difference in count functionality between Cache::Cache and Cache APIs
sub count {
	my $backend = shift()->{backend};
	
	#Cache:: module have a count() method
	return $backend->count() if($backend->can('count'));
	
	#Cache::Cache modules currently don't - but they do have a get_keys method
	if($backend->can('get_keys')) {
		my @keys = $backend->get_keys();
		return scalar @keys;
	}
	
	return undef;
}

# Allow for slight difference in serialization between Cache::Cache and Cache APIs
sub _set {
	my $self = shift;
	if($self->{serialize}) {
		my ($k, $v, @args) = @_;
		return $self->{backend}->freeze(@_);
	} else {
		return $self->{backend}->set(@_);
	}
}

sub _get {
	my $self = shift;
	if($self->{serialize}) {
		return $self->{backend}->thaw(@_);
	} else {
		return $self->{backend}->get(@_);		
	}	
}

sub _explicitly_serialize {
	my ($backend) = @_;