Changeset 5620

Timestamp:

01/27/08 14:34:23 (5 years ago)

Author:

daisuke

Message:

lang/perl/Cache-Memcached-LibMemcached?; starting to work with new perl-memcached's set/get callbacks. Lots of tests still fail

Files:

• lang/perl/Cache-Memcached-LibMemcached/branch/perl-memcached/lib/Cache/Memcached/LibMemcached.pm (modified) (7 diffs)

lang/perl/Cache-Memcached-LibMemcached/branch/perl-memcached/lib/Cache/Memcached/LibMemcached.pm

@@ -40 +40 @@
 
     # proxy these methods
-    foreach my $method qw(delete) {
+    foreach my $method qw(delete get set add replace) {
         eval <<"        EOSUB";
             sub $method {
@@ -69 +69 @@
     $self->set_servers($args->{servers});
 
-    Memcached::libmemcached::memcached_set_fetch_callback($memd, \&_deflate_callback);
+    # Set compression/serialization callbacks
+    Memcached::libmemcached::memcached_set_callback_coderefs($memd, 
+        # Closures so we have reference to $self
+        $self->_mk_callbacks()
+    );
 
     return $self;
@@ -96 +100 @@
 }
 
-sub get
-{
-    my $self = shift;
-    my $key = shift;
-    my ($flags, $rc);
-    my $value = Memcached::libmemcached::memcached_get($self->[MEMD_BACKEND], $key, $flags, $rc);
-    
-    if ($flags & F_COMPRESS) {
-        if (! HAVE_ZLIB) {
-            croak("Data for $key is compressed, but we have no Compress::Zlib");
-        }
-        $value = Compress::Zlib::memGunzip($value);
-    }
-
-    if ($flags & F_STORABLE) {
-        $value = Storable::thaw($value);
-    }
-    return $value;
-}
-
 sub get_multi
 {
@@ -124 +108 @@
 }
 
-sub _deflate_callback
-{
-    my ($key, $value, $flags) = @_;
-    if ($flags & F_COMPRESS) {
-        if (! HAVE_ZLIB) {
-            croak("Data for $key is compressed, but we have no Compress::Zlib");
+sub _mk_callbacks
+{
+    my $self = shift;
+
+    my $inflate = sub {
+        my ($key, $flags) = @_;
+        if ($flags & F_COMPRESS) {
+            if (! HAVE_ZLIB) {
+                croak("Data for $key is compressed, but we have no Compress::Zlib");
+            }
+            $_ = Compress::Zlib::memGunzip($_);
         }
-        $value = Compress::Zlib::memGunzip($value);
-    }
-
-    if ($flags & F_STORABLE) {
-        $value = Storable::thaw($value);
-    }
-    return $value;
-}
-
-sub set
-{
-    my $self    = shift;
-    my $key     = shift;
-    my $value   = shift;
-    my $expires = shift || 0;
-
-    my $flags = 0;
-    # Check if we have a complex structure
-    if (ref $value) {
-        $value = Storable::nfreeze($value);
-        $flags |= F_STORABLE;
-    }
-
-    # Check if we need compression
-    if (HAVE_ZLIB && $self->[MEMD_COMPRESS_ENABLE] && $self->[MEMD_COMPRESS_THRESHOLD]) {
-        # Find the byte length
-        my $length = bytes::length($value);
-        if ($length > $self->[MEMD_COMPRESS_THRESHOLD]) {
-            my $tmp = Compress::Zlib::memGzip($value);
-            if (1 - bytes::length($tmp) / $length < $self->[MEMD_COMPRESS_SAVINGS]) {
-                $value = $tmp;
-                $flags |= F_COMPRESS;
+
+        if ($flags & F_STORABLE) {
+            $_ = Storable::thaw($_);
+        }
+        return ();
+    };
+
+    my $deflate = sub {
+        my ($key, $flags) = @_;
+        # Check if we have a complex structure
+
+        if (ref $_) {
+            $_ = Storable::nfreeze($_);
+            $flags |= F_STORABLE;
+        }
+
+        # Check if we need compression
+        if (HAVE_ZLIB && $self->[MEMD_COMPRESS_ENABLE] && $self->[MEMD_COMPRESS_THRESHOLD]) {
+            # Find the byte length
+            my $length = bytes::length($_);
+            if ($length > $self->[MEMD_COMPRESS_THRESHOLD]) {
+                my $tmp = Compress::Zlib::memGzip($_);
+                if (1 - bytes::length($tmp) / $length < $self->[MEMD_COMPRESS_SAVINGS]) {
+                    $_ = $tmp;
+                    $flags |= F_COMPRESS;
+                }
             }
         }
-    }
-
-    return Memcached::libmemcached::memcached_set($self->[MEMD_BACKEND], $key, $value, $expires, $flags);
-}
-
-sub replace
-{
-    my $self = shift;
-    Memcached::libmemcached::memcached_replace($self->[MEMD_BACKEND], @_[0, 1, 2]);
+        return ();
+    };
+    return ($deflate, $inflate);
 }
 
@@ -180 +157 @@
     my $self = shift;
     my $val;
-    Memcached::libmemcached::memcached_increment($self->[MEMD_BACKEND], $_[0], $_[1] || 1, $val);
+    Memcached::libmemcached::memcached_increment($self->[MEMD_BACKEND], @_, $val);
     return $val;
 }
@@ -188 +165 @@
     my $self = shift;
     my $val;
-    Memcached::libmemcached::memcached_decrement($self->[MEMD_BACKEND], $_[0], $_[1] || 1, $val);
+    Memcached::libmemcached::memcached_decrement($self->[MEMD_BACKEND], @_, $val);
     return $val;
 }
@@ -199 +176 @@
 
 *remove = \&delete;
+
+sub disconnect_all
+{
+    my $self = shift;
+    Memcached::libmemcached::memcached_quit($self->[MEMD_BACKEND]);
+}
+
+sub stats { +{} }
 
 1;