File Coverage

blib/lib/Paws/Net/XMLResponse.pm
Criterion Covered Total %
statement 124 146 84.9
branch 87 120 72.5
condition 5 6 83.3
subroutine 10 10 100.0
pod 0 6 0.0
total 226 288 78.4


line stmt bran cond sub pod time code
1             package Paws::Net::XMLResponse;
2 15     15   10492 use Moose::Role;
  15         32  
  15         108  
3 15     15   99306 use XML::Simple qw//;
  15         93856  
  15         386  
4 15     15   106 use Carp qw(croak);
  15         30  
  15         695  
5 15     15   178 use Paws::Exception;
  15         30  
  15         19111  
6              
7             sub handle_response {
8 270     270 0 2122537 my ($self, $call_object, $http_status, $content, $headers) = @_;
9              
10 270 50       1295 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 270 100       1338 if ( $http_status >= 300 ) {
21 24         74 return $self->error_to_exception($call_object, $http_status, $content, $headers);
22             } else {
23 246         1488 return $self->response_to_object($call_object, $http_status, $content, $headers);
24             }
25             }
26              
27             sub error_to_exception {
28 24     24 0 58 my ($self, $call_object, $http_status, $content, $headers) = @_;
29              
30 24         40 my $struct = eval { $self->unserialize_response( $content ) };
  24         62  
31 24 100       262843 if ($@){
32 12         278 return Paws::Exception->new(
33             message => $@,
34             code => 'InvalidContent',
35             request_id => '', #$request_id,
36             http_status => $http_status,
37             );
38             }
39            
40 12         28 my ($code, $error, $request_id);
41              
42 12 100       52 if (exists $struct->{Errors}){
    100          
43 4         11 $error = $struct->{Errors}->[0]->{Error};
44             } elsif (exists $struct->{Error}){
45 7         19 $error = $struct->{Error};
46             } else {
47 1         2 $error = $struct;
48             }
49              
50 12 100       34 if (exists $error->{Code}){
51 11         27 $code = $error->{Code};
52             } else {
53 1         3 $code = $http_status;
54             }
55              
56 12 100       36 if (exists $struct->{RequestId}) {
    100          
    50          
57 7         15 $request_id = $struct->{RequestId};
58             } elsif (exists $struct->{RequestID}){
59 4         11 $request_id = $struct->{RequestID};
60             } elsif (exists $headers->{ 'x-amzn-requestid' }) {
61 0         0 $request_id = $headers->{ 'x-amzn-requestid' };
62             } else {
63 1         2 $request_id = '';
64             }
65              
66             Paws::Exception->new(
67 12   66     349 message => $error->{Message} // $content,
68             code => $code,
69             request_id => $request_id,
70             http_status => $http_status,
71             );
72             }
73              
74             sub unserialize_response {
75 266     266 0 952 my ($self, $data) = @_;
76              
77 266         3340 my $xml = XML::Simple->new(
78             ForceArray => qr/(?:item|Errors)/i,
79             KeyAttr => '',
80             SuppressEmpty => undef,
81             );
82 266         32702 return $xml->parse_string($data);
83             }
84              
85             sub handle_response_strtonativemap {
86 3     3 0 9 my ($self, $att_class, $value) = @_;
87 3         71 my $xml_keys = $att_class->xml_keys;
88 3         70 my $xml_values = $att_class->xml_values;
89              
90 3         9 my $value_ref = ref($value);
91 3 50       8 if ($value_ref eq 'HASH') {
92 3 50       10 if (exists $value->{ member }) {
    50          
    0          
93 0         0 $value = $value->{ member };
94             } elsif (exists $value->{ entry }) {
95 3         7 $value = $value->{ entry };
96             } elsif (keys %$value == 1) {
97 0         0 $value = $value->{ (keys %$value)[0] };
98             } else {
99             #die "Can't detect the item that has the array in the response hash";
100             }
101 3         5 $value_ref = ref($value);
102             }
103            
104 3 50       7 if ($value_ref eq 'ARRAY') {
    0          
105 3         8 return $att_class->new(Map => { map { ( $_->{ $xml_keys } => $_->{ $xml_values } ) } @$value } );
  10         38  
106             } elsif ($value_ref eq 'HASH') {
107 0         0 return $att_class->new(Map => { $value->{ $xml_keys } => $value->{ $xml_values } } );
108             }
109             }
110              
111             sub handle_response_strtoobjmap {
112 6     6 0 19 my ($self, $att_class, $value) = @_;
113 6         153 my $xml_keys = $att_class->xml_keys;
114 6         147 my $xml_values = $att_class->xml_values;
115              
116 6         16 my $value_ref = ref($value);
117 6 50       19 if ($value_ref eq 'HASH') {
118 6 50       27 if (exists $value->{ member }) {
    50          
    0          
119 0         0 $value = $value->{ member };
120             } elsif (exists $value->{ entry }) {
121 6         15 $value = $value->{ entry };
122             } elsif (keys %$value == 1) {
123 0         0 $value = $value->{ (keys %$value)[0] };
124             } else {
125             #die "Can't detect the item that has the array in the response hash";
126             }
127 6         15 $value_ref = ref($value);
128             }
129            
130 6         24 my $inner_class = $att_class->meta->get_attribute('Map')->type_constraint->name;
131 6         486 ($inner_class) = ($inner_class =~ m/\[(.*)\]$/);
132 6         36 Paws->load_class("$inner_class");
133              
134 6 100       31 if ($value_ref eq 'ARRAY') {
    50          
    0          
135 3         13 return $att_class->new(Map => { map { ( $_->{ $xml_keys } => $self->new_from_result_struct($inner_class, $_->{ $xml_values }) ) } @$value } );
  6         3239  
136             } elsif ($value_ref eq 'HASH') {
137 3         15 return $att_class->new(Map => { $value->{ $xml_keys } => $self->new_from_result_struct($inner_class, $value->{ $xml_values }) });
138             } elsif (not defined $value){
139 0         0 return $att_class->new(Map => {});
140             }
141             }
142              
143             sub new_from_result_struct {
144 2219     2219 0 5557 my ($self, $class, $result) = @_;
145 2219         3529 my %args;
146            
147 2219 50       7128 if ($class->does('Paws::API::StrToObjMapParser')) {
    50          
148 0         0 return $self->handle_response_strtoobjmap($class, $result);
149             } elsif ($class->does('Paws::API::StrToNativeMapParser')) {
150 0         0 return $self->handle_response_strtonativemap($class, $result);
151             } else {
152 2219         854171 foreach my $att ($class->meta->get_attribute_list) {
153 10491 50       477670 next if (not my $meta = $class->meta->get_attribute($att));
154              
155 10491 50       217624 my $key = $meta->does('NameInRequest') ? $meta->request_name :
    100          
156             $meta->does('ParamInHeader') ? lc($meta->header_name) : $att;
157              
158 10491         957275 my $att_type = $meta->type_constraint;
159 10491         341049 my $att_is_required = $meta->is_required;
160              
161             # use Data::Dumper;
162             # print STDERR "USING KEY: $key\n";
163             # print STDERR "$att IS A '$att_type' TYPE\n";
164             # print STDERR "VALUE: " . Dumper($result);
165             # my $extracted_val = $result->{ $key };
166             # print STDERR "RESULT >>> $extracted_val\n";
167              
168             # We'll consider that an attribute without brackets [] isn't an array type
169 10491 100       72395 if ($att_type !~ m/\[.*\]$/) {
    100          
170 9753         293009 my $value = $result->{ $key };
171 9753         16102 my $value_ref = ref($value);
172              
173 9753 100       17358 if ($att_type =~ m/\:\:/) {
174             # Make the att_type stringify for module loading
175 325         9665 Paws->load_class("$att_type");
176 325 100       1409 if (defined $value) {
177 135 50       511 if (not $value_ref) {
178 0         0 $args{ $att } = $value;
179             } else {
180 135         3738 my $att_class = $att_type->class;
181              
182 135 100       1823 if ($att_class->does('Paws::API::StrToObjMapParser')) {
    100          
    100          
183 6         1125 $args{ $att } = $self->handle_response_strtoobjmap($att_class, $value);
184             } elsif ($att_class->does('Paws::API::StrToNativeMapParser')) {
185 3         1248 $args{ $att } = $self->handle_response_strtonativemap($att_class, $value);
186             } elsif ($att_class->does('Paws::API::MapParser')) {
187 5         3211 my $xml_keys = $att_class->xml_keys;
188 5         117 my $xml_values = $att_class->xml_values;
189              
190             #TODO: handle in one place
191 5 100       17 if ($value_ref eq 'HASH') {
192 3 50       16 if (exists $value->{ member }) {
    100          
    50          
193 0         0 $value = $value->{ member };
194             } elsif (exists $value->{ entry }) {
195 2         5 $value = $value->{ entry };
196             } elsif (keys %$value == 1) {
197 0         0 $value = $value->{ (keys %$value)[0] };
198             } else {
199             # Force it to be an arrayref and hope it is processed correctly
200 1         3 $value = [ $value ];
201             }
202 3         8 $value_ref = ref($value);
203             }
204              
205              
206 5         14 $args{ $att } = $att_class->new(map { ($_->{ $xml_keys } => $_->{ $xml_values }) } @$value);
  67         140  
207             } else {
208 121         71022 $args{ $att } = $self->new_from_result_struct($att_class, $value);
209             }
210             }
211             }
212             } else {
213 9428 100       273572 if (defined $value) {
214 8495 100       18112 if ($att_type eq 'Bool') {
215 173 100       5287 if ($value eq 'true') {
    100          
    50          
216 55         204 $args{ $att } = 1;
217             } elsif ($value eq 'false') {
218 116         490 $args{ $att } = 0;
219             } elsif ($value == 1) {
220 2         7 $args{ $att } = 1;
221             } else {
222 0         0 $args{ $att } = 0;
223             }
224             } else {
225 8322         250155 $args{ $att } = $value;
226             }
227             }
228             }
229             } elsif (my ($type) = ($att_type =~ m/^ArrayRef\[(.*)\]$/)) {
230 714         44037 my $value = $result->{ $att };
231 714 100 100     4241 $value = $result->{ $key } if (not defined $value and $key ne $att);
232 714         1454 my $value_ref = ref($value);
233              
234 714 100       1678 if ($value_ref eq 'HASH') {
235 345 100       1716 if (exists $value->{ member }) {
    50          
    100          
236 177         365 $value = $value->{ member };
237             } elsif (exists $value->{ entry }) {
238 0         0 $value = $value->{ entry };
239             } elsif (keys %$value == 1) {
240 162         834 $value = $value->{ (keys %$value)[0] };
241             } else {
242             #die "Can't detect the item that has the array in the response hash";
243             }
244 345         820 $value_ref = ref($value);
245             }
246            
247 714 100       2046 if ($type =~ m/\:\:/) {
248 593         2613 Paws->load_class($type);
249              
250 593         1031 my $val;
251 593 100       2241 if (not defined $value) {
    100          
    50          
252 290         637 $val = [ ];
253             } elsif ($value_ref eq 'ARRAY') {
254 168         468 $val = $value;
255             } elsif ($value_ref eq 'HASH') {
256 135         343 $val = [ $value ];
257             }
258              
259 593 50       3582 if ($type->does('Paws::API::StrToObjMapParser')) {
    50          
    50          
260 0         0 $args{ $att } = [ map { $self->handle_response_strtoobjmap($type, $_) } @$val ];
  0         0  
261             } elsif ($type->does('Paws::API::StrToNativeMapParser')) {
262 0         0 $args{ $att } = [ map { $self->handle_response_strtonativemap($type, $_) } @$val ];
  0         0  
263             } elsif ($type->does('Paws::API::MapParser')) {
264 0         0 die "MapParser Type in an Array. Please implement me";
265             } else {
266 593         339955 $args{ $att } = [ map { $self->new_from_result_struct($type, $_) } @$val ];
  1863         2192294  
267             }
268             } else {
269 121 100       329 if (defined $value){
270 57 100       141 if ($value_ref eq 'ARRAY') {
271 35         121 $args{ $att } = $value;
272             } else {
273 22         99 $args{ $att } = [ $value ];
274             }
275             } else {
276 64 100       250 $args{ $att } = [] if ($att_is_required);
277             }
278             }
279             }
280             }
281 2213         205740 $class->new(%args);
282             }
283             }
284             1;