update POD; add changelog

6 files changed, 274 insertions, 103 deletions

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..68366a6
--- /dev/null
+++ b/Changes
@@ -0,0 +1,2 @@
+0.01 Mon 14 Jun 2010 01:08:52 PM CEST  
+    - initial release (port of the python client)
\ No newline at end of file
diff --git a/lib/Net/Riak.pm b/lib/Net/Riak.pm
index f31415b..dda2ccc 100644
--- a/lib/Net/Riak.pm
+++ b/lib/Net/Riak.pm
@@ -124,20 +124,32 @@ Get the bucket by the specified name. Since buckets always exist, this will alwa
 
 =method is_alive
 
+    if (!$client->is_alive) {
+        ...
+    }
+
 Check if the Riak server for this client is alive
 
 =method add
 
+    my $map_reduce = $client->add('bucket_name', 'key');
+
 Start assembling a Map/Reduce operation
 
 =method link
 
+    my $map_reduce = $client->link();
+
 Start assembling a Map/Reduce operation
 
 =method map
 
+    my $map_reduce = $client->add('bucket_name', 'key')->map("function ...");
+
 Start assembling a Map/Reduce operation
 
 =method reduce
 
+    my $map_reduce = $client->add(..)->map(..)->reduce("function ...");
+
 Start assembling a Map/Reduce operation
diff --git a/lib/Net/Riak/Bucket.pm b/lib/Net/Riak/Bucket.pm
index ec17f5b..ac7de24 100644
--- a/lib/Net/Riak/Bucket.pm
+++ b/lib/Net/Riak/Bucket.pm
@@ -136,52 +136,78 @@ sub new_object {
 
 =head1 SYNOPSIS
 
-The L<Net::Riak::Bucket> object allows you to access and change information about a Riak bucket, and provides methods to create or retrieve objects within the bucket.
+    my $client = Net::Riak->new(...);
+    my $bucket = $client->bucket('foo');
+    my $object = $bucket->new_object('foo', {...});
+    $object->store;
+    $object->get('foo2');
 
 =head1 DESCRIPTION
 
+The L<Net::Riak::Bucket> object allows you to access and change information about a Riak bucket, and provides methods to create or retrieve objects within the bucket.
+
 =head2 ATTRIBUTES
 
 =item B<name>
 
+    my $name = $bucket->name;
+
 Get the bucket name
 
 =item B<r>
 
+    my $r_value = $bucket->r;
+
 R value setting for this client (default 2)
 
 =item B<w>
 
+    my $w_value = $bucket->w;
+
 W value setting for this client (default 2)
 
 =item B<dw>
 
+    my $dw_value = $bucket->dw;
+
 DW value setting for this client (default 2)
 
 =head2 METHODS
 
 =method new_object
 
+    my $obj = $bucket->new_object($key, $data);
+
 Create a new L<Net::Riak::Object> object that will be stored as JSON.
 
 =method get
 
+    my $obj = $bucket->get($key, [$r]);
+
 Retrieve a JSON-encoded object from Riak
 
 =method n_val
 
+    my $n_val = $bucket->n_val;
+
 Get/set the N-value for this bucket, which is the number of replicas that will be written of each object in the bucket. Set this once before you write any data to the bucket, and never change it again, otherwise unpredictable things could happen. This should only be used if you know what you are doing.
 
 =method allow_multiples
 
+    my $allow_mul = $bucket->allow_multiples;
+
 If set to True, then writes with conflicting data will be stored and returned to the client. This situation can be detected by calling has_siblings() and get_siblings(). This should only be used if you know what you are doing.
 
 =method set_property
 
+    $bucket->set_property({n_val => 2});
+
 Set a bucket property. This should only be used if you know what you are doing.
 
 =method get_property
 
+    my $prop = $bucket->get_property('n_val');
+
 Retrieve a bucket property
 
 =method set_properties
@@ -191,3 +217,4 @@ Set multiple bucket properties in one call. This should only be used if you know
 =method get_properties
 
 Retrieve an associative array of all bucket properties.
+
diff --git a/lib/Net/Riak/Link.pm b/lib/Net/Riak/Link.pm
index 88bceaa..7a1afa3 100644
--- a/lib/Net/Riak/Link.pm
+++ b/lib/Net/Riak/Link.pm
@@ -40,3 +40,4 @@ sub to_link_header {
 }
 
 1;
+
diff --git a/lib/Net/Riak/Object.pm b/lib/Net/Riak/Object.pm
index f6e8664..d7ae5ab 100644
--- a/lib/Net/Riak/Object.pm
+++ b/lib/Net/Riak/Object.pm
@@ -253,9 +253,6 @@ sub add_link {
     }
     $self->remove_link($new_link);
     $self->append_link($new_link);
-
-    # warn "on est bien ici ??\n";
-    # use YAML; warn Dump $new_link;
     $self;
 }
 
