File Coverage

File:blib/lib/OpenSRF/Utils/Cache.pm
Coverage:19.2%

linestmtbrancondsubpodtimecode
1package OpenSRF::Utils::Cache;
2
1
1
1
1
1
1
1
1
6
4
7
6
4
5
use strict; use warnings;
3
1
1
1
1
8
3
7
use base qw/OpenSRF/;
4
1
1
1
1
10
4
17
use Cache::Memcached;
5
1
1
1
1
14
4
9
use OpenSRF::Utils::Logger qw/:level/;
6
1
1
1
1
7
3
9
use OpenSRF::Utils::Config;
7
1
1
1
1
14
4
9
use OpenSRF::Utils::SettingsClient;
8
1
1
1
1
7
4
6
use OpenSRF::EX qw(:try);
9
1
1
1
1
7
3
9
use OpenSRF::Utils::JSON;
10
11my $log = 'OpenSRF::Utils::Logger';
12
13 - 31
=head1 NAME

OpenSRF::Utils::Cache

=head1 SYNOPSIS

This class just subclasses Cache::Memcached.
see Cache::Memcached for more options.

The value passed to the call to current is the cache type
you wish to access.  The below example sets/gets data
from the 'user' cache.

my $cache = OpenSRF::Utils::Cache->current("user");
$cache->set( "key1", "value1" [, $expire_secs ] );
my $val = $cache->get( "key1" );


=cut
32
33
0
0
sub DESTROY {}
34
35my %caches;
36
37# ------------------------------------------------------
38# Persist methods and method names
39# ------------------------------------------------------
40my $persist_add_slot;
41my $persist_push_stack;
42my $persist_peek_stack;
43my $persist_destroy_slot;
44my $persist_slot_get_expire;
45my $persist_slot_find;
46
47my $max_persist_time;
48my $persist_add_slot_name = "opensrf.persist.slot.create_expirable";
49my $persist_push_stack_name = "opensrf.persist.stack.push";
50my $persist_peek_stack_name = "opensrf.persist.stack.peek";
51my $persist_destroy_slot_name = "opensrf.persist.slot.destroy";
52my $persist_slot_get_expire_name = "opensrf.persist.slot.get_expire";
53my $persist_slot_find_name = "opensrf.persist.slot.find";;
54
55# ------------------------------------------------------
56
57 - 63
=head1 METHODS

=head2 current

Return a named cache if it exists

=cut
64
65sub current {
66
0
0
1
        my ( $class, $c_type ) = @_;
67
0
0
        return undef unless $c_type;
68
0
0
        return $caches{$c_type} if exists $caches{$c_type};
69
0
        return $caches{$c_type} = $class->new( $c_type );
70}
71
72
73 - 77
=head2 new

Create a new named memcache object.

=cut
78
79sub new {
80
81
0
0
1
        my( $class, $cache_type, $persist ) = @_;
82
0
0
        $cache_type ||= 'global';
83
0
0
        $class = ref( $class ) || $class;
84
85
0
0
        return $caches{$cache_type} if (defined $caches{$cache_type});
86
87
0
        my $conf = OpenSRF::Utils::SettingsClient->new;
88
0
        my $servers = $conf->config_value( cache => $cache_type => servers => 'server' );
89
0
        $max_persist_time = $conf->config_value( cache => $cache_type => 'max_cache_time' );
90
91
0
0
        $servers = [ $servers ] if(!ref($servers));
92
93
0
        my $self = {};
94
0
0
        $self->{persist} = $persist || 0;
95
0
        $self->{memcache} = Cache::Memcached->new( { servers => $servers } );
96
0
0
        if(!$self->{memcache}) {
97
0
                throw OpenSRF::EX::PANIC ("Unable to create a new memcache object for $cache_type");
98        }
99
100
0
        bless($self, $class);
101
0
        $caches{$cache_type} = $self;
102
0
        return $self;
103}
104
105
106 - 108
=head2 put_cache

