Changeset 6655 for lang/perl/Cache-Memcached-libmemcached

Timestamp:

02/14/08 07:36:10 (5 years ago)

Author:

daisuke

Message:

Subclass Memcached::libmemcached

Location:

lang/perl/Cache-Memcached-libmemcached/trunk

Files:

• Makefile.PL (modified) (1 diff)
• lib/Cache/Memcached/libmemcached.pm (modified) (15 diffs)
• t/01_load.t (modified) (1 diff)

lang/perl/Cache-Memcached-libmemcached/trunk/Makefile.PL

@@ -5 +5 @@
 all_from('lib/Cache/Memcached/libmemcached.pm');
 
-requires('Memcached::libmemcached', '0.1402');
+requires('Memcached::libmemcached', '0.1405');
 requires('Storable');
 requires('Carp');

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

@@ -7 +7 @@
 use strict;
 use warnings;
+use base qw(Memcached::libmemcached);
 use Carp qw(croak);
-use Memcached::libmemcached ();
 use Storable ();
 
 our $VERSION = '0.01000';
-
-use constant MEMD_BACKEND            => 0;
-use constant MEMD_COMPRESS_ENABLE    => 1;
-use constant MEMD_COMPRESS_THRESHOLD => 2;
-use constant MEMD_COMPRESS_SAVINGS   => 3;
 
 use constant HAVE_ZLIB    => eval { require Compress::Zlib } && !$@;
