1package Net::Riak::Role::REST::Object; 2{ 3 $Net::Riak::Role::REST::Object::VERSION = '0.1702'; 4} 5 6use Moose::Role; 7use JSON; 8 9sub store_object { 10 my ($self, $w, $dw, $object) = @_; 11 12 my $params = {returnbody => 'true', w => $w, dw => $dw}; 13 14 $params->{returnbody} = 'false' 15 if $self->disable_return_body; 16 17 18 my $request; 19 if ( defined $object->key ) { 20 $request = $self->new_request('PUT', 21 [$self->prefix, $object->bucket->name, $object->key], $params); 22 } else { 23 $request = $self->new_request('POST', 24 [$self->prefix, $object->bucket->name ], $params); 25 } 26 27 $request->header('X-Riak-ClientID' => $self->client_id); 28 $request->header('Content-Type' => $object->content_type); 29 30 if ($object->has_vclock) { 31 $request->header('X-Riak-Vclock' => $object->vclock); 32 } 33 34 if ($object->has_links) { 35 $request->header('link' => $self->_links_to_header($object)); 36 } 37 38 if ($object->has_meta) { 39 while ( my ( $k, $v ) = each %{ $object->metadata } ) { 40 $request->header('x-riak-meta-' . lc($k) => $v ); 41 } 42 } 43 44 if ($object->i2indexes) { 45 foreach (keys %{$object->i2indexes}) { 46 $request->header(':x-riak-index-' . lc($_) => $object->i2indexes->{$_}); 47 } 48 } 49 50 if (ref $object->data && $object->content_type eq 'application/json') { 51 $request->content(JSON::encode_json($object->data)); 52 } 53 else { 54 $request->content($object->data); 55 } 56 57 my $response = $self->send_request($request); 58 $self->populate_object($object, $response, [200, 201, 204, 300]); 59 return $object; 60} 61 62sub load_object { 63 my ( $self, $params, $object ) = @_; 64 65 my $request = 66 $self->new_request( 'GET', 67 [ $self->prefix, $object->bucket->name, $object->key ], $params ); 68 69 my $response = $self->send_request($request); 70 $self->populate_object($object, $response, [ 200, 300, 404 ] ); 71 $object; 72} 73 74sub delete_object { 75 my ( $self, $params, $object ) = @_; 76 77 my $request = 78 $self->new_request( 'DELETE', 79 [ $self->prefix, $object->bucket->name, $object->key ], $params ); 80 81 my $response = $self->send_request($request); 82 $self->populate_object($object, $response, [ 204, 404 ] ); 83 $object; 84} 85 86sub populate_object { 87 my ($self, $obj, $http_response, $expected) = @_; 88 89 $obj->_clear_links; 90 $obj->exists(0); 91 92 return if (!$http_response); 93 94 95 my $status = $http_response->code; 96 97 $obj->data($http_response->content) 98 unless $self->disable_return_body; 99 100 if ( $http_response->header('location') ) { 101 $obj->key( $http_response->header('location') ); 102 $obj->location( $http_response->header('location') ); 103 } 104 105 if (!grep { $status == $_ } @$expected) { 106 confess "Expected status " 107 . (join(', ', @$expected)) 108 . ", received: ".$http_response->status_line 109 } 110 111 $HTTP::Headers::TRANSLATE_UNDERSCORE = 0; 112 foreach ($http_response->header_field_names) { 113 114 if ( /^X-Riak-Index-(.+_bin)$/ || /^X-Riak-Index-(.+_int)$/ ) { 115 $obj->add_index(lc($1), $http_response->header($_)) 116 } 117 elsif ( /^X-Riak-Meta-(.+)$/ ) { 118 $obj->set_meta(lc($1), $http_response->header($_)); 119 } 120 } 121 $HTTP::Headers::TRANSLATE_UNDERSCORE = 1; 122 123 if ($status == 404) { 124 $obj->clear; 125 return; 126 } 127 128 $obj->exists(1); 129 130 if ($http_response->header('link')) { 131 $self->_populate_links($obj, $http_response->header('link')); 132 } 133 134 if ($status == 300) { 135 my @siblings = split("\n", $obj->data); 136 shift @siblings; 137 my %seen; @siblings = grep { !$seen{$_}++ } @siblings; 138 $obj->siblings(\@siblings); 139 } 140 141 if ($status == 201) { 142 my $location = $http_response->header('location'); 143 my ($key) = ($location =~ m!/([^/]+)$!); 144 $obj->key($key); 145 } 146 147 148 if ($status == 200 || $status == 201) { 149 $obj->content_type($http_response->content_type) 150 if $http_response->content_type; 151 $obj->data(JSON::decode_json($obj->data)) 152 if $obj->content_type eq 'application/json'; 153 $obj->vclock($http_response->header('X-Riak-Vclock')); 154 } 155} 156 157sub retrieve_sibling { 158 my ($self, $object, $params) = @_; 159 160 my $request = $self->new_request( 161 'GET', 162 [$self->prefix, $object->bucket->name, $object->key], 163 $params 164 ); 165 166 my $response = $self->send_request($request); 167 168 my $sibling = Net::Riak::Object->new( 169 client => $self, 170 bucket => $object->bucket, 171 key => $object->key 172 ); 173 174 $sibling->_jsonize($object->_jsonize); 175 $self->populate_object($sibling, $response, [200]); 176 $sibling; 177} 178 179 180 181 1821; 183 184__END__ 185 186=pod 187 188=head1 NAME 189 190Net::Riak::Role::REST::Object 191 192=head1 VERSION 193 194version 0.1702 195 196=over 3 197 198=item populate_object 199 200Given the output of RiakUtils.http_request and a list of statuses, populate the object. Only for use by the Riak client library. 201 202=back 203 204=head1 AUTHOR 205 206franck cuny <franck@lumberjaph.net>, robin edwards <robin.ge@gmail.com> 207 208=head1 COPYRIGHT AND LICENSE 209 210This software is copyright (c) 2013 by linkfluence. 211 212This is free software; you can redistribute it and/or modify it under 213the same terms as the Perl 5 programming language system itself. 214 215=cut 216