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