/usr/share/perl5/Class/DBI/Lite/CacheManager/InMemory.pm is in libclass-dbi-lite-perl 1.026-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 | package Class::DBI::Lite::CacheManager::InMemory;
use strict;
use warnings 'all';
use base 'Class::DBI::Lite::CacheManager';
use Carp 'confess';
sub defaults
{
return (
lifetime => '30s',
class => undef,
);
}# end defaults()
sub class { shift->{class} }
sub init
{
my ($s) = @_;
$s->{lifetime} ||= '30s';
my ($number, $unit) = $s->{lifetime} =~ m/^(\d+)([smhd])$/i;
$unit = uc($unit);
confess "Invalid lifetime value of '$s->{lifetime}'" unless $number && $unit;
my $expiry;
if( $unit eq 'S' )
{
$expiry = $number;
}
elsif( $unit eq 'M' )
{
$expiry = $number * 60;
}
elsif( $unit eq 'H' )
{
$expiry = $number * 60 * 60;
}
elsif( $unit eq 'D' )
{
$expiry = $number * 60 * 60 * 24;
}# end if()
$s->{expiry} = $expiry;
$s->{cache} = { };
1;
}# end init()
sub set
{
my ($s, $key, $value) = @_;
my $exp = time() + $s->{expiry};
$s->{cache}{$key} = { expires => $exp, value => $value };
}# end set()
sub get
{
my ($s, $key) = @_;
return unless exists($s->{cache}{$key}) && $s->{cache}{$key}->{expires} > time();
return $s->{cache}{$key}->{value};
}# end get()
sub delete
{
my ($s, $key) = @_;
delete( $s->{cache}{$key} );
}# end delete()
sub clear
{
my ($s) = @_;
$s->{cache} = { };
}# end clear()
1;# return true:
=pod
=head1 NAME
Class::DBI::Lite::CacheManager::InMemory - Cache in RAM.
=head1 SYNOPSIS
package app::user;
use strict;
use warnings 'all';
use base 'app::model';
use Class::DBI::Lite::CacheManager::InMemory;
__PACKAGE__->set_up_table('users');
__PACKAGE__->set_cache(
Class::DBI::Lite::CacheManager::Memcached->new(
lifetime => '30s',
class => __PACKAGE__,
do_cache_search => 1,
)
);
__PACKAGE__->cache->cache_searches_containing(qw(
email
password
));
Then, someplace else...
# This will be cached...
my ($user) = app::user->search(
email => 'alice@wonderland.net',
password => 'whiterabbit',
);
...later - within 30 seconds...
# This won't hit the database - the result will come from the cache instead:
my ($user) = app::user->search(
email => 'alice@wonderland.net',
password => 'whiterabbit',
);
A create, update or delete invalidates the cache:
$user->delete; # Cache is emptied now.
=head1 DESCRIPTION
C<Class::DBI::Lite::CacheManager::InMemory> will store the results of searches
in RAM for a specific length of time. This is helpful if you find that your
application's performance is suffering because of oft-repeated queries.
So, if your data requirements are such that you find objects of a specific class are getting called
up frequently enough to warrant caching - you can now do that on a per-class basis.
You can even specify the kinds of search queries that should be cached.
You can specify the length of time that cached data should be available.
B<NOTE:> More documentation and complete examples TBD.
=head1 AUTHOR
Copyright John Drago <jdrago_999@yahoo.com>. All rights reserved.
=head1 LICENSE
This software is B<Free> software and may be used and redistributed under the
same terms as perl itself.
=cut
|