File Coverage

blib/lib/Amazon/API/Botocore.pm
Criterion Covered Total %
statement 84 503 16.7
branch 1 152 0.6
condition 0 112 0.0
subroutine 27 46 58.7
pod 0 17 0.0
total 112 830 13.4


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