[cgiapp] RFC: CGI::Application::RunModeCache

["Brian Cassidy" <suppressed>]

Hi All,

Something I've been wanting for a while now is a generic caching system to
plug in to CGI::Application. For example, I have a CGI::App which uses
Gedcom.pm. Some of its operations can be quite lengthy, thus caching would
be wise.

The following is what I might consider a workable first step.

Notes:

I've hooked on to the prerun and postrun methods as my caching points.

Cache::FileCache is used by default, but you can pass in your own Cache::*
to replace it.

HTTP::Message objects are used to encapsulate the cached data.

Extra hooks are provided for controlling what exactly gets cached and what
happens when things are taken out of the cache (cache_in() and cache_out()).
You might use these hooks to remove cookie headers from being cached. 

You can override cache_key to accomplish two things: tell the app which
pages not to cache (but returning undef in that instance) and define your
own cache keys (currently based on the URL).

Comments?

--

package CGI::Application::RunModeCache;

our $VERSION = '0.01';

use base qw( CGI::Application );

use strict;
#use warnings;
#use diagnostics;

use Data::Dumper;
use HTTP::Message;
use Cache::FileCache;
use File::Spec;

sub cgiapp_prerun {
	my $self    = shift;
	my $cache   = $self->cache;
	my $key     = $self->cache_key;

	return unless defined $key;

	my $message = $cache->get( $key );

	return unless defined $message;

	{
		no strict 'vars';
		$message = eval( $cache->get( $key ) );
	}

	$self->cache_out( $message );
	print $message->as_string;
	$self->teardown;		
	exit( 0 );
}

sub cgiapp_postrun {
	my $self        = shift;
	my $content_ref = shift;
	my $key         = $self->cache_key;

	return unless defined $key;

	my $message     = HTTP::Message->parse( $self->_send_headers .
$$content_ref );

	$self->cache_in( $message );
	$self->cache->set( $key => Dumper $message );
}

sub cache_in {
	# nothing yet
}

sub cache_out {
	# nothing yet
}

sub cache_key {
	my $self = shift;
	return $self->query->self_url;
}

sub cache {
	my $self  = shift;
	my $cache = shift;

	unless( $self->{ _CACHE } or $cache ) {
		$cache = Cache::FileCache->new( {
			cache_root         => File::Spec->tmpdir,
			namespace          => 'CACHE',
			default_expires_in => 10080
		} ) or die "Error initializing cache: $!";
	}

	$self->{ _CACHE } = $cache if $cache;

	return $self->{ _CACHE };
}

1;


http://www.gordano.com - Messaging for educators.

---------------------------------------------------------------------
Web Archive:  http://www.mail-archive.com/suppressed/
              http://marc.theaimsgroup.com/?l=cgiapp&r=1&w=2
To unsubscribe, e-mail: suppressed
For additional commands, e-mail: suppressed