Email::MIME::CreateHTML::Resolver::Cached - wraps caching around a resource resolver

Email-MIME-CreateHTML documentation Contained in the Email-MIME-CreateHTML distribution.

Index

Code Index:

NAME

Top

Email::MIME::CreateHTML::Resolver::Cached - wraps caching around a resource resolver

SYNOPSIS

Top

	my $o = new Email::MIME::CreateHTML::Resolver::Cached(\%args)
	my ($content,$filename,$mimetype,$xfer_encoding) = $o->get_resource($uri)

DESCRIPTION

Top

This is used by Email::MIME::CreateHTML to load resources.

METHODS

Top

$o = new Email::MIME::CreateHTML::Resolver::Cached(\%args)

%args can contain:

base

Base URI to resolve URIs passed to get_resource.

object_cache (mandatory)

A cache object

resolver (mandatory)

Another resolver to apply caching to

($content,$filename,$mimetype,$xfer_encoding) = $o->get_resource($uri)

VERSION

Top

$Revision: 1.4 $ on $Date: 2006/08/24 21:41:38 $ by $Author: johna $

AUTHOR

Top

Tony Hennessy, Simon Flack and John Alden

COPYRIGHT

Top

(c) BBC 2005,2006. This program is free software; you can redistribute it and/or modify it under the GNU GPL.

See the file COPYING in this distribution, or http://www.gnu.org/licenses/gpl.txt

Email-MIME-CreateHTML documentation Contained in the Email-MIME-CreateHTML distribution. 
###############################################################################
# Purpose : Apply caching to another resolver
# Author  : John Alden
# Created : Aug 2006
# CVS     : $Header: /home/cvs/software/cvsroot/email/lib/Email/MIME/CreateHTML/Resolver/Cached.pm,v 1.4 2006/08/24 21:41:38 johna Exp $
###############################################################################

package Email::MIME::CreateHTML::Resolver::Cached;

use strict;
use Data::Serializer;
use URI::Escape;

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

sub new {
	my ($class, $args) = @_;	
	my $self = {
		'Resolver' => $args->{resolver},
		'Cache'	=> $args->{object_cache},
		'base' => $args->{base},
	};
	return bless($self, $class);
}

sub get_resource {
	my ($self, $uri) = @_;
	my $args = {'uri' => $uri, 'base' => $self->{base}, 'resolver' => ref $self->{Resolver}};
	my $key = join('&', map {$_ . '=' . URI::Escape::uri_escape($args->{$_})} grep {defined $args->{$_}} sort(keys %$args));
	my $cache = $self->{Cache};
	my $serialized = $cache->get( $key );
	my $ds = Data::Serializer->new();
	my @rv;
	if ( defined $serialized ) {
	   my $deserialized = $ds->deserialize( $serialized );
	   @rv = @$deserialized;
	}
	else {
	   @rv = $self->{Resolver}->get_resource( $uri );
	   my $serialized = $ds->serialize( \@rv );
	   $cache->set( $key,$serialized );
	}
	return @rv;
}

1;