cgi-bin/LJ/MemCacheable.pm

   1 package LJ::MemCacheable;
   2
   3 use strict;
   4 use warnings;
   5 use LJ::MemCacheProxy;
   6 use String::CRC32 qw/crc32/;
   7
   8 ##
   9 ## Mixin class for objects to be stored in Memcache
  10 ## See LJ::MemCache and LJ::User::memcache_set_u/memcache_get_u for idea
  11 ##
  12 ## Derived classes must implement the following methods:
  13 ## _memcache_id                 { $_[0]->userid                 }
  14 ## _memcache_key_prefix         { "user"                        }
  15 ## _memcache_stored_props       { qw/$VERSION name age caps /   }
  16 ## _memcache_hashref_to_object  { LJ::User->new_from_row($_[0]) }
  17 ## _memcache_expires            { 24*3600                       }
  18 ##
  19 ## In many cases you can use aliases for subs, e.g.:
  20 ##  *_memcache_hashref_to_object = \&new_from_row;
  21 ##
  22
  23 ##
  24 ## Memcache routines
  25 ##
  26 sub _store_to_memcache {
  27     my $self = shift;
  28
  29     my ($version, @props) = $self->_memcache_stored_props;
  30     my @data = $version;
  31     foreach my $key (@props) {
  32         push @data, $self->{$key};
  33     }
  34     LJ::MemCacheProxy::set($self->_memcache_key, \@data, $self->_memcache_expires);
  35 }
  36
  37 sub _load_from_memcache {
  38     my $class = shift;
  39     my $id = shift;
  40
  41     my $data = LJ::MemCacheProxy::get($class->_memcache_key($id));
  42     return unless $data && ref $data eq 'ARRAY';
  43
  44     my ($version, @props) = $class->_memcache_stored_props;
  45     ## check if memcache contains data with actual version
  46     return unless $data->[0]==$version;
  47     my %hash;
  48     foreach my $i (0..$#props) {
  49         $hash{ $props[$i] } = $data->[$i+1];
  50     }
  51     return $class->_memcache_hashref_to_object(\%hash);
  52 }
  53
  54 ## warning: instance or class method.
  55 ## $id may be absent when calling on instance.
  56 sub _remove_from_memcache {
  57     my $class = shift;
  58     my $id = shift;
  59     LJ::MemCacheProxy::delete($class->_memcache_key($id));
  60 }
  61
  62 sub _memcache_key {
  63     my $class = shift;
  64     my $id = shift || $class->_memcache_id;
  65     my $prefix = $class->_memcache_key_prefix;
  66     if ($id =~ /^\d+$/) {
  67         return [$id, "$prefix:$id"];
  68     }
  69     else{
  70         return [(crc32($id) >> 16) & 0x7fff, "$prefix:$id"];
  71     }
  72 }
  73
  74 1;
  75