merged pbc branch to master

1 files changed, 32 insertions, 157 deletions

diff --git a/lib/Net/Riak/Object.pm b/lib/Net/Riak/Object.pm
index f40031b..7148d4f 100644
--- a/lib/Net/Riak/Object.pm
+++ b/lib/Net/Riak/Object.pm
@@ -2,24 +2,27 @@ package Net::Riak::Object;
 
 # ABSTRACT: holds meta information about a Riak object
 
-use Carp;
-use JSON;
 use Moose;
 use Scalar::Util;
 use Net::Riak::Link;
 
 with 'Net::Riak::Role::Replica' => {keys => [qw/r w dw/]};
 with 'Net::Riak::Role::Base' => {classes =>
-      [{name => 'bucket', required => 1}, {name => 'client', required => 1}]};
-
+      [{name => 'bucket', required => 1}]};
+use Net::Riak::Types Client => {-as => 'Client_T'};
+has client => (
+    is       => 'rw',
+    isa      => Client_T,
+    required => 1,
+);
 has key => (is => 'rw', isa => 'Str', required => 0);
-has status       => (is => 'rw', isa => 'Int');
 has exists       => (is => 'rw', isa => 'Bool', default => 0,);
 has data         => (is => 'rw', isa => 'Any', clearer => '_clear_data');
-has vclock       => (is => 'rw', isa => 'Str', predicate => 'has_vclock',);
+has vclock       => (is => 'rw', isa => 'Str', predicate => 'has_vclock');
+has vtag          => (is => 'rw', isa => 'Str');
 has content_type => (is => 'rw', isa => 'Str', default => 'application/json');
-has _headers     => (is => 'rw', isa => 'HTTP::Response',);
-has _jsonize     => (is => 'rw', isa => 'Bool', lazy => 1, default => 1,);
+has location     => ( is => 'rw', isa => 'Str' );
+has _jsonize     => (is => 'rw', isa => 'Bool', lazy => 1, default => 1);
 has links => (
     traits     => ['Array'],
     is         => 'rw',
@@ -31,6 +34,7 @@ has links => (
         count_links => 'elements',
         append_link => 'push',
         has_links   => 'count',
+        all_links   => 'elements',
     },
     clearer => '_clear_links',
 );
@@ -52,62 +56,31 @@ has siblings => (
     clearer => '_clear_siblings',
 );
 
+after count_links => sub {
+    warn "DEPRECATED: count_links method will be removed in the 0.17 release, please use has_links.";
+};
+
 sub store {
     my ($self, $w, $dw) = @_;
 
     $w  ||= $self->w;
     $dw ||= $self->dw;
 
-    my $params = {returnbody => 'true', w => $w, dw => $dw};
-    my $path   = [$self->client->prefix, $self->bucket->name];
-    my $method = 'POST';
-    if (defined $self->key) {
-      push @$path, $self->key;
-      $method = 'PUT';
-    }
-
-    my $request = $self->client->new_request($method, $path, $params);
-
-    $request->header('X-Riak-ClientID' => $self->client->client_id);
-    $request->header('Content-Type'    => $self->content_type);
-
-    if ($self->has_vclock) {
-        $request->header('X-Riak-Vclock' => $self->vclock);
-    }
-
-    if ($self->has_links) {
-        $request->header('link' => $self->_links_to_header);
-    }
-
-    if (ref $self->data && $self->content_type eq 'application/json') {
-        $request->content(JSON::encode_json($self->data));
-    }
-    else {
-        $request->content($self->data);
-    }
-
-    my $response = $self->client->send_request($request);
-    $self->populate($response, [200, 201, 204, 300]);
-    $self;
+    $self->client->store_object($w, $dw, $self);
 }
 
