App-PickRandomLines
view release on metacpan or search on metacpan
script/_pick view on Meta::CPAN
#=head1 COPYRIGHT AND LICENSE
#
#Copyright 2003 Matthew Simon Cavalletto. You may contact the author
#directly at C<evo@cpan.org> or C<simonm@cavalletto.org>.
#
#Code initially derived from Ref.pm. Portions Copyright 1994 David Muir Sharnoff.
#
#Interface based by Clone by Ray Finch with contributions from chocolateboy.
#Portions Copyright 2001 Ray Finch. Portions Copyright 2001 chocolateboy.
#
#You may use, modify, and distribute this software under the same terms as Perl.
#
#=cut
### Complete/Bash.pm ###
#package Complete::Bash;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter 'import';
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-09-08'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.337'; # VERSION
#
#our @EXPORT_OK = qw(
# point
# parse_cmdline
# join_wordbreak_words
# format_completion
# );
#
#our %SPEC;
#
#$SPEC{':package'} = {
# v => 1.1,
# summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
# my ($user, $slash) = @_;
# my @ent;
# if (length $user) {
# @ent = getpwnam($user);
# } else {
# @ent = getpwuid($>);
# $user = $ent[0];
# }
# return $ent[7] . $slash if @ent;
# "~$user$slash"; # return as-is when failed
#}
#
#sub _add_unquoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word, $after_ws) = @_;
#
# #say "D:add_unquoted word=$word is_cur_word=$is_cur_word after_ws=$after_ws";
#
# $word =~ s!^(~)(\w*)(/|\z) | # 1) tilde 2) username 3) optional slash
# \\(.) | # 4) escaped char
# \$(\w+) # 5) variable name
# !
# $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
# $4 ? $4 :
# ($is_cur_word ? "\$$5" : $ENV{$5})
# !egx;
# $word;
#}
#
#sub _add_double_quoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word) = @_;
#
# $word =~ s!\\(.) | # 1) escaped char
# \$(\w+) # 2) variable name
# !
# $1 ? $1 :
# ($is_cur_word ? "\$$2" : $ENV{$2})
# !egx;
# $word;
#}
#
#sub _add_single_quoted {
# my $word = shift;
# $word =~ s/\\(.)/$1/g;
# $word;
#}
#
#$SPEC{point} = {
# v => 1.1,
# summary => 'Return line with point marked by a marker',
# description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
# point("^foo") # => ("foo", 0)
# point("fo^o") # => ("foo", 2)
#
#_
# args_as => 'array',
# args => {
# cmdline => {
# summary => 'Command-line which contains a marker character',
# schema => 'str*',
# pos => 0,
# },
# marker => {
# summary => 'Marker character',
# schema => ['str*', len=>1],
# default => '^',
# pos => 1,
script/_pick view on Meta::CPAN
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
# position of cursor, for example (`^` marks the position of cursor):
# `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
# doing tab completion.
#
#_
# schema => 'hash*',
# pos => 2,
# },
# },
# result => {
# schema => ['array*', len=>2],
# description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in `@ARGV`), you need to strip the first element from
#`$words` and reduce `$cword` by 1.
#
#
#_
# },
# result_naked => 1,
# links => [
# ],
#};
#sub parse_cmdline {
# no warnings 'uninitialized';
# my ($line, $point, $opts) = @_;
#
# $line //= $ENV{COMP_LINE};
# $point //= $ENV{COMP_POINT} // 0;
#
# die "$0: COMP_LINE not set, make sure this script is run under ".
# "bash completion (e.g. through complete -C)\n" unless defined $line;
#
# log_trace "[compbash] parse_cmdline(): input: line=<$line> point=<$point>"
# if $ENV{COMPLETE_BASH_TRACE};
#
# my @words;
# my $cword;
# my $pos = 0;
# my $pos_min_ws = 0;
# my $after_ws = 1; # XXX what does this variable mean?
# my $chunk;
# my $add_blank;
# my $is_cur_word;
# $line =~ s!( # 1) everything
# (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*) | # 2) open " 3) content 4) space after
# (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*) | # 5) open ' 6) content 7) space after
# ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) | # 8) unquoted word 9) space after
# ([\@><=|&\(:]+) | # 10) non-whitespace word-breaking characters
# \s+
# )!
# $pos += length($1);
# #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
# #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
# if ($2 || $5 || defined($8)) {
# # double-quoted/single-quoted/unquoted chunk
#
# if (not(defined $cword)) {
# $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
# #say "D:pos_min_ws=$pos_min_ws";
# if ($point <= $pos_min_ws) {
# $cword = @words - ($after_ws ? 0 : 1);
# } elsif ($point < $pos) {
# $cword = @words + 1 - ($after_ws ? 0 : 1);
# $add_blank = 1;
# }
# }
#
# if ($after_ws) {
# $is_cur_word = defined($cword) && $cword==@words;
# } else {
# $is_cur_word = defined($cword) && $cword==@words-1;
# }
# #say "D:is_cur_word=$is_cur_word";
# $chunk =
# $2 ? _add_double_quoted($3, $is_cur_word) :
# $5 ? _add_single_quoted($6) :
# _add_unquoted($8, $is_cur_word, $after_ws);
# if ($opts && $opts->{truncate_current_word} &&
# $is_cur_word && $pos > $point) {
# $chunk = substr(
# $chunk, 0, length($chunk)-($pos_min_ws-$point));
# #say "D:truncating current word to <$chunk>";
# }
# if ($after_ws) {
# push @words, $chunk;
# } else {
# $words[-1] .= $chunk;
# }
# if ($add_blank) {
# push @words, '';
# $add_blank = 0;
# }
# $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
#
# } elsif ($10) {
# # non-whitespace word-breaking characters
# push @words, $10;
# $after_ws = 1;
# } else {
# # whitespace
# $after_ws = 1;
# }
# !egx;
#
# $cword //= @words;
# $words[$cword] //= '';
#
# log_trace "[compbash] parse_cmdline(): result: words=%s, cword=%s", \@words, $cword
# if $ENV{COMPLETE_BASH_TRACE};
#
# [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
# v => 1.1,
# summary => 'Post-process parse_cmdline() result by joining some words',
# description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
# "'@><=;|&(:
#
#So if command-line is:
#
# command --module=Data::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "--module", "=", "Data", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
# ["command", "--module=Data::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
# my ($words, $cword) = @_;
# my $new_words = [];
# my $i = -1;
script/_pick view on Meta::CPAN
# # to use fzf instead of passing to bash directly
# my @words;
# my @summaries;
# my @res;
# my $has_summary;
#
# my $code_return_message = sub {
# # display a message instead of list of words. we send " " (ASCII space)
# # which bash does not display, so we can display a line of message while
# # the user does not get the message as the completion. I've also tried
# # \000 to \037 instead of space (\040) but nothing works better.
# my $msg = shift;
# if ($msg =~ /\A /) {
# $msg =~ s/\A +//;
# $msg = " (empty message)" unless length $msg;
# }
# return (sprintf("%-"._terminal_width()."s", $msg), " ");
# };
#
# FORMAT_MESSAGE:
# # display a message instead of list of words. we send " " (ASCII space)
# # which bash does not display, so we can display a line of message while the
# # user does not get the message as the completion. I've also tried \000 to
# # \037 instead of space (\040) but nothing works better.
# if (defined $hcomp->{message}) {
# @res = $code_return_message->($hcomp->{message});
# goto RETURN_RES;
# }
#
# WORKAROUND_PREVENT_BASH_FROM_INSERTING_SPACE:
# {
# last unless @$words == 1;
# if (defined $path_sep) {
# my $re = qr/\Q$path_sep\E\z/;
# my $word;
# if (ref $words->[0] eq 'HASH') {
# $words = [$words->[0], {word=>"$words->[0]{word} "}] if
# $words->[0]{word} =~ $re;
# } else {
# $words = [$words->[0], "$words->[0] "]
# if $words->[0] =~ $re;
# }
# last;
# }
#
# if ($hcomp->{is_partial} ||
# ref $words->[0] eq 'HASH' && $words->[0]{is_partial}) {
# if (ref $words->[0] eq 'HASH') {
# $words = [$words->[0], {word=>"$words->[0]{word} "}];
# } else {
# $words = [$words->[0], "$words->[0] "];
# }
# last;
# }
# }
#
# WORKAROUND_WITH_WORDBREAKS:
# # this is a workaround. since bash breaks words using characters in
# # $COMP_WORDBREAKS, which by default is "'@><=;|&(: this presents a problem
# # we often encounter: if we want to provide with a list of strings
# # containing say ':', most often Perl modules/packages, if user types e.g.
# # "Text::AN" and we provide completion ["Text::ANSI"] then bash will change
# # the word at cursor to become "Text::Text::ANSI" since it sees the current
# # word as "AN" and not "Text::AN". the workaround is to chop /^Text::/ from
# # completion answers. btw, we actually chop /^text::/i to handle
# # case-insensitive matching, although this does not have the ability to
# # replace the current word (e.g. if we type 'text::an' then bash can only
# # replace the current word 'an' with 'ANSI).
# {
# last unless $opts->{workaround_with_wordbreaks} // 1;
# last unless defined $opts->{word};
#
# if ($opts->{word} =~ s/(.+[\@><=;|&\(:])//) {
# my $prefix = $1;
# for (@$words) {
# if (ref($_) eq 'HASH') {
# $_->{word} =~ s/\A\Q$prefix\E//i;
# } else {
# s/\A\Q$prefix\E//i;
# }
# }
# }
# }
#
# ESCAPE_WORDS:
# for my $entry (@$words) {
# my $word = ref($entry) eq 'HASH' ? $entry->{word} : $entry;
# my $summary = (ref($entry) eq 'HASH' ? $entry->{summary} : undef) // '';
# if ($esc_mode eq 'shellvar') {
# # escape $ also
# $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
# } elsif ($esc_mode eq 'none') {
# # no escaping
# } else {
# # default
# $word =~ s!([^A-Za-z0-9,+._/:\$~-])!\\$1!g;
# }
# push @words, $word;
# push @summaries, $summary;
# $has_summary = 1 if length $summary;
# }
#
# my $summary_align = $ENV{COMPLETE_BASH_SUMMARY_ALIGN} // 'left';
# my $max_columns = $ENV{COMPLETE_BASH_MAX_COLUMNS} // 0;
# my $terminal_width = _terminal_width();
# my $column_width = _column_width($terminal_width, $max_columns);
#
# #warn "terminal_width=$terminal_width, column_width=".($column_width // 'undef')."\n";
#
# FORMAT_SUMMARIES: {
# @res = @words;
# last if @words <= 1;
# last unless $has_summary;
# last unless $opts->{show_summaries} //
# $ENV{COMPLETE_BASH_SHOW_SUMMARIES} // 1;
# my $max_entry_width = 8;
# my $max_summ_width = 0;
# for (0..$#words) {
# $max_entry_width = length $words[$_]
# if $max_entry_width < length $words[$_];
# $max_summ_width = length $summaries[$_]
script/_pick view on Meta::CPAN
# if ($opts{$optname}{is_neg}) {
# $summ = $coptspec->{"summary.alt.bool.not"};
# return $summ if defined $summ;
# my $pos_opt = $ospecmeta->{pos_opts}[0];
# $pos_opt = length($pos_opt) == 1 ? "-$pos_opt" : "--$pos_opt";
# return "The opposite of $pos_opt";
# } else {
# $summ = $coptspec->{"summary.alt.bool.yes"};
# return $summ if defined $summ;
# $summ = $coptspec->{"summary"};
# return $summ if defined $summ;
# }
# } else {
# # it's option from function argument
# my $arg = $ospecmeta->{arg};
# my $argspec = $extras->{r}{meta}{args}{$arg};
# #use DD; dd $argspec;
#
# my $summ;
# # XXX translate
# #use DD; dd {optname=>$optname, ospecmeta=>$ospecmeta};
# if ($ospecmeta->{is_neg}) {
# $summ = $argspec->{"summary.alt.bool.not"};
# return $summ if defined $summ;
# my $pos_opt = $ospecmeta->{pos_opts}[0];
# $pos_opt = length($pos_opt) == 1 ? "-$pos_opt" : "--$pos_opt";
# return "The opposite of $pos_opt";
# } else {
# $summ = $argspec->{"summary.alt.bool.yes"};
# return $summ if defined $summ;
# $summ = $argspec->{"summary"};
# return $summ if defined $summ;
# }
# }
#
# return;
# };
#
# my %seen_opts;
#
# # for each word (each element in this array), we try to find out whether
# # it's supposed to complete option name, or option value, or argument, or
# # separator (or more than one of them). plus some other information.
# #
# # each element is a hash. if hash contains 'optname' key then it expects an
# # option name. if hash contains 'optval' key then it expects an option
# # value.
# #
# # 'short_only' means that the word is not to be completed with long option
# # name, only (bundle of) one-letter option names.
#
# my @expects;
#
# $i = -1;
# my $argpos = 0;
#
# WORD:
# while (1) {
# last WORD if ++$i >= @words;
# my $word = $words[$i];
# #say "D:i=$i, word=$word, ~~\@words=",~~@words;
#
# if ($word eq '--' && $i != $cword) {
# $expects[$i] = {separator=>1};
# while (1) {
# $i++;
# last WORD if $i >= @words;
# $expects[$i] = {arg=>1, argpos=>$argpos++};
# }
# }
#
# if ($word =~ /\A-/) {
#
# # check if it is a (bundle) of short option names
# SHORT_OPTS:
# {
# # it's not a known short option
# last unless $opts{"-".substr($word,1,1)};
#
# # not a bundle, regard as only a single short option name
# last unless $bundling;
#
# # expand bundle
# my $j = $i;
# my $rest = substr($word, 1);
# my @inswords;
# my $encounter_equal_sign;
# EXPAND:
# while (1) {
# $rest =~ s/(.)// or last;
# my $opt = "-$1";
# my $opthash = $opts{$opt};
# unless ($opthash) {
# # we encounter an unknown option, doubt that this is a
# # bundle of short option name, it could be someone
# # typing --long as -long
# @inswords = ();
# $expects[$i]{short_only} = 0;
# $rest = $word;
# last EXPAND;
# }
# if ($opthash->{parsed}{max_vals}) {
# # stop after an option that requires value
# _mark_seen(\%seen_opts, $opt, \%opts);
#
# if ($i == $j) {
# $words[$i] = $opt;
# } else {
# push @inswords, $opt;
# $j++;
# }
#
# my $expand;
# if (length $rest) {
# $expand++;
# # complete -Sfoo^ is completing option value
# $expects[$j > $i ? $j+1 : $j+2]{do_complete_optname} = 0;
# $expects[$j > $i ? $j+1 : $j+2]{optval} = $opt;
# } else {
# # complete -S^ as [-S] to add space
# $expects[$j > $i ? $j-1 : $j]{optname} = $opt;
script/_pick view on Meta::CPAN
# }
#
# if ($rest =~ s/\A=//) {
# $encounter_equal_sign++;
# }
#
# if ($expand) {
# push @inswords, "=", $rest;
# $j+=2;
# }
# last EXPAND;
# }
# # continue splitting
# _mark_seen(\%seen_opts, $opt, \%opts);
# if ($i == $j) {
# $words[$i] = $opt;
# } else {
# push @inswords, $opt;
# }
# $j++;
# }
#
# #use DD; print "D:inswords: "; dd \@inswords;
#
# my $prefix = $encounter_equal_sign ? '' :
# substr($word, 0, length($word)-length($rest));
# splice @words, $i+1, 0, @inswords;
# for (0..@inswords) {
# $expects[$i+$_]{prefix} = $prefix;
# $expects[$i+$_]{word} = $rest;
# }
# $cword += @inswords;
# $i += @inswords;
# $word = $words[$i];
# $expects[$i]{short_only} //= 1;
# } # SHORT_OPTS
#
# # split --foo=val -> --foo, =, val
# SPLIT_EQUAL:
# {
# if ($word =~ /\A(--?[^=]+)(=)(.*)/) {
# splice @words, $i, 1, $1, $2, $3;
# $word = $1;
# $cword += 2 if $cword >= $i;
# }
# }
#
# my $opt = $word;
# my $matching_opts = _matching_opts($opt, \%opts);
#
# if (keys(%$matching_opts) == 1) {
# my $opthash = $matching_opts->{ (keys %$matching_opts)[0] };
# $opt = $opthash->{name};
# $expects[$i]{optname} = $opt;
# my $nth = $seen_opts{$opt} // 0;
# $expects[$i]{nth} = $nth;
# _mark_seen(\%seen_opts, $opt, \%opts);
#
# my $min_vals = $opthash->{parsed}{min_vals};
# my $max_vals = $opthash->{parsed}{max_vals};
# #say "D:min_vals=$min_vals, max_vals=$max_vals";
#
# # detect = after --opt
# if ($i+1 < @words && $words[$i+1] eq '=') {
# $i++;
# $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
# # force expecting a value due to =
# $min_vals = 1;
# $max_vals = $min_vals if $max_vals < $min_vals;
# }
#
# for (1 .. $min_vals) {
# $i++;
# last WORD if $i >= @words;
# $expects[$i]{optval} = $opt;
# $expects[$i]{nth} = $nth;
# push @{ $parsed_opts{$opt} }, $words[$i];
# }
# for (1 .. $max_vals-$min_vals) {
# last if $i+$_ >= @words;
# last if $words[$i+$_] =~ /\A-/; # a new option
# $expects[$i+$_]{optval} = $opt; # but can also be optname
# $expects[$i]{nth} = $nth;
# push @{ $parsed_opts{$opt} }, $words[$i+$_];
# }
# } else {
# # an unknown or still ambiguous option, assume it doesn't
# # require argument, unless it's --opt= or --opt=foo
# $opt = undef;
# $expects[$i]{optname} = $opt;
# my $possible_optnames = [sort keys %$matching_opts];
# $expects[$i]{possible_optnames} = $possible_optnames;
#
# # detect = after --opt
# if ($i+1 < @words && $words[$i+1] eq '=') {
# $i++;
# $expects[$i] = {separator=>1, optval=>undef, possible_optnames=>$possible_optnames, word=>''};
# if ($i+1 < @words) {
# $i++;
# $expects[$i]{optval} = $opt;
# $expects[$i]{possible_optnames} = $possible_optnames;
# }
# }
# }
# } else {
# $expects[$i]{optname} = '';
# $expects[$i]{arg} = 1;
# $expects[$i]{argpos} = $argpos++;
# }
# }
#
# my $exp = $expects[$cword];
# my $word = $exp->{word} // $words[$cword];
#
# #use DD; say "D:opts: "; dd \%opts;
# #use DD; print "D:words: "; dd \@words;
# #say "D:cword: $cword";
# #use DD; print "D:expects: "; dd \@expects;
# #use DD; print "D:seen_opts: "; dd \%seen_opts;
# #use DD; print "D:parsed_opts: "; dd \%parsed_opts;
# #use DD; print "D:exp: "; dd $exp;
# #use DD; say "D:word:<$word>";
#
# my @answers;
#
# # complete option names
# {
# last if $word =~ /\A[^-]/;
# last unless exists $exp->{optname};
# last if defined($exp->{do_complete_optname}) &&
# !$exp->{do_complete_optname};
# if ($exp->{comp_result}) {
# push @answers, $exp->{comp_result};
# last;
# }
# #say "D:completing option names";
# my $opt = $exp->{optname};
# my @o;
# my @osumms;
# my $o_has_summaries;
# for my $optname (@optnames) {
# my $repeatable = 0;
# next if $exp->{short_only} && $optname =~ /\A--/;
# if ($seen_opts{$optname}) {
# my $opthash = $opts{$optname};
# my $parsed = $opthash->{parsed};
# my $dest = $opthash->{dest};
# if (ref $dest eq 'ARRAY') {
# $repeatable = 1;
# } elsif ($parsed->{desttype} || $parsed->{is_inc}) {
# $repeatable = 1;
# }
# }
# # skip options that have been specified and not repeatable
# #use DD; dd {'$_'=>$_, seen=>$seen_opts{$_}, repeatable=>$repeatable, opt=>$opt};
# next if $seen_opts{$optname} && !$repeatable && (
# # long option has been specified
# (!$opt || $opt ne $optname) ||
# # short option (in a bundle) has been specified
# (defined($exp->{prefix}) &&
# index($exp->{prefix}, substr($opt, 1, 1)) >= 0));
# if (defined $exp->{prefix}) {
# my $o = $optname; $o =~ s/\A-//;
# push @o, "$exp->{prefix}$o";
# } else {
# push @o, $optname;
# }
# my $summ = $code_get_summary->($optname) // '';
# if (length $summ) {
# $o_has_summaries = 1;
# push @osumms, $summ;
# } else {
# push @osumms, '';
# }
# }
# #use DD; dd \@o;
# #use DD; dd \@osumms;
# my $compres = Complete::Util::complete_array_elem(
# array => \@o, word => $word,
# (summaries => \@osumms) x !!$o_has_summaries,
# );
# log_trace('[compgl] adding result from option names, '.
# 'matching options=%s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
# push @answers, $compres;
# if (!exists($exp->{optval}) && !exists($exp->{arg})) {
# $fres = {words=>$compres, esc_mode=>'option'};
# goto RETURN_RES;
# }
# }
#
# # complete option value
# {
# last unless exists($exp->{optval});
# #say "D:completing option value";
# my $opt = $exp->{optval};
# my $opthash; $opthash = $opts{$opt} if $opt;
# my %compargs = (
# %$extras,
# type=>'optval', words=>\@words, cword=>$args{cword},
# word=>$word, opt=>($opt // $exp->{possible_optnames}), ospec=>$opthash->{ospec},
# argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
# parsed_opts=>\%parsed_opts,
# );
# my $compres;
# if ($comp) {
# log_trace("[compgl] invoking routine supplied from 'completion' argument to complete option value, option=<%s>", $opt) if $COMPLETE_GETOPT_LONG_TRACE;
# $compres = $comp->(%compargs);
# Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
# if defined $exp->{prefix};
# log_trace('[compgl] adding result from routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
# }
# if (!$compres || !$comp) {
# $compres = _default_completion(%compargs);
# Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
# if defined $exp->{prefix};
# log_trace('[compgl] adding result from default '.
# 'completion routine') if $COMPLETE_GETOPT_LONG_TRACE;
# }
# push @answers, $compres;
# }
#
# # complete argument
# {
# last unless exists($exp->{arg});
# my %compargs = (
# %$extras,
# type=>'arg', words=>\@words, cword=>$args{cword},
# word=>$word, opt=>undef, ospec=>undef,
# argpos=>$exp->{argpos}, seen_opts=>\%seen_opts,
# parsed_opts=>\%parsed_opts,
# );
# log_trace('[compgl] invoking \'completion\' routine '.
# 'to complete argument') if $COMPLETE_GETOPT_LONG_TRACE;
# my $compres; $compres = $comp->(%compargs) if $comp;
# if (!defined $compres) {
# $compres = _default_completion(%compargs);
# log_trace('[compgl] adding result from default '.
# 'completion routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
# }
# push @answers, $compres;
# }
#
# log_trace("[compgl] combining result from %d source(s)", scalar @answers) if $COMPLETE_GETOPT_LONG_TRACE;
# $fres = Complete::Util::combine_answers(@answers) // [];
#
# RETURN_RES:
# log_trace("[compgl] leaving %s(), result=%s", $fname, $fres) if $COMPLETE_GETOPT_LONG_TRACE;
# $fres;
#}
#
#1;
## ABSTRACT: Complete command-line argument using Getopt::Long specification
#
#__END__
script/_pick view on Meta::CPAN
#
# RECURSE_MATCHING_ALL_AT_ONCE: {
# # recurse matching all-at-once is way simpler, we just need to collect
# # all the nodes, then complate against it.
# last unless $recurse && $recurse_matching eq 'all-at-once';
# my @dirs = ($starting_path);
# while (@dirs) {
# my $dir = shift @dirs;
# my $listres = $list_func->($dir, '', 0);
# next unless $listres && @$listres;
# L1:
# for my $e (@$listres) {
# my $p = $dir =~ $re_ends_with_path_sep ?
# "$dir$e" : "$dir$path_sep$e";
#
# {
# local $_ = $p; # convenience for filter func
# next L1 if $filter_func && !$filter_func->($p);
# }
#
# my $is_dir;
# if ($e =~ $re_ends_with_path_sep) {
# $is_dir = 1;
# } else {
# local $_ = $p; # convenience for is_dir_func
# $is_dir = $is_dir_func->($p);
# }
#
# if ($is_dir) { push @dirs, $p }
#
# # format result
# $p = "$result_prefix$p" if length($result_prefix);
# substr($p, 0, $cut_chars) = '' if $cut_chars;
# unless ($p =~ /\Q$path_sep\E\z/) {
# $p .= $path_sep if $is_dir;
# }
#
# push @res, $p unless ($is_dir && $exclude_dir) || (!$is_dir && $exclude_leaf);
# } # entry
# } # while dirs
# @res = @{ Complete::Util::complete_array_elem(
# array => \@res,
# word => $word,
# ) };
# goto RETURN_RESULT;
# }
#
# # split word by into path elements, as we want to dig level by level (needed
# # when doing case-insensitive search on a case-sensitive tree).
# my @intermediate_dirs;
# {
# @intermediate_dirs = split qr/\Q$path_sep/, $word;
# @intermediate_dirs = ('') if !@intermediate_dirs;
# push @intermediate_dirs, '' if $word =~ $re_ends_with_path_sep;
# }
#
# # extract leaf path, because this one is treated differently
# my $leaf = pop @intermediate_dirs;
# @intermediate_dirs = ('') if !@intermediate_dirs;
#
# #say "D:starting_path=<$starting_path>";
# #say "D:intermediate_dirs=[",join(", ", map{"<$_>"} @intermediate_dirs),"]";
# #say "D:leaf=<$leaf>";
#
# # candidate for intermediate paths. when doing case-insensitive search,
# # there maybe multiple candidate paths for each dir, for example if
# # word='../foo/s' and there is '../foo/Surya', '../Foo/sri', '../FOO/SUPER'
# # then candidate paths would be ['../foo', '../Foo', '../FOO'] and the
# # filename should be searched inside all those dirs. everytime we drill down
# # to deeper subdirectories, we adjust this list by removing
# # no-longer-eligible candidates.
# my @candidate_paths;
#
# for my $i (0..$#intermediate_dirs) {
# my $intdir = $intermediate_dirs[$i];
# my $intdir_with_path_sep = "$intdir$path_sep";
# my @dirs;
# if ($i == 0) {
# # first path elem, we search starting_path first since
# # candidate_paths is still empty.
# @dirs = ($starting_path);
# } else {
# # subsequent path elem, we search all candidate_paths
# @dirs = @candidate_paths;
# }
#
# if ($i == $#intermediate_dirs && $intdir eq '') {
# @candidate_paths = @dirs;
# last;
# }
#
# my @new_candidate_paths;
# for my $dir (@dirs) {
# #say "D: intdir list($dir)";
# my $listres = $list_func->($dir, $intdir, 1);
# next unless $listres && @$listres;
# #use DD; say "D: list res=", DD::dump($listres);
# my $matches = Complete::Util::complete_array_elem(
# word => $intdir, array => $listres,
# );
# my $exact_matches = [grep {
# $_ eq $intdir || $_ eq $intdir_with_path_sep
# } @$matches];
# #use Data::Dmp; say "D: word=<$intdir>, matches=", dmp($matches), ", exact_matches=", dmp($exact_matches);
#
# # when doing exp_im_path, check if we have a single exact match. in
# # that case, don't use all the candidates because that can be
# # annoying, e.g. you have 'a/foo' and 'and/food', you won't be able
# # to complete 'a/f' because bash (e.g.) will always cut the answer
# # to 'a' because the candidates are 'a/foo' and 'and/foo' (it will
# # use the shortest common string which is 'a').
# #say "D: num_exact_matches: ", scalar @$exact_matches;
# if (!$exp_im_path || @$exact_matches == 1) {
# $matches = $exact_matches;
# }
#
# for (@$matches) {
# my $p = $dir =~ $re_ends_with_path_sep ?
# "$dir$_" : "$dir$path_sep$_";
# push @new_candidate_paths, $p;
# }
#
# }
# #say "D: candidate_paths=[",join(", ", map{"<$_>"} @new_candidate_paths),"]";
# return [] unless @new_candidate_paths;
# @candidate_paths = @new_candidate_paths;
# }
# log_trace "[comppath] candidate paths: %s", \@candidate_paths if $ENV{COMPLETE_PATH_TRACE};
#
# for my $dir (@candidate_paths) {
# #say "D:opendir($dir)";
# my $listres = $list_func->($dir, $leaf, 0);
# next unless $listres && @$listres;
# my $matches = Complete::Util::complete_array_elem(
# word => $leaf, array => $listres,
# );
# #use DD; dd $matches;
#
# L1:
# for my $e (@$matches) {
# my $p = $dir =~ $re_ends_with_path_sep ?
# "$dir$e" : "$dir$path_sep$e";
# {
# local $_ = $p; # convenience for filter func
# next L1 if $filter_func && !$filter_func->($p);
# }
#
# my $is_dir;
# if ($e =~ $re_ends_with_path_sep) {
# $is_dir = 1;
# } else {
# local $_ = $p; # convenience for is_dir_func
# $is_dir = $is_dir_func->($p);
# }
#
# my @subres;
# if ($is_dir) {
# if ($recurse) {
# @subres = @{complete_path(
# %args,
# starting_path => $p,
# word => '',
# _cut_chars => $cut_chars,
# )};
# } elsif ($dig_leaf) {
# DIG_LEAF:
# {
# my $p2 = _dig_leaf($p, $list_func, $is_dir_func, $filter_func, $path_sep);
# last DIG_LEAF if $p2 eq $p;
# $p = $p2;
# #say "D:p=$p (dig_leaf)";
#
# # check again
# if ($p =~ $re_ends_with_path_sep) {
# $is_dir = 1;
# } else {
# local $_ = $p; # convenience for is_dir_func
# $is_dir = $is_dir_func->($p);
# }
# } # DIG_LEAF
# }
# }
#
# # process into final result
# my $p0 = $p;
# substr($p, 0, $cut_chars) = '' if $cut_chars;
# $p = "$result_prefix$p" if length($result_prefix);
# unless ($p =~ /\Q$path_sep\E\z/) {
# $p .= $path_sep if $is_dir;
# }
# push @res, $p unless ($is_dir && $exclude_dir) || (!$is_dir && $exclude_leaf);
# push @res, @subres;
# }
# }
#
# RETURN_RESULT:
# \@res;
#}
#1;
## ABSTRACT: Complete path
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Path - Complete path
#
#=head1 VERSION
#
#This document describes version 0.251 of Complete::Path (from Perl distribution Complete-Path), released on 2021-02-02.
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#
#=head2 complete_path
#
#Usage:
#
# complete_path(%args) -> array
#
#Complete path.
#
#Complete path, for anything path-like. Meant to be used as backend for other
#functions like C<Complete::File::complete_file> or
#C<Complete::Module::complete_module>. Provides features like case-insensitive
script/_pick view on Meta::CPAN
# log_trace("[computil] Result from char-mode matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
# }
#
# # fuzzy matching
# if ($fuzzy && !@words) {
# log_trace("[computil] Trying fuzzy matching ...") if $COMPLETE_UTIL_TRACE;
# $code_editdist //= do {
# my $env = $ENV{COMPLETE_UTIL_LEVENSHTEIN} // '';
# if ($env eq 'xs') {
# require Text::Levenshtein::XS;
# $editdist_flex = 0;
# \&Text::Levenshtein::XS::distance;
# } elsif ($env eq 'flexible') {
# require Text::Levenshtein::Flexible;
# $editdist_flex = 1;
# \&Text::Levenshtein::Flexible::levenshtein_l;
# } elsif ($env eq 'pp') {
# $editdist_flex = 0;
# \&__editdist;
# } elsif (eval { require Text::Levenshtein::Flexible; 1 }) {
# $editdist_flex = 1;
# \&Text::Levenshtein::Flexible::levenshtein_l;
# } else {
# $editdist_flex = 0;
# \&__editdist;
# }
# };
#
# my $factor = 1.3;
# my $x = -1;
# my $y = 1;
#
# # note: we cannot use Text::Levenshtein::Flexible::levenshtein_l_all()
# # because we perform distance calculation on the normalized array but we
# # want to get the original array elements
#
# my %editdists;
# ELEM:
# for my $i (0..$#array) {
# my $eln = $arrayn[$i];
#
# for my $l (length($wordn)-$y .. length($wordn)+$y) {
# next if $l <= 0;
# my $chopped = substr($eln, 0, $l);
# my $maxd = __min(
# __min(length($chopped), length($word))/$factor,
# $fuzzy,
# );
# my $d;
# unless (defined $editdists{$chopped}) {
# if ($editdist_flex) {
# $d = $code_editdist->($wordn, $chopped, $maxd);
# next ELEM unless defined $d;
# } else {
# $d = $code_editdist->($wordn, $chopped);
# }
# $editdists{$chopped} = $d;
# } else {
# $d = $editdists{$chopped};
# }
# #say "D: d($word,$chopped)=$d (maxd=$maxd)";
# next unless $d <= $maxd;
# push @words, $array[$i];
# push @wordsumms, $arraysumms[$i] if $summaries;
# next ELEM;
# }
# }
# log_trace("[computil] Result from fuzzy matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
# }
#
# # replace back the words from replace_map
# if ($rmapn && @words) {
# my @wordsn;
# for my $el (@words) {
# my $eln = $ci ? uc($el) : $el; $eln =~ s/_/-/g if $map_case;
# push @wordsn, $eln;
# }
# for my $i (0..$#words) {
# if (my $w = $rev_rmapn->{$wordsn[$i]}) {
# $words[$i] = $w;
# }
# }
# }
#
# # sort results and insert summaries
# $res = [
# map {
# $summaries ?
# {word=>$words[$_], summary=>$wordsumms[$_]} :
# $words[$_]
# }
# sort {
# $ci ?
# lc($words[$a]) cmp lc($words[$b]) :
# $words[$a] cmp $words[$b] }
# 0 .. $#words
# ];
#
# RETURN_RES:
# log_trace("[computil] leaving complete_array_elem(), res=%s", $res)
# if $COMPLETE_UTIL_TRACE;
# $res;
#}
#
#$SPEC{complete_hash_key} = {
# v => 1.1,
# summary => 'Complete from hash keys',
# args => {
# %arg_word,
# hash => { schema=>['hash*'=>{}], req=>1 },
# summaries => { schema=>['hash*'=>{}] },
# summaries_from_hash_values => { schema=>'true*' },
# },
# result_naked => 1,
# result => {
# schema => 'array',
# },
# args_rels => {
# choose_one => ['summaries', 'summaries_from_hash_values'],
# },
#};
script/_pick view on Meta::CPAN
#
# # we should be completing keys
# my $cae_word = @mentioned_keys ? pop(@mentioned_keys) : ''; # cae=complete_array_elem
#
# my $remaining_elems;
# if ($remaining_keys) {
# $remaining_elems = $remaining_keys->(\@mentioned_keys, $keys);
# } elsif ($uniq) {
# my %mem;
# $remaining_elems = [];
# for (@mentioned_keys) {
# if ($ci) { $mem{lc $_}++ } else { $mem{$_}++ }
# }
# for (@$keys) {
# push @$remaining_elems, $_ unless ($ci ? $mem{lc $_} : $mem{$_});
# }
# } else {
# $remaining_elems = $keys;
# }
#
# my $cae_res = complete_array_elem(
# %args,
# word => $cae_word,
# array => $remaining_elems,
# ($keys_summaries ? (summaries=>[map {$keys_summaries_for{ $ci ? lc($_):$_ }} @$remaining_elems]) : ()),
# );
#
# pop @mentioned_elems;
# my $prefix = join($sep, @mentioned_elems);
# $prefix .= $sep if @mentioned_elems;
# $cae_res = [map { ref $_ eq 'HASH' ? { %$_, word=>"$prefix$_->{word}" } : "$prefix$_" } @$cae_res];
#
# # add trailing comma for convenience, where appropriate
# {
# last unless @$cae_res == 1;
# last if @$remaining_elems <= 1;
# $cae_res = [{word=>$cae_res->[0]}] unless ref $cae_res->[0] eq 'HASH';
# $cae_res = [{word=>"$cae_res->[0]{word}$sep", (defined $cae_res->[0]{summary} ? (summary=>$cae_res->[0]{summary}) : ()), is_partial=>1}];
# }
# return $cae_res;
#
# } else {
#
# # we should be completing values
#
# return [] unless $complete_value;
# my $word = pop @mentioned_elems;
# my $res = $complete_value->(word=>$word, key=>$mentioned_keys[-1]);
# my $prefix = join($sep, @mentioned_elems);
# $prefix .= $sep if @mentioned_elems;
# modify_answer(answer=>$res, prefix=>$prefix);
# }
#}
#
#$SPEC{combine_answers} = {
# v => 1.1,
# summary => 'Given two or more answers, combine them into one',
# description => <<'_',
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool <prog:cpanm>, which accepts a filename (a tarball like
#`*.tar.gz`), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
# complete_module(word=>$word),
# );
#
#But if a completion answer has a metadata `final` set to true, then that answer
#is used as the final answer without any combining with the other answers.
#
#_
# args => {
# answers => {
# schema => [
# 'array*' => {
# of => ['any*', of=>['hash*','array*']], # XXX answer_t
# min_len => 1,
# },
# ],
# req => 1,
# pos => 0,
# greedy => 1,
# },
# },
# args_as => 'array',
# result_naked => 1,
# result => {
# schema => 'hash*',
# description => <<'_',
#
#Return a combined completion answer. Words from each input answer will be
#combined, order preserved and duplicates removed. The other keys from each
#answer will be merged.
#
#_
# },
#};
#sub combine_answers {
# require List::Util;
#
# return unless @_;
# return $_[0] if @_ < 2;
#
# my $final = {words=>[]};
# my $encounter_hash;
# my $add_words = sub {
# my $words = shift;
# for my $entry (@$words) {
# push @{ $final->{words} }, $entry
# unless List::Util::first(
# sub {
# (ref($entry) ? $entry->{word} : $entry)
# eq
# (ref($_) ? $_->{word} : $_)
# }, @{ $final->{words} }
# );
# }
# };
#
script/_pick view on Meta::CPAN
#Get the number of entries in an answer.
#
#It is equivalent to:
#
# ref $answer eq 'ARRAY' ? (@$answer // 0) : (@{$answer->{words}} // 0);
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$answer>* => I<array|hash>
#
#Completion answer structure.
#
#
#=back
#
#Return value: (int)
#
#
#
#=head2 arrayify_answer
#
#Usage:
#
# arrayify_answer($answer) -> array
#
#Make sure we return completion answer in array form.
#
#This is the reverse of C<hashify_answer>. It accepts a hash or an array. If it
#receives a hash, will return its C<words> key.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$answer>* => I<array|hash>
#
#Completion answer structure.
#
#
#=back
#
#Return value: (array)
#
#
#
#=head2 combine_answers
#
#Usage:
#
# combine_answers($answers, ...) -> hash
#
#Given two or more answers, combine them into one.
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool L<cpanm>, which accepts a filename (a tarball like
#C<*.tar.gz>), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
# complete_module(word=>$word),
# );
#
#But if a completion answer has a metadata C<final> set to true, then that answer
#is used as the final answer without any combining with the other answers.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$answers>* => I<array[hash|array]>
#
#(No description)
#
#
#=back
#
#Return value: (hash)
#
#
#Return a combined completion answer. Words from each input answer will be
#combined, order preserved and duplicates removed. The other keys from each
#answer will be merged.
#
#
#
#=head2 complete_array_elem
#
#Usage:
#
# complete_array_elem(%args) -> array
#
#Complete from array.
#
#Try to find completion from an array of strings. Will attempt several methods,
#from the cheapest and most discriminating to the most expensive and least
#discriminating.
#
#First method is normal/exact string prefix matching (either case-sensitive or
#insensitive depending on the C<$Complete::Common::OPT_CI> variable or the
#C<COMPLETE_OPT_CI> environment variable). If at least one match is found, return
#result. Else, proceed to the next method.
#
#Word-mode matching (can be disabled by setting
#C<$Complete::Common::OPT_WORD_MODE> or C<COMPLETE_OPT_WORD_MODE> environment
#varialbe to false). Word-mode matching is described in L<Complete::Common>. If
#at least one match is found, return result. Else, proceed to the next method.
#
#Prefix char-mode matching (can be disabled by settings
#C<$Complete::Common::OPT_CHAR_MODE> or C<COMPLETE_OPT_CHAR_MODE> environment
#variable to false). Prefix char-mode matching is just like char-mode matching
#(see next paragraph) except the first character must match. If at least one
#match is found, return result. Else, proceed to the next method.
script/_pick view on Meta::CPAN
#=over
#
#=item * $src
#
#String. The module source code.
#
#=item * $path
#
#String. The filesystem path (C<undef> if source comes from a require hook).
#
#=item * $entry
#
#The element in C<@INC> where the source comes from.
#
#=item * $index
#
#Integer, the index of entry in C<@INC> where the source comes from, 0 means the
#first entry.
#
#=item * $name_mod
#
#Module name normalized to C<Foo::Bar> form.
#
#=item * $name_pm
#
#Module name normalized to C<Foo/Bar.pm> form.
#
#=item * $name_path
#
#Module name normalized to C<Foo/Bar.pm> form or C<Foo\Bar.pm> form depending on
#the native path separator character.
#
#=back
#
#Options:
#
#=over
#
#=item * die
#
#Bool. Default true. If set to false, won't die upon failure but instead will
#return undef (or empty list in list context).
#
#=item * find_prefix
#
#Bool. If set to true, when a module (e.g. C<Foo/Bar.pm>) is not found in the
#fileysstem but its directory is (C<Foo/Bar/>), then instead of dying or
#returning undef/empty list, the function will return:
#
# \$path
#
#in scalar context, or:
#
# (undef, $path, $entry, $index, $name_mod, $name_pm, $name_path)
#
#in list context. In scalar context, you can differentiate path from module
#source because the path is returned as a scalar reference. So to get the path:
#
# $source_or_pathref = module_source("Foo/Bar.pm", {find_prefix=>1});
# if (ref $source_or_pathref eq 'SCALAR') {
# say "Path is ", $$source_or_pathref;
# } else {
# say "Module source code is $source_or_pathref";
# }
#
#=item * all
#
#Bool. If set to true, then instead of stopping after one source is found, the
#function will continue finding sources until all entries in C<@INC> is
#exhausted. Then will return all the found sources as an arrayref:
#
# my $sources = module_source($name, {all=>1});
#
#In list context, will return a list of records instead of a single record:
#
# my @records = module_source($name, {all=>1});
# for my $record (@records) {
# my ($src, $path, $entry, $index, $name_mod, $name_pm, $name_path) = @$record;
# ...
# }
#
#=back
#
#=head2 module_installed
#
#Usage:
#
# module_installed($name [ , \%opts ]) => bool
#
#Check that module named C<$name> is available to load, without actually
#loading/executing the module. Module will be searched in C<@INC> the way Perl's
#C<require()> finds modules. This include executing require hooks in C<@INC> if
#there are any.
#
#Note that this does not guarantee that the module can eventually be loaded
#successfully, as there might be syntax or runtime errors in the module's source.
#To check for that, one would need to actually load the module using C<require>.
#
#Module C<$name> can be in the form of C<Foo::Bar>, C<Foo/Bar.pm> or
#F<Foo\Bar.pm> (on Windows).
#
#Options:
#
#=over
#
#=item * find_prefix
#
#See L</module_source> documentation.
#
#=back
#
#=head1 FAQ
#
#=head2 How to get module source without dying? I want to just get undef if module source is not available.
#
#Set the C<die> option to false:
#
# my $src = module_source($name, {die=>0});
#
#This is what C<module_installed()> does.
#
#=head2 How to know which @INC entry the source comes from?
#
script/_pick view on Meta::CPAN
# if ($opt_dotglob) {
# push @res, '.*';
# } elsif (@res && !$after_pathsep) {
# push @res, "(?:$re_not_ps*)(?:$q_ps+$re_not_dot_or_ps$re_not_ps*)*";
# } else {
# push @res, "(?:$re_not_dot_or_ps$re_not_ps*)(?:$q_ps+$re_not_dot_or_ps$re_not_ps*)*";
# }
# }
#
# } elsif (defined($p = $m{literal_brace_single_element})) {
# push @res, quotemeta($p);
# } elsif (defined($p = $m{bash_class})) {
# # XXX no need to escape some characters?
# push @res, $p;
# } elsif (defined($p = $m{sql_joker})) {
# push @res, quotemeta($p);
# } elsif (defined($p = $m{literal})) {
# push @res, quotemeta($p);
# }
#
# $after_pathsep = defined($m{literal}) && substr($m{literal}, -1) eq $opt_ps;
# }
#
# join "", @res;
#}
#
#1;
## ABSTRACT: Bash wildcard string routines
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#String::Wildcard::Bash - Bash wildcard string routines
#
#=head1 VERSION
#
#This document describes version 0.045 of String::Wildcard::Bash (from Perl distribution String-Wildcard-Bash), released on 2022-08-12.
#
#=head1 SYNOPSIS
#
# use String::Wildcard::Bash qw(
# $RE_WILDCARD_BASH
#
# contains_wildcard
# contains_brace_wildcard
# contains_class_wildcard
# contains_joker_wildcard
# contains_qmark_wildcard
# contains_glob_wildcard
# contains_globstar_wildcard
#
# convert_wildcard_to_sql
# convert_wildcard_to_re
# );
#
# say 1 if contains_wildcard("")); # ->
# say 1 if contains_wildcard("ab*")); # -> 1
# say 1 if contains_wildcard("ab\\*")); # ->
#
# say 1 if contains_glob_wildcard("ab*")); # -> 1
# say 1 if contains_glob_wildcard("ab?")); # ->
# say 1 if contains_qmark_wildcard("ab?")); # -> 1
#
# say convert_wildcard_to_sql("foo*"); # -> "foo%"
#
# say convert_wildcard_to_re("foo*"); # -> "foo.*"
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(qqquote)$
#
#=head1 VARIABLES
#
#=head2 $RE_WILDCARD_BASH
#
#=head1 FUNCTIONS
#
#=head2 contains_wildcard
#
#Usage:
#
# $bool = contains_wildcard($wildcard_str)
#
#Return true if C<$str> contains wildcard pattern. Wildcard patterns include
#I<joker> such as C<*> (meaning zero or more of any characters) and C<?> (exactly
#one of any character), I<character class> C<[...]>, and I<brace> C<{...,}>
#(brace expansion). A pattern can be escaped using a bacslash so it becomes
#literal, e.g. C<foo\*> does not contain wildcard because it's C<foo> followed by
#a literal asterisk C<*>.
#
#Aside from the abovementioned wildcard patterns, bash does other types of
#expansions/substitutions too, but these are not considered wildcard. These
#include tilde expansion (e.g. C<~> becomes C</home/alice>), parameter and
#variable expansion (e.g. C<$0> and C<$HOME>), arithmetic expression (e.g.
#C<$[1+2]>), or history (C<!>).
#
#Although this module has 'Bash' in its name, this set of wildcards should be
#applicable to other Unix shells. Haven't checked completely though.
#
#For more specific needs, e.g. you want to check if a string just contains joker
#and not other types of wildcard patterns, use L</"$RE_WILDCARD_BASH"> directly
#or one of the C<contains_*_wildcard> functions.
#
#=head2 contains_brace_wildcard
#
#Like L</contains_wildcard>, but only return true if string contains brace
#(C<{...,}>) wildcard pattern.
#
#=head2 contains_class_wildcard
#
#Like L</contains_wildcard>, but only return true if string contains character
#class (C<[...]>) wildcard pattern.
#
#=head2 contains_joker_wildcard
#
#Like L</contains_wildcard>, but only return true if string contains any of the
#joker (C<?>, C<*>, or C<**>) wildcard patterns.
#
#=head2 contains_qmark_wildcard
#
#Like L</contains_wildcard>, but only return true if string contains the question
#mark joker (C<?>) wildcard pattern.
#
#=head2 contains_glob_wildcard
#
#Like L</contains_wildcard>, but only return true if string contains the glob
( run in 1.522 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )