Changeset 12566

Show
Ignore:
Timestamp:
05/27/08 22:40:13 (5 years ago)
Author:
daisuke
Message:

* Add PERL_LIBMEMCACHED_OPTIMIZE flag
* fix incr/decr to appropriately take namespace
* all get/set methods now work with master key

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Cache-Memcached-libmemcached/trunk/lib/Cache/Memcached/libmemcached.pm

    r12502 r12566  
    1717use constant F_STORABLE   => 1; 
    1818use constant F_COMPRESS   => 2; 
     19use constant OPTIMIZE     => $ENV{PERL_LIBMEMCACHED_OPTIMIZE} ? 1 : 0; 
    1920 
    2021BEGIN 
    … …  
    3435    } 
    3536 
    36     # proxy these methods 
    37     foreach my $method qw(set add replace prepend append cas) { 
    38         eval <<"        EOSUB"; 
    39             sub $method {  
    40                 my \$self = shift; 
    41                 my (\$master_key, \$key) = \$self->__to_keys(shift); 
    42                 if (\$master_key) { 
    43                     \$self->SUPER::memcached_${method}_by_key(\$master_key, \$key, \@_); 
    44                 } else { 
    45                     \$self->SUPER::memcached_${method}(\$key, \@_); 
     37    if (OPTIMIZE) { 
     38        # If the optimize flag is enabled, we do not support master key 
     39        # generation, cause we really care about the speed. 
     40        foreach my $method qw(get set add replace prepend append cas delete) { 
     41            eval <<"            EOSUB"; 
     42                sub $method { 
     43                    my \$self = shift; 
     44                    my \$key  = shift; 
     45                    if (\$self->{namespace}) { 
     46                        \$key = "\$self->{namespace}\$key"; 
     47                    } 
     48                    \$self->SUPER::memcached_${method}(\$key, \@_) 
    4649                } 
    47             } 
    48         EOSUB 
    49         die if $@; 
     50            EOSUB 
     51            die if $@; 
     52        } 
     53    } else { 
     54        # Regular case. 
     55        # Mental note. We only do this cause while we're faster than 
     56        # Cache::Memcached::Fast, *even* when the above optimization isn't 
     57        # toggled. 
     58        foreach my $method qw(get set add replace prepend append cas delete) { 
     59            eval <<"            EOSUB"; 
     60                sub $method {  
     61                    my \$self = shift; 
     62                    my \$key  = shift; 
     63                    my \$master_key; 
     64                    if (ref \$key eq 'ARRAY') { 
     65                        (\$master_key, \$key) = @\$key; 
     66                    } 
     67 
     68                    if (\$self->{namespace}) { 
     69                        \$key = "\$self->{namespace}\$key"; 
     70                    } 
     71                    if (\$master_key) { 
     72                        \$self->SUPER::memcached_${method}_by_key(\$master_key, \$key, \@_); 
     73                    } else { 
     74                        \$self->SUPER::memcached_${method}(\$key, \@_); 
     75                    } 
     76                } 
     77            EOSUB 
     78            die if $@; 
     79        } 
    5080    } 
    5181} 
    … …  
    111141        $self->memcached_server_add_unix_socket( $server ); 
    112142    } 
    113 } 
    114  
    115 sub __to_keys 
    116 { 
    117     my $self = shift; 
    118     my $key  = shift; 
    119  
    120     my $master_key; 
    121     if (ref $key eq 'ARRAY') { 
    122         ($master_key, $key) = @$key; 
    123     } 
    124  
    125     if ($self->{namespace}) { 
    126         $key .= "$self->{namespace}$key"; 
    127     } 
    128     return ($master_key, $key); 
    129 } 
    130  
    131 sub get 
    132 { 
    133     my $self = shift; 
    134     my ($master_key, $key) = $self->__to_keys(shift); 
    135     $self->SUPER::get($master_key ? [$master_key, $key] : $key, @_); 
    136143} 
    137144 
    … …  
    180187} 
    181188 
    182 sub delete { shift->memcached_delete($_[0], int($_[1] || 0)) } 
    183  
    184189sub incr 
    185190{ 
    186191    my $self = shift; 
    187     $_[0] or croak("No key specified in incr"); 
    188     $_[1] ||= 1 if @_ < 2; 
     192    my $key  = shift; 
     193    if ($self->{namespace}) { 
     194        $key = "$self->{namespace}$key"; 
     195    } 
     196    $_[0] ||= 1 if @_ < 2; 
    189197    my $val = 0; 
    190     $self->memcached_increment(@_[0,1], $val); 
     198    $self->memcached_increment($key, $_[0], $val); 
    191199    return $val; 
    192200} 
    … …  
    195203{ 
    196204    my $self = shift; 
    197     $_[0] or croak("No key specified in decr"); 
    198     $_[1] ||= 1 if @_ < 2; 
     205    my $key  = shift; 
     206    if ($self->{namespace}) { 
     207        $key = "$self->{namespace}$key"; 
     208    } 
     209    $_[0] ||= 1 if @_ < 2; 
    199210    my $val = 0; 
    200     $self->memcached_decrement(@_[0,1], $val); 
     211    $self->memcached_decrement($key, $_[0], $val); 
    201212    return $val; 
    202213} 
    … …  
    633644Enable/disable CAS support. 
    634645 
     646=head1 OPTIMIZE FLAG 
     647 
     648There's an EXPERIMENTAL optimization available for some corner cases, where 
     649if you know before hand that you won't be using some features, you can 
     650disable them all together for some performance boost. To enable this mode, 
     651set an environment variable named PERL_LIBMEMCACHED_OPTIMIZE to a true value 
     652 
     653=head2 NO MASTER KEY SUPPORT 
     654 
     655If you are 100% sure that you won't be using the master key support, where  
     656you provide an arrayref as the key, you get about 4~5% performance boost. 
     657 
    635658=head1 VARIOUS MEMCACHED MODULES 
    636659