src/perlmods/OpenSRF/Utils/Cache.pm

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