Skip to content
Browse files

Test files (based on Test::Class). README glorified.

  • Loading branch information...
1 parent 93a8d50 commit dbe6cfaba6a57baee86713b86239b002372bd452 @mnunberg committed Jan 28, 2012
Showing with 607 additions and 20 deletions.
  1. +26 −0 Client.xs
  2. +6 −1 MANIFEST
  3. +33 −6 Makefile.PL
  4. +14 −0 PLCB_Config.pm
  5. +0 −13 README
  6. +103 −0 README.pod
  7. +2 −0 ignore.txt
  8. +171 −0 lib/Couchbase/MockServer.pm
  9. +180 −0 lib/Couchbase/Test/ClientSync.pm
  10. +52 −0 lib/Couchbase/Test/Common.pm
  11. +20 −0 t/01-main.t
View
26 Client.xs
@@ -344,6 +344,21 @@ SV *PLCB_stats(SV *self, AV *stats)
return ret_hvref;
}
+static SV*
+return_empty(SV *self, int error, const char *errmsg)
+{
+ libcouchbase_t instance;
+ PLCB_t *object;
+ AV *ret_av;
+
+ mk_instance_vars(self, instance, object);
+ ret_av = newAV();
+ av_store(ret_av, PLCB_RETIDX_ERRNUM, newSViv(error));
+ av_store(ret_av, PLCB_RETIDX_ERRSTR, newSVpvf(
+ "Couchbase::Client usage error: %s", errmsg));
+ plcb_ret_blessed_rv(object, ret_av);
+}
+
/*Used for set/get/replace/add common interface*/
static libcouchbase_storage_t PLCB_XS_setmap[] = {
LIBCOUCHBASE_SET,
@@ -403,6 +418,10 @@ PLCB_set(self, key, value, ...)
CODE:
set_plst_get_offset(4, exp_offset, "USAGE: set(key, value [,expiry]");
+ if(ix >= 3 && SvROK(value)) {
+ die("Cannot append/prepend a reference");
+ }
+
RETVAL = PLCB_set_common(
self, key, value,
PLCB_XS_setmap[ix],
@@ -485,6 +504,13 @@ PLCB_cas(self, key, value, cas_sv, ...)
STRLEN cas_len;
CODE:
+ if(SvTYPE(cas_sv) == SVt_NULL) {
+ /*don't bother the network if we know our CAS operation will fail*/
+ RETVAL = return_empty(self,
+ LIBCOUCHBASE_KEY_EEXISTS, "I was given an undef cas");
+ return;
+ }
+
plcb_cas_from_sv(cas_sv, cas_val, cas_len);
set_plst_get_offset(5, exp_offset, "USAGE: cas(key,value,cas[,expiry])");
View
7 MANIFEST
@@ -1,7 +1,7 @@
Changes
MANIFEST
Makefile.PL
-README
+README.pod
lib/Couchbase/Client.pm
lib/Couchbase/Client/Return.pm
@@ -16,6 +16,10 @@ 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
+
Client.xs
Async.xs
@@ -36,3 +40,4 @@ error_constants.pl
print_constants.pl
t/00-load.t
+t/01-main.t
View
39 Makefile.PL
@@ -1,9 +1,21 @@
use strict;
use warnings;
use ExtUtils::MakeMaker;
+use Dir::Self;
-system("$^X error_constants.pl lib/Couchbase/Client/Errors_const.pm");
-system("$^X idx_constants.pl lib/Couchbase/Client/IDXConst_const.pm");
+use lib __DIR__;
+
+my $plcb_config = do 'PLCB_Config.pm';
+
+my $include_path = $plcb_config->{COUCHBASE_INCLUDE_PATH} || "";
+my $library_path = $plcb_config->{COUCHBASE_LIBRARY_PATH} || "";
+
+if($include_path) {
+ $include_path = "-I$include_path";
+}
+if($library_path) {
+ $library_path = "-L$library_path";
+}
WriteMakefile(
NAME => 'Couchbase::Client',
@@ -16,18 +28,33 @@ WriteMakefile(
($ExtUtils::MakeMaker::VERSION >= 6.3002
? ('LICENSE'=> 'perl')
: ()),
- PL_FILES => {},
+
+ PL_FILES => {
+ "error_constants.pl" => "lib/Couchbase/Client/Errors_const.pm",
+ "idx_constants.pl" => "lib/Couchbase/Client/IDXConst_const.pm"
+ },
+
+ CONFIGURE_REQUIRES => {
+ 'Dir::Self' => 0,
+ },
+
PREREQ_PM => {
'Array::Assign' => 0,
'ExtUtils::H2PM' => 0.08,
'Class::XSAccessor' => 1.11,
'Test::More' => 0,
+
+ #These modules are needed for tests, but not strictly required for
+ #functionality
+
+ 'Log::Fu' => 0.25,
+ 'Test::Class' => 0.36,
+ 'LWP::UserAgent' => 0,
},
NEEDS_LINKING => 1,
OPTIMIZE => '-O0 -ggdb3',
- LIBS => ['-L/sources/libcouchbase/.libs -lcouchbase -lcouchbase_libevent'],
- #LIBS => ['-lcouchbase'],
- INC => '-I/sources/libcouchbase/include /sources/memcached/include',
+ LIBS => ["$library_path -lcouchbase -lcouchbase_libevent"],
+ INC => $include_path,
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Couchbase-Client-*' },
);
View
14 PLCB_Config.pm
@@ -0,0 +1,14 @@
+#this perl 'hash' contains configuration information necessary
+#to bootstrap and/or configure the perl couchbase client and run
+#necessary tests.
+
+{
+ COUCHBASE_INCLUDE_PATH => "/sources/libcouchbase/include",
+ COUCHBASE_LIBRARY_PATH => "/sources/libcouchbase/.libs",
+
+ #URL from which to download the mock JAR file for tests
+ COUCHBASE_MOCK_JARURL =>
+ "http://files.couchbase.com/maven2/org/couchbase/mock/".
+ "CouchbaseMock/0.5-SNAPSHOT/CouchbaseMock-0.5-20120103.162550-11.jar",
+};
+
View
13 README
@@ -1,13 +0,0 @@
-Couch::Couchbase is a Perl client for Couchbase (http://www.couchbase.org).
-
-This is a 'smart' or 'Type-2' client, as opposed to legacy Memcached clients.
-
-This module depends on having libcouchbase development packages installed;
-
-It currently features no functionality unit tests.
-
-Included is a wrapper module which provides backwards API compatibility
-with Cache::Memcached::* modules.
-
-Currently only the single-op synchronous inteface is implemented.
-
View
103 README.pod
@@ -0,0 +1,103 @@
+=head1 Introduction
+
+Couch::Couchbase is a Perl client for Couchbase (http://www.couchbase.org).
+
+The couchbase client is a smart, vbucket-aware client. What this means is that
+Couchbase::Client can tap into your Couchbase cluster, with the client needing
+to be able to access (initially) only a single entry point.
+
+The module provides:
+
+=head2 Synchronous Interface: Couchbase::Client
+
+This is the simplest and most tested interface. The methods are self-explanatory.
+Additionally, the return type is complex and detailed, allowing error reporting
+for any unexpected conditions (something severely lacking in any Memcache client
+implementation).
+
+=head2 Legacy Interface: Couchbase::Client::Compat
+
+Drop-in replacement for Cache::Memcached and Cache::Memcached::Fast.
+
+I can't say it's 100% compatible yet, but the basic methods have been implemented.
+Internally it just wraps around the new interface
+
+=head2 Asynchronous Framework for Perl: Couchbase::Client::Async
+
+Provides the necessary functions and utilities needed to make a POE, IO::Async,
+etc. client for Couchbase.
+
+=head2 Mock Server Interface: Couchbase::MockServer
+
+Interface to the Java C<Couchbase::Mock>. This is a work in progress.
+
+=head1 Installing
+
+I will be focusing on installing and configuring C<libcouchbase> itself, the C
+client library. It is assumed you have a functional installation of the couchbase
+server somewhere. If not, go to http://www.couchbase.org
+
+To use this module, you should have installed C<libvbucket> (see the links on
+the side here http://www.couchbase.com/develop/c/current).
+
+As of 01/28/2011, you will need to download C<libcouchbase> itself from
+github (the current release versions contain bugs which may break this module).
+
+=head2 Building C<libcouchbase>
+
+
+C<libcouchbase> itself depends on C<libvbucket>, so make sure to install that
+(and its development libraries) first.
+
+Currently, I know of these dependencies:
+
+=over
+
+=item libevent >= 1.4
+
+=back
+
+Additionally, C<libcouchbase> depends on header files available from the
+C<engine-pu> branch of the C<memcached> project. Note that actually building
+memcached itself is not required.
+
+Your best bet would be to do
+something like this:
+
+ ~$ mkdir couch
+ ~$ git clone https://github.com/memcached/memcached.git -b engine-pu couch/memcached
+ ~$ git clone https://github.com/couchbase/libcouchbase.git couch/libcouchbase
+
+ ~$ cd couch/libcouchbase
+ ~$ ./config/autorun.sh
+
+ #make sure we know about the new memcached headers:
+
+ ~$ CPPFLAGS=-I../memcached/include ./configure
+ ~$ make
+
+ #optional, run some tests:
+ ~$ make check
+
+
+=head2 Building Couchbase::Client
+
+To build the perl client, you should edit the C<PLCB_Config.pm> file, and
+change the keys C<COUCHBASE_INCLUDE_PATH> and C<COUCHBASE_LIBRARY_PATH> to their
+appropriate locations.
+
+If you were following the example above, your keys should look like this
+
+ COUCHBASE_INCLUDE_PATH => "~/couch/libcouchbase/include",
+ COUCHBASE_LIBRARY_PATH => "~/couch/libcouchbase/.libs"
+
+ #the '.libs' is an Autoconf thing, it seems.
+
+run
+ $ perl Makefile.PL #you know the drill..
+ $ make test
+
+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
View
2 ignore.txt
@@ -10,3 +10,5 @@ pm_to_blib*
cover_db
pod2htm*.tmp
Couchbase-Client-*
+*.jar
+t/tmp/*
View
171 lib/Couchbase/MockServer.pm
@@ -0,0 +1,171 @@
+package Couchbase::MockServer;
+use strict;
+use warnings;
+use LWP::UserAgent;
+use File::Basename;
+use URI;
+use File::Path qw(mkpath);
+use IO::Socket::INET;
+use Socket;
+use POSIX qw(:errno_h :signal_h);
+use Time::HiRes;
+use Log::Fu;
+use Data::Dumper;
+
+
+
+my $SYMLINK = "CouchbaseMock_PLTEST.jar";
+our $INSTANCE;
+
+use Class::XSAccessor {
+ constructor => '_real_new',
+ accessors => [qw(
+ harakiri_addr
+ port
+ pid
+ dir
+ url
+ nodes
+ buckets
+ vbuckets
+ harakiri_socket
+ )]
+};
+# This is the couchbase mock server, it will attempt to download, spawn, and
+# otherwise control the java-based CouchbaseMock server.
+
+sub _do_run {
+ my $self = shift;
+ my @command;
+ push @command, "java", "-jar", $self->dir . "/$SYMLINK";
+
+ my $buckets_arg = "--buckets=";
+
+ foreach my $bucket (@{$self->buckets}) {
+ my ($name,$password,$type) = @{$bucket}{qw(name password type)};
+ $name ||= "";
+ $password ||= "";
+ $type ||= "";
+ if($type && $type ne "couchbase" && $type ne "memcache") {
+ die("type for bucket must be either 'couchbase' or 'memcache'");
+ }
+ my $spec = join(":", $name, $password, $type);
+ $buckets_arg .= $spec . ",";
+ }
+
+ $buckets_arg =~ s/,$//g;
+
+ push @command, $buckets_arg;
+
+ push @command, "--port=" . $self->port;
+
+ if($self->nodes) {
+ push @command, "--nodes=" . $self->nodes;
+ }
+
+ if($self->harakiri_addr) {
+ push @command, "--harakiri-monitor=" . $self->harakiri_addr
+ } else {
+ my $sock = IO::Socket::INET->new(Listen => 5);
+ $self->harakiri_socket($sock);
+ my $port = $self->harakiri_socket->sockport;
+ log_infof("Listening on %d for harakiri", $port);
+ push @command, "--harakiri-monitor=localhost:$port";
+ }
+
+ my $pid = fork();
+
+ if($pid) {
+ #Parent: setup harakiri monitoring socket
+ $self->pid($pid);
+ log_info("Launched CouchbaseMock PID=$pid");
+ if($self->harakiri_socket) {
+ $self->harakiri_socket->blocking(0);
+ my $begin_time = time();
+ my $max_wait = 5;
+ my $got_accept = 0;
+ while(time - $begin_time < $max_wait) {
+ my $sock = $self->harakiri_socket->accept();
+ if($sock) {
+ $self->harakiri_socket($sock);
+ $got_accept = 1;
+ log_info("Got harakiri connection");
+ my $buf;
+ $self->harakiri_socket->recv($buf, 100, 0);
+ last;
+ } else {
+ sleep(0.1);
+ }
+ }
+ if(!$got_accept) {
+ die("Could not establish harakiri control connection");
+ }
+ $self->harakiri_socket->blocking(1);
+ }
+ } else {
+ log_infof("Executing %s", join(" ", @command));
+ exec(@command);
+ }
+}
+
+sub new {
+ my ($cls,%opts) = @_;
+ if($INSTANCE) {
+ log_warn("Returning cached instance");
+ return $INSTANCE;
+ }
+ unless(exists $opts{url} and exists $opts{dir}) {
+ die("Must have directory and URL");
+ }
+ my $o = $cls->_real_new(%opts);
+ my $dir = $o->dir;
+ my $url = URI->new($o->url);
+ my $basepath = basename($url->path);
+ my $fqpath = "$dir/$basepath";
+
+ if(!-d $dir) {
+ mkpath($dir);
+ }
+
+ if(!-e $fqpath) {
+ log_warn("$fqpath does not exist. Downloading..");
+ my $ua = LWP::UserAgent->new();
+ $ua->get($url, ':content_file' => $fqpath);
+ }
+
+ unlink("$dir/$SYMLINK");
+ symlink($fqpath, "$dir/$SYMLINK");
+
+ #Initialize buckets to their defaults
+ if(!$o->buckets) {
+ $o->buckets([{
+ name => "default",
+ #does mock not support SASL?
+ #password => "secret"
+ }]);
+ }
+
+ #initialize port to the default, if not there already
+ if(!$o->port) {
+ $o->port(8091);
+ }
+
+ $o->_do_run();
+ $INSTANCE = $o;
+ return $o;
+}
+
+sub GetInstance {
+ my $cls = shift;
+ return $INSTANCE;
+}
+
+sub DESTROY {
+ my $self = shift;
+ kill SIGTERM, $self->pid;
+ waitpid($self->pid, 0);
+ log_infof("Reaped PID %d, status %d", $self->pid, $? >> 8);
+
+}
+
+1;
View
180 lib/Couchbase/Test/ClientSync.pm
@@ -0,0 +1,180 @@
+package Couchbase::Test::ClientSync;
+use strict;
+use warnings;
+use base qw(Couchbase::Test::Common);
+use Test::More;
+use Couchbase::Client;
+use Couchbase::Client::Errors;
+use Data::Dumper;
+
+sub setup_client :Test(startup)
+{
+ my $self = shift;
+ $self->mock_init();
+
+ my %options = (
+ %{$self->common_options},
+ compress_threshold => 100
+ );
+
+ my $o = Couchbase::Client->new(\%options);
+
+ $self->cbo( $o );
+ $self->{basic_keys} = [qw(
+ Foo Bar Baz Blargh Bleh Meh Grr Gah)];
+ $self->err_ok();
+}
+
+sub cbo {
+ if(@_ == 1) {
+ return $_[0]->{object};
+ } elsif (@_ == 2) {
+ $_[0]->{object} = $_[1];
+ return $_[1];
+ }
+}
+
+sub err_ok {
+ my $self = shift;
+ my $errors = $self->cbo->get_errors;
+ my $nerr = 0;
+ foreach my $errinfo (@$errors) {
+ $nerr++;
+ }
+ ok($nerr == 0, "Got no errors");
+}
+
+sub k2v {
+ my ($self,$k) = @_;
+ reverse($k);
+}
+
+sub v2k {
+ my ($self,$v) = @_;
+ reverse($v);
+}
+
+sub set_ok {
+ my ($self,$msg,@args) = @_;
+ my $ret = $self->cbo->set(@args);
+ ok($ret->is_ok, $msg);
+ $self->err_ok();
+ if(!$ret->is_ok) {
+ diag($ret->errstr);
+ }
+}
+
+sub get_ok {
+ my ($self,$key,$expected) = @_;
+ my $ret = $self->cbo->get($key);
+ ok($ret->is_ok, "Status OK for GET($key)");
+ ok($ret->value eq $expected, "Got expected value for $key");
+}
+
+sub T0_set_values_simple :Test(no_plan) {
+ my $self = shift;
+ foreach my $k (@{$self->{basic_keys}}) {
+ $self->set_ok("Key '$k'", $k, $self->k2v($k));
+ $self->get_ok($k, $self->k2v($k))
+ }
+}
+
+sub T1_get_nonexistent :Test(no_plan) {
+ my $self = shift;
+ my $v = $self->cbo->get('NonExistent');
+ is($v->errnum, COUCHBASE_KEY_ENOENT, "Got ENOENT for nonexistent key");
+ $self->err_ok();
+}
+
+sub T2_mutators :Test(no_plan) {
+ my $self = shift;
+ my $o = $self->cbo;
+
+ my $key = "mutate_key";
+ $o->remove($key); #if it already exists
+ is($o->add($key, "BASE")->errnum, 0, "No error for add on new key");
+ is($o->prepend($key, "PREFIX_")->errnum, 0, "No error for prepend");
+ is($o->append($key, "_SUFFIX")->errnum, 0, "No error for append");
+ is($o->get($key)->value, "PREFIX_BASE_SUFFIX", "Got expected mutated value");
+}
+
+sub T3_arithmetic :Test(no_plan) {
+ my $self = shift;
+ my $o = $self->cbo;
+ my $key = "ArithmeticKey";
+ $o->remove($key);
+ my $wv;
+
+ $wv = $o->arithmetic($key, -12, 42);
+ ok($wv->is_ok, "Set arithmetic with initial value");
+
+ $o->remove($key);
+
+ $wv = $o->arithmetic($key, -12, undef);
+ is($wv->errnum, COUCHBASE_KEY_ENOENT, "Error without initial value (undef)");
+
+ $wv = $o->arithmetic($key, -12, 0, 120);
+ ok($wv->is_ok, "No error with initial value=0");
+ is($wv->value, 0, "Initial value is 0");
+
+ $wv = $o->incr($key);
+ is($wv->value, 1, "incr() == 1");
+
+ $wv = $o->decr($key);
+ is($wv->value, 0, "decr() == 0");
+}
+
+sub T4_atomic :Test(no_plan) {
+ my $self = shift;
+ my $o = $self->cbo;
+ my $key = "AtomicKey";
+ $o->delete($key);
+
+ is($o->replace($key, "blargh")->errnum, COUCHBASE_KEY_ENOENT,
+ "Can't replace non-existent value");
+
+ my $wv = $o->set($key, "initial");
+ ok($wv->errnum == 0, "No error");
+ ok(length($wv->cas), "Have cas");
+ $o->set($key, "next");
+ my $newv = $o->cas($key, "my_next", $wv->cas);
+
+ is($newv->errnum,
+ COUCHBASE_KEY_EEXISTS, "Got EEXISTS for outdated CAS");
+
+ $newv = $o->get($key);
+ ok($newv->cas, "Have CAS for new value");
+ $wv = $o->cas($key, "synchronized", $newv->cas);
+ ok($wv->errnum == 0, "Got no error for CAS with updated CAS");
+ is($o->get($key)->value, "synchronized", "Got expected value");
+
+ $o->delete($key);
+ ok($o->add($key, "value")->is_ok, "No error for ADD with nonexistent key");
+ is($o->add($key, "value")->errnum,
+ COUCHBASE_KEY_EEXISTS, "Got eexists for ADD on existing key");
+
+ ok($o->delete($key, $newv->cas)->errnum, "Got error for DELETE with bad CAS");
+ $newv = $o->get($key);
+ ok($o->delete($key, $newv->cas)->errnum == 0,
+ "No error for delete with updated CAS");
+}
+
+sub T5_conversion :Test(no_plan) {
+ my $self = shift;
+ my $o = $self->cbo;
+ my $structure = [ qw(foo bar baz) ];
+ my $key = "Serialization";
+ my $rv;
+
+ ok($o->set($key, $structure)->is_ok, "Serialized OK");
+
+ $rv = $o->get($key);
+ ok($rv->is_ok, "Got serialized structure OK");
+ is_deeply($rv->value, $structure, "Got back our array reference");
+ eval {
+ $o->append($key, $structure);
+ };
+ ok($@, "Got error for append/prepending a serialized structure ($@)");
+}
+
+1;
View
52 lib/Couchbase/Test/Common.pm
@@ -0,0 +1,52 @@
+package Couchbase::Test::Common;
+use strict;
+use warnings;
+use base qw(Test::Class);
+use Test::More;
+use Couchbase::MockServer;
+use Data::Dumper;
+
+our $Mock;
+
+sub mock_init
+{
+ my $self = shift;
+ if(!$Mock) {
+ die("Mock object not found. Initialize mock object with Initialize()");
+ }
+ $self->{mock} = $Mock;
+}
+
+sub mock { $_[0]->{mock} }
+
+sub common_options {
+ my $self = shift;
+ my $opthash = {};
+ my $defbucket = $self->mock->buckets->[0];
+
+ if($defbucket->{password}) {
+ $opthash->{username} = "some_user";
+ $opthash->{password} = $defbucket->{password};
+ }
+ $opthash->{server} = "127.0.0.1:" . $self->mock->port;
+ $opthash->{bucket} = $defbucket->{name};
+ return $opthash;
+}
+
+sub k2v {
+ my ($self,$k) = @_;
+ reverse($k);
+}
+
+sub v2k {
+ my ($self,$v) = @_;
+ reverse($v);
+}
+
+
+sub Initialize {
+ my ($cls,%opts) = @_;
+ $Mock = Couchbase::MockServer->new(%opts);
+ return $Mock;
+}
+1;
View
20 t/01-main.t
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use Dir::Self;
+use lib __DIR__ . "../lib";
+use lib __DIR__ . "../";
+
+$Log::Fu::LINE_PREFIX = '#';
+
+my $config = do 'PLCB_Config.pm';
+use Couchbase::Test::Common;
+my $TEST_PORT;
+
+Couchbase::Test::Common->Initialize(
+ url => $config->{COUCHBASE_MOCK_JARURL},
+ dir => __DIR__ . "/tmp",
+ port => 8092,
+ nodes => 2,
+);
+
+use Couchbase::Test::ClientSync;
+Test::Class->runtests();

0 comments on commit dbe6cfa

Please sign in to comment.
Something went wrong with that request. Please try again.