File Coverage

blib/lib/Net/Amazon/DynamoDB/Lite.pm
Criterion Covered Total %
statement 67 202 33.1
branch 1 72 1.3
condition n/a
subroutine 17 31 54.8
pod 13 14 92.8
total 98 319 30.7


line stmt bran cond sub pod time code
1             package Net::Amazon::DynamoDB::Lite;
2 16     16   3668961 use 5.008001;
  16         68  
3 16     16   94 use strict;
  16         33  
  16         390  
4 16     16   109 use warnings;
  16         43  
  16         897  
5              
6             our $VERSION = "0.03";
7              
8 16     16   89 use Carp;
  16         34  
  16         1276  
9 16     16   12813 use Furl;
  16         530591  
  16         494  
10 16     16   11273 use HTTP::Request;
  16         393287  
  16         570  
11 16     16   15852 use JSON;
  16         194171  
  16         99  
12 16     16   22073 use Moo;
  16         258403  
  16         109  
13 16     16   46718 use POSIX qw(setlocale LC_TIME strftime);
  16         114447  
  16         141  
14 16     16   22760 use Scalar::Util qw(reftype);
  16         31  
  16         1356  
15 16     16   13003 use WebService::Amazon::Signature::v4;
  16         805965  
  16         39526  
16              
17             has signature => (
18             is => 'lazy',
19             );
20              
21             has scope => (
22             is => 'lazy',
23             );
24              
25             has ua => (
26             is => 'lazy',
27             );
28              
29             has uri => (
30             is => 'lazy',
31             );
32              
33             has access_key => (
34             is => 'ro',
35             );
36              
37             has secret_key => (
38             is => 'ro',
39             );
40              
41             has region => (
42             is => 'ro',
43             );
44              
45             has api_version => (
46             is => 'ro',
47             default => sub {
48             '20120810',
49             },
50             );
51              
52             has ca_path => (
53             is => 'rw',
54             default => sub {
55             '/etc/ssl/certs',
56             },
57             );
58              
59             has connection_timeout => (
60             is => 'rw',
61             default => sub {
62             1,
63             },
64             );
65              
66             has json => (
67             is => 'rw',
68             default => sub {
69             JSON->new,
70             },
71             );
72              
73             sub _build_signature {
74 15     15   6172 my ($self) = @_;
75 15         86 my $locale = setlocale(LC_TIME);
76 15         69 setlocale(LC_TIME, "C");
77 15         87 my $v4 = WebService::Amazon::Signature::v4->new(
78             scope => $self->scope,
79             access_key => $self->access_key,
80             secret_key => $self->secret_key,
81             );
82 15         209 setlocale(LC_TIME, $locale);
83 15         108 $v4;
84             }
85              
86             sub _build_scope {
87 15     15   6027 my ($self) = @_;
88 15         809 join '/', strftime('%Y%m%d', gmtime), $self->region, qw(dynamodb aws4_request);
89             }
90              
91             sub _build_ua {
92 13     13   5248 my ($self) = @_;
93              
94 13         226 my $ua = Furl->new(
95             agent => 'Net::Amazon::DynamoDB::Lite ' . $VERSION,
96             timeout => $self->connection_timeout,
97             ssl_opts => {
98             SSL_ca_path => $self->ca_path,
99             },
100             );
101             }
102              
103             sub _build_uri {
104 2     2   852 my ($self) = @_;
105 2         29 URI->new('https://dynamodb.' . $self->region . '.amazonaws.com/');
106             }
107              
108             sub make_request {
109 14     14 0 66 my ($self, $target, $content) = @_;
110              
111 14         78 my $req = HTTP::Request->new(
112             POST => $self->uri,
113             );
114 14         17101 my $locale = setlocale(LC_TIME);
115 14         128 setlocale(LC_TIME, "C");
116 14         318 $req->header(host => $self->uri->host);
117 14         3666 my $http_date = strftime('%a, %d %b %Y %H:%M:%S %Z', localtime);
118 14         739 my $amz_date = strftime('%Y%m%dT%H%M%SZ', gmtime);
119 14         106 $req->header(Date => $http_date);
120 14         590 $req->header('x-amz-date' => $amz_date);
121 14         889 $req->header('x-amz-target' => 'DynamoDB_' . $self->api_version . ".$target" );
122 14         711 $req->header('content-type' => 'application/x-amz-json-1.0');
123 14         970 $content = $self->json->encode($content);
124 14         116 $req->content($content);
125 14         411 $req->header('Content-Length' => length($content));
126 14         571 $self->signature->from_http_request($req);
127 14         2906 $req->header(Authorization => $self->signature->calculate_signature);
128 14         10572 setlocale(LC_TIME, $locale);
129 14         40 return $req;
130             }
131              
132             sub list_tables {
133 13     13 1 2841 my ($self, $content) = @_;
134              
135 13 50       71 $content = {} unless $content;
136 13         73 my $req = $self->make_request('ListTables', $content);
137 13         64 my $res = $self->ua->request($req);
138 13         31086 my $decoded = $self->json->decode($res->content);
139 0 0         if ($res->is_success) {
140 0           return $decoded->{TableNames};
141             }
142             else {
143 0           Carp::croak $self->_error_content($res, $decoded);
144             }
145             }
146              
147             sub put_item {
148 0     0 1   my ($self, $content) = @_;
149              
150 0 0         Carp::croak "Item required." unless $content->{Item};
151 0 0         Carp::croak "TableName required." unless $content->{TableName};
152 0           my $req = $self->make_request('PutItem', $content);
153 0           my $res = $self->ua->request($req);
154 0 0         if ($res->is_success) {
155 0           return 1;
156             } else {
157 0           my $decoded = $self->json->decode($res->content);
158 0           Carp::croak $self->_error_content($res, $decoded);
159             }
160             }
161              
162             sub get_item {
163 0     0 1   my ($self, $content) = @_;
164              
165 0 0         Carp::croak "Key required." unless $content->{Key};
166 0 0         Carp::croak "TableName required." unless $content->{TableName};
167 0           my $req = $self->make_request('GetItem', $content);
168 0           my $res = $self->ua->request($req);
169 0           my $decoded = $self->json->decode($res->content);
170 0 0         if ($res->is_success) {
171 0           return _except_type($decoded->{Item});
172             }
173             else {
174 0           Carp::croak $self->_error_content($res, $decoded);
175             }
176              
177             }
178              
179             sub update_item {
180 0     0 1   my ($self, $content) = @_;
181              
182 0 0         Carp::croak "Key required." unless $content->{Key};
183 0 0         Carp::croak "TableName required." unless $content->{TableName};
184 0           my $req = $self->make_request('UpdateItem', $content);
185 0           my $res = $self->ua->request($req);
186 0 0         if ($res->is_success) {
187 0           return 1;
188             } else {
189 0           my $decoded = $self->json->decode($res->content);
190 0           Carp::croak $self->_error_content($res, $decoded);
191             }
192             }
193              
194             sub delete_item {
195 0     0 1   my ($self, $content) = @_;
196              
197 0 0         Carp::croak "Key required." unless $content->{Key};
198 0 0         Carp::croak "TableName required." unless $content->{TableName};
199 0           my $req = $self->make_request('DeleteItem', $content);
200 0           my $res = $self->ua->request($req);
201 0 0         if ($res->is_success) {
202 0           return 1;
203             } else {
204 0           my $decoded = $self->json->decode($res->content);
205 0           Carp::croak $self->_error_content($res, $decoded);
206             }
207             }
208              
209             sub create_table {
210 0     0 1   my ($self, $content) = @_;
211              
212 0 0         Carp::croak "AttributeDefinitions required." unless $content->{AttributeDefinitions};
213 0 0         Carp::croak "KeySchema required." unless $content->{KeySchema};
214 0 0         Carp::croak "ProvisionedThroughput required." unless $content->{ProvisionedThroughput};
215 0 0         Carp::croak "TableName required." unless $content->{TableName};
216              
217 0           my $req = $self->make_request('CreateTable', $content);
218 0           my $res = $self->ua->request($req);
219 0 0         if ($res->is_success) {
220 0           return 1;
221             } else {
222 0           my $decoded = $self->json->decode($res->content);
223 0           Carp::croak $self->_error_content($res, $decoded);
224             }
225             }
226              
227             sub delete_table {
228 0     0 1   my ($self, $content) = @_;
229              
230 0 0         Carp::croak "TableName required." unless $content->{TableName};
231 0           my $req = $self->make_request('DeleteTable', $content);
232 0           my $res = $self->ua->request($req);
233 0 0         if ($res->is_success) {
234 0           return 1;
235             } else {
236 0           my $decoded = $self->json->decode($res->content);
237 0           Carp::croak $self->_error_content($res, $decoded);
238             }
239             }
240              
241             sub describe_table {
242 0     0 1   my ($self, $content) = @_;
243              
244 0 0         Carp::croak "TableName required." unless $content->{TableName};
245 0           my $req = $self->make_request('DescribeTable', $content);
246 0           my $res = $self->ua->request($req);
247 0           my $decoded = $self->json->decode($res->content);
248 0 0         if ($res->is_success) {
249 0           return $decoded->{Table};
250             }
251             else {
252 0           Carp::croak $self->_error_content($res, $decoded);
253             }
254              
255             }
256              
257             sub update_table {
258 0     0 1   my ($self, $content) = @_;
259              
260 0 0         Carp::croak "TableName required." unless $content->{TableName};
261 0           my $req = $self->make_request('UpdateTable', $content);
262 0           my $res = $self->ua->request($req);
263 0 0         if ($res->is_success) {
264 0           return 1;
265             } else {
266 0           my $decoded = $self->json->decode($res->content);
267 0           Carp::croak $self->_error_content($res, $decoded);
268             }
269             }
270              
271             sub query {
272 0     0 1   my ($self, $content) = @_;
273              
274 0 0         Carp::croak "TableName required." unless $content->{TableName};
275 0           my $req = $self->make_request('Query', $content);
276 0           my $res = $self->ua->request($req);
277              
278 0           my $decoded = $self->json->decode($res->content);
279 0 0         if ($res->is_success) {
280 0           return _except_type($decoded->{Items});
281             } else {
282 0           Carp::croak $self->_error_content($res, $decoded);
283             }
284             }
285              
286             sub scan {
287 0     0 1   my ($self, $content) = @_;
288              
289 0 0         Carp::croak "TableName required." unless $content->{TableName};
290 0           my $req = $self->make_request('Scan', $content);
291 0           my $res = $self->ua->request($req);
292 0           my $decoded = $self->json->decode($res->content);
293 0 0         if ($res->is_success) {
294 0           return _except_type($decoded->{Items});
295             } else {
296 0           Carp::croak $self->_error_content($res, $decoded);
297             }
298             }
299              
300             sub batch_get_item {
301 0     0 1   my ($self, $content) = @_;
302              
303 0 0         Carp::croak "RequestItems required." unless $content->{RequestItems};
304 0           my $req = $self->make_request('BatchGetItem', $content);
305 0           my $res = $self->ua->request($req);
306 0           my $decoded = $self->json->decode($res->content);
307 0 0         if ($res->is_success) {
308 0           my $res;
309 0           for my $k (keys %{$decoded->{Responses}}) {
  0            
310 0           push @{$res}, {$k => _except_type($decoded->{Responses}->{$k})};
  0            
311             }
312 0           return $res;
313             } else {
314 0           Carp::croak $self->_error_content($res, $decoded);
315             }
316             }
317              
318             sub batch_write_item {
319 0     0 1   my ($self, $content) = @_;
320              
321 0 0         Carp::croak "RequestItems required." unless $content->{RequestItems};
322 0           my $req = $self->make_request('BatchWriteItem', $content);
323 0           my $res = $self->ua->request($req);
324 0 0         if ($res->is_success) {
325 0           return 1;
326             }
327             else {
328 0           my $decoded = $self->json->decode($res->content);
329 0           Carp::croak $self->_error_content($res, $decoded);
330             }
331             }
332              
333             sub _except_type {
334 0     0     my $v = shift;
335 0           my $res;
336 0 0         if (ref $v eq 'HASH') {
    0          
337 0           for my $k (keys %{$v}) {
  0            
338 0           my $with_type = $v->{$k};
339 0           my ($k2) = keys %{$with_type};
  0            
340 0           $res->{$k} = $with_type->{$k2};
341             }
342             } elsif (ref $v eq 'ARRAY') {
343 0           for my $w (@{$v}) {
  0            
344 0           my $with_out_type;
345 0           for my $k (keys %{$w}) {
  0            
346 0           my $with_type = $w->{$k};
347 0           my ($k2) = keys %{$with_type};
  0            
348 0           $with_out_type->{$k} = $with_type->{$k2};
349             }
350 0           push @{$res}, $with_out_type;
  0            
351             }
352             }
353 0           return $res;
354             }
355              
356             sub _error_content {
357 0     0     my ($self, $res, $decoded) = @_;
358              
359 0 0         my $message = $decoded->{Message} ? $decoded->{Message} : $decoded->{message};
360             return "status_code : " . $res->status_line
361             . " __type : " . $decoded->{__type}
362 0           . " message : " . $message;
363             }
364              
365              
366             1;
367             __END__