File Coverage

blib/lib/Template/Provider/MD5.pm

Criterion	Covered	Total	%
statement	18	39	46.1
branch	0	14	0.0
condition	0	3	0.0
subroutine	6	9	66.6
pod	1	1	100.0
total	25	66	37.8

line	stmt	bran	cond	sub	pod	time	code
1							package Template::Provider::MD5;
2	1			1		5533	use strict;
	1					3
	1					28
3	1			1		4	use base qw(Template::Provider);
	1					2
	1					2167
4	1			1		38566	use Digest::MD5 qw(md5 md5_hex md5_base64);
	1					8
	1					63
5	1			1		4	use Template::Constants qw(:status);
	1					2
	1					164
6	1			1		5	use Template::Provider;
	1					2
	1					20
7	1			1		4	use vars qw/$VERSION/;
	1					1
	1					340
8							$VERSION = "0.02";
9
10							my %tt_md5_cache = ();
11
12							=head1 NAME
13
14							Template::Provider::MD5 - MD5 Cached Compiled SCALARS for Template Toolkit
15
16							=head1 SYNOPSIS
17
18							use Template::Provider::MD5;
19							use Template;
20
21							# NOTE: Config is shared between Providers and Templates there is no
22							# clear separation.
23
24							my $config = {
25							INCLUDE_PATH => "Some/Include/Path",
26							EVAL_PERL => 0,
27							COMPILE_DIR => "/var/tmp/TTCache",
28							COMPILE_EXT => '.ttc',
29							};
30
31							# MAke your provider first, otherwise Template will make one for you.
32							my $p = Template::Provider::MD5->new($config);
33							$config->{LOAD_TEMPLATES} = [$p];
34							$config->{PREFIX_MAP} = {default => 0};
35							my $tt = Template->new($config);
36
37							... use $tt as per standard Template Toolkit ...
38
39							=head1 DESCRIPTION
40
41							Extension for L
42							MD5. A L is actually designed to provide an
43							alternate method for getting data (eg: the example is a WEB Access
44							Module). In this case it is actually a replacement to the default
45							L by providing caching for strings and then falling
46							back to the original when required.
47
48							=head1 METHODS
49
50							There are no public methods. They are all consumed by Template Toolkit
51
52							=cut
53
54							# XXX POD
55							# XXX Example
56							# XXX Test
57							# XXX
58							# - Use init to check if we want memory cache only or file only or
59							# combined.
60							# - Notes on how we should be using REAL cache
61							#if ($slot = $self->{ LOOKUP }->{ $compiled }) {
62							# XXX Totally temporary cache version, should be ->store
63							# and ->refresh
64							# ## cached entry exists, so refresh slot and extract data
65							# #($data, $error) = $self->_refresh($slot);
66							# #$data = $slot->[ Template::Provider::DATA ] unless $error;
67							# XXX ($data, $error) = $self->_store($compiled, { data => $data, load => 0 }, $compiled);
68
69							# ----------------------------------------------------------------------
70							sub fetch {
71	0			0	1		my ($self, $name) = @_;
72
73							# ONLY Supports SCALAR References, otherwise use standard
74	0	0					if (ref($name) eq "SCALAR") {
75
76							# Calculate the compiled filename
77	0						my $compiled = $self->_compiled_filename_scalar($name);
78	0						my ($data, $error, $slot);
79
80							# Do we have it in our class cache ?
81	0	0	0				if (exists($tt_md5_cache{$compiled})) {
		0
82							# TODO - Consider using current TT cache
83							# (that may not work but at least
84							# support the same size limits)
85							# Load from cache
86	0						$data = $tt_md5_cache{$compiled};
87	0						$error = STATUS_OK;
88
89							# Otherwise - do we have it on disk
90							} elsif ($compiled && -f $compiled) {
91							# Load off the disk... should also store ?
92	0						$data = $self->_load_compiled($compiled);
93	0						$error = STATUS_OK;
94	0						$tt_md5_cache{$compiled} = $data;
95
96							# Nope - we need to compile and store it
97							} else {
98							# Compile from fresh.
99	0						($data, $error) = $self->_load($name);
100	0	0					($data, $error) = $self->_compile($data, $compiled)
101							unless $error;
102
103							# Local file cached
104	0	0					($data, $error) = $self->store($compiled, $data)
105							unless $error;
106							$data = $data->{ data }
107	0	0					unless $error;
108
109							# Memory cached
110	0	0					$tt_md5_cache{$compiled} = $data
111							unless $error;
112							}
113
114	0						return ($data, $error);
115
116							} else {
117	0						return $self->SUPER::fetch($name);
118							}
119							}
120
121							# ----------------------------------------------------------------------
122							sub _compiled_filename_scalar {
123	0			0			my ($self, $name) = @_;
124	0						return File::Spec->canonpath(
125							# TODO - Make MD5_ etc configurable
126							# TODO - Make this a HASHED path rather than flat
127							# TODO - Allow other calculation algorythms - eg: not MD5
128							$self->SUPER::_compiled_filename(
129							$self->_hash_name($name)
130							)
131							);
132							}
133
134							# ALLOW Overload of just this function
135							sub _hash_name {
136	0			0			my ($self, $name) = @_;
137	0						return 'MD5_' . md5_hex($$name);
138							}
139
140
141							1;
142
143							=head1 TODO
144
145							There are various things to do including:
146
147							=over
148
149							=item Alternate Hashing
150
151							There is no reason just to use MD5, this should be either something that can be
152							passed in or you could inherit this and pass in an alternate hashing.
153
154							=item Directory Hashing
155
156							Template Toollkit standard provider has a directory cache hashing by using the
157							name of the file. This one is all in one directory, which is, well, obviously
158							bad if you have LOTS of files. Generally speaking once unix hits 1000 files in
159							a directory you start noticing serious degradataion in performance of a simple
160							file operation (eg: -f).
161
162							=back
163
164							=head1 SEE ALSO
165
166							L
167
168							=head1 AUTHOR
169
170							Scott Penrose EFE OR EFE
171
172							=head1 COPYRIGHT
173
174							Copyright (c) 2004 Scott Penrose. All rights reserved.
175							This program is free software; you can redistribute it and/or modify
176							it under the same terms as Perl itself. (Artistic License and LGPL).
177
178							=cut