1 package OpenSRF::Utils::Cache;
2 use strict; use warnings;
3 use base qw/Cache::Memcached OpenSRF/;
5 use OpenSRF::Utils::Config;
6 use OpenSRF::Utils::SettingsClient;
7 use OpenSRF::EX qw(:try);
11 =head OpenSRF::Utils::Cache
13 This class just subclasses Cache::Memcached.
14 see Cache::Memcached for more options.
16 The value passed to the call to current is the cache type
17 you wish to access. The below example sets/gets data
18 from the 'user' cache.
20 my $cache = OpenSRF::Utils::Cache->current("user");
21 $cache->set( "key1", "value1" [, $expire_secs ] );
22 my $val = $cache->get( "key1" );
31 # ------------------------------------------------------
32 # Persist methods and method names
33 # ------------------------------------------------------
35 my $persist_push_stack;
36 my $persist_peek_stack;
37 my $persist_destroy_slot;
38 my $persist_slot_get_expire;
39 my $persist_slot_find;
41 my $max_persist_time = 86400;
42 my $persist_add_slot_name = "opensrf.persist.slot.create_expirable";
43 my $persist_push_stack_name = "opensrf.persist.stack.push";
44 my $persist_peek_stack_name = "opensrf.persist.stack.peek";
45 my $persist_destroy_slot_name = "opensrf.persist.slot.destroy";
46 my $persist_slot_get_expire_name = "opensrf.persist.slot.get_expire";
47 my $persist_slot_find_name = "opensrf.persist.slot.find";;
49 # ------------------------------------------------------
52 # return a named cache if it exists
54 my ( $class, $c_type ) = @_;
55 return undef unless $c_type;
56 return $caches{$c_type} if exists $caches{$c_type};
57 return $caches{$c_type} = $class->new( $c_type );
61 # create a new named memcache object.
64 my( $class, $cache_type, $persist ) = @_;
65 $cache_type ||= 'global';
66 $class = ref( $class ) || $class;
68 return $caches{$cache_type}
69 if (defined $caches{$cache_type});
71 my $conf = OpenSRF::Utils::SettingsClient->new;
72 my $servers = $conf->config_value( cache => $cache_type => servers => 'server' );
73 my $expire_time = $conf->config_value( cache => $cache_type => 'max_cache_time' );
76 $servers = [ $servers ];
80 $self->{persist} = $persist || 0;
81 $self->{memcache} = Cache::Memcached->new( { servers => $servers } );
82 if(!$self->{memcache}) {
83 throw OpenSRF::EX::PANIC ("Unable to create a new memcache object for $cache_type");
87 $caches{$cache_type} = $self;
94 my($self, $key, $value, $expiretime ) = @_;
95 return undef unless( defined $key and defined $value );
97 $value = JSON->perl2JSON($value);
99 if($self->{persist}){ _load_methods(); }
101 $expiretime ||= $max_persist_time;
103 $self->{memcache}->set( $key, $value, $expiretime ) ||
104 throw OpenSRF::EX::ERROR ("Unable to store $key => $value in memcached server" );;
106 if($self->{"persist"}) {
108 my ($slot) = $persist_add_slot->run("_CACHEVAL_$key", $expiretime . "s");
111 # slot may already exist
112 ($slot) = $persist_slot_find->run("_CACHEVAL_$key");
113 if(!defined($slot)) {
114 throw OpenSRF::EX::ERROR ("Unable to create cache slot $key in persist server" );
116 #XXX destroy the slot and rebuild it to prevent DOS
120 ($slot) = $persist_push_stack->run("_CACHEVAL_$key", $value);
123 throw OpenSRF::EX::ERROR ("Unable to push data onto stack in persist slot _CACHEVAL_$key" );
131 my( $self, $key ) = @_;
132 if(!$key) { return undef; }
133 if($self->{persist}){ _load_methods(); }
134 $self->{memcache}->delete($key);
135 if( $self->{persist} ) {
136 $persist_destroy_slot->run("_CACHEVAL_$key");
142 my($self, $key ) = @_;
144 my $val = $self->{memcache}->get( $key );
145 return $val if defined($val);
147 if($self->{persist}){ _load_methods(); }
149 # if not in memcache but we are persisting, the put it into memcache
150 if( $self->{"persist"} ) {
151 $val = $persist_peek_stack->( "_CACHEVAL_$key" );
153 my ($expire) = $persist_slot_get_expire->run("_CACHEVAL_$key");
155 $self->{memcache}->set( $key, $val, $expire);
157 $self->{memcache}->set( $key, $val, $max_persist_time);
159 return JSON->JSON2perl($val);
170 if(!$persist_add_slot) {
172 OpenSRF::Application->method_lookup($persist_add_slot_name);
173 if(!ref($persist_add_slot)) {
174 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_add_slot_name");
178 if(!$persist_push_stack) {
179 $persist_push_stack =
180 OpenSRF::Application->method_lookup($persist_push_stack_name);
181 if(!ref($persist_push_stack)) {
182 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_push_stack_name");
186 if(!$persist_peek_stack) {
187 $persist_peek_stack =
188 OpenSRF::Application->method_lookup($persist_peek_stack_name);
189 if(!ref($persist_peek_stack)) {
190 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_peek_stack_name");
194 if(!$persist_destroy_slot) {
195 $persist_destroy_slot =
196 OpenSRF::Application->method_lookup($persist_destroy_slot_name);
197 if(!ref($persist_destroy_slot)) {
198 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_destroy_slot_name");
201 if(!$persist_slot_get_expire) {
202 $persist_slot_get_expire =
203 OpenSRF::Application->method_lookup($persist_slot_get_expire_name);
204 if(!ref($persist_slot_get_expire)) {
205 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_get_expire_name");
208 if(!$persist_slot_find) {
210 OpenSRF::Application->method_lookup($persist_slot_find_name);
211 if(!ref($persist_slot_find)) {
212 throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_find_name");