1 files changed, 131 insertions, 0 deletions
diff --git a/lib/Net/Riak/Role/PBC/Object.pm b/lib/Net/Riak/Role/PBC/Object.pm
new file mode 100644
index 0000000..847cac2
--- /dev/null
+++ b/lib/Net/Riak/Role/PBC/Object.pm
@@ -0,0 +1,131 @@
+package Net::Riak::Role::PBC::Object;
+
+use JSON;
+use Moose::Role;
+use Data::Dumper;
+use List::Util 'first';
+
+sub store_object {
+    my ($self, $w, $dw, $object) = @_;
+
+    my $value = (ref $object->data && $object->content_type eq 'application/json') 
+            ? JSON::encode_json($object->data) : $object->data;
+
+    my $content = {
+        content_type => $object->content_type,
+        value => $value,
+        usermeta => undef
+    };
+
+    if ($object->has_links) {
+        $content->{links} = $self->_links_for_message($object);
+    }
+
+    $self->send_message(
+        PutReq => {
+            bucket  => $object->bucket->name,
+            key     => $object->key,
+            content => $content,
+        }
+    );
+    return $object;
+}
+
+sub load_object {
+    my ( $self, $params, $object ) = @_;
+
+    my $resp = $self->send_message(
+        GetReq => {
+            bucket => $object->bucket->name,
+            key    => $object->key,
+            r      => $params->{r},
+        }
+    );
+
+    $self->populate_object($object, $resp);
+
+    return $object;
+}
+
+sub delete_object {
+    my ( $self, $params, $object ) = @_;
+
+    my $resp = $self->send_message(
+        DelReq => {
+            bucket => $object->bucket->name,
+            key    => $object->key,
+            rw     => $params->{dw},
+        }
+    );
+
+    $object;
+}
+
+sub populate_object {
+    my ( $self, $object, $resp) = @_;
+
+    $object->_clear_links;
+    $object->exists(0);
+
+    if ( $resp->content && scalar (@{$resp->content}) > 1) {
+        my %seen;
+        my @vtags = grep { !$seen{$_}++ } map { $_->vtag } @{$resp->content};
+        $object->siblings(\@vtags);
+    }
+
+    my $content = $resp->content ? $resp->content->[0] : undef;
+
+    return unless $content and $resp->vclock;
+
+    $object->vclock($resp->vclock);
+    $object->vtag($content->vtag);
+    $object->content_type($content->content_type);
+
+    if($content->links) {
+        $self->_populate_links($object, $content->links);
+    }
+
+    my $data = ($object->content_type eq 'application/json') 
+        ? JSON::decode_json($content->value) : $content->value;
+
+    $object->exists(1);
+
+    $object->data($data);
+}
+
+
+# This emulates the behavior of the existing REST client.
+sub retrieve_sibling {
+    my ($self, $object, $params) = @_;
+
+    my $resp = $self->send_message(
+        GetReq => {
+            bucket => $object->bucket->name,
+            key    => $object->key,
+            r      => $params->{r},
+        }
+    );
+
+    # hack for loading 1 sibling
+    if ($params->{vtag}) {
+        $resp->{content} = [ 
+            first {
+                $_->vtag eq $params->{vtag}
+            } @{$resp->content}
+        ];
+    }
+
+    my $sibling = Net::Riak::Object->new(
+        client => $self,
+        bucket => $object->bucket,
+        key    => $object->key
+    );
+
+    $sibling->_jsonize($object->_jsonize);
+
+    $self->populate_object($sibling, $resp);
+    
+    $sibling;
+}
+
+1;