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 |