@@ -26 +21 @@
     # accessors
     foreach my $field qw(compress_enable compress_threshold compress_savings) {
-        eval sprintf(<<"        EOSUB", $field, uc $field, $field, uc $field);
-            sub set_%s {
-                my \$self = shift;
-                \$self->[ MEMD_%s ] = shift;
-            }
-
-            sub get_%s {
-                shift->[ MEMD_%s ];
-            }
+        eval sprintf(<<"        EOSUB", $field, $field, $field, $field);
+            sub set_%s { \$_[0]->{%s} = \$_[1] }
+            sub get_%s { \$_[0]->{%s} }
         EOSUB
         die if $@;
@@ -40 +29 @@
 
     # proxy these methods
-    foreach my $method qw(delete get set add replace prepend append cas) {
+    foreach my $method qw(delete set add replace prepend append cas) {
         eval <<"        EOSUB";
-            sub $method {
-                Memcached::libmemcached::memcached_$method(shift->[MEMD_BACKEND], \@_)
-            }
+            sub $method { shift->memcached_$method(\@_) }
         EOSUB
         die if $@;
@@ -63 +50 @@
     $args->{servers} || die "No servers specified";
 
-    my $memd  = Memcached::libmemcached::memcached_create();
-    my $self = bless [], $class;
-
-    $self->[MEMD_BACKEND]            = $memd;
-    $self->[MEMD_COMPRESS_THRESHOLD] = $args->{compress_threshold};
-    $self->[MEMD_COMPRESS_SAVINGS]   = $args->{compress_savings} || 0.20;
-    $self->[MEMD_COMPRESS_ENABLE]    =
+    my $self = $class->SUPER::new();
+
+    $self->{compress_threshold} = $args->{compress_threshold};
+    $self->{compress_savingsS}   = $args->{compress_savings} || 0.20;
+    $self->{compress_enable}    =
         exists $args->{compress_enable} ? $args->{compress_enable} : 1;
 
@@ -76 +61 @@
 
     # Set compression/serialization callbacks
-    Memcached::libmemcached::memcached_set_callback_coderefs($memd, 
+    $self->set_callback_coderefs(
         # Closures so we have reference to $self
         $self->_mk_callbacks()
@@ -103 +88 @@
     # check for existance of : 
     if (my ($hostname, $port) = split(/:/, $server)) {
-        Memcached::libmemcached::memcached_server_add( $self->[MEMD_BACKEND], $hostname, $port );
+        $self->memcached_server_add($hostname, $port );
     } else {
-        Memcached::libmemcached::memcached_server_add_unix( $self->[MEMD_BACKEND], $server );
+        $self->memcached_server_add_uni( $server );
     }
-}
-
-sub get_multi
-{
-    my $self = shift;
-    my $hv = {};
-    Memcached::libmemcached::memcached_mget_into_hashref($self->[MEMD_BACKEND], [ @_ ], $hv);
-    return $hv;
 }
 
@@ -144 +121 @@
 
         # Check if we need compression
-        if (HAVE_ZLIB && $self->[MEMD_COMPRESS_ENABLE] && $self->[MEMD_COMPRESS_THRESHOLD]) {
+        if (HAVE_ZLIB && $self->{compress_enable} && $self->{compress_threshold}) {
             # Find the byte length
             my $length = bytes::length($_);
-            if ($length > $self->[MEMD_COMPRESS_THRESHOLD]) {
+            if ($length > $self->{compress_threshold}) {
                 my $tmp = Compress::Zlib::memGzip($_);
-                if (1 - bytes::length($tmp) / $length < $self->[MEMD_COMPRESS_SAVINGS]) {
+                if (1 - bytes::length($tmp) / $length < $self->{compress_savingsS}) {
                     $_ = $tmp;
                     $_[1] |= F_COMPRESS;
@@ -166 +143 @@
     $_[1] ||= 1 if @_ < 2;
     my $val = 0;
-    Memcached::libmemcached::memcached_increment($self->[MEMD_BACKEND], @_[0,1], $val);
+    $self->memcached_increment(@_[0,1], $val);
     return $val;
 }
@@ -176 +153 @@
     $_[1] ||= 1 if @_ < 2;
     my $val = 0;
-    Memcached::libmemcached::memcached_decrement($self->[MEMD_BACKEND], @_[0,1], $val);
+    $self->memcached_decrement(@_[0,1], $val);
     return $val;
 }
@@ -182 +159 @@
 sub flush_all
 {
-    my $self = shift;
-    Memcached::libmemcached::memcached_flush($self->[MEMD_BACKEND], 0);
+    $_[0]->memcached_flush(0);
 }
 
@@ -190 +166 @@
 sub disconnect_all
 {
-    my $self = shift;
-    Memcached::libmemcached::memcached_quit($self->[MEMD_BACKEND]);
+    $_[0]->memcached_quit();
 }
 
@@ -198 +173 @@
 sub is_no_block
 {
-    shift->behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_NO_BLOCK() );
+    shift->memcached_behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_NO_BLOCK() );
 }
 
 sub set_no_block
 {
-    shift->behavior_set(
+    shift->memcached_behavior_set(
         Memcached::libmemcached::MEMCACHED_BEHAVIOR_NO_BLOCK(),
         $_[0]
@@ -211 +186 @@
 sub get_distribution_method
 {
-    shift->behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_DISTRIBUTION() );
+    shift->memcached_behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_DISTRIBUTION() );
 }
 
 sub set_distribution_method
 {
-    shift->behavior_set(
+    shift->memcached_behavior_set(
         Memcached::libmemcached::MEMCACHED_BEHAVIOR_DISTRIBUTION(),
         $_[0]
@@ -224 +199 @@
 sub get_hashing_algorithm
 {
-    shift->behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_HASH() );
+    shift->memcached_behavior_get( Memcached::libmemcached::MEMCACHED_BEHAVIOR_HASH() );
 }
 
 sub set_hashing_algorithm
 {
-    shift->behavior_set(
+    shift->memcached_behavior_set(
         Memcached::libmemcached::MEMCACHED_BEHAVIOR_HASH(),
         $_[0]
     );
-}
-
-sub behavior_get
-{
-    my $self = shift;
-    Memcached::libmemcached::memcached_behavior_get($self->[MEMD_BACKEND], @_);
-}
-
-sub behavior_set
-{
-    my $self = shift;
-    Memcached::libmemcached::memcached_behavior_set($self->[MEMD_BACKEND], @_);
 }
 
@@ -293 +256 @@
 Cache::Memcached::libmemcached attempts to be API compatible with
 Cache::Memcached, so it can be used as a drop-in replacement.
+
+Note that as of version 0.02000, Cache::Memcached::libmemcached I<inherits>
+from Memcached::libmemcached. While you are free to use the 
+Memcached::libmemcached specific methods directly on the object, you should
+use them with care, as it will mean that your code is no longer compatible
+with the Cache::Memcached API therefore losing some of th portability in
+case you want to replace it with some other package.
 
 =head1 FOR Cache::Memcached::LibMemcached USERS

lang/perl/Cache-Memcached-libmemcached/trunk/t/01_load.t

@@ -6 +6 @@
     qw(new get get_multi set stats disconnect_all set_servers flush_all),
     qw(is_no_block set_no_block get_distribution_method set_distribution_method get_hashing_algorithm set_hashing_algorithm),
-    qw(behavior_set behavior_get)
 ) );