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