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