File Coverage

blib/lib/Complete/Getopt/Long.pm
Criterion Covered Total %
statement 254 342 74.2
branch 125 230 54.3
condition 61 83 73.4
subroutine 9 9 100.0
pod 1 1 100.0
total 450 665 67.6


line stmt bran cond sub pod time code
1             package Complete::Getopt::Long;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-09-09'; # DATE
5             our $DIST = 'Complete-Getopt-Long'; # DIST
6             our $VERSION = '0.480'; # VERSION
7              
8 1     1   9507 use 5.010001;
  1         4  
9 1     1   5 use strict;
  1         3  
  1         21  
10 1     1   5 use warnings;
  1         2  
  1         23  
11 1     1   6 use Log::ger;
  1         2  
  1         4  
12              
13             require Exporter;
14             our @ISA = qw(Exporter);
15             our @EXPORT_OK = qw(
16             complete_cli_arg
17             );
18              
19             our %SPEC;
20              
21             our $COMPLETE_GETOPT_LONG_TRACE=$ENV{COMPLETE_GETOPT_LONG_TRACE} // 0;
22             our $COMPLETE_GETOPT_LONG_DEFAULT_ENV = $ENV{COMPLETE_GETOPT_LONG_DEFAULT_ENV} // 1;
23             our $COMPLETE_GETOPT_LONG_DEFAULT_FILE = $ENV{COMPLETE_GETOPT_LONG_DEFAULT_FILE} // 1;
24              
25             sub _default_completion {
26 1     1   725 require Complete::Env;
27 1         1554 require Complete::File;
28 1         2195 require Complete::Util;
29              
30 1         9 my %args = @_;
31 1   50     8 my $word = $args{word} // '';
32              
33 1         2 my $fres;
34 1 50       5 log_trace('[compgl] entering default completion routine') if $COMPLETE_GETOPT_LONG_TRACE;
35              
36             # try completing '$...' with shell variables
37 1 0 33     5 if ($word =~ /\A\$/ && $COMPLETE_GETOPT_LONG_DEFAULT_ENV) {
38 0 0       0 log_trace('[compgl] completing shell variable') if $COMPLETE_GETOPT_LONG_TRACE;
39             {
40 0         0 my $compres = Complete::Env::complete_env(
  0         0  
41             word=>$word);
42 0 0       0 last unless @$compres;
43 0         0 $fres = {words=>$compres, esc_mode=>'shellvar'};
44 0         0 goto RETURN_RES;
45             }
46             # if empty, fallback to searching file
47             }
48              
49             # try completing '~foo' with user dir (appending / if user's home exists)
50 1 0 33     4 if ($word =~ m!\A~([^/]*)\z! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
51 0 0       0 log_trace("[compgl] completing userdir, user=%s", $1) if $COMPLETE_GETOPT_LONG_TRACE;
52             {
53 0         0 eval { require Unix::Passwd::File };
  0         0  
  0         0  
54 0 0       0 last if $@;
55 0         0 my $res = Unix::Passwd::File::list_users(detail=>1);
56 0 0       0 last unless $res->[0] == 200;
57             my $compres = Complete::Util::complete_array_elem(
58 0 0       0 array=>[map {"~" . $_->{user} . ((-d $_->{home}) ? "/":"")}
59 0         0 @{ $res->[2] }],
  0         0  
60             word=>$word,
61             );
62 0 0       0 last unless @$compres;
63 0         0 $fres = {words=>$compres, path_sep=>'/'};
64 0         0 goto RETURN_RES;
65             }
66             # if empty, fallback to searching file
67             }
68              
69             # try completing '~/blah' or '~foo/blah' as if completing file, but do not
70             # expand ~foo (this is supported by complete_file(), so we just give it off
71             # to the routine)
72 1 0 33     4 if ($word =~ m!\A(~[^/]*)/! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
73 0 0       0 log_trace("[compgl] completing file, path=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE;
74 0         0 $fres = Complete::Util::hashify_answer(
75             Complete::File::complete_file(word=>$word),
76             {path_sep=>'/'}
77             );
78 0         0 goto RETURN_RES;
79             }
80              
81             # try completing something that contains wildcard with glob. for
82             # convenience, we add '*' at the end so that when user type [AB] it is
83             # treated like [AB]*.
84 1         582 require String::Wildcard::Bash;
85 1 0 33     1232 if (String::Wildcard::Bash::contains_wildcard($word) && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
86 0 0       0 log_trace("[compgl] completing with wildcard glob, glob=<%s>", "$word*") if $COMPLETE_GETOPT_LONG_TRACE;
87             {
88 0         0 my $compres = [glob("$word*")];
  0         0  
89 0 0       0 last unless @$compres;
90 0         0 for (@$compres) {
91 0 0       0 $_ .= "/" if (-d $_);
92             }
93 0         0 $fres = {words=>$compres, path_sep=>'/'};
94 0         0 goto RETURN_RES;
95             }
96             # if empty, fallback to searching file
97             }
98              
99 1 50       27 if ($COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
100 1 50       6 log_trace("[compgl] completing with file, file=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE;
101 1         5 $fres = Complete::Util::hashify_answer(
102             Complete::File::complete_file(word=>$word),
103             {path_sep=>'/'}
104             );
105             }
106              
107             RETURN_RES:
108 1 50       14840 log_trace("[compgl] leaving default completion routine, result=%s", $fres) if $COMPLETE_GETOPT_LONG_TRACE;
109 1         6 $fres;
110             }
111              
112             # return the possible options. if there is only one candidate (unambiguous
113             # expansion) then scalar will be returned. otherwise, an array of candidates
114             # will be returned.
115             sub _matching_opts {
116 41     41   89 my ($opt, $opts) = @_;
117 41         64 my %candidates;
118 41         227 for (sort {length($a)<=>length($b)} keys %$opts) {
  1116         1575  
119 269 100       516 next unless index($_, $opt) == 0;
120 108         198 $candidates{$_} = $opts->{$_};
121 108 100       207 last if $opt eq $_;
122             }
123 41         111 \%candidates;
124             }
125              
126             # mark an option (and all its aliases) as seen
127             sub _mark_seen {
128 48     48   104 my ($seen_opts, $opt, $opts) = @_;
129 48         82 my $opthash = $opts->{$opt};
130 48 50       92 return unless $opthash;
131 48         80 my $ospec = $opthash->{ospec};
132 48         160 for (keys %$opts) {
133 632         843 my $v = $opts->{$_};
134 632 100       1252 $seen_opts->{$_}++ if $v->{ospec} eq $ospec;
135             }
136             }
137              
138             $SPEC{complete_cli_arg} = {
139             v => 1.1,
140             summary => 'Complete command-line argument using '.
141             'Getopt::Long specification',
142             description => <<'_',
143              
144             This routine can complete option names, where the option names are retrieved
145             from specification. If you provide completion routine in
146             `completion`, you can also complete _option values_ and _arguments_.
147              
148             Note that this routine does not use (it does its own parsing)
149             and currently is not affected by Getopt::Long's configuration. Its behavior
150             mimics Getopt::Long under these configuration: `no_ignore_case`, `bundling` (or
151             `no_bundling` if the `bundling` option is turned off). Which I think is the
152             sensible default. This routine also does not currently support `auto_help` and
153             `auto_version`, so you'll need to add those options specifically if you want to
154             recognize `--help/-?` and `--version`, respectively.
155              
156             _
157             args => {
158             getopt_spec => {
159             summary => 'Getopt::Long specification',
160             schema => 'array*',
161             req => 1,
162             },
163             completion => {
164             summary =>
165             'Completion routine to complete option value/argument',
166             schema => 'code*',
167             description => <<'_',
168              
169             Completion code will receive a hash of arguments (`%args`) containing these
170             keys:
171              
172             * `type` (str, what is being completed, either `optval`, or `arg`)
173             * `word` (str, word to be completed)
174             * `cword` (int, position of words in the words array, starts from 0)
175             * `opt` (str, option name, e.g. `--str`; undef if we're completing argument)
176             * `ospec` (str, Getopt::Long option spec, e.g. `str|S=s`; undef when completing
177             argument)
178             * `argpos` (int, argument position, zero-based; undef if type='optval')
179             * `nth` (int, the number of times this option has seen before, starts from 0
180             that means this is the first time this option has been seen; undef when
181             type='arg')
182             * `seen_opts` (hash, all the options seen in `words`)
183             * `parsed_opts` (hash, options parsed the standard/raw way)
184              
185             as well as all keys from `extras` (but these won't override the above keys).
186              
187             and is expected to return a completion answer structure as described in
188             `Complete` which is either a hash or an array. The simplest form of answer is
189             just to return an array of strings. The various `complete_*` function like those
190             in or the other `Complete::*` modules are suitable to use
191             here.
192              
193             Completion routine can also return undef to express declination, in which case
194             the default completion routine will then be consulted. The default routine
195             completes from shell environment variables (`$FOO`), Unix usernames (`~foo`),
196             and files/directories.
197              
198             Example:
199              
200             use Complete::Unix qw(complete_user);
201             use Complete::Util qw(complete_array_elem);
202             complete_cli_arg(
203             getopt_spec => [
204             'help|h' => sub{...},
205             'format=s' => \$format,
206             'user=s' => \$user,
207             ],
208             completion => sub {
209             my %args = @_;
210             my $word = $args{word};
211             my $ospec = $args{ospec};
212             if ($ospec && $ospec eq 'format=s') {
213             complete_array_elem(array=>[qw/json text xml yaml/], word=>$word);
214             } else {
215             complete_user(word=>$word);
216             }
217             },
218             );
219              
220             _
221             },
222             words => {
223             summary => 'Command line arguments, like @ARGV',
224             description => <<'_',
225              
226             See function `parse_cmdline` in on how to produce this (if
227             you're using bash).
228              
229             _
230             schema => 'array*',
231             req => 1,
232             },
233             cword => {
234             summary =>
235             "Index in words of the word we're trying to complete",
236             description => <<'_',
237              
238             See function `parse_cmdline` in on how to produce this (if
239             you're using bash).
240              
241             _
242             schema => 'int*',
243             req => 1,
244             },
245             extras => {
246             summary => 'Add extra arguments to completion routine',
247             schema => 'hash',
248             description => <<'_',
249              
250             The keys from this `extras` hash will be merged into the final `%args` passed to
251             completion routines. Note that standard keys like `type`, `word`, and so on as
252             described in the function description will not be overwritten by this.
253              
254             _
255             },
256             bundling => {
257             schema => 'bool*',
258             default => 1,
259             'summary.alt.bool.not' => 'Turn off bundling',
260             description => <<'_',
261              
262             If you turn off bundling, completion of short-letter options won't support
263             bundling (e.g. `-b` won't add more single-letter options), but single-dash
264             multiletter options can be recognized. Currently only those specified with a
265             single dash will be completed. For example if you have `-foo=s` in your option
266             specification, `-f` can complete it.
267              
268             This can be used to complete old-style programs, e.g. emacs which has options
269             like `-nw`, `-nbc` etc (but also have double-dash options like
270             `--no-window-system` or `--no-blinking-cursor`).
271              
272             _
273             },
274             },
275             result_naked => 1,
276             result => {
277             schema => ['any*' => of => ['hash*', 'array*']],
278             description => <<'_',
279              
280             You can use `format_completion` function in module to format
281             the result of this function for bash.
282              
283             _
284             },
285             };
286             sub complete_cli_arg {
287 35     35 1 112644 require Complete::Util;
288 35         6583 require Getopt::Long::Util;
289              
290 35         1972 my %args = @_;
291              
292 35         70 my $fname = __PACKAGE__ . "::complete_cli_arg"; # XXX use __SUB__
293 35         56 my $fres;
294              
295 35 50       96 $args{words} or die "Please specify words";
296 35         54 my @words = @{ $args{words} };
  35         88  
297 35 50       97 defined(my $cword = $args{cword}) or die "Please specify cword";
298 35 50       91 my $gospec = $args{getopt_spec} or die "Please specify getopt_spec";
299 35         48 my $comp = $args{completion};
300 35   100     150 my $extras = $args{extras} // {};
301 35   100     117 my $bundling = $args{bundling} // 1;
302 35         58 my %parsed_opts;
303              
304             # backward compatibility: gospec was expected to be a hash, now an array
305 35 100       90 if (ref $gospec eq 'HASH') {
306 1         2 my $ary_gospec = [];
307 1         4 for (keys %$gospec) {
308 2         4 push @$ary_gospec, $_;
309 2 50       9 push @$ary_gospec, $gospec->{$_} if ref $gospec->{$_};
310             }
311 1         2 $gospec = $ary_gospec;
312             }
313              
314 35 50       80 log_trace('[compgl] entering %s(), words=%s, cword=%d, word=<%s>',
315             $fname, \@words, $cword, $words[$cword]) if $COMPLETE_GETOPT_LONG_TRACE;
316              
317             # strip hash storage from getopt_spec
318 35 100       83 shift @$gospec if ref $gospec->[0] eq 'HASH';
319              
320             # parse all options first & supply default completion routine
321 35         47 my %opts;
322 35         50 my $i = -1;
323 35         53 while (++$i <= $#{$gospec}) {
  248         564  
324 213         426 my $ospec = $gospec->[$i];
325 213 100 100     311 my $dest = $i+1 <= $#{$gospec} && ref $gospec->[$i+1] ?
326             splice(@$gospec, $i+1, 1) : undef;
327              
328 213 50       514 my $res = Getopt::Long::Util::parse_getopt_long_opt_spec($ospec)
329             or die "Can't parse option spec '$ospec'";
330 213 50       10313 next if $res->{is_arg};
331 213 100 66     915 $res->{min_vals} //= $res->{type} ? 1 : 0;
332 213 100 100     1095 $res->{max_vals} //= $res->{type} || $res->{opttype} ? 1:0;
      66        
333 213         301 for my $o0 (@{ $res->{opts} }) {
  213         459  
334 363 100 100     1143 my @ary = $res->{is_neg} && length($o0) > 1 ?
335             ([$o0, 0], ["no$o0",1], ["no-$o0",1]) : ([$o0,0]);
336 363         628 for my $elem (@ary) {
337 411         621 my $o = $elem->[0];
338 411         586 my $is_neg = $elem->[1];
339             my $k = length($o)==1 ||
340 411 100 100     1448 (!$bundling && $res->{dash_prefix} eq '-') ?
341             "-$o" : "--$o";
342 411         1987 $opts{$k} = {
343             name => $k,
344             ospec => $ospec,
345             dest => $dest,
346             parsed => $res,
347             is_neg => $is_neg,
348             };
349             }
350             }
351             }
352 35         460 my @optnames = sort keys %opts;
353              
354             my $code_get_summary = sub {
355             # currently we only extract summaries from Rinci metadata and
356             # Perinci::CmdLine object
357 169 50   169   290 return unless $extras;
358 169         240 my $ggls_res = $extras->{ggls_res};
359 169 50       480 return unless $ggls_res;
360 0         0 my $cmdline = $extras->{cmdline};
361 0 0       0 return unless $cmdline;
362 0         0 my $r = $extras->{r};
363 0 0       0 return unless $r;
364              
365 0         0 my $optname = shift;
366 0         0 my $ospec = $opts{$optname}{ospec};
367 0 0       0 return unless $ospec; # shouldn't happen
368 0         0 my $specmeta = $ggls_res->[3]{'func.specmeta'};
369 0         0 my $ospecmeta = $specmeta->{$ospec};
370              
371 0 0       0 return $ospecmeta->{summary} if defined $ospecmeta->{summary};
372              
373 0 0       0 if ($ospecmeta->{is_alias}) {
374 0         0 my $real_ospecmeta = $specmeta->{ $ospecmeta->{alias_for} };
375 0         0 my $real_opt = $real_ospecmeta->{parsed}{opts}[0];
376 0 0       0 $real_opt = length($real_opt) == 1 ? "-$real_opt" : "--$real_opt";
377 0         0 return "Alias for $real_opt";
378             }
379              
380 0 0       0 if (defined(my $coptname = $ospecmeta->{common_opt})) {
381             # it's a common Perinci::CmdLine option
382 0         0 my $coptspec = $cmdline->{common_opts}{$coptname};
383             #use DD; dd $coptspec;
384 0 0       0 return unless $coptspec;
385              
386 0         0 my $summ;
387             # XXX translate
388 0 0       0 if ($opts{$optname}{is_neg}) {
389 0         0 $summ = $coptspec->{"summary.alt.bool.not"};
390 0 0       0 return $summ if defined $summ;
391 0         0 my $pos_opt = $ospecmeta->{pos_opts}[0];
392 0 0       0 $pos_opt = length($pos_opt) == 1 ? "-$pos_opt" : "--$pos_opt";
393 0         0 return "The opposite of $pos_opt";
394             } else {
395 0         0 $summ = $coptspec->{"summary.alt.bool.yes"};
396 0 0       0 return $summ if defined $summ;
397 0         0 $summ = $coptspec->{"summary"};
398 0 0       0 return $summ if defined $summ;
399             }
400             } else {
401             # it's option from function argument
402 0         0 my $arg = $ospecmeta->{arg};
403 0         0 my $argspec = $extras->{r}{meta}{args}{$arg};
404             #use DD; dd $argspec;
405              
406 0         0 my $summ;
407             # XXX translate
408             #use DD; dd {optname=>$optname, ospecmeta=>$ospecmeta};
409 0 0       0 if ($ospecmeta->{is_neg}) {
410 0         0 $summ = $argspec->{"summary.alt.bool.not"};
411 0 0       0 return $summ if defined $summ;
412 0         0 my $pos_opt = $ospecmeta->{pos_opts}[0];
413 0 0       0 $pos_opt = length($pos_opt) == 1 ? "-$pos_opt" : "--$pos_opt";
414 0         0 return "The opposite of $pos_opt";
415             } else {
416 0         0 $summ = $argspec->{"summary.alt.bool.yes"};
417 0 0       0 return $summ if defined $summ;
418 0         0 $summ = $argspec->{"summary"};
419 0 0       0 return $summ if defined $summ;
420             }
421             }
422              
423 0         0 return;
424 35         317 };
425              
426 35         75 my %seen_opts;
427              
428             # for each word (each element in this array), we try to find out whether
429             # it's supposed to complete option name, or option value, or argument, or
430             # separator (or more than one of them). plus some other information.
431             #
432             # each element is a hash. if hash contains 'optname' key then it expects an
433             # option name. if hash contains 'optval' key then it expects an option
434             # value.
435             #
436             # 'short_only' means that the word is not to be completed with long option
437             # name, only (bundle of) one-letter option names.
438              
439             my @expects;
440              
441 35         57 $i = -1;
442 35         50 my $argpos = 0;
443              
444             WORD:
445 35         48 while (1) {
446 80 100       212 last WORD if ++$i >= @words;
447 48         93 my $word = $words[$i];
448             #say "D:i=$i, word=$word, ~~\@words=",~~@words;
449              
450 48 50 66     112 if ($word eq '--' && $i != $cword) {
451 0         0 $expects[$i] = {separator=>1};
452 0         0 while (1) {
453 0         0 $i++;
454 0 0       0 last WORD if $i >= @words;
455 0         0 $expects[$i] = {arg=>1, argpos=>$argpos++};
456             }
457             }
458              
459 48 100       217 if ($word =~ /\A-/) {
460              
461             # check if it is a (bundle) of short option names
462             SHORT_OPTS:
463             {
464             # it's not a known short option
465 41 100       65 last unless $opts{"-".substr($word,1,1)};
  41         148  
466              
467             # not a bundle, regard as only a single short option name
468 12 100       51 last unless $bundling;
469              
470             # expand bundle
471 11         18 my $j = $i;
472 11         22 my $rest = substr($word, 1);
473 11         17 my @inswords;
474             my $encounter_equal_sign;
475             EXPAND:
476 11         21 while (1) {
477 27 100       94 $rest =~ s/(.)// or last;
478 20         53 my $opt = "-$1";
479 20         37 my $opthash = $opts{$opt};
480 20 50       38 unless ($opthash) {
481             # we encounter an unknown option, doubt that this is a
482             # bundle of short option name, it could be someone
483             # typing --long as -long
484 0         0 @inswords = ();
485 0         0 $expects[$i]{short_only} = 0;
486 0         0 $rest = $word;
487 0         0 last EXPAND;
488             }
489 20 100       46 if ($opthash->{parsed}{max_vals}) {
490             # stop after an option that requires value
491 4         12 _mark_seen(\%seen_opts, $opt, \%opts);
492              
493 4 100       23 if ($i == $j) {
494 2         6 $words[$i] = $opt;
495             } else {
496 2         5 push @inswords, $opt;
497 2         4 $j++;
498             }
499              
500 4         5 my $expand;
501 4 100       11 if (length $rest) {
502 2         3 $expand++;
503             # complete -Sfoo^ is completing option value
504 2 100       10 $expects[$j > $i ? $j+1 : $j+2]{do_complete_optname} = 0;
505 2 100       8 $expects[$j > $i ? $j+1 : $j+2]{optval} = $opt;
506             } else {
507             # complete -S^ as [-S] to add space
508 2 100       11 $expects[$j > $i ? $j-1 : $j]{optname} = $opt;
509             $expects[$j > $i ? $j-1 : $j]{comp_result} = [
510 2 100       23 substr($word, 0, length($word)-length($rest))];
511             }
512              
513 4 50       14 if ($rest =~ s/\A=//) {
514 0         0 $encounter_equal_sign++;
515             }
516              
517 4 100       10 if ($expand) {
518 2         7 push @inswords, "=", $rest;
519 2         4 $j+=2;
520             }
521 4         19 last EXPAND;
522             }
523             # continue splitting
524 16         51 _mark_seen(\%seen_opts, $opt, \%opts);
525 16 100       44 if ($i == $j) {
526 9         19 $words[$i] = $opt;
527             } else {
528 7         16 push @inswords, $opt;
529             }
530 16         29 $j++;
531             }
532              
533             #use DD; print "D:inswords: "; dd \@inswords;
534              
535 11 50       33 my $prefix = $encounter_equal_sign ? '' :
536             substr($word, 0, length($word)-length($rest));
537 11         27 splice @words, $i+1, 0, @inswords;
538 11         34 for (0..@inswords) {
539 24         64 $expects[$i+$_]{prefix} = $prefix;
540 24         54 $expects[$i+$_]{word} = $rest;
541             }
542 11         20 $cword += @inswords;
543 11         17 $i += @inswords;
544 11         21 $word = $words[$i];
545 11   50     44 $expects[$i]{short_only} //= 1;
546             } # SHORT_OPTS
547              
548             # split --foo=val -> --foo, =, val
549             SPLIT_EQUAL:
550             {
551 41 100       68 if ($word =~ /\A(--?[^=]+)(=)(.*)/) {
  41         109  
552 4         25 splice @words, $i, 1, $1, $2, $3;
553 4         12 $word = $1;
554 4 50       11 $cword += 2 if $cword >= $i;
555             }
556             }
557              
558 41         73 my $opt = $word;
559 41         93 my $matching_opts = _matching_opts($opt, \%opts);
560              
561 41 100       126 if (keys(%$matching_opts) == 1) {
562 28         67 my $opthash = $matching_opts->{ (keys %$matching_opts)[0] };
563 28         59 $opt = $opthash->{name};
564 28         83 $expects[$i]{optname} = $opt;
565 28   100     84 my $nth = $seen_opts{$opt} // 0;
566 28         54 $expects[$i]{nth} = $nth;
567 28         66 _mark_seen(\%seen_opts, $opt, \%opts);
568              
569 28         72 my $min_vals = $opthash->{parsed}{min_vals};
570 28         45 my $max_vals = $opthash->{parsed}{max_vals};
571             #say "D:min_vals=$min_vals, max_vals=$max_vals";
572              
573             # detect = after --opt
574 28 100 100     99 if ($i+1 < @words && $words[$i+1] eq '=') {
575 3         4 $i++;
576 3         14 $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
577             # force expecting a value due to =
578 3         5 $min_vals = 1;
579 3 100       9 $max_vals = $min_vals if $max_vals < $min_vals;
580             }
581              
582 28         67 for (1 .. $min_vals) {
583 16         24 $i++;
584 16 100       68 last WORD if $i >= @words;
585 13         53 $expects[$i]{optval} = $opt;
586 13         26 $expects[$i]{nth} = $nth;
587 13         17 push @{ $parsed_opts{$opt} }, $words[$i];
  13         67  
588             }
589 25         149 for (1 .. $max_vals-$min_vals) {
590 1 50       6 last if $i+$_ >= @words;
591 1 50       5 last if $words[$i+$_] =~ /\A-/; # a new option
592 1         5 $expects[$i+$_]{optval} = $opt; # but can also be optname
593 1         2 $expects[$i]{nth} = $nth;
594 1         4 push @{ $parsed_opts{$opt} }, $words[$i+$_];
  1         7  
595             }
596             } else {
597             # an unknown or still ambiguous option, assume it doesn't
598             # require argument, unless it's --opt= or --opt=foo
599 13         24 $opt = undef;
600 13         35 $expects[$i]{optname} = $opt;
601 13         84 my $possible_optnames = [sort keys %$matching_opts];
602 13         31 $expects[$i]{possible_optnames} = $possible_optnames;
603              
604             # detect = after --opt
605 13 100 100     77 if ($i+1 < @words && $words[$i+1] eq '=') {
606 1         3 $i++;
607 1         6 $expects[$i] = {separator=>1, optval=>undef, possible_optnames=>$possible_optnames, word=>''};
608 1 50       5 if ($i+1 < @words) {
609 1         2 $i++;
610 1         13 $expects[$i]{optval} = $opt;
611 1         7 $expects[$i]{possible_optnames} = $possible_optnames;
612             }
613             }
614             }
615             } else {
616 7         22 $expects[$i]{optname} = '';
617 7         13 $expects[$i]{arg} = 1;
618 7         15 $expects[$i]{argpos} = $argpos++;
619             }
620             }
621              
622 35         61 my $exp = $expects[$cword];
623 35   100     131 my $word = $exp->{word} // $words[$cword];
624              
625             #use DD; say "D:opts: "; dd \%opts;
626             #use DD; print "D:words: "; dd \@words;
627             #say "D:cword: $cword";
628             #use DD; print "D:expects: "; dd \@expects;
629             #use DD; print "D:seen_opts: "; dd \%seen_opts;
630             #use DD; print "D:parsed_opts: "; dd \%parsed_opts;
631             #use DD; print "D:exp: "; dd $exp;
632             #use DD; say "D:word:<$word>";
633              
634 35         61 my @answers;
635              
636             # complete option names
637             {
638 35 100       92 last if $word =~ /\A[^-]/;
639 33 100       67 last unless exists $exp->{optname};
640             last if defined($exp->{do_complete_optname}) &&
641 26 50 33     72 !$exp->{do_complete_optname};
642 26 100       49 if ($exp->{comp_result}) {
643 2         5 push @answers, $exp->{comp_result};
644 2         4 last;
645             }
646             #say "D:completing option names";
647 24         40 my $opt = $exp->{optname};
648 24         59 my @o;
649             my @osumms;
650 24         0 my $o_has_summaries;
651 24         46 for my $optname (@optnames) {
652 247         354 my $repeatable = 0;
653 247 100 100     596 next if $exp->{short_only} && $optname =~ /\A--/;
654 197 100       362 if ($seen_opts{$optname}) {
655 34         53 my $opthash = $opts{$optname};
656 34         54 my $parsed = $opthash->{parsed};
657 34         48 my $dest = $opthash->{dest};
658 34 100 66     128 if (ref $dest eq 'ARRAY') {
    100          
659 1         3 $repeatable = 1;
660             } elsif ($parsed->{desttype} || $parsed->{is_inc}) {
661 3         5 $repeatable = 1;
662             }
663             }
664             # skip options that have been specified and not repeatable
665             #use DD; dd {'$_'=>$_, seen=>$seen_opts{$_}, repeatable=>$repeatable, opt=>$opt};
666             next if $seen_opts{$optname} && !$repeatable && (
667             # long option has been specified
668             (!$opt || $opt ne $optname) ||
669             # short option (in a bundle) has been specified
670             (defined($exp->{prefix}) &&
671 197 100 100     503 index($exp->{prefix}, substr($opt, 1, 1)) >= 0));
      66        
      100        
672 169 100       275 if (defined $exp->{prefix}) {
673 18         26 my $o = $optname; $o =~ s/\A-//;
  18         48  
674 18         45 push @o, "$exp->{prefix}$o";
675             } else {
676 151         246 push @o, $optname;
677             }
678 169   50     278 my $summ = $code_get_summary->($optname) // '';
679 169 50       274 if (length $summ) {
680 0         0 $o_has_summaries = 1;
681 0         0 push @osumms, $summ;
682             } else {
683 169         291 push @osumms, '';
684             }
685             }
686             #use DD; dd \@o;
687             #use DD; dd \@osumms;
688 24         100 my $compres = Complete::Util::complete_array_elem(
689             array => \@o, word => $word,
690             (summaries => \@osumms) x !!$o_has_summaries,
691             );
692 24 50       4069 log_trace('[compgl] adding result from option names, '.
693             'matching options=%s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
694 24         44 push @answers, $compres;
695 24 100 100     124 if (!exists($exp->{optval}) && !exists($exp->{arg})) {
696 17         56 $fres = {words=>$compres, esc_mode=>'option'};
697 17         270 goto RETURN_RES;
698             }
699             }
700              
701             # complete option value
702             {
703 35 100       46 last unless exists($exp->{optval});
  18         45  
704             #say "D:completing option value";
705 10         23 my $opt = $exp->{optval};
706 10 100       15 my $opthash; $opthash = $opts{$opt} if $opt;
  10         24  
707             my %compargs = (
708             %$extras,
709             type=>'optval', words=>\@words, cword=>$args{cword},
710             word=>$word, opt=>($opt // $exp->{possible_optnames}), ospec=>$opthash->{ospec},
711 10   66     109 argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
712             parsed_opts=>\%parsed_opts,
713             );
714 10         20 my $compres;
715 10 50       26 if ($comp) {
716 10 50       25 log_trace("[compgl] invoking routine supplied from 'completion' argument to complete option value, option=<%s>", $opt) if $COMPLETE_GETOPT_LONG_TRACE;
717 10         70 $compres = $comp->(%compargs);
718             Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
719 10 100       339 if defined $exp->{prefix};
720 10 50       70 log_trace('[compgl] adding result from routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
721             }
722 10 50 33     38 if (!$compres || !$comp) {
723 0         0 $compres = _default_completion(%compargs);
724             Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
725 0 0       0 if defined $exp->{prefix};
726 0 0       0 log_trace('[compgl] adding result from default '.
727             'completion routine') if $COMPLETE_GETOPT_LONG_TRACE;
728             }
729 10         41 push @answers, $compres;
730             }
731              
732             # complete argument
733             {
734 18 100       30 last unless exists($exp->{arg});
  18         25  
  18         53  
735             my %compargs = (
736             %$extras,
737             type=>'arg', words=>\@words, cword=>$args{cword},
738             word=>$word, opt=>undef, ospec=>undef,
739 7         73 argpos=>$exp->{argpos}, seen_opts=>\%seen_opts,
740             parsed_opts=>\%parsed_opts,
741             );
742 7 50       29 log_trace('[compgl] invoking \'completion\' routine '.
743             'to complete argument') if $COMPLETE_GETOPT_LONG_TRACE;
744 7 100       13 my $compres; $compres = $comp->(%compargs) if $comp;
  7         35  
745 7 100       34 if (!defined $compres) {
746 1         9 $compres = _default_completion(%compargs);
747 1 50       5 log_trace('[compgl] adding result from default '.
748             'completion routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
749             }
750 7         24 push @answers, $compres;
751             }
752              
753 18 50       39 log_trace("[compgl] combining result from %d source(s)", scalar @answers) if $COMPLETE_GETOPT_LONG_TRACE;
754 18   50     56 $fres = Complete::Util::combine_answers(@answers) // [];
755              
756 35 50       1166 RETURN_RES:
757             log_trace("[compgl] leaving %s(), result=%s", $fname, $fres) if $COMPLETE_GETOPT_LONG_TRACE;
758 35         905 $fres;
759             }
760              
761             1;
762             # ABSTRACT: Complete command-line argument using Getopt::Long specification
763              
764             __END__