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