Add support for usermeta nvps

6 files changed, 202 insertions, 3 deletions

diff --git a/lib/Net/Riak/Object.pm b/lib/Net/Riak/Object.pm
index 80997c1..1a533d5 100644
--- a/lib/Net/Riak/Object.pm
+++ b/lib/Net/Riak/Object.pm
@@ -40,6 +40,24 @@ has links => (
     },
     clearer => '_clear_links',
 );
+
+has metadata => (
+    traits     => ['Hash'],
+    is         => 'rw',
+    isa        => 'HashRef[Str]',
+    auto_deref => 1,
+    lazy       => 1,
+    default    => sub { {} },
+    handles    => {
+        set_meta    => 'set',
+        get_meta    => 'get',
+        remove_meta => 'delete',
+        has_meta    => 'count',
+        all_meta => 'elements',
+    },
+    clearer => '_clear_meta',
+);
+
 has siblings => (
     traits     => ['Array'],
     is         => 'rw',
@@ -126,6 +144,7 @@ sub clear {
     my $self = shift;
     $self->_clear_data;
     $self->_clear_links;
+    $self->_clear_meta;
     $self->exists(0);
     $self;
 }
@@ -286,6 +305,38 @@ Add a new sibling
 
 Return a sibling
 
+=item all_meta
+
+Returns a hash containing all the meta name/value pairs
+
+    my %metadata = $obj->all_meta;
+
+=item has_meta
+
+Returns the number of usermetas associated with the object. Typical use is as a
+predicate method.
+
+    if ( $obj->has_meta ) { ... }
+
+=item set_meta
+
+Sets a usermeta on the object, overriding any existing value for that key
+
+    $obj->set_meta( key => $value );
+
+=item get_meta
+
+Reads a single usermeta from the object. If multiple usermeta headers have been
+set for a single key (eg via another client), the values will be separated with
+a comma; Riak will concatenate the input headers and only return a single one.
+
+=item remove_meta
+
+removes a single usermeta from the object. Returns false on failure, eg if the
+key did not exist on the object.
+
+ $obj->remove_meta( 'key' ) || die( "could not remove" );
+
 =item store
 
     $obj->store($w, $dw);
diff --git a/lib/Net/Riak/Role/PBC.pm b/lib/Net/Riak/Role/PBC.pm
index bc32e3b..775976e 100644
--- a/lib/Net/Riak/Role/PBC.pm
+++ b/lib/Net/Riak/Role/PBC.pm
@@ -8,6 +8,7 @@ with qw(
   Net::Riak::Role::PBC::Bucket
   Net::Riak::Role::PBC::MapReduce
   Net::Riak::Role::PBC::Link
+  Net::Riak::Role::PBC::Meta
   Net::Riak::Role::PBC::Object);
 
 use Net::Riak::Types 'Socket';
diff --git a/lib/Net/Riak/Role/PBC/Meta.pm b/lib/Net/Riak/Role/PBC/Meta.pm
new file mode 100644
index 0000000..b04ec81
--- /dev/null
+++ b/lib/Net/Riak/Role/PBC/Meta.pm
@@ -0,0 +1,24 @@
+package Net::Riak::Role::PBC::Meta;
+
+use Moose::Role;
+
+sub _populate_metas {
+    my ($self, $object, $metas) = @_;
+
+    for my $meta (@$metas) {
+        $object->set_meta( $meta->key, $meta->value );
+    }
+}
+
+sub _metas_for_message {
+    my ($self, $object) = @_;
+
+    my @out;
+    while ( my ( $k, $v ) = each %{ $object->metadata } ) {
+        push @out, { key => $k, value => $v };
+    }
+    return \@out;
+
+}
+
+1;
diff --git a/lib/Net/Riak/Role/PBC/Object.pm b/lib/Net/Riak/Role/PBC/Object.pm
index f1a82a5..280956c 100644
--- a/lib/Net/Riak/Role/PBC/Object.pm
+++ b/lib/Net/Riak/Role/PBC/Object.pm
@@ -16,13 +16,16 @@ sub store_object {
     my $content = {
         content_type => $object->content_type,
         value => $value,
-        usermeta => undef
     };
 
     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,
@@ -87,6 +90,10 @@ sub populate_object {
         $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;
 
diff --git a/lib/Net/Riak/Role/REST/Object.pm b/lib/Net/Riak/Role/REST/Object.pm
index e3341b3..6c0aa7e 100644
--- a/lib/Net/Riak/Role/REST/Object.pm
+++ b/lib/Net/Riak/Role/REST/Object.pm
@@ -32,6 +32,12 @@ sub store_object {
         $request->header('link' => $self->_links_to_header($object));
     }
 
+    if ($object->has_meta) {
+        while ( my ( $k, $v ) = each %{ $object->metadata } ) {
+            $request->header('x-riak-meta-' . lc($k) => $v );
+        }
+    }
+
     if ($object->i2indexes) {
         foreach (keys %{$object->i2indexes}) {
             $request->header(':x-riak-index-' . lc($_) => $object->i2indexes->{$_});
@@ -101,8 +107,13 @@ sub populate_object {
 
     $HTTP::Headers::TRANSLATE_UNDERSCORE = 0;
     foreach ($http_response->header_field_names) {
-        next unless /^X-Riak-Index-(.+_bin)$/ || /^X-Riak-Index-(.+_int)$/;
-        $obj->add_index(lc($1),  $http_response->header($_))
+
+        if ( /^X-Riak-Index-(.+_bin)$/ || /^X-Riak-Index-(.+_int)$/ ) {
+            $obj->add_index(lc($1),  $http_response->header($_))
+        }
+        elsif ( /^X-Riak-Meta-(.+)$/ ) {
+            $obj->set_meta(lc($1), $http_response->header($_));
+        }
     }
     $HTTP::Headers::TRANSLATE_UNDERSCORE = 1;
 
diff --git a/t/26-metadata.t b/t/26-metadata.t
new file mode 100644
index 0000000..bd063c8
--- /dev/null
+++ b/t/26-metadata.t
@@ -0,0 +1,105 @@
+use lib 't/lib';
+use Test::More;
+use Test::Riak;
+
+test_riak {
+    my ($client, $bucket_name) = @_;
+    my $content = '{ "dummy":"content"}';
+    ok my $bucket = $client->bucket($bucket_name),
+        'created bucket object ok';
+
+    {
+    ok my $obj = $bucket->new_object('metaobj', $content),
+        'created a new riak object to hold our metadata';
+    ok $obj->set_meta( mymeta => 'metavalue'),
+        '... and can add metadata to it';
+    ok my $meta_value = $obj->get_meta('mymeta'),
+        '... and can retrieve our metadata from the object';
+    is $meta_value, 'metavalue',
+        '... and metadata has correct value';
+
+    # setting meta overwrites the value; no support for multivalue headers
+    ok $obj->set_meta( mymeta => 'newvalue' ),
+        '... and can update the metadata';
+    ok $meta_value = $obj->get_meta('mymeta'),
+        '... and can retrieve new metadata from the object';
+    is $meta_value, 'newvalue',
+        '... and metadata has new value';
+    ok $obj->store,
+        '... and our object with metadata can be stored ok';
+
+    }
+
+    {
+    ok my $obj = $bucket->get('metaobj'),
+        'Can retrieve object';
+    is $obj->has_meta, 1,
+        '... and object says it has one piece of metadata';
+
+    ok my $meta_value = $obj->get_meta('mymeta'),
+        '... and can retrieve our metadata from the object';
+    is $meta_value, 'newvalue',
+        '... and metadata has expected value';
+
+    ok $obj->set_meta( meta2 => 'metavalue2' ),
+        'Can add a second meta';
+    is $obj->has_meta, 2,
+        '... and meta counter is incremented';
+
+    ok $obj->store,
+        "... and object can be stored again";
+    }
+
+    {
+    my $obj = $bucket->get('metaobj');
+    is $obj->has_meta, 2,
+        'Object says it now has two pieces of metadata';
+    ok $obj->get_meta('meta2'),
+        "... and second meta can be accessed";
+    is $obj->get_meta('meta2'), 'metavalue2',
+        '... and has expected value';
+
+    my $expected = {'meta2' => 'metavalue2', 'mymeta' => 'newvalue' };
+    is_deeply {$obj->all_meta}, $expected,
+        "... and all_meta gives us both metas in a hash";
+
+    ok $obj->remove_meta('meta2'),
+        'Can remove an individual meta';
+    is $obj->has_meta, 1,
+        '... and meta counter is decremented';
+
+    ok !$obj->remove_meta('meta2'),
+        'Double-removing the now-non-existant item returns false';
+    is $obj->has_meta, 1,
+        '... and meta counter is not decremented';
+    ok $obj->store,
+        "... and object can be stored again";
+
+    }
+
+    {
+    my $obj = $bucket->get('metaobj');
+    ok !$obj->get_meta('meta2'),
+        "Deleted meta is no longer available";
+    is $obj->get_meta('mymeta'), 'newvalue',
+        '... but non-deleted meta is still present';
+    }
+
+
+    # cannot add undef values via set_meta
+    {
+    my $obj = $bucket->get('metaobj');
+    eval {
+        $obj->set_meta( meta3 => undef )
+    };
+
+    like $@, qr/Validation failed for 'Str' with value undef/,
+        "Cannot add meta with undef value";
+    is $obj->has_meta, 1,
+        '... and meta counter is unchanged by trying to add invalid data';
+    }
+
+    my $obj = $bucket->get('metaobj');
+    $obj->delete; # teardown
+};
+