summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/00_use.t5
-rw-r--r--t/01_basic.t209
-rw-r--r--t/01_store_fetch_object.t25
-rw-r--r--t/02_missing_object.t10
-rw-r--r--t/03_delete_object.t20
-rw-r--r--t/04_bucket.t12
-rw-r--r--t/04_bucket_properties.t24
-rw-r--r--t/05_links.t18
-rw-r--r--t/05_object_siblings.t47
-rw-r--r--t/06_links.t40
-rw-r--r--t/07_map_reduce.t66
-rw-r--r--t/10_list_buckets.t15
-rw-r--r--t/11_get_keys.t36
-rw-r--r--t/90_bug_links.t115
-rw-r--r--t/client.t (renamed from t/02_client.t)0
-rw-r--r--t/hosts.t (renamed from t/06_host.t)0
-rw-r--r--t/lib/Test/Riak.pm99
-rw-r--r--t/pbc/server_info.t10
-rw-r--r--t/rest/populate_object.t (renamed from t/03_object.t)12
-rw-r--r--t/rest/properties.t (renamed from t/07_properties.t)2
-rw-r--r--t/rest/stats.t10
-rw-r--r--t/rest/stream.t (renamed from t/08_stream.t)2
22 files changed, 468 insertions, 309 deletions
diff --git a/t/00_use.t b/t/00_use.t
new file mode 100644
index 0000000..32f2c4c
--- /dev/null
+++ b/t/00_use.t
@@ -0,0 +1,5 @@
+use strict;
+use warnings all => 'FATAL';
+use Test::More;
+use_ok 'Net::Riak';
+done_testing();
diff --git a/t/01_basic.t b/t/01_basic.t
deleted file mode 100644
index 4f408f9..0000000
--- a/t/01_basic.t
+++ /dev/null
@@ -1,209 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-use Net::Riak;
-use YAML::Syck;
-
-BEGIN {
- unless ($ENV{RIAK_REST_HOST}) {
- require Test::More;
- Test::More::plan(skip_all => 'RIAK_REST_HOST not set.. skipping');
- }
-}
-
-my $bucket_name = 'RIAK_TEST_'.time;
-my $bucket_multi = 'multiBucket2';
-
-# is alive
-{
- ok my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST}), 'client created';
- ok $client->is_alive, 'riak is alive';
-}
-
-# store and get
-{
- ok my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST}), 'client created';
- ok my $bucket = $client->bucket($bucket_name), 'got bucket test';
- my $content = [int(rand(100))];
- ok my $obj = $bucket->new_object('foo', $content),
- 'created a new riak object';
- ok $obj->store, 'store object foo';
- is $obj->status, 200, 'valid status';
- is $obj->key, 'foo', 'valid key';
- is_deeply $obj->data, $content, 'valid content';
-}
-
-# missing object
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- my $obj = $bucket->get("missing");
- ok !$obj->data, 'no data';
-}
-
-# delete object
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- my $content = [int(rand(100))];
- my $obj = $bucket->new_object('foo', $content);
- ok $obj->store, 'object is stored';
- $obj = $bucket->get('foo');
- ok $obj->exists, 'object exists';
- $obj->delete;
- $obj->load;
- ok !$obj->exists, "object don't exists anymore";
-}
-
-# test set bucket properties
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- $bucket->allow_multiples(1);
- my $props = $bucket->get_properties;
- my $res = $bucket->allow_multiples;
- $bucket->n_val(3);
- is $bucket->n_val, 3, 'n_val is set to 3';
- $bucket->set_properties({allow_mult => 0, "n_val" => 2});
- $res = $bucket->allow_multiples;
- ok !$bucket->allow_multiples, "don't allow multiple anymore";
- is $bucket->n_val, 2, 'n_val is set to 2';
-}
-
-# test siblings
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_multi);
- $bucket->allow_multiples(1);
- ok $bucket->allow_multiples, 'multiples set to 1';
- my $obj = $bucket->get('foo');
- $obj->delete;
- for(1..5) {
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_multi);
- $obj = $bucket->new_object('foo', [int(rand(100))]);
- $obj->store;
- }
- # check we got 5 siblings
- ok $obj->has_siblings, 'object has siblings';
- $obj = $bucket->get('foo');
- my $siblings_count = $obj->get_siblings;
- is $siblings_count, 5, 'got 5 siblings';
- # test set/get
- my @siblings = $obj->siblings;
- my $obj3 = $obj->sibling(3);
- is_deeply $obj3->data, $obj->sibling(3)->data;
- $obj3 = $obj->sibling(3);
- $obj3->store;
- $obj->load;
- is_deeply $obj->data, $obj3->data;
- $obj->delete;
-}
-
-# test js source map
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- my $obj = $bucket->new_object('foo', [2])->store;
- my $result =
- $client->add($bucket_name, 'foo')
- ->map("function (v) {return [JSON.parse(v.values[0].data)];}")->run;
- is_deeply $result, [[2]], 'got valid result';
-}
-
-# XXX javascript named map
-# {
-# my $client = Net::Riak->new();
-# my $bucket = $client->bucket($bucket_name);
-# my $obj = $bucket->new_object('foo', [2])->store;
-# my $result = $client->add("bucket", "foo")->map("Riak.mapValuesJson")->run;
-# use YAML; warn Dump $result;
-# is_deeply $result, [[2]], 'got valid result';
-# }
-
-# javascript source map reduce
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- my $obj = $bucket->new_object('foo', [2])->store;
- $obj = $bucket->new_object('bar', [3])->store;
- $bucket->new_object('baz', [4])->store;
- my $result =
- $client->add($bucket_name, "foo")->add($bucket_name, "bar")
- ->add($bucket_name, "baz")->map("function (v) { return [1]; }")
- ->reduce("function (v) { return [v.length]; }")->run;
- is $result->[0], 3, "success map reduce";
-}
-
-# javascript named map reduce
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- my $obj = $bucket->new_object("foo", [2])->store;
- $obj = $bucket->new_object("bar", [3])->store;
- $obj = $bucket->new_object("baz", [4])->store;
- my $result =
- $client->add($bucket_name, "foo")->add($bucket_name, "bar")
- ->add($bucket_name, "baz")->map("Riak.mapValuesJson")
- ->reduce("Riak.reduceSum")->run();
- ok $result->[0];
-}
-
-# javascript bucket map reduce
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket("bucket_".int(rand(10)));
- $bucket->new_object("foo", [2])->store;
- $bucket->new_object("bar", [3])->store;
- $bucket->new_object("baz", [4])->store;
- my $result =
- $client->add($bucket->name)->map("Riak.mapValuesJson")
- ->reduce("Riak.reduceSum")->run;
- ok $result->[0];
-}
-
-# javascript map reduce from object
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- $bucket->new_object("foo", [2])->store;
- my $obj = $bucket->get("foo");
- my $result = $obj->map("Riak.mapValuesJson")->run;
- is_deeply $result->[0], [2], 'valid content';
-}
-
-# store and get links
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- my $obj = $bucket->new_object("foo", [2]);
- my $obj1 = $bucket->new_object("foo1", {test => 1})->store;
- my $obj2 = $bucket->new_object("foo2", {test => 2})->store;
- my $obj3 = $bucket->new_object("foo3", {test => 3})->store;
- $obj->add_link($obj1);
- $obj->add_link($obj2, "tag");
- $obj->add_link($obj3, "tag2!@&");
- $obj->store;
- $obj = $bucket->get("foo");
- my $count = $obj->count_links;
- is $count, 3, 'got 3 links';
-}
-
-# link walking
-{
- my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST});
- my $bucket = $client->bucket($bucket_name);
- my $obj = $bucket->new_object("foo", [2]);
- my $obj1 = $bucket->new_object("foo1", {test => 1})->store;
- my $obj2 = $bucket->new_object("foo2", {test => 2})->store;
- my $obj3 = $bucket->new_object("foo3", {test => 3})->store;
- $obj->add_link($obj1)->add_link($obj2, "tag")->add_link($obj3, "tag2!@&");
- $obj->store;
- $obj = $bucket->get("foo");
- my $results = $obj->link($bucket_name)->run();
- is scalar @$results, 3, 'got 3 links via links walking';
- $results = $obj->link($bucket_name, 'tag')->run;
- is scalar @$results, 1, 'got one link via link walking';
-}
-
-done_testing;
diff --git a/t/01_store_fetch_object.t b/t/01_store_fetch_object.t
new file mode 100644
index 0000000..09f5e99
--- /dev/null
+++ b/t/01_store_fetch_object.t
@@ -0,0 +1,25 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak {
+ my ($client, $bucket_name) = @_;
+ ok my $bucket = $client->bucket($bucket_name), 'got bucket test';
+ my $content = [int(rand(100))];
+ ok my $obj = $bucket->new_object('foo', $content),
+ 'created a new riak object';
+
+ ok $obj->store, 'store object foo';
+
+ if ($obj->client->can('status')) {
+ is $obj->client->status, 200, 'valid status';
+ }
+
+ is $obj->key, 'foo', 'valid key';
+ is_deeply $obj->data, $content, 'valid content';
+
+ ok $obj = $bucket->new_object(undef, $content),
+ 'created a new riak object without a key';
+ ok $obj->store, 'store object without key';
+ ok $obj->key, 'key created';
+};
diff --git a/t/02_missing_object.t b/t/02_missing_object.t
new file mode 100644
index 0000000..93bdf60
--- /dev/null
+++ b/t/02_missing_object.t
@@ -0,0 +1,10 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak {
+ my ($client, $bucket_name) = @_;
+ my $bucket = $client->bucket($bucket_name);
+ my $obj = $bucket->get("missing");
+ ok !$obj->data, 'no data';
+};
diff --git a/t/03_delete_object.t b/t/03_delete_object.t
new file mode 100644
index 0000000..f2d6d10
--- /dev/null
+++ b/t/03_delete_object.t
@@ -0,0 +1,20 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+use Data::Dumper;
+
+test_riak {
+ my ($client, $bucket_name) = @_;
+
+ my $bucket = $client->bucket($bucket_name);
+ my $content = [int(rand(100))];
+ my $obj = $bucket->new_object('foo', $content);
+ ok $obj->store, 'object is stored';
+ $obj = $bucket->get('foo');
+ ok $obj->exists, 'object exists';
+ $obj->delete;
+ ok $obj->exists, " exists after delete";
+ $obj->load;
+ ok !$obj->exists, "object don't exists after load";
+ is scalar(@{$bucket->get_keys}), 0, "no keys left in bucket";
+};
diff --git a/t/04_bucket.t b/t/04_bucket.t
deleted file mode 100644
index eb46cd7..0000000
--- a/t/04_bucket.t
+++ /dev/null
@@ -1,12 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-use Net::Riak::Bucket;
-use Net::Riak::Client;
-
-my $client = Net::Riak::Client->new;
-ok my $bucket = Net::Riak::Bucket->new(name => 'foo', client => $client),
- 'client created';
-
-done_testing;
diff --git a/t/04_bucket_properties.t b/t/04_bucket_properties.t
new file mode 100644
index 0000000..c3b4358
--- /dev/null
+++ b/t/04_bucket_properties.t
@@ -0,0 +1,24 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+use Data::Dumper;
+
+test_riak {
+ my ($client, $bucket_name) = @_;
+
+ my $bucket = $client->bucket($bucket_name);
+ $bucket->allow_multiples(1);
+ my $props = $bucket->get_properties;
+ is ref($props), 'HASH', 'get properties returns a hash';
+
+ is $bucket->allow_multiples, 1, 'allow multiples returns true';
+
+ $bucket->n_val(3);
+ is $bucket->n_val, 3, 'n_val is set to 3';
+ $bucket->set_properties({allow_mult => 0, "n_val" => 2});
+
+ is $bucket->allow_multiples, 0, "don't allow multiple anymore";
+ is $bucket->n_val, 2, 'n_val is set to 2';
+}
+
+
diff --git a/t/05_links.t b/t/05_links.t
deleted file mode 100644
index ab2ebb0..0000000
--- a/t/05_links.t
+++ /dev/null
@@ -1,18 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-use Net::Riak::Client;
-use Net::Riak::Bucket;
-use Net::Riak::Link;
-
-my $client = Net::Riak::Client->new();
-my $bucket = Net::Riak::Bucket->new(name => 'foo', client => $client);
-
-ok my $link = Net::Riak::Link->new(bucket => $bucket), 'link created';
-
-my $header = $link->to_link_header($client);
-
-is $header, '</riak/foo/_>; riaktag="foo"', 'generate valid link string';
-
-done_testing;
diff --git a/t/05_object_siblings.t b/t/05_object_siblings.t
new file mode 100644
index 0000000..4bdec63
--- /dev/null
+++ b/t/05_object_siblings.t
@@ -0,0 +1,47 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak {
+ my ($client, $bucket_name, $proto) = @_;
+
+ my $bucket = $client->bucket($bucket_name);
+ $bucket->allow_multiples(1);
+ ok $bucket->allow_multiples, 'multiples set to 1';
+
+ {
+ # test bucket still has multiples sep li
+ my $client = new_riak_client($proto);
+ my $bucket = $client->bucket($bucket_name);
+ ok $bucket->allow_multiples, 'bucket multiples set to 1';
+ }
+
+ {
+ my $obj = $bucket->get('foo');
+ is $obj->has_siblings, 0, 'has no sibilings';
+ is $obj->count_siblings, 0, 'has no sibilings';
+ }
+
+ for(1..5) {
+ my $client = new_riak_client($proto);
+ my $bucket = $client->bucket($bucket_name);
+ my $obj = $bucket->new_object('foo', [$_]);
+ $obj->store;
+ $obj->load;
+ }
+
+ my $obj = $bucket->get('foo');
+ ok $obj->has_siblings, 'object has siblings';
+ is $obj->count_siblings, 5, 'got 5 siblings';
+
+ my @siblings = $obj->siblings;
+ my $obj3 = $obj->sibling(3);
+
+ is_deeply $obj3->data, $obj->sibling(3)->data, 'sibling data matches';
+ $obj3 = $obj->sibling(3);
+ $obj3->store;
+ $obj->load;
+
+ is_deeply $obj->data, $obj3->data, 'sibling data still matches';
+ $obj->delete;
+}
diff --git a/t/06_links.t b/t/06_links.t
new file mode 100644
index 0000000..d5effb0
--- /dev/null
+++ b/t/06_links.t
@@ -0,0 +1,40 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+# store and get links
+test_riak {
+ my ($client, $bucket_name) = @_;
+
+ my $bucket = $client->bucket($bucket_name);
+ my $obj = $bucket->new_object("foo", [2]);
+ my $obj1 = $bucket->new_object("foo1", {test => 1})->store;
+ my $obj2 = $bucket->new_object("foo2", {test => 2})->store;
+ my $obj3 = $bucket->new_object("foo3", {test => 3})->store;
+ $obj->add_link($obj1);
+ $obj->add_link($obj2, "tag");
+ $obj->add_link($obj3, "tag2!@&");
+ $obj->store;
+ $obj = $bucket->get("foo");
+ is $obj->has_links, 3, 'got 3 links';
+};
+
+# link walking
+test_riak {
+ my ($client, $bucket_name) = @_;
+
+ my $bucket = $client->bucket($bucket_name);
+ my $obj = $bucket->new_object("foo", [2]);
+ my $obj1 = $bucket->new_object("foo1", {test => 1})->store;
+ my $obj2 = $bucket->new_object("foo2", {test => 2})->store;
+ my $obj3 = $bucket->new_object("foo3", {test => 3})->store;
+ $obj->add_link($obj1)->add_link($obj2, "tag")->add_link($obj3, "tag2!@&");
+ $obj->store;
+ $obj = $bucket->get("foo");
+ my $results = $obj->link($bucket_name)->run();
+ is scalar @$results, 3, 'got 3 links via links walking';
+ $results = $obj->link($bucket_name, 'tag')->run;
+ is scalar @$results, 1, 'got one link via link walking';
+};
+
+
diff --git a/t/07_map_reduce.t b/t/07_map_reduce.t
new file mode 100644
index 0000000..26fdfc0
--- /dev/null
+++ b/t/07_map_reduce.t
@@ -0,0 +1,66 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+# JS source map reduce
+test_riak {
+ my ($client, $bucket_name) = @_;
+ my $bucket = $client->bucket($bucket_name);
+ my $obj = $bucket->new_object('foo', [2])->store;
+ my $result =
+ $client->add($bucket_name, 'foo')
+ ->map("function (v) {return [JSON.parse(v.values[0].data)];}")->run;
+ is_deeply $result, [[2]], 'got valid result';
+};
+
+# JS source map reduce
+test_riak {
+ my ($client, $bucket_name) = @_;
+ my $bucket = $client->bucket($bucket_name);
+ my $obj = $bucket->new_object('foo', [2])->store;
+ $obj = $bucket->new_object('bar', [3])->store;
+ $bucket->new_object('baz', [4])->store;
+ my $result =
+ $client->add($bucket_name, "foo")->add($bucket_name, "bar")
+ ->add($bucket_name, "baz")->map("function (v) { return [1]; }")
+ ->reduce("function (v) { return [v.length]; }")->run;
+ is $result->[0], 3, "success map reduce";
+};
+
+# JS named map reduce
+test_riak {
+ my ($client, $bucket_name) = @_;
+ my $bucket = $client->bucket($bucket_name);
+ my $obj = $bucket->new_object("foo", [2])->store;
+ $obj = $bucket->new_object("bar", [3])->store;
+ $obj = $bucket->new_object("baz", [4])->store;
+ my $result =
+ $client->add($bucket_name, "foo")->add($bucket_name, "bar")
+ ->add($bucket_name, "baz")->map("Riak.mapValuesJson")
+ ->reduce("Riak.reduceSum")->run();
+ ok $result->[0];
+};
+
+# JS bucket map reduce
+test_riak {
+ my ($client, $bucket_name) = @_;
+ my $bucket = $client->bucket("bucket_".int(rand(10)));
+ $bucket->new_object("foo", [2])->store;
+ $bucket->new_object("bar", [3])->store;
+ $bucket->new_object("baz", [4])->store;
+ my $result =
+ $client->add($bucket->name)->map("Riak.mapValuesJson")
+ ->reduce("Riak.reduceSum")->run;
+ ok $result->[0];
+};
+
+# JS map reduce from object
+test_riak {
+ my ($client, $bucket_name) = @_;
+ my $bucket = $client->bucket($bucket_name);
+ $bucket->new_object("foo", [2])->store;
+ my $obj = $bucket->get("foo");
+ my $result = $obj->map("Riak.mapValuesJson")->run;
+ is_deeply $result->[0], [2], 'valid content';
+};
+
diff --git a/t/10_list_buckets.t b/t/10_list_buckets.t
new file mode 100644
index 0000000..eaedb4b
--- /dev/null
+++ b/t/10_list_buckets.t
@@ -0,0 +1,15 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak {
+ my ($client, $bucket_name) = @_;
+
+ my $bucket = $client->bucket($bucket_name."_1");
+ ok $bucket->new_object( "bob" => { 'name' => 'bob', age => 23 } )->store, 'store';
+
+ $bucket = $client->bucket($bucket_name."_2");
+ ok $bucket->new_object( "bob" => { 'name' => 'bob', age => 23 } )->store, 'store';
+
+ ok scalar( $client->all_buckets) >= 2, 'listed buckets';
+};
diff --git a/t/11_get_keys.t b/t/11_get_keys.t
new file mode 100644
index 0000000..3c771a6
--- /dev/null
+++ b/t/11_get_keys.t
@@ -0,0 +1,36 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak {
+ my ($client, $bucket_name) = @_;
+
+ my $bucket = $client->bucket($bucket_name);
+
+ for (1..4) {
+ my $obj = $bucket->new_object("foo$_", [ "foo_test" ]);
+ ok $obj->store, 'object is stored';
+ }
+
+ my $keys = $bucket->get_keys;
+
+ is_deeply [sort @$keys], [ map { "foo$_" } 1..4 ], "got keys";
+
+
+ my @keys2;
+
+ $bucket->get_keys( {
+ stream => 'true',
+ cb => sub {
+ ok 1, "call back called for $_[0]";
+ push @keys2, $_[0];
+ }
+ }
+ );
+
+ $bucket->delete_object($_) for @keys2;
+
+ $keys = $bucket->get_keys;
+
+ is scalar @$keys, 0, "deleted keys";
+};
diff --git a/t/90_bug_links.t b/t/90_bug_links.t
index d1851af..ccc7e10 100644
--- a/t/90_bug_links.t
+++ b/t/90_bug_links.t
@@ -1,70 +1,59 @@
-use strict;
-use warnings;
-use Net::Riak;
+use lib 't/lib';
use Test::More;
-
-BEGIN {
- unless ( $ENV{RIAK_REST_HOST} ) {
- require Test::More;
- Test::More::plan(
- skip_all => 'RIAK_REST_HOST not set.. skipping' );
+use Test::Riak;
+
+test_riak {
+ my ($client, $bucket_name) = @_;
+
+ # set up a bucket containing two person/user records and store them
+ my $bucket_one = $client->bucket($bucket_name);
+
+ my $ref1 = {
+ username => 'griffinp',
+ fullname => 'Peter Griffin',
+ email => 'peter@familyguy.com'
+ };
+ my $ref2 = {
+ username => 'griffins',
+ fullname => 'Stewie Griffin',
+ email => 'stewie@familyguy.com'
+ };
+
+ ok $bucket_one->new_object( $ref1->{username} => $ref1 )->store(1,1), 'new object stored';
+ ok $bucket_one->new_object( $ref2->{username} => $ref2 )->store(1,1), 'new object stored';
+
+ # create another bucket to store some data that will link to users
+ my $bucket_two = $client->bucket("$bucket_name\_2");
+
+ # create the object
+ my $item_data = {
+ a_number => rand(),
+ some_text => 'e86d62c91139f328df5f05e9698a248f',
+ epoch => time()
+ };
+ ok my $item = $bucket_two->new_object( '25FCBA57-8D75-41B6-9E5A-0E2528BB3342' => $item_data ), 'store new object to second bucket';
+
+ # create a link to each person that is stored in bucket 'ONE' and associate the link
+ # with the $item object
+ foreach my $person ( $ref1, $ref2 ) {
+ my $link = Net::Riak::Link->new(
+ bucket => $bucket_one,
+ key => $person->{email},
+ tag => 'owners'
+ );
+ ok $item->add_link( $link ), 'link added to object';
}
-}
-
-ok my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST}), 'client created';
-
-# set up a bucket containing two person/user records and store them
-my $bucket_one = $client->bucket('ONE');
-my $ref1 = {
- username => 'griffinp',
- fullname => 'Peter Griffin',
- email => 'peter@familyguy.com'
-};
-my $ref2 = {
- username => 'griffins',
- fullname => 'Stewie Griffin',
- email => 'stewie@familyguy.com'
-};
+ # store to Riak
+ ok $item->store( 1, 1 ), 'object stored';
-ok $bucket_one->new_object( $ref1->{username} => $ref1 )->store(1,1), 'new object stored';
-ok $bucket_one->new_object( $ref2->{username} => $ref2 )->store(1,1), 'new object stored';
+ my $test_links = $bucket_two->get('25FCBA57-8D75-41B6-9E5A-0E2528BB3342', [1]);
+ my $links = $test_links->links;
-# create another bucket to store some data that will link to users
-my $bucket_two = $client->bucket('TWO');
+ is $links->[0]->key, 'peter@familyguy.com', 'good owner for first link';
+ is $links->[1]->key, 'stewie@familyguy.com', 'good owner for second link';
-# create the object
-my $item_data = {
- a_number => rand(),
- some_text => 'e86d62c91139f328df5f05e9698a248f',
- epoch => time()
+ $test_links->remove_link($links->[0]);
+ $links = $test_links->links;
+ is $links->[0]->key, 'stewie@familyguy.com', 'good owner for second link after a remove link';
};
-ok my $item = $bucket_two->new_object( '25FCBA57-8D75-41B6-9E5A-0E2528BB3342' => $item_data ), 'store new object to second bucket';
-
-# create a link to each person that is stored in bucket 'ONE' and associate the link
-# with the $item object
-foreach my $person ( $ref1, $ref2 ) {
- my $link = Net::Riak::Link->new(
- bucket => $bucket_one,
- key => $person->{email},
- tag => 'owners'
- );
- ok $item->add_link( $link ), 'link added to object';
-}
-
-# store to Riak
-ok $item->store( 1, 1 ), 'object stored';
-
-my $test_links = $bucket_two->get('25FCBA57-8D75-41B6-9E5A-0E2528BB3342', [1]);
-my $links = $test_links->links;
-is $links->[0]->key, 'peter@familyguy.com', 'good owner for first link';
-is $links->[1]->key, 'stewie@familyguy.com', 'good owner for second link';
-
-$test_links->remove_link($links->[0]);
-$links = $test_links->links;
-is $links->[0]->key, 'stewie@familyguy.com', 'good owner for second link after a remove link';
-
-$test_links->remove_link($links->[0]);
-$links = $test_links->links;
-is $links->[0]->key, 'griffins', 'good owner for second link after a remove link';
-done_testing;
diff --git a/t/02_client.t b/t/client.t
index f90621e..f90621e 100644
--- a/t/02_client.t
+++ b/t/client.t
diff --git a/t/06_host.t b/t/hosts.t
index 801e8b4..801e8b4 100644
--- a/t/06_host.t
+++ b/t/hosts.t
diff --git a/t/lib/Test/Riak.pm b/t/lib/Test/Riak.pm
new file mode 100644
index 0000000..6ec13ab
--- /dev/null
+++ b/t/lib/Test/Riak.pm
@@ -0,0 +1,99 @@
+package Test::Riak;
+use strict;
+use warnings;
+use Test::More 'no_plan';
+use_ok 'Net::Riak';
+
+sub import {
+ no strict 'refs';
+ *{caller()."::test_riak"} = \&{"Test::Riak::test_riak"};
+ *{caller()."::test_riak_pbc"} = \&{"Test::Riak::test_riak_pbc"};
+ *{caller()."::test_riak_rest"} = \&{"Test::Riak::test_riak_rest"};
+ *{caller()."::new_riak_client"} = \&{"Test::Riak::new_riak_client"};
+ strict->import;
+ warnings->import;
+}
+
+sub test_riak (&) {
+ my ($test_case) = @_;
+ test_riak_rest($test_case);
+ test_riak_pbc($test_case);
+}
+
+sub test_riak_rest (&) {
+ my ($test_case) = @_;
+
+ if ($ENV{RIAK_REST_HOST}) {
+ diag "Running for REST";
+ my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST}, r => 1, w => 1, dw => 1);
+ isa_ok $client, 'Net::Riak';
+ is $client->is_alive, 1, 'connected';
+ run_test_case($test_case, $client, 'REST');
+ }
+ else {
+ diag "Skipping REST tests - RIAK_REST_HOST not set";
+ }
+}
+
+sub test_riak_pbc (&) {
+ my ($test_case) = @_;
+
+ if ($ENV{RIAK_PBC_HOST}) {
+
+ diag "Running for PBC";
+ my ($host, $port) = split ':', $ENV{RIAK_PBC_HOST};
+
+ my $client = Net::Riak->new(
+ transport => 'PBC',
+ host => $host,
+ port => $port,
+ r => 1,
+ w => 1,
+ dw => 1,
+ );
+
+ isa_ok $client, 'Net::Riak';
+ is $client->is_alive, 1, 'connected';
+ run_test_case($test_case, $client, 'PBC');
+ }
+ else {
+ diag "Skipping PBC tests - RIAK_PBC_HOST not set";
+ }
+}
+
+sub new_riak_client {
+ my $proto = shift;
+
+ if ($proto eq 'PBC') {
+ my ($host, $port) = split ':', $ENV{RIAK_PBC_HOST};
+
+ return Net::Riak->new(
+ transport => 'PBC',
+ host => $host,
+ port => $port,
+ r => 1,
+ w => 1,
+ dw => 1,
+ );
+ }
+ elsif ($proto eq 'REST') {
+ return Net::Riak->new(host => $ENV{RIAK_REST_HOST});
+ }
+
+ die "Unknown protocol $proto";
+}
+
+sub run_test_case {
+ my ($case, $client, $proto) = @_;
+
+ my $bucket = "TEST_RIAK_$$".sprintf("%d", rand()*1000);
+
+ local $@;
+ eval { $case->($client, $bucket, $proto) };
+
+ if ($@) {
+ ok 0, "$@";
+ }
+
+ #TODO add bucket cleanup
+}
diff --git a/t/pbc/server_info.t b/t/pbc/server_info.t
new file mode 100644
index 0000000..e276dc5
--- /dev/null
+++ b/t/pbc/server_info.t
@@ -0,0 +1,10 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak_pbc {
+ my ($client) = @_;
+ my $resp = $client->server_info;
+ ok exists $resp->{node}, 'got server node';
+ ok exists $resp->{server_version}, 'got server version';
+};
diff --git a/t/03_object.t b/t/rest/populate_object.t
index 13de9d4..b875ad7 100644
--- a/t/03_object.t
+++ b/t/rest/populate_object.t
@@ -6,10 +6,10 @@ use JSON;
use HTTP::Response;
use Net::Riak::Bucket;
-use Net::Riak::Client;
+use Net::Riak;
use Net::Riak::Object;
-my $client = Net::Riak::Client->new();
+my $client = Net::Riak->new()->client;
my $bucket = Net::Riak::Bucket->new(name => 'foo', client => $client);
ok my $object =
@@ -17,11 +17,12 @@ ok my $object =
'object bar created';
my $response = HTTP::Response->new(400);
+$client->http_response($response);
ok !$object->exists, 'object don\'t exists';
eval {
- $object->populate($response, [200]);
+ $client->populate_object($object, $response, [200]);
};
like $@, qr/Expected status 200, received 400/, "can't populate with a 400";
@@ -29,14 +30,15 @@ like $@, qr/Expected status 200, received 400/, "can't populate with a 400";
my $value = {value => 1};
$response = HTTP::Response->new(200);
+$client->http_response($response);
$response->content(JSON::encode_json($value));
-$object->populate($response, [200]);
+$client->populate_object($object, $response, [200]);
ok $object->exists, 'object exists';
is_deeply $value, $object->data, 'got same data';
-is $object->status, 200, 'last http code is 200';
+is $object->client->status, 200, 'last http code is 200';
done_testing;
diff --git a/t/07_properties.t b/t/rest/properties.t
index 26a643c..f6327ac 100644
--- a/t/07_properties.t
+++ b/t/rest/properties.t
@@ -5,7 +5,7 @@ use Test::More;
use Net::Riak;
use HTTP::Response;
-my $client = Net::Riak::Client->new;
+my $client = Net::Riak::Client->with_traits('Net::Riak::Transport::REST')->new();
ok my $bucket = Net::Riak::Bucket->new(name => 'bar', client => $client),
'client created';
diff --git a/t/rest/stats.t b/t/rest/stats.t
new file mode 100644
index 0000000..9f52dcc
--- /dev/null
+++ b/t/rest/stats.t
@@ -0,0 +1,10 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak_rest {
+ my ($client) = @_;
+ my $resp = $client->stats;
+ is ref($resp), 'HASH', 'got stats';
+ ok exists $resp->{webmachine_version}, 'contains expected key';
+};
diff --git a/t/08_stream.t b/t/rest/stream.t
index becc600..2a545d3 100644
--- a/t/08_stream.t
+++ b/t/rest/stream.t
@@ -5,7 +5,7 @@ use Test::More;
use Net::Riak;
use HTTP::Response;
-my $client = Net::Riak::Client->new;
+my $client = Net::Riak::Client->with_traits('Net::Riak::Transport::REST')->new();
ok my $bucket = Net::Riak::Bucket->new(name => 'bar', client => $client),
'bucket created';
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-06 13:00:38 +0000