File Coverage

blib/lib/Perinci/Sub/GetArgs/Argv.pm
Criterion Covered Total %
statement 436 460 94.7
branch 189 232 81.4
condition 99 132 75.0
subroutine 30 31 96.7
pod 2 2 100.0
total 756 857 88.2


line stmt bran cond sub pod time code
1             package Perinci::Sub::GetArgs::Argv;
2              
3 3     3   242854 use 5.010001;
  3         42  
4 3     3   17 use strict;
  3         5  
  3         58  
5 3     3   13 use warnings;
  3         9  
  3         82  
6             #use Log::Any '$log';
7              
8 3     3   978 use Data::Sah::Normalize qw(normalize_schema);
  3         3086  
  3         202  
9 3     3   1585 use Data::Sah::Util::Type qw(is_type is_simple);
  3         3430  
  3         227  
10 3     3   1429 use Getopt::Long::Negate::EN qw(negations_for_option);
  3         2734  
  3         192  
11 3     3   1454 use Getopt::Long::Util qw(parse_getopt_long_opt_spec);
  3         10214  
  3         230  
12 3     3   23 use List::Util qw(first);
  3         8  
  3         310  
13 3     3   3395 use Perinci::Sub::GetArgs::Array qw(get_args_from_array);
  3         2278  
  3         190  
14 3     3   1689 use Perinci::Sub::Util qw(err);
  3         7608  
  3         301  
15              
16             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
17             our $DATE = '2022-12-01'; # DATE
18             our $DIST = 'Perinci-Sub-GetArgs-Argv'; # DIST
19             our $VERSION = '0.849_001'; # TRIAL VERSION
20              
21 3     3   28 use Exporter;
  3         8  
  3         705  
