[memcached] bradfitz, r303: detect/use Cache::Memcached::GetParserXS...

commits at code.sixapart.com commits at code.sixapart.com
Tue Jul 18 04:16:11 UTC 2006


detect/use Cache::Memcached::GetParserXS if available



U   trunk/api/perl/ChangeLog
U   trunk/api/perl/lib/Cache/Memcached/GetParser.pm
U   trunk/api/perl/lib/Cache/Memcached.pm


Modified: trunk/api/perl/ChangeLog
===================================================================
--- trunk/api/perl/ChangeLog	2006-07-17 21:24:31 UTC (rev 302)
+++ trunk/api/perl/ChangeLog	2006-07-18 04:16:10 UTC (rev 303)
@@ -1,3 +1,7 @@
+	* abstract out response parsing into own class, and add XS-module
+	  detection, so if you have the XS (C) version, things'll be faster.
+	  that part's not done yet.
+
 2006-07-03
 	* don't use dual scalar/glob sockets.  makes it all profilable
 	  again under SmallProf, DProf, and Devel::Profiler, all three

Modified: trunk/api/perl/lib/Cache/Memcached/GetParser.pm
===================================================================
--- trunk/api/perl/lib/Cache/Memcached/GetParser.pm	2006-07-17 21:24:31 UTC (rev 302)
+++ trunk/api/perl/lib/Cache/Memcached/GetParser.pm	2006-07-18 04:16:10 UTC (rev 303)
@@ -26,12 +26,11 @@
 # returns 1 on success, -1 on failure, and 0 if still working.
 sub parse_from_sock {
     my ($self, $sock) = @_;
-
     my $res;
-    my $ret = $self->[DEST];
 
     # where are we reading into?
     if ($self->[STATE]) { # reading value into $ret
+        my $ret = $self->[DEST];
         $res = sysread($sock, $ret->{$self->[KEY]},
                        $self->[STATE] - $self->[OFFSET],
                        $self->[OFFSET]);
@@ -57,7 +56,7 @@
     # we're reading a single line.
     # first, read whatever's there, but be satisfied with 2048 bytes
     $res = sysread($sock, $self->[BUF],
-                   2048, $self->[OFFSET]);
+                   128*1024, $self->[OFFSET]);
     return 0
         if !defined($res) and $!==EWOULDBLOCK;
     if ($res == 0) {
@@ -67,10 +66,16 @@
 
     $self->[OFFSET] += $res;
 
-    # Below is a hot path.  Should be written in C.
+    return $self->parse_buffer;
+}
 
+# returns 1 on success, -1 on failure, and 0 if still working.
+sub parse_buffer {
+    my ($self) = @_;
+    my $ret = $self->[DEST];
+
   SEARCH:
-    while(1) { # may have to search many times
+    while (1) { # may have to search many times
 
         # do we have a complete END line?
         if ($self->[BUF] =~ /^END\r\n/) {
@@ -114,6 +119,7 @@
         $self->[OFFSET] = length($self->[BUF]);
         last SEARCH;
     }
+    return 0;
 }
 
 1;

Modified: trunk/api/perl/lib/Cache/Memcached.pm
===================================================================
--- trunk/api/perl/lib/Cache/Memcached.pm	2006-07-17 21:24:31 UTC (rev 302)
+++ trunk/api/perl/lib/Cache/Memcached.pm	2006-07-18 04:16:10 UTC (rev 303)
@@ -16,7 +16,14 @@
 use String::CRC32;
 use Errno qw( EINPROGRESS EWOULDBLOCK EISCONN );
 use Cache::Memcached::GetParser;
+my $HAVE_XS = eval "use Cache::Memcached::GetParserXS; 1;";
+$HAVE_XS = 0 if $ENV{NO_XS};
 
+my $parser_class = $HAVE_XS ? "Cache::Memcached::GetParserXS" : "Cache::Memcached::GetParser";
+if ($ENV{XS_DEBUG}) {
+    print "using parser: $parser_class\n";
+}
+
 use fields qw{
     debug no_rehash stats compress_threshold compress_enable stat_callback
     readonly select_timeout namespace namespace_len servers active buckets
@@ -635,7 +642,8 @@
         } else {
             $buf{$_} = join(" ", 'get', @{$sock_keys->{$_}}, "\r\n");
         }
-        $parser{$_} = Cache::Memcached::GetParser->new($ret, $self->{namespace_len}, $finalize);
+
+        $parser{$_} = $parser_class->new($ret, $self->{namespace_len}, $finalize);
     }
 
     my $read = sub {




More information about the memcached-commits mailing list