=cut
109
110sub put_cache {
111
0
0
1
        my($self, $key, $value, $expiretime ) = @_;
112
0
0
0
        return undef unless( defined $key and defined $value );
113
114
0
        $value = OpenSRF::Utils::JSON->perl2JSON($value);
115
116
0
0
0
        if($self->{persist}){ _load_methods(); }
117
118
0
0
        $expiretime ||= $max_persist_time;
119
120
0
0
        unless( $self->{memcache}->set( $key, $value, $expiretime ) ) {
121
0
                $log->error("Unable to store $key => [".length($value)." bytes] in memcached server" );
122
0
                return undef;
123        }
124
125
0
        $log->debug("Stored $key => $value in memcached server", INTERNAL);
126
127
0
0
        if($self->{"persist"}) {
128
129
0
                my ($slot) = $persist_add_slot->run("_CACHEVAL_$key", $expiretime . "s");
130
131
0
0
                if(!$slot) {
132                        # slot may already exist
133
0
                        ($slot) = $persist_slot_find->run("_CACHEVAL_$key");
134
0
0
                        if(!defined($slot)) {
135
0
                                throw OpenSRF::EX::ERROR ("Unable to create cache slot $key in persist server" );
136                        } else {
137                                #XXX destroy the slot and rebuild it to prevent DOS
138                        }
139                }
140
141
0
                ($slot) = $persist_push_stack->run("_CACHEVAL_$key", $value);
142
143
0
0
                if(!$slot) {
144
0
                        throw OpenSRF::EX::ERROR ("Unable to push data onto stack in persist slot _CACHEVAL_$key" );
145                }
146        }
147
148
0
        return $key;
149}
150
151
152 - 154
=head2 delete_cache

=cut
155
156sub delete_cache {
157
0
0
1
        my( $self, $key ) = @_;
158
0
0
0
        if(!$key) { return undef; }
159
0
0
0
        if($self->{persist}){ _load_methods(); }
160
0
        $self->{memcache}->delete($key);
161
0
0
        if( $self->{persist} ) {
162
0
                $persist_destroy_slot->run("_CACHEVAL_$key");
163        }
164
0
        return $key;
165}
166
167
168 - 170
=head2 get_cache

=cut
171
172sub get_cache {
173
0
0
1
        my($self, $key ) = @_;
174
175
0
        my $val = $self->{memcache}->get( $key );
176
0
0
        return OpenSRF::Utils::JSON->JSON2perl($val) if defined($val);
177
178
0
0
0
        if($self->{persist}){ _load_methods(); }
179
180        # if not in memcache but we are persisting, the put it into memcache
181
0
0
        if( $self->{"persist"} ) {
182
0
                $val = $persist_peek_stack->( "_CACHEVAL_$key" );
183
0
0
                if(defined($val)) {
184
0
                        my ($expire) = $persist_slot_get_expire->run("_CACHEVAL_$key");
185
0
0
                        if($expire) {
186
0
                                $self->{memcache}->set( $key, $val, $expire);
187                        } else {
188
0
                                $self->{memcache}->set( $key, $val, $max_persist_time);
189                        }
190
0
                        return OpenSRF::Utils::JSON->JSON2perl($val);
191                }
192        }
193
0
        return undef;
194}
195
196
197 - 199
=head2 _load_methods

=cut
200
201sub _load_methods {
202
203
0
0
0
        if(!$persist_add_slot) {
204
0
                $persist_add_slot =
205                        OpenSRF::Application->method_lookup($persist_add_slot_name);
206
0
0
                if(!ref($persist_add_slot)) {
207
0
                        throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_add_slot_name");
208                }
209        }
210
211
0
0
        if(!$persist_push_stack) {
212
0
                $persist_push_stack =
213                        OpenSRF::Application->method_lookup($persist_push_stack_name);
214
0
0
                if(!ref($persist_push_stack)) {
215
0
                        throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_push_stack_name");
216                }
217        }
218
219
0
0
        if(!$persist_peek_stack) {
220
0
                $persist_peek_stack =
221                        OpenSRF::Application->method_lookup($persist_peek_stack_name);
222
0
0
                if(!ref($persist_peek_stack)) {
223
0
                        throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_peek_stack_name");
224                }
225        }
226
227
0
0
        if(!$persist_destroy_slot) {
228
0
                $persist_destroy_slot =
229                        OpenSRF::Application->method_lookup($persist_destroy_slot_name);
230
0
0
                if(!ref($persist_destroy_slot)) {
231
0
                        throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_destroy_slot_name");
232                }
233        }
234
0
0
        if(!$persist_slot_get_expire) {
235
0
                $persist_slot_get_expire =
236                        OpenSRF::Application->method_lookup($persist_slot_get_expire_name);
237
0
0
                if(!ref($persist_slot_get_expire)) {
238
0
                        throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_get_expire_name");
239                }
240        }
241
0
0
        if(!$persist_slot_find) {
242
0
                $persist_slot_find =
243                        OpenSRF::Application->method_lookup($persist_slot_find_name);
244
0
0
                if(!ref($persist_slot_find)) {
245
0
                        throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_find_name");
246                }
247        }
248}
249
250
251
252
253
254
255
2561;
257