-sub _links_to_header {
-    my $self = shift;
-    join(', ', map { $_->to_link_header($self->client) } $self->links);
-}
+sub status {
+    my ($self) = @_;
+    warn "DEPRECATED: status method will be removed in the 0.17 release, please use ->client->status.";
+    $self->client->status;
+}   
 
 sub load {
     my $self = shift;
 
     my $params = {r => $self->r};
 
-    my $request =
-      $self->client->new_request('GET',
-        [$self->client->prefix, $self->bucket->name, $self->key], $params);
-
-    my $response = $self->client->send_request($request);
-    $self->populate($response, [200, 300, 404]);
-    $self;
+    $self->client->load_object($params, $self);
 }
 
 sub delete {
@@ -116,13 +89,7 @@ sub delete {
     $dw ||= $self->bucket->dw;
     my $params = {dw => $dw};
 
-    my $request =
-      $self->client->new_request('DELETE',
-        [$self->client->prefix, $self->bucket->name, $self->key], $params);
-
-    my $response = $self->client->send_request($request);
-    $self->populate($response, [204, 404]);
-    $self;
+    $self->client->delete_object($params, $self);
 }
 
 sub clear {
@@ -133,109 +100,17 @@ sub clear {
     $self;
 }
 
-sub populate {
-    my ($self, $http_response, $expected) = @_;
-
-    $self->clear;
-
-    return if (!$http_response);
-
-    my $status = $http_response->code;
-    $self->_headers($http_response);
-    $self->status($status);
-
-    $self->data($http_response->content);
-
-    if (!grep { $status == $_ } @$expected) {
-        confess "Expected status "
-          . (join(', ', @$expected))
-          . ", received $status"
-    }
-
-    if ($status == 404) {
-        $self->clear;
-        return;
-    }
-
-    $self->exists(1);
-
-    if ($http_response->header('link')) {
-        $self->_populate_links($http_response->header('link'));
-    }
-
-    if ($status == 300) {
-        my @siblings = split("\n", $self->data);
-        shift @siblings;
-        $self->siblings(\@siblings);
-    }
-
-    if ($status == 201) {
-        my $location = $http_response->header('location');
-        my ($key)    = ($location =~ m!/([^/]+)$!);
-        $self->key($key);
-    }
-
-
-    if ($status == 200 || $status == 201) {
-        $self->content_type($http_response->content_type)
-            if $http_response->content_type;
-        $self->data(JSON::decode_json($self->data))
-            if $self->content_type eq 'application/json';
-        $self->vclock($http_response->header('X-Riak-Vclock'));
-    }
-}
-
-sub _uri_decode {
-  my $str = shift;
-  $str =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
-  return $str;
-}
-
-sub _populate_links {
-    my ($self, $links) = @_;
-    for my $link (split(',', $links)) {
-        if ($link
-            =~ /\<\/([^\/]+)\/([^\/]+)\/([^\/]+)\>; ?riaktag=\"([^\']+)\"/)
-        {
-            my $bucket = _uri_decode($2);
-            my $key    = _uri_decode($3);
-            my $tag    = _uri_decode($4);
-            my $l      = Net::Riak::Link->new(
-                bucket => Net::Riak::Bucket->new(
-                    name   => $bucket,
-                    client => $self->client
-                ),
-                key => $key,
-                tag => $tag
-            );
-            $self->add_link($l);
-        }
-    }
-}
-
 sub sibling {
     my ($self, $id, $r) = @_;
     $r ||= $self->bucket->r;
 
     my $vtag = $self->get_sibling($id);
-    my $params = {r => $r, vtag => $vtag};
 
-    my $request =
-      $self->client->new_request('GET',
-        [$self->client->prefix, $self->bucket->name, $self->key], $params);
-    my $response = $self->client->send_request($request);
-
-    my $obj = Net::Riak::Object->new(
-        client => $self->client,
-        bucket => $self->bucket,
-        key    => $self->key
+    return $self->client->retrieve_sibling(
+        $self, {r => $r, vtag => $vtag}
     );
-    $obj->_jsonize($self->_jsonize);
-    $obj->populate($response, [200]);
-    $obj;
 }
 
-
 sub _build_link {
     my ($self,$obj,$tag) = @_;
     blessed $obj && $obj->isa('Net::Riak::Link')
@@ -337,10 +212,6 @@ Get or set the data stored in this object.
 
 =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
@@ -359,7 +230,11 @@ Return an array of Siblings
 
 =over 4
 
-=item count_links
+=item all_links
+
+Return the number of links
+
+=item has_links
 
 Return the number of links
 
@@ -445,7 +320,7 @@ Return true if this object has siblings
 
 Return true if this object has no siblings
 
-=item populate
+=item populate_object
 
 Given the output of RiakUtils.http_request and a list of statuses, populate the object. Only for use by the Riak client library.