File Coverage

blib/lib/Paws/Net/RestJsonResponse.pm
Criterion Covered Total %
statement 70 105 66.6
branch 45 74 60.8
condition 2 3 66.6
subroutine 9 10 90.0
pod 0 6 0.0
total 126 198 63.6


line stmt bran cond sub pod time code
1             package Paws::Net::RestJsonResponse;
2 7     7   4302 use Moose::Role;
  7         32  
  7         55  
3 7     7   40803 use JSON::MaybeXS;
  7         21  
  7         540  
4 7     7   55 use Carp qw(croak);
  7         24  
  7         376  
5 7     7   56 use Paws::Exception;
  7         20  
  7         7787  
6              
7             sub handle_response {
8 34     34 0 55219 my ($self, $call_object, $http_status, $content, $headers) = @_;
9              
10 34 50       154 if (defined $headers->{ 'x-amz-crc32' }) {
11 0         0 require String::CRC32;
12 0         0 my $crc = String::CRC32::crc32($content);
13             return Paws::Exception->new(
14             code => 'Crc32Error',
15             message => 'Content CRC32 mismatch',
16             request_id => $headers->{ 'x-amzn-requestid' }
17 0 0       0 ) if ($crc != $headers->{ 'x-amz-crc32' });
18             }
19              
20 34 100       140 if ( $http_status >= 300 ) {
21 17         80 return $self->error_to_exception($call_object, $http_status, $content, $headers);
22             } else {
23 17         93 return $self->response_to_object($call_object, $http_status, $content, $headers);
24             }
25             }
26            
27             sub unserialize_response {
28 28     28 0 129 my ($self, $data) = @_;
29              
30 28         444 return decode_json( $data );
31             }
32              
33             sub error_to_exception {
34 17     17 0 49 my ($self, $call_object, $http_status, $content, $headers) = @_;
35            
36 17         40 my $struct = eval { $self->unserialize_response( $content ) };
  17         57  
37 17 100       86 if ($@) {
38 12         244 return Paws::Exception->new(
39             message => $@,
40             code => 'InvalidContent',
41             request_id => '', #$request_id,
42             http_status => $http_status,
43             );
44             }
45              
46 5         23 my ($message, $request_id, $code);
47              
48 5 50       24 if (exists $struct->{message}){
    0          
49 5         16 $message = $struct->{message};
50             } elsif (exists $struct->{Message}){
51 0         0 $message = $struct->{Message};
52             } else {
53             # Rationale for this condition is in Issue #82
54 0 0       0 if ($struct->{__type} eq 'InternalError'){
55 0         0 $message = '';
56             } else {
57 0         0 die "Unrecognized error message format";
58             }
59             }
60              
61 5 100       33 if (exists $headers->{'x-amzn-errortype'}){
    50          
    100          
62 2         15 $code = (split /:/, $headers->{'x-amzn-errortype'})[0];
63             } elsif (exists $struct->{Code}) {
64 0         0 $code = $struct->{Code};
65             } elsif (exists $struct->{ code }) {
66 2         5 $code = $struct->{ code };
67             } else {
68 1         2 $code = 'UnrecognizedError';
69             }
70 5         16 $request_id = $headers->{ 'x-amzn-requestid' };
71              
72 5         159 Paws::Exception->new(
73             message => $message,
74             code => $code,
75             request_id => $request_id,
76             http_status => $http_status,
77             );
78             }
79              
80             sub handle_response_strtonativemap {
81 5     5 0 17 my ($self, $att_class, $value) = @_;
82              
83 5 50       18 if (not defined $value){
84 0         0 return $att_class->new(Map => {});
85             } else {
86 5         27 return $att_class->new(Map => $value);
87             }
88             }
89              
90             sub handle_response_strtoobjmap {
91 0     0 0 0 my ($self, $att_class, $value) = @_;
92              
93 0         0 my $inner_class = $att_class->meta->get_attribute('Map')->type_constraint->name;
94 0         0 ($inner_class) = ($inner_class =~ m/\[(.*)\]$/);
95 0         0 Paws->load_class("$inner_class");
96              
97 0 0       0 if (not defined $value){
98 0         0 return $att_class->new(Map => {});
99             } else {
100             return $att_class->new(Map => {
101 0         0 map { ($_ => $self->new_from_result_struct($inner_class, $value->{ $_ }) ) } keys %$value
  0         0  
102             });
103             }
104             }
105              
106             sub new_from_result_struct {
107 29     29 0 110 my ($self, $class, $result) = @_;
108 29         56 my %args;
109            
110 29 50       134 if ($class->does('Paws::API::StrToObjMapParser')) {
    50          
111 0         0 return $self->handle_response_strtoobjmap($class, $result);
112             } elsif ($class->does('Paws::API::StrToNativeMapParser')) {
113 0         0 return $self->handle_response_strtonativemap($class, $result);
114             } else {
115 29         12388 foreach my $att ($class->meta->get_attribute_list) {
116 148 50       23937 next if (not my $meta = $class->meta->get_attribute($att));
117              
118 148 100       3805 my $key = $meta->does('NameInRequest') ? $meta->request_name :
    50          
119             $meta->does('ParamInHeader') ? lc($meta->header_name) : $att;
120              
121 148         35425 my $att_type = $meta->type_constraint;
122              
123             # use Data::Dumper;
124             # print STDERR "USING KEY: $key\n";
125             # print STDERR "$att IS A '$att_type' TYPE\n";
126             # print STDERR "VALUE: " . Dumper($result);
127             # my $extracted_val = $result->{ $key };
128             # print STDERR "RESULT >>> $extracted_val\n";
129              
130             # We'll consider that an attribute without brackets [] isn't an array type
131 148 100       1328 if ($att_type !~ m/\[.*\]$/) {
    100          
132 136         4395 my $value = $result->{ $key };
133 136         289 my $value_ref = ref($value);
134              
135 136 100       326 if ($att_type =~ m/\:\:/) {
136             # Make the att_type stringify for module loading
137 25         842 Paws->load_class("$att_type");
138 25 100       103 if (defined $value) {
139 19 50       67 if (not $value_ref) {
140 0         0 $args{ $att } = $value;
141             } else {
142 19         508 my $att_class = $att_type->class;
143              
144 19 50       273 if ($att_class->does('Paws::API::StrToObjMapParser')) {
    100          
    50          
145 0         0 $args{ $att } = $self->handle_response_strtoobjmap($att_class, $value);
146             } elsif ($att_class->does('Paws::API::StrToNativeMapParser')) {
147 5         2225 $args{ $att } = $self->handle_response_strtonativemap($att_class, $value);
148             } elsif ($att_class->does('Paws::API::MapParser')) {
149 0         0 my $xml_keys = $att_class->xml_keys;
150 0         0 my $xml_values = $att_class->xml_values;
151              
152 0         0 $args{ $att } = $att_class->new(map { ($_->{ $xml_keys } => $_->{ $xml_values }) } @$value);
  0         0  
153             } else {
154 14         9387 $args{ $att } = $self->new_from_result_struct($att_class, $value);
155             }
156             }
157             }
158             } else {
159 111 100       3493 if (defined $value) {
160 89 100       251 if ($att_type eq 'Bool') {
161 24 100       711 if ($value eq 'true') {
    50          
    0          
162 12         225 $args{ $att } = 1;
163             } elsif ($value eq 'false') {
164 12         332 $args{ $att } = 0;
165             } elsif ($value == 1) {
166 0         0 $args{ $att } = 1;
167             } else {
168 0         0 $args{ $att } = 0;
169             }
170             } else {
171 65         2095 $args{ $att } = $value;
172             }
173             }
174             }
175             } elsif (my ($type) = ($att_type =~ m/^ArrayRef\[(.*)\]$/)) {
176 8         510 my $value = $result->{ $att };
177 8 50 66     63 $value = $result->{ $key } if (not defined $value and $key ne $att);
178 8         21 my $value_ref = ref($value);
179              
180 8 100       31 if ($type =~ m/\:\:/) {
181 6         29 Paws->load_class($type);
182              
183 6 50       40 if ($type->does('Paws::API::StrToObjMapParser')) {
    50          
    50          
184 0         0 $args{ $att } = [ map { $self->handle_response_strtoobjmap($type, $_) } @$value ];
  0         0  
185             } elsif ($type->does('Paws::API::StrToNativeMapParser')) {
186 0         0 $args{ $att } = [ map { $self->handle_response_strtonativemap($type, $_) } @$value ];
  0         0  
187             } elsif ($type->does('Paws::API::MapParser')) {
188 0         0 die "MapParser Type in an Array. Please implement me";
189             } else {
190 6         3964 $args{ $att } = [ map { $self->new_from_result_struct($type, $_) } @$value ];
  4         18  
191             }
192             } else {
193 2 50       8 if (defined $value){
194 0 0       0 if ($value_ref eq 'ARRAY') {
195 0         0 $args{ $att } = $value;
196             } else {
197 0         0 $args{ $att } = [ $value ];
198             }
199             }
200             }
201             }
202             }
203 29         10172 $class->new(%args);
204             }
205             }
206             1;