line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/env perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Amazon::API::Botocore; |
4
|
|
|
|
|
|
|
|
5
|
3
|
|
|
3
|
|
24
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
98
|
|
6
|
3
|
|
|
3
|
|
16
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
108
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
BEGIN { |
9
|
3
|
|
|
3
|
|
17
|
use English qw(-no_match_vars); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
33
|
|
10
|
|
|
|
|
|
|
|
11
|
3
|
|
|
3
|
|
57
|
eval { require Log::Log4perl; }; |
|
3
|
|
|
|
|
3278
|
|
12
|
|
|
|
|
|
|
|
13
|
3
|
50
|
|
|
|
141240
|
if ($EVAL_ERROR) { |
14
|
3
|
|
|
3
|
|
1273
|
no strict qw(refs); ## no critic (ProhibitNoStrict) |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
254
|
|
15
|
|
|
|
|
|
|
|
16
|
0
|
|
|
|
|
0
|
*{ __PACKAGE__ . "::$_" } = sub { } |
17
|
0
|
|
|
|
|
0
|
for qw(DEBUG INFO WARN ERROR FATAL); |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
else { |
20
|
3
|
|
|
3
|
|
19
|
no warnings; ## no critic (ProhibitNoWarnings) |
|
3
|
|
|
|
|
16
|
|
|
3
|
|
|
|
|
280
|
|
21
|
|
|
|
|
|
|
|
22
|
3
|
|
|
|
|
27
|
require Log::Log4perl::Level; |
23
|
|
|
|
|
|
|
|
24
|
3
|
|
|
|
|
20
|
Log::Log4perl::Level->import(__PACKAGE__); |
25
|
3
|
|
|
|
|
390
|
Log::Log4perl->import(qw(:easy)); |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
3
|
|
|
3
|
|
2126
|
use parent qw{ Exporter }; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
28
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
use Amazon::API::Botocore::Shape::Utils |
32
|
3
|
|
|
3
|
|
2358
|
qw(require_class create_shape create_module_name); |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
300
|
|
33
|
|
|
|
|
|
|
|
34
|
3
|
|
|
3
|
|
23
|
use Amazon::API::Template qw(:all); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
325
|
|
35
|
3
|
|
|
3
|
|
1742
|
use Amazon::API::Pod::Parser qw(get_pod_section); |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
183
|
|
36
|
|
|
|
|
|
|
|
37
|
3
|
|
|
3
|
|
21
|
use Carp; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
141
|
|
38
|
3
|
|
|
3
|
|
1426
|
use Carp::Always; |
|
3
|
|
|
|
|
2268
|
|
|
3
|
|
|
|
|
14
|
|
39
|
3
|
|
|
3
|
|
163
|
use Cwd; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
175
|
|
40
|
3
|
|
|
3
|
|
20
|
use Data::Dumper; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
129
|
|
41
|
3
|
|
|
3
|
|
18
|
use English qw( -no_match_vars ); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
28
|
|
42
|
3
|
|
|
3
|
|
940
|
use File::Find; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
171
|
|
43
|
3
|
|
|
3
|
|
18
|
use File::Path qw(make_path); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
204
|
|
44
|
3
|
|
|
3
|
|
22
|
use Getopt::Long qw(:config no_ignore_case); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
30
|
|
45
|
3
|
|
|
3
|
|
529
|
use JSON; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
26
|
|
46
|
3
|
|
|
3
|
|
2733
|
use List::MoreUtils qw( first_index ); |
|
3
|
|
|
|
|
42456
|
|
|
3
|
|
|
|
|
19
|
|
47
|
3
|
|
|
3
|
|
3281
|
use List::Util qw( max ); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
182
|
|
48
|
3
|
|
|
3
|
|
1670
|
use Pod::Usage; |
|
3
|
|
|
|
|
71584
|
|
|
3
|
|
|
|
|
344
|
|
49
|
3
|
|
|
3
|
|
33
|
use Pod::Text; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
120
|
|
50
|
3
|
|
|
3
|
|
20
|
use ReadonlyX; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
143
|
|
51
|
3
|
|
|
3
|
|
1605
|
use charnames qw(:full); |
|
3
|
|
|
|
|
30809
|
|
|
3
|
|
|
|
|
19
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# package constants |
54
|
|
|
|
|
|
|
Readonly::Scalar our $BOTO_PATH_OFFSET => 3; |
55
|
|
|
|
|
|
|
Readonly::Scalar our $SHAPE_FILE_TEMPLATE => |
56
|
|
|
|
|
|
|
'%sAmazon/API/Botocore/Shape/%s/'; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Readonly::Scalar our $REQUEST_CLASS_TEMPLATE => |
59
|
|
|
|
|
|
|
q{Amazon::API::Botocore::Shape::%s::%sRequest}; |
60
|
|
|
|
|
|
|
|
61
|
3
|
|
|
3
|
|
835
|
use Amazon::API::Constants qw( :all ); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
707
|
|
62
|
3
|
|
|
3
|
|
1646
|
use Amazon::API::Botocore::Pod qw( pod ); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
1829
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
our $VERSION = '2.0.11'; ## no critic (RequireInterpolationOfMetachars) |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
our %BOTO_SERVICES; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
our $TEMPLATE_START = tell DATA; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
71
|
|
|
|
|
|
|
%BOTO_SERVICES |
72
|
|
|
|
|
|
|
create_module_name |
73
|
|
|
|
|
|
|
create_service_shapes |
74
|
|
|
|
|
|
|
fetch_boto_services |
75
|
|
|
|
|
|
|
get_service_descriptions |
76
|
|
|
|
|
|
|
paginator |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
80
|
|
|
|
|
|
|
all => [ |
81
|
|
|
|
|
|
|
qw( |
82
|
|
|
|
|
|
|
create_service_shapes |
83
|
|
|
|
|
|
|
fetch_boto_services |
84
|
|
|
|
|
|
|
get_service_descriptions |
85
|
|
|
|
|
|
|
%BOTO_SERVICES) |
86
|
|
|
|
|
|
|
], |
87
|
|
|
|
|
|
|
); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
caller or __PACKAGE__->main; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
######################################################################## |
92
|
|
|
|
|
|
|
sub paginator { |
93
|
|
|
|
|
|
|
######################################################################## |
94
|
0
|
|
|
0
|
0
|
|
my (%options) = @_; |
95
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
|
my ( $service, $api, $parameters ) = @options{qw(service api parameters)}; |
97
|
|
|
|
|
|
|
|
98
|
0
|
|
0
|
|
|
|
$parameters //= {}; |
99
|
|
|
|
|
|
|
|
100
|
0
|
0
|
0
|
|
|
|
croak "no service\n" |
101
|
|
|
|
|
|
|
if !$service && ref($service) =~ /^Amazon::API::/xsm; |
102
|
|
|
|
|
|
|
|
103
|
0
|
0
|
|
|
|
|
croak "no api name\n" |
104
|
|
|
|
|
|
|
if !$api; |
105
|
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
|
my $service_name = ref $service; |
107
|
|
|
|
|
|
|
|
108
|
0
|
0
|
|
|
|
|
if ( $service_name =~ /^Amazon::API::([^:]+)$/xsm ) { |
109
|
0
|
|
|
|
|
|
$service_name = $1; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
else { |
112
|
0
|
|
|
|
|
|
croak "could not determine service name\n"; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
my $request_class = sprintf $REQUEST_CLASS_TEMPLATE, $service_name, $api; |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
my $ret = eval { require_class $request_class; }; |
|
0
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
|
119
|
0
|
0
|
0
|
|
|
|
croak "unable to find a request class: $request_class\n" |
120
|
|
|
|
|
|
|
if !$ret || $EVAL_ERROR; |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my $paginator = $service->get_paginators->{$api}; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my $input_token = $paginator->{input_token}; |
125
|
0
|
|
|
|
|
|
my $more_results = $paginator->{more_results}; |
126
|
0
|
|
|
|
|
|
my $limit_key = $paginator->{limit_key}; |
127
|
0
|
|
|
|
|
|
my $output_token = $paginator->{output_token}; |
128
|
0
|
|
|
|
|
|
my $result_key = $paginator->{result_key}; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
my $request = $request_class->new($parameters); |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
my @response; |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
0
|
|
|
|
$more_results //= $output_token; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
while ( my $rsp = $service->$api($request) ) { |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
push @response, @{ $rsp->{$result_key} }; |
|
0
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
|
140
|
0
|
0
|
|
|
|
|
last if !$rsp->{$more_results}; |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my $limit = $rsp->{$limit_key}; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
$request = $request_class->new( |
145
|
|
|
|
|
|
|
{ $limit ? ( $limit_key => $limit ) : (), |
146
|
0
|
0
|
|
|
|
|
$input_token => $rsp->{$output_token} |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
0
|
|
|
|
|
|
return \@response; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
######################################################################## |
155
|
|
|
|
|
|
|
sub parse_request_uri { |
156
|
|
|
|
|
|
|
######################################################################## |
157
|
0
|
|
|
0
|
0
|
|
my ($uri) = @_; |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
my ( $path, $query_string ) = split /\N{QUESTION MARK}/xsm, $uri; |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
|
my @path_parts = split /\N{SOLIDUS}/xsm, $path; |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
my @path_args; |
164
|
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
foreach my $idx ( 1 .. $#path_parts + 1 ) { |
166
|
0
|
0
|
0
|
|
|
|
if ( $path_parts[$idx] && $path_parts[$idx] =~ /^[{](.*)[}]$/xsm ) { |
167
|
0
|
|
|
|
|
|
push @path_args, ucfirst $1; |
168
|
0
|
|
|
|
|
|
$path_parts[$idx] = '%s'; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
my $request_uri = join $SLASH, @path_parts; |
173
|
|
|
|
|
|
|
|
174
|
0
|
0
|
|
|
|
|
if ($query_string) { |
175
|
0
|
|
|
|
|
|
$request_uri .= $QUESTION_MARK . $query_string; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
0
|
|
0
|
|
|
|
return ( $request_uri || $uri, \@path_args ); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
######################################################################## |
182
|
|
|
|
|
|
|
sub fetch_json_file { |
183
|
|
|
|
|
|
|
######################################################################## |
184
|
0
|
|
|
0
|
0
|
|
my ($path) = @_; |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
my $json; |
187
|
|
|
|
|
|
|
|
188
|
0
|
0
|
|
|
|
|
open my $fh, '<', $path |
189
|
|
|
|
|
|
|
or croak 'could not open ' . $path; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
{ |
192
|
0
|
|
|
|
|
|
local $RS = undef; |
|
0
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
|
$json = JSON->new->utf8->decode(<$fh>); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
0
|
0
|
|
|
|
|
close $fh |
197
|
|
|
|
|
|
|
or croak 'could not close ' . $path; |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
return $json; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
######################################################################## |
203
|
0
|
|
|
0
|
0
|
|
sub fetch_service_description { goto &fetch_json_file; } |
204
|
0
|
|
|
0
|
0
|
|
sub fetch_paginators { goto &fetch_json_file; } |
205
|
|
|
|
|
|
|
######################################################################## |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
######################################################################## |
208
|
|
|
|
|
|
|
sub create_service_shapes { |
209
|
|
|
|
|
|
|
######################################################################## |
210
|
0
|
|
|
0
|
0
|
|
my (%options) = @_; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
my ( $service, $boto_path, $shape_path, $module_name ) |
213
|
0
|
|
|
|
|
|
= @options{qw(service botocore-path output-path module-name)}; |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
fetch_boto_services($boto_path); |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
my $service_description |
218
|
0
|
|
|
|
|
|
= get_service_descriptions($service)->[0]->{$service}; |
219
|
|
|
|
|
|
|
|
220
|
0
|
0
|
0
|
|
|
|
if ( $shape_path && $shape_path !~ /\/\z/xsm ) { |
221
|
0
|
|
|
|
|
|
$shape_path = "$shape_path/"; |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
$shape_path = sprintf $SHAPE_FILE_TEMPLATE, $shape_path, $module_name; |
224
|
|
|
|
|
|
|
|
225
|
0
|
0
|
|
|
|
|
if ( !-d $shape_path ) { |
226
|
0
|
0
|
|
|
|
|
croak "could not create $shape_path" |
227
|
|
|
|
|
|
|
if !make_path $shape_path; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
0
|
|
|
|
|
|
my $shapes = $service_description->{shapes}; |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
my $count = 0; |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
foreach my $shape_name ( keys %{$shapes} ) { |
|
0
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
my $class = create_shape( |
237
|
|
|
|
|
|
|
name => $shape_name, |
238
|
|
|
|
|
|
|
service_description => $service_description, |
239
|
|
|
|
|
|
|
service => $module_name |
240
|
|
|
|
|
|
|
); |
241
|
|
|
|
|
|
|
|
242
|
0
|
0
|
|
|
|
|
if ($shape_path) { |
243
|
0
|
|
|
|
|
|
my $module = sprintf '%s%s.pm', $shape_path, $shape_name; |
244
|
|
|
|
|
|
|
|
245
|
0
|
0
|
|
|
|
|
open my $fh, '>', $module |
246
|
|
|
|
|
|
|
or croak "could not open $module for writing"; |
247
|
|
|
|
|
|
|
|
248
|
0
|
|
|
|
|
|
binmode $fh, 'encoding(UTF-8)'; |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
print {$fh} $class; |
|
0
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
close $fh; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
else { |
255
|
0
|
|
|
|
|
|
print {*STDOUT} $class; |
|
0
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$count++; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
|
return $count; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# File::Find callback - collect paths to most recent service-2.json |
265
|
|
|
|
|
|
|
# files for all AWS services |
266
|
|
|
|
|
|
|
######################################################################## |
267
|
|
|
|
|
|
|
sub find_latest_services { |
268
|
|
|
|
|
|
|
######################################################################## |
269
|
0
|
|
|
0
|
0
|
|
my $file = $_; |
270
|
0
|
|
|
|
|
|
my $dir = $File::Find::name; |
271
|
|
|
|
|
|
|
|
272
|
0
|
0
|
|
|
|
|
return if $dir !~ qr/botocore\N{SOLIDUS}botocore/xsm; |
273
|
0
|
0
|
|
|
|
|
return if $file !~ qr/service\N{HYPHEN-MINUS}2\N{FULL STOP}json/xsm; |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
my (@path) = split /\N{SOLIDUS}/xsm, $dir; |
276
|
|
|
|
|
|
|
|
277
|
0
|
|
|
0
|
|
|
my $boto_path = first_index {/botocore/xsm} @path; |
|
0
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# this should not happen... |
280
|
0
|
0
|
|
|
|
|
if ( $boto_path < 0 ) { |
281
|
0
|
|
|
|
|
|
croak 'no botocore in path ' . $dir; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
$boto_path += $BOTO_PATH_OFFSET; |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
my ( $service, $date ) = @path[ $boto_path, $boto_path + 1, ]; |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
$BOTO_SERVICES{$service}->{date} = $BOTO_SERVICES{$service}->{date} |
289
|
0
|
|
0
|
|
|
|
// $EMPTY; |
290
|
|
|
|
|
|
|
|
291
|
0
|
0
|
|
|
|
|
if ( $date gt $BOTO_SERVICES{$service}->{date} ) { |
292
|
0
|
|
|
|
|
|
$BOTO_SERVICES{$service} = { |
293
|
|
|
|
|
|
|
date => $date, |
294
|
|
|
|
|
|
|
path => \@path |
295
|
|
|
|
|
|
|
}; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
return $file; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
######################################################################## |
302
|
|
|
|
|
|
|
sub render_stub { |
303
|
|
|
|
|
|
|
######################################################################## |
304
|
0
|
|
|
0
|
0
|
|
my (%args) = @_; |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
my %options = %{ $args{options} }; |
|
0
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
|
my $service = $args{service}; |
309
|
0
|
|
|
|
|
|
my $template = $args{template}; |
310
|
0
|
|
|
|
|
|
my $parameters = $args{parameters}; |
311
|
0
|
|
|
|
|
|
my $operations = $parameters->{operations}; |
312
|
0
|
|
|
|
|
|
my $shapes = $parameters->{shapes}; |
313
|
0
|
|
|
|
|
|
my $metadata = $parameters->{metadata}; |
314
|
|
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
my $paginators = $parameters->{paginators}; |
316
|
|
|
|
|
|
|
|
317
|
0
|
0
|
|
|
|
|
if ( $parameters->{paginators} ) { |
318
|
0
|
|
|
|
|
|
$paginators = $paginators->{pagination}; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('program_name') } = $PROGRAM_NAME; |
322
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('program_version') } = $VERSION; |
323
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('timestamp') } = scalar localtime; |
324
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('end') } = '__END__'; |
325
|
|
|
|
|
|
|
$parameters->{ to_template_var('description') } |
326
|
0
|
|
|
|
|
|
= $metadata->{serviceFullName}; |
327
|
|
|
|
|
|
|
|
328
|
0
|
|
|
|
|
|
local $Data::Dumper::Terse = $TRUE; |
329
|
0
|
|
|
|
|
|
local $Data::Dumper::Deepcopy = $TRUE; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
$parameters->{ to_template_var('metadata') } |
332
|
0
|
|
|
|
|
|
= Dumper $parameters->{metadata}; |
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
my %methods; |
335
|
|
|
|
|
|
|
my @errors; |
336
|
|
|
|
|
|
|
|
337
|
0
|
|
|
|
|
|
foreach my $m ( keys %{$operations} ) { |
|
0
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
my %operation = %{ $operations->{$m} }; |
|
0
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
|
340
|
0
|
|
|
|
|
|
my $documentation; |
341
|
|
|
|
|
|
|
|
342
|
0
|
0
|
|
|
|
|
if ( $options{pod} ) { |
343
|
0
|
|
0
|
|
|
|
$documentation = html2pod( $operation{documentation} // $EMPTY ); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
$methods{$m} = { |
347
|
|
|
|
|
|
|
documentation => $documentation, |
348
|
|
|
|
|
|
|
input => $operation{input}->{shape}, |
349
|
|
|
|
|
|
|
output => $operation{output}->{shape}, |
350
|
|
|
|
|
|
|
http => $operation{http}, |
351
|
0
|
|
|
|
|
|
errors => [ map { $_->{shape} } @{ $operation{errors} } ], |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
}; |
353
|
|
|
|
|
|
|
|
354
|
0
|
|
|
|
|
|
delete $operations->{$m}->{documentation}; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
0
|
|
|
|
|
|
my @pod; |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
foreach my $method ( sort keys %methods ) { |
360
|
0
|
|
0
|
|
|
|
my $input = $methods{$method}->{input} // $EMPTY; |
361
|
0
|
|
0
|
|
|
|
my $output = $methods{$method}->{output} // $EMPTY; |
362
|
0
|
|
0
|
|
|
|
my $errors = $methods{$method}->{errors} // $EMPTY; |
363
|
|
|
|
|
|
|
|
364
|
0
|
0
|
|
|
|
|
if ( $options{pod} ) { |
365
|
0
|
|
|
|
|
|
my $documentation = $EMPTY; |
366
|
|
|
|
|
|
|
|
367
|
0
|
|
0
|
|
|
|
$documentation = $methods{$method}->{documentation} // $EMPTY; |
368
|
0
|
|
|
|
|
|
$documentation =~ s/\A\n+//xsm; |
369
|
0
|
|
|
|
|
|
$documentation =~ s/\n+\z//xsm; |
370
|
|
|
|
|
|
|
|
371
|
0
|
0
|
|
|
|
|
if ($input) { |
372
|
0
|
|
|
|
|
|
my $input_shape = $shapes->{$input}; |
373
|
0
|
|
|
|
|
|
local $LIST_SEPARATOR = "\n\n"; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
my @items |
376
|
0
|
|
|
|
|
|
= map { sprintf '=item %s', $_ } @{ $input_shape->{required} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
377
|
0
|
|
|
|
|
|
my $required = "@items\n"; |
378
|
|
|
|
|
|
|
|
379
|
0
|
|
|
|
|
|
my $members = $EMPTY; |
380
|
0
|
|
|
|
|
|
my %shape_members = %{ $input_shape->{members} }; |
|
0
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
|
382
|
0
|
|
|
|
|
|
foreach my $m ( sort keys %shape_members ) { |
383
|
0
|
|
0
|
|
|
|
my $location = $shape_members{$m}->{locationName} || $m; |
384
|
0
|
|
|
|
|
|
$members .= sprintf "\n=item %s\n", $m; |
385
|
|
|
|
|
|
|
|
386
|
0
|
|
|
|
|
|
$members .= html2pod $shape_members{$m}->{documentation}; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
0
|
|
0
|
|
|
|
$required ||= 'None'; |
390
|
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
|
$input = <<"INPUT"; |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=over 5 |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=item $input |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=over 5 |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=item Parameters |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=over 5 |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
$members |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=back |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=item Required |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=over 5 |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
$required |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=back |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=back |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=back |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
INPUT |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
0
|
0
|
|
|
|
|
if ($output) { |
423
|
0
|
|
|
|
|
|
my $members = $EMPTY; |
424
|
0
|
|
|
|
|
|
my $output_shape = $shapes->{$output}; |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
|
my %shape_members = %{ $output_shape->{members} }; |
|
0
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
0
|
|
|
|
|
|
foreach my $m ( sort keys %shape_members ) { |
429
|
0
|
|
|
|
|
|
$members .= sprintf "\n=item %s\n", $m; |
430
|
0
|
|
|
|
|
|
$members .= html2pod $shape_members{$m}->{documentation}; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
0
|
|
|
|
|
|
$output = <<"OUTPUT"; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=over 5 |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=item $output |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=over 5 |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=item Parameters |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=over 5 |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
$members |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=back |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=back |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=back |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
OUTPUT |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
0
|
|
|
|
|
|
my @error_items; |
457
|
|
|
|
|
|
|
|
458
|
0
|
0
|
|
|
|
|
if ( @{$errors} ) { |
|
0
|
|
|
|
|
|
|
459
|
0
|
|
|
|
|
|
foreach my $e ( @{$errors} ) { |
|
0
|
|
|
|
|
|
|
460
|
0
|
|
|
|
|
|
my $shape = $shapes->{$e}; |
461
|
0
|
|
|
|
|
|
push @error_items, '=over 5'; |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
push @error_items, sprintf "=item %s\n%s", $e, |
464
|
0
|
|
|
|
|
|
html2pod $shape->{documentation}; |
465
|
|
|
|
|
|
|
|
466
|
0
|
0
|
|
|
|
|
if ( $shape->{error} ) { |
467
|
0
|
|
|
|
|
|
push @error_items, '=over 5'; |
468
|
|
|
|
|
|
|
|
469
|
0
|
|
|
|
|
|
foreach my $k ( sort keys %{ $shape->{error} } ) { |
|
0
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
push @error_items, sprintf "=item %s\n\n%s", $k, |
471
|
0
|
|
|
|
|
|
$shape->{error}->{$k}; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
0
|
|
|
|
|
|
push @error_items, "=back\n"; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
0
|
|
|
|
|
|
push @error_items, "=back\n"; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
0
|
|
|
|
|
|
local $LIST_SEPARATOR = "\n\n"; |
481
|
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
|
my $error_str = "@error_items"; |
483
|
|
|
|
|
|
|
|
484
|
0
|
|
|
|
|
|
$errors = <<"ERRORS"; |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
$error_str |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
ERRORS |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
else { |
491
|
0
|
|
|
|
|
|
$errors = $EMPTY; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
|
my $none = "=over 5\n\n=item NONE\n\n=back\n\n"; |
495
|
|
|
|
|
|
|
|
496
|
0
|
|
0
|
|
|
|
$output = $output || $none; |
497
|
0
|
|
0
|
|
|
|
$errors = $errors || $none; |
498
|
0
|
|
0
|
|
|
|
$input = $input || $none; |
499
|
|
|
|
|
|
|
|
500
|
0
|
|
|
|
|
|
my $method_pod = <<'END_OF_POD'; |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=head2 @method@ |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
@documentation@ |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=over 5 |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=item INPUT |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
@input@ |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=item OUTPUT |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
@output@ |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=item ERRORS |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
@errors@ |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=back |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
END_OF_POD |
523
|
|
|
|
|
|
|
|
524
|
0
|
|
|
|
|
|
my $http = $methods{$method}->{http}; |
525
|
|
|
|
|
|
|
|
526
|
0
|
|
|
|
|
|
my $http_method = $EMPTY; |
527
|
0
|
|
|
|
|
|
my $request_uri = $EMPTY; |
528
|
|
|
|
|
|
|
|
529
|
0
|
0
|
|
|
|
|
if ($http) { |
530
|
0
|
|
0
|
|
|
|
$http_method = $http->{method} // $EMPTY; |
531
|
0
|
|
0
|
|
|
|
$request_uri = $http->{requestUri} // $EMPTY; |
532
|
|
|
|
|
|
|
|
533
|
0
|
|
|
|
|
|
my ( $request_uri_tpl, $args ) = parse_request_uri($request_uri); |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
$operations->{$method}->{http}->{parsed_request_uri} |
536
|
0
|
|
|
|
|
|
= { request_uri_tpl => $request_uri_tpl, parameters => $args }; |
537
|
|
|
|
|
|
|
|
538
|
0
|
|
|
|
|
|
$method_pod .= <<'END_OF_POD'; |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=over 5 |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=item METHOD |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
@http_method@ |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=item REQUEST URI |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
@request_uri@ |
549
|
|
|
|
|
|
|
END_OF_POD |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
|
552
|
0
|
|
|
|
|
|
$method_pod .= <<'END_OF_POD'; |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=back |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
END_OF_POD |
557
|
|
|
|
|
|
|
|
558
|
0
|
|
|
|
|
|
my @see_also; |
559
|
|
|
|
|
|
|
|
560
|
0
|
|
0
|
|
|
|
push @see_also, $methods{$method}->{input} || (); |
561
|
0
|
|
0
|
|
|
|
push @see_also, $methods{$method}->{output} || (); |
562
|
|
|
|
|
|
|
push @see_also, |
563
|
0
|
|
|
|
|
|
map { $_->{shape} } @{ $operations->{$method}->{errors} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
$parameters->{ to_template_var('see_also') } = join "\n", map { |
566
|
0
|
|
|
|
|
|
sprintf 'L<%s::%s>', $parameters->{ to_template_var('package_name') }, |
|
0
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
$_ |
568
|
|
|
|
|
|
|
} @see_also; |
569
|
|
|
|
|
|
|
|
570
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('method') } = $method; |
571
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('errors') } = $errors; |
572
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('input') } = $input; |
573
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('output') } = $output; |
574
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('http_method') } = $http_method; |
575
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('request_uri') } = $request_uri; |
576
|
|
|
|
|
|
|
|
577
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('documentation') } = $documentation; |
578
|
|
|
|
|
|
|
|
579
|
0
|
|
|
|
|
|
my $package_name = $parameters->{ to_template_var('package_name') }; |
580
|
0
|
|
|
|
|
|
$package_name =~ s/::/\//gxsm; |
581
|
|
|
|
|
|
|
|
582
|
0
|
|
|
|
|
|
push @pod, render_template $method_pod, $parameters; |
583
|
|
|
|
|
|
|
|
584
|
0
|
|
|
|
|
|
my $pod_stub = <<'END_OF_POD'; |
585
|
|
|
|
|
|
|
=pod |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=encoding utf8 |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=head1 NAME |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
@method@ |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head1 SYNOPSIS |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
my $service = @package_name@->new; |
596
|
|
|
|
|
|
|
my $rsp = $service->@method@($parameters); |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=head1 DESCRIPTION |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
@documentation@ |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=head1 PARAMETERS |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
=head2 INPUT |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
@input@ |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
=head2 OUTPUT |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
@output@ |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=head2 ERRORS |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
@errors@ |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
=head1 NOTES |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=over 5 |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=item * Method: @http_method@ |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=item * Request URI: @request_uri@ |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
=back |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=head1 SEE ALSO |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
@see_also@ |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
=head1 AUTHOR |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
Autogenerate by @program_name@ on @timestamp@ |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
This module is free software it may be used, redistributed and/or |
637
|
|
|
|
|
|
|
modified under the same terms as Perl itself. |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=cut |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
1; |
642
|
|
|
|
|
|
|
END_OF_POD |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# NOTE: this is JUST pod, so if you don't provide an output path, |
645
|
|
|
|
|
|
|
# you won't get the method pod |
646
|
0
|
0
|
|
|
|
|
if ( $options{'output-path'} ) { |
647
|
0
|
|
|
|
|
|
my $method_pod_file = sprintf '%s/%s/%s.pm', $options{'output-path'}, |
648
|
|
|
|
|
|
|
$package_name, $method; |
649
|
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
|
my $fh = *STDOUT; |
651
|
|
|
|
|
|
|
|
652
|
0
|
0
|
|
|
|
|
if ( $options{'output-path'} ne $DASH ) { |
653
|
0
|
0
|
|
|
|
|
open $fh, '>', $method_pod_file |
654
|
|
|
|
|
|
|
or croak "could not open $method_pod_file for writing"; |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
|
657
|
0
|
|
|
|
|
|
print {$fh} render_template( $pod_stub, $parameters ); |
|
0
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
|
659
|
0
|
|
|
|
|
|
close $fh; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('methods') } = join "\n", @pod; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('operations') } = Dumper $operations; |
667
|
|
|
|
|
|
|
|
668
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('shapes') } = Dumper $shapes; |
669
|
|
|
|
|
|
|
|
670
|
0
|
|
|
|
|
|
$parameters->{ to_template_var('paginators') } = Dumper $paginators; |
671
|
|
|
|
|
|
|
|
672
|
0
|
0
|
|
|
|
|
if ( !$options{pod} ) { |
673
|
0
|
|
|
|
|
|
$template =~ s/^\@end.*\z//xsm; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
0
|
|
|
|
|
|
return render_template( $template, $parameters ); |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
######################################################################## |
680
|
|
|
|
|
|
|
sub get_api_descriptions { |
681
|
|
|
|
|
|
|
######################################################################## |
682
|
0
|
|
|
0
|
0
|
|
goto &get_service_descriptions; |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
######################################################################## |
686
|
|
|
|
|
|
|
sub get_service_descriptions { |
687
|
|
|
|
|
|
|
######################################################################## |
688
|
0
|
|
|
0
|
0
|
|
my @services = @_; |
689
|
|
|
|
|
|
|
|
690
|
0
|
|
|
|
|
|
my @descriptions; |
691
|
|
|
|
|
|
|
|
692
|
0
|
0
|
|
|
|
|
if ( !@services ) { |
693
|
0
|
|
|
|
|
|
@services = sort keys %BOTO_SERVICES; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
0
|
|
|
|
|
|
foreach my $s ( map {lc} @services ) { |
|
0
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
croak "no such service: $s\n" |
699
|
0
|
0
|
|
|
|
|
if !$BOTO_SERVICES{$s}; |
700
|
|
|
|
|
|
|
|
701
|
0
|
|
|
|
|
|
my @path = @{ $BOTO_SERVICES{$s}->{path} }; |
|
0
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
|
703
|
0
|
|
|
0
|
|
|
my $boto_path = first_index {/botocore/xsm} @path; |
|
0
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
|
705
|
0
|
0
|
|
|
|
|
if ( $boto_path < 0 ) { |
706
|
0
|
|
|
|
|
|
croak 'no botocore in path ' . $BOTO_SERVICES{$s}->{path}; |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
my $service_path = join $SLASH, @path[ 0 .. $boto_path + 2 ], $s, |
710
|
0
|
|
|
|
|
|
$BOTO_SERVICES{$s}->{date}; |
711
|
|
|
|
|
|
|
|
712
|
0
|
|
|
|
|
|
my $service_file = "$service_path/service-2.json"; |
713
|
0
|
|
|
|
|
|
my $paginators_file = "$service_path/paginators-1.json"; |
714
|
|
|
|
|
|
|
|
715
|
0
|
|
|
|
|
|
my $paginators = fetch_paginators($paginators_file); |
716
|
|
|
|
|
|
|
|
717
|
0
|
|
|
|
|
|
my $service_description = fetch_service_description($service_file); |
718
|
|
|
|
|
|
|
|
719
|
0
|
0
|
|
|
|
|
if ( $service_description->{operations} ) { |
720
|
0
|
|
|
|
|
|
my $operations = $service_description->{operations}; |
721
|
0
|
|
|
|
|
|
my $shapes = $service_description->{shapes}; |
722
|
0
|
|
|
|
|
|
my $metadata = $service_description->{metadata}; |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
my $service_name |
725
|
0
|
|
0
|
|
|
|
= $metadata->{signingName} || $metadata->{endpointPrefix}; |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
push @descriptions, |
728
|
|
|
|
|
|
|
{ |
729
|
|
|
|
|
|
|
$s => { |
730
|
0
|
|
|
|
|
|
actions => [ keys %{$operations} ], |
731
|
|
|
|
|
|
|
documentation => $service_description->{documentation}, |
732
|
|
|
|
|
|
|
endpoint_prefix => $metadata->{endpointPrefix}, |
733
|
|
|
|
|
|
|
json_version => $metadata->{jsonVersion}, |
734
|
|
|
|
|
|
|
metadata => $metadata, |
735
|
0
|
|
|
|
|
|
metadata_keys => [ keys %{$metadata} ], |
736
|
|
|
|
|
|
|
operations => $operations, |
737
|
|
|
|
|
|
|
paginators => $paginators, |
738
|
|
|
|
|
|
|
protocol => $metadata->{protocol}, |
739
|
|
|
|
|
|
|
service_name => $service_name, |
740
|
|
|
|
|
|
|
shapes => $shapes, |
741
|
|
|
|
|
|
|
target_prefix => $metadata->{targetPrefix}, |
742
|
|
|
|
|
|
|
version => $BOTO_SERVICES{$s}->{date}, |
743
|
|
|
|
|
|
|
} |
744
|
0
|
|
|
|
|
|
}; |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
|
748
|
0
|
|
|
|
|
|
return \@descriptions; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
######################################################################## |
752
|
|
|
|
|
|
|
sub fetch_boto_services { |
753
|
|
|
|
|
|
|
######################################################################## |
754
|
0
|
|
|
0
|
0
|
|
my ($path) = @_; |
755
|
|
|
|
|
|
|
|
756
|
0
|
0
|
|
|
|
|
if ( !-d "$path/botocore" ) { |
757
|
0
|
|
|
|
|
|
croak <<"END_OF_CROAKING"; |
758
|
|
|
|
|
|
|
!!! No $path/botocore directory found. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
In order to create stubs or shapes you must clone the Botocore project |
761
|
|
|
|
|
|
|
and provide the path to the project using the -b option or by setting |
762
|
|
|
|
|
|
|
the environment variable BOTOCORE_PATH. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
git clone https::/github.com/boto/botocore.git /tmp/botocore |
765
|
|
|
|
|
|
|
export BOTOCORE_PATH=/tmp/botocore |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
END_OF_CROAKING |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
0
|
|
|
|
|
|
find( { wanted => \&find_latest_services, follow => $TRUE }, $path ); |
771
|
|
|
|
|
|
|
|
772
|
0
|
0
|
|
|
|
|
if ( !keys %BOTO_SERVICES ) { |
773
|
0
|
|
|
|
|
|
croak 'no services found in path ' . $path; |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
0
|
|
|
|
|
|
return keys %BOTO_SERVICES; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
######################################################################## |
780
|
|
|
|
|
|
|
sub extra_args { |
781
|
|
|
|
|
|
|
######################################################################## |
782
|
0
|
|
|
0
|
0
|
|
my (%options) = @_; |
783
|
|
|
|
|
|
|
|
784
|
0
|
|
|
|
|
|
return shift @{ $options{'extra-args'} }; |
|
0
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
######################################################################## |
788
|
|
|
|
|
|
|
sub dump_service { |
789
|
|
|
|
|
|
|
######################################################################## |
790
|
0
|
|
|
0
|
0
|
|
my (%options) = @_; |
791
|
|
|
|
|
|
|
|
792
|
0
|
|
|
|
|
|
fetch_boto_services( $options{'botocore-path'} ); |
793
|
|
|
|
|
|
|
|
794
|
0
|
|
0
|
|
|
|
my $service = extra_args(%options) // $options{'service'}; |
795
|
|
|
|
|
|
|
|
796
|
0
|
0
|
|
|
|
|
croak 'no service specified' |
797
|
|
|
|
|
|
|
if !$service; |
798
|
|
|
|
|
|
|
|
799
|
0
|
0
|
|
|
|
|
my @services = $service eq 'all' ? keys %BOTO_SERVICES : $service; |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
|
|
|
my $description = get_api_descriptions(@services); |
802
|
|
|
|
|
|
|
|
803
|
0
|
|
|
|
|
|
print JSON->new->pretty->encode( $description->[0] ); |
804
|
|
|
|
|
|
|
|
805
|
0
|
|
|
|
|
|
return $TRUE; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
######################################################################## |
809
|
|
|
|
|
|
|
sub create_stub { |
810
|
|
|
|
|
|
|
######################################################################## |
811
|
0
|
|
|
0
|
0
|
|
my (%options) = @_; |
812
|
|
|
|
|
|
|
|
813
|
0
|
|
|
|
|
|
fetch_boto_services( $options{'botocore-path'} ); |
814
|
|
|
|
|
|
|
|
815
|
0
|
|
|
|
|
|
my ( $service, $module_name ) = @options{qw( service module-name)}; |
816
|
|
|
|
|
|
|
|
817
|
0
|
|
|
|
|
|
$service = lc $service; |
818
|
|
|
|
|
|
|
|
819
|
0
|
|
|
|
|
|
my $package_name = sprintf 'Amazon::API::%s', $module_name; |
820
|
|
|
|
|
|
|
|
821
|
0
|
0
|
|
|
|
|
croak 'no service specified' |
822
|
|
|
|
|
|
|
if !$service; |
823
|
|
|
|
|
|
|
|
824
|
0
|
|
|
|
|
|
my $description = get_api_descriptions($service); |
825
|
|
|
|
|
|
|
|
826
|
0
|
|
|
|
|
|
my $parameters = $description->[0]->{$service}; |
827
|
0
|
|
|
|
|
|
$parameters->{'package_name'} = $package_name; |
828
|
|
|
|
|
|
|
|
829
|
0
|
|
|
|
|
|
my @actions = @{ $parameters->{'actions'} }; |
|
0
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
|
831
|
0
|
|
|
|
|
|
$parameters->{'actions'} = $PADDING . join "\n ", sort @actions; |
832
|
|
|
|
|
|
|
|
833
|
0
|
0
|
|
|
|
|
if ( $parameters->{'protocol'} eq 'rest-json' ) { |
834
|
0
|
|
|
|
|
|
foreach (@actions) { |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
$parameters->{'service'} |
839
|
0
|
|
0
|
|
|
|
= $parameters->{'service_name'} || $parameters->{'endpoint_prefix'}; |
840
|
|
|
|
|
|
|
|
841
|
0
|
0
|
|
|
|
|
if ( $parameters->{'protocol'} eq 'query' ) { |
842
|
0
|
|
|
|
|
|
$parameters->{'content_type'} = 'application/x-www-form-urlencoded'; |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
|
845
|
0
|
0
|
|
|
|
|
if ( $parameters->{'protocol'} eq 'json' ) { |
846
|
|
|
|
|
|
|
$parameters->{'content_type'} |
847
|
0
|
|
|
|
|
|
= 'application/x-amz-json-' . $parameters->{'json_version'}; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
# for rest-json protocol we need a method and and a query uri in |
851
|
|
|
|
|
|
|
# addition to the payload |
852
|
0
|
0
|
|
|
|
|
if ( $parameters->{'protocol'} eq 'rest-json' ) { |
853
|
0
|
|
|
|
|
|
$parameters->{'content_type'} = 'application/json'; |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
0
|
|
|
|
|
|
my @template_vars = qw( |
857
|
|
|
|
|
|
|
actions |
858
|
|
|
|
|
|
|
botocore_metadata |
859
|
|
|
|
|
|
|
botocore_operation |
860
|
|
|
|
|
|
|
content_type |
861
|
|
|
|
|
|
|
endpoint_prefix |
862
|
|
|
|
|
|
|
package_name |
863
|
|
|
|
|
|
|
protocol |
864
|
|
|
|
|
|
|
service |
865
|
|
|
|
|
|
|
target_prefix |
866
|
|
|
|
|
|
|
version |
867
|
|
|
|
|
|
|
); |
868
|
|
|
|
|
|
|
|
869
|
0
|
|
|
|
|
|
foreach my $var (@template_vars) { |
870
|
0
|
|
|
|
|
|
$parameters->{ to_template_var($var) } = $parameters->{$var}; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
0
|
|
|
|
|
|
my $module = render_stub( |
874
|
|
|
|
|
|
|
service => $service, |
875
|
|
|
|
|
|
|
template => fetch_template( *DATA, $TEMPLATE_START ), |
876
|
|
|
|
|
|
|
parameters => $parameters, |
877
|
|
|
|
|
|
|
options => \%options, |
878
|
|
|
|
|
|
|
); |
879
|
|
|
|
|
|
|
|
880
|
0
|
0
|
0
|
|
|
|
if ( $options{'tidy'} && eval { require Perl::Tidy; } ) { |
|
0
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
|
882
|
0
|
|
|
|
|
|
my $tidy_module = $EMPTY; |
883
|
|
|
|
|
|
|
|
884
|
0
|
0
|
|
|
|
|
if ( |
885
|
|
|
|
|
|
|
Perl::Tidy::perltidy( |
886
|
|
|
|
|
|
|
argv => [], |
887
|
|
|
|
|
|
|
source => \$module, |
888
|
|
|
|
|
|
|
destination => \$tidy_module, |
889
|
|
|
|
|
|
|
) |
890
|
|
|
|
|
|
|
) { |
891
|
0
|
|
|
|
|
|
croak 'could not tidy module!'; |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
|
894
|
0
|
|
|
|
|
|
$module = $tidy_module; |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
|
897
|
0
|
|
|
|
|
|
my $file = $options{file}; |
898
|
|
|
|
|
|
|
|
899
|
0
|
0
|
0
|
|
|
|
if ( !$file && $options{'output-path'} ) { |
900
|
0
|
|
|
|
|
|
my $path = sprintf '%s/Amazon/API', $options{'output-path'}; |
901
|
|
|
|
|
|
|
|
902
|
0
|
0
|
|
|
|
|
if ( !-d $path ) { |
903
|
0
|
0
|
|
|
|
|
croak "could not create $path" |
904
|
|
|
|
|
|
|
if !make_path $path; |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
|
907
|
0
|
|
|
|
|
|
$file = sprintf '%s/%s.pm', $path, $module_name; |
908
|
|
|
|
|
|
|
|
909
|
0
|
0
|
|
|
|
|
if ( -e $file ) { |
910
|
0
|
|
|
|
|
|
rename $file, "$file.bak"; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
0
|
|
|
|
|
|
my $fh = eval { |
915
|
0
|
0
|
|
|
|
|
if ($file) { |
916
|
0
|
0
|
|
|
|
|
open my $handle, '>', $file |
917
|
|
|
|
|
|
|
or croak 'could not open ' . $file; |
918
|
|
|
|
|
|
|
|
919
|
0
|
|
|
|
|
|
return $handle; |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
else { |
922
|
0
|
|
|
|
|
|
return *STDOUT; |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
}; |
925
|
|
|
|
|
|
|
|
926
|
0
|
|
|
|
|
|
print {$fh} $module; |
|
0
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
|
928
|
0
|
0
|
|
|
|
|
close $fh |
929
|
|
|
|
|
|
|
or croak 'could close file'; |
930
|
|
|
|
|
|
|
|
931
|
0
|
|
|
|
|
|
return $TRUE; |
932
|
|
|
|
|
|
|
} |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
######################################################################## |
935
|
|
|
|
|
|
|
sub format_columns { |
936
|
|
|
|
|
|
|
######################################################################## |
937
|
0
|
|
|
0
|
0
|
|
my (%args) = @_; |
938
|
|
|
|
|
|
|
|
939
|
0
|
|
|
|
|
|
my $text = $args{text}; |
940
|
|
|
|
|
|
|
|
941
|
0
|
|
0
|
|
|
|
my $padding = $args{padding} // 2; |
942
|
0
|
|
|
|
|
|
my $column_width = $args{'column-width'}; |
943
|
|
|
|
|
|
|
|
944
|
0
|
0
|
|
|
|
|
my $indent = $args{indent} ? $SPACE x $args{indent} : $EMPTY; |
945
|
|
|
|
|
|
|
|
946
|
0
|
|
|
|
|
|
my $max_width = max map {length} @{$text}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
|
948
|
0
|
|
|
|
|
|
my $width = $args{width}; # width of canvas |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
# format for screen by default |
951
|
0
|
0
|
|
|
|
|
if ( !$width ) { |
952
|
0
|
|
|
|
|
|
require Term::ReadKey; |
953
|
|
|
|
|
|
|
|
954
|
0
|
|
|
|
|
|
Term::ReadKey->import('GetTerminalSize'); |
955
|
|
|
|
|
|
|
|
956
|
0
|
|
|
|
|
|
($width) = eval { GetTerminalSize() }; |
|
0
|
|
|
|
|
|
|
957
|
0
|
|
0
|
|
|
|
$width //= 80; |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
|
960
|
0
|
0
|
|
|
|
|
if ( !$column_width ) { |
961
|
0
|
|
|
|
|
|
$column_width = 2 + $max_width; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
0
|
|
|
|
|
|
my $columns = int $width / $column_width; |
965
|
|
|
|
|
|
|
|
966
|
0
|
|
|
|
|
|
my @formatted_text = map { sprintf "%-${column_width}s", $_; } @{$text}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
|
968
|
0
|
|
|
|
|
|
my $output = $EMPTY; |
969
|
|
|
|
|
|
|
|
970
|
0
|
|
|
|
|
|
while (@formatted_text) { |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
$output .= sprintf "%s%s\n", $indent, join $EMPTY, |
973
|
0
|
|
|
|
|
|
grep {defined} @formatted_text[ ( 0 .. $columns - 1 ) ]; |
|
0
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
|
975
|
0
|
|
|
|
|
|
shift @formatted_text for 0 .. $columns - 1; |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
|
978
|
0
|
|
|
|
|
|
return $output; |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
######################################################################## |
982
|
|
|
|
|
|
|
sub help { |
983
|
|
|
|
|
|
|
######################################################################## |
984
|
0
|
|
|
0
|
0
|
|
my (%options) = @_; |
985
|
|
|
|
|
|
|
|
986
|
0
|
|
|
|
|
|
my (@args) = @ARGV; |
987
|
|
|
|
|
|
|
|
988
|
0
|
|
|
|
|
|
my $token; |
989
|
|
|
|
|
|
|
|
990
|
0
|
0
|
|
|
|
|
if ( $options{pager} ) { |
991
|
0
|
|
|
|
|
|
$token = eval { |
992
|
0
|
|
|
|
|
|
require IO::Pager; |
993
|
|
|
|
|
|
|
|
994
|
0
|
|
|
|
|
|
IO::Pager::open( *STDOUT, '|-:utf8', 'Unbuffered' ); |
995
|
|
|
|
|
|
|
}; |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
return pod |
999
|
0
|
0
|
0
|
|
|
|
if !@args && !$options{service}; |
1000
|
|
|
|
|
|
|
|
1001
|
0
|
|
|
|
|
|
my $service = $options{'service'}; |
1002
|
|
|
|
|
|
|
|
1003
|
0
|
|
|
|
|
|
my $module; |
1004
|
|
|
|
|
|
|
|
1005
|
0
|
0
|
0
|
|
|
|
if ( @args == 2 ) { |
|
|
0
|
|
|
|
|
|
1006
|
0
|
|
|
|
|
|
( $service, $module ) = @args; |
1007
|
|
|
|
|
|
|
} |
1008
|
|
|
|
|
|
|
elsif ( @args == 1 && $service ) { |
1009
|
0
|
|
|
|
|
|
$module = $args[0]; |
1010
|
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
else { |
1012
|
0
|
|
|
|
|
|
fetch_boto_services( $options{'botocore-path'} ); |
1013
|
|
|
|
|
|
|
|
1014
|
0
|
|
0
|
|
|
|
$options{service} //= 'all'; |
1015
|
|
|
|
|
|
|
|
1016
|
0
|
0
|
|
|
|
|
if ( $options{service} eq 'all' ) { |
1017
|
|
|
|
|
|
|
return |
1018
|
0
|
|
|
|
|
|
print {*STDOUT} |
|
0
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
format_columns( text => [ sort keys %BOTO_SERVICES ] ); |
1020
|
|
|
|
|
|
|
} |
1021
|
|
|
|
|
|
|
else { |
1022
|
0
|
|
|
|
|
|
my $description = get_service_descriptions( lc $options{service} ); |
1023
|
|
|
|
|
|
|
my $operations |
1024
|
0
|
|
|
|
|
|
= $description->[0]->{ lc $options{service} }->{operations}; |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
my $documentation |
1027
|
0
|
|
|
|
|
|
= $description->[0]->{ lc $options{service} }->{documentation}; |
1028
|
|
|
|
|
|
|
|
1029
|
0
|
|
|
|
|
|
$documentation = html2pod $documentation ; |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
my $available_commands |
1032
|
0
|
|
|
|
|
|
= format_columns( indent => 1, text => [ sort keys %{$operations} ] ); |
|
0
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
my %parameters = ( |
1035
|
|
|
|
|
|
|
to_template_var('service') => $options{service}, |
1036
|
0
|
|
|
|
|
|
to_template_var('documentation') => $documentation, |
1037
|
|
|
|
|
|
|
to_template_var('available_commands') => $available_commands, |
1038
|
|
|
|
|
|
|
); |
1039
|
|
|
|
|
|
|
|
1040
|
0
|
|
|
|
|
|
my $help_text = <<'HELP'; |
1041
|
|
|
|
|
|
|
=pod |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
=encoding utf8 |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=head1 NAME |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
@service@ |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
@documentation@ |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
=head1 AVAILABLE COMMANDS |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
@available_commands@ |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=cut |
1058
|
|
|
|
|
|
|
HELP |
1059
|
0
|
|
|
|
|
|
my $pod = render_template( $help_text, \%parameters ); |
1060
|
|
|
|
|
|
|
|
1061
|
0
|
|
|
|
|
|
my $pod_parser = Pod::Text->new; |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
# yes, this outputs to STDOUT |
1064
|
0
|
|
|
|
|
|
return $pod_parser->parse_string_document($pod); |
1065
|
|
|
|
|
|
|
} |
1066
|
|
|
|
|
|
|
} |
1067
|
|
|
|
|
|
|
|
1068
|
0
|
0
|
|
|
|
|
croak 'no service specified' |
1069
|
|
|
|
|
|
|
if !$service; |
1070
|
|
|
|
|
|
|
|
1071
|
0
|
|
|
|
|
|
my $service_name = create_module_name($service); |
1072
|
|
|
|
|
|
|
|
1073
|
0
|
|
|
|
|
|
my $class = sprintf 'Amazon::API::Botocore::Shape::%s::%s', |
1074
|
|
|
|
|
|
|
$service_name, $module; |
1075
|
|
|
|
|
|
|
|
1076
|
0
|
|
|
|
|
|
print {*STDOUT} "$class\n"; |
|
0
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
|
1078
|
0
|
|
|
|
|
|
my $file; |
1079
|
|
|
|
|
|
|
# try -s service or |
1080
|
0
|
|
|
|
|
|
for (qw($service_name $service)) { |
1081
|
0
|
|
|
|
|
|
$file = require_class($class); |
1082
|
0
|
0
|
|
|
|
|
last if $file; |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
|
1085
|
0
|
0
|
0
|
|
|
|
if ( !$file || !-e $file ) { |
1086
|
|
|
|
|
|
|
|
1087
|
0
|
|
|
|
|
|
$file = require_class( sprintf 'Amazon::API::%s::%s', $service_name, |
1088
|
|
|
|
|
|
|
$module ); |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
0
|
|
|
|
|
|
$module = undef; |
1092
|
|
|
|
|
|
|
|
1093
|
0
|
0
|
0
|
|
|
|
croak "no pod available\n" |
1094
|
|
|
|
|
|
|
if !$file || !-e $file; |
1095
|
|
|
|
|
|
|
|
1096
|
0
|
|
|
|
|
|
my $pod = get_pod_section $file; |
1097
|
|
|
|
|
|
|
|
1098
|
0
|
|
|
|
|
|
print {*STDOUT} "$pod\n"; |
|
0
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
|
1100
|
0
|
|
|
|
|
|
return $EMPTY; |
1101
|
|
|
|
|
|
|
} |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
######################################################################## |
1104
|
|
|
|
|
|
|
sub main { |
1105
|
|
|
|
|
|
|
######################################################################## |
1106
|
|
|
|
|
|
|
my %options = ( |
1107
|
0
|
|
0
|
0
|
0
|
|
'botocore-path' => $ENV{BOTOCORE_PATH} || getcwd, |
1108
|
|
|
|
|
|
|
tidy => $TRUE, |
1109
|
|
|
|
|
|
|
pod => $TRUE, |
1110
|
|
|
|
|
|
|
pager => $TRUE, |
1111
|
|
|
|
|
|
|
'output-path' => getcwd, |
1112
|
|
|
|
|
|
|
); |
1113
|
|
|
|
|
|
|
|
1114
|
0
|
0
|
|
|
|
|
if ( $ENV{DEBUG} ) { |
1115
|
0
|
|
|
|
|
|
print {*STDERR} Dumper( \@ARGV ); |
|
0
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
|
1118
|
0
|
|
|
|
|
|
my @option_defs = qw( |
1119
|
|
|
|
|
|
|
botocore-path|b=s |
1120
|
|
|
|
|
|
|
help|h |
1121
|
|
|
|
|
|
|
module-name|m=s |
1122
|
|
|
|
|
|
|
output-path|o=s |
1123
|
|
|
|
|
|
|
service|s=s |
1124
|
|
|
|
|
|
|
tidy|t! |
1125
|
|
|
|
|
|
|
pod|p! |
1126
|
|
|
|
|
|
|
pager|P! |
1127
|
|
|
|
|
|
|
); |
1128
|
|
|
|
|
|
|
|
1129
|
0
|
|
|
|
|
|
GetOptions( \%options, @option_defs ); |
1130
|
|
|
|
|
|
|
|
1131
|
0
|
|
|
|
|
|
$options{'command'} = shift @ARGV; |
1132
|
0
|
|
|
|
|
|
$options{'extra-args'} = \@ARGV; |
1133
|
|
|
|
|
|
|
|
1134
|
0
|
0
|
0
|
|
|
|
if ( $options{'help'} || !$options{'command'} ) { |
1135
|
0
|
|
|
|
|
|
$options{'command'} = 'help'; |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
|
1138
|
0
|
0
|
0
|
|
|
|
if ( !$options{'module-name'} && $options{'service'} ) { |
1139
|
0
|
|
|
|
|
|
$options{'module-name'} = create_module_name( $options{'service'} ); |
1140
|
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
|
1142
|
0
|
0
|
|
|
|
|
if ( $options{'output-path'} eq $DASH ) { |
1143
|
0
|
|
|
|
|
|
delete $options{'output-path'}; |
1144
|
|
|
|
|
|
|
} |
1145
|
|
|
|
|
|
|
|
1146
|
0
|
0
|
|
|
|
|
if ( $options{command} ne 'help' ) { |
1147
|
0
|
0
|
0
|
|
|
|
if ( $options{'output-path'} && $options{'output-path'} =~ /^[.]/xsm ) { |
|
|
0
|
0
|
|
|
|
|
1148
|
0
|
|
|
|
|
|
my $cwd = getcwd; |
1149
|
|
|
|
|
|
|
|
1150
|
0
|
|
|
|
|
|
$options{'output-path'} =~ s/^[.]/$cwd/xsm; |
1151
|
|
|
|
|
|
|
} |
1152
|
|
|
|
|
|
|
elsif ( $options{'output-path'} && $options{'module-name'} ) { |
1153
|
|
|
|
|
|
|
my $module_path = sprintf '%s/Amazon/API/%s', |
1154
|
0
|
|
|
|
|
|
@options{qw(output-path module-name)}; |
1155
|
|
|
|
|
|
|
|
1156
|
0
|
0
|
|
|
|
|
if ( !-d $module_path ) { |
1157
|
0
|
0
|
|
|
|
|
croak "could not create path: $module_path\n" |
1158
|
|
|
|
|
|
|
if !make_path $module_path; |
1159
|
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
|
} |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
|
1163
|
0
|
|
|
|
|
|
my %handlers = ( |
1164
|
|
|
|
|
|
|
'dump-service' => \&dump_service, |
1165
|
|
|
|
|
|
|
'dump' => \&dump_service, |
1166
|
|
|
|
|
|
|
'describe' => \&dump_service, |
1167
|
|
|
|
|
|
|
'create-stub' => \&create_stub, |
1168
|
|
|
|
|
|
|
'create-stubs' => \&create_stub, |
1169
|
|
|
|
|
|
|
'create-shapes' => \&create_service_shapes, |
1170
|
|
|
|
|
|
|
'create-shape' => \&create_service_shapes, |
1171
|
|
|
|
|
|
|
'help' => \&help, |
1172
|
|
|
|
|
|
|
); |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
croak sprintf 'not a valid command [%s]', $options{'command'} |
1175
|
0
|
0
|
|
|
|
|
if !$handlers{ $options{'command'} }; |
1176
|
|
|
|
|
|
|
|
1177
|
0
|
|
|
|
|
|
exit !$handlers{ $options{'command'} }->(%options); |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
1; |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
__DATA__ |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
package @package_name@; |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
# Autogenerated by @program_name@ @program_version@ at @timestamp@ |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
use strict; |
1189
|
|
|
|
|
|
|
use warnings; |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
use parent qw( Amazon::API ); |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
our @API_METHODS = qw( |
1194
|
|
|
|
|
|
|
@actions@ |
1195
|
|
|
|
|
|
|
); |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
our $VERSION = '2.0.11'; |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
sub new { |
1200
|
|
|
|
|
|
|
my ( $class, @options ) = @_; |
1201
|
|
|
|
|
|
|
$class = ref($class) || $class; |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
my %options = ref $options[0] ? %{ $options[0] } : @options; |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
my $self = $class->SUPER::new( |
1206
|
|
|
|
|
|
|
{ service => '@service@', |
1207
|
|
|
|
|
|
|
endpoint_prefix => '@endpoint_prefix@', |
1208
|
|
|
|
|
|
|
version => '@version@', |
1209
|
|
|
|
|
|
|
target_prefix => '@target_prefix@', |
1210
|
|
|
|
|
|
|
api_methods => \@API_METHODS, |
1211
|
|
|
|
|
|
|
content_type => '@content_type@', |
1212
|
|
|
|
|
|
|
botocore_metadata => @metadata@, |
1213
|
|
|
|
|
|
|
botocore_operations => @operations@, |
1214
|
|
|
|
|
|
|
botocore_shapes => @shapes@, |
1215
|
|
|
|
|
|
|
debug => $ENV{DEBUG} // 0, |
1216
|
|
|
|
|
|
|
decode_always => 1, |
1217
|
|
|
|
|
|
|
paginators => @paginators@, |
1218
|
|
|
|
|
|
|
%options |
1219
|
|
|
|
|
|
|
} |
1220
|
|
|
|
|
|
|
); |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
# global services should be signed with us-east-1 region |
1223
|
|
|
|
|
|
|
if ( defined $self->get_botocore_metadata->{'globalEndpoint'} ) { |
1224
|
|
|
|
|
|
|
$self->set_region('us-east-1'); |
1225
|
|
|
|
|
|
|
} |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
return $self; |
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
1; |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
@end@ |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
=pod |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
=encoding utf8 |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
=head1 NAME |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
@package_name@ |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
@description@ |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
=head1 VERSION |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
Version @program_version@ |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
=head1 METHODS AND SUBROUTINES |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
@methods@ |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
=head1 NOTES |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
Autogenerated by @program_name@ at @timestamp@ |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
This module is free software it may be used, redistributed and/or |
1261
|
|
|
|
|
|
|
modified under the same terms as Perl itself. |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
=cut |