OpenSRF/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 => 'max_cache_time' );
  74
  75         if(!ref($servers)){
  76                 $servers = [ $servers ];
  77         }
  78
  79         my $self = {};
  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");
  84         }
  85
  86         bless($self, $class);
  87         $caches{$cache_type} = $self;
  88         return $self;
  89 }
  90
  91
  92
  93 sub put_cache {
  94         my($self, $key, $value, $expiretime ) = @_;
  95         return undef unless( defined $key and defined $value );
  96
  97         $value = JSON->perl2JSON($value);
  98
  99         if($self->{persist}){ _load_methods(); }
 100
 101         $expiretime ||= $max_persist_time;
 102
 103         $self->{memcache}->set( $key, $value, $expiretime ) ||
 104                 throw OpenSRF::EX::ERROR ("Unable to store $key => $value in memcached server" );;
 105
 106         if($self->{"persist"}) {
 107
 108                 my ($slot) = $persist_add_slot->run("_CACHEVAL_$key", $expiretime . "s");
 109
 110                 if(!$slot) {
 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" );
 115                         } else {
 116                                 #XXX destroy the slot and rebuild it to prevent DOS
 117                         }
 118                 }
 119
 120                 ($slot) = $persist_push_stack->run("_CACHEVAL_$key", $value);
 121
 122                 if(!$slot) {
 123                         throw OpenSRF::EX::ERROR ("Unable to push data onto stack in persist slot _CACHEVAL_$key" );
 124                 }
 125         }
 126
 127         return $key;
 128 }
 129
 130 sub delete_cache {
 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");
 137         }
 138         return $key;
 139 }
 140
 141 sub get_cache {
 142         my($self, $key ) = @_;
 143
 144         my $val = $self->{memcache}->get( $key );
 145         return $val if defined($val);
 146
 147         if($self->{persist}){ _load_methods(); }
 148
 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" );
 152                 if(defined($val)) {
 153                         my ($expire) = $persist_slot_get_expire->run("_CACHEVAL_$key");
 154                         if($expire)     {
 155                                 $self->{memcache}->set( $key, $val, $expire);
 156                         } else {
 157                                 $self->{memcache}->set( $key, $val, $max_persist_time);
 158                         }
 159                         return JSON->JSON2perl($val);
 160                 }
 161         }
 162         return undef;
 163 }
 164
 165
 166
 167
 168 sub _load_methods {
 169
 170         if(!$persist_add_slot) {
 171                 $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");
 175                 }
 176         }
 177
 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");
 183                 }
 184         }
 185
 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");
 191                 }
 192         }
 193
 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");
 199                 }
 200         }
 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");
 206                 }
 207         }
 208         if(!$persist_slot_find) {
 209                 $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");
 213                 }
 214         }
 215 }
 216
 217
 218
 219
 220
 221
 222
 223 1;
 224