Changeset 15787 for lang/perl/Data-Valve

Show
Ignore:
Timestamp:
07/14/08 15:26:52 (5 years ago)
Author:
daisuke
Message:

Refactor main non-memory throttling from memcached.pm

Location:
lang/perl/Data-Valve/trunk
Files:
2 added
2 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Data-Valve/trunk/lib/Data/Valve/BucketStore/Memcached.pm

    r15634 r15787  
    11# $Id$ 
    22 
    3 # TODO I think we need locking! 
    43package Data::Valve::BucketStore::Memcached; 
    54use Moose; 
    65use Moose::Util::TypeConstraints; 
    76 
    8 use KeyedMutex; 
    9  
    10 with 'Data::Valve::BucketStore'; 
     7extends 'Data::Valve::BucketStore::Object'; 
    118 
    129subtype 'Memcached' 
    … …  
    3128; 
    3229 
    33 class_type 'KeyedMutex'; 
    34  
    35 coerce 'KeyedMutex' 
    36     => from 'HashRef' 
    37         => via { 
    38             my $h = $_; 
    39             KeyedMutex->new($h->{args}); 
    40         } 
    41 ; 
    42  
    43 has 'memcached' => ( 
    44     is       => 'rw', 
     30has '+store' => ( 
    4531    isa      => 'Memcached', 
    4632    coerce   => 1, 
    … …  
    4834); 
    4935 
    50 has 'mutex' => ( 
    51     is => 'rw', 
    52     isa => 'KeyedMutex', 
    53     coerce => 1, 
    54 ); 
     36__PACKAGE__->meta->make_immutable; 
    5537 
    5638no Moose; 
    57  
    58 sub BUILD { 
    59     my $self = shift; 
    60  
    61     # if no keyedmutex was provided explicitly, we attempt to create one 
    62     # however, if the creation of this object fails, well, we can go 
    63     # without it in degraded mode 
    64     if ( ! $self->mutex ) { 
    65         my $mutex = eval {KeyedMutex->new }; 
    66         if ($mutex) { 
    67             $self->mutex($mutex); 
    68         } else { 
    69             warn $@; 
    70         } 
    71     } 
    72 } 
    73  
    74 sub try_push { 
    75     my ($self, %args) = @_; 
    76  
    77     my $key = $args{key}; 
    78  
    79     my $mutex = $self->mutex; 
    80  
    81     my $rv; 
    82     my $done = 0; 
    83     while ( ! $done) { 
    84         my $lock = $mutex ? $mutex->lock($key, 1) : 1; 
    85         next unless $lock; 
    86  
    87         $done = 1; 
    88         my $bucket_source = $self->memcached->get($key); 
    89         my $bucket; 
    90         if ($bucket_source) { 
    91             $bucket = Data::Valve::Bucket->deserialize($bucket_source, $self->interval, $self->max_items); 
    92         } else { 
    93             $bucket = Data::Valve::Bucket->new( 
    94                 interval  => $self->interval, 
    95                 max_items => $self->max_items, 
    96             ); 
    97         } 
    98         $rv = $bucket->try_push(); 
    99  
    100         # we only need to set if the value has changed, i.e., the throttle 
    101         # was successful 
    102         if ($rv) { 
    103             $self->memcached->set($key, $bucket->serialize); 
    104         } 
    105     } 
    106  
    107     return $rv; 
    108 } 
    10939 
    110401; 
    … …  
    12050Data::Valve::BucketStore::Memcached uses Memcached as its storage backend, 
    12151and allows multiple processes to work together. 
     52 
     53You need to specify a memcached server in order for t to work: 
     54 
     55  Data::Valve->new( 
     56    bucket_store => { 
     57      module => "Memcached", 
     58      args => { 
     59        store => { 
     60          servers => [ '127.0.0.1:11211' ], 
     61          namespace => ... 
     62        } 
     63      } 
     64    } 
     65  ); 
    12266 
    12367This module also provides locking mechanism by means of KeyedMutex. 

  • lang/perl/Data-Valve/trunk/t/03_memcached.t

    r15627 r15787  
    4343            module => "Memcached", 
    4444            args   => { 
    45                 memcached => { 
     45                store => { 
    4646                    args => { 
    4747                        servers => [ $ENV{MEMCACHED_SERVER} ], 
    … …  
    7474            module => "Memcached", 
    7575            args   => { 
    76                 memcached => { 
     76                store => { 
    7777                    args => { 
    7878                        servers => [ $ENV{MEMCACHED_SERVER} ],