/usr/share/perl5/Petal/Cache/Memory.pm is in libpetal-perl 2.23-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 | # ------------------------------------------------------------------
# Petal::Cache::Memory - Caches generated subroutines in memory.
# ------------------------------------------------------------------
# Author: Jean-Michel Hiver
# Description: A simple cache module to avoid re-compiling the Perl
# code from the Perl data at each request.
# ------------------------------------------------------------------
package Petal::Cache::Memory;
use strict;
use warnings;
use Carp;
our $FILE_TO_SUBS = {};
our $FILE_TO_MTIME = {};
sub sillyness
{
+ $Petal::INPUT && $Petal::OUTPUT;
}
# $class->get ($file, $lang);
# --------------------
# Returns the cached subroutine if its last modification time
# is more recent than the last modification time of the template,
# returns undef otherwise
sub get
{
my $class = shift;
my $file = shift;
my $lang = shift || '';
my $key = $class->compute_key ($file, $lang);
return $FILE_TO_SUBS->{$key} if ($class->is_ok ($file, $lang));
return;
}
# $class->set ($file, $code, $lang);
# ---------------------------
# Sets the cached code for $file.
sub set
{
my $class = shift;
my $file = shift;
my $code = shift;
my $lang = shift || '';
my $key = $class->compute_key ($file, $lang);
$FILE_TO_SUBS->{$key} = $code;
$FILE_TO_MTIME->{$key} = $class->current_mtime ($file);
}
# $class->is_ok ($file, $lang);
# ----------------------
# Returns TRUE if the cache is still fresh, FALSE otherwise.
sub is_ok
{
my $class = shift;
my $file = shift;
my $lang = shift || '';
my $key = $class->compute_key ($file, $lang);
return unless (defined $FILE_TO_SUBS->{$key});
my $cached_mtime = $class->cached_mtime ($file, $lang);
my $current_mtime = $class->current_mtime ($file);
return $cached_mtime >= $current_mtime;
}
# $class->cached_mtime ($file, $lang);
# -----------------------------
# Returns the last modification date of the cached data
# for $file & $lang
sub cached_mtime
{
my $class = shift;
my $file = shift;
my $lang = shift || '';
my $key = $class->compute_key ($file, $lang);
return $FILE_TO_MTIME->{$key};
}
# $class->current_mtime ($file);
# ------------------------------
# Returns the last modification date for $file
sub current_mtime
{
my $class = shift;
my $file = shift;
$file =~ s/#.*$//;
my $mtime = (stat($file))[9];
return $mtime;
}
# $class->compute_key ($file);
# ----------------------------
# Computes a cache 'key' for $file, which should be unique.
# (Well, currently an MD5 checksum is used, which is not
# *exactly* unique but which should be good enough)
sub compute_key
{
my $class = shift;
my $file = shift;
my $lang = shift || '';
my $key = $file . ";$lang" . ";INPUT=" . $Petal::INPUT . ";OUTPUT=" . $Petal::OUTPUT;
return $key;
}
1;
|