[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