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