File Coverage

lib/Email/MIME/CreateHTML/Resolver/Cached.pm
Criterion Covered Total %
statement 28 28 100.0
branch 2 2 100.0
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 37 37 100.0


line stmt bran cond sub pod time code
1             ###############################################################################
2             # Purpose : Apply caching to another resolver
3             # Author : John Alden
4             # Created : Aug 2006
5             ###############################################################################
6              
7             package Email::MIME::CreateHTML::Resolver::Cached;
8              
9 3     3   11 use strict;
  3         6  
  3         103  
10 3     3   1476 use Data::Serializer;
  3         7202  
  3         81  
11 3     3   1446 use URI::Escape;
  3         3387  
  3         814  
12              
13             our $VERSION = '1.041';
14              
15             sub new {
16 4     4 1 6 my ($class, $args) = @_;
17 4         17 my $self = {
18             'Resolver' => $args->{resolver},
19             'Cache' => $args->{object_cache},
20             'base' => $args->{base},
21             };
22 4         12 return bless($self, $class);
23             }
24              
25             sub get_resource {
26 4     4 1 6 my ($self, $uri) = @_;
27 4         19 my $args = {'uri' => $uri, 'base' => $self->{base}, 'resolver' => ref $self->{Resolver}};
28 4         17 my $key = join('&', map {$_ . '=' . URI::Escape::uri_escape($args->{$_})} grep {defined $args->{$_}} sort(keys %$args));
  8         152  
  12         20  
29 4         39 my $cache = $self->{Cache};
30 4         10 my $serialized = $cache->get( $key );
31 4         40 my $ds = Data::Serializer->new();
32 4         7046 my @rv;
33 4 100       21 if ( defined $serialized ) {
34 2         7 my $deserialized = $ds->deserialize( $serialized );
35 2         383 @rv = @$deserialized;
36             }
37             else {
38 2         8 @rv = $self->{Resolver}->get_resource( $uri );
39 2         9 my $serialized = $ds->serialize( \@rv );
40 2         356 $cache->set( $key,$serialized );
41             }
42 4         60 return @rv;
43             }
44              
45             1;
46              
47             =head1 NAME
48              
49             Email::MIME::CreateHTML::Resolver::Cached - wraps caching around a resource resolver
50              
51             =head1 SYNOPSIS
52              
53             my $o = new Email::MIME::CreateHTML::Resolver::Cached(\%args)
54             my ($content,$filename,$mimetype,$xfer_encoding) = $o->get_resource($uri)
55              
56             =head1 DESCRIPTION
57              
58             This is used by Email::MIME::CreateHTML to load resources.
59              
60             =head1 METHODS
61              
62             =over 4
63              
64             =item $o = new Email::MIME::CreateHTML::Resolver::Cached(\%args)
65              
66             %args can contain:
67              
68             =over 4
69              
70             =item base
71              
72             Base URI to resolve URIs passed to get_resource.
73              
74             =item object_cache (mandatory)
75              
76             A cache object
77              
78             =item resolver (mandatory)
79              
80             Another resolver to apply caching to
81              
82             =back
83              
84             =item ($content,$filename,$mimetype,$xfer_encoding) = $o->get_resource($uri)
85              
86             =back
87              
88             =head1 AUTHOR
89              
90             Tony Hennessy, Simon Flack and John Alden with additional contributions by
91             Ricardo Signes and Henry Van Styn
92              
93             =head1 COPYRIGHT
94              
95             (c) BBC 2005,2006. This program is free software; you can redistribute it and/or modify it under the GNU GPL.
96              
97             See the file COPYING in this distribution, or http://www.gnu.org/licenses/gpl.txt
98              
99             =cut