added initial limiter and cache population
[OpenSRF.git] / src / perlmods / OpenSRF / Utils / Cache.pm
1 package OpenSRF::Utils::Cache;
2 use strict; use warnings;
3 use base qw/Cache::Memcached OpenSRF/;
4 use Cache::Memcached;
5 use OpenSRF::Utils::Config;
6 use OpenSRF::Utils::SettingsClient;
7 use OpenSRF::EX qw(:try);
8 use JSON;
9
10
11 =head OpenSRF::Utils::Cache
12
13 This class just subclasses Cache::Memcached.
14 see Cache::Memcached for more options.
15
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.
19
20 my $cache = OpenSRF::Utils::Cache->current("user");
21 $cache->set( "key1", "value1" [, $expire_secs ] );
22 my $val = $cache->get( "key1" );
23
24
25 =cut
26
27 sub DESTROY {}
28
29 my %caches;
30
31 # ------------------------------------------------------
32 # Persist methods and method names
33 # ------------------------------------------------------
34 my $persist_add_slot; 
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;
40
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";;
48
49 # ------------------------------------------------------
50
51
52 # return a named cache if it exists
53 sub current { 
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 );
58 }
59
60
61 # create a new named memcache object.
62 sub new {
63
64         my( $class, $cache_type, $persist ) = @_;
65         $cache_type ||= 'global';
66         $class = ref( $class ) || $class;
67
68         return $caches{$cache_type} 
69                 if (defined $caches{$cache_type});
70
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 => servers => 'max_cache_time' );
74
75
76         my $self = {};
77         $self->{persist} = $persist || 0;
78         $self->{memcache} = Cache::Memcached->new( { servers => $servers } ); 
79         if(!$self->{memcache}) {
80                 throw OpenSRF::EX::PANIC ("Unable to create a new memcache object for $cache_type");
81         }
82
83         bless($self, $class);
84         $caches{$cache_type} = $self;
85         return $self;
86 }
87
88
89
90 sub put_cache {
91         my($self, $key, $value, $expiretime ) = @_;
92         return undef unless( defined $key and defined $value );
93
94         $value = JSON->perl2JSON($value);
95
96         if($self->{persist}){ _load_methods(); }
97
98         $expiretime ||= $max_persist_time;
99
100         $self->{memcache}->set( $key, $value, $expiretime );
101
102         if($self->{"persist"}) {
103
104                 my ($slot) = $persist_add_slot->run("_CACHEVAL_$key", $expiretime . "s");
105
106                 if(!$slot) {
107                         # slot may already exist
108                         ($slot) = $persist_slot_find->run("_CACHEVAL_$key");
109                         if(!defined($slot)) {
110                                 throw OpenSRF::EX::ERROR ("Unable to create cache slot $key in persist server" );
111                         } else {
112                                 #XXX destroy the slot and rebuild it to prevent DOS
113                         }
114                 }
115
116                 ($slot) = $persist_push_stack->run("_CACHEVAL_$key", $value);
117
118                 if(!$slot) {
119                         throw OpenSRF::EX::ERROR ("Unable to push data onto stack in persist slot _CACHEVAL_$key" );
120                 }
121         }
122
123         return $key;
124 }
125
126 sub delete_cache {
127         my( $self, $key ) = @_;
128         if(!$key) { return undef; }
129         if($self->{persist}){ _load_methods(); }
130         $self->{memcache}->delete($key);
131         if( $self->{persist} ) {
132                 $persist_destroy_slot->run("_CACHEVAL_$key");
133         }
134         return $key; 
135 }
136
137 sub get_cache {
138         my($self, $key ) = @_;
139
140         my $val = $self->{memcache}->get( $key );
141         return $val if defined($val);
142
143         if($self->{persist}){ _load_methods(); }
144
145         # if not in memcache but we are persisting, the put it into memcache
146         if( $self->{"persist"} ) {
147                 $val = $persist_peek_stack->( "_CACHEVAL_$key" );
148                 if(defined($val)) {
149                         my ($expire) = $persist_slot_get_expire->run("_CACHEVAL_$key");
150                         if($expire)     {
151                                 $self->{memcache}->set( $key, $val, $expire);
152                         } else {
153                                 $self->{memcache}->set( $key, $val, $max_persist_time);
154                         }
155                         return JSON->JSON2perl($val);
156                 } 
157         }
158         return undef;
159
160
161
162
163
164 sub _load_methods {
165
166         if(!$persist_add_slot) {
167                 $persist_add_slot = 
168                         OpenSRF::Application->method_lookup($persist_add_slot_name);
169                 if(!ref($persist_add_slot)) {
170                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_add_slot_name");
171                 }
172         }
173
174         if(!$persist_push_stack) {
175                 $persist_push_stack = 
176                         OpenSRF::Application->method_lookup($persist_push_stack_name);
177                 if(!ref($persist_push_stack)) {
178                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_push_stack_name");
179                 }
180         }
181
182         if(!$persist_peek_stack) {
183                 $persist_peek_stack = 
184                         OpenSRF::Application->method_lookup($persist_peek_stack_name);
185                 if(!ref($persist_peek_stack)) {
186                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_peek_stack_name");
187                 }
188         }
189
190         if(!$persist_destroy_slot) {
191                 $persist_destroy_slot = 
192                         OpenSRF::Application->method_lookup($persist_destroy_slot_name);
193                 if(!ref($persist_destroy_slot)) {
194                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_destroy_slot_name");
195                 }
196         }
197         if(!$persist_slot_get_expire) {
198                 $persist_slot_get_expire = 
199                         OpenSRF::Application->method_lookup($persist_slot_get_expire_name);
200                 if(!ref($persist_slot_get_expire)) {
201                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_get_expire_name");
202                 }
203         }
204         if(!$persist_slot_find) {
205                 $persist_slot_find = 
206                         OpenSRF::Application->method_lookup($persist_slot_find_name);
207                 if(!ref($persist_slot_find)) {
208                         throw OpenSRF::EX::PANIC ("Unable to retrieve method $persist_slot_find_name");
209                 }
210         }
211 }
212
213
214
215
216
217
218
219 1;
220