1package PPI::Cache;
2
3=pod
4
5=head1 NAME
6
7PPI::Cache - The PPI Document Caching Layer
8
9=head1 SYNOPSIS
10
11  # Set the cache
12  use PPI::Cache path => '/var/cache/ppi-cache';
13
14  # Manually create a cache
15  my $Cache = PPI::Cache->new(
16      path     => '/var/cache/perl/class-PPI',
17      readonly => 1,
18  );
19
20=head1 DESCRIPTION
21
22C<PPI::Cache> provides the default caching functionality for L<PPI>.
23
24It integrates automatically with L<PPI> itself. Once enabled, any attempt
25to load a document from the filesystem will be cached via cache.
26
27Please note that creating a L<PPI::Document> from raw source or something
28other object will B<not> be cached.
29
30=head2 Using PPI::Cache
31
32The most common way of using C<PPI::Cache> is to provide parameters to
33the C<use> statement at the beginning of your program.
34
35  # Load the class but do not set a cache
36  use PPI::Cache;
37
38  # Use a fairly normal cache location
39  use PPI::Cache path => '/var/cache/ppi-cache';
40
41Any of the arguments that can be provided to the C<new> constructor can
42also be provided to C<use>.
43
44=head1 METHODS
45
46=cut
47
48use strict;
49use Carp             ();
50use File::Spec       ();
51use File::Path       ();
52use Storable 2.17    ();
53use Digest::MD5 2.35 ();
54use Params::Util     qw{_INSTANCE _SCALAR};
55use PPI::Document    ();
56
57our $VERSION = '1.270'; # VERSION
58
59use constant VMS => !! ( $^O eq 'VMS' );
60
61sub import {
62	my $class = ref $_[0] ? ref shift : shift;
63	return 1 unless @_;
64
65	# Create a cache from the params provided
66	my $cache = $class->new(@_);
67
68	# Make PPI::Document use it
69	unless ( PPI::Document->set_cache( $cache ) ) {
70		Carp::croak("Failed to set cache in PPI::Document");
71	}
72
73	1;
74}
75
76
77
78
79
80#####################################################################
81# Constructor and Accessors
82
83=pod
84
85=head2 new param => $value, ...
86
87The C<new> constructor creates a new standalone cache object.
88
89It takes a number of parameters to control the cache.
90
91=over
92
93=item path
94
95The C<path> param sets the base directory for the cache. It must already
96exist, and must be writable.
97
98=item readonly
99
100The C<readonly> param is a true/false flag that allows the use of an
101existing cache by a less-privileged user (such as the web user).
102
103Existing documents will be retrieved from the cache, but new documents
104will not be written to it.
105
106=back
107
108Returns a new C<PPI::Cache> object, or dies on error.
109
110=cut
111
112sub new {
113	my $class  = shift;
114	my %params = @_;
115
116	# Path should exist and be usable
117	my $path = $params{path}
118		or Carp::croak("Cannot create PPI::Cache, no path provided");
119	unless ( -d $path ) {
120		Carp::croak("Cannot create PPI::Cache, path does not exist");
121	}
122	unless ( -r $path and -x $path ) {
123		Carp::croak("Cannot create PPI::Cache, no read permissions for path");
124	}
125	if ( ! $params{readonly} and ! -w $path ) {
126		Carp::croak("Cannot create PPI::Cache, no write permissions for path");
127	}
128
129	# Create the basic object
130	my $self = bless {
131		path     => $path,
132		readonly => !! $params{readonly},
133	}, $class;
134
135	$self;
136}
137
138=pod
139
140=head2 path
141
142The C<path> accessor returns the path on the local filesystem that is the
143root of the cache.
144
145=cut
146
147sub path { $_[0]->{path} }
148
149=pod
150
151=head2 readonly
152
153The C<readonly> accessor returns true if documents should not be written
154to the cache.
155
156=cut
157
158sub readonly { $_[0]->{readonly} }
159
160
161
162
163
164#####################################################################
165# PPI::Cache Methods
166
167=pod
168
169=head2 get_document $md5sum | \$source
170
171The C<get_document> method checks to see if a Document is stored in the
172cache and retrieves it if so.
173
174=cut
175
176sub get_document {
177	my $self = ref $_[0]
178		? shift
179		: Carp::croak('PPI::Cache::get_document called as static method');
180	my $md5hex = $self->_md5hex(shift) or return undef;
181	$self->_load($md5hex);
182}
183
184=pod
185
186=head2 store_document $Document
187
188The C<store_document> method takes a L<PPI::Document> as argument and
189explicitly adds it to the cache.
190
191Returns true if saved, or C<undef> (or dies) on error.
192
193FIXME (make this return either one or the other, not both)
194
195=cut
196
197sub store_document {
198	my $self     = shift;
199	my $Document = _INSTANCE(shift, 'PPI::Document') or return undef;
200
201	# Shortcut if we are readonly
202	return 1 if $self->readonly;
203
204	# Find the filename to save to
205	my $md5hex = $Document->hex_id or return undef;
206
207	# Store the file
208	$self->_store( $md5hex, $Document );
209}
210
211
212
213
214
215#####################################################################
216# Support Methods
217
218# Store an arbitrary PPI::Document object (using Storable) to a particular
219# path within the cache filesystem.
220sub _store {
221	my ($self, $md5hex, $object) = @_;
222	my ($dir, $file) = $self->_paths($md5hex);
223
224	# Save the file
225	File::Path::mkpath( $dir, 0, 0755 ) unless -d $dir;
226	if ( VMS ) {
227		Storable::lock_nstore( $object, $file );
228	} else {
229		Storable::nstore( $object, $file );
230	}
231}
232
233# Load an arbitrary object (using Storable) from a particular
234# path within the cache filesystem.
235sub _load {
236	my ($self, $md5hex) = @_;
237	my (undef, $file) = $self->_paths($md5hex);
238
239	# Load the file
240	return '' unless -f $file;
241	my $object = VMS
242		? Storable::retrieve( $file )
243		: Storable::lock_retrieve( $file );
244
245	# Security check
246	unless ( _INSTANCE($object, 'PPI::Document') ) {
247		Carp::croak("Security Violation: Object in '$file' is not a PPI::Document");
248	}
249
250	$object;
251}
252
253# Convert a md5 to a dir and file name
254sub _paths {
255	my $self   = shift;
256	my $md5hex = lc shift;
257	my $dir    = File::Spec->catdir( $self->path, substr($md5hex, 0, 1), substr($md5hex, 0, 2) );
258	my $file   = File::Spec->catfile( $dir, $md5hex . '.ppi' );
259	return ($dir, $file);
260}
261
262# Check a md5hex param
263sub _md5hex {
264	my $either = shift;
265	my $it     = _SCALAR($_[0])
266		? PPI::Util::md5hex(${$_[0]})
267		: $_[0];
268	return (defined $it and ! ref $it and $it =~ /^[[:xdigit:]]{32}\z/s)
269		? lc $it
270		: undef;
271}
272
2731;
274
275=pod
276
277=head1 TO DO
278
279- Finish the basic functionality
280
281- Add support for use PPI::Cache auto-setting $PPI::Document::CACHE
282
283=head1 SUPPORT
284
285See the L<support section|PPI/SUPPORT> in the main module.
286
287=head1 AUTHOR
288
289Adam Kennedy E<lt>adamk@cpan.orgE<gt>
290
291=head1 COPYRIGHT
292
293Copyright 2005 - 2011 Adam Kennedy.
294
295This program is free software; you can redistribute
296it and/or modify it under the same terms as Perl itself.
297
298The full text of the license can be found in the
299LICENSE file included with this module.
300
301=cut
302