From 79bea382fd2c0753ca9ace79a11bb74c9a1d722b Mon Sep 17 00:00:00 2001 From: Robin Edwards Date: Wed, 20 Apr 2011 14:38:43 +0100 Subject: merged pbc branch to master --- t/00_use.t | 5 ++ t/01_basic.t | 209 ---------------------------------------------- t/01_store_fetch_object.t | 25 ++++++ t/02_client.t | 20 ----- t/02_missing_object.t | 10 +++ t/03_delete_object.t | 20 +++++ t/03_object.t | 42 ---------- t/04_bucket.t | 12 --- t/04_bucket_properties.t | 24 ++++++ t/05_links.t | 18 ---- t/05_object_siblings.t | 47 +++++++++++ t/06_host.t | 20 ----- t/06_links.t | 40 +++++++++ t/07_map_reduce.t | 66 +++++++++++++++ t/07_properties.t | 30 ------- t/08_stream.t | 37 -------- t/10_list_buckets.t | 15 ++++ t/11_get_keys.t | 36 ++++++++ t/90_bug_links.t | 115 ++++++++++++------------- t/client.t | 20 +++++ t/hosts.t | 20 +++++ t/lib/Test/Riak.pm | 99 ++++++++++++++++++++++ t/pbc/server_info.t | 10 +++ t/rest/populate_object.t | 44 ++++++++++ t/rest/properties.t | 30 +++++++ t/rest/stats.t | 10 +++ t/rest/stream.t | 37 ++++++++ 27 files changed, 610 insertions(+), 451 deletions(-) create mode 100644 t/00_use.t delete mode 100644 t/01_basic.t create mode 100644 t/01_store_fetch_object.t delete mode 100644 t/02_client.t create mode 100644 t/02_missing_object.t create mode 100644 t/03_delete_object.t delete mode 100644 t/03_object.t delete mode 100644 t/04_bucket.t create mode 100644 t/04_bucket_properties.t delete mode 100644 t/05_links.t create mode 100644 t/05_object_siblings.t delete mode 100644 t/06_host.t create mode 100644 t/06_links.t create mode 100644 t/07_map_reduce.t delete mode 100644 t/07_properties.t delete mode 100644 t/08_stream.t create mode 100644 t/10_list_buckets.t create mode 100644 t/11_get_keys.t create mode 100644 t/client.t create mode 100644 t/hosts.t create mode 100644 t/lib/Test/Riak.pm create mode 100644 t/pbc/server_info.t create mode 100644 t/rest/populate_object.t create mode 100644 t/rest/properties.t create mode 100644 t/rest/stats.t create mode 100644 t/rest/stream.t (limited to 't') 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_client.t b/t/02_client.t deleted file mode 100644 index f90621e..0000000 --- a/t/02_client.t +++ /dev/null @@ -1,20 +0,0 @@ -use strict; -use warnings; - -use Test::More; - -use Net::Riak; -use Net::Riak::Client; - -my $riak = Net::Riak->new(r => 3, w => 4, dw => 5); -is $riak->client->r, 3, 'r set to 3'; -is $riak->client->dw, 5, 'r set to 5'; - -$riak = Net::Riak::Client->new(r => 5, w => 4, dw => 3); -is $riak->r, 5, 'r set to 5'; -is $riak->dw, 3, 'r set to 3'; - -ok $riak->client_id, 'id set'; - -done_testing; - 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/03_object.t b/t/03_object.t deleted file mode 100644 index 13de9d4..0000000 --- a/t/03_object.t +++ /dev/null @@ -1,42 +0,0 @@ -use strict; -use warnings; -use Test::More; - -use JSON; -use HTTP::Response; - -use Net::Riak::Bucket; -use Net::Riak::Client; -use Net::Riak::Object; - -my $client = Net::Riak::Client->new(); -my $bucket = Net::Riak::Bucket->new(name => 'foo', client => $client); - -ok my $object = - Net::Riak::Object->new(key => 'bar', bucket => $bucket, client => $client), - 'object bar created'; - -my $response = HTTP::Response->new(400); - -ok !$object->exists, 'object don\'t exists'; - -eval { - $object->populate($response, [200]); -}; - -like $@, qr/Expected status 200, received 400/, "can't populate with a 400"; - -my $value = {value => 1}; - -$response = HTTP::Response->new(200); -$response->content(JSON::encode_json($value)); - -$object->populate($response, [200]); - -ok $object->exists, 'object exists'; - -is_deeply $value, $object->data, 'got same data'; - -is $object->status, 200, 'last http code is 200'; - -done_testing; 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, '; 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_host.t b/t/06_host.t deleted file mode 100644 index 801e8b4..0000000 --- a/t/06_host.t +++ /dev/null @@ -1,20 +0,0 @@ -use strict; -use warnings; -use Test::More; - -package test::host; -use Moose; with 'Net::Riak::Role::Hosts'; - -package main; - -my $test = test::host->new(); -is scalar @{$test->host}, 1, 'got one host'; - -ok my $host = $test->get_host, 'got host'; -is $host, 'http://127.0.0.1:8098', 'host is ok'; - -$test = test::host->new(host => ['http://10.0.0.40', 'http://10.0.0.41']); -is scalar @{$test->host}, 2, 'got two hosts'; -ok $host = $test->get_host, 'got host'; - -done_testing; 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/07_properties.t b/t/07_properties.t deleted file mode 100644 index 26a643c..0000000 --- a/t/07_properties.t +++ /dev/null @@ -1,30 +0,0 @@ -use strict; -use warnings; -use Test::More; - -use Net::Riak; -use HTTP::Response; - -my $client = Net::Riak::Client->new; -ok my $bucket = Net::Riak::Bucket->new(name => 'bar', client => $client), - 'client created'; - -$bucket->client->useragent->add_handler( - request_send => sub { - my $response = HTTP::Response->new(200); - $response->content( - '{"props":{"name":"foo","allow_mult":false,"big_vclock":50,"chash_keyfun":{"mod":"riak_util","fun":"chash_std_keyfun"},"linkfun":{"mod":"jiak_object","fun":"mapreduce_linkfun"},"n_val":3,"old_vclock":86400,"small_vclock":10,"young_vclock":20},"keys":["bar"]}' - ); - $response; - } -); - -ok my $props = $bucket->get_properties(), 'fetch properties'; -ok my $keys = $bucket->get_keys(), 'fetch list of keys'; - -is_deeply $keys, [qw/bar/], 'keys is bar'; - -ok my $name = $bucket->get_property('name'), 'get props name'; -is $name, 'foo', 'name is foo'; - -done_testing; diff --git a/t/08_stream.t b/t/08_stream.t deleted file mode 100644 index becc600..0000000 --- a/t/08_stream.t +++ /dev/null @@ -1,37 +0,0 @@ -use strict; -use warnings; -use Test::More; - -use Net::Riak; -use HTTP::Response; - -my $client = Net::Riak::Client->new; -ok my $bucket = Net::Riak::Bucket->new(name => 'bar', client => $client), - 'bucket created'; - -$bucket->client->useragent->add_handler( - request_send => sub { - my $response = HTTP::Response->new(200); - $response->content( - '{}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":["apple"]}{"keys":[]}{"keys":["pear","peach"]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}' - ); - $response; - } -); - -ok my $props = $bucket->get_properties({props => 'false', keys => 'stream'}), 'get_properties'; -is_deeply $props, { keys => [ qw(apple pear peach) ], props => {} }, 'keys ok'; - -ok my $keys = $bucket->get_keys({stream => 1}), 'get_keys'; -is_deeply $keys, [qw/apple pear peach/], 'keys ok'; - -my $result = ''; -ok $bucket->get_properties({props => 'false', cb => sub { $result .= "** $_[0] " }}), 'get_properties with callback'; -is $result, '** apple ** pear ** peach ', 'result ok'; - -$result = ''; -ok ! defined $bucket->get_keys({cb => sub { $result .= "--> $_[0] " }}), 'get_keys with callback'; -is $result, '--> apple --> pear --> peach ', 'result ok'; - -done_testing; - 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/client.t b/t/client.t new file mode 100644 index 0000000..f90621e --- /dev/null +++ b/t/client.t @@ -0,0 +1,20 @@ +use strict; +use warnings; + +use Test::More; + +use Net::Riak; +use Net::Riak::Client; + +my $riak = Net::Riak->new(r => 3, w => 4, dw => 5); +is $riak->client->r, 3, 'r set to 3'; +is $riak->client->dw, 5, 'r set to 5'; + +$riak = Net::Riak::Client->new(r => 5, w => 4, dw => 3); +is $riak->r, 5, 'r set to 5'; +is $riak->dw, 3, 'r set to 3'; + +ok $riak->client_id, 'id set'; + +done_testing; + diff --git a/t/hosts.t b/t/hosts.t new file mode 100644 index 0000000..801e8b4 --- /dev/null +++ b/t/hosts.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More; + +package test::host; +use Moose; with 'Net::Riak::Role::Hosts'; + +package main; + +my $test = test::host->new(); +is scalar @{$test->host}, 1, 'got one host'; + +ok my $host = $test->get_host, 'got host'; +is $host, 'http://127.0.0.1:8098', 'host is ok'; + +$test = test::host->new(host => ['http://10.0.0.40', 'http://10.0.0.41']); +is scalar @{$test->host}, 2, 'got two hosts'; +ok $host = $test->get_host, 'got host'; + +done_testing; 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/rest/populate_object.t b/t/rest/populate_object.t new file mode 100644 index 0000000..b875ad7 --- /dev/null +++ b/t/rest/populate_object.t @@ -0,0 +1,44 @@ +use strict; +use warnings; +use Test::More; + +use JSON; +use HTTP::Response; + +use Net::Riak::Bucket; +use Net::Riak; +use Net::Riak::Object; + +my $client = Net::Riak->new()->client; +my $bucket = Net::Riak::Bucket->new(name => 'foo', client => $client); + +ok my $object = + Net::Riak::Object->new(key => 'bar', bucket => $bucket, client => $client), + 'object bar created'; + +my $response = HTTP::Response->new(400); +$client->http_response($response); + +ok !$object->exists, 'object don\'t exists'; + +eval { + $client->populate_object($object, $response, [200]); +}; + +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)); + +$client->populate_object($object, $response, [200]); + +ok $object->exists, 'object exists'; + +is_deeply $value, $object->data, 'got same data'; + +is $object->client->status, 200, 'last http code is 200'; + +done_testing; diff --git a/t/rest/properties.t b/t/rest/properties.t new file mode 100644 index 0000000..f6327ac --- /dev/null +++ b/t/rest/properties.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Test::More; + +use Net::Riak; +use HTTP::Response; + +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'; + +$bucket->client->useragent->add_handler( + request_send => sub { + my $response = HTTP::Response->new(200); + $response->content( + '{"props":{"name":"foo","allow_mult":false,"big_vclock":50,"chash_keyfun":{"mod":"riak_util","fun":"chash_std_keyfun"},"linkfun":{"mod":"jiak_object","fun":"mapreduce_linkfun"},"n_val":3,"old_vclock":86400,"small_vclock":10,"young_vclock":20},"keys":["bar"]}' + ); + $response; + } +); + +ok my $props = $bucket->get_properties(), 'fetch properties'; +ok my $keys = $bucket->get_keys(), 'fetch list of keys'; + +is_deeply $keys, [qw/bar/], 'keys is bar'; + +ok my $name = $bucket->get_property('name'), 'get props name'; +is $name, 'foo', 'name is foo'; + +done_testing; 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/rest/stream.t b/t/rest/stream.t new file mode 100644 index 0000000..2a545d3 --- /dev/null +++ b/t/rest/stream.t @@ -0,0 +1,37 @@ +use strict; +use warnings; +use Test::More; + +use Net::Riak; +use HTTP::Response; + +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'; + +$bucket->client->useragent->add_handler( + request_send => sub { + my $response = HTTP::Response->new(200); + $response->content( + '{}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":["apple"]}{"keys":[]}{"keys":["pear","peach"]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}{"keys":[]}' + ); + $response; + } +); + +ok my $props = $bucket->get_properties({props => 'false', keys => 'stream'}), 'get_properties'; +is_deeply $props, { keys => [ qw(apple pear peach) ], props => {} }, 'keys ok'; + +ok my $keys = $bucket->get_keys({stream => 1}), 'get_keys'; +is_deeply $keys, [qw/apple pear peach/], 'keys ok'; + +my $result = ''; +ok $bucket->get_properties({props => 'false', cb => sub { $result .= "** $_[0] " }}), 'get_properties with callback'; +is $result, '** apple ** pear ** peach ', 'result ok'; + +$result = ''; +ok ! defined $bucket->get_keys({cb => sub { $result .= "--> $_[0] " }}), 'get_keys with callback'; +is $result, '--> apple --> pear --> peach ', 'result ok'; + +done_testing; + -- cgit 1.4.1