/usr/share/perl5/Class/DBI/Lite/CacheManager/Memcached.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 164 165 166 167 168 169 170 171 172 173 174 175 176 | package Class::DBI::Lite::CacheManager::Memcached;
use strict;
use warnings 'all';
use base 'Class::DBI::Lite::CacheManager';
use Cache::Memcached;
use Carp 'confess';
sub defaults
{
return (
servers => undef,
compress_threshold => 10_000,
enable_compress => 0,
debug => 0,
lifetime => '30s',
class => undef,
);
}# end defaults()
# Public read-only properties:
sub servers { shift->{servers} }
sub compress_threshold { shift->{compress_threshold} }
sub enable_compress { shift->{enable_compress} }
sub debug { shift->{debug} }
sub memd { shift->{class}->_meta->{memd} }
sub init
{
my ($s) = @_;
$s->{class}->_meta->{memd} = Cache::Memcached->new(
servers => $s->servers,
compress_threshold => $s->compress_threshold,
enable_compress => $s->enable_compress,
debug => $s->debug,
);
$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;
1;
}# end init()
sub set
{
my ($s, $key, $value) = @_;
$s->memd->set( $key, $value, $s->{expiry} );
}# end set()
sub get
{
my ($s, $key) = @_;
$s->memd->get( $key );
}# end get()
sub delete
{
my ($s, $key) = @_;
$s->memd->delete( $key );
}# end delete()
sub clear
{
my ($s) = @_;
$s->memd->flush_all;
}# end clear()
1;# return true:
=pod
=head1 NAME
Class::DBI::Lite::CacheManager::Memcached - Cache via memcached.
=head1 SYNOPSIS
package app::user;
use strict;
use warnings 'all';
use base 'app::model';
use Class::DBI::Lite::CacheManager::Memcached;
__PACKAGE__->set_up_table('users');
__PACKAGE__->set_cache(
Class::DBI::Lite::CacheManager::Memcached->new(
lifetime => '30s',
class => __PACKAGE__,
servers => ['127.0.0.1:11211'],
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...
# 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::Memcached> uses L<Cache::Memcached> to temporarily
store the results of (presumably) frequent database searches for faster lookup.
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
|