@@ -312,12 +309,167 @@ sub reduce {
 
 =head1 SYNOPSIS
 
-The L<Net::Riak::Object> holds meta information about a Riak object, plus the object's data.
+    my $obj = $bucket->get('foo');
 
-=head1 DESCRIPTION
 
+=head1 DESCRIPTION
 
+The L<Net::Riak::Object> holds meta information about a Riak object, plus the object's data.
 
 =head2 ATTRIBUTES
 
+=over 4
+
+=item B<key>
+
+    my $key = $obj->key;
+
+Get the key of this object
+
+=item B<client>
+
+=item B<bucket>
+
+=item B<data>
+
+Get or set the data stored in this object.
+
+=item B<r>
+
+=item B<w>
+
+=item B<dw>
+
+=item B<content_type>
+
+=item B<status>
+
+Get the HTTP status from the last operation on this object.
+
+=item B<links>
+
+Get an array of L<Net::Riak::Link> objects
+
+=item B<exists>
+
+Return true if the object exists, false otherwise.
+
+=item B<siblings>
+
+Return an array of Siblings
+
+=back
+
 =head2 METHODS
+
+=method count_links
+
+Return the number of links
+
+=method append_link
+
+Add a new link
+
+=method get_siblings
+
+Return the number of siblings
+
+=method add_sibling
+
+Add a new sibling
+
+=method count_siblings
+
+=method get_sibling
+
+Return a sibling
+
+=method store
+
+    $obj->store($w, $dw);
+
+Store the object in Riak. When this operation completes, the object could contain new metadata and possibly new data if Riak contains a newer version of the object according to the object's vector clock.
+
+=over 2
+
+=item B<w>
+
+W-value, wait for this many partitions to respond before returning to client.
+
+=item B<dw>
+
+DW-value, wait for this many partitions to confirm the write before returning to client.
+
+=back
+
+=method load
+
+    $obj->load($w);
+
+Reload the object from Riak. When this operation completes, the object could contain new metadata and a new value, if the object was updated in Riak since it was last retrieved.
+
+=over 4
+
+=item B<r>
+
+R-Value, wait for this many partitions to respond before returning to client.
+
+=back
+
+=method delete
+
+    $obj->delete($dw);
+
+Delete this object from Riak.
+
+=over 4
+
+=item B<dw>
+
+DW-value. Wait until this many partitions have deleted the object before responding.
+
+=back
+
+=method clear
+
+    $obj->reset;
+
+Reset this object
+
+=method has_siblings
+
+    if ($obj->has_siblings) { ... }
+
+Return true if this object has siblings
+
+=method populate
+
+Given the output of RiakUtils.http_request and a list of statuses, populate the object. Only for use by the Riak client library.
+
+=method add_link
+
+    $obj->add_link($obj2, "tag");
+
+Add a link to a L<Net::Riak::Object>
+
+=method remove_link
+
+    $obj->remove_link($obj2, "tag");
+
+Remove a link to a L<Net::Riak::Object>
+
+=method add
+
+Start assembling a Map/Reduce operation
+
+=method link
+
+Start assembling a Map/Reduce operation
+
+=method map
+
+Start assembling a Map/Reduce operation
+
+=method reduce
+
+Start assembling a Map/Reduce operation
diff --git a/t/01_basic.t b/t/01_basic.t
index f55a263..f3f3dda 100644
--- a/t/01_basic.t
+++ b/t/01_basic.t
@@ -4,9 +4,11 @@ use Test::More;
 use Net::Riak;
 use YAML::Syck;
 
+
+
 my $host = 'http://localhost:8098';
 my $bucket_name = 'test4';
-my $bucket_multi = 'multiBucket1';
+my $bucket_multi = 'multiBucket2';
 
 # is alive
 {
@@ -46,7 +48,7 @@ my $bucket_multi = 'multiBucket1';
     ok $obj->exists, 'object exists';
     $obj->delete;
     $obj->load;
-    ok !$obj->exists;
+    ok !$obj->exists, "object don't exists anymore";
 }
 
 # test set bucket properties
@@ -58,7 +60,7 @@ my $bucket_multi = 'multiBucket1';
     $bucket->n_val(3);
     is $bucket->n_val, 3, 'n_val is set to 3';
     $bucket->set_properties({allow_mult => "False", "n_val" => 2});
-    ok !$bucket->allow_multiples;
+    ok !$bucket->allow_multiples, "don't allow multiple anymore";
     is $bucket->n_val, 2, 'n_val is set to 2';
 }
 
@@ -73,61 +75,57 @@ my $bucket_multi = 'multiBucket1';
     for(1..5) {
         my $client = Net::Riak->new();
         my $bucket = $client->bucket($bucket_multi);
-        my $rand = int(rand(100));
-        $obj = $bucket->new_object('foo', [$rand]);
+        $obj = $bucket->new_object('foo', [int(rand(100))]);
         $obj->store;
     }