22             our @ISA = qw(Exporter);
23             our @EXPORT_OK = qw(
24             gen_getopt_long_spec_from_meta
25             get_args_from_argv
26             );
27              
28             our %SPEC;
29              
30             $SPEC{':package'} = {
31             v => 1.1,
32             summary => 'Get subroutine arguments from command line arguments (@ARGV)',
33             };
34              
35             # retun ($success?, $errmsg, $res)
36             sub _parse_json {
37 3     3   8 my $str = shift;
38              
39 3         8 state $json = do {
40 1         804 require JSON::PP;
41 1         15247 JSON::PP->new->allow_nonref;
42             };
43              
44             # to rid of those JSON::PP::Boolean objects which currently choke
45             # Data::Sah-generated validator code. in the future Data::Sah can be
46             # modified to handle those, or we use a fork of JSON::PP which doesn't
47             # produce those in the first place (probably only when performance is
48             # critical).
49 3         76 state $cleanser = do {
50 1 50       8 if (eval { require Data::Clean::FromJSON; 1 }) {
  1         640  
  1         6000  
51 1         9 Data::Clean::FromJSON->get_cleanser;
52             } else {
53 0         0 undef;
54             }
55             };
56              
57 3         1932 my $res;
58 3 50       7 eval { $res = $json->decode($str); $cleanser->clean_in_place($res) if $cleanser };
  3         13  
  1         144  
59 3         868 my $e = $@;
60 3         16 return (!$e, $e, $res);
61             }
62              
63             sub _parse_yaml {
64 3     3   32 no warnings 'once';
  3         20  
  3         15941  
65              
66 3     3   6 state $yaml_xs_available = do {
67 1 50       3 if (eval { require YAML::XS; 1 }) {
  1         6  
  1         7  
68 1         3 1;
69             } else {
70 0         0 require YAML::Old;
71 0         0 0;
72             }
73             };
74              
75 3         7 my $str = shift;
76              
77             #local $YAML::Syck::ImplicitTyping = 1;
78 3         8 my $res;
79 3         4 eval {
80 3 50       20 if ($yaml_xs_available) {
81 3         218 $res = YAML::XS::Load($str);
82             } else {
83             # YAML::Old is too strict, it requires "--- " header and newline
84             # ending
85 0 0       0 $str = "--- $str" unless $str =~ /\A--- /;
86 0 0       0 $str .= "\n" unless $str =~ /\n\z/;
87 0         0 $res = YAML::Old::Load($str);
88             }
89             };
90 3         15 my $e = $@;
91 3         19 return (!$e, $e, $res);
92             }
93              
94             sub _arg2opt {
95 234     234   392 my $opt = shift;
96 234         615 $opt =~ s/[^A-Za-z0-9-]+/-/g; # foo.bar_baz becomes --foo-bar-baz
97 234         473 $opt;
98             }
99              
100             # this subroutine checks whether a schema mentions a coercion rule from simple
101             # types (e.g. 'str_comma_sep', etc).
102             sub _is_coercible_from_simple {
103 184     184   3739 my $nsch = shift;
104 184 50       399 my $clset = $nsch->[1] or return 0;
105 184 100 66     855 my $rules = $clset->{'x.perl.coerce_rules'} // $clset->{'x.coerce_rules'}
106             or return 0;
107 2         6 for my $rule (@$rules) {
108 2 50       24 next unless $rule =~ /\A([^_]+)_/;
109 2 50       25 return 1 if is_simple($1);
110             }
111 0         0 0;
112             }
113              
114             sub _is_simple_or_coercible_from_simple {
115 541     541   799 my $nsch = shift;
116 541 100       1021 is_simple($nsch) || _is_coercible_from_simple($nsch);
117             }
118              
119             # this routine's job is to avoid using Data::Sah::Resolve unless it needs to, to
120             # reduce startup overhead
121             sub _is_simple_or_array_of_simple_or_hash_of_simple {
122 442     442   92586 my $nsch = shift;
123              
124 442         655 my $is_simple = 0;
125 442         611 my $is_array_of_simple = 0;
126 442         625 my $is_hash_of_simple = 0;
127 442         652 my $eltype;
128              
129 442         766 my $type = $nsch->[0];
130 442         625 my $clset = $nsch->[1];
131              
132             {
133             # if not known as builtin type, then resolve it first
134 442 100       621 unless (is_type($nsch)) {
  442         971  
135 1         581 require Data::Sah::Resolve;
136 1         1483 my $res = Data::Sah::Resolve::resolve_schema(
137             {schema_is_normalized=>1}, $nsch);
138 1         21034 $type = $res->{type};
139 1   50     6 $clset = $res->{clsets_after_type}[0] // {};
140             }
141              
142 442         8406 $is_simple = _is_simple_or_coercible_from_simple([$type, $clset]);
143 442 100       6263 last if $is_simple;
144              
145 180 100       452 if ($type eq 'array') {
146 100   66     280 my $elnsch = $clset->{of} // $clset->{each_elem};
147 100 100       226 last unless $elnsch;
148 64         155 $elnsch = normalize_schema($elnsch);
149 64         2528 $eltype = $elnsch->[0];
150              
151             # if not known as builtin type, then resolve it first
152 64 100       151 unless (is_type($elnsch)) {
153 1         22 require Data::Sah::Resolve;
154 1         5 my $res = Data::Sah::Resolve::resolve_schema(
155             {schema_is_normalized=>1}, $elnsch);
156 1   50     290 $elnsch = [$res->{type}, $res->{clsets_after_type}[0] // {}]; # XXX we only take the first clause set
157 1         6 $eltype = $res->{type};
158             }
159              
160 64         1153 $is_array_of_simple = _is_simple_or_coercible_from_simple($elnsch);
161 64         1323 last;
162             }
163              
164 80 100       171 if ($type eq 'hash') {
165 79   66     272 my $elnsch = $clset->{of} // $clset->{each_value} // $clset->{each_elem};
      33        
166 79 100       165 last unless $elnsch;
167 35         90 $elnsch = normalize_schema($elnsch);
168 35         607 $eltype = $elnsch->[0];
169              
170             # if not known as builtin type, then resolve it first
171 35 100       81 unless (is_type($elnsch)) {
172 1         21 require Data::Sah::Resolve;
173 1         8 my $res = Data::Sah::Resolve::resolve_schema(
174             {schema_is_normalized=>1}, $elnsch);
175 1   50     293 $elnsch = [$res->{type}, $res->{clsets_after_type}[0] // {}]; # XXX we only take the first clause set
176 1         6 $eltype = $res->{type};
177             }
178              
179 35         607 $is_hash_of_simple = _is_simple_or_coercible_from_simple($elnsch);
180 35         687 last;
181             }
182             }
183              
184             #{ no warnings 'uninitialized'; say "D:$nsch->[0]: is_simple=<$is_simple>, is_array_of_simple=<$is_array_of_simple>, is_hash_of_simple=<$is_hash_of_simple>, type=<$type>, eltype=<$eltype>" };
185 442         1459 ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $clset, $eltype);
186             }
187              
188             # return one or more triplets of Getopt::Long option spec, its parsed structure,
189             # and extra stuffs. we do this to avoid having to call
190             # parse_getopt_long_opt_spec().
191             sub _opt2ospec {
192 224     224   461 my ($opt, $schema, $arg_spec) = @_;
193 224         374 my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $clset, $eltype) =
194             _is_simple_or_array_of_simple_or_hash_of_simple($schema);
195              
196 224         415 my (@opts, @types, @isaos, @ishos);
197              
198 224 100 100     709 if ($is_array_of_simple || $is_hash_of_simple) {
199 54         83 my $singular_opt;
200 54 100 100     184 if ($arg_spec && $arg_spec->{'x.name.is_plural'}) {
201 2 100       6 if ($arg_spec->{'x.name.singular'}) {
202 1         5 $singular_opt = _arg2opt($arg_spec->{'x.name.singular'});
203             } else {
204 1         1317 require Lingua::EN::PluralToSingular;
205 1         2188 $singular_opt = Lingua::EN::PluralToSingular::to_singular($opt);
206             }
207             } else {
208 52         92 $singular_opt = $opt;
209             }
210 54         127 push @opts , $singular_opt;
211 54         85 push @types, $eltype;
212 54 100       118 push @isaos, $is_array_of_simple ? 1:0;
213 54 100       105 push @ishos, $is_hash_of_simple ? 1:0;
214             }
215              
216 224 100 100     656 if ($is_simple || !@opts) {
217 170         320 push @opts , $opt;
218 170         256 push @types, $type;
219 170         282 push @isaos, 0;
220 170         246 push @ishos, 0;
221             }
222              
223 224         340 my @res;
224              
225 224         537 for my $i (0..$#opts) {
226 224         371 my $opt = $opts[$i];
227 224         330 my $type = $types[$i];
228 224         308 my $isaos = $isaos[$i];
229 224         327 my $ishos = $ishos[$i];
230              
231 224 100       573 if ($type eq 'bool') {
    100          
232 22 100 66     211 if (length $opt == 1) {
    100 33        
    100 66        
      33        
233             # single-letter option like -b doesn't get --nob.
234 4         19 push @res, ($opt, {opts=>[$opt]}), undef;
235             } elsif ($clset->{is} || $clset->{is_true}) {
236             # an always-true bool ('true' or [bool => {is=>1}] or
237             # [bool=>{is_true=>1}] also means it's a flag and should not get
238             # --nofoo.
239 2         23 push @res, ($opt, {opts=>[$opt]}), undef;
240             } elsif ((defined $clset->{is} && !$clset->{is}) ||
241             (defined $clset->{is_true} && !$clset->{is_true})) {
242             # an always-false bool ('false' or [bool => {is=>0}] or
243             # [bool=>{is_true=>0}] also means it's a flag and should only be
244             # getting --nofoo.
245 1         17 for (negations_for_option($opt)) {
246 2         24 push @res, $_, {opts=>[$_]}, {is_neg=>1, pos_opts=>[$opt]};
247             }
248             } else {
249             # a regular bool gets --foo as well as --nofoo
250 15         57 my @negs = negations_for_option($opt);
251 15         291 push @res, $opt, {opts=>[$opt]}, {is_neg=>0, neg_opts=>\@negs};
252 15         36 for (@negs) {
253 29         139 push @res, $_, {opts=>[$_]}, {is_neg=>1, pos_opts=>[$opt]};
254             }
255             }
256             } elsif ($type eq 'buf') {
257 3         37 push @res, (
258             "$opt=s", {opts=>[$opt], desttype=>"", type=>"s"}, undef,
259             "$opt-base64=s", {opts=>["$opt-base64"], desttype=>"", type=>"s"}, {is_base64=>1},
260             );
261             } else {
262 199 100       637 my $t = ($type eq 'int' ? 's' : $type eq 'float' ? 's' : 's') .
    100          
    100          
    100          
263             ($isaos ? '@' : $ishos ? '%' : '');
264 199         971 push @res, ("$opt=$t", {opts=>[$opt], desttype=>"", type=>$t}, undef);
265             }
266             }
267              
268 224         779 @res;
269             }
270              
271             sub _args2opts {
272 79     79   336 my %args = @_;
273              
274 79         137 my $argprefix = $args{argprefix};
275 79         125 my $parent_args = $args{parent_args};
276 79         129 my $meta = $args{meta};
277 79         130 my $seen_opts = $args{seen_opts};
278 79         117 my $seen_common_opts = $args{seen_common_opts};
279 79         131 my $seen_func_opts = $args{seen_func_opts};
280 79         109 my $rargs = $args{rargs};
281 79         127 my $go_spec = $args{go_spec};
282 79         114 my $specmeta = $args{specmeta};
283              
284 79   50     176 my $args_prop = $meta->{args} // {};
285              
286 79         221 for my $arg (keys %$args_prop) {
287 198         425 my $fqarg = "$argprefix$arg";
288 198 100       502 my $optlabel = "arg=$arg".($fqarg ne $arg ? ", fqarg=$fqarg":""); # written to %$seen_opts values
289 198         348 my $arg_spec = $args_prop->{$arg};
290 0 0       0 next if grep { $_ eq 'hidden' || $_ eq 'hidden-cli' }
291 198 50 50     272 @{ $arg_spec->{tags} // [] };
  198         871  
292 198   50     521 my $sch = $arg_spec->{schema} // ['any', {}];
293 198         404 my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $clset, $eltype) =
294             _is_simple_or_array_of_simple_or_hash_of_simple($sch);
295              
296             # XXX normalization of 'of' clause should've been handled by sah itself
297 198 100 100     561 if ($type eq 'array' && $clset->{of}) {
298 25         68 $clset->{of} = normalize_schema($clset->{of});
299             }
300 198         719 my $opt = _arg2opt($fqarg);
301 198 100       515 if ($seen_opts->{$opt}) {
302 3         6 my $i = 1;
303 3         6 my $opt2;
304 3         5 while (1) {
305 3 50       30 $opt2 = "$opt-arg" . ($i > 1 ? $i : '');
306 3 50       19 last unless $seen_opts->{$opt2};
307 0         0 $i++;
308             }
309 3         7 $opt = $opt2;
310             }
311              
312 198         318 my $stash = {};
313              
314             # why we use coderefs here? due to Getopt::Long's behavior. when
315             # @ARGV=qw() and go_spec is ('foo=s' => \$opts{foo}) then %opts will
316             # become (foo=>undef). but if go_spec is ('foo=s' => sub { $opts{foo} =
317             # $_[1] }) then %opts will become (), which is what we prefer, so we can
318             # later differentiate "unspecified" (exists($opts{foo}) == false) and
319             # "specified as undef" (exists($opts{foo}) == true but
320             # defined($opts{foo}) == false).
321              
322             my $handler = sub {
323 76     76   22029 my ($val, $val_set);
324              
325             # how many times have been called for this argument?
326 76         202 my $num_called = ++$stash->{called}{$arg};
327              
328             # hashify rargs till the end of the handler scope if it happens to
329             # be an array (this is the case when we want to fill values using
330             # element_meta).
331 76         118 my $rargs = do {
332 76 100       181 if (ref($rargs) eq 'ARRAY') {
333 5   100     28 $rargs->[$num_called-1] //= {};
334 5         9 $rargs->[$num_called-1];
335             } else {
336 71         127 $rargs;
337             }
338             };
339              
340 76 100       177 if ($is_array_of_simple) {
    100          
341 16   100     72 $rargs->{$arg} //= [];
342 16         26 $val_set = 1; $val = $_[1];
  16         141  
343 16         24 push @{ $rargs->{$arg} }, $val;
  16         41  
344             } elsif ($is_hash_of_simple) {
345 7   100     34 $rargs->{$arg} //= {};
346 7         10 $val_set = 1; $val = $_[2];
  7         13  
347 7         16 $rargs->{$arg}{$_[1]} = $val;
348             } else {
349 53         95 $val_set = 1; $val = $_[1];
  53         96  
350 53         108 $rargs->{$arg} = $val;
351             }
352 76 100 66     389 if ($val_set && $arg_spec->{cmdline_on_getopt}) {
353 5         23 $arg_spec->{cmdline_on_getopt}->(
354             arg=>$arg, fqarg=>$fqarg, value=>$val, args=>$rargs,
355             opt=>$opt,
356             );
357             }
358 198         1012 }; # handler
359              
360 198         483 my @triplets = _opt2ospec($opt, $sch, $arg_spec);
361 198         331 my $aliases_processed;
362 198         695 while (my ($ospec, $parsed, $extra) = splice @triplets, 0, 3) {
363 231         578 my $optlabel = $optlabel . ", spec=$ospec"; # note: redefine
364 231   100     792 $extra //= {};
365 231 100       647 if ($extra->{is_neg}) {
    100          
    100          
366 31     2   135 $go_spec->{$ospec} = sub { $handler->($_[0], 0) };
  2         946  
367             } elsif (defined $extra->{is_neg}) {
368 15     2   68 $go_spec->{$ospec} = sub { $handler->($_[0], 1) };
  2         585  
369             } elsif ($extra->{is_base64}) {
370             $go_spec->{$ospec} = sub {
371 1     1   1098 require MIME::Base64;
372 1         825 my $decoded = MIME::Base64::decode($_[1]);
373 1         4 $handler->($_[0], $decoded);
374 3         27 };
375             } else {
376 182         432 $go_spec->{$ospec} = $handler;
377             }
378              
379 231         874 $specmeta->{$ospec} = {arg=>$arg, fqarg=>$fqarg, parsed=>$parsed, %$extra};
380 231         371 for (@{ $parsed->{opts} }) {
  231         483  
381 231         419 $seen_opts->{$_} = $optlabel;
382 231         505 $seen_func_opts->{$_} = $fqarg;
383             }
384              
385 231 100 100     658 if ($parent_args->{per_arg_json} && !$is_simple) {
386 8         21 my $jopt = "$opt-json";
387 8 50       26 if ($seen_opts->{$jopt}) {
388 0         0 warn "Clash of option $jopt ($optlabel) vs existing ($seen_opts->{$jopt}), not added";
389             } else {
390 8         29 my $jospec = "$jopt=s";
391 8         25 my $parsed = {type=>"s", opts=>[$jopt]};
392             $go_spec->{$jospec} = sub {
393 1     1   301 my ($success, $e, $decoded);
394 1         7 ($success, $e, $decoded) = _parse_json($_[1]);
395 1 50       5 if ($success) {
396 1         4 $rargs->{$arg} = $decoded;
397             } else {
398 0         0 die "Invalid JSON in option --$jopt: $_[1]: $e";
399             }
400 8         61 };
401 8         38 $specmeta->{$jospec} = {arg=>$arg, fqarg=>$fqarg, is_json=>1, parsed=>$parsed, %$extra};
402 8         20 $seen_opts->{$jopt} = $optlabel;
403 8         22 $seen_func_opts->{$jopt} = $fqarg;
404             }
405             }
406 231 100 100     505 if ($parent_args->{per_arg_yaml} && !$is_simple) {
407 8         18 my $yopt = "$opt-yaml";
408 8 50       21 if ($seen_opts->{$yopt}) {
409 0         0 warn "Clash of option: $yopt ($optlabel) vs existing ($seen_opts->{$yopt}), not added";
410             } else {
411 8         21 my $yospec = "$yopt=s";
412 8         22 my $parsed = {type=>"s", opts=>[$yopt]};
413             $go_spec->{$yospec} = sub {
414 1     1   323 my ($success, $e, $decoded);
415 1         5 ($success, $e, $decoded) = _parse_yaml($_[1]);
416 1 50       9 if ($success) {
417 1         5 $rargs->{$arg} = $decoded;
418             } else {
419 0         0 die "Invalid YAML in option --$yopt: $_[1]: $e";
420             }
421 8         48 };
422 8         37 $specmeta->{$yospec} = {arg=>$arg, fqarg=>$fqarg, is_yaml=>1, parsed=>$parsed, %$extra};
423 8         19 $seen_opts->{$yopt} = $optlabel;
424 8         21 $seen_func_opts->{$yopt} = $fqarg;
425             }
426             }
427              
428             # parse argv_aliases
429 231 100 100     571 if ($arg_spec->{cmdline_aliases} && !$aliases_processed++) {
430 31         58 for my $al (keys %{$arg_spec->{cmdline_aliases}}) {
  31         126  
431 35         74 my $alspec = $arg_spec->{cmdline_aliases}{$al};
432             my $alsch = $alspec->{schema} //
433 35 100 66     158 $alspec->{is_flag} ? [bool=>{req=>1,is=>1}] : $sch;
434 35         63 my $altype = $alsch->[0];
435 35         92 my $alopt = _arg2opt("$argprefix$al");
436 35 50       96 if ($seen_opts->{$alopt}) {
437 0         0 warn "Clash of cmdline_alias option $al ($optlabel) vs existing ($seen_opts->{$alopt})";
438 0         0 next;
439             }
440 35         67 my $alcode = $alspec->{code};
441 35         54 my $alospec;
442             my $parsed;
443 35 100 100     111 if ($alcode && $alsch->[0] eq 'bool') {
444             # bool --alias doesn't get --noalias if has code
445 9         16 $alospec = $alopt; # instead of "$alopt!"
446 9         29 $parsed = {opts=>[$alopt]};
447             } else {
448 26         56 ($alospec, $parsed) = _opt2ospec($alopt, $alsch);
449             }
450              
451 35 100       80 if ($alcode) {
452 12 100       43 if ($alcode eq 'CODE') {
453 3 100       16 if ($parent_args->{ignore_converted_code}) {
454 1     1   5 $alcode = sub {};
455             } else {
456             return [
457 2         19 501,
458             join("",
459             "Code in cmdline_aliases for arg $fqarg ",
460             "got converted into string, probably ",
461             "because of JSON/YAML transport"),
462             ];
463             }
464             }
465             # alias handler
466             $go_spec->{$alospec} = sub {
467              
468             # do the same like in arg handler
469 3     3   1281 my $num_called = ++$stash->{called}{$arg};
470 3         5 my $rargs = do {
471 3 50       17 if (ref($rargs) eq 'ARRAY') {
472 0   0     0 $rargs->[$num_called-1] //= {};
473 0         0 $rargs->[$num_called-1];
474             } else {
475 3         7 $rargs;
476             }
477             };
478              
479 3         11 $alcode->($rargs, $_[1]);
480 10         55 };
481             } else {
482 23         57 $go_spec->{$alospec} = $handler;
483             }
484             $specmeta->{$alospec} = {
485 33 100       210 (summary => $alspec->{summary}) x !!defined($alspec->{summary}),
486             alias => $al,
487             is_alias => 1,
488             alias_for => $ospec,
489             arg => $arg,
490             fqarg => $fqarg,
491             is_code => $alcode ? 1:0,
492             parsed => $parsed,
493             %$extra,
494             };
495 33 100       58 push @{$specmeta->{$ospec}{($alcode ? '':'non').'code_aliases'}},
  33         125  
496             $alospec;
497 33         70 $seen_opts->{$alopt} = $optlabel;
498 33         90 $seen_func_opts->{$alopt} = $fqarg;
499             }
500             } # cmdline_aliases
501              
502             # submetadata
503 229 100       459 if ($arg_spec->{meta}) {
504 2         8 $rargs->{$arg} = {};
505             my $res = _args2opts(
506             %args,
507             argprefix => "$argprefix$arg\::",
508             meta => $arg_spec->{meta},
509 2         41 rargs => $rargs->{$arg},
510             );
511 2 50       11 return $res if $res;
512             }
513              
514             # element submetadata
515 229 100       1115 if ($arg_spec->{element_meta}) {
516 3         8 $rargs->{$arg} = [];
517             my $res = _args2opts(
518             %args,
519             argprefix => "$argprefix$arg\::",
520             meta => $arg_spec->{element_meta},
521 3         48 rargs => $rargs->{$arg},
522             );
523 3 50       19 return $res if $res;
524             }
525             } # for ospec triplet
526              
527             } # for arg
528              
529 77         258 undef;
530             }
531              
532             $SPEC{gen_getopt_long_spec_from_meta} = {
533             v => 1.1,
534             summary => 'Generate Getopt::Long spec from Rinci function metadata',
535             description => <<'_',
536              
537             This routine will produce a <pm:Getopt::Long> specification from Rinci function
538             metadata, as well as some more data structure in the result metadata to help
539             producing a command-line help/usage message.
540              
541             Function arguments will be mapped to command-line options with the same name,
542             with non-alphanumeric characters changed to `-` (`-` is preferred over `_`
543             because it lets user avoid pressing Shift on popular keyboards). For example:
544             `file_size` becomes `file-size`, `file_size.max` becomes `file-size-max`. If
545             function argument option name clashes with command-line option or another
546             existing option, it will be renamed to `NAME-arg` (or `NAME-arg2` and so on).
547             For example: `help` will become `help-arg` (if `common_opts` contains `help`,
548             that is).
549              
550             Each command-line alias (`cmdline_aliases` property) in the argument
551             specification will also be added as command-line option, except if it clashes
552             with an existing option, in which case this function will warn and skip adding
553             the alias. For more information about `cmdline_aliases`, see `Rinci::function`.
554              
555             For arguments with type of `bool`, Getopt::Long will by default also
556             automatically recognize `--noNAME` or `--no-NAME` in addition to `--name`. So
557             this function will also check those names for clashes.
558              
559             For arguments with type array of simple scalar, `--NAME` can be specified more
560             than once to append to the array.
561              
562             If `per_arg_json` setting is active, and argument's schema is not a "required
563             simple scalar" (e.g. an array, or a nullable string), then `--NAME-json` will
564             also be added to let users input undef (through `--NAME-json null`) or a
565             non-scalar value (e.g. `--NAME-json '[1,2,3]'`). If this name conflicts with
566             another existing option, a warning will be displayed and the option will not be
567             added.
568              
569             If `per_arg_yaml` setting is active, and argument's schema is not a "required
570             simple scalar" (e.g. an array, or a nullable string), then `--NAME-yaml` will
571             also be added to let users input undef (through `--NAME-yaml '~'`) or a
572             non-scalar value (e.g. `--NAME-yaml '[foo, bar]'`). If this name conflicts with
573             another existing option, a warning will be displayed and the option will not be
574             added. YAML can express a larger set of values, e.g. binary data, circular
575             references, etc.
576              
577             Will produce a hash (Getopt::Long spec), with `func.specmeta`, `func.opts`,
578             `func.common_opts`, `func.func_opts` that contain extra information
579             (`func.specmeta` is a hash of getopt spec name and a hash of extra information
580             while `func.*opts` lists all used option names).
581              
582             _
583             args => {
584             meta => {
585             summary => 'Rinci function metadata',
586             schema => 'hash*',
587             req => 1,
588             },
589             meta_is_normalized => {
590             schema => 'bool*',
591             },
592             args => {
593             summary => 'Reference to hash which will store the result',
594             schema => 'hash*',
595             },
596             common_opts => {
597             summary => 'Common options',
598             description => <<'_',
599              
600             A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
601             option specification), `handler` (Getopt::Long handler). Will be passed to
602             `get_args_from_argv()`. Example:
603              
604             {
605             help => {
606             getopt => 'help|h|?',
607             handler => sub { ... },
608             summary => 'Display help and exit',
609             },
610             version => {
611             getopt => 'version|v',
612             handler => sub { ... },
613             summary => 'Display version and exit',
614             },
615             }
616              
617             _
618             schema => ['hash*'],
619             },
620             per_arg_json => {
621             summary => 'Whether to add --NAME-json for non-simple arguments',
622             schema => 'bool',
623             default => 0,
624             description => <<'_',
625              
626             Will also interpret command-line arguments as JSON if assigned to function
627             arguments, if arguments' schema is not simple scalar.
628              
629             _
630             },
631             per_arg_yaml => {
632             summary => 'Whether to add --NAME-yaml for non-simple arguments',
633             schema => 'bool',
634             default => 0,
635             description => <<'_',
636              
637             Will also interpret command-line arguments as YAML if assigned to function
638             arguments, if arguments' schema is not simple scalar.
639              
640             _
641             },
642             ignore_converted_code => {
643             summary => 'Whether to ignore coderefs converted to string',
644             schema => 'bool',
645             default => 0,
646             description => <<'_',
647              
648             Across network through JSON encoding, coderef in metadata (e.g. in
649             `cmdline_aliases` property) usually gets converted to string `CODE`. In some
650             cases, like for tab completion, this is pretty harmless so you can turn this
651             option on. For example, in the case of `cmdline_aliases`, the effect is just
652             that command-line aliases code are not getting executed, but this is usually
653             okay.
654              
655             _
656             },
657             },
658             };
659             sub gen_getopt_long_spec_from_meta {
660 74     74 1 526 my %fargs = @_;
661              
662 74 50       199 my $meta = $fargs{meta} or return [400, "Please specify meta"];
663 74 100       167 unless ($fargs{meta_is_normalized}) {
664 1         522 require Perinci::Sub::Normalize;
665 1         1143 $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
666             }
667 74   50     3846 my $co = $fargs{common_opts} // {};
668 74   50     197 my $per_arg_yaml = $fargs{per_arg_yaml} // 0;
669 74   50     144 my $per_arg_json = $fargs{per_arg_json} // 0;
670 74         129 my $ignore_converted_code = $fargs{ignore_converted_code};
671 74   100     168 my $rargs = $fargs{args} // {};
672              
673 74         257 my %go_spec;
674             my %specmeta; # key = option spec, val = hash of extra info
675 74         0 my %seen_opts;
676 74         0 my %seen_common_opts;
677 74         0 my %seen_func_opts;
678              
679 74         212 for my $k (keys %$co) {
680 9         20 my $v = $co->{$k};
681 9         19 my $ospec = $v->{getopt};
682 9         16 my $handler = $v->{handler};
683 9 50       30 my $res = parse_getopt_long_opt_spec($ospec)
684             or return [400, "Can't parse common opt spec '$ospec'"];
685 9         571 $go_spec{$ospec} = $handler;
686 9         38 $specmeta{$ospec} = {common_opt=>$k, arg=>undef, parsed=>$res};
687 9         15 for (@{ $res->{opts} }) {
  9         26  
688 12 50       30 return [412, "Clash of common opt '$_' ($seen_opts{$_})"] if $seen_opts{$_};
689 12         35 $seen_opts{$_} = "common option $k";
690 12         20 $seen_common_opts{$_} = $ospec;
691 12 100       36 if ($res->{is_neg}) {
692 1         8 $seen_opts{"no$_"} = "common option $k, negative form";
693 1         3 $seen_common_opts{"no$_"} = $ospec;
694 1         4 $seen_opts{"no-$_"} = "common option $k, negative form";
695 1         4 $seen_common_opts{"no-$_"} = $ospec;
696             }
697             }
698             }
699              
700 74         242 my $res = _args2opts(
701             argprefix => "",
702             parent_args => \%fargs,
703             meta => $meta,
704             seen_opts => \%seen_opts,
705             seen_common_opts => \%seen_common_opts,
706             seen_func_opts => \%seen_func_opts,
707             rargs => $rargs,
708             go_spec => \%go_spec,
709             specmeta => \%specmeta,
710             );
711 74 100       217 return $res if $res;
712              
713 72 100       234 my $opts = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_opts)];
  292         935  
