Updated tests, dual-mode for testing on real cluster, too

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "Config"]
+	path = Config
+	url = file://Config

PLCB_Config.pm

@@ -1,8 +1,11 @@
+package PLCB_Config;
+use strict;
+use warnings;
 #this perl 'hash' contains configuration information necessary
 #to bootstrap and/or configure the perl couchbase client and run
 #necessary tests.
 
-{
+my $params = {
     COUCHBASE_INCLUDE_PATH  => "/sources/libcouchbase/include",
     COUCHBASE_LIBRARY_PATH  => "/sources/libcouchbase/.libs",
 
@@ -12,3 +15,5 @@
         "CouchbaseMock/0.5-SNAPSHOT/CouchbaseMock-0.5-20120202.071818-12.jar",
 };
 
+
+return $params; #return value

README.pod

@@ -31,6 +31,19 @@ etc. client for Couchbase.
 
 Interface to the Java C<CouchbaseMock.jar>. This is a work in progress.
 
+=head2 Extra Components
+
+=head3 Couchbase::Config - REST API module
+
+This module will probably be a dependency for full testing, but will not necessarily
+be part of this distribution. It's currently available as a separate repository
+on github.
+
+=head3 Couchbase::VBucket - VBucket server mapping module
+
+Just a little utility module. May be useful for testing.
+
+
 =head1 Installing
 
 I will be focusing on installing and configuring C<libcouchbase> itself, the C
@@ -128,4 +141,38 @@ run
 There are some top-level scripts. Some have meaning to only the author, some might
 be useful.
 
-Also, check out the runnable modules in the C<t/> directory
+Also, check out the runnable modules in the C<t/> directory
+
+=head2 Testing
+
+The tests in this module require java to run. Some tests furthermore will only
+work on a real cluster, due to some of the limitations in the Java client.
+
+To run the tests on a real cluster, you can make use of the
+C<PLCB_TEST_REAL_SERVER> environment variable.
+
+When set, it should/can contain something like this:
+
+    PLCB_TEST_REAL_SERVER='bucket=my_bucket,username=secret,memd_port=11212'
+
+The keys available are
+
+=over
+
+=item username, password
+
+Authentication information
+
+=item bucket
+
+Which bucket to use (default is C<default>)
+
+=item server
+
+Which server to connect to (default is C<localhost:8091>)
+
+=item memd_port
+
+Required for some tests. This is the authless port for memcached client access.
+
+=back

lib/Couchbase/Test/Async.pm

@@ -42,7 +42,10 @@ sub _run_poe {
 
 sub cb_result_single {
     my ($key,$return,$errnum) = @_;
-    is($return->errnum, $errnum, "Got return for key $key ($errnum)");
+    if($errnum >= 0) {
+        is($return->errnum, $errnum,
+           "Got return for key $key (expected=$errnum)");
+    }
     $Return = $return;
 }
 
@@ -81,11 +84,12 @@ sub T12_get :Test(no_plan) {
     is($ret->value, $self->k2v($key), "Got expected value");
 }
 
-sub T13_arith_ext :Test(no_plan) {
+sub T14_arith_ext :Test(no_plan) {
     my $self = shift;
-    my $key = "arith";
+    my $key = "async_key";
 
     my $ret;
+    $self->post_to_loop(remove => [$key], -1);
 
     $ret = $self->post_to_loop(
         arithmetic => [ $key, 42, undef ], COUCHBASE_KEY_ENOENT);

lib/Couchbase/Test/Async/Loop.pm

@@ -303,7 +303,8 @@ sub _arith_basic :Event(incr, decr) {
     $_[HEAP]->_numop_common($key, $delta, undef, $expiry, $cb_params);
 }
 
-sub _keyop :Event(touch, remove, delete) {
+sub _keyop :Event(touch, remove)
+{
     my ($op_params, $cb_params) = @_[ARG0,ARG1];
     my ($key,$expiry,$cas);
     my $command;

lib/Couchbase/Test/Common.pm

@@ -7,7 +7,8 @@ use Couchbase::MockServer;
 use Data::Dumper;
 
 our $Mock;
-
+our $RealServer = $ENV{PLCB_TEST_REAL_SERVER};
+our $MemdPort = $ENV{PLCB_TEST_MEMD_PORT};
 sub mock_init
 {
     my $self = shift;
@@ -21,6 +22,11 @@ sub mock { $_[0]->{mock} }
 
 sub common_options {
     my $self = shift;
+
+    if($RealServer) {
+        return { %$RealServer };
+    }
+
     my $opthash = {};
     my $defbucket = $self->mock->buckets->[0];
 
@@ -33,6 +39,17 @@ sub common_options {
     return $opthash;
 }
 
+sub memd_options {
+    if(!$MemdPort) {
+        die("Cannot find Memcached port");
+    }
+    my ($hostname) = split(/:/, $RealServer->{server});
+    $hostname .= ":$MemdPort";
+    return {
+        servers => [ $hostname ]
+    };
+}
+
 sub k2v {
     my ($self,$k) = @_;
     reverse($k);
@@ -43,10 +60,23 @@ sub v2k {
     reverse($v);
 }
 
-
 sub Initialize {
     my ($cls,%opts) = @_;
-    $Mock = Couchbase::MockServer->new(%opts);
-    return $Mock;
+    if($RealServer && (!ref $RealServer) ) {
+        warn("Using real server..");
+        my @kvpairs = split(/,/, $RealServer);
+        $RealServer = {};
+        foreach my $pair (@kvpairs) {
+            my ($k,$v) = split(/=/, $pair);
+            $RealServer->{$k} = $v if $k =~ /server|bucket|username|password|memd_port/;
+        }
+        $RealServer->{server} ||= "localhost:8091";
+        $RealServer->{bucket} ||= "default";
+        $MemdPort ||= delete $RealServer->{memd_port};
+        $Mock = 1;
+    } else {
+        $Mock = Couchbase::MockServer->new(%opts);
+        return $Mock;
+    }
 }
 1;

lib/Couchbase/Test/Interop.pm

@@ -6,31 +6,39 @@ use Test::More;
 use Couchbase::Client::Errors;
 use Data::Dumper;
 use Class::XSAccessor {
-    accessors => [qw(cbo memds confua vbconf)]
+    accessors => [qw(cbo memds memd confua vbconf)]
 };
 
 my $MEMD_CLASS;
 my $have_memcached = 
+eval {
+    require Cache::Memcached::Fast;
+    $MEMD_CLASS = "Cache::Memcached::Fast";
+} ||
+eval {
+    require Cache::Memcached;
+    $MEMD_CLASS = "Cache::Memcached";
+} ||
 eval {
     require Cache::Memcached::libmemcached;
-    $MEMD_CLASS = "Cache::Memcached::libmemcached";
+    $MEMD_CLASS = "Cache::Memcaced::libmemcached";
 };
 
-my $have_libvbucket = eval 'use Couchbase::VBucket; 1;';
-my $have_couchconf = eval 'use Couchbase::Config::UA; 1;';
-
-if(!$have_memcached) {
-    __PACKAGE__->SKIP_ALL("Need Cache::Memcached::libmemcached");
-}
-if(!$have_libvbucket) {
-    __PACKAGE__->SKIP_ALL("Need Couchbase::VBucket");
-}
-if(!$have_couchconf) {
-    __PACKAGE__->SKIP_ALL("Need Couchbase::Config::UA");
-}
 
 sub setup_client :Test(startup) {
     my $self = shift;
+    if(!$have_memcached) {
+        $self->SKIP_ALL("Need Cache::Memcached::libmemcached");
+    }
+
+    if(!$Couchbase::Test::Common::RealServer) {
+        $self->SKIP_ALL("Need connection to real cluster");
+    }
+
+    if(!$Couchbase::Test::Common::MemdPort) {
+        $self->SKIP_ALL("Need dedicated memcached proxy port");
+    }
+
     $self->mock_init();
     my $server = $self->common_options->{server};
 
@@ -43,35 +51,13 @@ sub setup_client :Test(startup) {
 
     $self->cbo($cbo);
 
-    my $confua = Couchbase::Config::UA->new(
-        $server, username => $username, password => $password);
-
-    #Get the actual memcached ports:
-    my $default_pool = $confua->list_pools();
-    my $pool_info = $confua->pool_info($default_pool);
-    my $buckets = $confua->list_buckets($pool_info);
-
-    my $selected_bucket = (grep($_->name eq $self->common_options->{bucket},
-                               @$buckets))[0];
-
-    die("Cannot find selected bucket") unless defined $selected_bucket;
-    my $vbconf = $selected_bucket->vbconf();
-    $self->vbconf($vbconf);
-    $self->memds({});
+    my $memd = $MEMD_CLASS->new($self->memd_options);
+    $self->memd($memd);
 }
 
 sub memd_for_key {
     my ($self,$key) = @_;
-    my $server = $self->vbconf->map($key);
-    die("Couldn't map key!") unless $server;
-    my $memd = $self->memds->{$server};
-    if(!$memd) {
-        $memd = $MEMD_CLASS->new({servers => [$server] } );
-        eval { $memd->set_binary_protocol(1) };
-        $self->memds->{$server} = $memd;
-        note "Created new memcached object for $server";
-    }
-    return $memd;
+    return $self->memd;
 }
 
 sub T30_interop_init :Test(no_plan)
@@ -80,15 +66,38 @@ sub T30_interop_init :Test(no_plan)
     my $key = "Foo";
     my $value = "foo_value";
 
-    my $memd = $self->memd_for_key($key);
+    my $memd = $self->memd;
 
     ok($memd->set($key, $value), "Set value OK");
     is($memd->get($key), $value, "Got back our value");
 
     my $ret = $self->cbo->get($key);
     ok($ret->is_ok, "Found value for memcached key");
     is($ret->value, $value, "Got back same value");
-    #print Dumper($ret);
+
+    $key = "bar";
+    $value = "bar_value";
+
+    ok($self->cbo->set($key,$value)->is_ok, "set via cbc");
+    is($memd->get($key), $value, "get via memd");
+}
+
+sub T31_interop_serialization :Test(no_plan) {
+    my $self = shift;
+    my $key = "Serialized";
+    my $value = [ qw(foo bar baz), { "this is" => "a hash" } ];
+    my $memd = $self->memd_for_key($key);
+
+    ok($memd->set($key, $value), "Set serialized structure");
+    my $ret;
+    $ret = $self->cbo->get($key);
+    ok($ret->is_ok, "Got ok result");
+    is_deeply($ret->value, $value, "Compared identical perl structures");
+    is_deeply($memd->get($key), $ret->value,"even deeper comparison");
+}
+
+sub T32_interop_compression :Test(no_plan) {
+
 }
 
 1;