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