| Server IP : 170.10.162.208 / Your IP : 216.73.216.181 Web Server : LiteSpeed System : Linux altar19.supremepanel19.com 4.18.0-553.69.1.lve.el8.x86_64 #1 SMP Wed Aug 13 19:53:59 UTC 2025 x86_64 User : deltahospital ( 1806) PHP Version : 7.4.33 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : OFF | Pkexec : OFF Directory : /home/deltahospital/test.delta-hospital.com/ |
Upload File : |
usr/share/perl5/Memoize/Expire.pm 0000644 00000026670 15051132656 0012724 0 ustar 00
package Memoize::Expire;
# require 5.00556;
use Carp;
$DEBUG = 0;
$VERSION = '1.03';
# This package will implement expiration by prepending a fixed-length header
# to the font of the cached data. The format of the header will be:
# (4-byte number of last-access-time) (For LRU when I implement it)
# (4-byte expiration time: unsigned seconds-since-unix-epoch)
# (2-byte number-of-uses-before-expire)
sub _header_fmt () { "N N n" }
sub _header_size () { length(_header_fmt) }
# Usage: memoize func
# TIE => [Memoize::Expire, LIFETIME => sec, NUM_USES => n,
# TIE => [...] ]
BEGIN {
eval {require Time::HiRes};
unless ($@) {
Time::HiRes->import('time');
}
}
sub TIEHASH {
my ($package, %args) = @_;
my %cache;
if ($args{TIE}) {
my ($module, @opts) = @{$args{TIE}};
my $modulefile = $module . '.pm';
$modulefile =~ s{::}{/}g;
eval { require $modulefile };
if ($@) {
croak "Memoize::Expire: Couldn't load hash tie module `$module': $@; aborting";
}
my $rc = (tie %cache => $module, @opts);
unless ($rc) {
croak "Memoize::Expire: Couldn't tie hash to `$module': $@; aborting";
}
}
$args{LIFETIME} ||= 0;
$args{NUM_USES} ||= 0;
$args{C} = \%cache;
bless \%args => $package;
}
sub STORE {
$DEBUG and print STDERR " >> Store $_[1] $_[2]\n";
my ($self, $key, $value) = @_;
my $expire_time = $self->{LIFETIME} > 0 ? $self->{LIFETIME} + time : 0;
# The call that results in a value to store into the cache is the
# first of the NUM_USES allowed calls.
my $header = _make_header(time, $expire_time, $self->{NUM_USES}-1);
$self->{C}{$key} = $header . $value;
$value;
}
sub FETCH {
$DEBUG and print STDERR " >> Fetch cached value for $_[1]\n";
my ($data, $last_access, $expire_time, $num_uses_left) = _get_item($_[0]{C}{$_[1]});
$DEBUG and print STDERR " >> (ttl: ", ($expire_time-time()), ", nuses: $num_uses_left)\n";
$num_uses_left--;
$last_access = time;
_set_header(@_, $data, $last_access, $expire_time, $num_uses_left);
$data;
}
sub EXISTS {
$DEBUG and print STDERR " >> Exists $_[1]\n";
unless (exists $_[0]{C}{$_[1]}) {
$DEBUG and print STDERR " Not in underlying hash at all.\n";
return 0;
}
my $item = $_[0]{C}{$_[1]};
my ($last_access, $expire_time, $num_uses_left) = _get_header($item);
my $ttl = $expire_time - time;
if ($DEBUG) {
$_[0]{LIFETIME} and print STDERR " Time to live for this item: $ttl\n";
$_[0]{NUM_USES} and print STDERR " Uses remaining: $num_uses_left\n";
}
if ( (! $_[0]{LIFETIME} || $expire_time > time)
&& (! $_[0]{NUM_USES} || $num_uses_left > 0 )) {
$DEBUG and print STDERR " (Still good)\n";
return 1;
} else {
$DEBUG and print STDERR " (Expired)\n";
return 0;
}
}
# Arguments: last access time, expire time, number of uses remaining
sub _make_header {
pack "N N n", @_;
}
sub _strip_header {
substr($_[0], 10);
}
# Arguments: last access time, expire time, number of uses remaining
sub _set_header {
my ($self, $key, $data, @header) = @_;
$self->{C}{$key} = _make_header(@header) . $data;
}
sub _get_item {
my $data = substr($_[0], 10);
my @header = unpack "N N n", substr($_[0], 0, 10);
# print STDERR " >> _get_item: $data => $data @header\n";
($data, @header);
}
# Return last access time, expire time, number of uses remaining
sub _get_header {
unpack "N N n", substr($_[0], 0, 10);
}
1;
=head1 NAME
Memoize::Expire - Plug-in module for automatic expiration of memoized values
=head1 SYNOPSIS
use Memoize;
use Memoize::Expire;
tie my %cache => 'Memoize::Expire',
LIFETIME => $lifetime, # In seconds
NUM_USES => $n_uses;
memoize 'function', SCALAR_CACHE => [HASH => \%cache ];
=head1 DESCRIPTION
Memoize::Expire is a plug-in module for Memoize. It allows the cached
values for memoized functions to expire automatically. This manual
assumes you are already familiar with the Memoize module. If not, you
should study that manual carefully first, paying particular attention
to the HASH feature.
Memoize::Expire is a layer of software that you can insert in between
Memoize itself and whatever underlying package implements the cache.
The layer presents a hash variable whose values expire whenever they
get too old, have been used too often, or both. You tell C<Memoize> to
use this forgetful hash as its cache instead of the default, which is
an ordinary hash.
To specify a real-time timeout, supply the C<LIFETIME> option with a
numeric value. Cached data will expire after this many seconds, and
will be looked up afresh when it expires. When a data item is looked
up afresh, its lifetime is reset.
If you specify C<NUM_USES> with an argument of I<n>, then each cached
data item will be discarded and looked up afresh after the I<n>th time
you access it. When a data item is looked up afresh, its number of
uses is reset.
If you specify both arguments, data will be discarded from the cache
when either expiration condition holds.
Memoize::Expire uses a real hash internally to store the cached data.
You can use the C<HASH> option to Memoize::Expire to supply a tied
hash in place of the ordinary hash that Memoize::Expire will normally
use. You can use this feature to add Memoize::Expire as a layer in
between a persistent disk hash and Memoize. If you do this, you get a
persistent disk cache whose entries expire automatically. For
example:
# Memoize
# |
# Memoize::Expire enforces data expiration policy
# |
# DB_File implements persistence of data in a disk file
# |
# Disk file
use Memoize;
use Memoize::Expire;
use DB_File;
# Set up persistence
tie my %disk_cache => 'DB_File', $filename, O_CREAT|O_RDWR, 0666];
# Set up expiration policy, supplying persistent hash as a target
tie my %cache => 'Memoize::Expire',
LIFETIME => $lifetime, # In seconds
NUM_USES => $n_uses,
HASH => \%disk_cache;
# Set up memoization, supplying expiring persistent hash for cache
memoize 'function', SCALAR_CACHE => [ HASH => \%cache ];
=head1 INTERFACE
There is nothing special about Memoize::Expire. It is just an
example. If you don't like the policy that it implements, you are
free to write your own expiration policy module that implements
whatever policy you desire. Here is how to do that. Let us suppose
that your module will be named MyExpirePolicy.
Short summary: You need to create a package that defines four methods:
=over 4
=item
TIEHASH
Construct and return cache object.
=item
EXISTS
Given a function argument, is the corresponding function value in the
cache, and if so, is it fresh enough to use?
=item
FETCH
Given a function argument, look up the corresponding function value in
the cache and return it.
=item
STORE
Given a function argument and the corresponding function value, store
them into the cache.
=item
CLEAR
(Optional.) Flush the cache completely.
=back
The user who wants the memoization cache to be expired according to
your policy will say so by writing
tie my %cache => 'MyExpirePolicy', args...;
memoize 'function', SCALAR_CACHE => [HASH => \%cache];
This will invoke C<< MyExpirePolicy->TIEHASH(args) >>.
MyExpirePolicy::TIEHASH should do whatever is appropriate to set up
the cache, and it should return the cache object to the caller.
For example, MyExpirePolicy::TIEHASH might create an object that
contains a regular Perl hash (which it will to store the cached
values) and some extra information about the arguments and how old the
data is and things like that. Let us call this object `C'.