diff options
-rw-r--r-- | Changes | 10 | ||||
-rw-r--r-- | lib/Net/Riak/Bucket.pm | 7 | ||||
-rw-r--r-- | lib/Net/Riak/Object.pm | 29 |
3 files changed, 35 insertions, 11 deletions
diff --git a/Changes b/Changes index 929c9ea..cbb632d 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,13 @@ +0.13 (UNRELEASED) + - Automatic key generation support (Simon Wistow) + +0.12 + - fix _build_link method (reported by gphat) + - added useragent timeout parameter (Robin Edwards) + - added expected status message (Robin Edwards) + - added delete_object method to Net::Riak::Bucket (Robin Edwards) + - support for adding bucket as objects in add method (Robin Edwards) + 0.11 Wed 03 Nov 2010 03:01:10 PM CET - update POD (franck cuny) - fix wrong clearer name (_clear_siblings instead of _clear_links) diff --git a/lib/Net/Riak/Bucket.pm b/lib/Net/Riak/Bucket.pm index 0e7aa63..2bc334e 100644 --- a/lib/Net/Riak/Bucket.pm +++ b/lib/Net/Riak/Bucket.pm @@ -144,13 +144,14 @@ sub set_properties { sub new_object { my ($self, $key, $data, @args) = @_; - my $object = Net::Riak::Object->new( - key => $key, + my %opts = ( data => $data, bucket => $self, client => $self->client, @args, ); + $opts{key} = $key if defined $key; + my $object = Net::Riak::Object->new(%opts); $object; } @@ -214,6 +215,8 @@ DW value setting for this client (default 2) Create a new L<Net::Riak::Object> object. Additional Object constructor arguments can be passed after $data. If $data is a reference and no explicit Object content_type is given in @args, the data will be serialised and stored as JSON. +If $key is passed as C<undef> then an autogenerated key will be provided by Riak. + =item get my $obj = $bucket->get($key, [$r]); diff --git a/lib/Net/Riak/Object.pm b/lib/Net/Riak/Object.pm index 0d2aef7..5efe5f9 100644 --- a/lib/Net/Riak/Object.pm +++ b/lib/Net/Riak/Object.pm @@ -12,7 +12,7 @@ with 'Net::Riak::Role::Replica' => {keys => [qw/r w dw/]}; with 'Net::Riak::Role::Base' => {classes => [{name => 'bucket', required => 1}, {name => 'client', required => 1}]}; -has key => (is => 'rw', isa => 'Str', 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'); @@ -59,10 +59,14 @@ sub store { $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('PUT', - [$self->client->prefix, $self->bucket->name, $self->key], $params); + 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); @@ -83,7 +87,7 @@ sub store { } my $response = $self->client->send_request($request); - $self->populate($response, [200, 204, 300]); + $self->populate($response, [200, 201, 204, 300]); $self; } @@ -164,8 +168,15 @@ sub populate { shift @siblings; $self->siblings(\@siblings); } - - if ($status == 200) { + + 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)) @@ -225,8 +236,8 @@ sub _build_link { blessed $obj && $obj->isa('Net::Riak::Link') ? $obj : Net::Riak::Link->new( - bucket => $self->bucket, - key => $self->key, + bucket => $obj->bucket, + key => $obj->key, tag => $tag || $self->bucket->name, ); } |