Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

First non-dev release

- Fixed and added tests for stat command
- Fixed and added tests for compat wrappers
- Removed auto-generated files from git tracking
- Added repository in Makefile.PL
  • Loading branch information...
commit b509a068fc46858c1b80735f7844bb42088a4315 1 parent c25036b
@mnunberg mnunberg authored
View
7 Changes
@@ -1,7 +0,0 @@
-Revision history for Couchbase-Client
-0.16 Feb 23 2012
- Added 32 bit support, some more fixes for mock testing
-
-0.01 Date/time
- First version, released on an unsuspecting world.
-
View
66 MANIFEST
@@ -1,66 +0,0 @@
-Changes
-MANIFEST
-MANIFEST.SKIP
-Makefile.PL
-README.pod
-
-PLCB_ConfUtil.pm
-PLCB_Config.pm
-build_libraries.pl
-
-inc/Devel/CheckLib.pm
-
-lib/Couchbase/Client.pm
-lib/Couchbase/Client/Return.pm
-lib/Couchbase/Client/Errors.pm
-lib/Couchbase/Client/IDXConst.pm
-
-lib/Couchbase/Client/README.pod
-
-lib/Couchbase/Client/Compat.pm
-
-lib/Couchbase/Client/Async.pm
-lib/Couchbase/Client/Async/Event.pm
-lib/Couchbase/Client/Async/Request.pm
-
-lib/Couchbase/MockServer.pm
-lib/Couchbase/Test/ClientSync.pm
-lib/Couchbase/Test/Common.pm
-lib/Couchbase/Test/Async.pm
-lib/Couchbase/Test/Async/Loop.pm
-lib/Couchbase/Test/Settings.pm
-lib/Couchbase/Test/Interop.pm
-lib/Couchbase/Test/Netfail.pm
-
-xs/Client.xs
-xs/Client_multi.xs
-xs/Async.xs
-
-xs/perl-couchbase.h
-xs/perl-couchbase-async.h
-xs/plcb-util.h
-xs/plcb-return.h
-
-xs/callbacks.c
-xs/convert.c
-xs/ctor.c
-xs/async_base.c
-xs/async_callbacks.c
-xs/async_events.c
-
-
-constants/idx_constants.pl
-constants/error_constants.pl
-constants/print_constants.pl
-
-t/00-load.t
-t/01-main.t
-t/tmp/CouchbaseMock.jar
-
-src/Makefile.PL
-src/libcouchbase.pm
-
-src/memcached-headers.tar.gz
-src/libcouchbase-1.0.0_75_g5622928.tar.gz
-src/libvbucket-1.8.0.2.tar.gz
-src/libevent-2.0.17-stable.tar.gz
View
3  MANIFEST.SKIP
@@ -6,3 +6,6 @@
.+_const\.pm
^author_utils
^INSTALL_DIR
+.+\.in
+.+\.kpf
+README\.dist
View
1  MANIFEST.in
@@ -55,6 +55,7 @@ constants/print_constants.pl
t/00-load.t
t/01-main.t
+t/02-compat.t
t/tmp/CouchbaseMock.jar
src/Makefile.PL
View
5 Makefile.PL
@@ -119,6 +119,11 @@ use Log::Fu;
$MM_Options{NEEDS_LINKING} = 1;
+$MM_Options{META_MERGE} = {
+ resources => {
+ repository => 'https://github.com/mnunberg/perl-Couchbase-Client'
+ }
+};
WriteMakefile(
NAME => 'Couchbase::Client',
View
15 README.dist
@@ -0,0 +1,15 @@
+#!/bin/sh
+
+# This file says how to make a proper distribution. It also contains shell
+# scripts to accomplish that end.
+# we need author_utils here.
+
+# first, we update the manifest
+
+perl ./author_utils/gen_manifest.pl
+
+# then, we need to make our changes visible
+
+git log > Changes
+
+# perhaps more steps will be added here in the future
View
2  lib/Couchbase/Client.pm
@@ -2,7 +2,7 @@ package Couchbase::Client;
BEGIN {
require XSLoader;
- our $VERSION = '0.17_0';
+ our $VERSION = '0.18';
XSLoader::load(__PACKAGE__, $VERSION);
}
View
2  lib/Couchbase/Client/Async.pm
@@ -1,7 +1,7 @@
package Couchbase::Client::Async;
use strict;
use warnings;
-our $VERSION = '0.17_0';
+our $VERSION = '0.17';
use Couchbase::Client;
use Couchbase::Client::IDXConst;
use Log::Fu;
View
146 lib/Couchbase/Client/Compat.pm
@@ -3,64 +3,97 @@ use strict;
use warnings;
use base qw(Couchbase::Client);
use Couchbase::Client::Errors;
-
-sub new {
- my ($cls,$options) = @_;
- my $o = $cls->SUPER::new($options);
-}
-
-sub get {
- my $self = shift;
- $self->SUPER::get(@_)->value(@_);
+use base qw(Exporter);
+
+our @EXPORT_OK = qw(return_for_multi_wrap return_for_op);
+
+#These errors are 'negative replies', all others are 'error' replies.
+our %ErrorMap = (
+ COUCHBASE_NOT_STORED, 0,
+ COUCHBASE_KEY_EEXISTS, 0,
+ COUCHBASE_KEY_ENOENT, 0,
+ COUCHBASE_DELTA_BADVAL, 0,
+ COUCHBASE_E2BIG, 0,
+);
+
+sub return_for_multi_wrap {
+ my ($requests,$response,$op) = @_;
+
+ if(wantarray) {
+ #ugh, really?
+ my @retvals;
+ foreach my $req (@$requests) {
+ my $key = ref $req eq 'ARRAY' ? $req->[0] : $req;
+ my $retval = return_for_op($response->{$key}, $op);
+ push @retvals, $retval;
+ }
+ return @retvals;
+ } else {
+ #scalar:
+ while (my ($k,$v) = each %$response) {
+ $response->{$k} = return_for_op($v, $op);
+ }
+ return $response;
+ }
}
-sub gets {
- my $self = shift;
- my $ret = $self->SUPER::get(@_);
- if($ret->is_ok) {
- return [ $ret->cas, $ret->value ];
- } else {
+sub return_for_op {
+ my ($retval, $op) = @_;
+
+ my $errval = $retval->errnum;
+
+ if ($errval) {
+ $errval = $ErrorMap{$errval};
+ }
+
+ if ($retval->errnum && (!defined $errval)) {
+ # Fatal error:
return undef;
}
+
+ if ($op =~ /^(?:get|incr|decr)$/) {
+ return $retval->value;
+ }
+
+ if ($op eq 'gets') {
+ return [$retval->cas, $retval->value];
+ }
+
+ if ($op =~ /^(?:set|cas|add|append|prepend|replace|remove|delete)/) {
+ return int($retval->errnum == 0);
+ }
+
}
-
-foreach my $sub qw(set add replace append prepend cas) {
- no strict 'refs';
- *{$sub} = sub {
- my $self = shift;
- my $ret = $self->${\"SUPER::$sub"}(@_);
- if($ret->is_ok) {
- return 1;
- } elsif ($ret->errnum == COUCHBASE_NOT_STORED ||
- $ret->errnum == COUCHBASE_KEY_EEXISTS ||
- $ret->errnum == COUCHBASE_KEY_ENOENT) {
- return 0;
- } else {
- return undef;
- }
- };
+sub new {
+ my ($cls,$options) = @_;
+ my $o = $cls->SUPER::new($options);
}
-foreach my $sub (qw(incr decr delete remove)) {
+
+foreach my $sub (qw(
+ get gets
+ set append prepend replace add
+ remove delete
+ incr decr cas)) {
no strict 'refs';
*{$sub} = sub {
my $self = shift;
- my $ret = $self->${\"SUPER::$sub"}(@_);
- if($ret->is_ok) {
- return $ret->value;
- } elsif ($ret->errnum == COUCHBASE_NOT_STORED ||
- $ret->errnum == COUCHBASE_KEY_ENOENT ||
- $ret->errnum == COUCHBASE_KEY_EEXISTS ||
- $ret->errnum == COUCHBASE_DELTA_BADVAL ||
- $ret->errnum == COUCHBASE_E2BIG) {
- return 0;
- } else {
- return undef;
- }
+ my $ret = $self->{\"SUPER::$sub"}(@_);
+ $ret = return_for_op($ret, $sub);
+ return $ret;
+ };
+
+ my $multi = "$sub\_multi";
+ *{$multi} = sub {
+ my $self = shift;
+ my $ret = $self->{\"SUPER::$multi"}(@_);
+ return return_for_multi_wrap(\@_, $ret, $sub)
};
}
+1;
+
__END__
=head1 NAME
@@ -77,32 +110,31 @@ of those pages for documentation of the methods supported.
=over
-=item get
-
-=item gets
+=item get, get_multi
-=item set
+=item gets, gets_multi
-=item cas
+=item set, set_multi
-=item add
+=item cas, cas_multi
-=item replace
+=item add, add_multi
-=item append
+=item replace, replace_multi
-=item prepend
+=item append, append_multi
-=item incr
+=item prepend, prepend_multi
-=item decr
+=item incr, incr_multi
-=item delete
+=item decr, decr_multi
-=item remove
+=item delete, remove, delete_multi, remove_multi
=back
+
=head2 SEE ALSO
L<Cache::Memcached>
View
15 lib/Couchbase/Test/ClientSync.pm
@@ -259,4 +259,19 @@ sub T06_multi :Test(no_plan) {
"all keys have been decremented");
}
+sub T07_stats :Test(no_plan) {
+ my $self = shift;
+ my $o = $self->cbo;
+ my $stats = $o->stats();
+
+ ok($stats && ref $stats eq 'HASH', "Got a hashref");
+ ok(scalar keys %$stats, "stats not empty");
+
+ if($self->mock && $self->mock->nodes) {
+ ok(scalar keys %$stats == $self->mock->nodes, "Got expected stat count");
+ } else {
+ diag "Cannot determine expected stat count for real cluster";
+ }
+}
+
1;
View
112 t/02-compat.t
@@ -0,0 +1,112 @@
+#!perl
+use strict;
+use warnings;
+use Test::More;
+use Couchbase::Client;
+use Couchbase::Client::Errors;
+use Couchbase::Client::Compat
+ qw(return_for_multi_wrap return_for_op);
+use Couchbase::Client::Return;
+use Couchbase::Client::IDXConst;
+use Data::Dumper;
+
+# Here we craft responses:
+
+sub new_response {
+ my ($value,$err,$cas) = @_;
+ my $ret = [ ];
+ bless $ret, 'Couchbase::Client::Return';
+ $ret->[RETIDX_ERRNUM] = $err;
+ $ret->[RETIDX_CAS] = $cas;
+ $ret->[RETIDX_VALUE] = $value;
+ return $ret;
+}
+
+my $Ret;
+my $CompatVal;
+
+
+#Try with a successful GET command
+$Ret = new_response("foo", 0, 42);
+is(return_for_op($Ret, 'get'), 'foo', "Got expected return for OK get");
+
+$Ret = new_response(undef, COUCHBASE_KEY_ENOENT, 0);
+ok(!return_for_op($Ret, 'get'), "Got non-true value for error response (GET)");
+
+
+#try with SET
+$Ret = new_response(undef, 0, 42);
+ok(return_for_op($Ret, 'set'), "Got OK for SET");
+
+$Ret = new_response(undef, COUCHBASE_KEY_ENOENT);
+$CompatVal = return_for_op($Ret, 'set');
+
+ok(defined $CompatVal, "Set ENOENT is defined");
+ok(!$CompatVal, "But it's false..");
+
+$Ret = new_response(undef, COUCHBASE_ETMPFAIL);
+ok(!defined return_for_op($Ret, 'set'), "TMPFAIL is undef");
+
+#try with GETS
+$Ret = new_response('foo', 0, 42);
+$CompatVal = return_for_op($Ret, 'gets');
+
+ok(ref $CompatVal eq 'ARRAY', "Got array for gets");
+ok($CompatVal->[0] == 42 && $CompatVal->[1] eq 'foo',
+ "Got expected [cas,value]");
+
+#try with incr/decr
+$Ret = new_response(0, 0, 0);
+$CompatVal = return_for_op($Ret, 'decr');
+ok(defined $CompatVal, "Value is defined for 0 arithmetic value");
+
+$Ret = new_response(undef, COUCHBASE_KEY_ENOENT, 0);
+ok(!defined return_for_op($Ret, 'incr'), "undefined for error result");
+
+#Try with delete/remove/whatever:
+
+$Ret = new_response(undef, 0);
+ok(return_for_op($Ret, 'remove'), "OK for delete without error");
+$Ret = new_response(undef, COUCHBASE_KEY_ENOENT);
+is(return_for_op($Ret, 'remove'), 0, "Got false reply for DELETE with ENOENT");
+
+
+#Try the multi interface:
+my $RetMulti_base = {
+ 'foo' => new_response('foo_value', 0, 42),
+ 'bar' => new_response('bar_value', 0, 43),
+ 'baz' => new_response('baz_value', 0, 44)
+};
+
+my $RetMulti = { %$RetMulti_base };
+
+my $ReqMulti = [qw(bar foo baz)];
+$CompatVal = return_for_multi_wrap($ReqMulti, $RetMulti, 'get');
+
+ok(ref $CompatVal eq 'HASH', "Got hash return");
+ok(scalar keys %$CompatVal == 3, "Got expected key count");
+
+ok(
+ $CompatVal->{foo} eq 'foo_value' &&
+ $CompatVal->{bar} eq 'bar_value' &&
+ $CompatVal->{baz} eq 'baz_value',
+ "Got all expected values");
+
+$RetMulti = { %$RetMulti_base };
+
+$CompatVal = [ (return_for_multi_wrap($ReqMulti, $RetMulti, 'get')) ];
+ok(ref $CompatVal eq 'ARRAY', "Have array for list context");
+
+my $ok = 1;
+foreach my $i (0..$#{$ReqMulti}) {
+ my $k = $ReqMulti->[$i];
+ my $v = $CompatVal->[$i];
+ if ($v ne "$k\_value") {
+ $ok = 0;
+ diag "Found unexpected $k => $v";
+ }
+}
+
+ok($ok, "Found no errors for list context");
+
+done_testing();
View
16 xs/callbacks.c
@@ -142,20 +142,19 @@ static void stat_callback(
SV *server_sv, *data_sv, *key_sv;
dSP;
+ object = (PLCB_t*)libcouchbase_get_cookie(instance);
-
- if(! (stat_key || bytes) ) {
- warn("Got all statistics");
- //signal_done(syncp);
+ if(stat_key == NULL && server == NULL) {
+ PLCB_sync_t sync;
+ sync.parent = object;
+ object->npending = 1;
+ signal_done(&sync);
return;
}
server_sv = newSVpvn(server, strlen(server));
if(nkey) {
key_sv = newSVpvn(stat_key, nkey);
- fprintf(stderr, "stat_callback(): ");
- fwrite(stat_key, nkey, 1, stderr);
- fprintf(stderr, "\n");
} else {
key_sv = newSVpvn("", 0);
}
@@ -166,7 +165,6 @@ static void stat_callback(
data_sv = newSVpvn("", 0);
}
- object = (PLCB_t*)libcouchbase_get_cookie(instance);
if(!object->stats_hv) {
die("We have nothing to write our stats to!");
}
@@ -183,7 +181,7 @@ static void stat_callback(
call_pv(PLCB_STATS_SUBNAME, G_DISCARD);
FREETMPS;
- LEAVE;
+ LEAVE;
}
void plcb_callbacks_set_multi(PLCB_t *object)
Please sign in to comment.
Something went wrong with that request. Please try again.