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