App-ZodiacUtils
view release on metacpan or search on metacpan
script/_zodiac-of view on Meta::CPAN
#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;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-16'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.335'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#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,
# },
# },
# result_naked => 1,
#};
#sub point {
# my ($line, $marker) = @_;
# $marker //= '^';
#
# my $point = index($line, $marker);
# die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
# $line =~ s/\Q$marker\E//;
# ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
# v => 1.1,
# summary => 'Parse shell command-line for processing by completion routines',
# description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
# quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
# parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
# bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
# which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
# for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
# variable substitution for `COMP_WORDS`). However, note that special shell
# variables that are not environment variables like `$0`, `$_`, `$IFS` will not
# be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
# word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
# By default `COMP_WORDBREAKS` is:
#
# "'@><=;|&(:
#
# So if raw command-line is:
#
# command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
# then the parse result will be:
#
# ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
# which is annoying sometimes. But we follow bash here so we can more easily
# accept input from a joined `COMP_WORDS` if we write completion bash functions,
# e.g. (in the example, `foo` is a Perl script):
#
# _foo ()
# {
# local words=(${COMP_CWORDS[@]})
# # add things to words, etc
# local point=... # calculate the new point
# COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
# }
#
# To avoid these word-breaking characters to be split/grouped, we can escape
# them with backslash or quote them, e.g.:
#
# command "http://example.com:80" Foo\:\:Bar
#
# which bash will parse as:
#
# ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
# and we parse as:
#
# ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
# equivalent:
#
# % cmd --foo=bar
# % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
# args_as => 'array',
# args => {
# cmdline => {
# summary => 'Command-line, defaults to COMP_LINE environment',
# schema => 'str*',
# pos => 0,
# },
# point => {
# summary => 'Point/position to complete in command-line, '.
# 'defaults to COMP_POINT',
# schema => 'int*',
# pos => 1,
# },
# opts => {
# summary => 'Options',
# schema => 'hash*',
# description => <<'_',
#
#Optional. Known options:
#
#* `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]`.
script/_zodiac-of view on Meta::CPAN
#sub join_wordbreak_words {
# my ($words, $cword) = @_;
# my $new_words = [];
# my $i = -1;
# while (++$i < @$words) {
# my $w = $words->[$i];
# if ($w =~ /\A[\@=:]+\z/) {
# if (@$new_words and $#$new_words != $cword) {
# $new_words->[-1] .= $w;
# $cword-- if $cword >= $i || $cword >= @$new_words;
# } else {
# push @$new_words, $w;
# }
# if ($i+1 < @$words) {
# $i++;
# $new_words->[-1] .= $words->[$i];
# $cword-- if $cword >= $i || $cword >= @$new_words;
# }
# } else {
# push @$new_words, $w;
# }
# }
# log_trace "[compbash] join_wordbreak_words(): result: words=%s, cword=%d", $new_words, $cword
# if $ENV{COMPLETE_BASH_TRACE};
# [$new_words, $cword];
#}
#
#sub _terminal_width {
# # XXX need to cache?
# if (eval { require Term::Size; 1 }) {
# my ($cols, undef) = Term::Size::chars(*STDOUT{IO});
# $cols // 80;
# } else {
# $ENV{COLUMNS} // 80;
# }
#}
#
## given terminal width & number of columns, calculate column width
#sub _column_width {
# my ($terminal_width, $num_columns) = @_;
# if (defined $num_columns && $num_columns > 0) {
# int( ($terminal_width - ($num_columns-1)*2) / $num_columns ) - 1;
# } else {
# undef;
# }
#}
#
## given terminal width & column width, calculate number of columns
#sub _num_columns {
# my ($terminal_width, $column_width) = @_;
# my $n = int( ($terminal_width+2) / ($column_width+2) );
# $n >= 1 ? $n : 1;
#}
#
#$SPEC{format_completion} = {
# v => 1.1,
# summary => 'Format completion for output (for shell)',
# description => <<'_',
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the `Complete`
#POD. Aside from `words`, this function also recognizes these keys:
#
#_
# args_as => 'array',
# args => {
# completion => {
# summary => 'Completion answer structure',
# description => <<'_',
#
#Either an array or hash. See function description for more details.
#
#_
# schema=>['any*' => of => ['hash*', 'array*']],
# req=>1,
# pos=>0,
# },
# opts => {
# summary => 'Specify options',
# schema=>'hash*',
# pos=>1,
# description => <<'_',
#
#Known options:
#
#* as
#
# Either `string` (the default) or `array` (to return array of lines instead of
# the lines joined together). Returning array is useful if you are doing
# completion inside `Term::ReadLine`, for example, where the library expects an
# array.
#
#* esc_mode
#
# Escaping mode for entries. Either `default` (most nonalphanumeric characters
# will be escaped), `shellvar` (like `default`, but dollar sign `$` will also be
# escaped, convenient when completing environment variables for example),
# `filename` (currently equals to `default`), `option` (currently equals to
# `default`), or `none` (no escaping will be done).
#
#* word
#
# A workaround. String. For now, see source code for more details.
#
#* show_summaries
#
# Whether to show item's summaries. Boolean, default is from
# COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
# An answer item contain summary, which is a short description about the item,
# e.g.:
#
# [{word=>"-a" , summary=>"Show hidden files"},
# {word=>"-l" , summary=>"Show details"},
# {word=>"--sort", summary=>"Specify sort order"}],
#
# When summaries are not shown, user will just be seeing something like:
#
# -a
# -l
# --sort
#
# But when summaries are shown, user will see:
#
# -a -- Show hidden files
# -l -- Show details
# --sort -- Specify sort order
#
# which is quite helpful.
#
#* workaround_with_wordbreaks
#
# Boolean. Default is true. See source code for more details.
#
#_
#
# },
# },
# result => {
# summary => 'Formatted string (or array, if `as` is set to `array`)',
# schema => ['any*' => of => ['str*', 'array*']],
# },
# result_naked => 1,
#};
#sub format_completion {
# my ($hcomp, $opts) = @_;
#
# $opts //= {};
#
# $hcomp = {words=>$hcomp} unless ref($hcomp) eq 'HASH';
# my $words = $hcomp->{words};
# my $as = $opts->{as} // 'string';
# # 'escmode' key is deprecated (Complete 0.11-) and will be removed later
# my $esc_mode = $opts->{esc_mode} // $ENV{COMPLETE_BASH_DEFAULT_ESC_MODE} //
# 'default';
# my $path_sep = $hcomp->{path_sep};
#
script/_zodiac-of view on Meta::CPAN
# 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[$_]
# if $max_summ_width < length $summaries[$_];
# }
# #warn "max_entry_width=$max_entry_width, max_summ_width=$max_summ_width\n";
# if ($summary_align eq 'right') {
# # if we are aligning summary to the right, we want to fill column
# # width width
# if ($max_columns <= 0) {
# $max_columns = _num_columns(
# $terminal_width, ($max_entry_width + 2 + $max_summ_width));
# }
# $column_width = _column_width($terminal_width, $max_columns);
# my $new_max_summ_width = $column_width - 2 - $max_entry_width;
# $max_summ_width = $new_max_summ_width
# if $max_summ_width < $new_max_summ_width;
# #warn "max_columns=$max_columns, column_width=$column_width, max_summ_width=$max_summ_width\n";
# }
#
# for (0..$#words) {
# my $summary = $summaries[$_];
# if (length $summary) {
# $res[$_] = sprintf(
# "%-${max_entry_width}s |%".
# ($summary_align eq 'right' ? $max_summ_width : '')."s",
# $words[$_], $summary);
# }
# }
# } # FORMAT_SUMMARIES
#
# MAX_COLUMNS: {
script/_zodiac-of view on Meta::CPAN
# % somecmd t<Tab>
# two three
#
#Another source is from a bash function (C<-F>). The function will receive input
#in two variables: C<COMP_WORDS> (array, command-line chopped into words) and
#C<COMP_CWORD> (integer, index to the array of words indicating the cursor
#position). It must set an array variable C<COMPREPLY> that contains the list of
#possible completion:
#
# % _foo()
# {
# local cur
# COMPREPLY=()
# cur=${COMP_WORDS[COMP_CWORD]}
# COMPREPLY=($( compgen -W '--help --verbose --version' -- $cur ) )
# }
# % complete -F _foo foo
# % foo <Tab>
# --help --verbose --version
#
#And yet another source is an external command (C<-C>) including, from a Perl
#script. The command receives two environment variables: C<COMP_LINE> (string,
#raw command-line) and C<COMP_POINT> (integer, cursor location). Program must
#split C<COMP_LINE> into words, find the word to be completed, complete that, and
#return the list of words one per-line to STDOUT. An example:
#
# % cat foo-complete
# #!/usr/bin/perl
# use Complete::Bash qw(parse_cmdline format_completion);
# use Complete::Util qw(complete_array_elem);
# my ($words, $cword) = @{ parse_cmdline() };
# my $res = complete_array_elem(array=>[qw/--help --verbose --version/], word=>$words->[$cword]);
# print format_completion($res);
#
# % complete -C foo-complete foo
# % foo --v<Tab>
# --verbose --version
#
#=head2 About the routines in this module
#
#First of all, C<parse_cmdline()> is the function to parse raw command-line (such
#as what you get from bash in C<COMP_LINE> environment variable) into words. This
#makes it easy for the other functions to generate completion answer. See the
#documentation for that function for more details.
#
#C<format_completion()> is what you use to format completion answer structure for
#bash.
#
#=head1 FUNCTIONS
#
#
#=head2 format_completion
#
#Usage:
#
# format_completion($completion, $opts) -> str|array
#
#Format completion for output (for shell).
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the C<Complete>
#POD. Aside from C<words>, this function also recognizes these keys:
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$completion>* => I<hash|array>
#
#Completion answer structure.
#
#Either an array or hash. See function description for more details.
#
#=item * B<$opts> => I<hash>
#
#Specify options.
#
#Known options:
#
#=over
#
#=item * as
#
#Either C<string> (the default) or C<array> (to return array of lines instead of
#the lines joined together). Returning array is useful if you are doing
#completion inside C<Term::ReadLine>, for example, where the library expects an
#array.
#
#=item * esc_mode
#
#Escaping mode for entries. Either C<default> (most nonalphanumeric characters
#will be escaped), C<shellvar> (like C<default>, but dollar sign C<$> will also be
#escaped, convenient when completing environment variables for example),
#C<filename> (currently equals to C<default>), C<option> (currently equals to
#C<default>), or C<none> (no escaping will be done).
#
#=item * word
#
#A workaround. String. For now, see source code for more details.
#
#=item * show_summaries
#
#Whether to show item's summaries. Boolean, default is from
#COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
#An answer item contain summary, which is a short description about the item,
#e.g.:
#
# [{word=>"-a" , summary=>"Show hidden files"},
# {word=>"-l" , summary=>"Show details"},
# {word=>"--sort", summary=>"Specify sort order"}],
#
#When summaries are not shown, user will just be seeing something like:
#
# -a
# -l
# --sort
#
#But when summaries are shown, user will see:
#
# -a -- Show hidden files
# -l -- Show details
# --sort -- Specify sort order
#
#which is quite helpful.
#
#=item * workaround_with_wordbreaks
#
#Boolean. Default is true. See source code for more details.
#
#=back
#
#
#=back
#
#Return value: Formatted string (or array, if `as` is set to `array`) (str|array)
#
#
#
#=head2 join_wordbreak_words
#
#Usage:
#
# join_wordbreak_words() -> [status, msg, payload, meta]
#
#Post-process parse_cmdline() result by joining some words.
#
#C<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 C<:>, C<@> to be part of word. So this
#routine will convert the above into:
#
# ["command", "--module=Data::Dump", 'bob@example.org']
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value: (any)
#
#
#
#=head2 parse_cmdline
#
#Usage:
#
# parse_cmdline($cmdline, $point, $opts) -> array
#
#Parse shell command-line for processing by completion routines.
#
#This function basically converts C<COMP_LINE> (str) and C<COMP_POINT> (int) into
#something like (but not exactly the same as) C<COMP_WORDS> (array) and
#C<COMP_CWORD> (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's C<COMP_WORDS> contains all the
# quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
# parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
# bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
# which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
# for the current word (C<COMP_WORDS[COMP_CWORD]>) (bash does not perform
# variable substitution for C<COMP_WORDS>). However, note that special shell
# variables that are not environment variables like C<$0>, C<$_>, C<$IFS> will not
# be replaced correctly because bash does not export those variables for us.
#
#4) tildes (C<~>) are expanded with user's home directory except for the current
# word (bash does not perform tilde expansion for C<COMP_WORDS>);
#
#Caveats:
#
#=over
#
#=item * Like bash, we group non-whitespace word-breaking characters into its own word.
#By default C<COMP_WORDBREAKS> is:
#
#"'@><=;|&(:
#
#So if raw command-line is:
#
#command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#then the parse result will be:
#
#["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#which is annoying sometimes. But we follow bash here so we can more easily
#accept input from a joined C<COMP_WORDS> if we write completion bash functions,
#e.g. (in the example, C<foo> is a Perl script):
#
#I<foo ()
#{
# local words=(${COMP>CWORDS[@]})
# # add things to words, etc
# local point=... # calculate the new point
# COMPREPLY=( C<COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo> )
#}
#
#To avoid these word-breaking characters to be split/grouped, we can escape
#them with backslash or quote them, e.g.:
#
#command "http://example.com:80" Foo\:\:Bar
#
#which bash will parse as:
#
#["command", "\"http://example.com:80\"", "Foo\:\:Bar"]
#
#and we parse as:
#
#["command", "http://example.com:80", "Foo::Bar"]
#
#=item * Due to the way bash parses the command line (see above), the two below are
#equivalent:
#
#% cmd --foo=bar
#% cmd --foo = bar
#
#=back
#
#Because they both expand to C<['--foo', '=', 'bar']>. But obviously
#L<Getopt::Long> does not regard the two as equivalent.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line, defaults to COMP_LINE environment.
#
#=item * B<$opts> => I<hash>
#
#Options.
#
#Optional. Known options:
#
#=over
#
#=item * C<truncate_current_word> (bool). If set to 1, will truncate current word to the
#position of cursor, for example (C<^> marks the position of cursor):
#C<--vers^oo> to C<--vers> instead of C<--versoo>. This is more convenient when
#doing tab completion.
#
#=back
#
#=item * B<$point> => I<int>
#
#PointE<sol>position to complete in command-line, defaults to COMP_POINT.
#
#
#=back
#
#Return value: (array)
#
#
#Return a 2-element array: C<[$words, $cword]>. C<$words> is array of str,
#equivalent to C<COMP_WORDS> provided by bash to shell functions. C<$cword> is an
script/_zodiac-of view on Meta::CPAN
#
#This software is copyright (c) 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Data/Dmp.pm ###
### no critic: Modules::ProhibitAutomaticExportation
#
#package Data::Dmp;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-07'; # DATE
#our $DIST = 'Data-Dmp'; # DIST
#our $VERSION = '0.240'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Scalar::Util qw(looks_like_number blessed reftype refaddr);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT = qw(dd dmp);
#our @EXPORT_OK = qw(dd_ellipsis dmp_ellipsis);
#
## for when dealing with circular refs
#our %_seen_refaddrs;
#our %_subscripts;
#our @_fixups;
#
#our $OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS = 70;
#our $OPT_PERL_VERSION = "5.010";
#our $OPT_REMOVE_PRAGMAS = 0;
#our $OPT_DEPARSE = 1;
#our $OPT_STRINGIFY_NUMBERS = 0;
#
## BEGIN COPY PASTE FROM Data::Dump
#my %esc = (
# "\a" => "\\a",
# "\b" => "\\b",
# "\t" => "\\t",
# "\n" => "\\n",
# "\f" => "\\f",
# "\r" => "\\r",
# "\e" => "\\e",
#);
#
## put a string value in double quotes
#sub _double_quote {
# local($_) = $_[0];
#
# # If there are many '"' we might want to use qq() instead
# s/([\\\"\@\$])/\\$1/g;
# return qq("$_") unless /[^\040-\176]/; # fast exit
#
# s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
# # no need for 3 digits in escape for these
# s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
# s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
# s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
# return qq("$_");
#}
## END COPY PASTE FROM Data::Dump
#
#sub _dump_code {
# my $code = shift;
#
# state $deparse = do {
# require B::Deparse;
# B::Deparse->new("-l"); # -i option doesn't have any effect?
# };
#
# my $res = $deparse->coderef2text($code);
#
# my ($res_before_first_line, $res_after_first_line) =
# $res =~ /(.+?)^(#line .+)/ms;
#
# if ($OPT_REMOVE_PRAGMAS) {
# $res_before_first_line = "{";
# } elsif ($OPT_PERL_VERSION < 5.016) {
# # older perls' feature.pm doesn't yet support q{no feature ':all';}
# # so we replace it with q{no feature}.
# $res_before_first_line =~ s/no feature ':all';/no feature;/m;
# }
# $res_after_first_line =~ s/^#line .+//gm;
#
# $res = "sub" . $res_before_first_line . $res_after_first_line;
# $res =~ s/^\s+//gm;
# $res =~ s/\n+//g;
# $res =~ s/;\}\z/}/;
# $res;
#}
#
#sub _quote_key {
# $_[0] =~ /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ ||
# $_[0] =~ /\A-?[1-9][0-9]{0,8}\z/ ? $_[0] : _double_quote($_[0]);
#}
#
#sub _dump {
# my ($val, $subscript) = @_;
#
# my $ref = ref($val);
# if ($ref eq '') {
# if (!defined($val)) {
# return "undef";
# } elsif (looks_like_number($val) && !$OPT_STRINGIFY_NUMBERS &&
# # perl does several normalizations to number literal, e.g.
# # "+1" becomes 1, 0123 is octal literal, etc. make sure we
# # only leave out quote when the number is not normalized
# $val eq $val+0 &&
# # perl also doesn't recognize Inf and NaN as numeric
# # literals (ref: perldata) so these unquoted literals will
# # choke under 'use strict "subs"
# $val !~ /\A-?(?:inf(?:inity)?|nan)\z/i
# ) {
script/_zodiac-of view on Meta::CPAN
#
# my $compgl_comp = sub {
# log_trace("[comp][periscomp] entering completion routine (that we supply to Complete::Getopt::Long)");
# my %cargs = @_;
# my $type = $cargs{type};
# my $ospec = $cargs{ospec} // '';
# my $word = $cargs{word};
#
# my $fres;
#
# my %rargs = (
# riap_server_url => $args{riap_server_url},
# riap_uri => $args{riap_uri},
# riap_client => $args{riap_client},
# );
#
# $extras->{parsed_opts} = $cargs{parsed_opts};
#
# if (my $sm = $specmeta->{$ospec}) {
# $cargs{type} = 'optval';
# if ($sm->{arg}) {
# log_trace("[comp][periscomp] completing option value for a known function argument, arg=<%s>, ospec=<%s>", $sm->{arg}, $ospec);
# $cargs{arg} = $sm->{arg};
# my $arg_spec = $args_prop->{$sm->{arg}} or goto RETURN_RES;
# if ($comp) {
# log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
# my $compres;
# eval { $compres = $comp->(%cargs) };
# log_debug("[comp][periscomp] completion died: $@") if $@;
# log_trace("[comp][periscomp] result from 'completion' routine: %s", $compres);
# if ($compres) {
# $fres = $compres;
# goto RETURN_RES;
# }
# }
# if ($ospec =~ /\@$/) {
# $fres = complete_arg_elem(
# meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
# word=>$word, index=>$cargs{nth}, # XXX correct index
# extras=>$extras, %rargs);
# goto RETURN_RES;
# } elsif ($ospec =~ /\%$/) {
# if ($word =~ /(.*?)=(.*)/s) {
# my $key = $1;
# my $val = $2;
# $fres = complete_arg_elem(
# meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
# word=>$val, index=>$key,
# extras=>$extras, %rargs);
# modify_answer(answer=>$fres, prefix=>"$key=");
# goto RETURN_RES;
# } else {
# $fres = complete_arg_index(
# meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
# word=>$word, extras=>$extras, %rargs);
# modify_answer(answer=>$fres, suffix=>"=");
# $fres->{path_sep} = "=";
# # XXX actually not entirely correct, we want normal
# # escaping but without escaping "=", maybe we should
# # allow customizing, e.g. esc_mode=normal, dont_esc="="
# # (list of characters to not escape)
# $fres->{esc_mode} = "none";
# goto RETURN_RES;
# }
# } else {
# $fres = complete_arg_val(
# meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
# word=>$word, extras=>$extras, %rargs);
# goto RETURN_RES;
# }
# } else {
# log_trace("[comp][periscomp] completing option value for a common option, ospec=<%s>", $ospec);
# $cargs{arg} = undef;
# my $codata = $copts_by_ospec->{$ospec};
# if ($comp) {
# log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
# my $res;
# eval { $res = $comp->(%cargs) };
# log_debug("[comp][periscomp] completion died: $@") if $@;
# if ($res) {
# $fres = $res;
# goto RETURN_RES;
# }
# }
# if ($codata->{completion}) {
# $cargs{arg} = undef;
# log_trace("[comp][periscomp] completing with common option's 'completion' property");
# my $res;
# eval { $res = $codata->{completion}->(%cargs) };
# log_debug("[comp][periscomp] completion died: $@") if $@;
# if ($res) {
# $fres = $res;
# goto RETURN_RES;
# }
# }
# if ($codata->{schema}) {
# require Data::Sah::Normalize;
# my $nsch = Data::Sah::Normalize::normalize_schema(
# $codata->{schema});
# log_trace("[comp][periscomp] completing with common option's schema");
# $fres = complete_from_schema(
# schema => $nsch, word=>$word,
# schema_is_normalized=>1,
# );
# goto RETURN_RES;
# }
# goto RETURN_RES;
# }
# } elsif ($type eq 'arg') {
# log_trace("[comp][periscomp] completing argument #%d", $cargs{argpos});
# $cargs{type} = 'arg';
#
# my $pos = $cargs{argpos};
# my $fasa = $args{func_arg_starts_at} // 0;
#
# # find if there is a non-slurpy argument with the exact position
# for my $an (keys %$args_prop) {
# my $arg_spec = $args_prop->{$an};
# next unless !($arg_spec->{slurpy} // $arg_spec->{greedy}) &&
# defined($arg_spec->{pos}) && $arg_spec->{pos} == $pos - $fasa;
# log_trace("[comp][periscomp] this argument position is for non-slurpy function argument <%s>", $an);
script/_zodiac-of view on Meta::CPAN
#
#Source repository is at L<https://github.com/perlancar/perl-String-LineNumber>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-LineNumber>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### String/PerlQuote.pm ###
#package String::PerlQuote;
#
#our $DATE = '2016-10-07'; # DATE
#our $VERSION = '0.02'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# single_quote
# double_quote
# );
#
## BEGIN COPY PASTE FROM Data::Dump
#my %esc = (
# "\a" => "\\a",
# "\b" => "\\b",
# "\t" => "\\t",
# "\n" => "\\n",
# "\f" => "\\f",
# "\r" => "\\r",
# "\e" => "\\e",
#);
#
## put a string value in double quotes
#sub double_quote {
# local($_) = $_[0];
# # If there are many '"' we might want to use qq() instead
# s/([\\\"\@\$])/\\$1/g;
# return qq("$_") unless /[^\040-\176]/; # fast exit
#
# s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
# # no need for 3 digits in escape for these
# s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
# s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
# s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
# return qq("$_");
#}
## END COPY PASTE FROM Data::Dump
#
#sub single_quote {
# local($_) = $_[0];
# s/([\\'])/\\$1/g;
# return qq('$_');
#}
#1;
## ABSTRACT: Quote a string as Perl does
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#String::PerlQuote - Quote a string as Perl does
#
#=head1 VERSION
#
#This document describes version 0.02 of String::PerlQuote (from Perl distribution String-PerlQuote), released on 2016-10-07.
#
#=head1 FUNCTIONS
#
#=head2 double_quote($str) => STR
#
#Quote or encode C<$str> to the Perl double quote (C<">) literal representation
#of the string. Example:
#
# say double_quote("a"); # => "a" (with the quotes)
# say double_quote("a\n"); # => "a\n"
# say double_quote('"'); # => "\""
# say double_quote('$foo'); # => "\$foo"
#
#This code is taken from C<quote()> in L<Data::Dump>. Maybe I didn't look more
#closely, but I couldn't a module that provides a function to do something like
#this. L<String::Escape>, for example, provides C<qqbackslash> but it does not
#escape C<$>.
#
#=head2 single_quote($str) => STR
#
#Like C<double_quote> but will produce a Perl single quote literal representation
#instead of the double quote ones. In single quotes, only literal backslash C<\>
#and single quote character C<'> are escaped, the rest are displayed as-is, so
#the result might span multiple lines or contain other non-printable characters.
#
# say single_quote("Mom's"); # => 'Mom\'s' (with the quotes)
# say single_quote("a\\"); # => 'a\\"
# say single_quote('"'); # => '"'
# say single_quote("\$foo"); # => '$foo'
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/String-PerlQuote>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-String-PerlQuote>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-PerlQuote>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2016 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### String/Wildcard/Bash.pm ###
#package String::Wildcard::Bash;
#
#our $DATE = '2019-08-30'; # DATE
#our $VERSION = '0.043'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# $RE_WILDCARD_BASH
# contains_wildcard
# convert_wildcard_to_sql
# convert_wildcard_to_re
# );
#
#our $re_bash_brace_element =
# qr(
# (?:(?:\\\\ | \\, | \\\{ | \\\} | [^\\\{,\}])*)
# )x;
#
## note: order is important here, brace encloses the other
#our $RE_WILDCARD_BASH =
# qr(
# # non-escaped brace expression, with at least one comma
# (?P<bash_brace>
# (?<!\\)(?P<slashes_before_bash_brace>\\\\)*\{
# (?P<bash_brace_content>
# $re_bash_brace_element(?:, $re_bash_brace_element )+
# )
# (?<!\\)(?:\\\\)*\}
# )
# |
# # non-escaped brace expression, to catch * or ? or [...] inside so
# # they don't go to below pattern, because bash doesn't consider them
# # wildcards, e.g. '/{et?,us*}' expands to '/etc /usr', but '/{et?}'
# # doesn't expand at all to /etc.
# (?P<literal_brace_single_element>
# (?<!\\)(?:\\\\)*\{
# $re_bash_brace_element
# (?<!\\)(?:\\\\)*\}
# )
# |
# (?P<bash_class>
# # non-empty, non-escaped character class
# (?<!\\)(?:\\\\)*\[
# (?: \\\\ | \\\[ | \\\] | [^\\\[\]] )+
# (?<!\\)(?:\\\\)*\]
# )
# |
# (?P<bash_joker>
# # non-escaped * and ?
# (?<!\\)(?:\\\\)*(?:\*\*?|\?)
# )
# |
# (?P<sql_joker>
# # non-escaped % and ?
# (?<!\\)(?:\\\\)*[%_]
# )
# |
# (?P<literal>
# [^\\\[\]\{\}*?%_]+
# |
# .+?
# )
# )ox;
#
#sub contains_wildcard {
# my $str = shift;
#
# while ($str =~ /$RE_WILDCARD_BASH/go) {
# my %m = %+;
# return 1 if $m{bash_brace} || $m{bash_class} || $m{bash_joker};
# }
# 0;
#}
#
#sub convert_wildcard_to_sql {
# my $opts = ref $_[0] eq 'HASH' ? shift : {};
# my $str = shift;
#
# my @res;
# my $p;
# while ($str =~ /$RE_WILDCARD_BASH/g) {
# my %m = %+;
# if (defined($p = $m{bash_brace_content})) {
# die "Cannot convert brace pattern '$p' to SQL";
# } elsif ($p = $m{bash_joker}) {
# if ($m{bash_joker} eq '*' || $m{bash_joker} eq '**') {
# push @res, "%";
# } else {
# push @res, "_";
# }
# } elsif ($p = $m{sql_joker}) {
# push @res, "\\$p";
# } elsif (defined($p = $m{literal_brace_single_element})) {
# die "Currently cannot convert brace literal '$p' to SQL";
# } elsif (defined($p = $m{bash_class})) {
# die "Currently cannot convert class pattern '$p' to SQL";
# } elsif (defined($p = $m{literal})) {
# push @res, $p;
# }
# }
#
# join "", @res;
#}
#
#sub convert_wildcard_to_re {
# my $opts = ref $_[0] eq 'HASH' ? shift : {};
# my $str = shift;
#
# my $opt_brace = $opts->{brace} // 1;
# my $opt_dotglob = $opts->{dotglob} // 0;
#
# my @res;
# my $p;
# while ($str =~ /$RE_WILDCARD_BASH/g) {
# my %m = %+;
# if (defined($p = $m{bash_brace_content})) {
# push @res, quotemeta($m{slashes_before_bash_brace}) if
# $m{slashes_before_bash_brace};
# if ($opt_brace) {
# my @elems;
# while ($p =~ /($re_bash_brace_element)(,|\z)/g) {
# push @elems, $1;
# last unless $2;
# }
# #use DD; dd \@elems;
# push @res, "(?:", join("|", map {
# convert_wildcard_to_re({
# bash_brace => 0,
# dotglob => $opt_dotglob || @res,
# }, $_)} @elems), ")";
# } else {
# push @res, quotemeta($m{bash_brace});
# }
#
# } elsif (defined($p = $m{bash_joker})) {
# if ($p eq '?') {
# push @res, '.';
# } elsif ($p eq '*') {
# push @res, $opt_dotglob || @res ? '.*' : '[^.].*';
# } elsif ($p eq '**') {
# push @res, '.*';
# }
#
# } 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);
# }
# }
#
# 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.043 of String::Wildcard::Bash (from Perl distribution String-Wildcard-Bash), released on 2019-08-30.
#
#=head1 SYNOPSIS
#
# use String::Wildcard::Bash qw(
# $RE_WILDCARD_BASH
# contains_wildcard
# convert_wildcard_to_sql
# convert_wildcard_to_re
# );
#
# say 1 if contains_wildcard("")); # -> 0
# say 1 if contains_wildcard("ab*")); # -> 1
# say 1 if contains_wildcard("ab\\*")); # -> 0
#
# 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.
#
#=head2 convert_wildcard_to_sql
#
#Usage:
#
# $sql_str = convert_wildcard_to_sql($wildcard_str);
#
#Convert bash wildcard to SQL pattern. This includes:
#
#=over
#
#=item * converting unescaped C<*> to C<%>
#
#=item * converting unescaped C<?> to C<_>
#
#=item * escaping unescaped C<%>
#
#=item * escaping unescaped C<_>
#
#=back
#
#Unsupported constructs will cause the function to die.
#
#=head2 convert_wildcard_to_re
#
#Usage:
#
# $re_str = convert_wildcard_to_re([ \%opts, ] $wildcard_str);
#
#Convert bash wildcard to regular expression string.
#
#Known options:
#
#=over
#
#=item * brace
#
#Bool. Default is true. Whether to expand braces or not. If set to false, will
#simply treat brace as literals.
#
#Examples:
#
# convert_wildcard_to_re( "{a,b}"); # => "(?:a|b)"
# convert_wildcard_to_re({brace=>0}, "{a,b}"); # => "\\{a\\,b\\}"
#
#=item * dotglob
#
#Bool. Default is false. Whether joker C<*> (asterisk) will match a dot file. The
#default behavior follows bash; that is, dot file must be matched explicitly with
#C<.*>.
#
#This setting is similar to shell behavior (shopt) setting C<dotglob>.
#
#Examples:
#
# convert_wildcard_to_re({} , '*a*'); # => "[^.].*a.*"
# convert_wildcard_to_re({dotglob=>1}, '*a*'); # => ".*a.*"
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/String-Wildcard-Bash>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-String-Wildcard-Bash>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-Wildcard-Bash>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
script/_zodiac-of view on Meta::CPAN
# $self->_emit_double($_[0]),
# $self->_emit($ef), last
# if $_[0] =~ /'/;
# $self->_emit($sf),
# $self->_emit_single($_[0]),
# $self->_emit($ef);
# last;
# }
#
# $self->{level}--;
#
# return;
#}
#
#sub is_literal_number {
# my $self = shift;
# # Stolen from JSON::Tiny
# return B::svref_2object(\$_[0])->FLAGS & (B::SVp_IOK | B::SVp_NOK)
# && 0 + $_[0] eq $_[0];
#}
#
#sub _emit_number {
# my $self = shift;
# return $self->_emit_plain($_[0]);
#}
#
## Check whether or not a scalar should be emitted as an plain scalar.
#sub is_valid_plain {
# my $self = shift;
# return 0 unless length $_[0];
# return 0 if $self->quote_numeric_strings and Scalar::Util::looks_like_number($_[0]);
# # refer to YAML::Old::Loader::parse_inline_simple()
# return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;
# return 0 if $_[0] =~ /[\{\[\]\},]/;
# return 0 if $_[0] =~ /[:\-\?]\s/;
# return 0 if $_[0] =~ /\s#/;
# return 0 if $_[0] =~ /\:(\s|$)/;
# return 0 if $_[0] =~ /[\s\|\>]$/;
# return 0 if $_[0] eq '-';
# return 1;
#}
#
#sub _emit_block {
# my $self = shift;
# my ($indicator, $value) = @_;
# $self->{stream} .= $indicator;
# $value =~ /(\n*)\Z/;
# my $chomp = length $1 ? (length $1 > 1) ? '+' : '' : '-';
# $value = '~' if not defined $value;
# $self->{stream} .= $chomp;
# $self->{stream} .= $self->indent_width if $value =~ /^\s/;
# $self->{stream} .= $self->indent($value);
#}
#
## Plain means that the scalar is unquoted.
#sub _emit_plain {
# my $self = shift;
# $self->{stream} .= defined $_[0] ? $_[0] : '~';
#}
#
## Double quoting is for single lined escaped strings.
#sub _emit_double {
# my $self = shift;
# (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
# $self->{stream} .= qq{"$escaped"};
#}
#
## Single quoting is for single lined unescaped strings.
#sub _emit_single {
# my $self = shift;
# my $item = shift;
# $item =~ s{'}{''}g;
# $self->{stream} .= "'$item'";
#}
#
##==============================================================================
## Utility subroutines.
##==============================================================================
#
## Indent a scalar to the current indentation level.
#sub indent {
# my $self = shift;
# my ($text) = @_;
# return $text unless length $text;
# $text =~ s/\n\Z//;
# my $indent = ' ' x $self->offset->[$self->level];
# $text =~ s/^/$indent/gm;
# $text = "\n$text";
# return $text;
#}
#
## Escapes for unprintable characters
#my @escapes = qw(\0 \x01 \x02 \x03 \x04 \x05 \x06 \a
# \x08 \t \n \v \f \r \x0e \x0f
# \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17
# \x18 \x19 \x1a \e \x1c \x1d \x1e \x1f
# );
#
## Escape the unprintable characters
#sub escape {
# my $self = shift;
# my ($text) = @_;
# $text =~ s/\\/\\\\/g;
# $text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;
# return $text;
#}
#
#1;
### YAML/Old/Dumper/Base.pm ###
#package YAML::Old::Dumper::Base;
#
#use YAML::Old::Mo;
#
#use YAML::Old::Node;
#
## YAML Dumping options
#has spec_version => default => sub {'1.0'};
#has indent_width => default => sub {2};
#has use_header => default => sub {1};
#has use_version => default => sub {0};
#has sort_keys => default => sub {1};
#has anchor_prefix => default => sub {''};
#has dump_code => default => sub {0};
#has use_block => default => sub {0};
#has use_fold => default => sub {0};
#has compress_series => default => sub {1};
#has inline_series => default => sub {0};
#has use_aliases => default => sub {1};
#has purity => default => sub {0};
#has stringify => default => sub {0};
#has quote_numeric_strings => default => sub {0};
#
## Properties
#has stream => default => sub {''};
#has document => default => sub {0};
#has transferred => default => sub {{}};
#has id_refcnt => default => sub {{}};
#has id_anchor => default => sub {{}};
#has anchor => default => sub {1};
#has level => default => sub {0};
#has offset => default => sub {[]};
#has headless => default => sub {0};
#has blessed_map => default => sub {{}};
#
## Global Options are an idea taken from Data::Dumper. Really they are just
## sugar on top of real OO properties. They make the simple Dump/Load API
## easy to configure.
#sub set_global_options {
# my $self = shift;
# $self->spec_version($YAML::SpecVersion)
# if defined $YAML::SpecVersion;
# $self->indent_width($YAML::Indent)
# if defined $YAML::Indent;
# $self->use_header($YAML::UseHeader)
# if defined $YAML::UseHeader;
# $self->use_version($YAML::UseVersion)
# if defined $YAML::UseVersion;
# $self->sort_keys($YAML::SortKeys)
# if defined $YAML::SortKeys;
# $self->anchor_prefix($YAML::AnchorPrefix)
# if defined $YAML::AnchorPrefix;
# $self->dump_code($YAML::DumpCode || $YAML::UseCode)
# if defined $YAML::DumpCode or defined $YAML::UseCode;
# $self->use_block($YAML::UseBlock)
script/_zodiac-of view on Meta::CPAN
# }
#
# # Main Loop. Parse out all the top level nodes and return them.
# while (not $self->eos) {
# $self->anchor2node({});
# $self->{document}++;
# $self->done(0);
# $self->level(0);
# $self->offset->[0] = -1;
#
# if ($self->lines->[0] =~ /^---\s*(.*)$/) {
# my @words = split /\s+/, $1;
# %directives = ();
# while (@words && $words[0] =~ /^#(\w+):(\S.*)$/) {
# my ($key, $value) = ($1, $2);
# shift(@words);
# if (defined $directives{$key}) {
# $self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',
# $key, $self->document);
# next;
# }
# $directives{$key} = $value;
# }
# $self->preface(join ' ', @words);
# }
# else {
# $self->die('YAML_PARSE_ERR_NO_SEPARATOR');
# }
#
# if (not $self->done) {
# $self->_parse_next_line(COLLECTION);
# }
# if ($self->done) {
# $self->{indent} = -1;
# $self->content('');
# }
#
# $directives{YAML} ||= '1.0';
# $directives{TAB} ||= 'NONE';
# ($self->{major_version}, $self->{minor_version}) =
# split /\./, $directives{YAML}, 2;
# $self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION', $directives{YAML})
# if $self->major_version ne '1';
# $self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION', $directives{YAML})
# if $self->minor_version ne '0';
# $self->die('Unrecognized TAB policy')
# unless $directives{TAB} =~ /^(NONE|\d+)(:HARD)?$/;
#
# push @{$self->documents}, $self->_parse_node();
# }
# return wantarray ? @{$self->documents} : $self->documents->[-1];
#}
#
## This function is the dispatcher for parsing each node. Every node
## recurses back through here. (Inlines are an exception as they have
## their own sub-parser.)
#sub _parse_node {
# my $self = shift;
# my $preface = $self->preface;
# $self->preface('');
# my ($node, $type, $indicator, $escape, $chomp) = ('') x 5;
# my ($anchor, $alias, $explicit, $implicit, $class) = ('') x 5;
# ($anchor, $alias, $explicit, $implicit, $preface) =
# $self->_parse_qualifiers($preface);
# if ($anchor) {
# $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
# }
# $self->inline('');
# while (length $preface) {
# my $line = $self->line - 1;
# if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
# $indicator = $1;
# $chomp = $2 if defined($2);
# }
# else {
# $self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR') if $indicator;
# $self->inline($preface);
# $preface = '';
# }
# }
# if ($alias) {
# $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
# unless defined $self->anchor2node->{$alias};
# if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
# $node = $self->anchor2node->{$alias};
# }
# else {
# $node = do {my $sv = "*$alias"};
# push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
# }
# }
# elsif (length $self->inline) {
# $node = $self->_parse_inline(1, $implicit, $explicit);
# if (length $self->inline) {
# $self->die('YAML_PARSE_ERR_SINGLE_LINE');
# }
# }
# elsif ($indicator eq $LIT_CHAR) {
# $self->{level}++;
# $node = $self->_parse_block($chomp);
# $node = $self->_parse_implicit($node) if $implicit;
# $self->{level}--;
# }
# elsif ($indicator eq $FOLD_CHAR) {
# $self->{level}++;
# $node = $self->_parse_unfold($chomp);
# $node = $self->_parse_implicit($node) if $implicit;
# $self->{level}--;
# }
# else {
# $self->{level}++;
# $self->offset->[$self->level] ||= 0;
# if ($self->indent == $self->offset->[$self->level]) {
# if ($self->content =~ /^-( |$)/) {
# $node = $self->_parse_seq($anchor);
# }
# elsif ($self->content =~ /(^\?|\:( |$))/) {
# $node = $self->_parse_mapping($anchor);
# }
# elsif ($preface =~ /^\s*$/) {
# $node = $self->_parse_implicit('');
script/_zodiac-of view on Meta::CPAN
# $self->anchor2node->{$anchor} = $mapping;
# my $key;
# while (not $self->done and $self->indent == $self->offset->[$self->level]) {
# # If structured key:
# if ($self->{content} =~ s/^\?\s*//) {
# $self->preface($self->content);
# $self->_parse_next_line(COLLECTION);
# $key = $self->_parse_node();
# $key = "$key";
# }
# # If "default" key (equals sign)
# elsif ($self->{content} =~ s/^\=\s*//) {
# $key = VALUE;
# }
# # If "comment" key (slash slash)
# elsif ($self->{content} =~ s/^\=\s*//) {
# $key = COMMENT;
# }
# # Regular scalar key:
# else {
# $self->inline($self->content);
# $key = $self->_parse_inline();
# $key = "$key";
# $self->content($self->inline);
# $self->inline('');
# }
#
# unless ($self->{content} =~ s/^:\s*//) {
# $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
# }
# $self->preface($self->content);
# my $line = $self->line;
# $self->_parse_next_line(COLLECTION);
# my $value = $self->_parse_node();
# if (exists $mapping->{$key}) {
# $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY', $key);
# }
# else {
# $mapping->{$key} = $value;
# }
# }
# return $mapping;
#}
#
## Parse a YAML sequence into a Perl array
#sub _parse_seq {
# my $self = shift;
# my ($anchor) = @_;
# my $seq = [];
# $self->anchor2node->{$anchor} = $seq;
# while (not $self->done and $self->indent == $self->offset->[$self->level]) {
# if ($self->content =~ /^-(?: (.*))?$/) {
# $self->preface(defined($1) ? $1 : '');
# }
# else {
# $self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT');
# }
#
# # Check whether the preface looks like a YAML mapping ("key: value").
# # This is complicated because it has to account for the possibility
# # that a key is a quoted string, which itself may contain escaped
# # quotes.
# my $preface = $self->preface;
# if ( $preface =~ /^ (\s*) ( \w .*? \: (?:\ |$).*) $/x or
# $preface =~ /^ (\s*) ((') (?:''|[^'])*? ' \s* \: (?:\ |$).*) $/x or
# $preface =~ /^ (\s*) ((") (?:\\\\|[^"])*? " \s* \: (?:\ |$).*) $/x
# ) {
# $self->indent($self->offset->[$self->level] + 2 + length($1));
# $self->content($2);
# $self->level($self->level + 1);
# $self->offset->[$self->level] = $self->indent;
# $self->preface('');
# push @$seq, $self->_parse_mapping('');
# $self->{level}--;
# $#{$self->offset} = $self->level;
# }
# else {
# $self->_parse_next_line(COLLECTION);
# push @$seq, $self->_parse_node();
# }
# }
# return $seq;
#}
#
## Parse an inline value. Since YAML supports inline collections, this is
## the top level of a sub parsing.
#sub _parse_inline {
# my $self = shift;
# my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
# $self->{inline} =~ s/^\s*(.*)\s*$/$1/; # OUCH - mugwump
# my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
# ($anchor, $alias, $explicit, $implicit, $self->{inline}) =
# $self->_parse_qualifiers($self->inline);
# if ($anchor) {
# $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
# }
# $implicit ||= $top_implicit;
# $explicit ||= $top_explicit;
# ($top_implicit, $top_explicit) = ('', '');
# if ($alias) {
# $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
# unless defined $self->anchor2node->{$alias};
# if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
# $node = $self->anchor2node->{$alias};
# }
# else {
# $node = do {my $sv = "*$alias"};
# push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
# }
# }
# elsif ($self->inline =~ /^\{/) {
# $node = $self->_parse_inline_mapping($anchor);
# }
# elsif ($self->inline =~ /^\[/) {
# $node = $self->_parse_inline_seq($anchor);
# }
# elsif ($self->inline =~ /^"/) {
# $node = $self->_parse_inline_double_quoted();
# $node = $self->_unescape($node);
# $node = $self->_parse_implicit($node) if $implicit;
# }
# elsif ($self->inline =~ /^'/) {
# $node = $self->_parse_inline_single_quoted();
# $node = $self->_parse_implicit($node) if $implicit;
# }
# else {
# if ($top) {
# $node = $self->inline;
# $self->inline('');
# }
# else {
# $node = $self->_parse_inline_simple();
# }
# $node = $self->_parse_implicit($node) unless $explicit;
#
# if ($self->numify and defined $node and not ref $node and length $node
# and $node =~ m/\A-?(?:0|[1-9][0-9]*)?(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?\z/) {
# $node += 0;
# }
# }
# if ($explicit) {
# $node = $self->_parse_explicit($node, $explicit);
# }
# if ($anchor) {
# if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
# for my $ref (@{$self->anchor2node->{$anchor}}) {
# ${$ref->[0]} = $node;
# $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
# $anchor, $ref->[1]);
# }
# }
# $self->anchor2node->{$anchor} = $node;
# }
# return $node;
#}
#
## Parse the inline YAML mapping into a Perl hash
#sub _parse_inline_mapping {
# my $self = shift;
# my ($anchor) = @_;
# my $node = {};
# $self->anchor2node->{$anchor} = $node;
#
# $self->die('YAML_PARSE_ERR_INLINE_MAP')
# unless $self->{inline} =~ s/^\{\s*//;
# while (not $self->{inline} =~ s/^\s*\}\s*//) {
# my $key = $self->_parse_inline();
# $self->die('YAML_PARSE_ERR_INLINE_MAP')
# unless $self->{inline} =~ s/^\: \s*//;
# my $value = $self->_parse_inline();
# if (exists $node->{$key}) {
# $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY', $key);
# }
# else {
# $node->{$key} = $value;
# }
# next if $self->inline =~ /^\s*\}/;
# $self->die('YAML_PARSE_ERR_INLINE_MAP')
# unless $self->{inline} =~ s/^\,\s*//;
script/_zodiac-of view on Meta::CPAN
# else {
# $self->lines->[0] =~ /^( *)\S/ or
# $self->die('YAML_PARSE_ERR_NONSPACE_INDENTATION');
# if (length($1) > $offset) {
# $self->offset->[$level+1] = length($1);
# }
# else {
# $self->offset->[$level+1] = $offset + 1;
# }
# }
# $offset = $self->offset->[++$level];
# }
#
# if ($type == LEAF) {
# while (@{$self->lines} and
# $self->lines->[0] =~ m{^( *)(\#)} and
# length($1) < $offset
# ) {
# shift @{$self->lines};
# $self->{line}++;
# }
# $self->eos($self->{done} = not @{$self->lines});
# }
# else {
# $self->_parse_throwaway_comments();
# }
# return if $self->eos;
#
# if ($self->lines->[0] =~ /^---(\s|$)/) {
# $self->done(1);
# return;
# }
# if ($type == LEAF and
# $self->lines->[0] =~ /^ {$offset}(.*)$/
# ) {
# $self->indent($offset);
# $self->content($1);
# }
# elsif ($self->lines->[0] =~ /^\s*$/) {
# $self->indent($offset);
# $self->content('');
# }
# else {
# $self->lines->[0] =~ /^( *)(\S.*)$/;
# while ($self->offset->[$level] > length($1)) {
# $level--;
# }
# $self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
# if $self->offset->[$level] != length($1);
# $self->indent(length($1));
# $self->content($2);
# }
# $self->die('YAML_PARSE_ERR_INDENTATION')
# if $self->indent - $offset > 1;
#}
#
##==============================================================================
## Utility subroutines.
##==============================================================================
#
## Printable characters for escapes
#my %unescapes = (
# 0 => "\x00",
# a => "\x07",
# t => "\x09",
# n => "\x0a",
# 'v' => "\x0b", # Potential v-string error on 5.6.2 if not quoted
# f => "\x0c",
# r => "\x0d",
# e => "\x1b",
# '\\' => '\\',
# );
#
## Transform all the backslash style escape characters to their literal meaning
#sub _unescape {
# my $self = shift;
# my ($node) = @_;
# $node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/
# (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;
# return $node;
#}
#
#1;
### YAML/Old/Loader/Base.pm ###
#package YAML::Old::Loader::Base;
#
#use YAML::Old::Mo;
#
#has load_code => default => sub {0};
#has preserve => default => sub {0};
#has stream => default => sub {''};
#has document => default => sub {0};
#has line => default => sub {0};
#has documents => default => sub {[]};
#has lines => default => sub {[]};
#has eos => default => sub {0};
#has done => default => sub {0};
#has anchor2node => default => sub {{}};
#has level => default => sub {0};
#has offset => default => sub {[]};
#has preface => default => sub {''};
#has content => default => sub {''};
#has indent => default => sub {0};
#has major_version => default => sub {0};
#has minor_version => default => sub {0};
#has inline => default => sub {''};
#has numify => default => sub {0};
#
#sub set_global_options {
# my $self = shift;
# $self->load_code($YAML::LoadCode || $YAML::UseCode)
# if defined $YAML::LoadCode or defined $YAML::UseCode;
# $self->preserve($YAML::Preserve) if defined $YAML::Preserve;
# $self->numify($YAML::Numify) if defined $YAML::Numify;
#}
#
#sub load {
# die 'load() not implemented in this class.';
#}
#
#1;
### YAML/Old/Marshall.pm ###
#use strict; use warnings;
#package YAML::Old::Marshall;
#
#use YAML::Old::Node ();
#
#sub import {
# my $class = shift;
# no strict 'refs';
# my $package = caller;
# unless (grep { $_ eq $class} @{$package . '::ISA'}) {
# push @{$package . '::ISA'}, $class;
# }
#
# my $tag = shift;
# if ( $tag ) {
# no warnings 'once';
# $YAML::TagClass->{$tag} = $package;
( run in 0.693 second using v1.01-cache-2.11-cpan-5a3173703d6 )