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