Commit | Line | Data |
3fea05b9 |
1 | package PPI::Cache; |
2 | |
3 | =pod |
4 | |
5 | =head1 NAME |
6 | |
7 | PPI::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 | |
22 | C<PPI::Cache> provides the default caching functionality for L<PPI>. |
23 | |
24 | It integrates automatically with L<PPI> itself. Once enabled, any attempt |
25 | to load a document from the filesystem will be cached via cache. |
26 | |
27 | Please note that creating a L<PPI::Document> from raw source or something |
28 | other object will B<not> be cached. |
29 | |
30 | =head2 Using PPI::Cache |
31 | |
32 | The most common way of using C<PPI::Cache> is to provide parameters to |
33 | the 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 | |
41 | Any of the arguments that can be provided to the C<new> constructor can |
42 | also be provided to C<use>. |
43 | |
44 | =head1 METHODS |
45 | |
46 | =cut |
47 | |
48 | use strict; |
49 | use Carp (); |
50 | use File::Spec (); |
51 | use File::Path (); |
52 | use Storable (); |
53 | use Digest::MD5 (); |
54 | use Params::Util qw{_INSTANCE _SCALAR}; |
55 | use PPI::Document (); |
56 | |
57 | use vars qw{$VERSION}; |
58 | BEGIN { |
59 | $VERSION = '1.206'; |
60 | } |
61 | |
62 | sub import { |
63 | my $class = ref $_[0] ? ref shift : shift; |
64 | return 1 unless @_; |
65 | |
66 | # Create a cache from the params provided |
67 | my $cache = $class->new(@_); |
68 | |
69 | # Make PPI::Document use it |
70 | PPI::Document->set_cache( $cache ) |
71 | or Carp::croak("Failed to set cache in PPI::Document"); |
72 | |
73 | 1; |
74 | } |
75 | |
76 | |
77 | |
78 | |
79 | |
80 | ##################################################################### |
81 | # Constructor and Accessors |
82 | |
83 | =pod |
84 | |
85 | =head2 new param => $value, ... |
86 | |
87 | The C<new> constructor creates a new standalone cache object. |
88 | |
89 | It takes a number of parameters to control the cache. |
90 | |
91 | =over |
92 | |
93 | =item path |
94 | |
95 | The C<path> param sets the base directory for the cache. It must already |
96 | exist, and must be writable. |
97 | |
98 | =item readonly |
99 | |
100 | The C<readonly> param is a true/false flag that allows the use of an |
101 | existing cache by a less-privileged user (such as the web user). |
102 | |
103 | Existing documents will be retrieved from the cache, but new documents |
104 | will not be written to it. |
105 | |
106 | =back |
107 | |
108 | Returns a new C<PPI::Cache> object, or dies on error. |
109 | |
110 | =cut |
111 | |
112 | sub 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 | |
142 | The C<path> accessor returns the path on the local filesystem that is the |
143 | root of the cache. |
144 | |
145 | =cut |
146 | |
147 | sub path { $_[0]->{path} } |
148 | |
149 | =pod |
150 | |
151 | =head2 readonly |
152 | |
153 | The C<readonly> accessor returns true if documents should not be written |
154 | to the cache. |
155 | |
156 | =cut |
157 | |
158 | sub readonly { $_[0]->{readonly} } |
159 | |
160 | |
161 | |
162 | |
163 | |
164 | ##################################################################### |
165 | # PPI::Cache Methods |
166 | |
167 | =pod |
168 | |
169 | =head2 get_document $md5sum | \$source |
170 | |
171 | The C<get_document> method checks to see if a Document is stored in the |
172 | cache and retrieves it if so. |
173 | |
174 | =cut |
175 | |
176 | sub 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 | |
188 | The C<store_document> method takes a L<PPI::Document> as argument and |
189 | explicitly adds it to the cache. |
190 | |
191 | Returns true if saved, or C<undef> (or dies) on error. |
192 | |
193 | FIXME (make this return either one or the other, not both) |
194 | |
195 | =cut |
196 | |
197 | sub 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. |
220 | sub _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 | Storable::lock_nstore( $object, $file ); |
227 | } |
228 | |
229 | # Load an arbitrary object (using Storable) from a particular |
230 | # path within the cache filesystem. |
231 | sub _load { |
232 | my ($self, $md5hex) = @_; |
233 | my (undef, $file) = $self->_paths($md5hex); |
234 | |
235 | # Load the file |
236 | return '' unless -f $file; |
237 | my $object = Storable::lock_retrieve( $file ); |
238 | |
239 | # Security check |
240 | unless ( _INSTANCE($object, 'PPI::Document') ) { |
241 | Carp::croak("Security Violation: Object in '$file' is not a PPI::Document"); |
242 | } |
243 | |
244 | $object; |
245 | } |
246 | |
247 | # Convert a md5 to a dir and file name |
248 | sub _paths { |
249 | my $self = shift; |
250 | my $md5hex = lc shift; |
251 | my $dir = File::Spec->catdir( $self->path, substr($md5hex, 0, 1), substr($md5hex, 0, 2) ); |
252 | my $file = File::Spec->catfile( $dir, $md5hex . '.ppi' ); |
253 | return ($dir, $file); |
254 | } |
255 | |
256 | # Check a md5hex param |
257 | sub _md5hex { |
258 | my $either = shift; |
259 | my $it = _SCALAR($_[0]) |
260 | ? PPI::Util::md5hex(${$_[0]}) |
261 | : $_[0]; |
262 | return (defined $it and ! ref $it and $it =~ /^[a-f0-9]{32}\z/si) |
263 | ? lc $it |
264 | : undef; |
265 | } |
266 | |
267 | 1; |
268 | |
269 | =pod |
270 | |
271 | =head1 TO DO |
272 | |
273 | - Finish the basic functionality |
274 | |
275 | - Add support for use PPI::Cache auto-setting $PPI::Document::CACHE |
276 | |
277 | =head1 SUPPORT |
278 | |
279 | See the L<support section|PPI/SUPPORT> in the main module. |
280 | |
281 | =head1 AUTHOR |
282 | |
283 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> |
284 | |
285 | =head1 COPYRIGHT |
286 | |
287 | Copyright 2005 Adam Kennedy. |
288 | |
289 | This program is free software; you can redistribute |
290 | it and/or modify it under the same terms as Perl itself. |
291 | |
292 | The full text of the license can be found in the |
293 | LICENSE file included with this module. |
294 | |
295 | =cut |