20f76df04ca94353a722f1510f59b958349b10f9
[OpenSRF.git] / src / perl / lib / OpenSRF / Utils / Cache.pm
1 package OpenSRF::Utils::Cache;
2 use strict; use warnings;
3 use base qw/OpenSRF/;
4 use Cache::Memcached;
5 use OpenSRF::Utils::Logger qw/:level/;
6 use OpenSRF::Utils::Config;
7 use OpenSRF::Utils::SettingsClient;
8 use OpenSRF::EX qw(:try);
9 use OpenSRF::Utils::JSON;
10
11 my $log = 'OpenSRF::Utils::Logger';
12
13 =head1 NAME
14
15 OpenSRF::Utils::Cache
16
17 =head1 SYNOPSIS
18
19 This class just subclasses Cache::Memcached.
20 see Cache::Memcached for more options.
21
22 The value passed to the call to current is the cache type
23 you wish to access.  The below example sets/gets data
24 from the 'user' cache.
25
26 my $cache = OpenSRF::Utils::Cache->current("user");
27 $cache->set( "key1", "value1" [, $expire_secs ] );
28 my $val = $cache->get( "key1" );
29
30
31 =cut
32
33 sub DESTROY {}
34
35 my %caches;
36
37 # ------------------------------------------------------
38 # Persist methods and method names
39 # ------------------------------------------------------
40 my $persist_add_slot; 
41 my $persist_push_stack;
42 my $persist_peek_stack;
43 my $persist_destroy_slot;
44 my $persist_slot_get_expire;
45 my $persist_slot_find;
46
47 my $max_persist_time;
48 my $persist_add_slot_name        = "opensrf.persist.slot.create_expirable";
49 my $persist_push_stack_name      = "opensrf.persist.stack.push";
50 my $persist_peek_stack_name      = "opensrf.persist.stack.peek";
51 my $persist_destroy_slot_name    = "opensrf.persist.slot.destroy";
52 my $persist_slot_get_expire_name = "opensrf.persist.slot.get_expire";
53 my $persist_slot_find_name       = "opensrf.persist.slot.find";;
54
55 # ------------------------------------------------------
56
57 =head1 METHODS
58
59 =head2 current
60
61 Return a named cache if it exists
62
63 =cut
64
65 sub current {
66         my ( $class, $c_type )  = @_;
67         return undef unless $c_type;
68         return $caches{$c_type} if exists $caches{$c_type};
69         return $caches{$c_type} = $class->new( $c_type );
70 }
71
72
73 =head2 new
74
75 Create a new named memcache object.
76
77 =cut
78
79 sub new {
80
81         my( $class, $cache_type, $persist ) = @_;
82         $cache_type ||= 'global';
83         $class = ref( $class ) || $class;
84
85         return $caches{$cache_type} if (defined $caches{$cache_type});
86
87         my $conf = OpenSRF::Utils::SettingsClient->new;
88         my $servers = $conf->config_value( cache => $cache_type => servers => 'server' );
89         $max_persist_time = $conf->config_value( cache => $cache_type => 'max_cache_time' );
90
91         $servers = [ $servers ] if(!ref($servers))
92
93         my $self = {};
94         $self->{persist} = $persist || 0;
95         $self->{memcache} = Cache::Memcached->new( { servers => $servers } ); 
96         if(!$self->{memcache}) {
97                 throw OpenSRF::EX::PANIC ("Unable to create a new memcache object for $cache_type");
98         }
99
100         bless($self, $class);
101         $caches{$cache_type} = $self;
102         return $self;
103 }
104
105
106 =head2 put_cache
107
108 =cut
109
110 sub put_cache {
111         my($self, $key, $value, $expiretime ) = @_;
112         return undef unless( defined $key and defined $value );
113
114         $value = OpenSRF::Utils::JSON->perl2JSON($value);
115
116         if($self->{persist}){ _load_methods(); }
117
118         $expiretime ||= $max_persist_time;
119
120         unless( $self->{memcache}->set( $key, $value, $expiretime ) ) {
121                 $log->error("Unable to store $key => [".length($value)." bytes]  in memcached server" );
122                 return undef;
123         }
124
125         $log->debug("Stored $key => $value in memcached server", INTERNAL);
126
127         if($self->{"persist"}) {
128
129                 my ($slot) = $persist_add_slot->run("_CACHEVAL_$key", $expiretime . "s");
130
131                 if(!$slot) {
132                         # slot may already exist
133                         ($slot) = $persist_slot_find->run("_CACHEVAL_$key");
134                         if(!defined($slot)) {
135                                 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                 ($slot) = $persist_push_stack->run("_CACHEVAL_$key", $value);
142
143                 if(!$slot) {
144                         throw OpenSRF::EX::ERROR ("Unable to push data onto stack in persist slot _CACHEVAL_$key" );
145                 }
146         }
147
148         return $key;
149 }
150
151
152 =head2 delete_cache
153
154 =cut
155
156 sub delete_cache {
157         my( $self, $key ) = @_;
158         if(!$key) { return undef; }
159         if($self->{persist}){ _load_methods(); }
160         $self->{memcache}->delete($key);
161         if( $self->{persist} ) {
162                 $persist_destroy_slot->run("_CACHEVAL_$key");
163         }
164         return $key; 
165 }
166
167
168 =head2 get_cache
169
170 =cut
171
172 sub get_cache {
173         my($self, $key ) = @_;
174
175         my $val = $self->{memcache}->get( $key );
176         return OpenSRF::Utils::JSON->JSON2perl($val) if defined($val);
177
178         if($self->{persist}){ _load_methods(); }
179
180         # if not in memcache but we are persisting, the put it into memcache
181         if( $self->{"persist"} ) {
182                 $val = $persist_peek_stack->( "_CACHEVAL_$key" );
183                 if(defined($val)) {
184                         my ($expire) = $persist_slot_get_expire->run("_CACHEVAL_$key");
185                         if($expire)     {
186                                 $self->{memcache}->set( $key, $val, $expire);
187                         } else {
188                                 $self->{memcache}->set( $key, $val, $max_persist_time);
189                         }
190                         return OpenSRF::Utils::JSON->JSON2perl($val);
191                 }
192         }
193         return undef;
194 }
195
196
197 =head2 _load_methods
198
199 =cut
200
201 sub _load_methods {
202
203         if(!$persist_add_slot) {
204                 $persist_add_slot = 
205                         OpenSRF::Application->method_lookup($persist_add_slot_name);
206                 if(!ref($persist_add_slot)) {
207                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_add_slot_name");
208                 }
209         }
210
211         if(!$persist_push_stack) {
212                 $persist_push_stack = 
213                         OpenSRF::Application->method_lookup($persist_push_stack_name);
214                 if(!ref($persist_push_stack)) {
215                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_push_stack_name");
216                 }
217         }
218
219         if(!$persist_peek_stack) {
220                 $persist_peek_stack = 
221                         OpenSRF::Application->method_lookup($persist_peek_stack_name);
222                 if(!ref($persist_peek_stack)) {
223                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_peek_stack_name");
224                 }
225         }
226
227         if(!$persist_destroy_slot) {
228                 $persist_destroy_slot = 
229                         OpenSRF::Application->method_lookup($persist_destroy_slot_name);
230                 if(!ref($persist_destroy_slot)) {
231                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_destroy_slot_name");
232                 }
233         }
234         if(!$persist_slot_get_expire) {
235                 $persist_slot_get_expire = 
236                         OpenSRF::Application->method_lookup($persist_slot_get_expire_name);
237                 if(!ref($persist_slot_get_expire)) {
238                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_get_expire_name");
239                 }
240         }
241         if(!$persist_slot_find) {
242                 $persist_slot_find = 
243                         OpenSRF::Application->method_lookup($persist_slot_find_name);
244                 if(!ref($persist_slot_find)) {
245                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_find_name");
246                 }
247         }
248 }
249
250
251
252
253
254
255
256 1;
257