1 package OpenSRF::Utils::Cache;
2 use strict; use warnings;
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;
11 my $log = 'OpenSRF::Utils::Logger';
19 This class just subclasses Cache::Memcached.
20 see Cache::Memcached for more options.
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.
26 my $cache = OpenSRF::Utils::Cache->current("user");
27 $cache->set( "key1", "value1" [, $expire_secs ] );
28 my $val = $cache->get( "key1" );
37 # ------------------------------------------------------
38 # Persist methods and method names
39 # ------------------------------------------------------
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;
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";;
55 # ------------------------------------------------------
61 Return a named cache if it exists
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 );
75 Create a new named memcache object.
81 my( $class, $cache_type, $persist ) = @_;
82 $cache_type ||= 'global';
83 $class = ref( $class ) || $class;
85 return $caches{$cache_type} if (defined $caches{$cache_type});
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' );
91 $servers = [ $servers ] if(!ref($servers));
94 $self->{persist} = $persist || 0;
95 $self->{memcache} = Cache::Memcached->new( { servers => $servers } );
96 if(!$self->{memcache}) {
97 open(CACHEFOO, '>', '/tmp/cached');
98 print CACHEFOO "De nada\n";
100 throw OpenSRF::EX::PANIC ("Unable to create a new memcache object for $cache_type");
103 bless($self, $class);
104 $caches{$cache_type} = $self;
114 my($self, $key, $value, $expiretime ) = @_;
115 return undef unless( defined $key and defined $value );
117 $value = OpenSRF::Utils::JSON->perl2JSON($value);
119 if($self->{persist}){ _load_methods(); }
121 $expiretime ||= $max_persist_time;
123 unless( $self->{memcache}->set( $key, $value, $expiretime ) ) {
124 $log->error("Unable to store $key => [".length($value)." bytes] in memcached server" );
128 $log->debug("Stored $key => $value in memcached server", INTERNAL);
130 if($self->{"persist"}) {
132 my ($slot) = $persist_add_slot->run("_CACHEVAL_$key", $expiretime . "s");
135 # slot may already exist
136 ($slot) = $persist_slot_find->run("_CACHEVAL_$key");
137 if(!defined($slot)) {
138 throw OpenSRF::EX::ERROR ("Unable to create cache slot $key in persist server" );
140 #XXX destroy the slot and rebuild it to prevent DOS
144 ($slot) = $persist_push_stack->run("_CACHEVAL_$key", $value);
147 throw OpenSRF::EX::ERROR ("Unable to push data onto stack in persist slot _CACHEVAL_$key" );
160 my( $self, $key ) = @_;
161 if(!$key) { return undef; }
162 if($self->{persist}){ _load_methods(); }
163 $self->{memcache}->delete($key);
164 if( $self->{persist} ) {
165 $persist_destroy_slot->run("_CACHEVAL_$key");
176 my($self, $key ) = @_;
178 my $val = $self->{memcache}->get( $key );
179 return OpenSRF::Utils::JSON->JSON2perl($val) if defined($val);
181 if($self->{persist}){ _load_methods(); }
183 # if not in memcache but we are persisting, the put it into memcache
184 if( $self->{"persist"} ) {
185 $val = $persist_peek_stack->( "_CACHEVAL_$key" );
187 my ($expire) = $persist_slot_get_expire->run("_CACHEVAL_$key");
189 $self->{memcache}->set( $key, $val, $expire);
191 $self->{memcache}->set( $key, $val, $max_persist_time);
193 return OpenSRF::Utils::JSON->JSON2perl($val);
206 if(!$persist_add_slot) {
208 OpenSRF::Application->method_lookup($persist_add_slot_name);
209 if(!ref($persist_add_slot)) {
210 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_add_slot_name");
214 if(!$persist_push_stack) {
215 $persist_push_stack =
216 OpenSRF::Application->method_lookup($persist_push_stack_name);
217 if(!ref($persist_push_stack)) {
218 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_push_stack_name");
222 if(!$persist_peek_stack) {
223 $persist_peek_stack =
224 OpenSRF::Application->method_lookup($persist_peek_stack_name);
225 if(!ref($persist_peek_stack)) {
226 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_peek_stack_name");
230 if(!$persist_destroy_slot) {
231 $persist_destroy_slot =
232 OpenSRF::Application->method_lookup($persist_destroy_slot_name);
233 if(!ref($persist_destroy_slot)) {
234 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_destroy_slot_name");
237 if(!$persist_slot_get_expire) {
238 $persist_slot_get_expire =
239 OpenSRF::Application->method_lookup($persist_slot_get_expire_name);
240 if(!ref($persist_slot_get_expire)) {
241 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_get_expire_name");
244 if(!$persist_slot_find) {
246 OpenSRF::Application->method_lookup($persist_slot_find_name);
247 if(!ref($persist_slot_find)) {
248 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_find_name");