line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Paws::Net::RestXmlCaller; |
2
|
8
|
|
|
8
|
|
4912
|
use Moose::Role; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
54
|
|
3
|
8
|
|
|
8
|
|
35839
|
use HTTP::Request::Common; |
|
8
|
|
|
|
|
13747
|
|
|
8
|
|
|
|
|
525
|
|
4
|
8
|
|
|
8
|
|
49
|
use POSIX qw(strftime); |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
64
|
|
5
|
8
|
|
|
8
|
|
521
|
use URI::Template; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
173
|
|
6
|
8
|
|
|
8
|
|
36
|
use URI::Escape; |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
354
|
|
7
|
8
|
|
|
8
|
|
48
|
use Moose::Util; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
62
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub array_flatten_string { |
10
|
9
|
|
|
9
|
0
|
12
|
my $self = shift; |
11
|
9
|
50
|
|
|
|
21
|
return ($self->flattened_arrays)?'%s.%d':'%s.member.%d'; |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# converts the objects that represent the call into parameters that the API can understand |
15
|
|
|
|
|
|
|
sub _to_querycaller_params { |
16
|
13
|
|
|
13
|
|
39
|
my ($self, $params) = @_; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
13
|
|
|
|
|
22
|
my %p; |
20
|
13
|
|
|
|
|
48
|
foreach my $att (grep { $_ !~ m/^_/ } $params->meta->get_attribute_list) { |
|
71
|
|
|
|
|
543
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# e.g. S3 metadata objects, which are passed in the header |
23
|
71
|
100
|
|
|
|
417
|
next if $params->meta->get_attribute($att)->does('Paws::API::Attribute::Trait::ParamInHeaders'); |
24
|
|
|
|
|
|
|
|
25
|
70
|
100
|
|
|
|
18209
|
my $key = $params->meta->get_attribute($att)->does('Paws::API::Attribute::Trait::ParamInQuery')?$params->meta->get_attribute($att)->query_name:$att; |
26
|
70
|
100
|
|
|
|
14531
|
if (defined $params->$att) { |
27
|
28
|
|
|
|
|
88
|
my $att_type = $params->meta->get_attribute($att)->type_constraint; |
28
|
|
|
|
|
|
|
|
29
|
28
|
100
|
|
|
|
1572
|
if ($self->_is_internal_type($att_type)) { |
|
|
100
|
|
|
|
|
|
30
|
21
|
|
|
|
|
1035
|
$p{ $key } = $params->{$att}; |
31
|
|
|
|
|
|
|
} elsif ($att_type =~ m/^ArrayRef\[(.*)\]/) { |
32
|
3
|
100
|
|
|
|
506
|
if ($self->_is_internal_type("$1")){ |
33
|
1
|
|
|
|
|
3
|
my $i = 1; |
34
|
1
|
|
|
|
|
2
|
foreach my $value (@{ $params->$att }){ |
|
1
|
|
|
|
|
22
|
|
35
|
3
|
|
|
|
|
7
|
$p{ sprintf($self->array_flatten_string, $key, $i) } = $value; |
36
|
3
|
|
|
|
|
7
|
$i++ |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
} else { |
39
|
2
|
|
|
|
|
4
|
my $i = 1; |
40
|
2
|
|
|
|
|
3
|
foreach my $value (@{ $params->$att }){ |
|
2
|
|
|
|
|
50
|
|
41
|
2
|
|
|
|
|
9
|
my %complex_value = $self->_to_querycaller_params($value); |
42
|
2
|
|
|
|
|
7
|
map { $p{ sprintf($self->array_flatten_string . ".%s", $key, $i, $_) } = $complex_value{$_} } keys %complex_value; |
|
6
|
|
|
|
|
13
|
|
43
|
2
|
|
|
|
|
8
|
$i++ |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
} else { |
47
|
4
|
|
|
|
|
959
|
my %complex_value = $self->_to_querycaller_params($params->$att); |
48
|
4
|
|
|
|
|
10
|
map { $p{ "$key.$_" } = $complex_value{$_} } keys %complex_value; |
|
18
|
|
|
|
|
58
|
|
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
} |
52
|
13
|
|
|
|
|
246
|
return %p; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub _call_uri { |
56
|
7
|
|
|
7
|
|
22
|
my ($self, $call) = @_; |
57
|
7
|
|
|
|
|
29
|
my $uri_template = $call->meta->name->_api_uri; # in auto-lib/<service>/<method>.pm |
58
|
|
|
|
|
|
|
|
59
|
7
|
|
|
|
|
60
|
my @uri_attribs = $uri_template =~ /{(.+?)}/g; |
60
|
7
|
|
|
|
|
17
|
my $vars = {}; |
61
|
|
|
|
|
|
|
|
62
|
7
|
|
|
|
|
14
|
my %uri_attrib_is_greedy; |
63
|
7
|
|
|
|
|
26
|
foreach my $attrib ( @uri_attribs ) { |
64
|
7
|
|
|
|
|
43
|
my ($att_name, $greedy) = $attrib =~ /(\w+)(\+?)/; |
65
|
7
|
|
|
|
|
26
|
$uri_attrib_is_greedy{$att_name} = $greedy; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
7
|
|
|
|
|
30
|
foreach my $attribute ($call->meta->get_all_attributes) |
69
|
|
|
|
|
|
|
{ |
70
|
49
|
100
|
|
|
|
11955
|
if ($attribute->does('Paws::API::Attribute::Trait::ParamInURI')) { |
71
|
7
|
|
|
|
|
1703
|
my $att_name = $attribute->name; |
72
|
7
|
100
|
|
|
|
28
|
if ($uri_attrib_is_greedy{$att_name}) { |
73
|
1
|
|
|
|
|
26
|
$vars->{ $attribute->uri_name } = uri_escape_utf8($call->$att_name, q[^A-Za-z0-9\-\._~/]); |
74
|
1
|
|
|
|
|
20
|
$uri_template =~ s{$att_name\+}{\+$att_name}g; |
75
|
|
|
|
|
|
|
} else { |
76
|
6
|
|
|
|
|
184
|
$vars->{ $attribute->uri_name } = $call->$att_name; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
7
|
|
|
|
|
1315
|
my $t = URI::Template->new( $uri_template ); |
82
|
7
|
|
|
|
|
835
|
my $uri = $t->process($vars); |
83
|
7
|
|
|
|
|
1637
|
return $uri; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub _to_header_params { |
87
|
7
|
|
|
7
|
|
20
|
my ($self, $request, $call) = @_; |
88
|
7
|
|
|
|
|
26
|
foreach my $attribute ($call->meta->get_all_attributes) { |
89
|
49
|
100
|
|
|
|
7725
|
if ($attribute->does('Paws::API::Attribute::Trait::AutoInHeader')) { |
90
|
1
|
50
|
|
|
|
266
|
if ( $attribute->auto eq 'MD5' ) { |
91
|
1
|
|
|
|
|
10
|
require MIME::Base64; |
92
|
1
|
|
|
|
|
6
|
require Digest::MD5; |
93
|
1
|
|
|
|
|
2
|
my $value; |
94
|
1
|
50
|
|
|
|
4
|
if ( $attribute->has_value($call) ) { |
95
|
0
|
|
|
|
|
0
|
$value = $attribute->get_value($call); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
else { |
98
|
1
|
|
|
|
|
54
|
$value = MIME::Base64::encode_base64( Digest::MD5::md5( $request->content ) ); |
99
|
1
|
|
|
|
|
6
|
chomp $value; |
100
|
|
|
|
|
|
|
} |
101
|
1
|
|
|
|
|
38
|
$request->headers->header( $attribute->header_name => $value ); |
102
|
|
|
|
|
|
|
} |
103
|
1
|
|
|
|
|
70
|
next; |
104
|
|
|
|
|
|
|
} |
105
|
48
|
100
|
|
|
|
14030
|
next unless $attribute->has_value($call); |
106
|
17
|
50
|
|
|
|
466
|
if ($attribute->does('Paws::API::Attribute::Trait::ParamInHeader')) { |
|
|
100
|
|
|
|
|
|
107
|
0
|
|
|
|
|
0
|
my $value = $attribute->get_value($call); |
108
|
0
|
|
|
|
|
0
|
$request->headers->header( $attribute->header_name => $value ); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
elsif ($attribute->does('Paws::API::Attribute::Trait::ParamInHeaders')) { |
111
|
1
|
|
|
|
|
473
|
my $map = $attribute->get_value($call)->Map; |
112
|
1
|
|
|
|
|
27
|
my $prefix = $attribute->header_prefix; |
113
|
1
|
|
|
|
|
3
|
for my $header (keys %{$map}) { |
|
1
|
|
|
|
|
4
|
|
114
|
2
|
|
|
|
|
93
|
my $header_name = $prefix . $header; |
115
|
2
|
|
|
|
|
49
|
$request->headers->header( $header_name => $map->{$header} ); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# URI escaping adapted from URI::Escape |
122
|
|
|
|
|
|
|
#c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1 |
123
|
|
|
|
|
|
|
# perl 5.6 ready UTF-8 encoding adapted from JSON::PP |
124
|
|
|
|
|
|
|
our %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; |
125
|
|
|
|
|
|
|
our $unsafe_char = qr/[^A-Za-z0-9\-\._~]/; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _uri_escape { |
128
|
0
|
|
|
0
|
|
0
|
my ($self, $str) = @_; |
129
|
0
|
|
|
|
|
0
|
utf8::encode($str); |
130
|
0
|
|
|
|
|
0
|
$str =~ s/($unsafe_char)/$escapes{$1}/ge; |
|
0
|
|
|
|
|
0
|
|
131
|
0
|
|
|
|
|
0
|
$str =~ s/ /+/go; |
132
|
0
|
|
|
|
|
0
|
return $str; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _to_xml { |
136
|
6
|
|
|
6
|
|
216
|
my ($self, $value) = @_; |
137
|
|
|
|
|
|
|
|
138
|
6
|
|
|
|
|
8
|
my $xml = ''; |
139
|
6
|
|
|
|
|
20
|
foreach my $attribute ($value->meta->get_all_attributes) { |
140
|
22
|
|
|
|
|
1088
|
my $att_name = $attribute->name; |
141
|
22
|
100
|
|
|
|
53
|
next if (not $attribute->has_value($value)); |
142
|
12
|
100
|
|
|
|
667
|
if (Moose::Util::find_meta($attribute->type_constraint->name)) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
143
|
2
|
50
|
|
|
|
106
|
if ($attribute->does('NameInRequest')) { |
144
|
0
|
|
|
|
|
0
|
my $location = $attribute->request_name; |
145
|
0
|
|
|
|
|
0
|
$xml .= sprintf '<%s>%s</%s>', $location, $self->_to_xml($attribute->get_value($value)), $location; |
146
|
|
|
|
|
|
|
} else { |
147
|
2
|
|
|
|
|
141
|
$xml .= sprintf '<%s>%s</%s>', $att_name, $self->_to_xml($attribute->get_value($value)), $att_name; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} elsif ($attribute->type_constraint eq 'ArrayRef[Str|Undef]') { |
150
|
1
|
|
|
|
|
118
|
my $location = $attribute->request_name; |
151
|
1
|
|
|
|
|
4
|
$xml .= "<${att_name}>" . ( join '', map { sprintf '<%s>%s</%s>', $location, $_, $location } @{ $attribute->get_value($value) } ) . "</${att_name}>"; |
|
3
|
|
|
|
|
115
|
|
|
1
|
|
|
|
|
10
|
|
152
|
|
|
|
|
|
|
} elsif ($attribute->type_constraint =~ m/^ArrayRef\[(.*?\:\:.*)\]/) { #assume it's an array of Paws API objects |
153
|
2
|
50
|
|
|
|
385
|
my $location = $attribute->does('NameInRequest') ? $attribute->request_name : $att_name; |
154
|
2
|
|
|
|
|
5
|
$xml .= ( join '', map { sprintf '<%s>%s</%s>', $location, $self->_to_xml($_), $location } @{ $attribute->get_value($value) } ); |
|
2
|
|
|
|
|
277
|
|
|
2
|
|
|
|
|
8
|
|
155
|
|
|
|
|
|
|
} else { |
156
|
7
|
50
|
|
|
|
1144
|
if ($attribute->does('NameInRequest')) { |
157
|
0
|
|
|
|
|
0
|
my $location = $attribute->request_name; |
158
|
0
|
|
|
|
|
0
|
$xml .= sprintf '<%s>%s</%s>', $location, $attribute->get_value($value), $location; |
159
|
|
|
|
|
|
|
} else { |
160
|
7
|
|
|
|
|
567
|
$xml .= sprintf '<%s>%s</%s>', $att_name, $attribute->get_value($value), $att_name; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
6
|
|
|
|
|
406
|
return $xml; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub _to_xml_body { |
168
|
7
|
|
|
7
|
|
20
|
my ($self, $call) = @_; |
169
|
|
|
|
|
|
|
|
170
|
7
|
|
|
|
|
17
|
my $xml = ''; |
171
|
7
|
|
|
|
|
24
|
foreach my $attribute ($call->meta->get_all_attributes) { |
172
|
49
|
100
|
66
|
|
|
9068
|
if ($attribute->has_value($call) and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
173
|
|
|
|
|
|
|
not $attribute->does('Paws::API::Attribute::Trait::ParamInHeader') and |
174
|
|
|
|
|
|
|
not $attribute->does('Paws::API::Attribute::Trait::ParamInQuery') and |
175
|
|
|
|
|
|
|
not $attribute->does('Paws::API::Attribute::Trait::ParamInURI') and |
176
|
|
|
|
|
|
|
not $attribute->does('Paws::API::Attribute::Trait::ParamInBody') and |
177
|
|
|
|
|
|
|
not $attribute->type_constraint eq 'Paws::S3::Metadata' |
178
|
|
|
|
|
|
|
) { |
179
|
2
|
|
|
|
|
699
|
my $attribute_value = $attribute->get_value($call); |
180
|
2
|
50
|
|
|
|
230
|
if ( ref $attribute_value ) { |
181
|
2
|
50
|
|
|
|
7
|
my $location = $attribute->does('NameInRequest') ? $attribute->request_name : $attribute->name; |
182
|
2
|
|
|
|
|
136
|
$xml .= sprintf '<%s>%s</%s>', $location, $self->_to_xml($attribute_value), $location; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
else { |
185
|
0
|
|
|
|
|
0
|
$xml .= $attribute_value; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
7
|
100
|
|
|
|
3652
|
return undef if (not $xml); |
191
|
2
|
|
|
|
|
7
|
return $xml; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub prepare_request_for_call { |
195
|
7
|
|
|
7
|
0
|
80
|
my ($self, $call) = @_; |
196
|
|
|
|
|
|
|
|
197
|
7
|
|
|
|
|
14
|
my $request; |
198
|
7
|
100
|
|
|
|
57
|
if ($self->isa('Paws::S3')){ |
199
|
4
|
|
|
|
|
1111
|
require Paws::Net::S3APIRequest; |
200
|
4
|
|
|
|
|
41
|
$request = Paws::Net::S3APIRequest->new(); |
201
|
|
|
|
|
|
|
} else { |
202
|
3
|
|
|
|
|
25
|
$request = Paws::Net::APIRequest->new(); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
7
|
|
|
|
|
5288
|
my $uri = $self->_call_uri($call); #in RestXmlCaller |
206
|
|
|
|
|
|
|
|
207
|
7
|
|
|
|
|
53
|
my $qparams = { $uri->query_form }; |
208
|
7
|
|
|
|
|
258
|
foreach my $attribute ($call->meta->get_all_attributes) { |
209
|
49
|
|
|
|
|
9342
|
my $att_name = $attribute->name; |
210
|
49
|
100
|
|
|
|
120
|
if ($attribute->does('Paws::API::Attribute::Trait::ParamInQuery')) { |
211
|
14
|
100
|
|
|
|
3204
|
$qparams->{ $attribute->query_name } = $call->$att_name if (defined $call->$att_name); |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
} |
214
|
7
|
|
|
|
|
1304
|
$uri->query_form(%$qparams); |
215
|
|
|
|
|
|
|
|
216
|
7
|
|
|
|
|
432
|
$request->uri($uri->as_string); |
217
|
|
|
|
|
|
|
|
218
|
7
|
|
|
|
|
182
|
my $url = $self->_api_endpoint . $uri; #in Paws::API::EndPointResolver |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
#TODO: I'm not sure if any of the REST style APIs want things as query parameters |
221
|
7
|
|
|
|
|
67
|
$request->parameters({ $self->_to_querycaller_params($call) }); |
222
|
|
|
|
|
|
|
|
223
|
7
|
|
|
|
|
171
|
$request->url($url); |
224
|
7
|
|
|
|
|
203
|
$request->method($call->_api_method); |
225
|
|
|
|
|
|
|
|
226
|
7
|
100
|
|
|
|
38
|
if (my $xml_body = $self->_to_xml_body($call)){ |
227
|
2
|
|
|
|
|
54
|
$request->content($xml_body); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
7
|
|
|
|
|
36
|
$self->_to_header_params($request, $call); |
231
|
|
|
|
|
|
|
|
232
|
7
|
100
|
|
|
|
1906
|
if ($call->can('_stream_param')) { |
233
|
1
|
|
|
|
|
30
|
my $param_name = $call->_stream_param; |
234
|
1
|
|
|
|
|
23
|
$request->content($call->$param_name); |
235
|
1
|
|
|
|
|
23
|
$request->headers->header( 'content-length' => $request->content_length ); |
236
|
|
|
|
|
|
|
#$request->headers->header( 'content-type' => $self->content_type ); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
7
|
|
|
|
|
95
|
$self->sign($request); |
240
|
|
|
|
|
|
|
|
241
|
7
|
|
|
|
|
138
|
return $request; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
1; |