File Coverage

blib/lib/Paws/Net/RestXMLResponse.pm
Criterion Covered Total %
statement 92 152 60.5
branch 53 110 48.1
condition 7 11 63.6
subroutine 9 11 81.8
pod 0 6 0.0
total 161 290 55.5


line stmt bran cond sub pod time code
1             package Paws::Net::RestXMLResponse;
2 9     9   18483 use Moose::Role;
  9         19  
  9         54  
3 9     9   43586 use XML::Simple qw//;
  9         13085  
  9         183  
4 9     9   49 use Carp qw(croak);
  9         17  
  9         426  
5 9     9   3461 use HTTP::Status;
  9         28312  
  9         1733  
6 9     9   63 use Paws::Exception;
  9         17  
  9         11012  
7              
8             sub unserialize_response {
9 66     66 0 201 my ($self, $data) = @_;
10              
11 66 50 33     418 return {} if (not defined $data or $data eq '');
12            
13 66         772 my $xml = XML::Simple->new(
14             ForceArray => qr/^(?:item|Errors)/i,
15             KeyAttr => '',
16             SuppressEmpty => undef,
17             );
18 66         7202 return $xml->parse_string($data);
19             }
20              
21             sub handle_response {
22 77     77 0 173463 my ($self, $call_object, $http_status, $content, $headers) = @_;
23              
24 77 100       299 if ( $http_status >= 300 ) {
25 9         41 return $self->error_to_exception($call_object, $http_status, $content, $headers);
26             } else {
27 68         377 return $self->response_to_object($call_object, $http_status, $content, $headers);
28             }
29             }
30              
31             sub error_to_exception {
32 9     9 0 28 my ($self, $call_object, $http_status, $content, $headers) = @_;
33              
34 9         20 my $struct = eval { $self->unserialize_response( $content ) };
  9         34  
35 9 50       36690 if ($@){
36 0         0 return Paws::Exception->new(
37             message => $@,
38             code => 'InvalidContent',
39             request_id => '', #$request_id,
40             http_status => $http_status,
41             );
42             }
43              
44 9         27 my ($message, $code, $request_id, $host_id);
45              
46 9         37 $message = status_message($http_status);
47 9         47 $code = $http_status;
48 9   66     41 $request_id = $headers->{ 'x-amz-request-id' } // $struct->{RequestId} // '';
      50        
49 9         21 $host_id = $headers->{ 'x-amz-id-2' };
50              
51 9         214 Paws::Exception->new(
52             message => $message,
53             code => $code,
54             request_id => $request_id,
55             host_id => $host_id,
56             http_status => $http_status,
57             );
58             }
59              
60             sub handle_response_strtonativemap {
61 0     0 0 0 my ($self, $att_class, $value) = @_;
62 0         0 my $xml_keys = $att_class->xml_keys;
63 0         0 my $xml_values = $att_class->xml_values;
64              
65 0         0 my $value_ref = ref($value);
66 0 0       0 if ($value_ref eq 'HASH') {
67 0 0       0 if (exists $value->{ member }) {
    0          
    0          
68 0         0 $value = $value->{ member };
69             } elsif (exists $value->{ entry }) {
70 0         0 $value = $value->{ entry };
71             } elsif (keys %$value == 1) {
72 0         0 $value = $value->{ (keys %$value)[0] };
73             } else {
74             #die "Can't detect the item that has the array in the response hash";
75             }
76 0         0 $value_ref = ref($value);
77             }
78            
79 0         0 my $inner_class = $att_class->meta->get_attribute('Map')->type_constraint->name;
80 0         0 ($inner_class) = ($inner_class =~ m/\[(.*)\]$/);
81 0         0 Paws->load_class("$inner_class");
82              
83 0 0       0 if ($value_ref eq 'ARRAY') {
    0          
    0          
84 0         0 return $att_class->new(Map => { map { ( $_->{ $xml_keys } => $self->new_from_result_struct($inner_class, $_->{ $xml_values }) ) } @$value } );
  0         0  
85             } elsif ($value_ref eq 'HASH') {
86 0         0 return $att_class->new(Map => { $value->{ $xml_keys } => $self->new_from_result_struct($inner_class, $value->{ $xml_values }) });
87             } elsif (not defined $value){
88 0         0 return $att_class->new(Map => {});
89             }
90             }
91              
92             sub handle_response_strtoobjmap {
93 0     0 0 0 my ($self, $att_class, $value) = @_;
94 0         0 my $xml_keys = $att_class->xml_keys;
95 0         0 my $xml_values = $att_class->xml_values;
96              
97 0         0 my $value_ref = ref($value);
98 0 0       0 if ($value_ref eq 'HASH') {
99 0 0       0 if (exists $value->{ member }) {
    0          
    0          
100 0         0 $value = $value->{ member };
101             } elsif (exists $value->{ entry }) {
102 0         0 $value = $value->{ entry };
103             } elsif (keys %$value == 1) {
104 0         0 $value = $value->{ (keys %$value)[0] };
105             } else {
106             #die "Can't detect the item that has the array in the response hash";
107             }
108 0         0 $value_ref = ref($value);
109             }
110            
111 0 0       0 if ($value_ref eq 'ARRAY') {
    0          
112 0         0 return $att_class->new(Map => { map { ( $_->{ $xml_keys } => $_->{ $xml_values } ) } @$value } );
  0         0  
113             } elsif ($value_ref eq 'HASH') {
114 0         0 return $att_class->new(Map => { $value->{ $xml_keys } => $value->{ $xml_values } } );
115             }
116             }
117              
118             sub new_from_result_struct {
119 4054     4054 0 8504 my ($self, $class, $result) = @_;
120 4054         5718 my %args;
121            
122 4054 50       10090 if ($class->does('Paws::API::StrToObjMapParser')) {
    50          
123 0         0 return $self->handle_response_strtoobjmap($class, $result);
124             } elsif ($class->does('Paws::API::StrToNativeMapParser')) {
125 0         0 return $self->handle_response_strtonativemap($class, $result);
126             } else {
127 4054         1530166 foreach my $att ($class->meta->get_attribute_list) {
128 17154 50       887032 next if (not my $meta = $class->meta->get_attribute($att));
129              
130 17154 100       349176 my $key = $meta->does('NameInRequest') ? $meta->request_name :
    100          
131             $meta->does('ParamInHeader') ? lc($meta->header_name) : $att;
132              
133 17154         2969116 my $att_type = $meta->type_constraint;
134 17154         546555 my $att_is_required = $meta->is_required;
135              
136             # use Data::Dumper;
137             # print STDERR "USING KEY: $key\n";
138             # print STDERR "$att IS A '$att_type' TYPE\n";
139             # print STDERR "VALUE: " . Dumper($result);
140             # my $extracted_val = $result->{ $key };
141             # print STDERR "RESULT >>> $extracted_val\n";
142              
143             # Free-form paramaters passed in the HTTP headers
144 17154 100       108923 if ($meta->does('Paws::API::Attribute::Trait::ParamInHeaders')) {
    100          
    50          
145 2         390 Paws->load_class("$att_type");
146 2         56 my $att_class = $att_type->class;
147 2         62 my $header_prefix = $meta->header_prefix;
148 2         4 my @metadata_headers = map { my ($h, $nometa) = ($_, $_); $nometa =~ s/^$header_prefix//; [ $h, $nometa ] } grep /^$header_prefix/, keys %{$result};
  2         5  
  2         11  
  2         7  
  2         59  
149 2         12 $args{ $att } = $att_class->new( Map => { map { $_->[1] => $result->{$_->[0]} } @metadata_headers } );
  2         13  
150             }
151             # We'll consider that an attribute without brackets [] isn't an array type
152             elsif ($att_type !~ m/\[.*\]$/) {
153 17058         1844627 my $value = $result->{ $key };
154 17058         25932 my $value_ref = ref($value);
155              
156 17058 100       33285 if ($att_type =~ m/\:\:/) {
157             # Make the att_type stringify for module loading
158 1828         52447 Paws->load_class("$att_type");
159 1828 100       4189 if (defined $value) {
160 926 50       2007 if (not $value_ref) {
161 0         0 $args{ $att } = $value;
162             } else {
163 926         23467 my $att_class = $att_type->class;
164              
165 926 50       7422 if ($att_class->does('Paws::API::StrToObjMapParser')) {
    50          
    50          
166 0         0 $args{ $att } = $self->handle_response_strtoobjmap($att_class, $value);
167             } elsif ($att_class->does('Paws::API::StrToNativeMapParser')) {
168 0         0 $args{ $att } = $self->handle_response_strtonativemap($att_class, $value);
169             } elsif ($att_class->does('Paws::API::MapParser')) {
170 0         0 my $xml_keys = $att_class->xml_keys;
171 0         0 my $xml_values = $att_class->xml_values;
172              
173             #TODO: handle in one place
174 0 0       0 if ($value_ref eq 'HASH') {
175 0 0       0 if (exists $value->{ member }) {
    0          
    0          
176 0         0 $value = $value->{ member };
177             } elsif (exists $value->{ entry }) {
178 0         0 $value = $value->{ entry };
179             } elsif (keys %$value == 1) {
180 0         0 $value = $value->{ (keys %$value)[0] };
181             } else {
182             # Force it to be an arrayref and hope it is processed correctly
183 0         0 $value = [ $value ];
184             }
185 0         0 $value_ref = ref($value);
186             }
187              
188              
189 0         0 $args{ $att } = $att_class->new(map { ($_->{ $xml_keys } => $_->{ $xml_values }) } @$value);
  0         0  
190             } else {
191 926         523710 $args{ $att } = $self->new_from_result_struct($att_class, $value);
192             }
193             }
194             } else {
195             ##########
196             # This loop is required to guard against cases (such as Paws::S3::CopyObject) where
197             # the root node is removed from the response when unserialising (see KeepRoot => 1 for
198             # XML::Simple) but is required to create the Paws object. This is mostly due to the
199             # implementation of the new_from_result_struct sub
200 902         22222 my $att_class = $att_type->class;
201             eval {
202 902         2414 $args{ $att } = $self->new_from_result_struct($att_class, $result);
203 901         323618 1;
204 902 100       5477 } or do {}
205             }
206             } else {
207 15230 100       435619 if (defined $value) {
208 12005 100       25727 if ($att_type eq 'Bool') {
209 53 100       1578 if ($value eq 'true') {
    50          
    0          
210 28         105 $args{ $att } = 1;
211             } elsif ($value eq 'false') {
212 25         107 $args{ $att } = 0;
213             } elsif ($value == 1) {
214 0         0 $args{ $att } = 1;
215             } else {
216 0         0 $args{ $att } = 0;
217             }
218             } else {
219 11952         344216 $args{ $att } = $value;
220             }
221             }
222             }
223             } elsif (my ($type) = ($att_type =~ m/^ArrayRef\[(.*)\]$/)) {
224 94         15164 my $value = $result->{ $att };
225 94 100 100     557 $value = $result->{ $key } if (not defined $value and $key ne $att);
226 94         229 my $value_ref = ref($value);
227              
228 94 100       260 if ($value_ref eq 'HASH') {
229 8 50       58 if (exists $value->{ member }) {
    50          
    100          
230 0         0 $value = $value->{ member };
231             } elsif (exists $value->{ entry }) {
232 0         0 $value = $value->{ entry };
233             } elsif (keys %$value == 1) {
234 6         24 $value = $value->{ (keys %$value)[0] };
235             } else {
236             #die "Can't detect the item that has the array in the response hash";
237             }
238 8         18 $value_ref = ref($value);
239             }
240            
241 94 100       352 if ($type =~ m/\:\:/) {
242 93         542 Paws->load_class($type);
243              
244 93         177 my $val;
245 93 100       367 if (not defined $value) {
    100          
    50          
246 44         106 $val = [ ];
247             } elsif ($value_ref eq 'ARRAY') {
248 43         89 $val = $value;
249             } elsif ($value_ref eq 'HASH') {
250 6         17 $val = [ $value ];
251             }
252              
253 93 50       674 if ($type->does('Paws::API::StrToObjMapParser')) {
    50          
    50          
254 0         0 $args{ $att } = [ map { $self->handle_response_strtoobjmap($type, $_) } @$val ];
  0         0  
255             } elsif ($type->does('Paws::API::StrToNativeMapParser')) {
256 0         0 $args{ $att } = [ map { $self->handle_response_strtonativemap($type, $_) } @$val ];
  0         0  
257             } elsif ($type->does('Paws::API::MapParser')) {
258 0         0 die "MapParser Type in an Array. Please implement me";
259             } else {
260 93         52856 $args{ $att } = [ map { $self->new_from_result_struct($type, $_) } @$val ];
  2159         3445363  
261             }
262             } else {
263 1 50       3 if (defined $value){
264 1 50       2 if ($value_ref eq 'ARRAY') {
265 1         4 $args{ $att } = $value;
266             } else {
267 0         0 $args{ $att } = [ $value ];
268             }
269             } else {
270 0 0       0 $args{ $att } = [] if ($att_is_required);
271             }
272             }
273             }
274             }
275 4052         20011 $class->new(%args);
276             }
277             }
278             1;