714 72 100       204 my $common_opts = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_common_opts)];
  14         44  
715 72 100       170 my $func_opts = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_func_opts)];
  278         697  
716 72         159 my $opts_by_common = {};
717 72         154 for my $k (keys %$co) {
718 9         21 my $v = $co->{$k};
719 9         23 my $ospec = $v->{getopt};
720 9         15 my @opts;
721 9         22 for (keys %seen_common_opts) {
722 58 100       115 next unless $seen_common_opts{$_} eq $ospec;
723 14 100       57 push @opts, (length($_)>1 ? "--$_":"-$_");
724             }
725 9         35 $opts_by_common->{$ospec} = [sort @opts];
726             }
727              
728 72         109 my $opts_by_arg = {};
729 72         155 for (keys %seen_func_opts) {
730 278         454 my $fqarg = $seen_func_opts{$_};
731 278 100       373 push @{ $opts_by_arg->{$fqarg} }, length($_)>1 ? "--$_":"-$_";
  278         836  
732             }
733 72         211 for (keys %$opts_by_arg) {
734 196         289 $opts_by_arg->{$_} = [sort @{ $opts_by_arg->{$_} }];
  196         518  
735             }
736              
737 72         690 [200, "OK", \%go_spec,
738             {
739             "func.specmeta" => \%specmeta,
740             "func.opts" => $opts,
741             "func.common_opts" => $common_opts,
742             "func.func_opts" => $func_opts,
743             "func.opts_by_arg" => $opts_by_arg,
744             "func.opts_by_common" => $opts_by_common,
745             }];
746             }
747              
748             $SPEC{get_args_from_argv} = {
749             v => 1.1,
750             summary => 'Get subroutine arguments (%args) from command-line arguments '.
751             '(@ARGV)',
752             description => <<'_',
753              
754             Using information in Rinci function metadata's `args` property, parse command
755             line arguments `@argv` into hash `%args`, suitable for passing into subroutines.
756              
757             Currently uses <pm:Getopt::Long>'s `GetOptions` to do the parsing.
758              
759             As with GetOptions, this function modifies its `argv` argument, so you might
760             want to copy the original `argv` first (or pass a copy instead) if you want to
761             preserve the original.
762              
763             See also: gen_getopt_long_spec_from_meta() which is the routine that generates
764             the specification.
765              
766             _
767             args => {
768             argv => {
769             schema => ['array*' => {
770             of => 'str*',
771             }],
772             description => 'If not specified, defaults to @ARGV',
773             },
774             args => {
775             summary => 'Specify input args, with some arguments preset',
776             schema => ['hash'],
777             },
778             meta => {
779             schema => ['hash*' => {}],
780             req => 1,
781             },
782             meta_is_normalized => {
783             summary => 'Can be set to 1 if your metadata is normalized, '.
784             'to avoid duplicate effort',
785             schema => 'bool',
786             default => 0,
787             },
788             strict => {
789             schema => ['bool' => {default=>1}],
790             summary => 'Strict mode',
791             description => <<'_',
792              
793             If set to 0, will still return parsed argv even if there are parsing errors
794             (reported by Getopt::Long). If set to 1 (the default), will die upon error.
795              
796             Normally you would want to use strict mode, for more error checking. Setting off
797             strict is used by, for example, Perinci::Sub::Complete during completion where
798             the command-line might still be incomplete.
799              
800             Should probably be named `ignore_errors` or `allow_unknown_options`. :-)
801              
802             _
803             },
804             per_arg_yaml => {
805             schema => ['bool' => {default=>0}],
806             summary => 'Whether to recognize --ARGNAME-yaml',
807             description => <<'_',
808              
809             This is useful for example if you want to specify a value which is not
810             expressible from the command-line, like 'undef'.
811              
812             % script.pl --name-yaml '~'
813              
814             See also: per_arg_json. You should enable just one instead of turning on both.
815              
816             _
817             },
818             per_arg_json => {
819             schema => ['bool' => {default=>0}],
820             summary => 'Whether to recognize --ARGNAME-json',
821             description => <<'_',
822              
823             This is useful for example if you want to specify a value which is not
824             expressible from the command-line, like 'undef'.
825              
826             % script.pl --name-json 'null'
827              
828             But every other string will need to be quoted:
829              
830             % script.pl --name-json '"foo"'
831              
832             See also: per_arg_yaml. You should enable just one instead of turning on both.
833              
834             _
835             },
836             common_opts => {
837             summary => 'Common options',
838             description => <<'_',
839              
840             A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
841             option specification), `handler` (Getopt::Long handler). Will be passed to
842             `get_args_from_argv()`. Example:
843              
844             {
845             help => {
846             getopt => 'help|h|?',
847             handler => sub { ... },
848             summary => 'Display help and exit',
849             },
850             version => {
851             getopt => 'version|v',
852             handler => sub { ... },
853             summary => 'Display version and exit',
854             },
855             }
856              
857             _
858             schema => ['hash*'],
859             },
860             allow_extra_elems => {
861             schema => ['bool' => {default=>0}],
862             summary => 'Allow extra/unassigned elements in argv',
863             description => <<'_',
864              
865             If set to 1, then if there are array elements unassigned to one of the
866             arguments, instead of generating an error, this function will just ignore them.
867              
868             This option will be passed to Perinci::Sub::GetArgs::Array's allow_extra_elems.
869              
870             _
871             },
872             on_missing_required_args => {
873             schema => 'code',
874             summary => 'Execute code when there is missing required args',
875             description => <<'_',
876              
877             This can be used to give a chance to supply argument value from other sources if
878             not specified by command-line options. Perinci::CmdLine, for example, uses this
879             hook to supply value from STDIN or file contents (if argument has `cmdline_src`
880             specification key set).
881              
882             This hook will be called for each missing argument. It will be supplied hash
883             arguments: (arg => $the_missing_argument_name, args =>
884             $the_resulting_args_so_far, spec => $the_arg_spec).
885              
886             The hook can return true if it succeeds in making the missing situation
887             resolved. In this case, this function will not report the argument as missing.
888              
889             _
890             },
891             ignore_converted_code => {
892             summary => 'Whether to ignore coderefs converted to string',
893             schema => 'bool',
894             default => 0,
895             description => <<'_',
896              
897             Across network through JSON encoding, coderef in metadata (e.g. in
898             `cmdline_aliases` property) usually gets converted to string `CODE`. In some
899             cases, like for tab completion, this is harmless so you can turn this option on.
900              
901             _
902             },
903             ggls_res => {
904             summary => 'Full result from gen_getopt_long_spec_from_meta()',
905             schema => 'array*', # XXX envres
906             description => <<'_',
907              
908             If you already call `gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
909             here, to avoid calculating twice.
910              
911             _
912             tags => ['category:optimization'],
913             },
914             },
915             result => {
916             description => <<'_',
917              
918             Error codes:
919              
920             * 400 - Error in Getopt::Long option specification, e.g. in common_opts.
921              
922             * 500 - failure in GetOptions, meaning argv is not valid according to metadata
923             specification (only if 'strict' mode is enabled).
924              
925             * 501 - coderef in cmdline_aliases got converted into a string, probably because
926             the metadata was transported (e.g. through Riap::HTTP/Riap::Simple).
927              
928             _
929             },
930             };
931             sub get_args_from_argv {
932 73     73 1 373457 require Getopt::Long;
933              
934 73         11234 my %fargs = @_;
935 73   100     234 my $argv = $fargs{argv} // \@ARGV;
936 73 50       195 my $meta = $fargs{meta} or return [400, "Please specify meta"];
937 73 50       170 unless ($fargs{meta_is_normalized}) {
938 73         686 require Perinci::Sub::Normalize;
939 73         1389 $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
940             }
941 73   100     24657 my $strict = $fargs{strict} // 1;
942 73   100     257 my $common_opts = $fargs{common_opts} // {};
943 73   100     218 my $per_arg_yaml = $fargs{per_arg_yaml} // 0;
944 73   100     198 my $per_arg_json = $fargs{per_arg_json} // 0;
945 73   100     212 my $allow_extra_elems = $fargs{allow_extra_elems} // 0;
946 73         117 my $on_missing = $fargs{on_missing_required_args};
947 73         117 my $ignore_converted_code = $fargs{ignore_converted_code};
948             #$log->tracef("-> get_args_from_argv(), argv=%s", $argv);
949              
950             # to store the resulting args
951 73   100     208 my $rargs = $fargs{args} // {};
952              
953             # 1. first we generate Getopt::Long spec
954 73   33     234 my $genres = $fargs{ggls_res} // gen_getopt_long_spec_from_meta(
955             meta => $meta, meta_is_normalized => 1,
956             args => $rargs,
957             common_opts => $common_opts,
958             per_arg_json => $per_arg_json,
959             per_arg_yaml => $per_arg_yaml,
960             ignore_converted_code => $ignore_converted_code,
961             );
962 73 100       256 return err($genres->[0], "Can't generate Getopt::Long spec", $genres)
963             if $genres->[0] != 200;
964 71         117 my $go_spec = $genres->[2];
965              
966             # 2. then we run GetOptions to fill $rargs from command-line opts
967             #$log->tracef("GetOptions spec: %s", \@go_spec);
968             {
969 71 100   0   101 local $SIG{__WARN__} = sub{} if !$strict;
  71         182  
970 71 100       251 my $old_go_conf = Getopt::Long::Configure(
971             $strict ? "no_pass_through" : "pass_through",
972             "no_ignore_case", "permute", "no_getopt_compat", "gnu_compat", "bundling");
973 71         6550 my $res = Getopt::Long::GetOptionsFromArray($argv, %$go_spec);
974 71         8128 Getopt::Long::Configure($old_go_conf);
975 71 100       1324 unless ($res) {
976 8 50       188 return [500, "GetOptions failed"] if $strict;
977             }
978             }
979              
980             # 3. then we try to fill $rargs from remaining command-line arguments (for
981             # args which have 'pos' spec specified)
982              
983 63         120 my $args_prop = $meta->{args};
984              
985 63 100       150 if (@$argv) {
986 13         62 my $res = get_args_from_array(
987             array=>$argv, meta => $meta,
988             meta_is_normalized => 1,
989             allow_extra_elems => $allow_extra_elems,
990             );
991 13 100 100     750 if ($res->[0] != 200 && $strict) {
    50 66        
    100          
992 2         13 return err(500, "Get args from array failed", $res);
993             } elsif ($strict && $res->[0] != 200) {
994 0         0 return err("Can't get args from argv", $res);
995             } elsif ($res->[0] == 200) {
996 10         22 my $pos_args = $res->[2];
997 10         33 for my $name (keys %$pos_args) {
998 11         24 my $arg_spec = $args_prop->{$name};
999 11         20 my $val = $pos_args->{$name};
1000 11 100       28 if (exists $rargs->{$name}) {
1001             return [400, "You specified option --$name but also ".
1002 2 50       75 "argument #".$arg_spec->{pos}] if $strict;
1003             }
1004             my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $clset, $eltype) =
1005 9         24 _is_simple_or_array_of_simple_or_hash_of_simple($arg_spec->{schema});
1006              
1007 9 100 66     62 if (($arg_spec->{slurpy} // $arg_spec->{greedy}) && ref($val) eq 'ARRAY' &&
      66        
      100        
      66        
1008             !$is_array_of_simple && !$is_hash_of_simple) {
1009 1         2 my $i = 0;
1010 1         4 for (@$val) {
1011             TRY_PARSING_AS_JSON_YAML:
1012             {
1013 1         2 my ($success, $e, $decoded);
  1         3  
1014 1 50       3 if ($per_arg_json) {
1015 1         3 ($success, $e, $decoded) = _parse_json($_);
1016 1 50       5 if ($success) {
1017 0         0 $_ = $decoded;
1018 0         0 last TRY_PARSING_AS_JSON_YAML;
1019             } else {
1020             #warn "Failed trying to parse argv #$i as JSON: $e";
1021             }
1022             }
1023 1 50       4 if ($per_arg_yaml) {
1024 1         4 ($success, $e, $decoded) = _parse_yaml($_);
1025 1 50       8 if ($success) {
1026 1         3 $_ = $decoded;
1027 1         3 last TRY_PARSING_AS_JSON_YAML;
1028             } else {
1029             #warn "Failed trying to parse argv #$i as YAML: $e";
1030             }
1031             }
1032             }
1033 1         4 $i++;
1034             }
1035             }
1036 9 100 66     46 if (!($arg_spec->{slurpy} // $arg_spec->{greedy}) && !$is_simple) {
      100        
1037             TRY_PARSING_AS_JSON_YAML:
1038             {
1039 1         2 my ($success, $e, $decoded);
  1         3  
1040 1 50       4 if ($per_arg_json) {
1041 1         5 ($success, $e, $decoded) = _parse_json($val);
1042 1 50       9 if ($success) {
1043 0         0 $val = $decoded;
1044 0         0 last TRY_PARSING_AS_JSON_YAML;
1045             } else {
1046             #warn "Failed trying to parse argv #$arg_spec->{pos} as JSON: $e";
1047             }
1048             }
1049 1 50       5 if ($per_arg_yaml) {
1050 1         10 ($success, $e, $decoded) = _parse_yaml($val);
1051 1 50       6 if ($success) {
1052 1         3 $val = $decoded;
1053 1         4 last TRY_PARSING_AS_JSON_YAML;
1054             } else {
1055             #warn "Failed trying to parse argv #$arg_spec->{pos} as YAML: $e";
1056             }
1057             }
1058             }
1059             }
1060 9         24 $rargs->{$name} = $val;
1061             # we still call cmdline_on_getopt for this
1062 9 100       39 if ($arg_spec->{cmdline_on_getopt}) {
1063 2 50 33     9 if ($arg_spec->{slurpy} // $arg_spec->{greedy}) {
1064             $arg_spec->{cmdline_on_getopt}->(
1065             arg=>$name, fqarg=>$name, value=>$_, args=>$rargs,
1066             opt=>undef, # this marks that value is retrieved from cmdline arg
1067 2         10 ) for @$val;
1068             } else {
1069 0         0 $arg_spec->{cmdline_on_getopt}->(
1070             arg=>$name, fqarg=>$name, value=>$val, args=>$rargs,
1071             opt=>undef, # this marks that value is retrieved from cmdline arg
1072             );
1073             }
1074             }
1075             }
1076             }
1077             }
1078              
1079             # 4. check missing required args
1080              
1081 59         109 my %missing_args; # value = order
1082 59         89 my $i = 0;
1083 59         237 for my $arg (sort {
1084 127 50 100     623 (($args_prop->{$a}{pos}//9999) <=> ($args_prop->{$b}{pos}//9999)) ||
      100        
1085             ($a cmp $b) } keys %$args_prop) {
1086 144         223 my $arg_spec = $args_prop->{$arg};
1087 144 100       322 if (!exists($rargs->{$arg})) {
1088 68 100       169 next unless $arg_spec->{req};
1089             # give a chance to hook to set missing arg
1090 5 100       19 if ($on_missing) {
1091 2 100       15 next if $on_missing->(arg=>$arg, args=>$rargs, spec=>$arg_spec);
1092             }
1093 4 100       29 next if exists $rargs->{$arg};
1094 3         9 $missing_args{$arg} = ++$i;
1095             }
1096             }
1097              
1098             # 5. check 'deps', currently we only support 'arg' dep type
1099             {
1100 59 100       104 last unless $strict;
  59         136  
1101              
1102 58         137 for my $arg (keys %$args_prop) {
1103 142         213 my $arg_spec = $args_prop->{$arg};
1104 142 100       297 next unless exists $rargs->{$arg};
1105 76 100       237 next unless $arg_spec->{deps};
1106 2         7 my $dep_arg = $arg_spec->{deps}{arg};
1107 2 50       9 next unless $dep_arg;
1108             return [400, "You specify '$arg', but don't specify '$dep_arg' ".
1109             "(upon which '$arg' depends)"]
1110 2 100       35 unless exists $rargs->{$dep_arg};
1111             }
1112             }
1113              
1114             #$log->tracef("<- get_args_from_argv(), args=%s, remaining argv=%s",
1115             # $rargs, $argv);
1116             [200, "OK", $rargs, {
1117 58         531 "func.missing_args" => [sort {$missing_args{$a} <=> $missing_args{$b} } keys %missing_args],
  0            
1118             "func.gen_getopt_long_spec_result" => $genres,
1119             }];
1120             }
1121              
1122             1;
1123             # ABSTRACT: Get subroutine arguments from command line arguments (@ARGV)
1124              
1125             __END__
1126              
1127             =pod
1128              
1129             =encoding UTF-8
1130              
1131             =head1 NAME
1132              
1133             Perinci::Sub::GetArgs::Argv - Get subroutine arguments from command line arguments (@ARGV)
1134              
1135             =head1 VERSION
1136              
1137             This document describes version 0.849_001 of Perinci::Sub::GetArgs::Argv (from Perl distribution Perinci-Sub-GetArgs-Argv), released on 2022-12-01.
1138              
1139             =head1 SYNOPSIS
1140              
1141             use Perinci::Sub::GetArgs::Argv;
1142              
1143             my $res = get_args_from_argv(argv=>\@ARGV, meta=>$meta, ...);
1144              
1145             =head1 DESCRIPTION
1146              
1147             This module provides C<get_args_from_argv()>, which parses command line
1148             arguments (C<@ARGV>) into subroutine arguments (C<%args>). This module is used
1149             by L<Perinci::CmdLine>. For explanation on how command-line options are
1150             processed, see Perinci::CmdLine's documentation.
1151              
1152             =head1 FUNCTIONS
1153              
1154              
1155             =head2 gen_getopt_long_spec_from_meta
1156              
1157             Usage:
1158              
1159             gen_getopt_long_spec_from_meta(%args) -> [$status_code, $reason, $payload, \%result_meta]
1160              
1161             Generate Getopt::Long spec from Rinci function metadata.
1162              
1163             This routine will produce a L<Getopt::Long> specification from Rinci function
1164             metadata, as well as some more data structure in the result metadata to help
1165             producing a command-line help/usage message.
1166              
1167             Function arguments will be mapped to command-line options with the same name,
1168             with non-alphanumeric characters changed to C<-> (C<-> is preferred over C<_>
1169             because it lets user avoid pressing Shift on popular keyboards). For example:
1170             C<file_size> becomes C<file-size>, C<file_size.max> becomes C<file-size-max>. If
1171             function argument option name clashes with command-line option or another
1172             existing option, it will be renamed to C<NAME-arg> (or C<NAME-arg2> and so on).
1173             For example: C<help> will become C<help-arg> (if C<common_opts> contains C<help>,
1174             that is).
1175              
1176             Each command-line alias (C<cmdline_aliases> property) in the argument
1177             specification will also be added as command-line option, except if it clashes
1178             with an existing option, in which case this function will warn and skip adding
1179             the alias. For more information about C<cmdline_aliases>, see C<Rinci::function>.
1180              
1181             For arguments with type of C<bool>, Getopt::Long will by default also
1182             automatically recognize C<--noNAME> or C<--no-NAME> in addition to C<--name>. So
1183             this function will also check those names for clashes.
1184              
1185             For arguments with type array of simple scalar, C<--NAME> can be specified more
1186             than once to append to the array.
1187              
1188             If C<per_arg_json> setting is active, and argument's schema is not a "required
1189             simple scalar" (e.g. an array, or a nullable string), then C<--NAME-json> will
1190             also be added to let users input undef (through C<--NAME-json null>) or a
1191             non-scalar value (e.g. C<--NAME-json '[1,2,3]'>). If this name conflicts with
1192             another existing option, a warning will be displayed and the option will not be
1193             added.
1194              
1195             If C<per_arg_yaml> setting is active, and argument's schema is not a "required
1196             simple scalar" (e.g. an array, or a nullable string), then C<--NAME-yaml> will
1197             also be added to let users input undef (through C<--NAME-yaml '~'>) or a
1198             non-scalar value (e.g. C<--NAME-yaml '[foo, bar]'>). If this name conflicts with
1199             another existing option, a warning will be displayed and the option will not be
1200             added. YAML can express a larger set of values, e.g. binary data, circular
1201             references, etc.
1202              
1203             Will produce a hash (Getopt::Long spec), with C<func.specmeta>, C<func.opts>,
1204             C<func.common_opts>, C<func.func_opts> that contain extra information
1205             (C<func.specmeta> is a hash of getopt spec name and a hash of extra information
1206             while C<func.*opts> lists all used option names).
1207              
1208             This function is not exported by default, but exportable.
1209              
1210             Arguments ('*' denotes required arguments):
1211              
1212             =over 4
1213              
1214             =item * B<args> => I<hash>
1215              
1216             Reference to hash which will store the result.
1217              
1218             =item * B<common_opts> => I<hash>
1219              
1220             Common options.
1221              
1222             A hash where the values are hashes containing these keys: C<getopt> (Getopt::Long
1223             option specification), C<handler> (Getopt::Long handler). Will be passed to
1224             C<get_args_from_argv()>. Example:
1225              
1226             {
1227             help => {
1228             getopt => 'help|h|?',
1229             handler => sub { ... },
1230             summary => 'Display help and exit',
1231             },
1232             version => {
1233             getopt => 'version|v',
1234             handler => sub { ... },
1235             summary => 'Display version and exit',
1236             },
1237             }
1238              
1239             =item * B<ignore_converted_code> => I<bool> (default: 0)
1240              
1241             Whether to ignore coderefs converted to string.
1242              
1243             Across network through JSON encoding, coderef in metadata (e.g. in
1244             C<cmdline_aliases> property) usually gets converted to string C<CODE>. In some
1245             cases, like for tab completion, this is pretty harmless so you can turn this
1246             option on. For example, in the case of C<cmdline_aliases>, the effect is just
1247             that command-line aliases code are not getting executed, but this is usually
1248             okay.
1249              
1250             =item * B<meta>* => I<hash>
1251              
1252             Rinci function metadata.
1253              
1254             =item * B<meta_is_normalized> => I<bool>
1255              
1256             (No description)
1257              
1258             =item * B<per_arg_json> => I<bool> (default: 0)
1259              
1260             Whether to add --NAME-json for non-simple arguments.
1261              
1262             Will also interpret command-line arguments as JSON if assigned to function
1263             arguments, if arguments' schema is not simple scalar.
1264              
1265             =item * B<per_arg_yaml> => I<bool> (default: 0)
1266              
1267             Whether to add --NAME-yaml for non-simple arguments.
1268              
1269             Will also interpret command-line arguments as YAML if assigned to function
1270             arguments, if arguments' schema is not simple scalar.
1271              
1272              
1273             =back
1274              
1275             Returns an enveloped result (an array).
1276              
1277             First element ($status_code) is an integer containing HTTP-like status code
1278             (200 means OK, 4xx caller error, 5xx function error). Second element
1279             ($reason) is a string containing error message, or something like "OK" if status is
1280             200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
1281             element (%result_meta) is called result metadata and is optional, a hash
1282             that contains extra information, much like how HTTP response headers provide additional metadata.
1283              
1284             Return value: (any)
1285              
1286              
1287              
1288             =head2 get_args_from_argv
1289              
1290             Usage:
1291              
1292             get_args_from_argv(%args) -> [$status_code, $reason, $payload, \%result_meta]
1293              
1294             Get subroutine arguments (%args) from command-line arguments (@ARGV).
1295              
1296             Using information in Rinci function metadata's C<args> property, parse command
1297             line arguments C<@argv> into hash C<%args>, suitable for passing into subroutines.
1298              
1299             Currently uses L<Getopt::Long>'s C<GetOptions> to do the parsing.
1300              
1301             As with GetOptions, this function modifies its C<argv> argument, so you might
1302             want to copy the original C<argv> first (or pass a copy instead) if you want to
1303             preserve the original.
1304              
1305             See also: gen_getopt_long_spec_from_meta() which is the routine that generates
1306             the specification.
1307              
1308             This function is not exported by default, but exportable.
1309              
1310             Arguments ('*' denotes required arguments):
1311              
1312             =over 4
1313              
1314             =item * B<allow_extra_elems> => I<bool> (default: 0)
1315              
1316             Allow extraE<sol>unassigned elements in argv.
1317              
1318             If set to 1, then if there are array elements unassigned to one of the
1319             arguments, instead of generating an error, this function will just ignore them.
1320              
1321             This option will be passed to Perinci::Sub::GetArgs::Array's allow_extra_elems.
1322              
1323             =item * B<args> => I<hash>
1324              
1325             Specify input args, with some arguments preset.
1326              
1327             =item * B<argv> => I<array[str]>
1328              
1329             If not specified, defaults to @ARGV
1330              
1331             =item * B<common_opts> => I<hash>
1332              
1333             Common options.
1334              
1335             A hash where the values are hashes containing these keys: C<getopt> (Getopt::Long
1336             option specification), C<handler> (Getopt::Long handler). Will be passed to
1337             C<get_args_from_argv()>. Example:
1338              
1339             {
1340             help => {
1341             getopt => 'help|h|?',
1342             handler => sub { ... },
1343             summary => 'Display help and exit',
1344             },
1345             version => {
1346             getopt => 'version|v',
1347             handler => sub { ... },
1348             summary => 'Display version and exit',
1349             },
1350             }
1351              
1352             =item * B<ggls_res> => I<array>
1353              
1354             Full result from gen_getopt_long_spec_from_meta().
1355              
1356             If you already call C<gen_getopt_long_spec_from_meta()>, you can pass the I<full> enveloped result
1357             here, to avoid calculating twice.
1358              
1359             =item * B<ignore_converted_code> => I<bool> (default: 0)
1360              
1361             Whether to ignore coderefs converted to string.
1362              
1363             Across network through JSON encoding, coderef in metadata (e.g. in
1364             C<cmdline_aliases> property) usually gets converted to string C<CODE>. In some
1365             cases, like for tab completion, this is harmless so you can turn this option on.
1366              
1367             =item * B<meta>* => I<hash>
1368              
1369             (No description)
1370              
1371             =item * B<meta_is_normalized> => I<bool> (default: 0)
1372              
1373             Can be set to 1 if your metadata is normalized, to avoid duplicate effort.
1374              
1375             =item * B<on_missing_required_args> => I<code>
1376              
1377             Execute code when there is missing required args.
1378              
1379             This can be used to give a chance to supply argument value from other sources if
1380             not specified by command-line options. Perinci::CmdLine, for example, uses this
1381             hook to supply value from STDIN or file contents (if argument has C<cmdline_src>
1382             specification key set).
1383              
1384             This hook will be called for each missing argument. It will be supplied hash
1385             arguments: (arg => $the_missing_argument_name, args =>
1386             $the_resulting_args_so_far, spec => $the_arg_spec).
1387              
1388             The hook can return true if it succeeds in making the missing situation
1389             resolved. In this case, this function will not report the argument as missing.
1390              
1391             =item * B<per_arg_json> => I<bool> (default: 0)
1392              
1393             Whether to recognize --ARGNAME-json.
1394              
1395             This is useful for example if you want to specify a value which is not
1396             expressible from the command-line, like 'undef'.
1397              
1398             % script.pl --name-json 'null'
1399              
1400             But every other string will need to be quoted:
1401              
1402             % script.pl --name-json '"foo"'
1403              
1404             See also: per_arg_yaml. You should enable just one instead of turning on both.
1405              
1406             =item * B<per_arg_yaml> => I<bool> (default: 0)
1407              
1408             Whether to recognize --ARGNAME-yaml.
1409              
1410             This is useful for example if you want to specify a value which is not
1411             expressible from the command-line, like 'undef'.
1412              
1413             % script.pl --name-yaml '~'
1414              
1415             See also: per_arg_json. You should enable just one instead of turning on both.
1416              
1417             =item * B<strict> => I<bool> (default: 1)
1418              
1419             Strict mode.
1420              
1421             If set to 0, will still return parsed argv even if there are parsing errors
1422             (reported by Getopt::Long). If set to 1 (the default), will die upon error.
1423              
1424             Normally you would want to use strict mode, for more error checking. Setting off
1425             strict is used by, for example, Perinci::Sub::Complete during completion where
1426             the command-line might still be incomplete.
1427              
1428             Should probably be named C<ignore_errors> or C<allow_unknown_options>. :-)
1429              
1430              
1431             =back
1432              
1433             Returns an enveloped result (an array).
1434              
1435             First element ($status_code) is an integer containing HTTP-like status code
1436             (200 means OK, 4xx caller error, 5xx function error). Second element
1437             ($reason) is a string containing error message, or something like "OK" if status is
1438             200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
1439             element (%result_meta) is called result metadata and is optional, a hash
1440             that contains extra information, much like how HTTP response headers provide additional metadata.
1441              
1442             Return value: (any)
1443              
1444              
1445             Error codes:
1446              
1447             =over
1448              
1449             =item * 400 - Error in Getopt::Long option specification, e.g. in common_opts.
1450              
1451             =item * 500 - failure in GetOptions, meaning argv is not valid according to metadata
1452             specification (only if 'strict' mode is enabled).
1453              
1454             =item * 501 - coderef in cmdline_aliases got converted into a string, probably because
1455             the metadata was transported (e.g. through Riap::HTTP/Riap::Simple).
1456              
1457             =back
1458              
1459             =head1 FAQ
1460              
1461             =head1 HOMEPAGE
1462              
1463             Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-GetArgs-Argv>.
1464              
1465             =head1 SOURCE
1466              
1467             Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-GetArgs-Argv>.
1468              
1469             =head1 SEE ALSO
1470              
1471             L<Perinci>
1472              
1473             =head1 AUTHOR
1474              
1475             perlancar <perlancar@cpan.org>
1476              
1477             =head1 CONTRIBUTORS
1478              
1479             =for stopwords Olivier Mengué Steven Haryanto
1480              
1481             =over 4
1482              
1483             =item *
1484              
1485             Olivier Mengué <dolmen@cpan.org>
1486              
1487             =item *
1488              
1489             Steven Haryanto <stevenharyanto@gmail.com>
1490              
1491             =back
1492              
1493             =head1 CONTRIBUTING
1494              
1495              
1496             To contribute, you can send patches by email/via RT, or send pull requests on
1497             GitHub.
1498              
1499             Most of the time, you don't need to build the distribution yourself. You can
1500             simply modify the code, then test via:
1501              
1502             % prove -l
1503              
1504             If you want to build the distribution (e.g. to try to install it locally on your
1505             system), you can install L<Dist::Zilla>,
1506             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
1507             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
1508             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
1509             that are considered a bug and can be reported to me.
1510              
1511             =head1 COPYRIGHT AND LICENSE
1512              
1513             This software is copyright (c) 2022, 2021, 2020, 2019, 2017, 2016, 2015, 2014, 2013, 2012, 2011 by perlancar <perlancar@cpan.org>.
1514              
1515             This is free software; you can redistribute it and/or modify it under
1516             the same terms as the Perl 5 programming language system itself.
1517              
1518             =head1 BUGS
1519              
1520             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-GetArgs-Argv>
1521              
1522             When submitting a bug or request, please include a test-file or a
1523             patch to an existing test-file that illustrates the bug or desired
1524             feature.
1525              
1526             =cut