path: root/lib/Net/Riak/Role/PBC/Object.pm

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;