This file is indexed.

/usr/share/perl5/PPI/Cache.pm is in libppi-perl 1.220-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.220';
}

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 =~ /^[a-f0-9]{32}\z/si)
		? 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