package Net::Riak::Role::PBC::Object; use JSON; use Moose::Role; use List::Util 'first'; sub store_object { my ($self, $w, $dw, $object) = @_; die "Storing object without a key is not supported in the PBC interface" unless $object->key; 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, }; if ($object->has_links) { $content->{links} = $self->_links_for_message($object); } if ($object->has_meta) { $content->{usermeta} = $self->_metas_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); } if($content->usermeta) { $self->_populate_metas($object, $content->usermeta); } 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;