-    # my $siblings_count = $obj->get_siblings;
-    # is $siblings_count, 5, 'got 5 siblings';
-    # my $obj3 = $obj->sibling(3);
-    # XXX FIXME
-    # $obj3 = $obj3->sibling(3);
-    # $obj3->store;
-    # $obj->reload;
-    # is_deeply $obj3->data, $obj->data;
-    # $obj->delete;
+    # 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();
     my $bucket = $client->bucket($bucket_name);
-    my $obj = $bucket->new_object('foo', [2]);
-    $obj->store;
-    my $map_reduce = $client->add($bucket_name, 'foo');
-    $map_reduce->map("function (v) {return [JSON.parse(v.values[0].data)];}");
-    my $result = $map_reduce->run();
+    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';
 }
 
-# javascript named map
-{
-    my $client     = Net::Riak->new();
-    my $bucket     = $client->bucket($bucket_name);
-    my $obj        = $bucket->new_object('foo', [2]);
-    my $map_reduce = $client->add("bucket", "foo");
-    $map_reduce->map("Riak.mapValuesJson");
-    my $result = $map_reduce->run;
-    use YAML::Syck;
-    warn Dump $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();
     my $bucket = $client->bucket($bucket_name);
-    my $obj = $bucket->new_object('foo', [2]);
-    $obj->store;
-    $obj = $bucket->new_object('bar', [3]);
-    $obj->store;
-    $bucket->new_object('baz', [4]);
-    $obj->store;
-    my $map_reduce = $client->add($bucket_name, "foo");
-    $map_reduce->add($bucket_name, "bar");
-    $map_reduce->add($bucket_name, "baz");
-    $map_reduce->map("function (v) { return [1]; }");
-    $map_reduce->reduce("function (v) { return [v.length]; }");
-    my $result = $map_reduce->run;
+    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";
 }
 
@@ -135,49 +133,37 @@ my $bucket_multi = 'multiBucket1';
 {
     my $client = Net::Riak->new();
     my $bucket = $client->bucket($bucket_name);
-    my $obj = $bucket->new_object("foo", [2]);
-    $obj->store;
-    $obj = $bucket->new_object("bar", [3]);
-    $obj->store;
-    $obj = $bucket->new_object("baz", [4]);
-    $obj->store;
-    my $map_reduce = $client->add($bucket_name, "foo");
-    $map_reduce->add($bucket_name, "bar");
-    $map_reduce->add($bucket_name, "baz");
-    $map_reduce->map("Riak.mapValuesJson");
-    $map_reduce->reduce("Riak.reduceSum");
-    my $result = $map_reduce->run();
-#    is $result->[0], 243; # ????
+    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();
-    my $bucket = $client->bucket($bucket_name);
-    my $obj = $bucket->new_object("foo", [2]);
-    $obj->store;
-    $obj = $bucket->new_object("bar", [3]);
-    $obj->store;
-    $obj = $bucket->new_object("baz", [4]);
-    $obj->store;
-    my $map_reduce = $client->add($bucket->name);
-    $map_reduce->map("Riak.mapValuesJson");
-    $map_reduce->reduce("Riak.reduceSum");
-    my $result = $map_reduce->run;
-    ok 1, "ici";
-#    is $result->[0], 243;
+    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();
     my $bucket = $client->bucket($bucket_name);
-    my $obj = $bucket->new_object("foo", [2]);
-    $obj->store;
-    $obj = $bucket->get("foo");
-    my $map_reduce = $obj->map("Riak.mapValuesJson");
-    my $result = $map_reduce->run();
-    is_deeply $result->[0], [2];
+    $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
@@ -185,42 +171,33 @@ my $bucket_multi = 'multiBucket1';
     my $client = Net::Riak->new();
     my $bucket = $client->bucket($bucket_name);
     my $obj = $bucket->new_object("foo", [2]);
-    my $obj1 = $bucket->new_object("foo1", {test => 1});
-    $obj1->store;
-    my $obj2 = $bucket->new_object("foo2", {test => 2});
-    $obj2->store;
-    my $obj3 = $bucket->new_object("foo3", {test => 3});
-    $obj3->store;
+    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 $mr = $obj->link("bucket");
-    my $results = $mr->run();
-    # XXX fixme !!
-    use YAML::Syck; warn Dump $results;
+    my $count = $obj->count_links;
+    is $count, 3, 'got 3 links';
 }
 
 # link walking
 {
     my $client = Net::Riak->new();
     my $bucket = $client->bucket($bucket_name);
-    my $obj = $bucket->new_object("foo", [2]);
-    my $obj1 = $bucket->new_object("foo1", {test => 1});
-    $obj1->store;
-    my $obj2 = $bucket->new_object("foo2", {test => 2});
-    $obj2->store;
-    my $obj3 = $bucket->new_object("foo3", {test => 3});
-    $obj3->store;
-    $obj->add_link($obj1);
-    $obj->add_link($obj2, "tag");
-    $obj->add_link($obj3, "tag2!@&");
+    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 $mr = $obj->link("bucket");
-    my $results = $mr->run();
-    use YAML::Syck; warn Dump $results;
+    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;