—

              
#!perl
# code after shebang
## no critic: TestingAndDebugging::RequireUseStrict
# BEGIN DATAPACK CODE
package main::_DataPacker;
our $handler;
sub main::_DataPacker::INC { goto $handler }
package main;
{
    my $toc;
    my $data_linepos = 1;
    $main::_DataPacker::handler = sub {
        my $debug = $ENV{PERL_DATAPACKER_DEBUG};
        if ($debug) {
            my @caller0 = caller;
            warn "[datapacker] Hook called with arguments: (".join(",", @_).") by package $caller0[0] in file $caller0[1] line $caller0[2]\n";
        }
        $toc ||= do {
            my $fh = \*DATA;
        my $header_line;
        my $header_found;
        while (1) {
            my $header_line = <$fh>;
            defined($header_line)
                or die "Unexpected end of data section while reading header line";
            chomp($header_line);
            if ($header_line eq 'Data::Section::Seekable v1') {
                $header_found++;
                last;
            }
        }
        die "Can't find header 'Data::Section::Seekable v1'"
            unless $header_found;
        my %toc;
        my $i = 0;
        while (1) {
            $i++;
            my $toc_line = <$fh>;
            defined($toc_line)
                or die "Unexpected end of data section while reading TOC line #$i";
            chomp($toc_line);
            $toc_line =~ /\S/ or last;
            $toc_line =~ /^([^,]+),(\d+),(\d+)(?:,(.*))?$/
                or die "Invalid TOC line #$i in data section: $toc_line";
            $toc{$1} = [$2, $3, $4];
        }
        my $pos = tell $fh;
        $toc{$_}[0] += $pos for keys %toc;
            # calculate the line number of data section
            my $data_pos = tell(DATA);
            seek DATA, 0, 0;
            my $pos = 0;
            while (1) {
                my $line = <DATA>;
                $pos += length($line);
                $data_linepos++;
                last if $pos >= $data_pos;
            }
            seek DATA, $data_pos, 0;
            \%toc;
        };
        if ($toc->{$_[1]}) {
            warn "[datapacker] $_[1] FOUND in packed modules\n" if $debug;
            seek DATA, $toc->{$_[1]}[0], 0;
            read DATA, my($content), $toc->{$_[1]}[1];
            my ($order, $lineoffset) = split(';', $toc->{$_[1]}[2]);
            $content =~ s/^#//gm;
            $content = "# line ".($data_linepos + $order+1 + $lineoffset)." \"".__FILE__."\"\n" . $content;
            open my $fh, '<', \$content
                or die "DataPacker error loading $_[1]: $!";
            return $fh;
        } else {
            warn "[datapacker] $_[1] NOT found in packed modules\n" if $debug;
        }
        return;
    }; # handler
    unshift @INC, bless(sub {"dummy"}, "main::_DataPacker");
}
# END DATAPACK CODE
# Note: This completer script is generated by App::GenPericmdCompleterScript version 0.126
# on Mon Nov 20 12:11:10 2023. You probably should not manually edit this file.
# NO_PERINCI_CMDLINE_SCRIPT
# PERINCI_CMDLINE_COMPLETER_SCRIPT: {program_name=>"pick-random-lines",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/App/PickRandomLines/pick_random_lines"}
# FRAGMENT id=shcompgen-hint completer=1 for=pick-random-lines
# PODNAME: _pick-random-lines
# ABSTRACT: Completer script for pick-random-lines
use 5.010;
use strict;
use warnings;
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-20'; # DATE
our $DIST = 'App-PickRandomLines'; # DIST
our $VERSION = '0.021'; # VERSION
die "Please run this script under shell completion\n" unless $ENV{COMP_LINE} || $ENV{COMMAND_LINE};
my $args = {program_name=>"pick-random-lines",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/App/PickRandomLines/pick_random_lines"};
my $meta = {_orig_args_as=>undef,_orig_result_naked=>undef,args=>{algorithm=>{default=>"scan",description=>"\n`scan` is the algorithm described in the `perlfaq` manual (`perldoc -q \"random\nline\"). This algorithm scans the whole input once and picks one or more lines\nrandomly from it.\n\n`seek` is the algorithm employed by the Perl module `File::RandomLine`. It works\nby seeking a file randomly and finding the next line (repeated `n` number of\ntimes). This algorithm is faster when the input is very large as it avoids\nhaving to scan the whole input. But it requires that the input is seekable (a\nsingle file, stdin is not supported and currently multiple files are not\nsupported as well). *Might produce duplicate lines*.\n\n",schema=>["str",{in=>["scan","seek"],req=>1}]},files=>{description=>"\nIf none is specified, will get input from stdin.\n\n",greedy=>1,pos=>0,schema=>["array",{of=>"filename*",req=>1}],"x.name.is_plural"=>1},num_lines=>{cmdline_aliases=>{n=>{}},default=>1,description=>"\nIf input contains less lines than the requested number of lines, then will only\nreturn as many lines as the input contains.\n\n",schema=>["int",{min=>1,req=>1}]}},args_as=>"hash",description=>"\nTODO:\n* option to allow or disallow duplicates\n\n",entity_date=>undef,entity_v=>undef,links=>[{url=>"pm:Data::Unixish::pick"},{description=>"\n`shuf -n` is a Unix idiom for when wanting to pick one or several lines from an\ninput. Our `pick` is generally slower than the optimized C-based utility, but\noffers several pick algorithms like `scan` (which does not need to hold the\nentire input in memory for shuffling) and `seek` (which does not need to scan\nthe entire input).\n\n",summary=>"The venerable Unix utility",url=>"prog:shuf"}],result_naked=>0,summary=>"Pick one or more random lines from input",v=>1.1};
my $sc_metas = {};
my $copts = {format=>{default=>undef,description=>"\nOutput can be displayed in multiple formats, and a suitable default format is\nchosen depending on the application and/or whether output destination is\ninteractive terminal (i.e. whether output is piped). This option specifically\nchooses an output format.\n\n",getopt=>"format=s",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'format'} = $val},is_settable_via_config=>1,key=>"format",schema=>["str*","in",["text","text-simple","text-pretty","json","json-pretty","csv","termtable","html","html+datatables","perl","vd"]],summary=>"Choose output format, e.g. json, text",tags=>["category:output"],value_label=>"name"},help=>{getopt=>"help|h|?",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'action'} = 'help';$$r{'skip_parse_subcommand_argv'} = 1},key=>"action",order=>0,summary=>"Display help message and exit",usage=>"--help (or -h, -?)","usage.alt.fmt.pod"=>"B<L<--help|/\"--help, -h, -?\">> (or B<L<-h|/\"--help, -h, -?\">>, B<L<-?|/\"--help, -h, -?\">>)"},json=>{getopt=>"json",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'format'} = is_interactive(*STDOUT) ? 'json-pretty' : 'json'},key=>"format",summary=>"Set output format to json",tags=>["category:output"]},naked_res=>{default=>0,description=>"\nBy default, when outputing as JSON, the full enveloped result is returned, e.g.:\n\n    [200,\"OK\",[1,2,3],{\"func.extra\"=>4}]\n\nThe reason is so you can get the status (1st element), status message (2nd\nelement) as well as result metadata/extra result (4th element) instead of just\nthe result (3rd element). However, sometimes you want just the result, e.g. when\nyou want to pipe the result for more post-processing. In this case you can use\n`--naked-res` so you just get:\n\n    [1,2,3]\n\n",getopt=>"naked-res!",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'naked_res'} = $val ? 1 : 0},is_settable_via_config=>1,summary=>"When outputing as JSON, strip result envelope","summary.alt.bool.not"=>"When outputing as JSON, add result envelope",tags=>["category:output"]},page_result=>{description=>"\nThis option will pipe the output to a specified pager program. If pager program\nis not specified, a suitable default e.g. `less` is chosen.\n\n",getopt=>"page-result:s",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'page_result'} = 1;$$r{'pager'} = $val if length $val},key=>"send_output",summary=>"Filter output through a pager",tags=>["category:output"],value_label=>"program"},version=>{getopt=>"version|v",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'action'} = 'version';$$r{'skip_parse_subcommand_argv'} = 1},key=>"action",summary=>"Display program's version and exit",usage=>"--version (or -v)","usage.alt.fmt.pod"=>"B<L<--version|/\"--version, -v\">> (or B<L<-v|/\"--version, -v\">>)"},view_result=>{description=>"\nThis option will first save the output to a temporary file, then open a viewer\nprogram to view the temporary file. If a viewer program is not chosen, a\nsuitable default, e.g. the browser, is chosen.\n\n",getopt=>"view-result:s",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'view_result'} = 1;$$r{'viewer'} = $val if length $val},key=>"send_output",summary=>"View output using a viewer",tags=>["category:output"],value_label=>"program"}};
my $r = {common_opts=>$copts};
# get words
my $shell;
my ($words, $cword);
if ($ENV{COMP_LINE}) { $shell = "bash"; require Complete::Bash; require Encode; ($words,$cword) = @{ Complete::Bash::parse_cmdline() }; ($words,$cword) = @{ Complete::Bash::join_wordbreak_words($words,$cword) }; $words = [map {Encode::decode("UTF-8", $_)} @$words]; }
elsif ($ENV{COMMAND_LINE}) { $shell = "tcsh"; require Complete::Tcsh; ($words,$cword) = @{ Complete::Tcsh::parse_cmdline() }; }
@ARGV = @$words;
# strip program name
shift @$words; $cword--;
# parse common_opts which potentially sets subcommand
{
    require Getopt::Long;
    my $old_go_conf = Getopt::Long::Configure('pass_through', 'no_ignore_case', 'bundling', 'no_auto_abbrev', 'no_getopt_compat', 'gnu_compat');
    my @go_spec;
    for my $k (keys %$copts) { push @go_spec, $copts->{$k}{getopt} => sub { my ($go, $val) = @_; $copts->{$k}{handler}->($go, $val, $r); } }
    Getopt::Long::GetOptions(@go_spec);
    Getopt::Long::Configure($old_go_conf);
}
# select subcommand
my $scn = $r->{subcommand_name};
my $scn_from = $r->{subcommand_name_from};
if (!defined($scn) && defined($args->{default_subcommand})) {
    # get from default_subcommand
    if ($args->{get_subcommand_from_arg} == 1) {
        $scn = $args->{default_subcommand};
        $scn_from = "default_subcommand";
    } elsif ($args->{get_subcommand_from_arg} == 2 && !@ARGV) {
        $scn = $args->{default_subcommand};
        $scn_from = "default_subcommand";
    }
}
if (!defined($scn) && $args->{subcommands} && @ARGV) {
    # get from first command-line arg
    $scn = shift @ARGV;
    $scn_from = "arg";
}
if (defined($scn) && !$sc_metas->{$scn}) { undef $scn } # unknown subcommand name
# pass meta for Complete::Getopt::Long
$r->{meta} = defined($scn) ? $sc_metas->{$scn} : $meta;
# XXX read_env
# complete with periscomp
my $compres;
{
    require Perinci::Sub::Complete;
    $compres = Perinci::Sub::Complete::complete_cli_arg(
        meta => $r->{meta},
        words => $words,
        cword => $cword,
        common_opts => $copts,
        riap_server_url => undef,
        riap_uri => undef,
        extras => {r=>$r, cmdline=>undef},
        func_arg_starts_at => (($scn_from//"") eq "arg" ? 1:0),
        completion => sub {
            my %args = @_;
            my $type = $args{type};
            # user specifies custom completion routine, so use that first
            if ($args->{completion}) {
                my $res = $args->{completion}->(%args);
                return $res if $res;
            }
            # if subcommand name has not been supplied and we're at arg#0,
            # complete subcommand name
            if ($args->{subcommands} &&
                $scn_from ne "--cmd" &&
                     $type eq "arg" && $args{argpos}==0) {
                my @subc_names     = keys %{ $args->{subcommands} };
                my @subc_summaries = map { $args->{subcommands}{$_}{summary} } @subc_names;
                require Complete::Util;
                return Complete::Util::complete_array_elem(
                    array     => \@subc_names,
                    summaries => \@subc_summaries,
                    word  => $words->[$cword]);
            }
            # otherwise let periscomp do its thing
            return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
        },
    );
}
# display result
if    ($shell eq "bash") { print Complete::Bash::format_completion($compres, {word=>$words->[$cword]}) }
elsif ($shell eq "tcsh") { print Complete::Tcsh::format_completion($compres) }
HideShow 59 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
_pick-random-lines - Completer script for pick-random-lines
=head1 VERSION
This document describes version 0.021 of main::_DataPacker (from Perl distribution App-PickRandomLines), released on 2023-11-20.
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/App-PickRandomLines>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-App-PickRandomLines>.
=head1 AUTHOR
perlancar <perlancar@cpan.org>
=head1 CONTRIBUTING
To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.
Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:
 % prove -l
If you want to build the distribution (e.g. to try to install it locally on your
system), you can install L<Dist::Zilla>,
L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
that are considered a bug and can be reported to me.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2023, 2020 by perlancar <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.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-PickRandomLines>
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.
=cut
__DATA__
Data::Section::Seekable v1
Clone/PP.pm,20,6331,0;0
Complete/Bash.pm,6376,41736,1;193
Complete/Common.pm,48139,6507,2;1496
Complete/Env.pm,54670,5656,3;1692
Complete/File.pm,60351,15192,4;1950
Complete/Getopt/Long.pm,75575,36939,5;2447
Complete/Path.pm,112539,17195,6;3466
Complete/Sah.pm,129758,18068,7;3981
Complete/Tcsh.pm,147851,6850,8;4465
Complete/Util.pm,154726,51040,9;4721
Data/Sah/Normalize.pm,205796,9925,10;6466
Function/Fallback/CoreOrPP.pm,215759,5030,11;6766
Getopt/Long/Util.pm,220817,24293,12;6961
Log/ger.pm,245129,12245,13;7793
Log/ger/Filter.pm,257400,1226,14;8165
Log/ger/Filter/Code.pm,258657,1419,15;8232
Log/ger/Format.pm,260102,1370,16;8314
Log/ger/Format/Default.pm,261506,3323,17;8388
Log/ger/Format/MultilevelLog.pm,264869,5162,18;8506
Log/ger/Format/None.pm,270062,1346,19;8689
Log/ger/Heavy.pm,271433,18227,20;8757
Log/ger/Layout.pm,289686,1306,21;9159
Log/ger/Output.pm,291018,1435,22;9228
Log/ger/Output/Array.pm,292485,1609,23;9308
Log/ger/Output/Null.pm,294125,1350,24;9394
Log/ger/Output/String.pm,295508,2332,25;9463
Log/ger/Plugin.pm,297866,2062,26;9568
Log/ger/Plugin/MultilevelLog.pm,299968,3836,27;9683
Log/ger/Util.pm,303828,10307,28;9812
Module/Installed/Tiny.pm,314168,14112,29;10140
Perinci/Sub/Complete.pm,328312,57331,30;10565
Perinci/Sub/Util.pm,385671,24867,31;12193
Perinci/Sub/Util/Args.pm,410571,7054,32;13060
Perinci/Sub/Util/ResObj.pm,417660,2332,33;13335
Perinci/Sub/Util/Sort.pm,420025,2712,34;13418
String/Wildcard/Bash.pm,422769,15067,35;13529
### Clone/PP.pm ###
#package Clone::PP;
#
#use 5.006;
#use strict;
#use warnings;
#use vars qw($VERSION @EXPORT_OK);
#use Exporter;
#
#$VERSION = 1.08;
#
#@EXPORT_OK = qw( clone );
#sub import { goto &Exporter::import } # lazy Exporter
#
## These methods can be temporarily overridden to work with a given class.
#use vars qw( $CloneSelfMethod $CloneInitMethod );
#$CloneSelfMethod ||= 'clone_self';
#$CloneInitMethod ||= 'clone_init';
#
## Used to detect looped networks and avoid infinite recursion. 
#use vars qw( %CloneCache );
#
## Generic cloning function
#sub clone {
#  my $source = shift;
#
#  return undef if not defined($source);
#  
#  # Optional depth limit: after a given number of levels, do shallow copy.
#  my $depth = shift;
#  return $source if ( defined $depth and $depth -- < 1 );
#  
#  # Maintain a shared cache during recursive calls, then clear it at the end.
#  local %CloneCache = ( undef => undef ) unless ( exists $CloneCache{undef} );
#  
#  return $CloneCache{ $source } if ( defined $CloneCache{ $source } );
#  
#  # Non-reference values are copied shallowly
#  my $ref_type = ref $source or return $source;
#  
#  # Extract both the structure type and the class name of referent
#  my $class_name;
#  if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
#    $class_name = $ref_type;
#    $ref_type = $1;
#    # Some objects would prefer to clone themselves; check for clone_self().
#    return $CloneCache{ $source } = $source->$CloneSelfMethod() 
#                                 if $source->can($CloneSelfMethod);
#  }
#  
#  # To make a copy:
#  # - Prepare a reference to the same type of structure;
#  # - Store it in the cache, to avoid looping if it refers to itself;
#  # - Tie in to the same class as the original, if it was tied;
#  # - Assign a value to the reference by cloning each item in the original;
#  
#  my $copy;
#  if ($ref_type eq 'HASH') {
#    $CloneCache{ $source } = $copy = {};
#    if ( my $tied = tied( %$source ) ) { tie %$copy, ref $tied }
#    %$copy = map { ! ref($_) ? $_ : clone($_, $depth) } %$source;
#  } elsif ($ref_type eq 'ARRAY') {
#    $CloneCache{ $source } = $copy = [];
#    if ( my $tied = tied( @$source ) ) { tie @$copy, ref $tied }
#    @$copy = map { ! ref($_) ? $_ : clone($_, $depth) } @$source;
#  } elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
#    $CloneCache{ $source } = $copy = \( my $var = "" );
#    if ( my $tied = tied( $$source ) ) { tie $$copy, ref $tied }
#    $$copy = clone($$source, $depth);
#  } else {
#    # Shallow copy anything else; this handles a reference to code, glob, regex
#    $CloneCache{ $source } = $copy = $source;
#  }
#  
#  # - Bless it into the same class as the original, if it was blessed;
#  # - If it has a post-cloning initialization method, call it.
#  if ( $class_name ) {
#    bless $copy, $class_name;
#    $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
#  }
#  
#  return $copy;
#}
#
#1;
#
#__END__
#
#=head1 NAME
#
#Clone::PP - Recursively copy Perl datatypes
#
#=head1 SYNOPSIS
#
#  use Clone::PP qw(clone);
#  
#  $item = { 'foo' => 'bar', 'move' => [ 'zig', 'zag' ]  };
#  $copy = clone( $item );
#
#  $item = [ 'alpha', 'beta', { 'gamma' => 'vlissides' } ];
#  $copy = clone( $item );
#
#  $item = Foo->new();
#  $copy = clone( $item );
#
#Or as an object method:
#
#  require Clone::PP;
#  push @Foo::ISA, 'Clone::PP';
#  
#  $item = Foo->new();
#  $copy = $item->clone();
#
#=head1 DESCRIPTION
#
#This module provides a general-purpose clone function to make deep
#copies of Perl data structures. It calls itself recursively to copy
#nested hash, array, scalar and reference types, including tied
#variables and objects.
#
#The clone() function takes a scalar argument to copy. To duplicate
#arrays or hashes, pass them in by reference:
#
#  my $copy = clone(\@array);    my @copy = @{ clone(\@array) };
#  my $copy = clone(\%hash);     my %copy = %{ clone(\%hash) };
#
#The clone() function also accepts an optional second parameter that
#can be used to limit the depth of the copy. If you pass a limit of
#0, clone will return the same value you supplied; for a limit of
#1, a shallow copy is constructed; for a limit of 2, two layers of
#copying are done, and so on.
#
#  my $shallow_copy = clone( $item, 1 );
#
#To allow objects to intervene in the way they are copied, the
#clone() function checks for a couple of optional methods. If an
#object provides a method named C<clone_self>, it is called and the
#result returned without further processing. Alternately, if an
#object provides a method named C<clone_init>, it is called on the
#copied object before it is returned.
#
#=head1 BUGS
#
#Some data types, such as globs, regexes, and code refs, are always copied shallowly.
#
#References to hash elements are not properly duplicated. (This is why two tests in t/dclone.t that are marked "todo".) For example, the following test should succeed but does not:
#
#  my $hash = { foo => 1 }; 
#  $hash->{bar} = \{ $hash->{foo} }; 
#  my $copy = clone( \%hash ); 
#  $hash->{foo} = 2; 
#  $copy->{foo} = 2; 
#  ok( $hash->{bar} == $copy->{bar} );
#
#To report bugs via the CPAN web tracking system, go to 
#C<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Clone-PP> or send mail 
#to C<Dist=Clone-PP#rt.cpan.org>, replacing C<#> with C<@>.
#
#=head1 SEE ALSO
#
#L<Clone> - a baseclass which provides a C<clone()> method.
#
#L<MooseX::Clone> - find-grained cloning for Moose objects.
#
#The C<dclone()> function in L<Storable>.
#
#L<Data::Clone> -
#polymorphic data cloning (see its documentation for what that means).
#
#L<Clone::Any> - use whichever of the cloning methods is available.
#
#=head1 REPOSITORY
#
#L<https://github.com/neilbowers/Clone-PP>
#
#=head1 AUTHOR AND CREDITS
#
#Developed by Matthew Simon Cavalletto at Evolution Softworks. 
#More free Perl software is available at C<www.evoscript.org>.
#
#
#=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,
#        },
#    },
#    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]`.
#
#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;
#    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;
#    }
#}
#
#sub _terminal_height {
#    # XXX need to cache?
#    if (eval { require Term::Size; 1 }) {
#        my (undef, $lines) = Term::Size::chars(*STDOUT{IO});
#        $lines // 25;
#    } else {
#        $ENV{LINES} // 25;
#    }
#}
#
## 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};
#
#    # we keep the original words (before formatted with summaries) when we want
#    # 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[$_]
#                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: {
#        last unless $max_columns > 0;
#        my $max_entry_width = 0;
#        for (@res) {
#            $max_entry_width = length if $max_entry_width < length;
#        }
#        last if $max_entry_width >= $column_width;
#        for (@res) {
#            $_ .= " " x ($column_width - length) if $column_width > length;
#        }
#    }
#
#  PASS_TO_FZF: {
#        last if $ENV{INSIDE_EMACS};
#        last unless $ENV{COMPLETE_BASH_FZF};
#        my $items = $ENV{COMPLETE_BASH_FZF_ITEMS} // 100;
#        if ($items == -1) {
#            $items = _terminal_height();
#        }
#        last unless @words >= $items;
#
#        require File::Which;
#        unless (File::Which::which("fzf")) {
#            #@res = $code_return_message->("Cannot find fzf to filter ".
#            #                                  scalar(@words)." items");
#            goto RETURN_RES;
#        }
#
#        require IPC::Open2;
#        local *CHLD_OUT;
#        local *CHLD_IN;
#        my $pid = IPC::Open2::open2(
#            \*CHLD_OUT, \*CHLD_IN, "fzf", "-m", "-d:", "--with-nth=2..")
#            or do {
#                @res = $code_return_message->("Cannot open fzf to filter ".
#                                                  scalar(@words)." items");
#                goto RETURN_RES;
#            };
#
#        print CHLD_IN map { "$_:$res[$_]\n" } 0..$#res;
#        close CHLD_IN;
#
#        my @res_words;
#        while (<CHLD_OUT>) {
#            my ($index) = /\A([0-9]+)\:/ or next;
#            push @res_words, $words[$index];
#        }
#        if (@res_words) {
#            @res = join(" ", @res_words);
#        } else {
#            @res = ();
#        }
#        waitpid($pid, 0);
#    }
#
#  RETURN_RES:
#    #use Data::Dump; warn Data::Dump::dump(\@res);
#    if ($as eq 'array') {
#        return \@res;
#    } else {
#        return join("", map {($_, "\n")} @res);
#    }
#}
#
#1;
## ABSTRACT: Completion routines for bash shell
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Bash - Completion routines for bash shell
#
#=head1 VERSION
#
#This document describes version 0.337 of Complete::Bash (from Perl distribution Complete-Bash), released on 2022-09-08.
#
#=head1 DESCRIPTION
#
#This module provides routines related to tab completion in bash shell.
#
#=head2 About programmable completion in bash
#
#Bash allows completion to come from various sources. The simplest is from a list
#of words (C<-W>):
#
# % complete -W "one two three four" somecmd
# % 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_code, $reason, $payload, \%result_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_code) is an integer containing HTTP-like status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#($reason) is a string containing error message, or something like "OK" if status is
#200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
#element (%result_meta) is called result metadata and is optional, a hash
#that contains extra information, much like how HTTP response headers provide additional metadata.
#
#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
#integer, roughly equivalent to C<COMP_CWORD> provided by bash to shell functions.
#The word to be completed is at C<< $words-E<gt>[$cword] >>.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in C<@ARGV>), you need to strip the first element from
#C<$words> and reduce C<$cword> by 1.
#
#
#
#=head2 point
#
#Usage:
#
# point($cmdline, $marker) -> any
#
#Return line with point marked by a marker.
#
#This is a utility function useful for testing/debugging. C<parse_cmdline()>
#expects a command-line and a cursor position (C<$line>, C<$point>). This routine
#expects C<$line> with a marker character (by default it's the caret, C<^>) and
#return (C<$line>, C<$point>) to feed to C<parse_cmdline()>.
#
#Example:
#
# point("^foo") # => ("foo", 0)
# point("fo^o") # => ("foo", 2)
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line which contains a marker character.
#
#=item * B<$marker> => I<str> (default: "^")
#
#Marker character.
#
#
#=back
#
#Return value:  (any)
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_BASH_DEFAULT_ESC_MODE
#
#Str. To provide default for the C<esc_mode> option in L</format_completion>.
#
#=head2 COMPLETE_BASH_FZF
#
#Bool. Whether to pass large completion answer to fzf instead of directly passing
#it to bash and letting bash page it with a simpler more-like internal pager. By
#default, large is defined as having at least 100 items (same bash's
#C<completion-query-items> setting). This can be configured via
#L</COMPLETE_BASH_FZF_ITEMS>.
#
#Will not pass to fzf if inside emacs (C<INSIDE_EMACS> environment is true).
#
#=head2 COMPLETE_BASH_FZF_ITEMS
#
#Uint. Default 100. The minimum number of items to trigger passing completion
#answer to C<fzf>.
#
#A special value of -1 means to use terminal height. However, since terminal
#height (and width) normally cannot be read during tab completion anyway, it's
#better if you do something like this in your bash startup file:
#
# export COMPLETE_BASH_FZF_ITEMS=$LINES
#
#because without passing to C<fzf>, as soon as the number of completion answers
#exceeds C<$LINES>, C<bash> will start paging the answer to its internal pager,
#which is limited like C<more>. If you set the above, then as soon as the number
#of completion answers exceeds terminal height, you will avoid the bash internal
#pager and use the nicer C<fzf>.
#
#See also: L</COMPLETE_BASH_FZF>.
#
#=head2 COMPLETE_BASH_MAX_COLUMNS
#
#Uint.
#
#Bash will show completion entries in one or several columns, depending on the
#terminal width and the length of the entries (much like a standard non-long
#`ls`). If you prefer completion entries to be shown in a single column no matter
#how wide your terminal is, or how short the entries are, you can set the value
#of this variable to 1. If you prefer a maximum of two columns, set to 2, and so
#on. L</format_completion> will pad the entries with sufficient spaces to limit
#the number of columns.
#
#=head2 COMPLETE_BASH_SHOW_SUMMARIES
#
#Bool. Will set the default for C<show_summaries> option in
#L</format_completion>.
#
#=head2 COMPLETE_BASH_SUMMARY_ALIGN
#
#String. Either C<left> (the default) or C<right>.
#
#The C<left> align looks something like this:
#
# --bar      Summary about the bar option
# --baz      Summary about the baz option
# --foo      Summary about the foo option
# --schapen  Summary about the schapen option
#
#The C<right> align will make the completion answer look like what you see in the
#B<fish> shell:
#
# --bar                        Summary about the bar option
# --baz                        Summary about the baz option
# --foo                        Summary about the foo option
# --schapen                Summary about the schapen option
#
#=head2 COMPLETE_BASH_TRACE
#
#Bool. If set to true, will produce more log statements to L<Log::ger>.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Bash>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Bash>.
#
#=head1 SEE ALSO
#
#L<Complete>, the convention that this module follows.
#
#Some higher-level modules that use this module (so you don't have to use this
#module directly): L<Getopt::Long::Complete> (via L<Complete::Getopt::Long>),
#L<Getopt::Long::Subcommand>, L<Perinci::CmdLine> (via
#L<Perinci::Sub::Complete>).
#
#Other modules related to bash shell tab completion: L<Bash::Completion>,
#L<Getopt::Complete>, L<Term::Bash::Completion::Generator>.
#
#Programmable Completion section in Bash manual:
#L<https://www.gnu.org/software/bash/manual/html_node/Programmable-Completion.html>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTORS
#
#=for stopwords Mary Ehlers Steven Haryanto
#
#=over 4
#
#=item *
#
#Mary Ehlers <regina.verb.ae@gmail.com>
#
#=item *
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=back
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2020, 2019, 2018, 2016, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-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.
#
#=cut
### Complete/Common.pm ###
#package Complete::Common;
#
#our $DATE = '2016-01-05'; # DATE
#our $VERSION = '0.22'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       %arg_word
#               );
#
#our %EXPORT_TAGS = (
#    all => \@EXPORT_OK
#);
#
#our %arg_word = (
#    word => {
#        summary => 'Word to complete',
#        schema => ['str', default=>''],
#        pos=>0,
#        req=>1,
#    },
#);
#
#our $OPT_CI          = ($ENV{COMPLETE_OPT_CI}          // 1) ? 1:0;
#our $OPT_WORD_MODE   = ($ENV{COMPLETE_OPT_WORD_MODE}   // 1) ? 1:0;
#our $OPT_CHAR_MODE   = ($ENV{COMPLETE_OPT_CHAR_MODE}   // 1) ? 1:0;
#our $OPT_FUZZY       = ($ENV{COMPLETE_OPT_FUZZY}       // 1)+0;
#our $OPT_MAP_CASE    = ($ENV{COMPLETE_OPT_MAP_CASE}    // 1) ? 1:0;
#our $OPT_EXP_IM_PATH = ($ENV{COMPLETE_OPT_EXP_IM_PATH} // 1) ? 1:0;
#our $OPT_DIG_LEAF    = ($ENV{COMPLETE_OPT_DIG_LEAF}    // 1) ? 1:0;
#
#1;
## ABSTRACT: Common stuffs for completion routines
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Common - Common stuffs for completion routines
#
#=head1 VERSION
#
#This document describes version 0.22 of Complete::Common (from Perl distribution Complete-Common), released on 2016-01-05.
#
#=head1 DESCRIPTION
#
#This module defines some common arguments and settings. C<Complete::*> modules
#should use the default from these settings, to make it convenient for users to
#change some behaviors globally.
#
#The defaults are optimized for convenience and laziness for user typing and
#might change from release to release.
#
#=head2 C<$Complete::Common::OPT_CI> => bool (default: from COMPLETE_OPT_CI or 1)
#
#If set to 1, matching is done case-insensitively.
#
#In bash/readline, this is akin to setting C<completion-ignore-case>.
#
#=head2 C<$Complete::Common::OPT_WORD_MODE> => bool (default: from COMPLETE_OPT_WORD_MODE or 1)
#
#If set to 1, enable word-mode matching.
#
#Word mode matching is normally only done when exact matching fails to return any
#candidate. To give you an idea of how word-mode matching works, you can run
#Emacs and try its completion of filenames (C<C-x C-f>) or function names
#(C<M-x>). Basically, each string is split into words and matching is tried for
#all available word even non-adjacent ones. For example, if you have C<dua-d> and
#the choices are (C<dua-tiga>, C<dua-empat>, C<dua-lima-delapan>) then
#C<dua-lima-delapan> will match because C<d> matches C<delapan> even though the
#word is not adjacent. This is convenient when you have strings that are several
#or many words long: you can just type the starting letters of some of the words
#instead of just the starting letters of the whole string (which might need to be
#quite long before producing a unique match).
#
#=head2 C<$Complete::Common::OPT_CHAR_MODE> => bool (default: from COMPLETE_OPT_CHAR_MODE or 1)
#
#If set to 1, enable character-mode matching.
#
#This mode is like word-mode matching, except it works on a
#character-by-character basis. Basically, it will match if a word contains any
#letters of the string in the correct order. For example, C<ap> will match C<ap>,
#C<amp>, C<slap>, or C<cramp> (but will not match C<pa> or C<pram>).
#
#Character-mode matching is normally only done when exact matching and word-mode
#fail to return any candidate.
#
#=head2 C<$Complete::Common::OPT_FUZZY> => int (default: from COMPLETE_OPT_FUZZY or 1)
#
#Enable fuzzy matching (matching even though there are some spelling mistakes).
#The greater the number, the greater the tolerance. To disable fuzzy matching,
#set to 0.
#
#Fuzzy matching is normally only done when exact matching, word-mode, and
#char-mode matching fail to return any candidate.
#
#=head2 C<$Complete::Common::OPT_MAP_CASE> => bool (default: from COMPLETE_OPT_MAP_CASE or 1)
#
#This is exactly like C<completion-map-case> in readline/bash to treat C<_> and
#C<-> as the same when matching.
#
#All L<Complete::Path>-based modules (like L<Complete::File>,
#L<Complete::Module>, or L<Complete::Riap>) respect this setting.
#
#=head2 C<$Complete::Common::OPT_EXP_IM_PATH> => bool (default: from COMPLETE_OPT_EXP_IM_PATH or 1)
#
#Whether to "expand intermediate paths". What is meant by this is something like
#zsh: when you type something like C<cd /h/u/b/myscript> it can be completed to
#C<cd /home/ujang/bin/myscript>.
#
#All L<Complete::Path>-based modules (like L<Complete::File>,
#L<Complete::Module>, or L<Complete::Riap>) respect this setting.
#
#=head2 C<$Complete::Common::OPT_DIG_LEAF> => bool (default: from COMPLETE_OPT_DIG_LEAF or 1)
#
#(Experimental) When enabled, this option mimics what's seen on GitHub. If a
#directory entry only contains a single subentry, it will directly show the
#subentry (and subsubentry and so on) to save a number of tab presses.
#
#Suppose you have files like this:
#
# a
# b/c/d/e
# c
#
#If you complete for C<b> you will directly get C<b/c/d/e> (the leaf).
#
#This is currently experimental because if you want to complete only directories,
#you won't get b or b/c or b/c/d. Need to think how to solve this.
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_OPT_CI => bool
#
#Set default for C<$Complete::Common::OPT_CI>.
#
#=head2 COMPLETE_OPT_FUZZY => int
#
#Set default for C<$Complete::Common::OPT_FUZZY>.
#
#=head2 COMPLETE_OPT_WORD_MODE => bool
#
#Set default for C<$Complete::Common::OPT_WORD_MODE>.
#
#=head2 COMPLETE_OPT_MAP_CASE => bool
#
#Set default for C<$Complete::Common::OPT_MAP_CASE>.
#
#=head2 COMPLETE_OPT_EXP_IM_PATH => bool
#
#Set default for C<$Complete::Common::OPT_EXP_IM_PATH>.
#
#=head2 COMPLETE_OPT_DIG_LEAF => bool
#
#Set default for C<$Complete::Common::OPT_DIG_LEAF>.
#
#=head1 SEE ALSO
#
#L<Complete>
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Common>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Common>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Common>
#
#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
### Complete/Env.pm ###
#package Complete::Env;
#
#our $DATE = '2017-12-31'; # DATE
#our $VERSION = '0.400'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_env
#                       complete_env_elem
#                       complete_path_env_elem
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines related to environment variables',
#};
#
#$SPEC{complete_env} = {
#    v => 1.1,
#    summary => 'Complete from environment variables',
#    description => <<'_',
#
#On Windows, environment variable names are all converted to uppercase. You can
#use case-insensitive option (`ci`) to match against original casing.
#
#_
#    args => {
#        %arg_word,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_env {
#    require Complete::Util;
#
#    my %args  = @_;
#    my $word     = $args{word} // "";
#    if ($word =~ /^\$/) {
#        Complete::Util::complete_array_elem(
#            word=>$word, array=>[map {"\$$_"} keys %ENV],
#        );
#    } else {
#        Complete::Util::complete_array_elem(
#            word=>$word, array=>[keys %ENV],
#        );
#    }
#}
#
#$SPEC{complete_env_elem} = {
#    v => 1.1,
#    summary => 'Complete from elements of an environment variable',
#    description => <<'_',
#
#An environment variable like PATH contains colon- (or, on Windows, semicolon-)
#separated elements. This routine complete from the elements of such variable.
#
#_
#    args => {
#        %arg_word,
#        env      => {
#            summary => 'Name of environment variable to use',
#            schema  => 'str*',
#            req => 1,
#            pos => 1,
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_env_elem {
#    require Complete::Util;
#
#    my %args  = @_;
#    my $word  = $args{word} // "";
#    my $env   = $args{env};
#    my @elems;
#    if ($^O eq 'MSWin32') {
#        @elems = split /;/, ($ENV{$env} // '');
#    } else {
#        @elems = split /:/, ($ENV{$env} // '');
#    }
#    Complete::Util::complete_array_elem(
#        word=>$word, array=>\@elems,
#    );
#}
#
#$SPEC{complete_path_env_elem} = {
#    v => 1.1,
#    summary => 'Complete from elements of PATH environment variable',
#    description => <<'_',
#
#PATH environment variable contains colon- (or, on Windows, semicolon-) separated
#elements. This routine complete from those elements.
#
#_
#    args => {
#        %arg_word,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_path_env_elem {
#    my %args  = @_;
#    complete_env_elem(word => $args{word}, env => 'PATH');
#}
#
#1;
## ABSTRACT: Completion routines related to environment variables
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Env - Completion routines related to environment variables
#
#=head1 VERSION
#
#This document describes version 0.400 of Complete::Env (from Perl distribution Complete-Env), released on 2017-12-31.
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#
#=head2 complete_env
#
#Usage:
#
# complete_env(%args) -> array
#
#Complete from environment variables.
#
#On Windows, environment variable names are all converted to uppercase. You can
#use case-insensitive option (C<ci>) to match against original casing.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#=back
#
#Return value:  (array)
#
#
#=head2 complete_env_elem
#
#Usage:
#
# complete_env_elem(%args) -> array
#
#Complete from elements of an environment variable.
#
#An environment variable like PATH contains colon- (or, on Windows, semicolon-)
#separated elements. This routine complete from the elements of such variable.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<env>* => I<str>
#
#Name of environment variable to use.
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#=back
#
#Return value:  (array)
#
#
#=head2 complete_path_env_elem
#
#Usage:
#
# complete_path_env_elem(%args) -> array
#
#Complete from elements of PATH environment variable.
#
#PATH environment variable contains colon- (or, on Windows, semicolon-) separated
#elements. This routine complete from those elements.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#=back
#
#Return value:  (array)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Env>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Env>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Env>
#
#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
#
#L<Complete>
#
#Other C<Complete::*> modules.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2017, 2016, 2015 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
### Complete/File.pm ###
#package Complete::File;
#
#our $DATE = '2021-02-08'; # DATE
#our $VERSION = '0.443'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#use Complete::Util qw(hashify_answer);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_file
#                       complete_dir
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines related to files',
#};
#
#$SPEC{complete_file} = {
#    v => 1.1,
#    summary => 'Complete file and directory from local filesystem',
#    args => {
#        %arg_word,
#        filter => {
#            summary => 'Only return items matching this filter',
#            description => <<'_',
#
#Filter can either be a string or a code.
#
#For string filter, you can specify a pipe-separated groups of sequences of these
#characters: f, d, r, w, x. Dash can appear anywhere in the sequence to mean
#not/negate. An example: `f` means to only show regular files, `-f` means only
#show non-regular files, `drwx` means to show only directories which are
#readable, writable, and executable (cd-able). `wf|wd` means writable regular
#files or writable directories.
#
#For code filter, you supply a coderef. The coderef will be called for each item
#with these arguments: `$name`. It should return true if it wants the item to be
#included.
#
#_
#            schema  => ['any*' => {of => ['str*', 'code*']}],
#            tags => ['category:filtering'],
#        },
#        file_regex_filter => {
#            summary => 'Filter shortcut for file regex',
#            description => <<'_',
#
#This is a shortcut for constructing a filter. So instead of using `filter`, you
#use this option. This will construct a filter of including only directories or
#regular files, and the file must match a regex pattern. This use-case is common.
#
#_
#            schema => 're*',
#            tags => ['category:filtering'],
#        },
#        exclude_dir => {
#            schema => 'bool*',
#            description => <<'_',
#
#This is also an alternative to specifying full `filter`. Set this to true if you
#do not want directories.
#
#If you only want directories, take a look at `complete_dir()`.
#
#_
#            tags => ['category:filtering'],
#        },
#        file_ext_filter => {
#            schema => ['any*', of=>['re*', ['array*',of=>'str*']]],
#            description => <<'_',
#
#This is also an alternative to specifying full `filter` or `file_regex_filter`.
#You can set this to a regex or a set of extensions to accept. Note that like in
#`file_regex_filter`, directories of any name is also still allowed.
#
#_
#            tags => ['category:filtering'],
#        },
#        starting_path => {
#            schema  => 'str*',
#            default => '.',
#        },
#        handle_tilde => {
#            schema  => 'bool',
#            default => 1,
#        },
#        allow_dot => {
#            summary => 'If turned off, will not allow "." or ".." in path',
#            description => <<'_',
#
#This is most useful when combined with `starting_path` option to prevent user
#going up/outside the starting path.
#
#_
#            schema  => 'bool',
#            default => 1,
#        },
#        recurse => {
#            schema => 'bool*',
#            cmdline_aliases => {r=>{}},
#        },
#        recurse_matching => {
#            schema => ['str*', in=>['level-by-level', 'all-at-once']],
#            default => 'level-by-level',
#        },
#        exclude_leaf => {
#            schema => 'bool*',
#        },
#        exclude_dir => {
#            schema => 'bool*',
#        },
#    },
#    args_rels => {
#        dep_all => [recurse_matching => ['recurse']],
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_file {
#    require Complete::Path;
#    require Encode;
#    require File::Glob;
#
#    my %args   = @_;
#    my $word   = $args{word} // "";
#    my $handle_tilde = $args{handle_tilde} // 1;
#    my $allow_dot   = $args{allow_dot} // 1;
#
#    # if word is starts with "~/" or "~foo/" replace it temporarily with user's
#    # name (so we can restore it back at the end). this is to mimic bash
#    # support. note that bash does not support case-insensitivity for "foo".
#    my $result_prefix;
#    my $starting_path = $args{starting_path} // '.';
#    if ($handle_tilde && $word =~ s!\A(~[^/]*)/!!) {
#        $result_prefix = "$1/";
#        my @dir = File::Glob::bsd_glob($1); # glob will expand ~foo to /home/foo
#        return [] unless @dir;
#        $starting_path = Encode::decode('UTF-8', $dir[0]);
#    } elsif ($allow_dot && $word =~ s!\A((?:\.\.?/+)+|/+)!!) {
#        # just an optimization to skip sequences of '../'
#        $starting_path = $1;
#        $result_prefix = $1;
#        $starting_path =~ s#/+\z## unless $starting_path =~ m!\A/!;
#    }
#
#    # bail if we don't allow dot and the path contains dot
#    return [] if !$allow_dot &&
#        $word =~ m!(?:\A|/)\.\.?(?:\z|/)!;
#
#    # prepare list_func
#    my $list = sub {
#        my ($path, $intdir, $isint) = @_;
#        opendir my($dh), $path or return undef;
#        my @res;
#        for (sort readdir $dh) {
#            # skip . and .. if leaf is empty, like in bash
#            next if ($_ eq '.' || $_ eq '..') && $intdir eq '';
#            next if $isint && !(-d "$path/$_");
#            push @res, Encode::decode('UTF-8', $_);
#        }
#        \@res;
#    };
#
#    # prepare filter_func
#
#    # from the filter option
#    my $filter;
#    if ($args{filter} && !ref($args{filter})) {
#        my @seqs = split /\s*\|\s*/, $args{filter};
#        $filter = sub {
#            my $name = shift;
#            my @st = stat($name) or return 0;
#            my $mode = $st[2];
#            my $pass;
#          SEQ:
#            for my $seq (@seqs) {
#                my $neg = sub { $_[0] };
#                for my $c (split //, $seq) {
#                    if    ($c eq '-') { $neg = sub { $_[0] ? 0 : 1 } }
#                    elsif ($c eq 'r') { next SEQ unless $neg->($mode & 0400) }
#                    elsif ($c eq 'w') { next SEQ unless $neg->($mode & 0200) }
#                    elsif ($c eq 'x') { next SEQ unless $neg->($mode & 0100) }
#                    elsif ($c eq 'f') { next SEQ unless $neg->($mode & 0100000)}
#                    elsif ($c eq 'd') { next SEQ unless $neg->($mode & 0040000)}
#                    else {
#                        die "Unknown character in filter: $c (in $seq)";
#                    }
#                }
#                $pass = 1; last SEQ;
#            }
#            $pass;
#        };
#    } elsif ($args{filter} && ref($args{filter}) eq 'CODE') {
#        $filter = $args{filter};
#    }
#
#    # from the file_regex_filter option
#    my $filter_fregex;
#    if ($args{file_regex_filter}) {
#        $filter_fregex = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            return 1 if $name =~ $args{file_regex_filter};
#            0;
#        };
#    }
#
#    # from the file_ext_filter option
#    my $filter_fext;
#    if ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'Regexp') {
#        $filter_fext = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
#            return 1 if $ext =~ $args{file_ext_filter};
#            0;
#        };
#    } elsif ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'ARRAY') {
#        $filter_fext = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
#            if ($Complete::Common::OPT_CI) {
#                $ext = lc($ext);
#                for my $e (@{ $args{file_ext_filter} }) {
#                    return 1 if $ext eq lc($e);
#                }
#            } else {
#                for my $e (@{ $args{file_ext_filter} }) {
#                    return 1 if $ext eq $e;
#                }
#            }
#            0;
#        };
#    }
#
#    # from _dir (used by complete_dir)
#    my $filter_dir;
#    if ($args{_dir}) {
#        $filter_dir = sub { return 0 unless (-d $_[0]); 1 };
#    }
#
#    # from exclude_dir option
#    my $filter_xdir;
#    if ($args{exclude_dir}) {
#        $filter_xdir = sub { return 0 if (-d $_[0]); 1 };
#    }
#
#    # final filter sub
#    my $final_filter = sub {
#        my $name = shift;
#        if ($filter_dir)    { return 0 unless $filter_dir->($name)    }
#        if ($filter_xdir)   { return 0 unless $filter_xdir->($name)   }
#        if ($filter)        { return 0 unless $filter->($name)        }
#        if ($filter_fregex) { return 0 unless $filter_fregex->($name) }
#        if ($filter_fext)   { return 0 unless $filter_fext->($name)   }
#        1;
#    };
#
#    my $compres = Complete::Path::complete_path(
#        word => $word,
#        list_func => $list,
#        is_dir_func => sub { -d $_[0] },
#        filter_func => $final_filter,
#        starting_path => $starting_path,
#        result_prefix => $result_prefix,
#        recurse => $args{recurse},
#        recurse_matching => $args{recurse_matching},
#        exclude_leaf => $args{exclude_leaf},
#        exclude_nonleaf => $args{exclude_nonleaf} // $args{exclude_dir},
#    );
#
#    # XXX why doesn't Complete::Path return hash answer with path_sep? we add
#    # workaround here to enable path mode.
#    hashify_answer($compres, {path_sep=>'/'});
#}
#
#$SPEC{complete_dir} = do {
#    my $spec = {%{ $SPEC{complete_file} }}; # shallow copy
#
#    $spec->{summary} = 'Complete directory from local filesystem '.
#        '(wrapper for complete_dir() that only picks directories)';
#    $spec->{args} = { %{$spec->{args}} }; # shallow copy of args
#    delete $spec->{args}{file_regex_filter};
#    delete $spec->{args}{file_ext_filter};
#    delete $spec->{args}{exclude_dir};
#
#    $spec;
#};
#sub complete_dir {
#    my %args = @_;
#
#    complete_file(%args, _dir=>1);
#}
#
#1;
## ABSTRACT: Completion routines related to files
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::File - Completion routines related to files
#
#=head1 VERSION
#
#This document describes version 0.443 of Complete::File (from Perl distribution Complete-File), released on 2021-02-08.
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#
#=head2 complete_dir
#
#Usage:
#
# complete_dir(%args) -> array
#
#Complete directory from local filesystem (wrapper for complete_dir() that only picks directories).
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<allow_dot> => I<bool> (default: 1)
#
#If turned off, will not allow "." or ".." in path.
#
#This is most useful when combined with C<starting_path> option to prevent user
#going up/outside the starting path.
#
#=item * B<exclude_leaf> => I<bool>
#
#=item * B<filter> => I<str|code>
#
#Only return items matching this filter.
#
#Filter can either be a string or a code.
#
#For string filter, you can specify a pipe-separated groups of sequences of these
#characters: f, d, r, w, x. Dash can appear anywhere in the sequence to mean
#not/negate. An example: C<f> means to only show regular files, C<-f> means only
#show non-regular files, C<drwx> means to show only directories which are
#readable, writable, and executable (cd-able). C<wf|wd> means writable regular
#files or writable directories.
#
#For code filter, you supply a coderef. The coderef will be called for each item
#with these arguments: C<$name>. It should return true if it wants the item to be
#included.
#
#=item * B<handle_tilde> => I<bool> (default: 1)
#
#=item * B<recurse> => I<bool>
#
#=item * B<recurse_matching> => I<str> (default: "level-by-level")
#
#=item * B<starting_path> => I<str> (default: ".")
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 complete_file
#
#Usage:
#
# complete_file(%args) -> array
#
#Complete file and directory from local filesystem.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<allow_dot> => I<bool> (default: 1)
#
#If turned off, will not allow "." or ".." in path.
#
#This is most useful when combined with C<starting_path> option to prevent user
#going up/outside the starting path.
#
#=item * B<exclude_dir> => I<bool>
#
#=item * B<exclude_leaf> => I<bool>
#
#=item * B<file_ext_filter> => I<re|array[str]>
#
#This is also an alternative to specifying full C<filter> or C<file_regex_filter>.
#You can set this to a regex or a set of extensions to accept. Note that like in
#C<file_regex_filter>, directories of any name is also still allowed.
#
#=item * B<file_regex_filter> => I<re>
#
#Filter shortcut for file regex.
#
#This is a shortcut for constructing a filter. So instead of using C<filter>, you
#use this option. This will construct a filter of including only directories or
#regular files, and the file must match a regex pattern. This use-case is common.
#
#=item * B<filter> => I<str|code>
#
#Only return items matching this filter.
#
#Filter can either be a string or a code.
#
#For string filter, you can specify a pipe-separated groups of sequences of these
#characters: f, d, r, w, x. Dash can appear anywhere in the sequence to mean
#not/negate. An example: C<f> means to only show regular files, C<-f> means only
#show non-regular files, C<drwx> means to show only directories which are
#readable, writable, and executable (cd-able). C<wf|wd> means writable regular
#files or writable directories.
#
#For code filter, you supply a coderef. The coderef will be called for each item
#with these arguments: C<$name>. It should return true if it wants the item to be
#included.
#
#=item * B<handle_tilde> => I<bool> (default: 1)
#
#=item * B<recurse> => I<bool>
#
#=item * B<recurse_matching> => I<str> (default: "level-by-level")
#
#=item * B<starting_path> => I<str> (default: ".")
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#
#=back
#
#Return value:  (array)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-File>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-File>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://github.com/perlancar/perl-Complete-File/issues>
#
#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
#
#L<Complete>
#
#Other C<Complete::*> modules.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2021, 2019, 2017, 2016, 2015 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
### Complete/Getopt/Long.pm ###
#package Complete::Getopt::Long;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter 'import';
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-08-28'; # DATE
#our $DIST = 'Complete-Getopt-Long'; # DIST
#our $VERSION = '0.481'; # VERSION
#
#our @EXPORT_OK = qw(
#                       complete_cli_arg
#               );
#
#our %SPEC;
#
#our $COMPLETE_GETOPT_LONG_TRACE=$ENV{COMPLETE_GETOPT_LONG_TRACE} // 0;
#our $COMPLETE_GETOPT_LONG_DEFAULT_ENV = $ENV{COMPLETE_GETOPT_LONG_DEFAULT_ENV} // 1;
#our $COMPLETE_GETOPT_LONG_DEFAULT_FILE = $ENV{COMPLETE_GETOPT_LONG_DEFAULT_FILE} // 1;
#
#sub _default_completion {
#    require Complete::Env;
#    require Complete::File;
#    require Complete::Util;
#
#    my %args = @_;
#    my $word = $args{word} // '';
#
#    my $fres;
#    log_trace('[compgl] entering default completion routine') if $COMPLETE_GETOPT_LONG_TRACE;
#
#    # try completing '$...' with shell variables
#    if ($word =~ /\A\$/ && $COMPLETE_GETOPT_LONG_DEFAULT_ENV) {
#        log_trace('[compgl] completing shell variable') if $COMPLETE_GETOPT_LONG_TRACE;
#        {
#            my $compres = Complete::Env::complete_env(
#                word=>$word);
#            last unless @$compres;
#            $fres = {words=>$compres, esc_mode=>'shellvar'};
#            goto RETURN_RES;
#        }
#        # if empty, fallback to searching file
#    }
#
#    # try completing '~foo' with user dir (appending / if user's home exists)
#    if ($word =~ m!\A~([^/]*)\z! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing userdir, user=%s", $1) if $COMPLETE_GETOPT_LONG_TRACE;
#        {
#            eval { require Unix::Passwd::File };
#            last if $@;
#            my $res = Unix::Passwd::File::list_users(detail=>1);
#            last unless $res->[0] == 200;
#            my $compres = Complete::Util::complete_array_elem(
#                array=>[map {"~" . $_->{user} . ((-d $_->{home}) ? "/":"")}
#                            @{ $res->[2] }],
#                word=>$word,
#            );
#            last unless @$compres;
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#        # if empty, fallback to searching file
#    }
#
#    # try completing '~/blah' or '~foo/blah' as if completing file, but do not
#    # expand ~foo (this is supported by complete_file(), so we just give it off
#    # to the routine)
#    if ($word =~ m!\A(~[^/]*)/! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing file, path=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE;
#        $fres = Complete::Util::hashify_answer(
#            Complete::File::complete_file(word=>$word),
#            {path_sep=>'/'}
#        );
#        goto RETURN_RES;
#    }
#
#    # try completing something that contains wildcard with glob. for
#    # convenience, we add '*' at the end so that when user type [AB] it is
#    # treated like [AB]*.
#    require String::Wildcard::Bash;
#    if (String::Wildcard::Bash::contains_wildcard($word) && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing with wildcard glob, glob=<%s>", "$word*") if $COMPLETE_GETOPT_LONG_TRACE;
#        {
#            my $compres = [glob("$word*")];
#            last unless @$compres;
#            for (@$compres) {
#                $_ .= "/" if (-d $_);
#            }
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#        # if empty, fallback to searching file
#    }
#
#    if ($COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing with file, file=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE;
#        $fres = Complete::Util::hashify_answer(
#            Complete::File::complete_file(word=>$word),
#            {path_sep=>'/'}
#        );
#    }
#
#  RETURN_RES:
#    log_trace("[compgl] leaving default completion routine, result=%s", $fres) if $COMPLETE_GETOPT_LONG_TRACE;
#    $fres;
#}
#
## return the possible options. if there is only one candidate (unambiguous
## expansion) then scalar will be returned. otherwise, an array of candidates
## will be returned.
#sub _matching_opts {
#    my ($opt, $opts) = @_;
#    my %candidates;
#    for (sort {length($a)<=>length($b)} keys %$opts) {
#        next unless index($_, $opt) == 0;
#        $candidates{$_} = $opts->{$_};
#        last if $opt eq $_;
#    }
#    \%candidates;
#}
#
## mark an option (and all its aliases) as seen
#sub _mark_seen {
#    my ($seen_opts, $opt, $opts) = @_;
#    my $opthash = $opts->{$opt};
#    return unless $opthash;
#    my $ospec = $opthash->{ospec};
#    for (keys %$opts) {
#        my $v = $opts->{$_};
#        $seen_opts->{$_}++ if $v->{ospec} eq $ospec;
#    }
#}
#
#$SPEC{complete_cli_arg} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using '.
#        'Getopt::Long specification',
#    description => <<'_',
#
#This routine can complete option names, where the option names are retrieved
#from <pm:Getopt::Long> specification. If you provide completion routine in
#`completion`, you can also complete _option values_ and _arguments_.
#
#Note that this routine does not use <pm:Getopt::Long> (it does its own parsing)
#and currently is not affected by Getopt::Long's configuration. Its behavior
#mimics Getopt::Long under these configuration: `no_ignore_case`, `bundling` (or
#`no_bundling` if the `bundling` option is turned off). Which I think is the
#sensible default. This routine also does not currently support `auto_help` and
#`auto_version`, so you'll need to add those options specifically if you want to
#recognize `--help/-?` and `--version`, respectively.
#
#_
#    args => {
#        getopt_spec => {
#            summary => 'Getopt::Long specification',
#            schema  => 'array*',
#            req     => 1,
#        },
#        completion => {
#            summary     =>
#                'Completion routine to complete option value/argument',
#            schema      => 'code*',
#            description => <<'_',
#
#Completion code will receive a hash of arguments (`%args`) containing these
#keys:
#
#* `type` (str, what is being completed, either `optval`, or `arg`)
#* `word` (str, word to be completed)
#* `cword` (int, position of words in the words array, starts from 0)
#* `opt` (str, option name, e.g. `--str`; undef if we're completing argument)
#* `ospec` (str, Getopt::Long option spec, e.g. `str|S=s`; undef when completing
#  argument)
#* `argpos` (int, argument position, zero-based; undef if type='optval')
#* `nth` (int, the number of times this option has seen before, starts from 0
#  that means this is the first time this option has been seen; undef when
#  type='arg')
#* `seen_opts` (hash, all the options seen in `words`)
#* `parsed_opts` (hash, options parsed the standard/raw way)
#
#as well as all keys from `extras` (but these won't override the above keys).
#
#and is expected to return a completion answer structure as described in
#`Complete` which is either a hash or an array. The simplest form of answer is
#just to return an array of strings. The various `complete_*` function like those
#in <pm:Complete::Util> or the other `Complete::*` modules are suitable to use
#here.
#
#Completion routine can also return undef to express declination, in which case
#the default completion routine will then be consulted. The default routine
#completes from shell environment variables (`$FOO`), Unix usernames (`~foo`),
#and files/directories.
#
#Example:
#
#    use Complete::Unix qw(complete_user);
#    use Complete::Util qw(complete_array_elem);
#    complete_cli_arg(
#        getopt_spec => [
#            'help|h'   => sub{...},
#            'format=s' => \$format,
#            'user=s'   => \$user,
#        ],
#        completion  => sub {
#            my %args  = @_;
#            my $word  = $args{word};
#            my $ospec = $args{ospec};
#            if ($ospec && $ospec eq 'format=s') {
#                complete_array_elem(array=>[qw/json text xml yaml/], word=>$word);
#            } else {
#                complete_user(word=>$word);
#            }
#        },
#    );
#
#_
#        },
#        words => {
#            summary     => 'Command line arguments, like @ARGV',
#            description => <<'_',
#
#See function `parse_cmdline` in <pm:Complete::Bash> on how to produce this (if
#you're using bash).
#
#_
#            schema      => 'array*',
#            req         => 1,
#        },
#        cword => {
#            summary     =>
#                "Index in words of the word we're trying to complete",
#            description => <<'_',
#
#See function `parse_cmdline` in <pm:Complete::Bash> on how to produce this (if
#you're using bash).
#
#_
#            schema      => 'int*',
#            req         => 1,
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `type`, `word`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#        bundling => {
#            schema  => 'bool*',
#            default => 1,
#            'summary.alt.bool.not' => 'Turn off bundling',
#            description => <<'_',
#
#If you turn off bundling, completion of short-letter options won't support
#bundling (e.g. `-b<tab>` won't add more single-letter options), but single-dash
#multiletter options can be recognized. Currently only those specified with a
#single dash will be completed. For example if you have `-foo=s` in your option
#specification, `-f<tab>` can complete it.
#
#This can be used to complete old-style programs, e.g. emacs which has options
#like `-nw`, `-nbc` etc (but also have double-dash options like
#`--no-window-system` or `--no-blinking-cursor`).
#
#_
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => ['any*' => of => ['hash*', 'array*']],
#        description => <<'_',
#
#You can use `format_completion` function in <pm:Complete::Bash> module to format
#the result of this function for bash.
#
#_
#    },
#};
#sub complete_cli_arg {
#    require Complete::Util;
#    require Getopt::Long::Util;
#
#    my %args = @_;
#
#    my $fname = __PACKAGE__ . "::complete_cli_arg"; # XXX use __SUB__
#    my $fres;
#
#    $args{words} or die "Please specify words";
#    my @words = @{ $args{words} };
#    defined(my $cword = $args{cword}) or die "Please specify cword";
#    my $gospec = $args{getopt_spec} or die "Please specify getopt_spec";
#    my $comp = $args{completion};
#    my $extras = $args{extras} // {};
#    my $bundling = $args{bundling} // 1;
#    my %parsed_opts;
#
#    # backward compatibility: gospec was expected to be a hash, now an array
#    if (ref $gospec eq 'HASH') {
#        my $ary_gospec = [];
#        for (keys %$gospec) {
#            push @$ary_gospec, $_;
#            push @$ary_gospec, $gospec->{$_} if ref $gospec->{$_};
#        }
#        $gospec = $ary_gospec;
#    }
#
#    log_trace('[compgl] entering %s(), words=%s, cword=%d, word=<%s>',
#              $fname, \@words, $cword, $words[$cword]) if $COMPLETE_GETOPT_LONG_TRACE;
#
#    # strip hash storage from getopt_spec
#    shift @$gospec if ref $gospec->[0] eq 'HASH';
#
#    # parse all options first & supply default completion routine
#    my %opts;
#    my $i = -1;
#    while (++$i <= $#{$gospec}) {
#        my $ospec = $gospec->[$i];
#        my $dest  = $i+1 <= $#{$gospec} && ref $gospec->[$i+1] ?
#            splice(@$gospec, $i+1, 1) : undef;
#
#        my $res = Getopt::Long::Util::parse_getopt_long_opt_spec($ospec)
#            or die "Can't parse option spec '$ospec'";
#        next if $res->{is_arg};
#        $res->{min_vals} //= $res->{type} ? 1 : 0;
#        $res->{max_vals} //= $res->{type} || $res->{opttype} ? 1:0;
#        for my $o0 (@{ $res->{opts} }) {
#            my @ary = $res->{is_neg} && length($o0) > 1 ?
#                ([$o0, 0], ["no$o0",1], ["no-$o0",1]) : ([$o0,0]);
#            for my $elem (@ary) {
#                my $o = $elem->[0];
#                my $is_neg = $elem->[1];
#                my $k = length($o)==1 ||
#                    (!$bundling && $res->{dash_prefix} eq '-') ?
#                        "-$o" : "--$o";
#                $opts{$k} = {
#                    name => $k,
#                    ospec => $ospec,
#                    dest  => $dest,
#                    parsed => $res,
#                    is_neg => $is_neg,
#                };
#            }
#        }
#    }
#    my @optnames = sort keys %opts;
#
#    my $code_get_summary = sub {
#        # currently we only extract summaries from Rinci metadata and
#        # Perinci::CmdLine object
#        return unless $extras;
#        my $ggls_res = $extras->{ggls_res};
#        return unless $ggls_res;
#        my $r = $extras->{r};
#        return unless $r;
#        my $cmdline = $extras->{cmdline};
#
#        my $optname = shift;
#        my $ospec  = $opts{$optname}{ospec};
#        return unless $ospec; # shouldn't happen
#        my $specmeta = $ggls_res->[3]{'func.specmeta'};
#        my $ospecmeta = $specmeta->{$ospec};
#
#        return $ospecmeta->{summary} if defined $ospecmeta->{summary};
#
#        if ($ospecmeta->{is_alias}) {
#            my $real_ospecmeta = $specmeta->{ $ospecmeta->{alias_for} };
#            my $real_opt = $real_ospecmeta->{parsed}{opts}[0];
#            $real_opt = length($real_opt) == 1 ? "-$real_opt" : "--$real_opt";
#            return "Alias for $real_opt";
#        }
#
#        if (defined(my $coptname = $ospecmeta->{common_opt})) {
#            # it's a common Perinci::CmdLine option
#            my $coptspec = $cmdline ? $cmdline->{common_opts}{$coptname} :
#                $r->{common_opts} ? $r->{common_opts}{$coptname} : undef;
#            #use DD; dd $coptspec;
#            return unless $coptspec;
#
#            my $summ;
#            # XXX translate
#            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;
#                            $expects[$j > $i ? $j-1 : $j]{comp_result} = [
#                                substr($word, 0, length($word)-length($rest))];
#                        }
#
#                        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__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Getopt::Long - Complete command-line argument using Getopt::Long specification
#
#=head1 VERSION
#
#This document describes version 0.481 of Complete::Getopt::Long (from Perl distribution Complete-Getopt-Long), released on 2022-08-28.
#
#=head1 SYNOPSIS
#
#See L<Getopt::Long::Complete> for an easy way to use this module.
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#
#=head2 complete_cli_arg
#
#Usage:
#
# complete_cli_arg(%args) -> hash|array
#
#Complete command-line argument using Getopt::Long specification.
#
#This routine can complete option names, where the option names are retrieved
#from L<Getopt::Long> specification. If you provide completion routine in
#C<completion>, you can also complete I<option values> and I<arguments>.
#
#Note that this routine does not use L<Getopt::Long> (it does its own parsing)
#and currently is not affected by Getopt::Long's configuration. Its behavior
#mimics Getopt::Long under these configuration: C<no_ignore_case>, C<bundling> (or
#C<no_bundling> if the C<bundling> option is turned off). Which I think is the
#sensible default. This routine also does not currently support C<auto_help> and
#C<auto_version>, so you'll need to add those options specifically if you want to
#recognize C<--help/-?> and C<--version>, respectively.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<bundling> => I<bool> (default: 1)
#
#If you turn off bundling, completion of short-letter options won't support
#bundling (e.g. C<< -bE<lt>tabE<gt> >> won't add more single-letter options), but single-dash
#multiletter options can be recognized. Currently only those specified with a
#single dash will be completed. For example if you have C<-foo=s> in your option
#specification, C<< -fE<lt>tabE<gt> >> can complete it.
#
#This can be used to complete old-style programs, e.g. emacs which has options
#like C<-nw>, C<-nbc> etc (but also have double-dash options like
#C<--no-window-system> or C<--no-blinking-cursor>).
#
#=item * B<completion> => I<code>
#
#Completion routine to complete option valueE<sol>argument.
#
#Completion code will receive a hash of arguments (C<%args>) containing these
#keys:
#
#=over
#
#=item * C<type> (str, what is being completed, either C<optval>, or C<arg>)
#
#=item * C<word> (str, word to be completed)
#
#=item * C<cword> (int, position of words in the words array, starts from 0)
#
#=item * C<opt> (str, option name, e.g. C<--str>; undef if we're completing argument)
#
#=item * C<ospec> (str, Getopt::Long option spec, e.g. C<str|S=s>; undef when completing
#argument)
#
#=item * C<argpos> (int, argument position, zero-based; undef if type='optval')
#
#=item * C<nth> (int, the number of times this option has seen before, starts from 0
#that means this is the first time this option has been seen; undef when
#type='arg')
#
#=item * C<seen_opts> (hash, all the options seen in C<words>)
#
#=item * C<parsed_opts> (hash, options parsed the standard/raw way)
#
#=back
#
#as well as all keys from C<extras> (but these won't override the above keys).
#
#and is expected to return a completion answer structure as described in
#C<Complete> which is either a hash or an array. The simplest form of answer is
#just to return an array of strings. The various C<complete_*> function like those
#in L<Complete::Util> or the other C<Complete::*> modules are suitable to use
#here.
#
#Completion routine can also return undef to express declination, in which case
#the default completion routine will then be consulted. The default routine
#completes from shell environment variables (C<$FOO>), Unix usernames (C<~foo>),
#and files/directories.
#
#Example:
#
# use Complete::Unix qw(complete_user);
# use Complete::Util qw(complete_array_elem);
# complete_cli_arg(
#     getopt_spec => [
#         'help|h'   => sub{...},
#         'format=s' => \$format,
#         'user=s'   => \$user,
#     ],
#     completion  => sub {
#         my %args  = @_;
#         my $word  = $args{word};
#         my $ospec = $args{ospec};
#         if ($ospec && $ospec eq 'format=s') {
#             complete_array_elem(array=>[qw/json text xml yaml/], word=>$word);
#         } else {
#             complete_user(word=>$word);
#         }
#     },
# );
#
#=item * B<cword>* => I<int>
#
#Index in words of the word we're trying to complete.
#
#See function C<parse_cmdline> in L<Complete::Bash> on how to produce this (if
#you're using bash).
#
#=item * B<extras> => I<hash>
#
#Add extra arguments to completion routine.
#
#The keys from this C<extras> hash will be merged into the final C<%args> passed to
#completion routines. Note that standard keys like C<type>, C<word>, and so on as
#described in the function description will not be overwritten by this.
#
#=item * B<getopt_spec>* => I<array>
#
#Getopt::Long specification.
#
#=item * B<words>* => I<array>
#
#Command line arguments, like @ARGV.
#
#See function C<parse_cmdline> in L<Complete::Bash> on how to produce this (if
#you're using bash).
#
#
#=back
#
#Return value:  (hash|array)
#
#
#You can use C<format_completion> function in L<Complete::Bash> module to format
#the result of this function for bash.
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_GETOPT_LONG_TRACE
#
#Bool. If set to true, will generated more log statements for debugging (at the
#trace level).
#
#=head2 COMPLETE_GETOPT_LONG_DEFAULT_ENV
#
#Bool. Default true. Can be set to false to disable completing from environment
#variable in default completion.
#
#=head2 COMPLETE_GETOPT_LONG_DEFAULT_FILE
#
#Bool. Default true. Can be set to false to disable completing from filesystem
#(file and directory names) in default completion.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Getopt-Long>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Getopt-Long>.
#
#=head1 SEE ALSO
#
#L<Getopt::Long::Complete>
#
#L<Complete>
#
#L<Complete::Bash>
#
#Other modules related to bash shell tab completion: L<Bash::Completion>,
#L<Getopt::Complete>.
#
#L<Perinci::CmdLine> - an alternative way to easily create command-line
#applications with completion feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTORS
#
#=for stopwords Mary Ehlers Steven Haryanto
#
#=over 4
#
#=item *
#
#Mary Ehlers <regina.verb.ae@gmail.com>
#
#=item *
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=back
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2020, 2019, 2017, 2016, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Getopt-Long>
#
#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.
#
#=cut
### Complete/Path.pm ###
#package Complete::Path;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2021-02-02'; # DATE
#our $DIST = 'Complete-Path'; # DIST
#our $VERSION = '0.251'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Complete::Common qw(:all);
#
#our $COMPLETE_PATH_TRACE = $ENV{COMPLETE_PATH_TRACE} // 0;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_path
#               );
#
#sub _dig_leaf {
#    my ($p, $list_func, $is_dir_func, $filter_func, $path_sep) = @_;
#    my $num_dirs;
#    my $listres = $list_func->($p, '', 0);
#    return $p unless ref($listres) eq 'ARRAY' && @$listres;
#    my @candidates;
#  L1:
#    for my $e (@$listres) {
#        my $p2 = $p =~ m!\Q$path_sep\E\z! ? "$p$e" : "$p$path_sep$e";
#        {
#            local $_ = $p2; # convenience for filter func
#            next L1 if $filter_func && !$filter_func->($p2);
#        }
#        push @candidates, $p2;
#    }
#    return $p unless @candidates == 1;
#    my $p2 = $candidates[0];
#    my $is_dir;
#    if ($p2 =~ m!\Q$path_sep\E\z!) {
#        $is_dir++;
#    } else {
#        $is_dir = $is_dir_func && $is_dir_func->($p2);
#    }
#    return _dig_leaf($p2, $list_func, $is_dir_func, $filter_func, $path_sep)
#        if $is_dir;
#    $p2;
#}
#
#our %SPEC;
#
#$SPEC{complete_path} = {
#    v => 1.1,
#    summary => 'Complete path',
#    description => <<'_',
#
#Complete path, for anything path-like. Meant to be used as backend for other
#functions like `Complete::File::complete_file` or
#`Complete::Module::complete_module`. Provides features like case-insensitive
#matching, expanding intermediate paths, and case mapping.
#
#Algorithm is to split path into path elements, then list items (using the
#supplied `list_func`) and perform filtering (using the supplied `filter_func`)
#at every level.
#
#_
#    args => {
#        %arg_word,
#        list_func => {
#            summary => 'Function to list the content of intermediate "dirs"',
#            schema => 'code*',
#            req => 1,
#            description => <<'_',
#
#Code will be called with arguments: ($path, $cur_path_elem, $is_intermediate).
#Code should return an arrayref containing list of elements. "Directories" can be
#marked by ending the name with the path separator (see `path_sep`). Or, you can
#also provide an `is_dir_func` function that will be consulted after filtering.
#If an item is a "directory" then its name will be suffixed with a path
#separator by `complete_path()`.
#
#_
#        },
#        is_dir_func => {
#            summary => 'Function to check whether a path is a "dir"',
#            schema  => 'code*',
#            description => <<'_',
#
#Optional. You can provide this function to determine if an item is a "directory"
#(so its name can be suffixed with path separator). You do not need to do this if
#you already suffix names of "directories" with path separator in `list_func`.
#
#One reason you might want to provide this and not mark "directories" in
#`list_func` is when you want to do extra filtering with `filter_func`. Sometimes
#you do not want to suffix the names first (example: see `complete_file` in
#`Complete::File`).
#
#_
#        },
#        starting_path => {
#            schema => 'str*',
#            req => 1,
#            default => '',
#        },
#        filter_func => {
#            schema  => 'code*',
#            description => <<'_',
#
#Provide extra filtering. Code will be given path and should return 1 if the item
#should be included in the final result or 0 if the item should be excluded.
#
#_
#        },
#        path_sep => {
#            schema  => 'str*',
#            default => '/',
#        },
#        #result_prefix => {
#        #    summary => 'Prefix each result with this string',
#        #    schema  => 'str*',
#        #},
#        recurse => {
#            schema => 'bool*',
#            cmdline_aliases => {r=>{}},
#        },
#        recurse_matching => {
#            schema => ['str*', in=>['level-by-level', 'all-at-once']],
#            default => 'level-by-level',
#        },
#        exclude_leaf => {
#            schema => 'bool*',
#        },
#        exclude_dir => {
#            schema => 'bool*',
#        },
#    },
#    args_rels => {
#        dep_all => [recurse_matching => ['recurse']],
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_path {
#    require Complete::Util;
#
#    my %args   = @_;
#    my $word   = $args{word} // "";
#    my $path_sep = $args{path_sep} // '/';
#    my $list_func   = $args{list_func};
#    my $is_dir_func = $args{is_dir_func};
#    my $filter_func = $args{filter_func};
#    my $result_prefix = $args{result_prefix};
#    my $starting_path = $args{starting_path} // '';
#    my $recurse = $args{recurse};
#    my $recurse_matching = $args{recurse_matching} // 'level-by-level';
#    my $exclude_leaf = $args{exclude_leaf};
#    my $exclude_dir  = $args{exclude_dir};
#
#    my $ci          = $Complete::Common::OPT_CI;
#    my $word_mode   = $Complete::Common::OPT_WORD_MODE;
#    my $fuzzy       = $Complete::Common::OPT_FUZZY;
#    my $map_case    = $Complete::Common::OPT_MAP_CASE;
#    my $exp_im_path = $Complete::Common::OPT_EXP_IM_PATH;
#    my $dig_leaf    = $Complete::Common::OPT_DIG_LEAF;
#
#    my $re_ends_with_path_sep = qr!\A\z|\Q$path_sep\E\z!;
#
#    my @res;
#
#    my $cut_chars;
#    if (defined $args{_cut_chars}) {
#        $cut_chars = $args{_cut_chars};
#    } else {
#        $cut_chars = 0;
#        if (length($starting_path)) {
#            $cut_chars += length($starting_path);
#            unless ($starting_path =~ /\Q$path_sep\E\z/) {
#                $cut_chars += length($path_sep);
#            }
#        }
#    }
#
#  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
#matching, expanding intermediate paths, and case mapping.
#
#Algorithm is to split path into path elements, then list items (using the
#supplied C<list_func>) and perform filtering (using the supplied C<filter_func>)
#at every level.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<exclude_dir> => I<bool>
#
#=item * B<exclude_leaf> => I<bool>
#
#=item * B<filter_func> => I<code>
#
#Provide extra filtering. Code will be given path and should return 1 if the item
#should be included in the final result or 0 if the item should be excluded.
#
#=item * B<is_dir_func> => I<code>
#
#Function to check whether a path is a "dir".
#
#Optional. You can provide this function to determine if an item is a "directory"
#(so its name can be suffixed with path separator). You do not need to do this if
#you already suffix names of "directories" with path separator in C<list_func>.
#
#One reason you might want to provide this and not mark "directories" in
#C<list_func> is when you want to do extra filtering with C<filter_func>. Sometimes
#you do not want to suffix the names first (example: see C<complete_file> in
#C<Complete::File>).
#
#=item * B<list_func>* => I<code>
#
#Function to list the content of intermediate "dirs".
#
#Code will be called with arguments: ($path, $cur_path_elem, $is_intermediate).
#Code should return an arrayref containing list of elements. "Directories" can be
#marked by ending the name with the path separator (see C<path_sep>). Or, you can
#also provide an C<is_dir_func> function that will be consulted after filtering.
#If an item is a "directory" then its name will be suffixed with a path
#separator by C<complete_path()>.
#
#=item * B<path_sep> => I<str> (default: "/")
#
#=item * B<recurse> => I<bool>
#
#=item * B<recurse_matching> => I<str> (default: "level-by-level")
#
#=item * B<starting_path>* => I<str> (default: "")
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#
#=back
#
#Return value:  (array)
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_PATH_TRACE => bool
#
#If set to true, will produce more log statements for debugging.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Path>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Path>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://github.com/perlancar/perl-Complete-Path/issues>
#
#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
#
#L<Complete>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2021, 2017, 2016, 2015, 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
### Complete/Sah.pm ###
#package Complete::Sah;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Complete::Common qw(:all);
#use Complete::Util qw(combine_answers complete_array_elem hashify_answer);
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-05-26'; # DATE
#our $DIST = 'Complete-Sah'; # DIST
#our $VERSION = '0.013'; # VERSION
#
#our %SPEC;
#our @EXPORT_OK = qw(complete_from_schema);
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Sah-related completion routines',
#};
#
#$SPEC{complete_from_schema} = {
#    v => 1.1,
#    summary => 'Complete a value from schema',
#    description => <<'_',
#
#Employ some heuristics to complete a value from Sah schema. For example, if
#schema is `[str => in => [qw/new open resolved rejected/]]`, then we can
#complete from the `in` clause. Or for something like `[int => between => [1,
#20]]` we can complete using values from 1 to 20.
#
#Tip: If you want to give summary for each entry in `in` clause, you can use the
#`x.in.summaries` attribute, example:
#
#    # schema
#    ['str', {
#        in => ['b', 'g'],
#        'x.in.summaries' => ['Male/boy', 'Female/girl'],
#    }]
#
#_
#    args => {
#        schema => {
#            schema => ['any*', of=>['str*', 'array*']], # XXX sah::schema
#            description => <<'_',
#
#Will be normalized, unless when `schema_is_normalized` is set to true, in which
#case schema must already be normalized.
#
#_
#            req => 1,
#        },
#        schema_is_normalized => {
#            schema => 'bool',
#            default => 0,
#        },
#        word => {
#            schema => [str => default => ''],
#            req => 1,
#        },
#    },
#    result_naked => 1,
#};
#sub complete_from_schema {
#    my %args = @_;
#    my $sch  = $args{schema};
#    my $word = $args{word} // "";
#
#    unless ($args{schema_is_normalized}) {
#        require Data::Sah::Normalize;
#        $sch = Data::Sah::Normalize::normalize_schema($sch);
#    }
#
#    my $fres;
#    log_trace("[compsah] entering complete_from_schema, word=<%s>, schema=%s", $word, $sch);
#
#    my ($type, $clset) = @{$sch};
#
#    # schema might be based on other schemas, if that is the case, let's try to
#    # look at Sah::SchemaR::* module to quickly find the base type
#    unless ($type =~ /\A(all|any|array|bool|buf|cistr|code|date|duration|float|hash|int|num|obj|re|str|undef)\z/) {
#        no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
#        my $pkg = "Sah::SchemaR::$type";
#        (my $pkg_pm = "$pkg.pm") =~ s!::!/!g;
#        eval { require $pkg_pm; 1 };
#        if ($@) {
#            log_trace("[compsah] couldn't load schema module %s: %s, skipped", $pkg, $@);
#            goto RETURN_RES;
#        }
#        my $rsch = ${"$pkg\::rschema"};
#        $type = ref $rsch eq 'ARRAY' ? $rsch->[0] : $rsch->{type}; # support older (v.009-) version of Data::Sah::Resolve result
#        my $clsets = ref $rsch eq 'ARRAY' ? $rsch->[1] : $rsch->{'clsets_after_type.alt.merge.merged'};
#        # let's just merge everything, for quick checking of clause
#        my $merged_clset = {};
#        for my $clset0 (@{ $clsets }) {
#            for (keys %$clset0) {
#                $merged_clset->{$_} = $clset0->{$_};
#            }
#        }
#        $clset = $merged_clset;
#        log_trace("[compsah] retrieving schema from module %s, base type=%s", $pkg, $type);
#    }
#
#    my $static;
#    my $words;
#    my $summaries;
#    eval {
#        if (my $xcomp = $clset->{'x.completion'}) {
#            require Module::Installed::Tiny;
#            my $comp;
#            if (ref($xcomp) eq 'CODE') {
#                $comp = $xcomp;
#            } else {
#                my ($submod, $xcargs);
#                if (ref($xcomp) eq 'ARRAY') {
#                    $submod = $xcomp->[0];
#                    $xcargs = $xcomp->[1];
#                } else {
#                    $submod = $xcomp;
#                    $xcargs = {};
#                }
#                my $mod = "Perinci::Sub::XCompletion::$submod";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[compsah] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    my $fref = \&{"$mod\::gen_completion"};
#                    log_trace("[compsah] invoking %s\::gen_completion(%s) ...", $mod, $xcargs);
#                    $comp = $fref->(%$xcargs);
#                } else {
#                    log_trace("[compsah] module %s is not installed, skipped", $mod);
#                }
#            }
#            if ($comp) {
#                # create a validator, to be used by the completion routine
#                #require Data::Sah;
#                #my $vdr = Data::Sah::gen_validator($sch, {schema_is_normalized=>1});
#
#                my %cargs = (
#                    %{$args{extras} // {}},
#                    word=>$word, arg=>$args{arg}, args=>$args{args},
#                    #_schema_validator => $vdr,
#                    _schema => $sch,
#                );
#                log_trace("[compsah] using arg completion routine from schema's 'x.completion' attribute with args (%s)", \%cargs);
#                $fres = $comp->(%cargs);
#                return; # from eval
#                }
#            }
#
#        if ($clset->{is} && !ref($clset->{is})) {
#            log_trace("[compsah] adding completion from schema's 'is' clause");
#            push @$words, $clset->{is};
#            push @$summaries, undef;
#            $static++;
#            return; # from eval. there should not be any other value
#        }
#        if ($clset->{in}) {
#            log_trace("[compsah] adding completion from schema's 'in' clause");
#            for my $i (0..$#{ $clset->{in} }) {
#                next if ref $clset->{in}[$i];
#                push @$words    , $clset->{in}[$i];
#                push @$summaries, $clset->{'x.in.summaries'} ? $clset->{'x.in.summaries'}[$i] : undef;
#            }
#            $static++;
#            return; # from eval. there should not be any other value
#        }
#        if ($clset->{'examples'}) {
#            log_trace("[compsah] adding completion from schema's 'examples' clause");
#            for my $eg (@{ $clset->{'examples'} }) {
#                if (ref $eg eq 'HASH') {
#                    next unless !exists($eg->{valid}) || $eg->{valid};
#                    next unless defined $eg->{value};
#                    next if ref $eg->{value};
#                    push @$words, $eg->{value};
#                    push @$summaries, $eg->{summary};
#                } else {
#                    next unless defined $eg;
#                    next if ref $eg;
#                    push @$words, $eg;
#                    push @$summaries, undef;
#                }
#            }
#            #$static++;
#            #return; # from eval. there should not be any other value
#        }
#        if ($type eq 'any') {
#            # because currently Data::Sah::Normalize doesn't recursively
#            # normalize schemas in 'of' clauses, etc.
#            require Data::Sah::Normalize;
#            if ($clset->{of} && @{ $clset->{of} }) {
#
#                $fres = combine_answers(
#                    grep { defined } map {
#                        complete_from_schema(schema=>$_, word => $word)
#                    } @{ $clset->{of} }
#                );
#                goto RETURN_RES; # directly return result
#            }
#        }
#        if ($type eq 'bool') {
#            log_trace("[compsah] adding completion from possible values of bool");
#            push @$words, 0, 1;
#            push @$summaries, undef, undef;
#            $static++;
#            return; # from eval
#        }
#        if ($type eq 'int') {
#            my $limit = 100;
#            if ($clset->{between} &&
#                    $clset->{between}[0] - $clset->{between}[0] <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'between' clause");
#                for ($clset->{between}[0] .. $clset->{between}[1]) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif ($clset->{xbetween} &&
#                         $clset->{xbetween}[0] - $clset->{xbetween}[0] <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'xbetween' clause");
#                for ($clset->{xbetween}[0]+1 .. $clset->{xbetween}[1]-1) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($clset->{min}) && defined($clset->{max}) &&
#                         $clset->{max}-$clset->{min} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'min' & 'max' clauses");
#                for ($clset->{min} .. $clset->{max}) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($clset->{min}) && defined($clset->{xmax}) &&
#                         $clset->{xmax}-$clset->{min} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'min' & 'xmax' clauses");
#                for ($clset->{min} .. $clset->{xmax}-1) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($clset->{xmin}) && defined($clset->{max}) &&
#                         $clset->{max}-$clset->{xmin} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'xmin' & 'max' clauses");
#                for ($clset->{xmin}+1 .. $clset->{max}) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($clset->{xmin}) && defined($clset->{xmax}) &&
#                         $clset->{xmax}-$clset->{xmin} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'xmin' & 'xmax' clauses");
#                for ($clset->{xmin}+1 .. $clset->{xmax}-1) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (length($word) && $word !~ /\A-?\d*\z/) {
#                log_trace("[compsah] word not an int");
#                $words = [];
#                $summaries = [];
#            } else {
#                # do a digit by digit completion
#                $words = [];
#                $summaries = [];
#                for my $sign ("", "-") {
#                    for ("", 0..9) {
#                        my $i = $sign . $word . $_;
#                        next unless length $i;
#                        next unless $i =~ /\A-?\d+\z/;
#                        next if $i eq '-0';
#                        next if $i =~ /\A-?0\d/;
#                        next if $clset->{between} &&
#                            ($i < $clset->{between}[0] ||
#                                 $i > $clset->{between}[1]);
#                        next if $clset->{xbetween} &&
#                            ($i <= $clset->{xbetween}[0] ||
#                                 $i >= $clset->{xbetween}[1]);
#                        next if defined($clset->{min} ) && $i <  $clset->{min};
#                        next if defined($clset->{xmin}) && $i <= $clset->{xmin};
#                        next if defined($clset->{max} ) && $i >  $clset->{max};
#                        next if defined($clset->{xmin}) && $i >= $clset->{xmax};
#                        push @$words, $i;
#                        push @$summaries, undef;
#                    }
#                }
#            }
#            return; # from eval
#        }
#        if ($type eq 'float') {
#            if (length($word) && $word !~ /\A-?\d*(\.\d*)?\z/) {
#                log_trace("[compsah] word not a float");
#                $words = [];
#                $summaries = [];
#            } else {
#                $words = [];
#                $summaries = [];
#                for my $sig ("", "-") {
#                    for ("", 0..9,
#                         ".0",".1",".2",".3",".4",".5",".6",".7",".8",".9") {
#                        my $f = $sig . $word . $_;
#                        next unless length $f;
#                        next unless $f =~ /\A-?\d+(\.\d+)?\z/;
#                        next if $f eq '-0';
#                        next if $f =~ /\A-?0\d\z/;
#                        next if $clset->{between} &&
#                            ($f < $clset->{between}[0] ||
#                                 $f > $clset->{between}[1]);
#                        next if $clset->{xbetween} &&
#                            ($f <= $clset->{xbetween}[0] ||
#                                 $f >= $clset->{xbetween}[1]);
#                        next if defined($clset->{min} ) && $f <  $clset->{min};
#                        next if defined($clset->{xmin}) && $f <= $clset->{xmin};
#                        next if defined($clset->{max} ) && $f >  $clset->{max};
#                        next if defined($clset->{xmin}) && $f >= $clset->{xmax};
#                        push @$words, $f;
#                        push @$summaries, undef;
#                    }
#                }
#                my @orders = sort { $words->[$a] cmp $words->[$b] }
#                    0..$#{$words};
#                my $words     = [map {$words->[$_]    } @orders];
#                my $summaries = [map {$summaries->[$_]} @orders];
#            }
#            return; # from eval
#        }
#    }; # eval
#    log_trace("[compsah] complete_from_schema died: %s", $@) if $@;
#
#    my $replace_map;
#  GET_REPLACE_MAP:
#    {
#        last unless $clset->{prefilters};
#        # TODO: make replace_map in Complete::Util equivalent as
#        # Str::replace_map's map.
#        for my $entry (@{ $clset->{prefilters} }) {
#            next unless ref $entry eq 'ARRAY';
#            next unless $entry->[0] eq 'Str::replace_map';
#            $replace_map = {};
#            for my $k (keys %{ $entry->[1]{map} }) {
#                my $v = $entry->[1]{map}{$k};
#                $replace_map->{$v} = [$k];
#            }
#            last;
#        }
#    }
#
#    goto RETURN_RES unless $words;
#    $fres = hashify_answer(
#        complete_array_elem(
#            array=>$words,
#            summaries=>$summaries,
#            word=>$word,
#            (replace_map => $replace_map) x !!$replace_map,
#        ),
#        {static=>$static && $word eq '' ? 1:0},
#    );
#
#  RETURN_RES:
#    log_trace("[compsah] leaving complete_from_schema, result=%s", $fres);
#    $fres;
#}
#
#1;
## ABSTRACT: Sah-related completion routines
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Sah - Sah-related completion routines
#
#=head1 VERSION
#
#This document describes version 0.013 of Complete::Sah (from Perl distribution Complete-Sah), released on 2023-05-26.
#
#=head1 SYNOPSIS
#
# use Complete::Sah qw(complete_from_schema);
# my $res = complete_from_schema(word => 'a', schema=>[str => {in=>[qw/apple apricot banana/]}]);
# # -> {words=>['apple', 'apricot'], static=>0}
#
#=head1 FUNCTIONS
#
#
#=head2 complete_from_schema
#
#Usage:
#
# complete_from_schema(%args) -> any
#
#Complete a value from schema.
#
#Employ some heuristics to complete a value from Sah schema. For example, if
#schema is C<< [str =E<gt> in =E<gt> [qw/new open resolved rejected/]] >>, then we can
#complete from the C<in> clause. Or for something like C<< [int =E<gt> between =E<gt> [1,
#20]] >> we can complete using values from 1 to 20.
#
#Tip: If you want to give summary for each entry in C<in> clause, you can use the
#C<x.in.summaries> attribute, example:
#
# # schema
# ['str', {
#     in => ['b', 'g'],
#     'x.in.summaries' => ['Male/boy', 'Female/girl'],
# }]
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<schema>* => I<str|array>
#
#Will be normalized, unless when C<schema_is_normalized> is set to true, in which
#case schema must already be normalized.
#
#=item * B<schema_is_normalized> => I<bool> (default: 0)
#
#(No description)
#
#=item * B<word>* => I<str> (default: "")
#
#(No description)
#
#
#=back
#
#Return value:  (any)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Sah>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Sah>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2020, 2019 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Sah>
#
#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.
#
#=cut
### Complete/Tcsh.pm ###
#package Complete::Tcsh;
#
#our $DATE = '2019-12-20'; # DATE
#our $VERSION = '0.030'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       parse_cmdline
#                       format_completion
#               );
#
#require Complete::Bash;
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion module for tcsh shell',
#};
#
#$SPEC{parse_cmdline} = {
#    v => 1.1,
#    summary => 'Parse shell command-line for processing by completion routines',
#    description => <<'_',
#
#This function converts COMMAND_LINE (str) given by tcsh to become something like
#COMP_WORDS (array) and COMP_CWORD (int), like what bash supplies to shell
#functions. Currently implemented using `Complete::Bash`'s `parse_cmdline`.
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line, defaults to COMMAND_LINE environment',
#            schema => 'str*',
#            pos => 0,
#        },
#    },
#    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, 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,
#};
#sub parse_cmdline {
#    my ($line) = @_;
#
#    $line //= $ENV{COMMAND_LINE};
#    Complete::Bash::parse_cmdline($line, length($line));
#}
#
#$SPEC{format_completion} = {
#    v => 1.1,
#    summary => 'Format completion for output (for shell)',
#    description => <<'_',
#
#tcsh accepts completion reply in the form of one entry per line to STDOUT.
#Currently the formatting is done using `Complete::Bash`'s `format_completion`
#because escaping rule and so on are not yet well defined in tcsh.
#
#_
#    args_as => 'array',
#    args => {
#        completion => {
#            summary => 'Completion answer structure',
#            description => <<'_',
#
#Either an array or hash, as described in `Complete`.
#
#_
#            schema=>['any*' => of => ['hash*', 'array*']],
#            req=>1,
#            pos=>0,
#        },
#    },
#    result => {
#        summary => 'Formatted string (or array, if `as` is set to `array`)',
#        schema => ['any*' => of => ['str*', 'array*']],
#    },
#    result_naked => 1,
#};
#sub format_completion {
#    Complete::Bash::format_completion(@_);
#}
#
#1;
## ABSTRACT: Completion module for tcsh shell
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Tcsh - Completion module for tcsh shell
#
#=head1 VERSION
#
#This document describes version 0.030 of Complete::Tcsh (from Perl distribution Complete-Tcsh), released on 2019-12-20.
#
#=head1 DESCRIPTION
#
#tcsh allows completion to come from various sources. One of the simplest is from
#a list of words:
#
# % complete CMDNAME 'p/*/(one two three)/'
#
#Another source is from an external command:
#
# % complete CMDNAME 'p/*/`mycompleter --somearg`/'
#
#The command receives one environment variables C<COMMAND_LINE> (string, raw
#command-line). Unlike bash, tcsh does not (yet) provide something akin to
#C<COMP_POINT> in bash. Command is expected to print completion entries, one line
#at a time.
#
# % cat foo-complete
# #!/usr/bin/perl
# use Complete::Tcsh 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 foo 'p/*/`foo-complete`/'
# % foo --v<Tab>
# --verbose --version
#
#This module provides routines for you to be doing the above.
#
#Also, unlike bash, currently tcsh does not allow delegating completion to a
#shell function.
#
#=head1 FUNCTIONS
#
#
#=head2 format_completion
#
#Usage:
#
# format_completion($completion) -> str|array
#
#Format completion for output (for shell).
#
#tcsh accepts completion reply in the form of one entry per line to STDOUT.
#Currently the formatting is done using C<Complete::Bash>'s C<format_completion>
#because escaping rule and so on are not yet well defined in tcsh.
#
#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, as described in C<Complete>.
#
#=back
#
#Return value: Formatted string (or array, if `as` is set to `array`) (str|array)
#
#
#
#=head2 parse_cmdline
#
#Usage:
#
# parse_cmdline($cmdline) -> array
#
#Parse shell command-line for processing by completion routines.
#
#This function converts COMMAND_LINE (str) given by tcsh to become something like
#COMP_WORDS (array) and COMP_CWORD (int), like what bash supplies to shell
#functions. Currently implemented using C<Complete::Bash>'s C<parse_cmdline>.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line, defaults to COMMAND_LINE environment.
#
#=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
#integer, equivalent to C<COMP_CWORD> provided by bash to shell functions. The
#word to be completed is at C<< $words-E<gt>[$cword] >>.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in C<@ARGV>), you need to strip the first element from
#C<$words> and reduce C<$cword> by 1.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Tcsh>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Tcsh>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Tcsh>
#
#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
#
#L<Complete>
#
#L<Complete::Bash>
#
#tcsh manual.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2015, 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
### Complete/Util.pm ###
#package Complete::Util;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Complete::Common qw(:all);
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-01-19'; # DATE
#our $DIST = 'Complete-Util'; # DIST
#our $VERSION = '0.617'; # VERSION
#
#our @EXPORT_OK = qw(
#                       hashify_answer
#                       arrayify_answer
#                       combine_answers
#                       modify_answer
#                       ununiquify_answer
#                       answer_has_entries
#                       answer_num_entries
#                       complete_array_elem
#                       complete_hash_key
#                       complete_comma_sep
#                       complete_comma_sep_pair
#               );
#
#our %SPEC;
#
#our $COMPLETE_UTIL_TRACE = $ENV{COMPLETE_UTIL_TRACE} // 0;
#
#our %arg0_answer = (
#    answer => {
#        summary => 'Completion answer structure',
#        schema  => ['any*' => of => ['array*','hash*']],
#        req => 1,
#        pos => 0,
#    },
#);
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'General completion routine',
#    description => <<'_',
#
#This package provides some generic completion routines that follow the
#<pm:Complete> convention. (If you are looking for bash/shell tab completion
#routines, take a look at the See Also section.) The main routine is
#`complete_array_elem` which tries to complete a word using choices from elements
#of supplied array. For example:
#
#    complete_array_elem(word => "a", array => ["apple", "apricot", "banana"]);
#
#The routine will first try a simple substring prefix matching. If that fails,
#will try some other methods like word-mode, character-mode, or fuzzy matching.
#These methods can be disabled using settings.
#
#There are other utility routines e.g. for converting completion answer structure
#from hash to array/array to hash, combine or modify answer, etc. These routines
#are usually used by the other more specific or higher-level completion modules.
#
#_
#};
#
#$SPEC{hashify_answer} = {
#    v => 1.1,
#    summary => 'Make sure we return completion answer in hash form',
#    description => <<'_',
#
#This function accepts a hash or an array. If it receives an array, will convert
#the array into `{words=>$ary}' first to make sure the completion answer is in
#hash form.
#
#Then will add keys from `meta` to the hash.
#
#_
#    args => {
#        %arg0_answer,
#        meta => {
#            summary => 'Metadata (extra keys) for the hash',
#            schema  => 'hash*',
#            pos => 1,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#    },
#};
#sub hashify_answer {
#    my $ans = shift;
#    return unless defined $ans;
#    if (ref($ans) ne 'HASH') {
#        $ans = {words=>$ans};
#    }
#    if (@_) {
#        my $meta = shift;
#        for (keys %$meta) {
#            $ans->{$_} = $meta->{$_};
#        }
#    }
#    $ans;
#}
#
#$SPEC{arrayify_answer} = {
#    v => 1.1,
#    summary => 'Make sure we return completion answer in array form',
#    description => <<'_',
#
#This is the reverse of `hashify_answer`. It accepts a hash or an array. If it
#receives a hash, will return its `words` key.
#
#_
#    args => {
#        %arg0_answer,
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'array*',
#    },
#};
#sub arrayify_answer {
#    my $ans = shift;
#    return unless defined $ans;
#    if (ref($ans) eq 'HASH') {
#        $ans = $ans->{words};
#    }
#    $ans;
#}
#
#$SPEC{answer_num_entries} = {
#    v => 1.1,
#    summary => 'Get the number of entries in an answer',
#    description => <<'_',
#
#It is equivalent to:
#
#    ref $answer eq 'ARRAY' ? (@$answer // 0) : (@{$answer->{words}} // 0);
#
#_
#    args => {
#        %arg0_answer,
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'int*',
#    },
#};
#sub answer_num_entries {
#    my $ans = shift;
#    return unless defined $ans;
#    return ref($ans) eq 'HASH' ? (@{$ans->{words} // []} // 0) : (@$ans // 0);
#}
#
#$SPEC{answer_has_entries} = {
#    v => 1.1,
#    summary => 'Check if answer has entries',
#    description => <<'_',
#
#It is equivalent to:
#
#    ref $answer eq 'ARRAY' ? (@$answer ? 1:0) : (@{$answer->{words}} ? 1:0);
#
#_
#    args => {
#        %arg0_answer,
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'int*',
#    },
#};
#sub answer_has_entries {
#    my $ans = shift;
#    return unless defined $ans;
#    return ref($ans) eq 'HASH' ? (@{$ans->{words} // []} ? 1:0) : (@$ans ? 1:0);
#}
#
#sub __min(@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
#    my $m = $_[0];
#    for (@_) {
#        $m = $_ if $_ < $m;
#    }
#    $m;
#}
#
#our $code_editdist;
#our $editdist_flex;
#
## straight copy of Wikipedia's "Levenshtein Distance"
#sub __editdist {
#    my @a = split //, shift;
#    my @b = split //, shift;
#
#    # There is an extra row and column in the matrix. This is the distance from
#    # the empty string to a substring of the target.
#    my @d;
#    $d[$_][0] = $_ for 0 .. @a;
#    $d[0][$_] = $_ for 0 .. @b;
#
#    for my $i (1 .. @a) {
#        for my $j (1 .. @b) {
#            $d[$i][$j] = (
#                $a[$i-1] eq $b[$j-1]
#                    ? $d[$i-1][$j-1]
#                    : 1 + __min(
#                        $d[$i-1][$j],
#                        $d[$i][$j-1],
#                        $d[$i-1][$j-1]
#                    )
#                );
#        }
#    }
#
#    $d[@a][@b];
#}
#
#my %complete_array_elem_args = (
#    %arg_word,
#    array       => {
#        schema => ['array*'=>{of=>'str*'}],
#        req => 1,
#        pos => 1,
#        slurpy => 1,
#    },
#    summaries => {
#        schema => ['array*'=>{of=>'str*'}],
#    },
#    exclude     => {
#        schema => ['array*'],
#    },
#    replace_map => {
#        schema => ['hash*', each_value=>['array*', of=>'str*']],
#        description => <<'_',
#
#You can supply correction entries in this option. An example is when array if
#`['mount','unmount']` and `umount` is a popular "typo" for `unmount`. When
#someone already types `um` it cannot be completed into anything (even the
#current fuzzy mode will return *both* so it cannot complete immediately).
#
#One solution is to add replace_map `{'unmount'=>['umount']}`. This way, `umount`
#will be regarded the same as `unmount` and when user types `um` it can be
#completed unambiguously into `unmount`.
#
#_
#        tags => ['experimental'],
#    },
#);
#
#$SPEC{complete_array_elem} = {
#    v => 1.1,
#    summary => 'Complete from array',
#    description => <<'_',
#
#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 `$Complete::Common::OPT_CI` variable or the
#`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
#`$Complete::Common::OPT_WORD_MODE` or `COMPLETE_OPT_WORD_MODE` environment
#varialbe to false). Word-mode matching is described in <pm: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
#`$Complete::Common::OPT_CHAR_MODE` or `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.
#
#Char-mode matching (can be disabled by settings
#`$Complete::Common::OPT_CHAR_MODE` or `COMPLETE_OPT_CHAR_MODE` environment
#variable to false). Char-mode matching is described in <pm:Complete::Common>. If
#at least one match is found, return result. Else, proceed to the next method.
#
#Fuzzy matching (can be disabled by setting `$Complete::Common::OPT_FUZZY` or
#`COMPLETE_OPT_FUZZY` to false). Fuzzy matching is described in
#<pm:Complete::Common>. If at least one match is found, return result. Else,
#return empty string.
#
#Will sort the resulting completion list, so you don't have to presort the array.
#
#_
#    args => {
#        %complete_array_elem_args,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_array_elem {
#    my %args  = @_;
#
#    my $array0    = delete $args{array} or die "Please specify array";
#    my $summaries = delete $args{summaries};
#    my $word      = delete($args{word}) // "";
#    my $exclude   = delete $args{exclude};
#    my $replace_map = delete $args{replace_map};
#    die "complete_array_elem(): Unknown argument(s): ".join(", ", keys %args)
#        if keys %args;
#
#    my $ci          = $Complete::Common::OPT_CI;
#    my $map_case    = $Complete::Common::OPT_MAP_CASE;
#    my $word_mode   = $Complete::Common::OPT_WORD_MODE;
#    my $char_mode   = $Complete::Common::OPT_CHAR_MODE;
#    my $fuzzy       = $Complete::Common::OPT_FUZZY;
#
#    log_trace("[computil] entering complete_array_elem(), word=<%s>", $word)
#        if $COMPLETE_UTIL_TRACE;
#
#    my $res;
#
#    unless (@$array0) {
#        $res = []; goto RETURN_RES;
#    }
#
#    # normalize
#    my $wordn = $ci ? uc($word) : $word; $wordn =~ s/_/-/g if $map_case;
#
#    my $excluden;
#    if ($exclude) {
#        $excluden = {};
#        for my $el (@{$exclude}) {
#            my $eln = $ci ? uc($el) : $el; $eln =~ s/_/-/g if $map_case;
#            $excluden->{$eln} //= 1;
#        }
#    }
#
#    my $rmapn;
#    my $rev_rmapn; # to replace back to the original words back in the result
#    if ($replace_map) {
#        $rmapn = {};
#        $rev_rmapn = {};
#        for my $k (keys %$replace_map) {
#            my $kn = $ci ? uc($k) : $k; $kn =~ s/_/-/g if $map_case;
#            my @vn;
#            for my $v (@{ $replace_map->{$k} }) {
#                my $vn = $ci ? uc($v) : $v; $vn =~ s/_/-/g if $map_case;
#                push @vn, $vn;
#                $rev_rmapn->{$vn} //= $k;
#            }
#            $rmapn->{$kn} = \@vn;
#        }
#    }
#
#    my @words;      # the answer
#    my @wordsumms;  # summaries for each item in @words
#    my @array ;     # original array + rmap entries
#    my @arrayn;     # case- & map-case-normalized form of $array + rmap entries
#    my @arraysumms; # summaries for each item in @array (or @arrayn)
#
#    # normal string prefix matching. we also fill @array & @arrayn here (which
#    # will be used again in word-mode, fuzzy, and char-mode matching) so we
#    # don't have to calculate again.
#    log_trace("[computil] Trying normal string-prefix matching ...") if $COMPLETE_UTIL_TRACE;
#    for my $i (0..$#{$array0}) {
#        my $el = $array0->[$i];
#        my $eln = $ci ? uc($el) : $el; $eln =~ s/_/-/g if $map_case;
#        next if $excluden && $excluden->{$eln};
#        push @array , $el;
#        push @arrayn, $eln;
#        push @arraysumms, $summaries->[$i] if $summaries;
#        if (0==index($eln, $wordn)) {
#            push @words, $el;
#            push @wordsumms, $summaries->[$i] if $summaries;
#        }
#        if ($rmapn && $rmapn->{$eln}) {
#            for my $vn (@{ $rmapn->{$eln} }) {
#                push @array , $el;
#                push @arrayn, $vn;
#                # we add the normalized form, because we'll just revert it back
#                # to the original word in the final result
#                if (0==index($vn, $wordn)) {
#                    push @words, $vn;
#                    push @wordsumms, $summaries->[$i] if $summaries;
#                }
#            }
#        }
#    }
#    log_trace("[computil] Result from normal string-prefix matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#
#    # word-mode matching
#    {
#        last unless $word_mode && !@words;
#        my @split_wordn = $wordn =~ /(\w+)/g;
#        unshift @split_wordn, '' if $wordn =~ /\A\W/;
#        last unless @split_wordn > 1;
#        my $re = '\A';
#        for my $i (0..$#split_wordn) {
#            $re .= '(?:\W+\w+)*\W+' if $i;
#            $re .= quotemeta($split_wordn[$i]).'\w*';
#        }
#        $re = qr/$re/;
#        log_trace("[computil] Trying word-mode matching (re=%s) ...", $re) if $COMPLETE_UTIL_TRACE;
#
#        for my $i (0..$#array) {
#            my $match;
#            {
#                if ($arrayn[$i] =~ $re) {
#                    $match++;
#                    last;
#                }
#                # try splitting CamelCase into Camel-Case
#                my $tmp = $array[$i];
#                if ($tmp =~ s/([a-z0-9_])([A-Z])/$1-$2/g) {
#                    $tmp = uc($tmp) if $ci; $tmp =~ s/_/-/g if $map_case; # normalize again
#                    if ($tmp =~ $re) {
#                        $match++;
#                        last;
#                    }
#                }
#            }
#            next unless $match;
#            push @words, $array[$i];
#            push @wordsumms, $arraysumms[$i] if $summaries;
#        }
#        log_trace("[computil] Result from word-mode matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#    }
#
#    # prefix char-mode matching
#    if ($char_mode && !@words && length($wordn) && length($wordn) <= 7) {
#        my $re = join(".*", map {quotemeta} split(//, $wordn));
#        $re = qr/\A$re/;
#        log_trace("[computil] Trying prefix char-mode matching (re=%s) ...", $re) if $COMPLETE_UTIL_TRACE;
#        for my $i (0..$#array) {
#            if ($arrayn[$i] =~ $re) {
#                push @words, $array[$i];
#                push @wordsumms, $arraysumms[$i] if $summaries;
#            }
#        }
#        log_trace("[computil] Result from prefix char-mode matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#    }
#
#    # char-mode matching
#    if ($char_mode && !@words && length($wordn) && length($wordn) <= 7) {
#        my $re = join(".*", map {quotemeta} split(//, $wordn));
#        $re = qr/$re/;
#        log_trace("[computil] Trying char-mode matching (re=%s) ...", $re) if $COMPLETE_UTIL_TRACE;
#        for my $i (0..$#array) {
#            if ($arrayn[$i] =~ $re) {
#                push @words, $array[$i];
#                push @wordsumms, $arraysumms[$i] if $summaries;
#            }
#        }
#        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'],
#    },
#};
#sub complete_hash_key {
#    my %args  = @_;
#    my $hash      = delete $args{hash} or die "Please specify hash";
#    my $word      = delete($args{word}) // "";
#    my $summaries = delete $args{summaries};
#    my $summaries_from_hash_values = delete $args{summaries_from_hash_values};
#    die "complete_hash_key(): Unknown argument(s): ".join(", ", keys %args)
#        if keys %args;
#
#    my @keys = keys %$hash;
#    my @summaries;
#    my $has_summary;
#    if ($summaries) {
#        $has_summary++;
#        for (@keys) { push @summaries, $summaries->{$_} }
#    } elsif ($summaries_from_hash_values) {
#        $has_summary++;
#        for (@keys) { push @summaries, $hash->{$_} }
#    }
#
#    complete_array_elem(
#        word=>$word, array=>\@keys,
#        (summaries=>\@summaries) x !!$has_summary,
#    );
#}
#
#my %complete_comma_sep_args = (
#    %complete_array_elem_args,
#    sep => {
#        schema  => 'str*',
#        default => ',',
#    },
#    uniq => {
#        summary => 'Whether list should contain unique elements',
#        description => <<'_',
#
#When this option is set to true, if the formed list in the current word already
#contains an element, the element will not be offered again as completion answer.
#For example, if `elems` is `[1,2,3,4]` and `word` is `2,3,` then without `uniq`
#set to true the completion answer is:
#
#    2,3,1
#    2,3,2
#    2,3,3
#    2,3,4
#
#but with `uniq` set to true, the completion answer becomes:
#
#    2,3,1
#    2,3,4
#
#See also the `remaining` option for a more general mechanism of offering fewer
#elements.
#
#_
#        schema => ['bool*', is=>1],
#    },
#    remaining => {
#        schema => ['code*'],
#        summary => 'What elements should remain for completion',
#        description => <<'_',
#
#This is a more general mechanism if the `uniq` option does not suffice. Suppose
#you are offering completion for sorting fields. The elements are field names as
#well as field names prefixed with dash (`-`) to mean sorting with a reverse
#order. So for example `elems` is `["name","-name","age","-age"]`. When current
#word is `name`, it doesn't make sense to offer `name` nor `-name` again as the
#next sorting field. So we can set `remaining` to this code:
#
#    sub {
#        my ($seen_elems, $elems) = @_;
#
#        my %seen;
#        for (@$seen_elems) {
#            (my $nodash = $_) =~ s/^-//;
#            $seen{$nodash}++;
#        }
#
#        my @remaining;
#        for (@$elems) {
#            (my $nodash = $_) =~ s/^-//;
#            push @remaining, $_ unless $seen{$nodash};
#        }
#
#        \@remaining;
#    }
#
#As you can see above, the code is given `$seen_elems` and `$elems` as arguments
#and is expected to return remaining elements to offer.
#
#_
#        tags => ['hidden-cli'],
#    },
#);
#$complete_comma_sep_args{elems} = delete $complete_comma_sep_args{array};
#
#$SPEC{complete_comma_sep} = {
#    v => 1.1,
#    summary => 'Complete a comma-separated list string',
#    args => {
#        %complete_comma_sep_args,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_comma_sep {
#    my %args  = @_;
#    my $word      = delete $args{word} // "";
#    my $sep       = delete $args{sep} // ',';
#    my $elems     = delete $args{elems} or die "Please specify elems";
#    my $summaries = delete $args{summaries};
#    my $uniq      = delete $args{uniq};
#    my $remaining = delete $args{remaining};
#    my $exclude     = delete $args{exclude};
#    my $replace_map = delete $args{replace_map};
#    die "complete_comma_sep(): Unknown argument(s): ".join(", ", keys %args)
#        if keys %args;
#
#    my $ci = $Complete::Common::OPT_CI;
#
#    my %summaries_for; # key=elem val=summary
#  GEN_SUMMARIES_HASH:
#    {
#        last unless $summaries;
#        for my $i (0 .. $#{$elems}) {
#            my $elem0 = $elems->[$i];
#            my $summary = $summaries->[$i];
#            my $elem = $ci ? lc($elem0) : $elem0;
#            if (exists $summaries_for{$elem}) {
#                log_warn "Non-unique value '$elem', using only the first summary for it";
#                next;
#            }
#            $summaries_for{$elem} = $summary;
#        }
#    } # GEN_SUMMARIES_HASH
#
#    my @mentioned_elems = split /\Q$sep\E/, $word, -1;
#    my $cae_word = @mentioned_elems ? pop(@mentioned_elems) : ''; # cae=complete_array_elem
#
#    my $remaining_elems;
#    if ($remaining) {
#        $remaining_elems = $remaining->(\@mentioned_elems, $elems);
#    } elsif ($uniq) {
#        my %mem;
#        $remaining_elems = [];
#        for (@mentioned_elems) {
#            if ($ci) { $mem{lc $_}++ } else { $mem{$_}++ }
#        }
#        for (@$elems) {
#            push @$remaining_elems, $_ unless ($ci ? $mem{lc $_} : $mem{$_});
#        }
#    } else {
#        $remaining_elems = $elems;
#    }
#
#    my $cae_res = complete_array_elem(
#        word  => $cae_word,
#        array => $remaining_elems,
#        exclude => $exclude,
#        replace_map => $replace_map,
#        ($summaries ? (summaries=>[map {$summaries_for{ $ci ? lc($_):$_ }} @$remaining_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}];
#    }
#    $cae_res;
#}
#
#$SPEC{complete_comma_sep_pair} = {
#    v => 1.1,
#    summary => 'Complete a comma-separated list of key-value pairs',
#    args => {
#        %arg_word,
#        keys => {
#            schema => ['array*', of=>'str*'],
#            req => 1,
#        },
#        keys_summaries => {
#            summary => 'Summary for each key',
#            schema => ['array*', of=>'str*'],
#        },
#        complete_value => {
#            summary => 'Code to supply possible values for a key',
#            schema => 'code*',
#            description => <<'_',
#
#Code should accept hash arguments and will be given the arguments `word` (word
#that is part of the value), and `key` (the key being evaluated) and is expected
#to return a completion answer.
#
#_
#        },
#        uniq => {
#            schema => 'bool*',
#            default => 1,
#        },
#        remaining_keys => {
#            schema => ['code*'],
#            summary => 'What keys should remain for completion',
#            description => <<'_',
#
#This is a more general mechanism if the `uniq` option does not suffice. Suppose
#you are offering completion for arguments. Possible arguments are `foo`, `bar`,
#`baz` but the `bar` and `baz` arguments are mutually exclusive. We can set
#`remaining_keys` to this code:
#
#    my %possible_args = {foo=>1, bar=>1, baz=>1};
#    sub {
#        my ($seen_elems, $elems) = @_;
#
#        my %remaining = %possible_args;
#        for (@$seen_elems) {
#            delete $remaining{$_};
#            delete $remaining{baz} if $_ eq 'bar';
#            delete $remaining{bar} if $_ eq 'baz';
#        }
#
#        [keys %remaining];
#    }
#
#As you can see above, the code is given `$seen_elems` and `$elems` as arguments
#and is expected to return remaining elements to offer.
#
#
#_
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_comma_sep_pair {
#    my %args  = @_;
#    my $word           = delete $args{word} // "";
#    my $sep            = delete $args{sep} // ',';
#    my $keys           = delete $args{keys} or die "Please specify keys";
#    my $keys_summaries = delete $args{keys_summaries};
#    my $uniq           = delete $args{uniq} // 1;
#    my $remaining_keys = delete $args{remaining_keys};
#    my $complete_value = delete $args{complete_value};
#    die "complete_comma_sep_pair(): Unknown argument(s): ".join(", ", keys %args)
#        if keys %args;
#
#    my $ci = $Complete::Common::OPT_CI;
#
#    my %keys_summaries_for; # key=elem val=summary
#  GEN_KEYS_SUMMARIES_HASH:
#    {
#        last unless $keys_summaries;
#        for my $i (0 .. $#{$keys}) {
#            my $key0 = $keys->[$i];
#            my $summary = $keys_summaries->[$i];
#            my $key = $ci ? lc($key0) : $key0;
#            if (exists $keys_summaries_for{$key}) {
#                log_warn "Non-unique key '$key', using only the first summary for it";
#                next;
#            }
#            $keys_summaries_for{$key} = $summary;
#        }
#    } # GEN_KEYS_SUMMARIES_HASH
#
#    my @mentioned_elems = split /\Q$sep\E/, $word, -1;
#    my @mentioned_keys;
#    for my $i (0..$#mentioned_elems) { push @mentioned_keys, $mentioned_elems[$i] if $i % 2 == 0 }
#
#    if (@mentioned_elems == 0 || @mentioned_elems % 2 == 1) {
#
#        # 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} }
#                        );
#        }
#    };
#
#  ANSWER:
#    for my $ans (@_) {
#        if (ref($ans) eq 'ARRAY') {
#            $add_words->($ans);
#        } elsif (ref($ans) eq 'HASH') {
#            $encounter_hash++;
#
#            if ($ans->{final}) {
#                $final = $ans;
#                last ANSWER;
#            }
#
#            $add_words->($ans->{words} // []);
#            for (keys %$ans) {
#                if ($_ eq 'words') {
#                    next;
#                } elsif ($_ eq 'static') {
#                    if (exists $final->{$_}) {
#                        $final->{$_} &&= $ans->{$_};
#                    } else {
#                        $final->{$_} = $ans->{$_};
#                    }
#                } else {
#                    $final->{$_} = $ans->{$_};
#                }
#            }
#        }
#    }
#
#    $encounter_hash ? $final : $final->{words};
#}
#
#$SPEC{modify_answer} = {
#    v => 1.1,
#    summary => 'Modify answer (add prefix/suffix, etc)',
#    args => {
#        answer => {
#            schema => ['any*', of=>['hash*','array*']], # XXX answer_t
#            req => 1,
#            pos => 0,
#        },
#        suffix => {
#            schema => 'str*',
#        },
#        prefix => {
#            schema => 'str*',
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'undef',
#    },
#};
#sub modify_answer {
#    my %args = @_;
#
#    my $answer = delete $args{answer};
#    my $words = ref($answer) eq 'HASH' ? $answer->{words} : $answer;
#    my $prefix = delete $args{prefix};
#    my $suffix = delete $args{suffix};
#    die "modify_answer(): Unknown argument(s): ".join(", ", keys %args)
#        if keys %args;
#
#    if (defined $prefix) {
#        for (@$words) {
#            if (ref $_ eq 'HASH') {
#                $_->{word} = "$prefix$_->{word}";
#            } else {
#                $_ = "$prefix$_";
#            }
#        }
#    }
#    if (defined $suffix) {
#        for (@$words) {
#            if (ref $_ eq 'HASH') {
#                $_->{word} = "$_->{word}$suffix";
#            } else {
#                $_ = "$_$suffix";
#            }
#        }
#    }
#    $answer;
#}
#
#$SPEC{ununiquify_answer} = {
#    v => 1.1,
#    summary => 'If answer contains only one item, make it two',
#    description => <<'_',
#
#For example, if answer is `["a"]`, then will make answer become `["a","a "]`.
#This will prevent shell from automatically adding space.
#
#_
#    args => {
#        answer => {
#            schema => ['any*', of=>['hash*','array*']], # XXX answer_t
#            req => 1,
#            pos => 0,
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'undef',
#    },
#    tags => ['hidden'],
#};
#sub ununiquify_answer {
#    my %args = @_;
#
#    my $answer = delete $args{answer};
#    my $words = ref($answer) eq 'HASH' ? $answer->{words} : $answer;
#    die "ununiquify_answer(): Unknown argument(s): ".join(", ", keys %args)
#        if keys %args;
#
#    if (@$words == 1) {
#        push @$words, "$words->[0] ";
#    }
#    undef;
#}
#
#1;
## ABSTRACT: General completion routine
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Util - General completion routine
#
#=head1 VERSION
#
#This document describes version 0.617 of Complete::Util (from Perl distribution Complete-Util), released on 2023-01-19.
#
#=head1 DESCRIPTION
#
#
#This package provides some generic completion routines that follow the
#L<Complete> convention. (If you are looking for bash/shell tab completion
#routines, take a look at the See Also section.) The main routine is
#C<complete_array_elem> which tries to complete a word using choices from elements
#of supplied array. For example:
#
# complete_array_elem(word => "a", array => ["apple", "apricot", "banana"]);
#
#The routine will first try a simple substring prefix matching. If that fails,
#will try some other methods like word-mode, character-mode, or fuzzy matching.
#These methods can be disabled using settings.
#
#There are other utility routines e.g. for converting completion answer structure
#from hash to array/array to hash, combine or modify answer, etc. These routines
#are usually used by the other more specific or higher-level completion modules.
#
#=head1 FUNCTIONS
#
#
#=head2 answer_has_entries
#
#Usage:
#
# answer_has_entries($answer) -> int
#
#Check if answer has entries.
#
#It is equivalent to:
#
# ref $answer eq 'ARRAY' ? (@$answer ? 1:0) : (@{$answer->{words}} ? 1: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 answer_num_entries
#
#Usage:
#
# answer_num_entries($answer) -> int
#
#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.
#
#Char-mode matching (can be disabled by settings
#C<$Complete::Common::OPT_CHAR_MODE> or C<COMPLETE_OPT_CHAR_MODE> environment
#variable to false). Char-mode matching is described in L<Complete::Common>. If
#at least one match is found, return result. Else, proceed to the next method.
#
#Fuzzy matching (can be disabled by setting C<$Complete::Common::OPT_FUZZY> or
#C<COMPLETE_OPT_FUZZY> to false). Fuzzy matching is described in
#L<Complete::Common>. If at least one match is found, return result. Else,
#return empty string.
#
#Will sort the resulting completion list, so you don't have to presort the array.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<array>* => I<array[str]>
#
#(No description)
#
#=item * B<exclude> => I<array>
#
#(No description)
#
#=item * B<replace_map> => I<hash>
#
#You can supply correction entries in this option. An example is when array if
#C<['mount','unmount']> and C<umount> is a popular "typo" for C<unmount>. When
#someone already types C<um> it cannot be completed into anything (even the
#current fuzzy mode will return I<both> so it cannot complete immediately).
#
#One solution is to add replace_map C<< {'unmount'=E<gt>['umount']} >>. This way, C<umount>
#will be regarded the same as C<unmount> and when user types C<um> it can be
#completed unambiguously into C<unmount>.
#
#=item * B<summaries> => I<array[str]>
#
#(No description)
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 complete_comma_sep
#
#Usage:
#
# complete_comma_sep(%args) -> array
#
#Complete a comma-separated list string.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<elems>* => I<array[str]>
#
#(No description)
#
#=item * B<exclude> => I<array>
#
#(No description)
#
#=item * B<remaining> => I<code>
#
#What elements should remain for completion.
#
#This is a more general mechanism if the C<uniq> option does not suffice. Suppose
#you are offering completion for sorting fields. The elements are field names as
#well as field names prefixed with dash (C<->) to mean sorting with a reverse
#order. So for example C<elems> is C<["name","-name","age","-age"]>. When current
#word is C<name>, it doesn't make sense to offer C<name> nor C<-name> again as the
#next sorting field. So we can set C<remaining> to this code:
#
# sub {
#     my ($seen_elems, $elems) = @_;
# 
#     my %seen;
#     for (@$seen_elems) {
#         (my $nodash = $_) =~ s/^-//;
#         $seen{$nodash}++;
#     }
# 
#     my @remaining;
#     for (@$elems) {
#         (my $nodash = $_) =~ s/^-//;
#         push @remaining, $_ unless $seen{$nodash};
#     }
# 
#     \@remaining;
# }
#
#As you can see above, the code is given C<$seen_elems> and C<$elems> as arguments
#and is expected to return remaining elements to offer.
#
#=item * B<replace_map> => I<hash>
#
#You can supply correction entries in this option. An example is when array if
#C<['mount','unmount']> and C<umount> is a popular "typo" for C<unmount>. When
#someone already types C<um> it cannot be completed into anything (even the
#current fuzzy mode will return I<both> so it cannot complete immediately).
#
#One solution is to add replace_map C<< {'unmount'=E<gt>['umount']} >>. This way, C<umount>
#will be regarded the same as C<unmount> and when user types C<um> it can be
#completed unambiguously into C<unmount>.
#
#=item * B<sep> => I<str> (default: ",")
#
#(No description)
#
#=item * B<summaries> => I<array[str]>
#
#(No description)
#
#=item * B<uniq> => I<bool>
#
#Whether list should contain unique elements.
#
#When this option is set to true, if the formed list in the current word already
#contains an element, the element will not be offered again as completion answer.
#For example, if C<elems> is C<[1,2,3,4]> and C<word> is C<2,3,> then without C<uniq>
#set to true the completion answer is:
#
# 2,3,1
# 2,3,2
# 2,3,3
# 2,3,4
#
#but with C<uniq> set to true, the completion answer becomes:
#
# 2,3,1
# 2,3,4
#
#See also the C<remaining> option for a more general mechanism of offering fewer
#elements.
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 complete_comma_sep_pair
#
#Usage:
#
# complete_comma_sep_pair(%args) -> array
#
#Complete a comma-separated list of key-value pairs.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<complete_value> => I<code>
#
#Code to supply possible values for a key.
#
#Code should accept hash arguments and will be given the arguments C<word> (word
#that is part of the value), and C<key> (the key being evaluated) and is expected
#to return a completion answer.
#
#=item * B<keys>* => I<array[str]>
#
#(No description)
#
#=item * B<keys_summaries> => I<array[str]>
#
#Summary for each key.
#
#=item * B<remaining_keys> => I<code>
#
#What keys should remain for completion.
#
#This is a more general mechanism if the C<uniq> option does not suffice. Suppose
#you are offering completion for arguments. Possible arguments are C<foo>, C<bar>,
#C<baz> but the C<bar> and C<baz> arguments are mutually exclusive. We can set
#C<remaining_keys> to this code:
#
# my %possible_args = {foo=>1, bar=>1, baz=>1};
# sub {
#     my ($seen_elems, $elems) = @_;
# 
#     my %remaining = %possible_args;
#     for (@$seen_elems) {
#         delete $remaining{$_};
#         delete $remaining{baz} if $_ eq 'bar';
#         delete $remaining{bar} if $_ eq 'baz';
#     }
# 
#     [keys %remaining];
# }
#
#As you can see above, the code is given C<$seen_elems> and C<$elems> as arguments
#and is expected to return remaining elements to offer.
#
#=item * B<uniq> => I<bool> (default: 1)
#
#(No description)
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 complete_hash_key
#
#Usage:
#
# complete_hash_key(%args) -> array
#
#Complete from hash keys.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<hash>* => I<hash>
#
#(No description)
#
#=item * B<summaries> => I<hash>
#
#(No description)
#
#=item * B<summaries_from_hash_values> => I<true>
#
#(No description)
#
#=item * B<word>* => I<str> (default: "")
#
#Word to complete.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 hashify_answer
#
#Usage:
#
# hashify_answer($answer, $meta) -> hash
#
#Make sure we return completion answer in hash form.
#
#This function accepts a hash or an array. If it receives an array, will convert
#the array into `{words=>$ary}' first to make sure the completion answer is in
#hash form.
#
#Then will add keys from C<meta> to the hash.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$answer>* => I<array|hash>
#
#Completion answer structure.
#
#=item * B<$meta> => I<hash>
#
#Metadata (extra keys) for the hash.
#
#
#=back
#
#Return value:  (hash)
#
#
#
#=head2 modify_answer
#
#Usage:
#
# modify_answer(%args) -> undef
#
#Modify answer (add prefixE<sol>suffix, etc).
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<answer>* => I<hash|array>
#
#(No description)
#
#=item * B<prefix> => I<str>
#
#(No description)
#
#=item * B<suffix> => I<str>
#
#(No description)
#
#
#=back
#
#Return value:  (undef)
#
#=for Pod::Coverage ^(ununiquify_answer)$
#
#=head1 FAQ
#
#=head2 Why is fuzzy matching slow?
#
#Example:
#
# use Benchmark qw(timethis);
# use Complete::Util qw(complete_array_elem);
#
# # turn off the other non-exact matching methods
# $Complete::Common::OPT_CI = 0;
# $Complete::Common::OPT_WORD_MODE = 0;
# $Complete::Common::OPT_CHAR_MODE = 0;
#
# my @ary = ("aaa".."zzy"); # 17575 elems
# timethis(20, sub { complete_array_elem(array=>\@ary, word=>"zzz") });
#
#results in:
#
# timethis 20:  7 wallclock secs ( 6.82 usr +  0.00 sys =  6.82 CPU) @  2.93/s (n=20)
#
#Answer: fuzzy matching is slower than exact matching due to having to calculate
#Levenshtein distance. But if you find fuzzy matching too slow using the default
#pure-perl implementation, you might want to install
#L<Text::Levenshtein::Flexible> (an optional prereq) to speed up fuzzy matching.
#After Text::Levenshtein::Flexible is installed:
#
# timethis 20:  1 wallclock secs ( 1.04 usr +  0.00 sys =  1.04 CPU) @ 19.23/s (n=20)
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_UTIL_TRACE
#
#Bool. If set to true, will generate more log statements for debugging (at the
#trace level).
#
#=head2 COMPLETE_UTIL_LEVENSHTEIN => str ('pp'|'xs'|'flexible')
#
#Can be used to force which Levenshtein distance implementation to use. C<pp>
#means the included PP implementation, which is the slowest (1-2 orders of
#magnitude slower than XS implementations), C<xs> which means
#L<Text::Levenshtein::XS>, or C<flexible> which means
#L<Text::Levenshtein::Flexible> (performs best).
#
#If this is not set, the default is to use Text::Levenshtein::Flexible when it's
#available, then fallback to the included PP implementation.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Util>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Util>.
#
#=head1 SEE ALSO
#
#L<Complete>
#
#If you want to do bash tab completion with Perl, take a look at
#L<Complete::Bash> or L<Getopt::Long::Complete> or L<Perinci::CmdLine>.
#
#Other C<Complete::*> modules.
#
#L<Bencher::Scenarios::CompleteUtil>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTORS
#
#=for stopwords A. Sinan Unur Steven Haryanto
#
#=over 4
#
#=item *
#
#A. Sinan Unur <nanis@cpan.org>
#
#=item *
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=back
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2017, 2016, 2015, 2014, 2013 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Util>
#
#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.
#
#=cut
### Data/Sah/Normalize.pm ###
#package Data::Sah::Normalize;
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-06-10'; # DATE
#our $DIST = 'Data-Sah-Normalize'; # DIST
#our $VERSION = '0.051'; # VERSION
#
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       normalize_clset
#                       normalize_schema
#
#                       $type_re
#                       $clause_name_re
#                       $clause_re
#                       $attr_re
#                       $funcset_re
#                       $compiler_re
#               );
#
#our $type_re        = qr/\A(?:[A-Za-z_]\w*::)*[A-Za-z_]\w*\z/;
#our $clause_name_re = qr/\A[A-Za-z_]\w*\z/;
#our $clause_re      = qr/\A[A-Za-z_]\w*(?:\.[A-Za-z_]\w*)*\z/;
#our $attr_re        = $clause_re;
#our $funcset_re     = qr/\A(?:[A-Za-z_]\w*::)*[A-Za-z_]\w*\z/;
#our $compiler_re    = qr/\A[A-Za-z_]\w*\z/;
#our $clause_attr_on_empty_clause_re = qr/\A(?:\.[A-Za-z_]\w*)+\z/;
#
#sub normalize_clset($;$) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
#    my ($clset0, $opts) = @_;
#    $opts //= {};
#
#    my $clset = {};
#    for my $c (sort keys %$clset0) {
#        my $c0 = $c;
#
#        my $v = $clset0->{$c};
#
#        # ignore expression
#        my $expr;
#        if ($c =~ s/=\z//) {
#            $expr++;
#            # XXX currently can't disregard merge prefix when checking
#            # conflict
#            die "Conflict between '$c=' and '$c'" if exists $clset0->{$c};
#            $clset->{"$c.is_expr"} = 1;
#            }
#
#        my $sc = "";
#        my $cn;
#        {
#            my $errp = "Invalid clause name syntax '$c0'"; # error prefix
#            if (!$expr && $c =~ s/\A!(?=.)//) {
#                die "$errp, syntax should be !CLAUSE"
#                    unless $c =~ $clause_name_re;
#                $sc = "!";
#            } elsif (!$expr && $c =~ s/(?<=.)\|\z//) {
#                die "$errp, syntax should be CLAUSE|"
#                    unless $c =~ $clause_name_re;
#                $sc = "|";
#            } elsif (!$expr && $c =~ s/(?<=.)\&\z//) {
#                die "$errp, syntax should be CLAUSE&"
#                    unless $c =~ $clause_name_re;
#                $sc = "&";
#            } elsif (!$expr && $c =~ /\A([^.]+)(?:\.(.+))?\((\w+)\)\z/) {
#                my ($c2, $a, $lang) = ($1, $2, $3);
#                die "$errp, syntax should be CLAUSE(LANG) or C.ATTR(LANG)"
#                    unless $c2 =~ $clause_name_re &&
#                        (!defined($a) || $a =~ $attr_re);
#                $sc = "(LANG)";
#                $cn = $c2 . (defined($a) ? ".$a" : "") . ".alt.lang.$lang";
#            } elsif ($c !~ $clause_re &&
#                         $c !~ $clause_attr_on_empty_clause_re) {
#                die "$errp, please use letter/digit/underscore only";
#            }
#        }
#
#        # XXX can't disregard merge prefix when checking conflict
#        if ($sc eq '!') {
#            die "Conflict between clause shortcuts '!$c' and '$c'"
#                if exists $clset0->{$c};
#            die "Conflict between clause shortcuts '!$c' and '$c|'"
#                if exists $clset0->{"$c|"};
#            die "Conflict between clause shortcuts '!$c' and '$c&'"
#                if exists $clset0->{"$c&"};
#            $clset->{$c} = $v;
#            $clset->{"$c.op"} = "not";
#        } elsif ($sc eq '&') {
#            die "Conflict between clause shortcuts '$c&' and '$c'"
#                if exists $clset0->{$c};
#            die "Conflict between clause shortcuts '$c&' and '$c|'"
#                if exists $clset0->{"$c|"};
#            die "Clause 'c&' value must be an array"
#                unless ref($v) eq 'ARRAY';
#            $clset->{$c} = $v;
#            $clset->{"$c.op"} = "and";
#        } elsif ($sc eq '|') {
#            die "Conflict between clause shortcuts '$c|' and '$c'"
#                if exists $clset0->{$c};
#            die "Clause 'c|' value must be an array"
#                unless ref($v) eq 'ARRAY';
#            $clset->{$c} = $v;
#            $clset->{"$c.op"} = "or";
#        } elsif ($sc eq '(LANG)') {
#            die "Conflict between clause '$c' and '$cn'"
#                if exists $clset0->{$cn};
#            $clset->{$cn} = $v;
#        } else {
#            $clset->{$c} = $v;
#        }
#
#    }
#    $clset->{req} = 1 if $opts->{has_req};
#
#    # XXX option to recursively normalize clset, any's of, all's of, ...
#    #if ($clset->{clset}) {
#    #    local $opts->{has_req};
#    #    if ($clset->{'clset.op'} && $clset->{'clset.op'} =~ /and|or/) {
#    #        # multiple clause sets
#    #        $clset->{clset} = map { $self->normalize_clset($_, $opts) }
#    #            @{ $clset->{clset} };
#    #    } else {
#    #        $clset->{clset} = $self->normalize_clset($_, $opts);
#    #    }
#    #}
#
#    $clset;
#}
#
#sub normalize_schema($) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
#    my $s = shift;
#
#    my $ref = ref($s);
#    if (!defined($s)) {
#
#        die "Schema is missing";
#
#    } elsif (!$ref) {
#
#        my $has_req = $s =~ s/\*\z//;
#        $s =~ $type_re or die "Invalid type syntax $s, please use ".
#            "letter/digit/underscore only";
#        return [$s, $has_req ? {req=>1} : {}];
#
#    } elsif ($ref eq 'ARRAY') {
#
#        my $t = $s->[0];
#        my $has_req = $t && $t =~ s/\*\z//;
#        if (!defined($t)) {
#            die "For array form, at least 1 element is needed for type";
#        } elsif (ref $t) {
#            die "For array form, first element must be a string";
#        }
#        $t =~ $type_re or die "Invalid type syntax $s, please use ".
#            "letter/digit/underscore only";
#
#        my $clset0;
#        my $extras;
#        if (defined($s->[1])) {
#            if (ref($s->[1]) eq 'HASH') {
#                $clset0 = $s->[1];
#                $extras = $s->[2];
#                die "For array form, there should not be more than 3 elements"
#                    if @$s > 3;
#            } else {
#                # flattened clause set [t, c=>1, c2=>2, ...]
#                die "For array in the form of [t, c1=>1, ...], there must be ".
#                    "3 elements (or 5, 7, ...)"
#                        unless @$s % 2;
#                $clset0 = { @{$s}[1..@$s-1] };
#            }
#        } else {
#            $clset0 = {};
#        }
#
#        # check clauses and parse shortcuts (!c, c&, c|, c=)
#        my $clset = normalize_clset($clset0, {has_req=>$has_req});
#        if (defined $extras) {
#            die "For array form with 3 elements, extras must be hash"
#                unless ref($extras) eq 'HASH';
#            die "Extras must be empty hashref (Sah 0.9.47)" if keys %$extras;
#            # we remove extras to comply with Sah 0.9.47+
#            return [$t, $clset];
#        } else {
#            return [$t, $clset];
#        }
#    }
#
#    die "Schema must be a string or arrayref (not $ref)";
#}
#
#1;
## ABSTRACT: Normalize Sah schema
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Sah::Normalize - Normalize Sah schema
#
#=head1 VERSION
#
#This document describes version 0.051 of Data::Sah::Normalize (from Perl distribution Data-Sah-Normalize), released on 2022-06-10.
#
#=head1 SYNOPSIS
#
# use Data::Sah::Normalize qw(normalize_clset normalize_schema);
#
# my $nclset = normalize_clset({'!a'=>1}); # -> {a=>1, 'a.op'=>'not'}
# my $nsch   = normalize_schema("int");    # -> ["int", {}]
#
#=head1 DESCRIPTION
#
#This often-needed functionality is split from the main L<Data::Sah> to keep it
#in a small and minimal-dependencies package.
#
#=head1 FUNCTIONS
#
#=head2 normalize_clset($clset) => HASH
#
#Normalize a clause set (hash). Return a shallow copy of the original hash. Die
#on failure.
#
#TODO: option to recursively normalize clause which contains sah clauses (e.g.
#C<of>).
#
#=head2 normalize_schema($sch) => ARRAY
#
#Normalize a Sah schema (scalar or array). Return an array. Produce a 2-level
#copy of schema, so it's safe to add/delete/modify the normalized schema's clause
#set, but clause set's values are still references to the original. Die on
#failure.
#
#TODO: recursively normalize clause which contains sah clauses (e.g. C<of>).
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Normalize>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Normalize>.
#
#=head1 SEE ALSO
#
#L<Sah>, L<Data::Sah>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTOR
#
#=for stopwords Steven Haryanto
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
#beyond that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2018, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-Normalize>
#
#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.
#
#=cut
### Function/Fallback/CoreOrPP.pm ###
#package Function::Fallback::CoreOrPP;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-02-03'; # DATE
#our $DIST = 'Function-Fallback-CoreOrPP'; # DIST
#our $VERSION = '0.090'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $USE_NONCORE_XS_FIRST = 1;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       clone
#                       clone_list
#                       unbless
#                       uniq
#               );
#
#sub clone {
#    my $data = shift;
#    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
#    goto FALLBACK unless eval { require Data::Clone; 1 };
#
#  STANDARD:
#    return Data::Clone::clone($data);
#
#  FALLBACK:
#    require Clone::PP;
#    return Clone::PP::clone($data);
#}
#
#sub clone_list {
#    map { clone($_) } @_;
#}
#
#sub _unbless_fallback {
#    my $ref = shift;
#
#    my $r = ref($ref);
#    # not a reference
#    return $ref unless $r;
#
#    # return if not a blessed ref
#    my ($r2, $r3) = "$ref" =~ /(.+)=(.+?)\(/
#        or return $ref;
#
#    if ($r3 eq 'HASH') {
#        return { %$ref };
#    } elsif ($r3 eq 'ARRAY') {
#        return [ @$ref ];
#    } elsif ($r3 eq 'SCALAR') {
#        return \( my $copy = ${$ref} );
#    } elsif ($r3 eq 'CODE') {
#        return sub { goto &$ref };
#    } else {
#        die "Can't handle $ref";
#    }
#}
#
#sub unbless {
#    my $ref = shift;
#
#    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
#    goto FALLBACK unless eval { require Acme::Damn; 1 };
#
#  STANDARD:
#    return Acme::Damn::damn($ref);
#
#  FALLBACK:
#    return _unbless_fallback($ref);
#}
#
#sub uniq {
#    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
#    goto FALLBACK unless eval { require List::MoreUtils; 1 };
#
#  STANDARD:
#    return List::MoreUtils::uniq(@_);
#
#  FALLBACK:
#    my %h;
#    my @res;
#    for (@_) {
#        push @res, $_ unless $h{$_}++;
#    }
#    return @res;
#}
#
#1;
## ABSTRACT: Functions that use non-core XS module but provide pure-Perl/core fallback
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Function::Fallback::CoreOrPP - Functions that use non-core XS module but provide pure-Perl/core fallback
#
#=head1 VERSION
#
#This document describes version 0.090 of Function::Fallback::CoreOrPP (from Perl distribution Function-Fallback-CoreOrPP), released on 2020-02-03.
#
#=head1 SYNOPSIS
#
# use Function::Fallback::CoreOrPP qw(clone unbless uniq);
#
# my $clone = clone({blah=>1});
# my $unblessed = unbless($blessed_ref);
# my @uniq  = uniq(1, 3, 2, 1, 4);  # -> (1, 3, 2, 4)
#
#=head1 DESCRIPTION
#
#This module provides functions that use non-core XS modules (for best speed,
#reliability, feature, etc) but falls back to those that use core XS or pure-Perl
#modules when the non-core XS module is not available.
#
#This module helps when you want to bootstrap your Perl application with a
#portable, dependency-free Perl script. In a vanilla Perl installation (having
#only core modules), you can use L<App::FatPacker> to include non-core pure-Perl
#dependencies to your script.
#
#=for Pod::Coverage ^()$
#
#=head1 FUNCTIONS
#
#=head2 clone($data) => $cloned
#
#Try to use L<Data::Clone>'s C<clone>, but fall back to using L<Clone::PP>'s
#C<clone>.
#
#=head2 clone_list(@data) => @data
#
#A shortcut for:
#
# return map {clone($_)} @data
#
#=head2 unbless($ref) => $unblessed_ref
#
#Try to use L<Acme::Damn>'s C<damn> to unbless a reference but fall back to
#shallow copying.
#
#NOTE: C<damn()> B<MODIFIES> the original reference. (XXX in the future an option
#to clone the reference first will be provided), while shallow copying will
#return a shallow copy.
#
#NOTE: The shallow copy method currently only handles blessed
#{scalar,array,hash}ref as those are the most common.
#
#=head2 uniq(@ary) => @uniq_ary
#
#Try to use L<List::MoreUtils>'s C<uniq>, but fall back to using slower,
#pure-Perl implementation.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Function-Fallback-CoreOrPP>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Function-Fallback-CoreOrPP>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Function-Fallback-CoreOrPP>
#
#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
#
#L<Clone::Any> can also use multiple backends. I used to avoid it because
#L<Storable>'s C<dclone> (which is used as the backend) did not support Regexp
#objects out of the box until version 3.08. Plus must use deparse to handle
#coderefs.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2017, 2016, 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
### Getopt/Long/Util.pm ###
#package Getopt::Long::Util;
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       parse_getopt_long_opt_spec
#                       humanize_getopt_long_opt_spec
#                       detect_getopt_long_script
#                       gen_getopt_long_spec_from_getopt_std_spec
#                       array_getopt_long_spec_to_hash
#               );
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-11-14'; # DATE
#our $DIST = 'Getopt-Long-Util'; # DIST
#our $VERSION = '0.899'; # VERSION
#
#our %SPEC;
#
#$SPEC{parse_getopt_long_opt_spec} = {
#    v => 1.1,
#    summary => 'Parse a single Getopt::Long option specification',
#    description => <<'_',
#
#Will produce a hash with some keys:
#
#* `is_arg` (if true, then option specification is the special `<>` for argument
#  callback)
#* `opts` (array of option names, in the order specified in the opt spec)
#* `type` (string, type name)
#* `desttype` (either '', or '@' or '%'),
#* `is_neg` (true for `--opt!`)
#* `is_inc` (true for `--opt+`)
#* `min_vals` (int, usually 0 or 1)
#* `max_vals` (int, usually 0 or 1 except for option that requires multiple
#  values)
#
#Will return undef if it can't parse the string.
#
#_
#    args => {
#        optspec => {
#            schema => 'str*',
#            req => 1,
#            pos => 0,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#    },
#    examples => [
#        {
#            args => {optspec => 'help|h|?'},
#            result => {dash_prefix=>'', opts=>['help', 'h', '?']},
#        },
#        {
#            args => {optspec=>'--foo=s'},
#            result => {dash_prefix=>'--', opts=>['foo'], type=>'s', desttype=>''},
#        },
#    ],
#};
## BEGIN_BLOCK: parse_getopt_long_opt_spec
#sub parse_getopt_long_opt_spec {
#    my $optspec = shift;
#    return {is_arg=>1, dash_prefix=>'', opts=>[]}
#        if $optspec eq '<>';
#    $optspec =~ qr/\A
#               (?P<dash_prefix>-{0,2})
#               (?P<name>[A-Za-z0-9_][A-Za-z0-9_-]*)
#               (?P<aliases> (?: \| (?:[^:|!+=:-][^:|!+=:]*) )*)?
#               (?:
#                   (?P<is_neg>!) |
#                   (?P<is_inc>\+) |
#                   (?:
#                       =
#                       (?P<type>[siof])
#                       (?P<desttype>|[%@])?
#                       (?:
#                           \{
#                           (?: (?P<min_vals>\d+), )?
#                           (?P<max_vals>\d+)
#                           \}
#                       )?
#                   ) |
#                   (?:
#                       :
#                       (?P<opttype>[siof])
#                       (?P<desttype>|[%@])?
#                   ) |
#                   (?:
#                       :
#                       (?P<optnum>-?\d+)
#                       (?P<desttype>|[%@])?
#                   ) |
#                   (?:
#                       :
#                       (?P<optplus>\+)
#                       (?P<desttype>|[%@])?
#                   )
#               )?
#               \z/x
#                   or return;
#    my %res = %+;
#
#    if (defined $res{optnum}) {
#        $res{type} = 'i';
#    }
#
#    if ($res{aliases}) {
#        my @als;
#        for my $al (split /\|/, $res{aliases}) {
#            next unless length $al;
#            next if $al eq $res{name};
#            next if grep {$_ eq $al} @als;
#            push @als, $al;
#        }
#        $res{opts} = [$res{name}, @als];
#    } else {
#        $res{opts} = [$res{name}];
#    }
#    delete $res{name};
#    delete $res{aliases};
#
#    $res{is_neg} = 1 if $res{is_neg};
#    $res{is_inc} = 1 if $res{is_inc};
#
#    \%res;
#}
## END_BLOCK: parse_getopt_long_opt_spec
#
#$SPEC{humanize_getopt_long_opt_spec} = {
#    v => 1.1,
#    description => <<'_',
#
#Convert <pm:Getopt::Long> option specification into a more human-friendly
#notation that is suitable for including in help/usage text, for example:
#
#    help|h|?       ->  "--help, -h, -?"
#    help|h|?       ->  "--help | -h | -?"               # if you provide 'separator'
#    --foo=s        ->  "--foo=s"
#    --foo=s        ->  "--foo=somelabel"                # if you provide 'value_label'
#    --foo:s        ->  "--foo[=s]"
#    --foo=s@       ->  "(--foo=s)+"
#    --foo=s%       ->  "(--foo key=value)+"
#    --foo=s%       ->  "(--foo somelabel1=somelabel2)+" # if you provide 'key_label' and 'value_label'
#    --debug!       ->  "--(no)debug"
#
#It also produces POD-formatted string for use in POD documentation:
#
#    --foo=s        ->  {plaintext=>"--foo=s", pod=>"B<--foo>=I<s>"}
#                                                        # if you set 'extended' to true
#
#Will die if can't parse the optspec string.
#
#_
#    args => {
#        optspec => {
#            schema => 'str*',
#            req => 1,
#            pos => 0,
#        },
#        separator => {
#            schema => 'str*',
#            default => ', ',
#        },
#        key_label => {
#            schema => 'str*',
#            default => 'key',
#        },
#        opt_link => {
#            schema => 'str*', # XXX url? podlink?
#        },
#        value_label => {
#            schema => 'str*',
#        },
#        value_label_link => {
#            schema => 'str*', # XXX url? podlink?
#        },
#        extended => {
#            summary => 'If set to true, will return a hash of multiple formats instead of a single plaintext format',
#            schema => 'bool*',
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => ['any*', {of=>[['str*'], ['hash*', {of=>'str*'}]]}],
#    },
#};
#sub humanize_getopt_long_opt_spec {
#    my $opts = {}; $opts = shift if ref $_[0] eq 'HASH';
#    my $optspec = shift;
#
#    my $parse = parse_getopt_long_opt_spec($optspec)
#        or die "Can't parse opt spec $optspec";
#
#    return "argument" if $parse->{is_arg};
#
#    my $plain_res = '';
#    my $pod_res   = '';
#    my $i = 0;
#    for (@{ $parse->{opts} }) {
#        $i++;
#        my $opt_plain_res = '';
#        my $opt_pod_res   = '';
#        if ($parse->{is_neg} && length($_) > 1) {
#            $opt_plain_res .= "--(no)$_";
#            $opt_pod_res   .= defined($opts->{opt_link}) ? "B<L<--(no)$_|$opts->{opt_link}>>" : "B<--(no)$_>";
#        } else {
#            if (length($_) > 1) {
#                $opt_plain_res .= "--$_";
#                $opt_pod_res   .= defined($opts->{opt_link}) ? "B<L<--$_|$opts->{opt_link}>>" : "B<--$_>";
#            } else {
#                $opt_plain_res .= "-$_";
#                $opt_pod_res   .= defined($opts->{opt_link}) ? "B<L<-$_|$opts->{opt_link}>>" : "B<-$_>";
#            }
#            if ($i==1 && ($parse->{type} || $parse->{opttype})) {
#                # show value label
#                my $key_label = $opts->{key_label} // 'key';
#                my $value_label = $opts->{value_label} //
#                    $parse->{type} // $parse->{opttype};
#
#                $opt_plain_res .= "[" if $parse->{opttype};
#                $opt_plain_res .= ($parse->{type} && $parse->{desttype} eq '%' ? " " : "=");
#                $opt_plain_res .= "$key_label=" if $parse->{desttype} eq '%';
#                $opt_plain_res .= $value_label;
#                $opt_plain_res .= "]" if $parse->{opttype};
#
#                $opt_pod_res   .= "[" if $parse->{opttype};
#                $opt_pod_res   .= ($parse->{type} && $parse->{desttype} eq '%' ? " " : "=");
#                $opt_pod_res   .= "I<$key_label>=" if $parse->{desttype} eq '%';
#                $opt_pod_res   .= defined $opts->{value_label_link} ? "I<L<$value_label|$opts->{value_label_link}>>" : "I<$value_label>";
#                $opt_pod_res   .= "]" if $parse->{opttype};
#            }
#            $opt_plain_res = "($opt_plain_res)+" if ($parse->{desttype} // '') =~ /@|%/;
#            $opt_pod_res   = "($opt_pod_res)+"   if ($parse->{desttype} // '') =~ /@|%/;
#        }
#
#        $plain_res .= ($opts->{separator} // ", ") if length($plain_res);
#        $pod_res   .= ($opts->{separator} // ", ") if length($pod_res);
#
#        $plain_res .= $opt_plain_res;
#        $pod_res   .= $opt_pod_res;
#    }
#
#    if ($opts->{extended}) {
#        return {
#            plaintext => $plain_res,
#            pod => $pod_res,
#        };
#    } else {
#        $plain_res;
#    }
#}
#
#$SPEC{detect_getopt_long_script} = {
#    v => 1.1,
#    summary => 'Detect whether a file is a Getopt::Long-based CLI script',
#    description => <<'_',
#
#The criteria are:
#
#* the file must exist and readable;
#
#* (optional, if `include_noexec` is false) file must have its executable mode
#  bit set;
#
#* content must start with a shebang C<#!>;
#
#* either: must be perl script (shebang line contains 'perl') and must contain
#  something like `use Getopt::Long`;
#
#_
#    args => {
#        filename => {
#            summary => 'Path to file to be checked',
#            schema => 'str*',
#            pos => 0,
#            cmdline_aliases => {f=>{}},
#        },
#        string => {
#            summary => 'String to be checked',
#            schema => 'buf*',
#        },
#        include_noexec => {
#            summary => 'Include scripts that do not have +x mode bit set',
#            schema  => 'bool*',
#            default => 1,
#        },
#    },
#    args_rels => {
#        'req_one' => ['filename', 'string'],
#    },
#};
#sub detect_getopt_long_script {
#    my %args = @_;
#
#    (defined($args{filename}) xor defined($args{string}))
#        or return [400, "Please specify either filename or string"];
#    my $include_noexec  = $args{include_noexec}  // 1;
#
#    my $yesno = 0;
#    my $reason = "";
#    my %extrameta;
#
#    my $str = $args{string};
#  DETECT:
#    {
#        if (defined $args{filename}) {
#            my $fn = $args{filename};
#            unless (-f $fn) {
#                $reason = "'$fn' is not a file";
#                last;
#            };
#            if (!$include_noexec && !(-x _)) {
#                $reason = "'$fn' is not an executable";
#                last;
#            }
#            my $fh;
#            unless (open $fh, "<", $fn) {
#                $reason = "Can't be read";
#                last;
#            }
#            # for efficiency, we read a bit only here
#            read $fh, $str, 2;
#            unless ($str eq '#!') {
#                $reason = "Does not start with a shebang (#!) sequence";
#                last;
#            }
#            my $shebang = <$fh>;
#            unless ($shebang =~ /perl/) {
#                $reason = "Does not have 'perl' in the shebang line";
#                last;
#            }
#            seek $fh, 0, 0;
#            {
#                local $/;
#                $str = <$fh>;
#            }
#            close $fh;
#        }
#        unless ($str =~ /\A#!/) {
#            $reason = "Does not start with a shebang (#!) sequence";
#            last;
#        }
#        unless ($str =~ /\A#!.*perl/) {
#            $reason = "Does not have 'perl' in the shebang line";
#            last;
#        }
#
#        # NOTE: the presence of \s* pattern after ^ causes massive slowdown of
#        # the regex when we reach many thousands of lines, so we use split()
#
#        #if ($str =~ /^\s*(use|require)\s+(Getopt::Long(?:::Complete)?)(\s|;)/m) {
#        #    $yesno = 1;
#        #    $extrameta{'func.module'} = $2;
#        #    last DETECT;
#        #}
#
#        for (split /^/, $str) {
#            if (/^\s*(use|require)\s+(Getopt::Long(?:::Complete|::Less|::EvenLess)?)(\s|;|$)/) {
#                $yesno = 1;
#                $extrameta{'func.module'} = $2;
#                last DETECT;
#            }
#        }
#
#        $reason = "Can't find any statement requiring Getopt::Long(?::Complete|::Less|::EvenLess)? module";
#    } # DETECT
#
#    [200, "OK", $yesno, {"func.reason"=>$reason, %extrameta}];
#}
#
#$SPEC{gen_getopt_long_spec_from_getopt_std_spec} = {
#    v => 1.1,
#    summary => 'Generate Getopt::Long spec from Getopt::Std spec',
#    args => {
#        spec => {
#            summary => 'Getopt::Std spec string',
#            schema => 'str*',
#            req => 1,
#            pos => 0,
#        },
#        is_getopt => {
#            summary => 'Whether to assume spec is for getopt() or getopts()',
#            description => <<'_',
#
#By default spec is assumed to be for getopts() instead of getopt(). This means
#that for a spec like `abc:`, `a` and `b` don't take argument while `c` does. But
#if `is_getopt` is true, the meaning of `:` is reversed: `a` and `b` take
#arguments while `c` doesn't.
#
#_
#            schema => 'bool',
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#    },
#};
#sub gen_getopt_long_spec_from_getopt_std_spec {
#    my %args = @_;
#
#    my $is_getopt = $args{is_getopt};
#    my $spec = {};
#
#    while ($args{spec} =~ /(.)(:?)/g) {
#        $spec->{$1 . ($is_getopt ? ($2 ? "" : "=s") : ($2 ? "=s" : ""))} =
#            sub {};
#    }
#
#    $spec;
#}
#
#$SPEC{array_getopt_long_spec_to_hash} = {
#    v => 1.1,
#    summary => 'Convert array form of Getopt::Long spec to hash',
#    description => <<'_',
#
#<pm:Getopt::Long>'s `GetOptions` function accepts a list of arguments. The first
#optional argument is a hash for option storage. After that, a list of option
#specs (e.g. `foo=s`), each optionally followed by a reference to specify
#destination (e.g. a reference to scalar, or array, or code).
#
#Die on failure (e.g. invalid option spec).
#
#This routine converts that array into a hash of option specs as keys and
#destinations as values. If an option spec does not have a destination, its
#destination is set to `undef`. If hash storage is specified then the destination
#will fall back to the hash storage's appropriate key when a specific destination
#is not specified.
#
#Note that by converting to hash, 1) duplicate option specs are merged; and 2)
#order of option specs is not preserved.
#
#_
#    args => {
#        spec => {
#            summary => 'Getopt::Long spec',
#            schema => 'array*',
#            req => 1,
#            pos => 0,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#    },
#};
#sub array_getopt_long_spec_to_hash {
#    my $go_spec = [ @_ ];
#    my $hash_spec = {};
#
#    my $hash_storage;
#    $hash_storage = shift @$go_spec
#        if @$go_spec && ref $go_spec->[0] eq 'HASH';
#
#    while (@$go_spec) {
#        my $opt_spec = shift @$go_spec;
#        my $dest;
#        if (@$go_spec && ref $go_spec->[0]) {
#            $dest = shift @$go_spec;
#        } elsif ($hash_storage) {
#            my $res = parse_getopt_long_opt_spec($opt_spec)
#                or die "Invalid option spec '$opt_spec'";
#            my $name = $res->{opts}[0];
#            $hash_storage->{$name} = undef unless exists $hash_storage->{$name};
#            $dest = ref $hash_storage->{$name} ?
#                $hash_storage->{$name} :
#                \($hash_storage->{$name});
#        }
#        $hash_spec->{$opt_spec} = $dest;
#    }
#
#    $hash_spec;
#}
#
#1;
## ABSTRACT: Utilities for Getopt::Long
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Getopt::Long::Util - Utilities for Getopt::Long
#
#=head1 VERSION
#
#This document describes version 0.899 of Getopt::Long::Util (from Perl distribution Getopt-Long-Util), released on 2022-11-14.
#
#=head1 FUNCTIONS
#
#
#=head2 array_getopt_long_spec_to_hash
#
#Usage:
#
# array_getopt_long_spec_to_hash($spec) -> hash
#
#Convert array form of Getopt::Long spec to hash.
#
#L<Getopt::Long>'s C<GetOptions> function accepts a list of arguments. The first
#optional argument is a hash for option storage. After that, a list of option
#specs (e.g. C<foo=s>), each optionally followed by a reference to specify
#destination (e.g. a reference to scalar, or array, or code).
#
#Die on failure (e.g. invalid option spec).
#
#This routine converts that array into a hash of option specs as keys and
#destinations as values. If an option spec does not have a destination, its
#destination is set to C<undef>. If hash storage is specified then the destination
#will fall back to the hash storage's appropriate key when a specific destination
#is not specified.
#
#Note that by converting to hash, 1) duplicate option specs are merged; and 2)
#order of option specs is not preserved.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$spec>* => I<array>
#
#Getopt::Long spec.
#
#
#=back
#
#Return value:  (hash)
#
#
#
#=head2 detect_getopt_long_script
#
#Usage:
#
# detect_getopt_long_script(%args) -> [$status_code, $reason, $payload, \%result_meta]
#
#Detect whether a file is a Getopt::Long-based CLI script.
#
#The criteria are:
#
#=over
#
#=item * the file must exist and readable;
#
#=item * (optional, if C<include_noexec> is false) file must have its executable mode
#bit set;
#
#=item * content must start with a shebang C<#!>;
#
#=item * either: must be perl script (shebang line contains 'perl') and must contain
#something like C<use Getopt::Long>;
#
#=back
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<filename> => I<str>
#
#Path to file to be checked.
#
#=item * B<include_noexec> => I<bool> (default: 1)
#
#Include scripts that do not have +x mode bit set.
#
#=item * B<string> => I<buf>
#
#String to be checked.
#
#
#=back
#
#Returns an enveloped result (an array).
#
#First element ($status_code) is an integer containing HTTP-like status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#($reason) is a string containing error message, or something like "OK" if status is
#200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
#element (%result_meta) is called result metadata and is optional, a hash
#that contains extra information, much like how HTTP response headers provide additional metadata.
#
#Return value:  (any)
#
#
#
#=head2 gen_getopt_long_spec_from_getopt_std_spec
#
#Usage:
#
# gen_getopt_long_spec_from_getopt_std_spec(%args) -> hash
#
#Generate Getopt::Long spec from Getopt::Std spec.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<is_getopt> => I<bool>
#
#Whether to assume spec is for getopt() or getopts().
#
#By default spec is assumed to be for getopts() instead of getopt(). This means
#that for a spec like C<abc:>, C<a> and C<b> don't take argument while C<c> does. But
#if C<is_getopt> is true, the meaning of C<:> is reversed: C<a> and C<b> take
#arguments while C<c> doesn't.
#
#=item * B<spec>* => I<str>
#
#Getopt::Std spec string.
#
#
#=back
#
#Return value:  (hash)
#
#
#
#=head2 humanize_getopt_long_opt_spec
#
#Usage:
#
# humanize_getopt_long_opt_spec( [ \%optional_named_args ] , $optspec) -> str|hash
#
#Convert L<Getopt::Long> option specification into a more human-friendly
#notation that is suitable for including in help/usage text, for example:
#
# help|h|?       ->  "--help, -h, -?"
# help|h|?       ->  "--help | -h | -?"               # if you provide 'separator'
# --foo=s        ->  "--foo=s"
# --foo=s        ->  "--foo=somelabel"                # if you provide 'value_label'
# --foo:s        ->  "--foo[=s]"
# --foo=s@       ->  "(--foo=s)+"
# --foo=s%       ->  "(--foo key=value)+"
# --foo=s%       ->  "(--foo somelabel1=somelabel2)+" # if you provide 'key_label' and 'value_label'
# --debug!       ->  "--(no)debug"
#
#It also produces POD-formatted string for use in POD documentation:
#
# --foo=s        ->  {plaintext=>"--foo=s", pod=>"B<--foo>=I<s>"}
#                                                     # if you set 'extended' to true
#
#Will die if can't parse the optspec string.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<extended> => I<bool>
#
#If set to true, will return a hash of multiple formats instead of a single plaintext format.
#
#=item * B<key_label> => I<str> (default: "key")
#
#(No description)
#
#=item * B<opt_link> => I<str>
#
#(No description)
#
#=item * B<$optspec>* => I<str>
#
#(No description)
#
#=item * B<separator> => I<str> (default: ", ")
#
#(No description)
#
#=item * B<value_label> => I<str>
#
#(No description)
#
#=item * B<value_label_link> => I<str>
#
#(No description)
#
#
#=back
#
#Return value:  (str|hash)
#
#
#
#=head2 parse_getopt_long_opt_spec
#
#Usage:
#
# parse_getopt_long_opt_spec($optspec) -> hash
#
#Parse a single Getopt::Long option specification.
#
#Examples:
#
#=over
#
#=item * Example #1:
#
# parse_getopt_long_opt_spec("help|h|?"); # -> { dash_prefix => "", opts => ["help", "h", "?"] }
#
#=item * Example #2:
#
# parse_getopt_long_opt_spec("--foo=s"); # -> { dash_prefix => "--", desttype => "", opts => ["foo"], type => "s" }
#
#=back
#
#Will produce a hash with some keys:
#
#=over
#
#=item * C<is_arg> (if true, then option specification is the special C<< E<lt>E<gt> >> for argument
#callback)
#
#=item * C<opts> (array of option names, in the order specified in the opt spec)
#
#=item * C<type> (string, type name)
#
#=item * C<desttype> (either '', or '@' or '%'),
#
#=item * C<is_neg> (true for C<--opt!>)
#
#=item * C<is_inc> (true for C<--opt+>)
#
#=item * C<min_vals> (int, usually 0 or 1)
#
#=item * C<max_vals> (int, usually 0 or 1 except for option that requires multiple
#values)
#
#=back
#
#Will return undef if it can't parse the string.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$optspec>* => I<str>
#
#(No description)
#
#
#=back
#
#Return value:  (hash)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Getopt-Long-Util>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Getopt-Long-Util>.
#
#=head1 SEE ALSO
#
#L<Getopt::Long>
#
#L<Getopt::Long::Spec>, which can also parse Getopt::Long spec into hash as well
#as transform back the hash to Getopt::Long spec. OO interface. I should've found
#this module first before writing my own C<parse_getopt_long_opt_spec()>. But at
#least currently C<parse_getopt_long_opt_spec()> is at least about 30-100+%
#faster than Getopt::Long::Spec::Parser, has a much simpler implementation (a
#single regex match), and can handle valid Getopt::Long specs that
#Getopt::Long::Spec::Parser fails to parse, e.g. C<foo|f=s@>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTOR
#
#=for stopwords Steven Haryanto
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2021, 2020, 2016, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Getopt-Long-Util>
#
#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.
#
#=cut
### Log/ger.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
##IFUNBUILT
## use strict 'subs', 'vars';
## use warnings;
##END IFUNBUILT
#
#our $re_addr = qr/\(0x([0-9a-f]+)/o;
#
#our %Levels = (
#    fatal   => 10,
#    error   => 20,
#    warn    => 30,
#    info    => 40,
#    debug   => 50,
#    trace   => 60,
#);
#
#our %Level_Aliases = (
#    off     => 0,
#    warning => 30,
#);
#
#our $Current_Level = 30;
#
#our $Caller_Depth_Offset = 0;
#
## a flag that can be used by null output to skip using formatter
#our $_outputter_is_null;
#
#our $_dumper;
#
#our %Global_Hooks;
#
## in Log/ger/Heavy.pm
## our %Default_Hooks = (
#
#our %Package_Targets; # key = package name, value = \%per_target_conf
#our %Per_Package_Hooks; # key = package name, value = { phase => hooks, ... }
#
#our %Hash_Targets; # key = hash address, value = [$hashref, \%per_target_conf]
#our %Per_Hash_Hooks; # key = hash address, value = { phase => hooks, ... }
#
#our %Object_Targets; # key = object address, value = [$obj, \%per_target_conf]
#our %Per_Object_Hooks; # key = object address, value = { phase => hooks, ... }
#
#my $sub0 = sub {0};
#my $sub1 = sub {1};
#my $default_null_routines;
#
#sub install_routines {
#    my ($target, $target_arg, $routines, $name_routines) = @_;
#
#    if ($name_routines && !defined &subname) {
#        if (eval { require Sub::Name; 1 }) {
#            *subname = \&Sub::Name::subname;
#        } else {
#            *subname = sub {};
#        }
#    }
#
#    if ($target eq 'package') {
##IFUNBUILT
##         no warnings 'redefine';
##END IFUNBUILT
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            #print "D:installing $name to package $target_arg\n";
#            *{"$target_arg\::$name"} = $code;
#            subname("$target_arg\::$name", $code) if $name_routines;
#        }
#    } elsif ($target eq 'object') {
##IFUNBUILT
##         no warnings 'redefine';
##END IFUNBUILT
#        my $pkg = ref $target_arg;
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_method\z/;
#            *{"$pkg\::$name"} = $code;
#            subname("$pkg\::$name", $code) if $name_routines;
#        }
#    } elsif ($target eq 'hash') {
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            $target_arg->{$name} = $code;
#        }
#    }
#}
#
#sub add_target {
#    my ($target_type, $target_name, $per_target_conf, $replace) = @_;
#    $replace = 1 unless defined $replace;
#
#    if ($target_type eq 'package') {
#        unless ($replace) { return if $Package_Targets{$target_name} }
#        $Package_Targets{$target_name} = $per_target_conf;
#    } elsif ($target_type eq 'object') {
#        my ($addr) = "$target_name" =~ $re_addr;
#        unless ($replace) { return if $Object_Targets{$addr} }
#        $Object_Targets{$addr} = [$target_name, $per_target_conf];
#    } elsif ($target_type eq 'hash') {
#        my ($addr) = "$target_name" =~ $re_addr;
#        unless ($replace) { return if $Hash_Targets{$addr} }
#        $Hash_Targets{$addr} = [$target_name, $per_target_conf];
#    }
#}
#
#sub _set_default_null_routines {
#    $default_null_routines ||= [
#        (map {(
#            [$sub0, "log_$_", $Levels{$_}, 'logger_sub'],
#            [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "log_is_$_", $Levels{$_}, 'level_checker_sub'],
#            [$sub0, $_, $Levels{$_}, 'logger_method'],
#            [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "is_$_", $Levels{$_}, 'level_checker_method'],
#        )} keys %Levels),
#    ];
#}
#
#sub get_logger {
#    my ($package, %per_target_conf) = @_;
#
#    my $caller = caller(0);
#    $per_target_conf{category} = $caller
#        if !defined($per_target_conf{category});
#    my $obj = []; $obj =~ $re_addr;
#    my $pkg = "Log::ger::Obj$1"; bless $obj, $pkg;
#    add_target(object => $obj, \%per_target_conf);
#    if (keys %Global_Hooks) {
#        require Log::ger::Heavy;
#        init_target(object => $obj, \%per_target_conf);
#    } else {
#        # if we haven't added any hooks etc, skip init_target() process and use
#        # this preconstructed routines as shortcut, to save startup overhead
#        _set_default_null_routines();
#        install_routines(object => $obj, $default_null_routines, 0);
#    }
#    $obj; # XXX add DESTROY to remove from list of targets
#}
#
#sub _import_to {
#    my ($package, $target_pkg, %per_target_conf) = @_;
#
#    $per_target_conf{category} = $target_pkg
#        if !defined($per_target_conf{category});
#    add_target(package => $target_pkg, \%per_target_conf);
#    if (keys %Global_Hooks) {
#        require Log::ger::Heavy;
#        init_target(package => $target_pkg, \%per_target_conf);
#    } else {
#        # if we haven't added any hooks etc, skip init_target() process and use
#        # this preconstructed routines as shortcut, to save startup overhead
#        _set_default_null_routines();
#        install_routines(package => $target_pkg, $default_null_routines, 0);
#    }
#}
#
#sub import {
#    my ($package, %per_target_conf) = @_;
#
#    my $caller = caller(0);
#    $package->_import_to($caller, %per_target_conf);
#}
#
#1;
## ABSTRACT: A lightweight, flexible logging framework
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger - A lightweight, flexible logging framework
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
#=head2 Producing logs
#
#In your module (producer):
#
# package MyModule;
#
# # this will install some logger routines. by default: log_trace, log_debug,
# # log_info, log_warn, log_error, and log_fatal. level checker routines are also
# # installed: log_is_trace, log_is_debug, and so on.
# use Log::ger;
#
# sub foo {
#     ...
#     # produce some logs. no need to configure output or level. by default
#     # output goes nowhere.
#     log_error "an error occured: %03d - %s", $errcode, $errmsg;
#     ...
#
#     # the logging routines (log_*) can automatically dump data structures
#     log_debug "http response: %s", $http;
#
#     # log_fatal does not die by default, if you want to then die() explicitly.
#     # but there are plugins that let you do this or provide log_die etc.
#     if (blah) { log_fatal "..."; die }
#
#     # use the level checker routines (log_is_*) to avoid doing unnecessary
#     # heavy calculation
#     if (log_is_trace) {
#         my $res = some_heavy_calculation();
#         log_trace "The result is %s", $res;
#     }
#
# }
# 1;
#
#=head2 Consuming logs
#
#=head3 Choosing an output
#
#In your application (consumer/listener):
#
# use MyModule;
# use Log::ger::Output 'Screen'; # configure output
# # level is by default 'warn'
# foo(); # the error message is shown, but debug/trace messages are not.
#
#=head3 Choosing multiple outputs
#
#Instead of screen, you can output to multiple outputs (including multiple
#files):
#
# use Log::ger::Output 'Composite' => (
#     outputs => {
#         Screen => {},
#         File   => [
#             {conf=>{path=>'/path/to/app.log'}},
#             ...
#         ],
#         ...
#     },
# );
#
#See L<Log::ger::Manual::Tutorial::481_Output_Composite> for more examples.
#
#There is also L<Log::ger::App> that wraps this in a simple interface so you just
#need to do:
#
# # In your application or script:
# use Log::ger::App;
# use MyModule;
#
#=head3 Choosing level
#
#One way to set level:
#
# use Log::ger::Util;
# Log::ger::Util::set_level('debug'); # be more verbose
# foo(); # the error message as well as debug message are now shown, but the trace is not
#
#There are better ways, e.g. letting users configure log level via configuration
#file or command-line option. See L<Log::ger::Manual::Tutorial::300_Level> for
#more details.
#
#=head1 DESCRIPTION
#
#Log::ger is yet another logging framework with the following features:
#
#=over
#
#=item * Separation of producers and consumers/listeners
#
#Like L<Log::Any>, this offers a very easy way for modules to produce some logs
#without having to configure anything. Configuring output, level, etc can be done
#in the application as log consumers/listeners. To read more about this, see the
#documentation of L<Log::Any> or L<Log::ger::Manual> (but nevertheless see
#L<Log::ger::Manual> on why you might prefer Log::ger to Log::Any).
#
#=item * Lightweight and fast
#
#B<Slim distribution.> No non-core dependencies, extra functionalities are
#provided in separate distributions to be pulled as needed.
#
#B<Low startup overhead.> Only ~0.5-1ms. For comparison, L<strict> ~0.2-0.5ms,
#L<warnings> ~2ms, L<Log::Any> (v0.15) ~2-3ms, Log::Any (v1.049) ~8-10ms,
#L<Log::Log4perl> ~35ms. This is measured on a 2014-2015 PC and before doing any
#output configuration. I strive to make C<use Log::ger;> statement to be roughly
#as light as C<use strict;> or C<use warnings;> so the impact of adding the
#statement is really minimal and you can just add logging without much thought to
#most of your modules. This is important to me because I want logging to be
#pervasive.
#
#To test for yourself, try e.g. with L<bencher-code>:
#
# % bencher-code 'use Log::ger' 'use Log::Any' --startup
#
#B<Fast>. Low null-/stealth-logging overhead, about 1.5x faster than Log::Any, 3x
#faster than Log4perl, 5x faster than L<Log::Fast>, ~40x faster than
#L<Log::Contextual>, and ~100x faster than L<Log::Dispatch>.
#
#For more benchmarks, see L<Bencher::Scenarios::Log::ger>.
#
#B<Conditional compilation.> There is a plugin to optimize away unneeded logging
#statements, like assertion/conditional compilation, so they have zero runtime
#performance cost. See L<Log::ger::Plugin::OptAway>.
#
#Being lightweight means the module can be used more universally, from CLI to
#long-running daemons to inside routines with tight loops.
#
#=item * Flexible
#
#B<Customizable levels and routine/method names.> Can be used in a procedural or
#OO style. Log::ger can mimic the interface of L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, or some other popular logging frameworks, to ease migration or
#adjust with your personal style.
#
#B<Per-package settings.> Each importer package can use its own format/layout,
#output. For example, a module that is migrated from Log::Any uses Log::Any-style
#logging, while another uses native Log::ger style, and yet some other uses block
#formatting like Log::Contextual. This eases code migration and teamwork. Each
#module author can preserve her own logging style, if wanted, and all the modules
#still use the same framework.
#
#B<Dynamic.> Outputs and levels can be changed anytime during run-time and logger
#routines will be updated automatically. This is useful in situation like a
#long-running server application: you can turn on tracing logs temporarily to
#debug problems, then turn them off again, without restarting your server.
#
#B<Interoperability.> There are modules to interop with Log::Any, either consume
#Log::Any logs (see L<Log::Any::Adapter::LogGer>) or produce logs to be consumed
#by Log::Any (see L<Log::ger::Output::LogAny>).
#
#B<Many output modules and plugins.> See C<Log::ger::Output::*>,
#C<Log::ger::Format::*>, C<Log::ger::Layout::*>, C<Log::ger::Plugin::*>. Writing
#an output module in Log::ger is easier than writing a Log::Any::Adapter::*.
#
#=back
#
#For more documentation, start with L<Log::ger::Manual>.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#Some other popular logging frameworks: L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, L<Log::Dispatch>, L<Log::Dispatchouli>.
#
#If you still prefer debugging using the good old C<print()>, there's
#L<Debug::Print>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Filter.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger::Filter;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#use parent qw(Log::ger::Plugin);
#
#1;
## ABSTRACT: Use a filter plugin
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Filter - Use a filter plugin
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
#To set globally:
#
# use Log::ger::Filter;
# Log::ger::Filter->set('Code', code => sub{ ... });
#
#or:
#
# use Log::ger::Filter 'Code', (code => sub { ... });
#
#To set for current package only:
#
# use Log::ger::Filter;
# Log::ger::Filter->set_for_current_package('Code', code => sub { ... });
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#L<Log::ger::Output>
#
#L<Log::ger::Plugin>
#
#L<Log::ger::Format>
#
#L<Log::ger::Layout>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Filter/Code.pm ###
#package Log::ger::Filter::Code;
#
#use strict;
#use warnings;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 1,
#} }
#
#sub get_hooks {
#    my %conf = @_;
#
#    $conf{code} or die "Please specify code";
#
#    return {
#        create_filter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#                [$conf{code}];
#            }],
#    };
#}
#
#1;
## ABSTRACT: Filter using a coderef
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Filter::Code - Filter using a coderef
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
# use Log::ger::Filter Code => (
#     code => sub { ... },
# );
#
#=head1 DESCRIPTION
#
#Mainly for testing only.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 CONFIGURATION
#
#=head2 code => coderef
#
#Required.
#
#=head1 SEE ALSO
#
#L<Log::ger>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Format.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger::Format;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#use parent qw(Log::ger::Plugin);
#
#sub _import_sets_for_current_package { 1 }
#
#1;
## ABSTRACT: Use a format plugin
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Format - Use a format plugin
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
#To set for current package only:
#
# use Log::ger::Format 'Block';
#
#or:
#
# use Log::ger::Format;
# Log::ger::Format->set_for_current_package('Block');
#
#To set globally:
#
# use Log::ger::Format;
# Log::ger::Format->set('Block');
#
#=head1 DESCRIPTION
#
#Note: Since format plugins affect log-producing code, the import syntax defaults
#to setting for current package instead of globally.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#L<Log::ger::Layout>
#
#L<Log::ger::Output>
#
#L<Log::ger::Plugin>
#
#L<Log::ger::Filter>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Format/Default.pm ###
#package Log::ger::Format::Default;
#
#use strict;
#use warnings;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 2,
#} }
#
#sub get_hooks {
#    my %conf = @_;
#
#    return {
#        create_formatter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#
#             my $formatter =
#
#                 # the default formatter is sprintf-style that dumps data
#                 # structures arguments as well as undef as '<undef>'.
#                 sub {
#                     return $_[0] if @_ < 2;
#                     my $fmt = shift;
#                     my @args;
#                     for (@_) {
#                         if (!defined($_)) {
#                             push @args, '<undef>';
#                         } elsif (ref $_) {
#                             require Log::ger::Util unless $Log::ger::_dumper;
#                             push @args, Log::ger::Util::_dump($_);
#                         } else {
#                             push @args, $_;
#                         }
#                     }
#                     # redefine is just a dummy category for perls < 5.22 which
#                     # don't have 'redundant' yet
#                     no warnings ($warnings::Bits{'redundant'} ? 'redundant' : 'redefine');
#                     sprintf $fmt, @args;
#                 };
#
#             [$formatter];
#
#
#            }],
#    };
#}
#
#1;
## ABSTRACT: Use default Log::ger formatting style
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Format::Default - Use default Log::ger formatting style
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
# use Log::ger::Format 'Default';
# use Log::ger;
#
# log_debug "Printed as is";
# # will format the log message as: Printed as is
#
# log_debug "Data for %s is %s", "budi", {foo=>'blah', bar=>undef};
# # will format the log message as: Data for budi is {bar=>undef,foo=>"blah"}
#
#=head1 DESCRIPTION
#
#This is the default Log::ger formatter, which: 1) passes the argument as-is if
#there is only a single argument; or, if there are more than one argument, 2)
#treats the arguments like sprintf(), where the first argument is the template
#and the rest are variables to be substituted to the conversions inside the
#template. In the second case, reference arguments will be dumped using
#L<Data::Dmp> or L<Data::Dumper> by default (but the dumper is configurable by
#setting C<$Log::ger::_dumper>; see for example L<Log::ger::UseDataDump> or
#L<Log::ger::UseDataDumpColor>).
#
#The same code is already included in L<Log::ger::Heavy>; this module just
#repackages it so it's more reusable.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#L<Log::ger::Format::Join>
#
#L<Log::ger>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Format/MultilevelLog.pm ###
#package Log::ger::Format::MultilevelLog;
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 2,
#} }
#
#sub get_hooks {
#    my %conf = @_;
#
#    my $sub_name    = $conf{sub_name}    || 'log';
#    my $method_name = $conf{method_name} || 'log';
#
#    return {
#        create_filter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#                my $filter = sub {
#                    my $level = Log::ger::Util::numeric_level(shift);
#                    return 0 unless $level <= $Log::ger::Current_Level;
#                    {level=>$level};
#                };
#
#                [$filter, 0, 'ml'];
#            },
#        ],
#
#        create_formatter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#                my $formatter =
#
#                 # just like the default formatter, except it accepts first
#                 # argument (level)
#                    sub {
#                        shift; # level
#                        return $_[0] if @_ < 2;
#                        my $fmt = shift;
#                        my @args;
#                        for (@_) {
#                            if (!defined($_)) {
#                                push @args, '<undef>';
#                            } elsif (ref $_) {
#                                push @args, Log::ger::Util::_dump($_);
#                            } else {
#                                push @args, $_;
#                            }
#                        }
#                        # redefine is just a dummy category for perls < 5.22
#                        # which don't have 'redundant' yet
#                        no warnings ($warnings::Bits{'redundant'} ? 'redundant' : 'redefine');
#                        sprintf $fmt, @args;
#                    };
#
#                [$formatter, 0, 'ml'];
#            },
#        ],
#
#        create_routine_names => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#                return [{
#                    logger_subs    => [[$sub_name   , undef, 'ml', undef, 'ml']],
#                    logger_methods => [[$method_name, undef, 'ml', undef, 'ml']],
#                }, $conf{exclusive}];
#            },
#        ],
#    };
#}
#
#1;
## ABSTRACT: Create a log($LEVEL, ...) subroutine/method
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Format::MultilevelLog - Create a log($LEVEL, ...) subroutine/method
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
#To use for the current package:
#
# use Log::ger::Format MultilevelLog => (
#     # sub_name => 'log_it',    # optional, defaults to 'log'
#     # method_name => 'log_it', # optional, defaults to 'log'
#     # exclusive => 1,          # optional, defaults to 0
# );
# use Log::ger;
#
# log('warn', 'This is a warning');
# log('debug', 'This is a debug, data is %s', $data);
#
# log_warn "This is also a warning"; # still available, unless you set exclusive to 1
#
#=head1 DESCRIPTION
#
#The Log::ger default is to create separate C<log_LEVEL> subroutine (or C<LEVEL>
#methods) for each level, e.g. C<log_trace> subroutine (or C<trace> method),
#C<log_warn> (or C<warn>), and so on. But sometimes you might want a log routine
#that takes $level as the first argument. That is, instead of:
#
# log_warn('blah ...');
#
#or:
#
# $log->debug('Blah: %s', $data);
#
#you prefer:
#
# log('warn', 'blah ...');
#
#or:
#
# $log->log('debug', 'Blah: %s', $data);
#
#This format plugin can create such log routine for you.
#
#Note: the multilevel log is slightly slower because of the extra argument and
#additional string level -> numeric level conversion. See benchmarks in
#L<Bencher::Scenarios::Log::ger>.
#
#Note: the individual separate C<log_LEVEL> subroutines (or C<LEVEL> methods) are
#still installed, unless you specify configuration L</exclusive> to true.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 CONFIGURATION
#
#=head2 sub_name
#
#String. Defaults to C<log>.
#
#=head2 method_name
#
#String. Defaults to C<log>.
#
#=head2 exclusive
#
#Boolean. If set to true, will block the generation of the default C<log_LEVEL>
#subroutines or C<LEVEL> methods (e.g. C<log_warn>, C<trace>, ...).
#
#=head1 SEE ALSO
#
#L<Log::ger::Format::HashArgs>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Format/None.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger::Format::None;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 2,
#} }
#
#sub get_hooks {
#    return {
#        create_formatter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#                my $formatter = sub { shift };
#                [$formatter];
#            }],
#    };
#}
#
#1;
## ABSTRACT: Perform no formatting on the message
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Format::None - Perform no formatting on the message
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
# use Log::ger::Format 'None';
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(.+)$
#
#=head1 CONFIGURATION
#
#=head1 SEE ALSO
#
#L<Log::ger>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Heavy.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger::Heavy;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
##IFUNBUILT
## use strict;
## use warnings;
##END IFUNBUILT
#
#package
#    Log::ger;
#
##IFUNBUILT
## our (
##                $re_addr,
##                %Levels,
##                %Level_Aliases,
##                $Current_Level,
##                $_outputter_is_null,
##                $_dumper,
##                %Global_Hooks,
##                %Package_Targets,
##                %Per_Package_Hooks,
##                %Hash_Targets,
##                %Per_Hash_Hooks,
##                %Object_Targets,
##                %Per_Object_Hooks,
##        );
##END IFUNBUILT
#
## key = phase, value = [ [key, prio, coderef], ... ]
#our %Default_Hooks = (
#    create_filter => [],
#
#    create_formatter => [
#        [__PACKAGE__, 90,
#         sub {
#             my %args = @_;
#
## BEGIN_BLOCK: default_formatter
#
#             my $formatter =
#
#                 # the default formatter is sprintf-style that dumps data
#                 # structures arguments as well as undef as '<undef>'.
#                 sub {
#                     return $_[0] if @_ < 2;
#                     my $fmt = shift;
#                     my @args;
#                     for (@_) {
#                         if (!defined($_)) {
#                             push @args, '<undef>';
#                         } elsif (ref $_) {
#                             require Log::ger::Util unless $Log::ger::_dumper;
#                             push @args, Log::ger::Util::_dump($_);
#                         } else {
#                             push @args, $_;
#                         }
#                     }
#                     # redefine is just a dummy category for perls < 5.22 which
#                     # don't have 'redundant' yet
#                     no warnings ($warnings::Bits{'redundant'} ? 'redundant' : 'redefine');
#                     sprintf $fmt, @args;
#                 };
#
#             [$formatter];
#
## END_BLOCK: default_formatter
#
#         }],
#    ],
#
#    create_layouter => [],
#
#    create_routine_names => [
#        [__PACKAGE__, 90,
#         # the default names are log_LEVEL() and log_is_LEVEL() for subroutine
#         # names, or LEVEL() and is_LEVEL() for method names
#         sub {
#             my %args = @_;
#
#             my $levels = [keys %Levels];
#
#             return [{
#                 logger_subs           => [map { ["log_$_", $_]    } @$levels],
#                 level_checker_subs    => [map { ["log_is_$_", $_] } @$levels],
#                 # used when installing to hash or object
#                 logger_methods        => [map { ["$_", $_]        } @$levels],
#                 level_checker_methods => [map { ["is_$_", $_]     } @$levels],
#             }, 1];
#         }],
#    ],
#
#    # old name for create_outputter, deprecated and will be removed in the
#    # future
#    create_log_routine => [],
#
#    create_outputter => [
#        [__PACKAGE__, 10,
#         # the default behavior is to create a null routine for levels that are
#         # too high than the global level ($Current_Level). since we run at high
#         # priority (10), we block typical output plugins at normal priority
#         # (50). this is a convenience so normally a plugin does not have to
#         # deal with level checking. plugins that want to do its own level
#         # checking can use a higher priority.
#         sub {
#             my %args = @_;
#             my $level = $args{level};
#             my $num_outputs = 0;
#             $num_outputs += @{ $Global_Hooks{create_log_routine} }; # old name, will be removed
#             $num_outputs += @{ $Global_Hooks{create_outputter} };
#             if ( # level indicates routine should be a null logger
#                 (defined $level && $Current_Level < $level) ||
#                     # there's only us that produces log routines (e.g. no outputs)
#                     $num_outputs == 1
#             ) {
#                 $_outputter_is_null = 1;
#                 return [sub {0}];
#             }
#             [undef]; # decline, let output plugin supply logger routines
#         }],
#    ],
#
#    # old name for create_level_checker, deprecated and will be removed in the
#    # future
#    create_is_routine => [],
#
#    create_level_checker => [
#        [__PACKAGE__, 90,
#         # the default behavior is to compare to global level. normally this
#         # behavior suffices. we run at low priority (90) so normal plugins
#         # which typically use priority 50 can override us.
#         sub {
#             my %args = @_;
#             my $level = $args{level};
#             [sub { $Current_Level >= $level }];
#         }],
#    ],
#
#    before_install_routines => [],
#
#    after_install_routines => [],
#);
#
#for my $phase (keys %Default_Hooks) {
#    $Global_Hooks{$phase} = [@{ $Default_Hooks{$phase} }];
#}
#
## if flow_control is 1, stops after the first hook that gives non-undef result.
## flow_control can also be a coderef that will be called after each hook with
## ($hook, $hook_res) and can return 1 to mean stop.
#sub run_hooks {
#    my ($phase, $hook_args, $flow_control,
#        $target_type, $target_name) = @_;
#    #print "D: running hooks for phase $phase\n";
#
#    $Global_Hooks{$phase} or die "Unknown phase '$phase'";
#    my @hooks = @{ $Global_Hooks{$phase} };
#
#    if ($target_type eq 'package') {
#        unshift @hooks, @{ $Per_Package_Hooks{$target_name}{$phase} || [] };
#    } elsif ($target_type eq 'hash') {
#        my ($addr) = "$target_name" =~ $re_addr;
#        unshift @hooks, @{ $Per_Hash_Hooks{$addr}{$phase} || [] };
#    } elsif ($target_type eq 'object') {
#        my ($addr) = "$target_name" =~ $re_addr;
#        unshift @hooks, @{ $Per_Object_Hooks{$addr}{$phase} || [] };
#    }
#
#    my $res;
#    for my $hook (sort {$a->[1] <=> $b->[1]} @hooks)  {
#        my $hook_res = $hook->[2]->(%$hook_args);
#        if (defined $hook_res->[0]) {
#            $res = $hook_res->[0];
#            #print "D:   got result from hook $hook->[0]: $res\n";
#            if (ref $flow_control eq 'CODE') {
#                last if $flow_control->($hook, $hook_res);
#            } else {
#                last if $flow_control;
#            }
#        }
#        last if $hook_res->[1];
#    }
#    return $res;
#}
#
#sub init_target {
#    my ($target_type, $target_name, $per_target_conf) = @_;
#
#    #print "D:init_target($target_type, $target_name, ...)\n";
#    my %hook_args = (
#        target_type     => $target_type,
#        target_name     => $target_name,
#        per_target_conf => $per_target_conf,
#    );
#
#    # collect only a single filter
#    my %filters;
#    run_hooks(
#        'create_filter', \%hook_args,
#        # collect filters, until a hook instructs to stop
#        sub {
#            my ($hook, $hook_res) = @_;
#            my ($filter, $flow_control, $fltname) = @$hook_res;
#            $fltname = 'default' if !defined($fltname);
#            $filters{$fltname} ||= $filter;
#            $flow_control;
#        },
#        $target_type, $target_name);
#
#    my %formatters;
#    run_hooks(
#        'create_formatter', \%hook_args,
#        # collect formatters, until a hook instructs to stop
#        sub {
#            my ($hook, $hook_res) = @_;
#            my ($formatter, $flow_control, $fmtname) = @$hook_res;
#            $fmtname = 'default' if !defined($fmtname);
#            $formatters{$fmtname} ||= $formatter;
#            $flow_control;
#        },
#        $target_type, $target_name);
#
#    # collect only a single layouter
#    my $layouter =
#        run_hooks(
#            'create_layouter', \%hook_args, 1, $target_type, $target_name);
#
#    my $routine_names = {};
#    run_hooks(
#        'create_routine_names', \%hook_args,
#        # collect routine names, until a hook instructs to stop.
#        sub {
#            my ($hook, $hook_res) = @_;
#            my ($routine_name_rec, $flow_control) = @$hook_res;
#            $routine_name_rec or return;
#            for (keys %$routine_name_rec) {
#                push @{ $routine_names->{$_} }, @{ $routine_name_rec->{$_} };
#            }
#            $flow_control;
#        },
#        $target_type, $target_name);
#
#    my @routines;
#    my $is_object = $target_type eq 'object';
#
#  CREATE_LOGGER_ROUTINES:
#    {
#        my @routine_name_recs;
#        if ($target_type eq 'package') {
#            push @routine_name_recs, @{ $routine_names->{log_subs} || [] }; # old name, will be removed
#            push @routine_name_recs, @{ $routine_names->{logger_subs} || [] };
#        } else {
#            push @routine_name_recs, @{ $routine_names->{log_methods} || [] }; # old name, will be removed
#            push @routine_name_recs, @{ $routine_names->{logger_methods} || [] };
#        }
#      NAME:
#        for my $routine_name_rec (@routine_name_recs) {
#            my ($rname, $lname, $fmtname, $rper_target_conf, $fltname)
#                = @$routine_name_rec;
#            my $lnum; $lnum = $Levels{$lname} if defined $lname;
#            $fmtname = 'default' if !defined($fmtname);
#
#            my ($output_routine, $logger);
#            $_outputter_is_null = 0;
#            local $hook_args{name} = $rname; # compat, deprecated
#            local $hook_args{routine_name} = $rname;
#            local $hook_args{level} = $lnum;
#            local $hook_args{str_level} = $lname;
#            my $outputter;
#            {
#                $outputter = run_hooks("create_outputter"  , \%hook_args, 1, $target_type, $target_name) and last;
#                $outputter = run_hooks("create_log_routine", \%hook_args, 1, $target_type, $target_name); # old name, will be removed in the future
#            }
#            die "BUG in configuration: No outputter is produced for routine name $rname" unless $outputter;
#
#            { # enclosing block
#                if ($_outputter_is_null) {
#
#                    # if outputter is a null outputter (sub {0}) we don't need
#                    # to format message, layout message, or care about the
#                    # logger routine being a subroutine/object. shortcut here
#                    # for faster init.
#
#                    $logger = $outputter;
#                    last;
#                }
#
#                my $formatter = $formatters{$fmtname};
#                my $filter    = defined($fltname) ? $filters{$fltname} : undef;
#
#                # zoom out to see vertical alignments... we have filter(x2) x
#                # formatter+layouter(x3) x OO/non-OO (x2) = 12 permutations. we
#                # create specialized subroutines for each case, for performance
#                # reason.
#                if ($filter) { if ($formatter) { if ($layouter) { if ($is_object) { $logger = sub { shift; return 0 unless my $per_msg_conf = $filter->(@_); $outputter->($rper_target_conf || $per_target_conf, $layouter->($formatter->(@_), $per_target_conf, $lnum, $lname, $per_msg_conf), $per_msg_conf) };       # has-filter has-formatter has-layouter with-oo
#                                                                  } else {          $logger = sub {        return 0 unless my $per_msg_conf = $filter->(@_); $outputter->($rper_target_conf || $per_target_conf, $layouter->($formatter->(@_), $per_target_conf, $lnum, $lname, $per_msg_conf), $per_msg_conf) }; }     # has-filter has-formatter has-layouter  not-oo
#                                                 } else {         if ($is_object) { $logger = sub { shift; return 0 unless my $per_msg_conf = $filter->(@_); $outputter->($rper_target_conf || $per_target_conf,             $formatter->(@_),                                                  $per_msg_conf) };       # has-filter has-formatter  no-layouter with-oo
#                                                                  } else {          $logger = sub {        return 0 unless my $per_msg_conf = $filter->(@_); $outputter->($rper_target_conf || $per_target_conf,             $formatter->(@_),                                                  $per_msg_conf) }; } }   # has-filter has-formatter  no-layouter  not-oo
#                               } else {                           if ($is_object) { $logger = sub { shift; return 0 unless my $per_msg_conf = $filter->(@_); $outputter->($rper_target_conf || $per_target_conf,                         \@_,                                                   $per_msg_conf) };       # has-filter  no-formatter  no-layouter with-oo
#                                                                  } else {          $logger = sub {        return 0 unless my $per_msg_conf = $filter->(@_); $outputter->($rper_target_conf || $per_target_conf,                         \@_,                                                   $per_msg_conf) }; } }   # has-filter  no-formatter  no-layouter  not-oo
#                } else {       if ($formatter) { if ($layouter) { if ($is_object) { $logger = sub { shift;                                                   $outputter->($rper_target_conf || $per_target_conf, $layouter->($formatter->(@_), $per_target_conf, $lnum, $lname               )               ) };       #  no-filter has-formatter has-layouter with-oo
#                                                                  } else {          $logger = sub {                                                          $outputter->($rper_target_conf || $per_target_conf, $layouter->($formatter->(@_), $per_target_conf, $lnum, $lname               )               ) }; }     #  no-filter has-formatter has-layouter  not-oo
#                                               } else {           if ($is_object) { $logger = sub { shift;                                                   $outputter->($rper_target_conf || $per_target_conf,             $formatter->(@_)                                                                ) };       #  no-filter has-formatter  no-layouter with-oo
#                                                                  } else {          $logger = sub {                                                          $outputter->($rper_target_conf || $per_target_conf,             $formatter->(@_)                                                                ) }; } }   #  no-filter has-formatter  no-layouter  not-oo
#                               } else {                           if ($is_object) { $logger = sub { shift;                                                   $outputter->($rper_target_conf || $per_target_conf,                         \@_                                                                 ) };       #  no-filter  no-formatter  no-layouter with-oo
#                                                                  } else {          $logger = sub {                                                          $outputter->($rper_target_conf || $per_target_conf,                         \@_                                                                 ) }; } } } #  no-filter  no-formatter  no-layouter  not-oo
#            } # enclosing block
#          L1:
#            my $rtype = $is_object ? 'logger_method' : 'logger_sub';
#            push @routines, [$logger, $rname, $lnum, $rtype, $rper_target_conf||$per_target_conf];
#        }
#    }
#
#  CREATE_LEVEL_CHECKER_ROUTINES:
#    {
#        my @routine_name_recs;
#        my $type;
#        if ($target_type eq 'package') {
#            push @routine_name_recs, @{ $routine_names->{is_subs} || [] }; # old name, will be removed
#            push @routine_name_recs, @{ $routine_names->{level_checker_subs} || [] };
#            $type = 'level_checker_sub';
#        } else {
#            push @routine_name_recs, @{ $routine_names->{is_methods} || [] }; # old name, will be removed
#            push @routine_name_recs, @{ $routine_names->{level_checker_methods} || [] };
#            $type = 'level_checker_method';
#        }
#        for my $routine_name_rec (@routine_name_recs) {
#            my ($rname, $lname) = @$routine_name_rec;
#            my $lnum = $Levels{$lname};
#
#            local $hook_args{name} = $rname;
#            local $hook_args{level} = $lnum;
#            local $hook_args{str_level} = $lname;
#
#            my $code_is;
#            {
#                $code_is = run_hooks('create_is_routine'   , \%hook_args, 1, $target_type, $target_name) and last; # old name, will be removed
#                $code_is = run_hooks('create_level_checker', \%hook_args, 1, $target_type, $target_name);
#            }
#            die "BUG in configuration: No level_checker routine is produced for routine name $rname" unless $code_is;
#
#            push @routines, [$code_is, $rname, $lnum, $type, $per_target_conf];
#        }
#    }
#
#    {
#        local $hook_args{routines} = \@routines;
#        local $hook_args{filters} = \%filters;
#        local $hook_args{formatters} = \%formatters;
#        local $hook_args{layouter} = $layouter;
#        run_hooks('before_install_routines', \%hook_args, 0,
#                  $target_type, $target_name);
#    }
#
#    install_routines($target_type, $target_name, \@routines, 1);
#
#    {
#        local $hook_args{routines} = \@routines;
#        run_hooks('after_install_routines', \%hook_args, 0,
#                  $target_type, $target_name);
#    }
#}
#
#1;
## ABSTRACT: The bulk of the implementation of Log::ger
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Heavy - The bulk of the implementation of Log::ger
#
#=head1 VERSION
#
#version 0.041
#
#=head1 DESCRIPTION
#
#This module contains the bulk of the implementation of Log::ger, to keep
#Log::ger superslim.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Layout.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger::Layout;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#use parent qw(Log::ger::Plugin);
#
## we only use one layout, so set() should replace all hooks from previously set
## plugin package
#sub _replace_package_regex { qr/\ALog::ger::Layout::/ }
#
#1;
## ABSTRACT: Use a layout plugin
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Layout - Use a layout plugin
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
#To set globally:
#
# use Log::ger::Layout;
# Log::ger::Layout->set('Pattern');
#
#or:
#
# use Log::ger::Layout 'Pattern';
#
#To set for current package only:
#
# use Log::ger::Layout;
# Log::ger::Layout->set_for_current_package('Pattern');
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#L<Log::ger::Output>
#
#L<Log::ger::Plugin>
#
#L<Log::ger::Format>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Output.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger::Output;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#use parent 'Log::ger::Plugin';
#
## we only use one output, so set() should replace all hooks from previously set
## plugin package
#sub _replace_package_regex { qr/\ALog::ger::Output::/ }
#
#1;
## ABSTRACT: Set logging output
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Output - Set logging output
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
#To set globally:
#
# use Log::ger::Output;
# Log::ger::Output->set(Screen => (
#     use_color => 1,
#     ...
# );
#
#or:
#
# use Log::ger::Output 'Screen', (
#     use_color=>1,
#     ...
# );
#
#To set for current package only:
#
# use Log::ger::Output;
# Log::ger::Output->set_for_current_package(Screen => (
#     use_color => 1,
#     ...
# );
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#L<Log::ger::Format>
#
#L<Log::ger::Layout>
#
#L<Log::ger::Plugin>
#
#L<Log::ger::Filter>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Output/Array.pm ###
#package Log::ger::Output::Array;
#
#use strict;
#use warnings;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 2,
#} }
#
#sub get_hooks {
#    my %plugin_conf = @_;
#
#    $plugin_conf{array} or die "Please specify array";
#
#    return {
#        create_outputter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#                my $outputter = sub {
#                    my ($per_target_conf, $msg, $per_msg_conf) = @_;
#                    push @{$plugin_conf{array}}, $msg;
#                };
#                [$outputter];
#            }],
#    };
#}
#
#1;
## ABSTRACT: Log to array
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Output::Array - Log to array
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
# use Log::ger::Output Array => (
#     array         => $ary,
# );
#
#=head1 DESCRIPTION
#
#Mainly for testing only.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 CONFIGURATION
#
#=head2 array => arrayref
#
#Required.
#
#=head1 SEE ALSO
#
#L<Log::ger>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Output/Null.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger::Output::Null;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 2,
#} }
#
#sub get_hooks {
#    return {
#        create_outputter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#                $Log::ger::_outputter_is_null = 1;
#                my $outputter = sub {0};
#                [$outputter];
#            }],
#    };
#}
#
#1;
## ABSTRACT: Null output
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Output::Null - Null output
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
# use Log::ger;
# use Log::ger::Output 'Null';
#
# log_warn "blah...";
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(.+)$
#
#=head1 CONFIGURATION
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Output/String.pm ###
#package Log::ger::Output::String;
#
#use strict;
#use warnings;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 2,
#} }
#
#sub get_hooks {
#    my %plugin_conf = @_;
#
#    $plugin_conf{string} or die "Please specify string";
#
#    my $formatter = $plugin_conf{formatter};
#    my $append_newline = $plugin_conf{append_newline};
#    $append_newline = 1 unless defined $append_newline;
#
#    return {
#        create_outputter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#                my $level = $hook_args{level};
#                my $outputter = sub {
#                    my ($per_target_conf, $msg, $per_msg_conf) = @_;
#                    if ($formatter) {
#                        $msg = $formatter->($msg);
#                    }
#                    ${ $plugin_conf{string} } .= $msg;
#                    ${ $plugin_conf{string} } .= "\n"
#                        unless !$append_newline || $msg =~ /\R\z/;
#                };
#                [$outputter];
#            }],
#    };
#}
#
#1;
## ABSTRACT: Set output to a string
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Output::String - Set output to a string
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
# BEGIN { our $str }
# use Log::ger::Output 'String' => (
#     string => \$str,
#     # append_newline => 0, # default is true, to mimic Log::ger::Output::Screen
# );
# use Log::ger;
#
# log_warn "warn ...";
# log_error "debug ...";
#
#C<$str> will contain "warn ...\n".
#
#=head1 DESCRIPTION
#
#For testing only.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 CONFIGURATION
#
#=head2 string => scalarref
#
#Required.
#
#=head2 formatter => coderef
#
#Optional.
#
#=head2 append_newline => bool (default: 1)
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Plugin.pm ###
#package Log::ger::Plugin;
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub set {
#    my $pkg = shift;
#
#    my %args;
#    if (ref $_[0] eq 'HASH') {
#        %args = %{shift()};
#    } else {
#        %args = (name => shift, conf => {@_});
#    }
#
#    $args{prefix} ||= $pkg . '::';
#    $args{replace_package_regex} = $pkg->_replace_package_regex;
#    Log::ger::Util::set_plugin(%args);
#}
#
#sub set_for_current_package {
#    my $pkg = shift;
#
#    my %args;
#    if (ref $_[0] eq 'HASH') {
#        %args = %{shift()};
#    } else {
#        %args = (name => shift, conf => {@_});
#    }
#
#    my $caller = caller(0);
#    $args{target} = 'package';
#    $args{target_arg} = $caller;
#
#    set($pkg, \%args);
#}
#
#sub _import_sets_for_current_package { 0 }
#
#sub _replace_package_regex { undef }
#
#sub import {
#    if (@_ > 1) {
#        if ($_[0]->_import_sets_for_current_package) {
#            goto &set_for_current_package;
#        } else {
#            goto &set;
#        }
#    }
#}
#
#1;
## ABSTRACT: Use a plugin
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Plugin - Use a plugin
#
#=head1 VERSION
#
#version 0.041
#
#=head1 SYNOPSIS
#
#To set globally:
#
# use Log::ger::Plugin;
# Log::ger::Plugin->set('OptAway');
#
#or:
#
# use Log::ger::Plugin 'OptAway';
#
#To set for current package only:
#
# use Log::ger::Plugin;
# Log::ger::Plugin->set_for_current_package('OptAway');
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#L<Log::ger::Format>
#
#L<Log::ger::Layout>
#
#L<Log::ger::Output>
#
#L<Log::ger::Filter>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Plugin/MultilevelLog.pm ###
#package Log::ger::Plugin::MultilevelLog;
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#sub meta { +{
#    v => 2,
#} }
#
#sub get_hooks {
#    my %conf = @_;
#
#    my $sub_name    = $conf{sub_name}    || 'log';
#    my $method_name = $conf{method_name} || 'log';
#
#    return {
#        create_filter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#                my $filter = sub {
#                    my $level = Log::ger::Util::numeric_level(shift);
#                    return 0 unless $level <= $Log::ger::Current_Level;
#                    {level=>$level};
#                };
#
#                [$filter, 0, 'ml'];
#            },
#        ],
#
#        create_formatter => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#
#                my $formatter =
#
#                 # just like the default formatter, except it accepts first
#                 # argument (level)
#                    sub {
#                        shift; # level
#                        return $_[0] if @_ < 2;
#                        my $fmt = shift;
#                        my @args;
#                        for (@_) {
#                            if (!defined($_)) {
#                                push @args, '<undef>';
#                            } elsif (ref $_) {
#                                push @args, Log::ger::Util::_dump($_);
#                            } else {
#                                push @args, $_;
#                            }
#                        }
#                        # redefine is just a dummy category for perls < 5.22
#                        # which don't have 'redundant' yet
#                        no warnings ($warnings::Bits{'redundant'} ? 'redundant' : 'redefine');
#                        sprintf $fmt, @args;
#                    };
#
#                [$formatter, 0, 'ml'];
#            },
#        ],
#
#        create_routine_names => [
#            __PACKAGE__, # key
#            50,          # priority
#            sub {        # hook
#                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
#                return [{
#                    logger_subs    => [[$sub_name   , undef, 'ml', undef, 'ml']],
#                    logger_methods => [[$method_name, undef, 'ml', undef, 'ml']],
#                }, $conf{exclusive}];
#            },
#        ],
#    };
#}
#
#1;
## ABSTRACT: (DEPRECATED) Old name for Log::ger::Format::MultilevelLog
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Plugin::MultilevelLog - (DEPRECATED) Old name for Log::ger::Format::MultilevelLog
#
#=head1 VERSION
#
#version 0.041
#
#=head1 DESCRIPTION
#
#This plugin has been renamed to L<Log::ger::Format::MultilevelLog> in 0.038. The
#old name is provided for backward compatibility for now, but is deprecated and
#will be removed in the future. Please switch to the new name and be aware that
#format plugins only affect the current package.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#L<Log::ger::Format::MultilevelLog>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Log/ger/Util.pm ###
#package Log::ger::Util;
#
#use strict;
#use warnings;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # VERSION
#
#require Log::ger;
#require Log::ger::Heavy;
#
#sub _dump {
#    unless ($Log::ger::_dumper) {
#        eval {
#            no warnings 'once';
#            require Data::Dmp;
#            $Data::Dmp::OPT_REMOVE_PRAGMAS = 1;
#            1;
#        };
#        if ($@) {
#            no warnings 'once';
#            require Data::Dumper;
#            $Log::ger::_dumper = sub {
#                local $Data::Dumper::Terse = 1;
#                local $Data::Dumper::Indent = 0;
#                local $Data::Dumper::Useqq = 1;
#                local $Data::Dumper::Deparse = 1;
#                local $Data::Dumper::Quotekeys = 0;
#                local $Data::Dumper::Sortkeys = 1;
#                local $Data::Dumper::Trailingcomma = 1;
#                local $Data::Dumper::Useqq = 1; # to show "\034", possible bug in Data::Dumper
#                Data::Dumper::Dumper($_[0]);
#            };
#        } else {
#            $Log::ger::_dumper = sub { Data::Dmp::dmp($_[0]) };
#        }
#    }
#    $Log::ger::_dumper->($_[0]);
#}
#
#sub numeric_level {
#    my $level = shift;
#    return $level if $level =~ /\A\d+\z/;
#    return $Log::ger::Levels{$level}
#        if defined $Log::ger::Levels{$level};
#    return $Log::ger::Level_Aliases{$level}
#        if defined $Log::ger::Level_Aliases{$level};
#    die "Unknown level '$level'";
#}
#
#sub string_level {
#    my $level = shift;
#    return $level if defined $Log::ger::Levels{$level};
#    $level = $Log::ger::Level_Aliases{$level}
#        if defined $Log::ger::Level_Aliases{$level};
#    for (keys %Log::ger::Levels) {
#        my $v = $Log::ger::Levels{$_};
#        return $_ if $v == $level;
#    }
#    die "Unknown level '$level'";
#}
#
#sub set_level {
#    no warnings 'once';
#    $Log::ger::Current_Level = numeric_level(shift);
#    reinit_all_targets();
#}
#
#sub _action_on_hooks {
#    no warnings 'once';
#
#    my ($action, $target_type, $target_name, $phase) = splice @_, 0, 4;
#
#    my $hooks = $Log::ger::Global_Hooks{$phase} or die "Unknown phase '$phase'";
#    if ($target_type eq 'package') {
#        $hooks = ($Log::ger::Per_Package_Hooks{$target_name}{$phase} ||= []);
#    } elsif ($target_type eq 'object') {
#        my ($addr) = $target_name =~ $Log::ger::re_addr;
#        $hooks = ($Log::ger::Per_Object_Hooks{$addr}{$phase} ||= []);
#    } elsif ($target_type eq 'hash') {
#        my ($addr) = $target_name =~ $Log::ger::re_addr;
#        $hooks = ($Log::ger::Per_Hash_Hooks{$addr}{$phase} ||= []);
#    }
#
#    if ($action eq 'add') {
#        my $hook = shift;
#        # XXX remove duplicate key
#        # my $key = $hook->[0];
#        unshift @$hooks, $hook;
#    } elsif ($action eq 'remove') {
#        my $code = shift;
#        for my $i (reverse 0..$#{$hooks}) {
#            splice @$hooks, $i, 1 if $code->($hooks->[$i]);
#        }
#    } elsif ($action eq 'reset') {
#        my $saved = [@$hooks];
#        splice @$hooks, 0, scalar(@$hooks),
#            @{ $Log::ger::Default_Hooks{$phase} };
#        return $saved;
#    } elsif ($action eq 'empty') {
#        my $saved = [@$hooks];
#        splice @$hooks, 0;
#        return $saved;
#    } elsif ($action eq 'save') {
#        return [@$hooks];
#    } elsif ($action eq 'restore') {
#        my $saved = shift;
#        splice @$hooks, 0, scalar(@$hooks), @$saved;
#        return $saved;
#    }
#}
#
#sub add_hook {
#    my ($phase, $hook) = @_;
#    _action_on_hooks('add', '', undef, $phase, $hook);
#}
#
#sub add_per_target_hook {
#    my ($target_type, $target_name, $phase, $hook) = @_;
#    _action_on_hooks('add', $target_type, $target_name, $phase, $hook);
#}
#
#sub remove_hook {
#    my ($phase, $code) = @_;
#    _action_on_hooks('remove', '', undef, $phase, $code);
#}
#
#sub remove_per_target_hook {
#    my ($target_type, $target_name, $phase, $code) = @_;
#    _action_on_hooks('remove', $target_type, $target_name, $phase, $code);
#}
#
#sub reset_hooks {
#    my ($phase) = @_;
#    _action_on_hooks('reset', '', undef, $phase);
#}
#
#sub reset_per_target_hooks {
#    my ($target_type, $target_name, $phase) = @_;
#    _action_on_hooks('reset', $target_type, $target_name, $phase);
#}
#
#sub empty_hooks {
#    my ($phase) = @_;
#    _action_on_hooks('empty', '', undef, $phase);
#}
#
#sub empty_per_target_hooks {
#    my ($target_type, $target_name, $phase) = @_;
#    _action_on_hooks('empty', $target_type, $target_name, $phase);
#}
#
#sub save_hooks {
#    my ($phase) = @_;
#    _action_on_hooks('save', '', undef, $phase);
#}
#
#sub save_per_target_hooks {
#    my ($target_type, $target_name, $phase) = @_;
#    _action_on_hooks('save', $target_type, $target_name, $phase);
#}
#
#sub restore_hooks {
#    my ($phase, $saved) = @_;
#    _action_on_hooks('restore', '', undef, $phase, $saved);
#}
#
#sub restore_per_target_hooks {
#    my ($target_type, $target_name, $phase, $saved) = @_;
#    _action_on_hooks('restore', $target_type, $target_name, $phase, $saved);
#}
#
#sub reinit_target {
#    my ($target_type, $target_name) = @_;
#
#    # adds target if not already exists
#    Log::ger::add_target($target_type, $target_name, {}, 0);
#
#    if ($target_type eq 'package') {
#        my $per_target_conf = $Log::ger::Package_Targets{$target_name};
#        Log::ger::init_target(package => $target_name, $per_target_conf);
#    } elsif ($target_type eq 'object') {
#        my ($obj_addr) = $target_name =~ $Log::ger::re_addr
#            or die "Invalid object '$target_name': not a reference";
#        my $v = $Log::ger::Object_Targets{$obj_addr}
#            or die "Unknown object target '$target_name'";
#        Log::ger::init_target(object => $v->[0], $v->[1]);
#    } elsif ($target_type eq 'hash') {
#        my ($hash_addr) = $target_name =~ $Log::ger::re_addr
#            or die "Invalid hashref '$target_name': not a reference";
#        my $v = $Log::ger::Hash_Targets{$hash_addr}
#            or die "Unknown hash target '$target_name'";
#        Log::ger::init_target(hash => $v->[0], $v->[1]);
#    } else {
#        die "Unknown target type '$target_type'";
#    }
#}
#
#sub reinit_all_targets {
#    for my $pkg (keys %Log::ger::Package_Targets) {
#        #print "D:reinit package $pkg\n";
#        Log::ger::init_target(
#            package => $pkg, $Log::ger::Package_Targets{$pkg});
#    }
#    for my $k (keys %Log::ger::Object_Targets) {
#        my ($obj, $per_target_conf) = @{ $Log::ger::Object_Targets{$k} };
#        Log::ger::init_target(object => $obj, $per_target_conf);
#    }
#    for my $k (keys %Log::ger::Hash_Targets) {
#        my ($hash, $per_target_conf) = @{ $Log::ger::Hash_Targets{$k} };
#        Log::ger::init_target(hash => $hash, $per_target_conf);
#    }
#}
#
#sub set_plugin {
#    my %args = @_;
#
#    my $hooks;
#    if ($args{hooks}) {
#        $hooks = $args{hooks};
#    } else {
#        no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
#        my $prefix = $args{prefix} || 'Log::ger::Plugin::';
#        my $mod = $args{name};
#        $mod = $prefix . $mod unless index($mod, $prefix) == 0;
#        (my $mod_pm = "$mod.pm") =~ s!::!/!g;
#        require $mod_pm;
#        my $meta  = $mod->can("meta") ? $mod->meta : {v=>1};
#        my $v     = $meta->{v} || 1;
#
#        # history of v bumping:
#        #
#        # - v increased from 1 to 2 in Log::ger v0.037 to force all plugins that
#        #   were not compatible with Log::ger 0.032 (removed
#        #   create_logml_routine phase) to be upgraded.
#
#        unless ($v == 2) {
#            die "Plugin '$mod' (version ".(${"$mod\::VERSION"} || "dev").")".
#                " follows meta version $v but Log::ger (version ".
#                (${__PACKAGE__."::VERSION"} || "dev").
#                ") (>0.032) requires meta version 2, ".
#                "please upgrade the plugin first";
#        }
#        $hooks = &{"$mod\::get_hooks"}(%{ $args{conf} || {} });
#    }
#
#    {
#        last unless $args{replace_package_regex};
#        my $all_hooks;
#        if (!$args{target}) {
#            $all_hooks = \%Log::ger::Global_Hooks;
#        } elsif ($args{target} eq 'package') {
#            $all_hooks = $Log::ger::Per_Package_Hooks{ $args{target_arg} };
#        } elsif ($args{target} eq 'object') {
#            my ($addr) = $args{target_arg} =~ $Log::ger::re_addr;
#            $all_hooks = $Log::ger::Per_Object_Hooks{$addr};
#        } elsif ($args{target} eq 'hash') {
#            my ($addr) = $args{target_arg} =~ $Log::ger::re_addr;
#            $all_hooks = $Log::ger::Per_Hash_Hooks{$addr};
#        }
#        last unless $all_hooks;
#        for my $phase (keys %$all_hooks) {
#            my $hooks = $all_hooks->{$phase};
#            for my $i (reverse 0..$#{$hooks}) {
#                splice @$hooks, $i, 1
#                    if $hooks->[$i][0] =~ $args{replace_package_regex};
#            }
#        }
#    }
#
#    for my $phase (keys %$hooks) {
#        my $hook = $hooks->{$phase};
#        if (defined $args{target}) {
#            add_per_target_hook(
#                $args{target}, $args{target_arg}, $phase, $hook);
#        } else {
#            add_hook($phase, $hook);
#        }
#    }
#
#    my $reinit = $args{reinit};
#    $reinit = 1 unless defined $reinit;
#    if ($reinit) {
#        if (defined $args{target}) {
#            reinit_target($args{target}, $args{target_arg});
#        } else {
#            reinit_all_targets();
#        }
#    }
#}
#
#1;
## ABSTRACT: Utility routines for Log::ger
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger::Util - Utility routines for Log::ger
#
#=head1 VERSION
#
#version 0.041
#
#=head1 DESCRIPTION
#
#This package is created to keep Log::ger as minimalist as possible.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2022, 2020, 2019, 2018, 2017 by perlancar <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
### Module/Installed/Tiny.pm ###
#package Module::Installed::Tiny;
#
#use strict;
#use warnings;
#
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-08-22'; # DATE
#our $DIST = 'Module-Installed-Tiny'; # DIST
#our $VERSION = '0.011'; # VERSION
#
#our @EXPORT_OK = qw(module_installed module_source);
#
#our $SEPARATOR;
#BEGIN {
#    if ($^O =~ /^(dos|os2)/i) {
#        $SEPARATOR = '\\';
#    } elsif ($^O =~ /^MacOS/i) {
#        $SEPARATOR = ':';
#    } else {
#        $SEPARATOR = '/';
#    }
#}
#
#sub _parse_name {
#    my $name = shift;
#
#    my ($name_mod, $name_pm, $name_path);
#    # name_mod is Foo::Bar form, name_pm is Foo/Bar.pm form, name_path is
#    # Foo/Bar.pm or Foo\Bar.pm (uses native path separator), name_path_prefix is
#    # Foo/Bar.
#
#    if ($name =~ m!/|\.pm\z!) {
#        # assume it's name_pm form
#        $name_pm = $name;
#        $name_mod = $name;    $name_mod =~ s/\.pm\z//; $name_mod =~ s!/!::!g;
#        $name_path = $name_pm; $name_path =~ s!/!$SEPARATOR!g if $SEPARATOR ne '/';
#    } elsif ($SEPARATOR ne '/' && $name =~ m!\Q$SEPARATOR!) {
#        # assume it's name_path form
#        $name_path = $name;
#        ($name_pm = $name_path) =~ s!\Q$SEPARATOR!/!g;
#        $name_mod = $name_pm; $name_mod =~ s/\.pm\z//; $name_mod =~ s!/!::!g;
#    } else {
#        # assume it's name_mod form
#        $name_mod = $name;
#        ($name_pm  = "$name_mod.pm") =~ s!::!/!g;
#        $name_path = $name_pm; $name_path =~ s!/!$SEPARATOR!g if $SEPARATOR ne '/';
#    }
#
#    ($name_mod, $name_pm, $name_path);
#}
#
#sub module_source {
#    my ($name, $opts) = @_;
#
#    $opts //= {};
#    $opts->{die} = 1 unless defined $opts->{die};
#
#    my ($name_mod, $name_pm, $name_path) = _parse_name($name);
#
#    my $index = -1;
#    my @res;
#  ENTRY:
#    for my $entry (@INC) {
#        $index++;
#        next unless defined $entry;
#        my $ref = ref($entry);
#        my ($is_hook, @hook_res);
#        if ($ref eq 'ARRAY') {
#            $is_hook++;
#            eval { @hook_res = $entry->[0]->($entry, $name_pm) };
#            if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
#        } elsif (UNIVERSAL::can($entry, 'INC')) {
#            $is_hook++;
#            eval { @hook_res = $entry->INC($name_pm) };
#            if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
#        } elsif ($ref eq 'CODE') {
#            $is_hook++;
#            eval { @hook_res = $entry->($entry, $name_pm) };
#            if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
#        } else {
#            my $path = "$entry$SEPARATOR$name_path";
#            if (-f $path) {
#                my $fh;
#                unless (open $fh, "<", $path) {
#                    if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $path: $! (\@INC contains ".join(" ", @INC).")" } else { return }
#                }
#                local $/;
#                my $res = wantarray ? [scalar <$fh>, $path, $entry, $index, $name_mod, $name_pm, $name_path] : scalar <$fh>;
#                if ($opts->{all}) { push @res, $res } else { return wantarray ? @$res : $res }
#            } elsif ($opts->{find_prefix}) {
#                $path =~ s/\.pm\z//;
#                if (-d $path) {
#                    my $res = wantarray ? [undef, $path, $entry, $index, $name_mod, $name_pm, $name_path] : \$path;
#                    if ($opts->{all}) { push @res, $res } else { return wantarray ? @$res : $res }
#                }
#            }
#        }
#
#        if ($is_hook) {
#            next unless @hook_res;
#            my ($src, $fh, $code);
#            eval {
#                my $prepend_ref; $prepend_ref = shift @hook_res if ref($hook_res[0]) eq 'SCALAR';
#                $fh                           = shift @hook_res if ref($hook_res[0]) eq 'GLOB';
#                $code                         = shift @hook_res if ref($hook_res[0]) eq 'CODE';
#                my $code_state ; $code_state  = shift @hook_res if @hook_res;
#                if ($fh) {
#                    $src = "";
#                    local $_;
#                    while (!eof($fh)) {
#                        $_ = <$fh>;
#                        if ($code) {
#                            $code->($code, $code_state);
#                        }
#                        $src .= $_;
#                    }
#                    $src = $$prepend_ref . $src if $prepend_ref;
#                } elsif ($code) {
#                    $src = "";
#                    local $_;
#                    while ($code->($code, $code_state)) {
#                        $src .= $_;
#                    }
#                    $src = $$prepend_ref . $src if $prepend_ref;
#                }
#            }; # eval
#            if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: ".($fh || $code).": $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
#            my $res = wantarray ? [$src, undef, $entry, $index, $name_mod, $name_pm, $name_path] : $src;
#            if ($opts->{all}) { push @res, $res } else { return wantarray ? @$res : $res }
#        } # if $is_hook
#    }
#
#    if (@res) {
#        return wantarray ? @res : \@res;
#    } else {
#        if ($opts->{die}) {
#            die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module) (\@INC contains ".join(" ", @INC).")";
#        } else {
#            return;
#        }
#    }
#}
#
#sub module_installed {
#    my ($name, $opts) = @_;
#
#    # convert Foo::Bar -> Foo/Bar.pm
#    my ($name_mod, $name_pm, $name_path) = _parse_name($name);
#
#    return 1 if exists $INC{$name_pm};
#
#    my $res = module_source($name, {%{ $opts || {}}, die=>0});
#    defined($res) ? 1:0;
#}
#
#1;
## ABSTRACT: Check if a module is installed, with as little code as possible
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Module::Installed::Tiny - Check if a module is installed, with as little code as possible
#
#=head1 VERSION
#
#This document describes version 0.011 of Module::Installed::Tiny (from Perl distribution Module-Installed-Tiny), released on 2022-08-22.
#
#=head1 SYNOPSIS
#
# use Module::Installed::Tiny qw(module_installed module_source);
#
# # check if a module is available
# if (module_installed "Foo::Bar") {
#     # Foo::Bar is available
# } elsif (module_installed "Foo/Baz.pm") {
#     # Foo::Baz is available
# }
#
# # get a module's source code, dies on failure
# my $src = module_source("Foo/Baz.pm");
#
#=head1 DESCRIPTION
#
#To check if a module is installed (available), generally the simplest way is to
#try to C<require()> it:
#
# if (eval { require Foo::Bar; 1 }) {
#     # Foo::Bar is available
# }
# # or
# my $mod_pm = "Foo/Bar.pm";
# if (eval { require $mod_pm; 1 }) {
#     # Foo::Bar is available
# }
#
#However, this actually loads the module. There are some cases where this is not
#desirable: 1) we have to check a lot of modules (actually loading the modules
#will take a lot of CPU time and memory; 2) some of the modules conflict with one
#another and cannot all be loaded; 3) the module is OS specific and might not
#load under another OS; 4) we simply do not want to execute the module, for
#security or other reasons.
#
#C<Module::Installed::Tiny> provides a routine C<module_installed()> which works
#like Perl's C<require> but does not actually load the module.
#
#This module does not require any other module except L<Exporter>.
#
#=head1 FUNCTIONS
#
#=head2 module_source
#
#Usage:
#
# module_source($name [ , \%opts ]) => str | list
#
#Return module's source code, without actually loading/executing it. Module
#source 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.
#
#Die on failure (e.g. module named C<$name> not found in C<@INC> or module source
#file cannot be read) with the same/similar message as Perl's C<require()>:
#
# Can't locate Foo/Bar.pm (you may need to install the Foo::Bar module) ...
#
#Module C<$name> can be in the form of C<Foo::Bar>, C<Foo/Bar.pm> or
#C<Foo\Bar.pm> (on Windows).
#
#In list context, will return a record of information:
#
# #   [0]   [1]    [2]     [3]     [4]        [5]       [6]
# my ($src, $path, $entry, $index, $name_mod, $name_pm, $name_path) = module_source($name);
#
#where:
#
#=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?
#
#Call the L</module_source> function in list context, where you will get more
#information including the entry. See the function documentation for more
#details.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Module-Installed-Tiny>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Module-Installed-Tiny>.
#
#=head1 SEE ALSO
#
#L<Module::Load::Conditional> provides C<check_install> which also does what
#C<module_installed> does, plus can check module version. It also has a couple
#other knobs to customize its behavior. It's less tiny than
#Module::Installed::Tiny though.
#
#L<Module::Path> and L<Module::Path::More>. These modules can also be used to
#check if a module on the filesystem is available. They do not handle require
#hooks, nor do they actually check that the module file is readable.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2021, 2020, 2016 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Installed-Tiny>
#
#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.
#
#=cut
### Perinci/Sub/Complete.pm ###
#package Perinci::Sub::Complete;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Complete::Common qw(:all);
#use Complete::Sah;
#use Complete::Util qw(hashify_answer complete_array_elem complete_hash_key combine_answers modify_answer);
#use Exporter 'import';
#use Perinci::Sub::Util qw(gen_modified_sub);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-09-02'; # DATE
#our $DIST = 'Perinci-Sub-Complete'; # DIST
#our $VERSION = '0.946'; # VERSION
#
#our @EXPORT_OK = qw(
#                       complete_from_schema
#                       complete_arg_val
#                       complete_arg_index
#                       complete_arg_elem
#                       complete_cli_arg
#               );
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using Rinci metadata',
#};
#
#my %common_args_riap = (
#    riap_client => {
#        summary => 'Optional, to perform complete_arg_val to the server',
#        schema  => 'obj*',
#        description => <<'_',
#
#When the argument spec in the Rinci metadata contains `completion` key, this
#means there is custom completion code for that argument. However, if retrieved
#from a remote server, sometimes the `completion` key no longer contains the code
#(it has been cleansed into a string). Moreover, the completion code needs to run
#on the server.
#
#If supplied this argument and te `riap_server_url` argument, the function will
#try to request to the server (via Riap request `complete_arg_val`). Otherwise,
#the function will just give up/decline completing.
#
#_
#        },
#    riap_server_url => {
#        summary => 'Optional, to perform complete_arg_val to the server',
#        schema  => 'str*',
#        description => <<'_',
#
#See the `riap_client` argument.
#
#_
#    },
#    riap_uri => {
#        summary => 'Optional, to perform complete_arg_val to the server',
#        schema  => 'str*',
#        description => <<'_',
#
#See the `riap_client` argument.
#
#_
#    },
#);
#
## backward compatibility, will be removed in the future
#*complete_from_schema = \&Complete::Sah::complete_from_schema;
#$SPEC{complete_from_schema} = $Complete::Sah::SPEC{complete_from_schema};
#
#$SPEC{complete_arg_val} = {
#    v => 1.1,
#    summary => 'Given argument name and function metadata, complete value',
#    description => <<'_',
#
#Will attempt to complete using the completion routine specified in the argument
#specification (the `completion` property, or in the case of `complete_arg_elem`
#function, the `element_completion` property), or if that is not specified, from
#argument's schema using `complete_from_schema`.
#
#Completion routine will get `%args`, with the following keys:
#
#* `word` (str, the word to be completed)
#* `arg` (str, the argument name which value is currently being completed)
#* `index (int, only for the `complete_arg_elem` function, the index in the
#   argument array that is currently being completed, starts from 0)
#* `args` (hash, the argument hash to the function, so far)
#
#as well as extra keys from `extras` (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#<pm:Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata, must be normalized',
#            schema => 'hash*',
#            req => 1,
#        },
#        arg => {
#            summary => 'Argument name',
#            schema => 'str*',
#            req => 1,
#        },
#        word => {
#            summary => 'Word to be completed',
#            schema => ['str*', default => ''],
#        },
#        args => {
#            summary => 'Collected arguments so far, '.
#                'will be passed to completion routines',
#            schema  => 'hash',
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array', # XXX of => str*
#    },
#};
#sub complete_arg_val {
#    my %args = @_;
#
#    log_trace("[comp][periscomp] entering complete_arg_val, arg=<%s>", $args{arg});
#    my $fres;
#
#    my $extras = $args{extras} // {};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#    # XXX reject if meta's v is not 1.1
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { # completion sub can die, etc.
#
#        my $comp;
#      GET_COMP_ROUTINE:
#        {
#            $comp = $arg_spec->{completion};
#            if ($comp) {
#                log_trace("[comp][periscomp] using arg completion routine from arg spec's 'completion' property");
#                last GET_COMP_ROUTINE;
#            }
#            my $xcomp = $arg_spec->{'x.completion'};
#            if ($xcomp) {
#                if (ref($xcomp) eq 'CODE') {
#                    $comp = $xcomp;
#                } else {
#                    my ($submod, $xcargs);
#                    if (ref($xcomp) eq 'ARRAY') {
#                        $submod = $xcomp->[0];
#                        $xcargs = $xcomp->[1];
#                    } else {
#                        $submod = $xcomp;
#                        $xcargs = {};
#                    }
#                    my $mod = "Perinci::Sub::XCompletion::$submod";
#                    require Module::Installed::Tiny;
#                    if (Module::Installed::Tiny::module_installed($mod)) {
#                        log_trace("[comp][periscomp] loading module %s ...", $mod);
#                        my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                        require $mod_pm;
#                        my $fref = \&{"$mod\::gen_completion"};
#                        log_trace("[comp][periscomp] invoking %s\::gen_completion(%s) ...", $mod, $xcargs);
#                        $comp = $fref->(%$xcargs);
#                    } else {
#                        log_trace("[comp][periscomp] module %s is not installed, skipped", $mod);
#                    }
#                }
#                if ($comp) {
#                    log_trace("[comp][periscomp] using arg completion routine from arg spec's 'x.completion' attribute");
#                    last GET_COMP_ROUTINE;
#                }
#            }
#            my $ent = $arg_spec->{'x.schema.entity'};
#            if ($ent) {
#                require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::ArgEntity::$ent";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[comp][periscomp] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    if (defined &{"$mod\::complete_arg_val"}) {
#                        log_trace("[comp][periscomp] invoking complete_arg_val() from %s ...", $mod);
#                        $comp = \&{"$mod\::complete_arg_val"};
#                        last GET_COMP_ROUTINE;
#                    } else {
#                        log_trace("[comp][periscomp] module %s doesn't define complete_arg_val(), skipped", $mod);
#                    }
#                } else {
#                    log_trace("[comp][periscomp] module %s not installed, skipped", $mod);
#                }
#            }
#        } # GET_COMP_ROUTINE
#
#        if ($comp) {
#            if (ref($comp) eq 'CODE') {
#                my %cargs = (
#                    %$extras,
#                    word=>$word, arg=>$arg, args=>$args{args},
#                );
#                log_trace("[comp][periscomp] invoking arg completion routine with args (%s)", \%cargs);
#                $fres = $comp->(%cargs);
#                return; # from eval
#            } elsif (ref($comp) eq 'ARRAY') {
#                # this is deprecated but will be supported for some time
#                log_trace("[comp][periscomp] using array specified in arg completion routine: %s", $comp);
#                $fres = complete_array_elem(array=>$comp, word=>$word);
#                $static++;
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'completion' property is not a coderef or arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_val request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_val => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, word=>$word},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; # from eval
#                }
#                $fres = $res->[2];
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; # from eval
#        }
#
#        my $fres_from_arg_examples;
#      COMPLETE_FROM_ARG_EXAMPLES:
#        {
#            my $egs = $arg_spec->{examples};
#            unless ($egs) {
#                log_trace("[comp][periscomp] arg spec does not specify examples");
#                last COMPLETE_FROM_ARG_EXAMPLES;
#            }
#            my @array;
#            my @summaries;
#            for my $eg (@$egs) {
#                if (ref $eg eq 'HASH') {
#                    next unless defined $eg->{value};
#                    next if ref $eg->{value};
#                    push @array, $eg->{value};
#                    push @summaries, $eg->{summary};
#                } else {
#                    next unless defined $eg;
#                    next if ref $eg;
#                    push @array, $eg;
#                    push @summaries, undef;
#                }
#            }
#            $fres_from_arg_examples = complete_array_elem(
#                word=>$word, array=>\@array, summaries=>\@summaries);
#            $static //= 1;
#        } # COMPLETE_FROM_ARG_EXAMPLES
#
#        my $fres_from_schema;
#      COMPLETE_FROM_SCHEMA:
#        {
#            my $sch = $arg_spec->{schema};
#            unless ($sch) {
#                log_trace("[comp][periscomp] arg spec does not specify schema");
#                last COMPLETE_FROM_SCHEMA;
#            }
#            # XXX normalize schema if not normalized
#            $fres_from_schema = complete_from_schema(
#                arg=>$arg, extras=>$extras, schema=>$sch, word=>$word,
#            );
#            $static //= 1;
#        } # COMPLETE_FROM_SCHEMA
#
#        $fres = combine_answers(grep {defined} (
#            $fres_from_arg_examples,
#            $fres_from_schema,
#        ));
#    };
#    log_debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        log_trace("[comp][periscomp] no completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_val, result=%s", $fres);
#    $fres;
#}
#
#gen_modified_sub(
#    output_name  => 'complete_arg_elem',
#    install_sub  => 0,
#    base_name    => 'complete_arg_val',
#    summary      => 'Given argument name and function metadata, '.
#        'complete array element',
#    add_args     => {
#        index => {
#            summary => 'Index of element to complete',
#            schema  => ['str*'],
#        },
#    },
#);
#sub complete_arg_elem {
#    require Data::Sah::Normalize;
#
#    my %args = @_;
#
#    my $fres;
#
#    log_trace("[comp][periscomp] entering complete_arg_elem, arg=<%s>, index=<%d>",
#                 $args{arg}, $args{index});
#
#    my $extras = $args{extras} // {};
#
#    my $ourextras = {arg=>$args{arg}, args=>$args{args}};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    defined(my $index = $args{index}) or do {
#        log_trace("[comp][periscomp] index is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#    # XXX reject if meta's v is not 1.1
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { # completion sub can die, etc.
#
#        my $elcomp;
#      GET_ELCOMP_ROUTINE:
#        {
#            $elcomp = $arg_spec->{element_completion};
#            if ($elcomp) {
#                log_trace("[comp][periscomp] using arg element completion routine from 'element_completion' property");
#                last GET_ELCOMP_ROUTINE;
#            }
#            my $xelcomp = $arg_spec->{'x.element_completion'};
#            if ($xelcomp) {
#                if (ref($xelcomp) eq 'CODE') {
#                    $elcomp = $xelcomp;
#                } else {
#                    my ($submod, $xcargs);
#                    if (ref($xelcomp) eq 'ARRAY') {
#                        $submod = $xelcomp->[0];
#                        $xcargs = $xelcomp->[1];
#                    } else {
#                        $submod = $xelcomp;
#                        $xcargs = {};
#                    }
#                    my $mod = "Perinci::Sub::XCompletion::$submod";
#                    require Module::Installed::Tiny;
#                    if (Module::Installed::Tiny::module_installed($mod)) {
#                        log_trace("[comp][periscomp] loading module %s ...", $mod);
#                        my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                        require $mod_pm;
#                        my $fref = \&{"$mod\::gen_completion"};
#                        log_trace("[comp][periscomp] invoking %s\::gen_completion(%s) ...", $mod, $xcargs);
#                        $elcomp = $fref->(%$xcargs);
#                    } else {
#                        log_trace("[comp][periscomp] module %s is not installed, skipped", $mod);
#                    }
#                }
#                if ($elcomp) {
#                    log_trace("[comp][periscomp] using arg element completion routine from 'x.element_completion' attribute");
#                    last GET_ELCOMP_ROUTINE;
#                }
#            }
#            my $ent = $arg_spec->{'x.schema.element_entity'};
#            if ($ent) {
#                require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::ArgEntity::$ent";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[comp][periscomp] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    if (defined &{"$mod\::complete_arg_val"}) {
#                        log_trace("[comp][periscomp] invoking complete_arg_val() from %s ...", $mod);
#                        $elcomp = \&{"$mod\::complete_arg_val"};
#                        last GET_ELCOMP_ROUTINE;
#                    } else {
#                        log_trace("[comp][periscomp] module %s doesn't defined complete_arg_val(), skipped", $mod);
#                    }
#                } else {
#                    log_trace("[comp][periscomp] module %s is not installed, skipped", $mod);
#                }
#            }
#        } # GET_ELCOMP_ROUTINE
#
#        $ourextras->{index} = $index;
#        if ($elcomp) {
#            if (ref($elcomp) eq 'CODE') {
#                my %cargs = (
#                    %$extras,
#                    %$ourextras,
#                    word=>$word,
#                );
#                log_trace("[comp][periscomp] invoking arg element completion routine with args (%s)", \%cargs);
#                $fres = $elcomp->(%cargs);
#                return; # from eval
#            } elsif (ref($elcomp) eq 'ARRAY') {
#                log_trace("[comp][periscomp] using array specified in arg element completion routine: %s", $elcomp);
#                $fres = complete_array_elem(array=>$elcomp, word=>$word);
#                $static = $word eq '';
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'element_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_elem request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_elem => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, args=>$args{args}, word=>$word,
#                     index=>$index},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; # from eval
#                }
#                $fres = $res->[2];
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; # from eval
#        } # if ($elcomp)
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            log_trace("[comp][periscomp] arg spec does not specify schema, declining");
#            return; # from eval
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'array') {
#            log_trace("[comp][periscomp] can't complete element for non-array");
#            return; # from eval
#        }
#
#        unless ($cs->{of}) {
#            log_trace("[comp][periscomp] schema does not specify 'of' clause, declining");
#            return; # from eval
#        }
#
#        # normalize subschema because normalize_schema (as of 0.01) currently
#        # does not do it yet
#        my $elsch = Data::Sah::Normalize::normalize_schema($cs->{of});
#
#        $fres = complete_from_schema(
#            schema=>$elsch, word=>$word,
#            schema_is_normalized=>1,
#        );
#    };
#    log_debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        log_trace("[comp][periscomp] no completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_elem, result=%s", $fres);
#    $fres;
#}
#
#$SPEC{complete_arg_index} = {
#    v => 1.1,
#    summary => 'Given argument name and function metadata, complete arg element index',
#    description => <<'_',
#
#This is only relevant for arguments which have `index_completion` property set
#(currently only `hash` type arguments). When that property is not set, will
#simply return undef.
#
#Completion routine will get `%args`, with the following keys:
#
#* `word` (str, the word to be completed)
#* `arg` (str, the argument name which value is currently being completed)
#* `args` (hash, the argument hash to the function, so far)
#
#as well as extra keys from `extras` (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#<pm:Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata, must be normalized',
#            schema => 'hash*',
#            req => 1,
#        },
#        arg => {
#            summary => 'Argument name',
#            schema => 'str*',
#            req => 1,
#        },
#        word => {
#            summary => 'Word to be completed',
#            schema => ['str*', default => ''],
#        },
#        args => {
#            summary => 'Collected arguments so far, '.
#                'will be passed to completion routines',
#            schema  => 'hash',
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array', # XXX of => str*
#    },
#};
#sub complete_arg_index {
#    require Data::Sah::Normalize;
#
#    my %args = @_;
#
#    my $fres;
#
#    log_trace("[comp][periscomp] entering complete_arg_index, arg=<%s>",
#                 $args{arg});
#
#    my $extras = $args{extras} // {};
#
#    my $ourextras = {arg=>$args{arg}, args=>$args{args}};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#    # XXX reject if meta's v is not 1.1
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { # completion sub can die, etc.
#
#        my $idxcomp;
#      GET_IDXCOMP_ROUTINE:
#        {
#            $idxcomp = $arg_spec->{index_completion};
#            if ($idxcomp) {
#                log_trace("[comp][periscomp] using arg element index completion routine from 'index_completion' property");
#                last GET_IDXCOMP_ROUTINE;
#            }
#        } # GET_IDXCOMP_ROUTINE
#
#        if ($idxcomp) {
#            if (ref($idxcomp) eq 'CODE') {
#                my %cargs = (
#                    %$extras,
#                    %$ourextras,
#                    word=>$word,
#                );
#                log_trace("[comp][periscomp] invoking arg element index completion routine with args (%s)", \%cargs);
#                $fres = $idxcomp->(%cargs);
#                return; # from eval
#            } elsif (ref($idxcomp) eq 'ARRAY') {
#                log_trace("[comp][periscomp] using array specified in arg element index completion routine: %s", $idxcomp);
#                $fres = complete_array_elem(array=>$idxcomp, word=>$word);
#                $static = $word eq '';
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'index_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_index request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_index => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, args=>$args{args}, word=>$word},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; # from eval
#                }
#                $fres = $res->[2];
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; # from eval
#        } # if ($idxcomp)
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            log_trace("[comp][periscomp] arg spec does not specify schema, declining");
#            return; # from eval
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'hash') {
#            log_trace("[comp][periscomp] can't complete element index for non-hash");
#            return; # from eval
#        }
#
#        # collect known keys from some clauses
#        my %keys;
#        if ($cs->{keys}) {
#            $keys{$_}++ for keys %{ $cs->{keys} };
#        }
#        if ($cs->{indices}) {
#            $keys{$_}++ for keys %{ $cs->{indices} };
#        }
#        if ($cs->{req_keys}) {
#            $keys{$_}++ for @{ $cs->{req_keys} };
#        }
#        if ($cs->{allowed_keys}) {
#            $keys{$_}++ for @{ $cs->{allowed_keys} };
#        }
#
#        # exclude keys that have been specified in collected args
#        for (keys %{$args{args}{$arg} // {}}) {
#            delete $keys{$_};
#        }
#
#        $fres = complete_hash_key(word => $word, hash => \%keys);
#
#    }; # eval
#    log_debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        log_trace("[comp][periscomp] no index completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_index, result=%s", $fres);
#    $fres;
#}
#
#$SPEC{complete_cli_arg} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using Rinci function metadata',
#    description => <<'_',
#
#This routine uses <pm:Perinci::Sub::GetArgs::Argv> to generate <pm:Getopt::Long>
#specification from arguments list in Rinci function metadata and common options.
#Then, it will use <pm:Complete::Getopt::Long> to complete option names, option
#values, as well as arguments.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata',
#            schema => 'hash*',
#            req => 1,
#        },
#        words => {
#            summary => 'Command-line arguments',
#            schema => ['array*' => {of=>'str*'}],
#            req => 1,
#        },
#        cword => {
#            summary => 'On which argument cursor is located (zero-based)',
#            schema => 'int*',
#            req => 1,
#        },
#        completion => {
#            summary => 'Supply custom completion routine',
#            description => <<'_',
#
#If supplied, instead of the default completion routine, this code will be called
#instead. Will receive all arguments that <pm:Complete::Getopt::Long> will pass,
#and additionally:
#
#* `arg` (str, the name of function argument)
#* `args` (hash, the function arguments formed so far)
#* `index` (int, if completing argument element value)
#
#_
#            schema => 'code*',
#        },
#        per_arg_json => {
#            summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
#            schema  => 'bool',
#        },
#        per_arg_yaml => {
#            summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
#            schema  => 'bool',
#        },
#        common_opts => {
#            summary => 'Common options',
#            description => <<'_',
#
#A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
#option specification), `handler` (Getopt::Long handler). Will be passed to
#`get_args_from_argv()`. Example:
#
#    {
#        help => {
#            getopt  => 'help|h|?',
#            handler => sub { ... },
#            summary => 'Display help and exit',
#        },
#        version => {
#            getopt  => 'version|v',
#            handler => sub { ... },
#            summary => 'Display version and exit',
#        },
#    }
#
#_
#            schema => ['hash*'],
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#        func_arg_starts_at => {
#            schema  => 'int*',
#            default => 0,
#            description => <<'_',
#
#This is a (temporary?) workaround for <pm:Perinci::CmdLine>. In an application
#with subcommands (e.g. `cmd --verbose subcmd arg0 arg1 ...`), then `words` will
#still contain the subcommand name. Positional function arguments then start at 1
#not 0. This option allows offsetting function arguments.
#
#_
#        },
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#        description => <<'_',
#
#You can use `format_completion` function in <pm:Complete::Bash> module to format
#the result of this function for bash.
#
#_
#    },
#};
#sub complete_cli_arg {
#    require Complete::Getopt::Long;
#    require Perinci::Sub::GetArgs::Argv;
#
#    my %args   = @_;
#    my $meta   = $args{meta} or die "Please specify meta";
#    my $words  = $args{words} or die "Please specify words";
#    my $cword  = $args{cword}; defined($cword) or die "Please specify cword";
#    my $copts  = $args{common_opts} // {};
#    my $comp   = $args{completion};
#    my $extras = {
#        %{ $args{extras} // {} },
#        words => $args{words},
#        cword => $args{cword},
#    };
#
#    my $fname = __PACKAGE__ . "::complete_cli_arg"; # XXX use __SUB__
#    my $fres;
#
#    my $word   = $words->[$cword];
#    my $args_prop = $meta->{args} // {};
#
#    log_trace('[comp][periscomp] entering %s(), words=%s, cword=%d, word=<%s>',
#                 $fname, $words, $cword, $word);
#
#    my $ggls_res = Perinci::Sub::GetArgs::Argv::gen_getopt_long_spec_from_meta(
#        meta         => $meta,
#        common_opts  => $copts,
#        per_arg_json => $args{per_arg_json},
#        per_arg_yaml => $args{per_arg_yaml},
#        ignore_converted_code => 1,
#    );
#    die "Can't generate getopt spec from meta: $ggls_res->[0] - $ggls_res->[1]"
#        unless $ggls_res->[0] == 200;
#    $extras->{ggls_res} = $ggls_res;
#    my $gospec = $ggls_res->[2];
#    my $specmeta = $ggls_res->[3]{'func.specmeta'};
#
#    my $gares = Perinci::Sub::GetArgs::Argv::get_args_from_argv(
#        argv   => [@$words],
#        meta   => $meta,
#        strict => 0,
#    );
#
#    my $copts_by_ospec = {};
#    for (keys %$copts) { $copts_by_ospec->{$copts->{$_}{getopt}}=$copts->{$_} }
#
#    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 with args (%s)", \%cargs);
#                    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 with args (%s)", \%cargs);
#                    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 with args (%s)", \%cargs);
#                    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);
#                $cargs{arg} = $an;
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_val(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            # find if there is a slurpy argument which takes elements at that
#            # position
#            for my $an (sort {
#                ($args_prop->{$b}{pos} // 9999) <=> ($args_prop->{$a}{pos} // 9999)
#            } 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;
#                my $index = $pos - $fasa - $arg_spec->{pos};
#                $cargs{arg} = $an;
#                $cargs{index} = $index;
#                log_trace("[comp][periscomp] this position is for slurpy function argument <%s>'s element[%d]", $an, $index);
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_elem(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, index=>$index, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            log_trace("[comp][periscomp] there is no matching function argument at this position");
#            if ($comp) {
#                log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                my $res;
#                eval { $res = $comp->(%cargs) };
#                log_debug("[comp][periscomp] completion died: $@") if $@;
#                if ($res) {
#                    $fres = $res;
#                    goto RETURN_RES;
#                }
#            }
#            goto RETURN_RES;
#        } else {
#            log_trace("[comp][periscomp] completing option value for an unknown/ambiguous option, declining ...");
#            # decline because there's nothing in Rinci metadata that can aid us
#            goto RETURN_RES;
#        }
#      RETURN_RES:
#        log_trace("[comp][periscomp] leaving completion routine (that we supply to Complete::Getopt::Long)");
#        $fres;
#    }; # completion routine
#
#    $fres = Complete::Getopt::Long::complete_cli_arg(
#        getopt_spec => $gospec,
#        words       => $words,
#        cword       => $cword,
#        completion  => $compgl_comp,
#        extras      => $extras,
#    );
#
#  RETURN_RES:
#    log_trace('[comp][periscomp] leaving %s(), result=%s',
#                 $fname, $fres);
#    $fres;
#}
#
#1;
## ABSTRACT: Complete command-line argument using Rinci metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Complete - Complete command-line argument using Rinci metadata
#
#=head1 VERSION
#
#This document describes version 0.946 of Perinci::Sub::Complete (from Perl distribution Perinci-Sub-Complete), released on 2022-09-02.
#
#=head1 SYNOPSIS
#
#See L<Perinci::CmdLine> or L<Perinci::CmdLine::Lite> or L<App::riap> which use
#this module.
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#
#=head2 complete_arg_elem
#
#Usage:
#
# complete_arg_elem(%args) -> array
#
#Given argument name and function metadata, complete array element.
#
#Will attempt to complete using the completion routine specified in the argument
#specification (the C<completion> property, or in the case of C<complete_arg_elem>
#function, the C<element_completion> property), or if that is not specified, from
#argument's schema using C<complete_from_schema>.
#
#Completion routine will get C<%args>, with the following keys:
#
#=over
#
#=item * C<word> (str, the word to be completed)
#
#=item * C<arg> (str, the argument name which value is currently being completed)
#
#=item * C<index (int, only for the>complete_arg_elem` function, the index in the
#argument array that is currently being completed, starts from 0)
#
#=item * C<args> (hash, the argument hash to the function, so far)
#
#=back
#
#as well as extra keys from C<extras> (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#L<Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<arg>* => I<str>
#
#Argument name.
#
#=item * B<args> => I<hash>
#
#Collected arguments so far, will be passed to completion routines.
#
#=item * B<extras> => I<hash>
#
#Add extra arguments to completion routine.
#
#The keys from this C<extras> hash will be merged into the final C<%args> passed to
#completion routines. Note that standard keys like C<word>, C<cword>, and so on as
#described in the function description will not be overwritten by this.
#
#=item * B<index> => I<str>
#
#Index of element to complete.
#
#=item * B<meta>* => I<hash>
#
#Rinci function metadata, must be normalized.
#
#=item * B<riap_client> => I<obj>
#
#Optional, to perform complete_arg_val to the server.
#
#When the argument spec in the Rinci metadata contains C<completion> key, this
#means there is custom completion code for that argument. However, if retrieved
#from a remote server, sometimes the C<completion> key no longer contains the code
#(it has been cleansed into a string). Moreover, the completion code needs to run
#on the server.
#
#If supplied this argument and te C<riap_server_url> argument, the function will
#try to request to the server (via Riap request C<complete_arg_val>). Otherwise,
#the function will just give up/decline completing.
#
#=item * B<riap_server_url> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<riap_uri> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<word> => I<str> (default: "")
#
#Word to be completed.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 complete_arg_index
#
#Usage:
#
# complete_arg_index(%args) -> array
#
#Given argument name and function metadata, complete arg element index.
#
#This is only relevant for arguments which have C<index_completion> property set
#(currently only C<hash> type arguments). When that property is not set, will
#simply return undef.
#
#Completion routine will get C<%args>, with the following keys:
#
#=over
#
#=item * C<word> (str, the word to be completed)
#
#=item * C<arg> (str, the argument name which value is currently being completed)
#
#=item * C<args> (hash, the argument hash to the function, so far)
#
#=back
#
#as well as extra keys from C<extras> (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#L<Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<arg>* => I<str>
#
#Argument name.
#
#=item * B<args> => I<hash>
#
#Collected arguments so far, will be passed to completion routines.
#
#=item * B<extras> => I<hash>
#
#Add extra arguments to completion routine.
#
#The keys from this C<extras> hash will be merged into the final C<%args> passed to
#completion routines. Note that standard keys like C<word>, C<cword>, and so on as
#described in the function description will not be overwritten by this.
#
#=item * B<meta>* => I<hash>
#
#Rinci function metadata, must be normalized.
#
#=item * B<riap_client> => I<obj>
#
#Optional, to perform complete_arg_val to the server.
#
#When the argument spec in the Rinci metadata contains C<completion> key, this
#means there is custom completion code for that argument. However, if retrieved
#from a remote server, sometimes the C<completion> key no longer contains the code
#(it has been cleansed into a string). Moreover, the completion code needs to run
#on the server.
#
#If supplied this argument and te C<riap_server_url> argument, the function will
#try to request to the server (via Riap request C<complete_arg_val>). Otherwise,
#the function will just give up/decline completing.
#
#=item * B<riap_server_url> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<riap_uri> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<word> => I<str> (default: "")
#
#Word to be completed.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 complete_arg_val
#
#Usage:
#
# complete_arg_val(%args) -> array
#
#Given argument name and function metadata, complete value.
#
#Will attempt to complete using the completion routine specified in the argument
#specification (the C<completion> property, or in the case of C<complete_arg_elem>
#function, the C<element_completion> property), or if that is not specified, from
#argument's schema using C<complete_from_schema>.
#
#Completion routine will get C<%args>, with the following keys:
#
#=over
#
#=item * C<word> (str, the word to be completed)
#
#=item * C<arg> (str, the argument name which value is currently being completed)
#
#=item * C<index (int, only for the>complete_arg_elem` function, the index in the
#argument array that is currently being completed, starts from 0)
#
#=item * C<args> (hash, the argument hash to the function, so far)
#
#=back
#
#as well as extra keys from C<extras> (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#L<Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<arg>* => I<str>
#
#Argument name.
#
#=item * B<args> => I<hash>
#
#Collected arguments so far, will be passed to completion routines.
#
#=item * B<extras> => I<hash>
#
#Add extra arguments to completion routine.
#
#The keys from this C<extras> hash will be merged into the final C<%args> passed to
#completion routines. Note that standard keys like C<word>, C<cword>, and so on as
#described in the function description will not be overwritten by this.
#
#=item * B<meta>* => I<hash>
#
#Rinci function metadata, must be normalized.
#
#=item * B<riap_client> => I<obj>
#
#Optional, to perform complete_arg_val to the server.
#
#When the argument spec in the Rinci metadata contains C<completion> key, this
#means there is custom completion code for that argument. However, if retrieved
#from a remote server, sometimes the C<completion> key no longer contains the code
#(it has been cleansed into a string). Moreover, the completion code needs to run
#on the server.
#
#If supplied this argument and te C<riap_server_url> argument, the function will
#try to request to the server (via Riap request C<complete_arg_val>). Otherwise,
#the function will just give up/decline completing.
#
#=item * B<riap_server_url> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<riap_uri> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<word> => I<str> (default: "")
#
#Word to be completed.
#
#
#=back
#
#Return value:  (array)
#
#
#
#=head2 complete_cli_arg
#
#Usage:
#
# complete_cli_arg(%args) -> hash
#
#Complete command-line argument using Rinci function metadata.
#
#This routine uses L<Perinci::Sub::GetArgs::Argv> to generate L<Getopt::Long>
#specification from arguments list in Rinci function metadata and common options.
#Then, it will use L<Complete::Getopt::Long> to complete option names, option
#values, as well as arguments.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<common_opts> => I<hash>
#
#Common options.
#
#A hash where the values are hashes containing these keys: C<getopt> (Getopt::Long
#option specification), C<handler> (Getopt::Long handler). Will be passed to
#C<get_args_from_argv()>. Example:
#
# {
#     help => {
#         getopt  => 'help|h|?',
#         handler => sub { ... },
#         summary => 'Display help and exit',
#     },
#     version => {
#         getopt  => 'version|v',
#         handler => sub { ... },
#         summary => 'Display version and exit',
#     },
# }
#
#=item * B<completion> => I<code>
#
#Supply custom completion routine.
#
#If supplied, instead of the default completion routine, this code will be called
#instead. Will receive all arguments that L<Complete::Getopt::Long> will pass,
#and additionally:
#
#=over
#
#=item * C<arg> (str, the name of function argument)
#
#=item * C<args> (hash, the function arguments formed so far)
#
#=item * C<index> (int, if completing argument element value)
#
#=back
#
#=item * B<cword>* => I<int>
#
#On which argument cursor is located (zero-based).
#
#=item * B<extras> => I<hash>
#
#Add extra arguments to completion routine.
#
#The keys from this C<extras> hash will be merged into the final C<%args> passed to
#completion routines. Note that standard keys like C<word>, C<cword>, and so on as
#described in the function description will not be overwritten by this.
#
#=item * B<func_arg_starts_at> => I<int> (default: 0)
#
#This is a (temporary?) workaround for L<Perinci::CmdLine>. In an application
#with subcommands (e.g. C<cmd --verbose subcmd arg0 arg1 ...>), then C<words> will
#still contain the subcommand name. Positional function arguments then start at 1
#not 0. This option allows offsetting function arguments.
#
#=item * B<meta>* => I<hash>
#
#Rinci function metadata.
#
#=item * B<per_arg_json> => I<bool>
#
#Will be passed to Perinci::Sub::GetArgs::Argv.
#
#=item * B<per_arg_yaml> => I<bool>
#
#Will be passed to Perinci::Sub::GetArgs::Argv.
#
#=item * B<riap_client> => I<obj>
#
#Optional, to perform complete_arg_val to the server.
#
#When the argument spec in the Rinci metadata contains C<completion> key, this
#means there is custom completion code for that argument. However, if retrieved
#from a remote server, sometimes the C<completion> key no longer contains the code
#(it has been cleansed into a string). Moreover, the completion code needs to run
#on the server.
#
#If supplied this argument and te C<riap_server_url> argument, the function will
#try to request to the server (via Riap request C<complete_arg_val>). Otherwise,
#the function will just give up/decline completing.
#
#=item * B<riap_server_url> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<riap_uri> => I<str>
#
#Optional, to perform complete_arg_val to the server.
#
#See the C<riap_client> argument.
#
#=item * B<words>* => I<array[str]>
#
#Command-line arguments.
#
#
#=back
#
#Return value:  (hash)
#
#
#You can use C<format_completion> function in L<Complete::Bash> module to format
#the result of this function for bash.
#
#
#
#=head2 complete_from_schema
#
#Usage:
#
# complete_from_schema(%args) -> [$status_code, $reason, $payload, \%result_meta]
#
#Complete a value from schema.
#
#Employ some heuristics to complete a value from Sah schema. For example, if
#schema is C<< [str =E<gt> in =E<gt> [qw/new open resolved rejected/]] >>, then we can
#complete from the C<in> clause. Or for something like C<< [int =E<gt> between =E<gt> [1,
#20]] >> we can complete using values from 1 to 20.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<schema>* => I<any>
#
#Will be normalized, unless when C<schema_is_normalized> is set to true, in which
#case schema must already be normalized.
#
#=item * B<schema_is_normalized> => I<bool> (default: 0)
#
#=item * B<word>* => I<str> (default: "")
#
#
#=back
#
#Returns an enveloped result (an array).
#
#First element ($status_code) is an integer containing HTTP-like status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#($reason) is a string containing error message, or something like "OK" if status is
#200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
#element (%result_meta) is called result metadata and is optional, a hash
#that contains extra information, much like how HTTP response headers provide additional metadata.
#
#Return value:  (any)
#
#=for Pod::Coverage ^(.+)$
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Complete>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Complete>.
#
#=head1 SEE ALSO
#
#L<Complete>, L<Complete::Getopt::Long>
#
#L<Perinci::CmdLine>, L<Perinci::CmdLine::Lite>, L<App::riap>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTOR
#
#=for stopwords Steven Haryanto
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012, 2011 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Complete>
#
#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.
#
#=cut
### Perinci/Sub/Util.pm ###
#package Perinci::Sub::Util;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-28'; # DATE
#our $DIST = 'Perinci-Sub-Util'; # DIST
#our $VERSION = '0.472'; # VERSION
#
#our @EXPORT_OK = qw(
#                       err
#                       caller
#                       warn_err
#                       die_err
#                       gen_modified_sub
#                       gen_curried_sub
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Helper when writing functions',
#};
#
#our $STACK_TRACE;
#our @_c; # to store temporary celler() result
#our $_i; # temporary variable
#sub err {
#    require Scalar::Util;
#
#    # get information about caller
#    my @caller = CORE::caller(1);
#    if (!@caller) {
#        # probably called from command-line (-e)
#        @caller = ("main", "-e", 1, "program");
#    }
#
#    my ($status, $msg, $meta, $prev);
#
#    for (@_) {
#        my $ref = ref($_);
#        if ($ref eq 'ARRAY') { $prev = $_ }
#        elsif ($ref eq 'HASH') { $meta = $_ }
#        elsif (!$ref) {
#            if (Scalar::Util::looks_like_number($_)) {
#                $status = $_;
#            } else {
#                $msg = $_;
#            }
#        }
#    }
#
#    $status //= 500;
#    $msg  //= "$caller[3] failed";
#    $meta //= {};
#    $meta->{prev} //= $prev if $prev;
#
#    # put information on who produced this error and where/when
#    if (!$meta->{logs}) {
#
#        # should we produce a stack trace?
#        my $stack_trace;
#        {
#            no warnings;
#            # we use Carp::Always as a sign that user wants stack traces
#            last unless $STACK_TRACE // $INC{"Carp/Always.pm"};
#            # stack trace is already there in previous result's log
#            last if $prev && ref($prev->[3]) eq 'HASH' &&
#                ref($prev->[3]{logs}) eq 'ARRAY' &&
#                    ref($prev->[3]{logs}[0]) eq 'HASH' &&
#                        $prev->[3]{logs}[0]{stack_trace};
#            $stack_trace = [];
#            $_i = 1;
#            while (1) {
#                {
#                    package DB;
#                    @_c = CORE::caller($_i);
#                    if (@_c) {
#                        $_c[4] = [@DB::args];
#                    }
#                }
#                last unless @_c;
#                push @$stack_trace, [@_c];
#                $_i++;
#            }
#        }
#        push @{ $meta->{logs} }, {
#            type    => 'create',
#            time    => time(),
#            package => $caller[0],
#            file    => $caller[1],
#            line    => $caller[2],
#            func    => $caller[3],
#            ( stack_trace => $stack_trace ) x !!$stack_trace,
#        };
#    }
#
#    #die;
#    [$status, $msg, undef, $meta];
#}
#
#sub warn_err {
#    require Carp;
#
#    my $res = err(@_);
#    Carp::carp("ERROR $res->[0]: $res->[1]");
#}
#
#sub die_err {
#    require Carp;
#
#    my $res = err(@_);
#    Carp::croak("ERROR $res->[0]: $res->[1]");
#}
#
#sub caller {
#    my $n0 = shift;
#    my $n  = $n0 // 0;
#
#    my $pkg = $Perinci::Sub::Wrapper::default_wrapped_package //
#        'Perinci::Sub::Wrapped';
#
#    my @r;
#    my $i =  0;
#    my $j = -1;
#    while ($i <= $n+1) { # +1 for this sub itself
#        $j++;
#        @r = CORE::caller($j);
#        last unless @r;
#        if ($r[0] eq $pkg && $r[1] =~ /^\(eval /) {
#            next;
#        }
#        $i++;
#    }
#
#    return unless @r;
#    return defined($n0) ? @r : $r[0];
#}
#
#$SPEC{gen_modified_sub} = {
#    v => 1.1,
#    summary => 'Generate modified metadata (and subroutine) based on another',
#    description => <<'_',
#
#Often you'll want to create another sub (and its metadata) based on another, but
#with some modifications, e.g. add/remove/rename some arguments, change summary,
#add/remove some properties, and so on.
#
#Instead of cloning the Rinci metadata and modify it manually yourself, this
#routine provides some shortcuts.
#
#You can specify base sub/metadata using `base_name` (string, subroutine name,
#either qualified or not) or `base_code` (coderef) + `base_meta` (hash).
#
#_
#    args => {
#        die => {
#            summary => 'Die upon failure',
#            schema => 'bool*',
#        },
#
#        base_name => {
#            summary => 'Subroutine name (either qualified or not)',
#            schema => 'str*',
#            description => <<'_',
#
#If not qualified with package name, will be searched in the caller's package.
#Rinci metadata will be searched in `%SPEC` package variable.
#
#Alternatively, you can also specify `base_code` and `base_meta`.
#
#Either `base_name` or `base_code` + `base_meta` are required.
#
#_
#        },
#        base_code => {
#            summary => 'Base subroutine code',
#            schema  => 'code*',
#            description => <<'_',
#
#If you specify this, you'll also need to specify `base_meta`.
#
#Alternatively, you can specify `base_name` instead, to let this routine search
#the base subroutine from existing Perl package.
#
#_
#        },
#        base_meta => {
#            summary => 'Base Rinci metadata',
#            schema  => 'hash*', # XXX defhash/rifunc
#        },
#        output_name => {
#            summary => 'Where to install the modified sub',
#            schema  => 'str*',
#            description => <<'_',
#
#Output subroutine will be put in the specified name. If the name is not
#qualified with package name, will use caller's package. If the name is not
#specified, the base name will be used and must not be from the caller's package.
#
#Note that this argument is optional.
#
#To prevent installing subroutine, set `install_sub` to false.
#_
#        },
#        output_code => {
#            summary => 'Code for the modified sub',
#            schema  => 'code*',
#            description => <<'_',
#
#Alternatively you can use `wrap_code`. If both are not specified, will use
#`base_code` (which will then be required) as the modified subroutine's code.
#
#_
#        },
#        wrap_code => {
#            summary => 'Wrapper to generate the modified sub',
#            schema  => 'code*',
#            description => <<'_',
#
#The modified sub will become:
#
#    sub { wrap_code->(base_code, @_) }
#
#Alternatively you can use `output_code`. If both are not specified, will use
#`base_code` (which will then be required) as the modified subroutine's code.
#
#_
#        },
#        summary => {
#            summary => 'Summary for the mod subroutine',
#            schema  => 'str*',
#        },
#        description => {
#            summary => 'Description for the mod subroutine',
#            schema  => 'str*',
#        },
#        remove_args => {
#            summary => 'List of arguments to remove',
#            schema  => 'array*',
#        },
#        add_args => {
#            summary => 'Arguments to add',
#            schema  => 'hash*',
#        },
#        replace_args => {
#            summary => 'Arguments to add',
#            schema  => 'hash*',
#        },
#        rename_args => {
#            summary => 'Arguments to rename',
#            schema  => 'hash*',
#        },
#        modify_args => {
#            summary => 'Arguments to modify',
#            description => <<'_',
#
#For each argument you can specify a coderef. The coderef will receive the
#argument ($arg_spec) and is expected to modify the argument specification.
#
#_
#            schema  => 'hash*',
#        },
#        modify_meta => {
#            summary => 'Specify code to modify metadata',
#            schema  => 'code*',
#            description => <<'_',
#
#Code will be called with arguments ($meta) where $meta is the cloned Rinci
#metadata.
#
#_
#        },
#        install_sub => {
#            schema  => 'bool',
#            default => 1,
#        },
#    },
#    args_rels => {
#        req_one => [qw/base_name base_code/],
#        choose_all => [qw/base_code base_meta/],
#    },
#    result => {
#        schema => ['hash*' => {
#            keys => {
#                code => ['code*'],
#                meta => ['hash*'], # XXX defhash/risub
#            },
#        }],
#    },
#};
#sub gen_modified_sub {
#    require Function::Fallback::CoreOrPP;
#
#    my %args = @_;
#
#    # get base code/meta
#    my $caller_pkg = CORE::caller();
#    my ($base_code, $base_meta);
#    my ($base_pkg, $base_leaf);
#    if ($args{base_name}) {
#        if ($args{base_name} =~ /(.+)::(.+)/) {
#            ($base_pkg, $base_leaf) = ($1, $2);
#        } else {
#            $base_pkg  = $caller_pkg;
#            $base_leaf = $args{base_name};
#        }
#        {
#            no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
#            $base_code = \&{"$base_pkg\::$base_leaf"};
#            $base_meta = ${"$base_pkg\::SPEC"}{$base_leaf};
#        }
#        die "Can't find Rinci metadata for $base_pkg\::$base_leaf" unless $base_meta;
#    } elsif ($args{base_meta}) {
#        $base_meta = $args{base_meta};
#        $base_code = $args{base_code}
#            or die "Please specify base_code";
#    } else {
#        die "Please specify base_name or base_code+base_meta";
#    }
#
#    my $output_meta = Function::Fallback::CoreOrPP::clone($base_meta);
#    my $output_code = ($args{wrap_code} ? sub { $args{wrap_code}->($base_code, @_) } : undef) //
#        $args{output_code} // $base_code;
#
#    # modify metadata
#    for (qw/summary description/) {
#        $output_meta->{$_} = $args{$_} if $args{$_};
#    }
#    if ($args{remove_args}) {
#        delete $output_meta->{args}{$_} for @{ $args{remove_args} };
#    }
#    if ($args{add_args}) {
#        for my $k (keys %{ $args{add_args} }) {
#            my $v = $args{add_args}{$k};
#            die "Can't add arg '$k' in mod sub: already exists"
#                if $output_meta->{args}{$k};
#            $output_meta->{args}{$k} = $v;
#        }
#    }
#    if ($args{replace_args}) {
#        for my $k (keys %{ $args{replace_args} }) {
#            my $v = $args{replace_args}{$k};
#            die "Can't replace arg '$k' in mod sub: doesn't exist"
#                unless $output_meta->{args}{$k};
#            $output_meta->{args}{$k} = $v;
#        }
#    }
#    if ($args{rename_args}) {
#        for my $old (keys %{ $args{rename_args} }) {
#            my $new = $args{rename_args}{$old};
#            my $as = $output_meta->{args}{$old};
#            die "Can't rename arg '$old' in mod sub: doesn't exist" unless $as;
#            die "Can't rename arg '$old'->'$new' in mod sub: ".
#                "new name already exist" if $output_meta->{args}{$new};
#            $output_meta->{args}{$new} = $as;
#            delete $output_meta->{args}{$old};
#        }
#    }
#    if ($args{modify_args}) {
#        for (keys %{ $args{modify_args} }) {
#            $args{modify_args}{$_}->($output_meta->{args}{$_});
#        }
#    }
#    if ($args{modify_meta}) {
#        $args{modify_meta}->($output_meta);
#    }
#
#    # install
#    my ($output_pkg, $output_leaf);
#    if (!defined $args{output_name}) {
#        $output_pkg  = $caller_pkg;
#        $output_leaf = $base_leaf;
#        if ($base_pkg eq $output_pkg) {
#            if ($args{die}) {
#                die "Won't override $base_pkg\::$base_leaf";
#            } else {
#                return [412, "Won't override $base_pkg\::$base_leaf"];
#            }
#        }
#    } elsif ($args{output_name} =~ /(.+)::(.+)/) {
#        ($output_pkg, $output_leaf) = ($1, $2);
#    } else {
#        $output_pkg  = $caller_pkg;
#        $output_leaf = $args{output_name};
#    }
#    {
#        no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
#        no warnings 'redefine', 'once';
#        log_trace "Installing modified sub to $output_pkg\::$output_leaf ...";
#        *{"$output_pkg\::$output_leaf"} = $output_code if $args{install_sub} // 1;
#        ${"$output_pkg\::SPEC"}{$output_leaf} = $output_meta;
#    }
#
#    [200, "OK", {code=>$output_code, meta=>$output_meta}];
#}
#
#$SPEC{gen_curried_sub} = {
#    v => 1.1,
#    summary => 'Generate curried subroutine (and its metadata)',
#    description => <<'_',
#
#This is a more convenient helper than `gen_modified_sub` if you want to create a
#new subroutine that has some of its arguments preset (so they no longer need to
#be present in the new metadata).
#
#For more general needs of modifying a subroutine (e.g. add some arguments,
#modify some arguments, etc) use `gen_modified_sub`.
#
#_
#    args => {
#        base_name => {
#            summary => 'Subroutine name (either qualified or not)',
#            schema => 'str*',
#            description => <<'_',
#
#If not qualified with package name, will be searched in the caller's package.
#Rinci metadata will be searched in `%SPEC` package variable.
#
#_
#            req => 1,
#            pos => 0,
#        },
#        set_args => {
#            summary => 'Arguments to set',
#            schema  => 'hash*',
#            req => 1,
#            pos => 1,
#        },
#        output_name => {
#            summary => 'Where to install the modified sub',
#            schema  => 'str*',
#            description => <<'_',
#
#Subroutine will be put in the specified name. If the name is not qualified with
#package name, will use caller's package. If the name is not specified, will use
#the base name which must not be in the caller's package.
#
#_
#            pos => 2,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#};
#sub gen_curried_sub {
#    my ($base_name, $set_args, $output_name) = @_;
#
#    my $caller = CORE::caller();
#
#    my ($base_pkg, $base_leaf);
#    if ($base_name =~ /(.+)::(.+)/) {
#        ($base_pkg, $base_leaf) = ($1, $2);
#    } else {
#        $base_pkg  = $caller;
#        $base_leaf = $base_name;
#    }
#
#    my ($output_pkg, $output_leaf);
#    if (!defined $output_name) {
#        die "Won't override $base_pkg\::$base_leaf" if $base_pkg eq $caller;
#        $output_pkg = $caller;
#        $output_leaf = $base_leaf;
#    } elsif ($output_name =~ /(.+)::(.+)/) {
#        ($output_pkg, $output_leaf) = ($1, $2);
#    } else {
#        $output_pkg  = $caller;
#        $output_leaf = $output_name;
#    }
#
#    my $base_sub = \&{"$base_pkg\::$base_leaf"};
#
#    gen_modified_sub(
#        die         => 1,
#        base_name   => "$base_pkg\::$base_leaf",
#        output_name => "$output_pkg\::$output_leaf",
#        output_code => sub {
#            no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
#            $base_sub->(@_, %$set_args);
#        },
#        remove_args => [keys %$set_args],
#        install => 1,
#    );
#}
#
#1;
## ABSTRACT: Helper when writing functions
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Util - Helper when writing functions
#
#=head1 VERSION
#
#This document describes version 0.472 of Perinci::Sub::Util (from Perl distribution Perinci-Sub-Util), released on 2023-10-28.
#
#=head1 SYNOPSIS
#
#Example for err() and caller():
#
# use Perinci::Sub::Util qw(err caller);
#
# sub foo {
#     my %args = @_;
#     my $res;
#
#     my $caller = caller();
#
#     $res = bar(...);
#     return err($err, 500, "Can't foo") if $res->[0] != 200;
#
#     [200, "OK"];
# }
#
#Example for die_err() and warn_err():
#
# use Perinci::Sub::Util qw(warn_err die_err);
# warn_err(403, "Forbidden");
# die_err(403, "Forbidden");
#
#Example for gen_modified_sub():
#
# use Perinci::Sub::Util qw(gen_modified_sub);
#
# $SPEC{list_users} = {
#     v => 1.1,
#     args => {
#         search => {},
#         is_suspended => {},
#     },
# };
# sub list_users { ... }
#
# gen_modified_sub(
#     output_name => 'list_suspended_users',
#     base_name   => 'list_users',
#     remove_args => ['is_suspended'],
#     output_code => sub {
#         list_users(@_, is_suspended=>1);
#     },
# );
#
#Example for gen_curried_sub():
#
# use Perinci::Sub::Util qw(gen_curried_sub);
#
# $SPEC{list_users} = {
#     v => 1.1,
#     args => {
#         search => {},
#         is_suspended => {},
#     },
# };
# sub list_users { ... }
#
# # simpler/shorter than gen_modified_sub, but can be used for currying only
# gen_curried_sub('list_users', {is_suspended=>1}, 'list_suspended_users');
#
#=head1 FUNCTIONS
#
#
#=head2 gen_curried_sub
#
#Usage:
#
# gen_curried_sub($base_name, $set_args, $output_name) -> any
#
#Generate curried subroutine (and its metadata).
#
#This is a more convenient helper than C<gen_modified_sub> if you want to create a
#new subroutine that has some of its arguments preset (so they no longer need to
#be present in the new metadata).
#
#For more general needs of modifying a subroutine (e.g. add some arguments,
#modify some arguments, etc) use C<gen_modified_sub>.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$base_name>* => I<str>
#
#Subroutine name (either qualified or not).
#
#If not qualified with package name, will be searched in the caller's package.
#Rinci metadata will be searched in C<%SPEC> package variable.
#
#=item * B<$output_name> => I<str>
#
#Where to install the modified sub.
#
#Subroutine will be put in the specified name. If the name is not qualified with
#package name, will use caller's package. If the name is not specified, will use
#the base name which must not be in the caller's package.
#
#=item * B<$set_args>* => I<hash>
#
#Arguments to set.
#
#
#=back
#
#Return value:  (any)
#
#
#
#=head2 gen_modified_sub
#
#Usage:
#
# gen_modified_sub(%args) -> [$status_code, $reason, $payload, \%result_meta]
#
#Generate modified metadata (and subroutine) based on another.
#
#Often you'll want to create another sub (and its metadata) based on another, but
#with some modifications, e.g. add/remove/rename some arguments, change summary,
#add/remove some properties, and so on.
#
#Instead of cloning the Rinci metadata and modify it manually yourself, this
#routine provides some shortcuts.
#
#You can specify base sub/metadata using C<base_name> (string, subroutine name,
#either qualified or not) or C<base_code> (coderef) + C<base_meta> (hash).
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<add_args> => I<hash>
#
#Arguments to add.
#
#=item * B<base_code> => I<code>
#
#Base subroutine code.
#
#If you specify this, you'll also need to specify C<base_meta>.
#
#Alternatively, you can specify C<base_name> instead, to let this routine search
#the base subroutine from existing Perl package.
#
#=item * B<base_meta> => I<hash>
#
#Base Rinci metadata.
#
#=item * B<base_name> => I<str>
#
#Subroutine name (either qualified or not).
#
#If not qualified with package name, will be searched in the caller's package.
#Rinci metadata will be searched in C<%SPEC> package variable.
#
#Alternatively, you can also specify C<base_code> and C<base_meta>.
#
#Either C<base_name> or C<base_code> + C<base_meta> are required.
#
#=item * B<description> => I<str>
#
#Description for the mod subroutine.
#
#=item * B<die> => I<bool>
#
#Die upon failure.
#
#=item * B<install_sub> => I<bool> (default: 1)
#
#(No description)
#
#=item * B<modify_args> => I<hash>
#
#Arguments to modify.
#
#For each argument you can specify a coderef. The coderef will receive the
#argument ($arg_spec) and is expected to modify the argument specification.
#
#=item * B<modify_meta> => I<code>
#
#Specify code to modify metadata.
#
#Code will be called with arguments ($meta) where $meta is the cloned Rinci
#metadata.
#
#=item * B<output_code> => I<code>
#
#Code for the modified sub.
#
#Alternatively you can use C<wrap_code>. If both are not specified, will use
#C<base_code> (which will then be required) as the modified subroutine's code.
#
#=item * B<output_name> => I<str>
#
#Where to install the modified sub.
#
#Output subroutine will be put in the specified name. If the name is not
#qualified with package name, will use caller's package. If the name is not
#specified, the base name will be used and must not be from the caller's package.
#
#Note that this argument is optional.
#
#To prevent installing subroutine, set C<install_sub> to false.
#
#=item * B<remove_args> => I<array>
#
#List of arguments to remove.
#
#=item * B<rename_args> => I<hash>
#
#Arguments to rename.
#
#=item * B<replace_args> => I<hash>
#
#Arguments to add.
#
#=item * B<summary> => I<str>
#
#Summary for the mod subroutine.
#
#=item * B<wrap_code> => I<code>
#
#Wrapper to generate the modified sub.
#
#The modified sub will become:
#
# sub { wrap_code->(base_code, @_) }
#
#Alternatively you can use C<output_code>. If both are not specified, will use
#C<base_code> (which will then be required) as the modified subroutine's code.
#
#
#=back
#
#Returns an enveloped result (an array).
#
#First element ($status_code) is an integer containing HTTP-like status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#($reason) is a string containing error message, or something like "OK" if status is
#200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
#element (%result_meta) is called result metadata and is optional, a hash
#that contains extra information, much like how HTTP response headers provide additional metadata.
#
#Return value:  (hash)
#
#
#=head2 caller([ $n ])
#
#Just like Perl's builtin caller(), except that this one will ignore wrapper code
#in the call stack. You should use this if your code is potentially wrapped. See
#L<Perinci::Sub::Wrapper> for more details.
#
#=head2 err(...) => ARRAY
#
#Experimental.
#
#Generate an enveloped error response (see L<Rinci::function>). Can accept
#arguments in an unordered fashion, by utilizing the fact that status codes are
#always integers, messages are strings, result metadata are hashes, and previous
#error responses are arrays. Error responses also seldom contain actual result.
#Status code defaults to 500, status message will default to "FUNC failed". This
#function will also fill the information in the C<logs> result metadata.
#
#Examples:
#
# err();    # => [500, "FUNC failed", undef, {...}];
# err(404); # => [404, "FUNC failed", undef, {...}];
# err(404, "Not found"); # => [404, "Not found", ...]
# err("Not found", 404); # => [404, "Not found", ...]; # order doesn't matter
# err([404, "Prev error"]); # => [500, "FUNC failed", undef,
#                           #     {logs=>[...], prev=>[404, "Prev error"]}]
#
#Will put C<stack_trace> in logs only if C<Carp::Always> module is loaded.
#
#=head2 warn_err(...)
#
#This is a shortcut for:
#
# $res = err(...);
# warn "ERROR $res->[0]: $res->[1]";
#
#=head2 die_err(...)
#
#This is a shortcut for:
#
# $res = err(...);
# die "ERROR $res->[0]: $res->[1]";
#
#=head1 FAQ
#
#=head2 What if I want to put result ($res->[2]) into my result with err()?
#
#You can do something like this:
#
# my $err = err(...) if ERROR_CONDITION;
# $err->[2] = SOME_RESULT;
# return $err;
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Util>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Util>.
#
#=head1 SEE ALSO
#
#L<Perinci>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTOR
#
#=for stopwords Steven Haryanto
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2020, 2017, 2016, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Util>
#
#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.
#
#=cut
### Perinci/Sub/Util/Args.pm ###
#package Perinci::Sub::Util::Args;
#
#use 5.010001;
#use strict 'subs', 'vars';
#use warnings;
#
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-28'; # DATE
#our $DIST = 'Perinci-Sub-Util'; # DIST
#our $VERSION = '0.472'; # VERSION
#
#our @EXPORT_OK = qw(
#                       args_by_tag
#                       argnames_by_tag
#                       func_args_by_tag
#                       func_argnames_by_tag
#                       call_with_its_args
#);
#
#sub args_by_tag {
#    my ($meta, $args, $tag) = @_;
#
#    my @res;
#    my $args_prop = $meta->{args} or return ();
#    my $neg = $tag =~ s/\A!//;
#    for my $argname (keys %$args_prop) {
#        my $argspec = $args_prop->{$argname};
#        if ($neg) {
#            next unless !$argspec->{tags} ||
#                !(grep {$_ eq $tag} @{$argspec->{tags}});
#        } else {
#            next unless $argspec->{tags} &&
#                grep {$_ eq $tag} @{$argspec->{tags}};
#        }
#        push @res, $argname, $args->{$argname}
#            if exists $args->{$argname};
#    }
#    @res;
#}
#
#sub argnames_by_tag {
#    my ($meta, $tag) = @_;
#
#    my @res;
#    my $args_prop = $meta->{args} or return ();
#    my $neg; $neg = 1 if $tag =~ s/\A!//;
#    for my $argname (keys %$args_prop) {
#        my $argspec = $args_prop->{$argname};
#        if ($neg) {
#            next unless !$argspec->{tags} ||
#                !(grep {$_ eq $tag} @{$argspec->{tags}});
#        } else {
#            next unless $argspec->{tags} &&
#                grep {$_ eq $tag} @{$argspec->{tags}};
#        }
#        push @res, $argname;
#    }
#    sort @res;
#}
#
#sub _find_meta {
#    my $caller = shift;
#    my $func_name = shift;
#
#    if ($func_name =~ /(.+)::(.+)/) {
#        return ${"$1::SPEC"}{$2};
#    } else {
#        return ${"$caller->[0]::SPEC"}{$func_name};
#    }
#}
#
#sub func_args_by_tag {
#    my ($func_name, $args, $tag) = @_;
#    my $meta = _find_meta([caller(1)], $func_name)
#        or die "Can't find Rinci function metadata for $func_name";
#    args_by_tag($meta, $args, $tag);
#}
#
#sub func_argnames_by_tag {
#    my ($func_name, $tag) = @_;
#    my $meta = _find_meta([caller(1)], $func_name)
#        or die "Can't find Rinci function metadata for $func_name";
#    argnames_by_tag($meta, $tag);
#}
#
#sub call_with_its_args {
#    my ($func_name, $args) = @_;
#
#    my ($meta, $func);
#    if ($func_name =~ /(.+)::(.+)/) {
#        defined &{$func_name}
#            or die "Function $func_name not defined";
#        $func = \&{$func_name};
#        $meta = ${"$1::SPEC"}{$2};
#    } else {
#        my @caller = caller(1);
#        my $fullname = "$caller[0]::$func_name";
#        defined &{$fullname}
#            or die "Function $fullname not defined";
#        $func = \&{$fullname};
#        $meta = ${"$caller[0]::SPEC"}{$func_name};
#    }
#    $meta or die "Can't find Rinci function metadata for $func_name";
#
#    my @args;
#    if ($meta->{args}) {
#        for my $argname (keys %{ $meta->{args} }) {
#            push @args, $argname, $args->{$argname}
#                if exists $args->{$argname};
#        }
#    }
#    $func->(@args);
#}
#
#1;
## ABSTRACT: Utility routines related to Rinci arguments
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Util::Args - Utility routines related to Rinci arguments
#
#=head1 VERSION
#
#This document describes version 0.472 of Perinci::Sub::Util::Args (from Perl distribution Perinci-Sub-Util), released on 2023-10-28.
#
#=head1 SYNOPSIS
#
# package MyPackage;
#
# use Perinci::Sub::Util::Args qw(
#     args_by_tag
#     argnames_by_tag
#     func_args_by_tag
#     func_argnames_by_tag
#     call_with_its_args
# );
#
# our %SPEC;
#
# my %func1_args;
#
# $SPEC{myfunc1} = {
#     v => 1.1,
#     summary => 'My function one',
#     args => {
#         %func1_args = (
#             foo => {tags=>['t1', 't2']},
#             bar => {tags=>['t2', 't3']},
#             baz => {},
#         ),
#     },
# };
# sub myfunc1 {
#     my %args = @_;
# }
#
# $SPEC{myfunc2} = {
#     v => 1.1,
#     summary => 'My function two',
#     args => {
#         %func1_args,
#         qux => {tags=>['t3']},
#     },
# };
# sub myfunc2 {
#     my %args = @_;
#     my $res = call_with_its_args('myfunc1', \%args);
# }
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#=head2 args_by_tag
#
#Usage:
#
# my %args = args_by_tag($meta, \%args0, $tag);
#
#Will select only keypairs from C<%args0> arguments which have tag C<$tag>.
#Examples:
#
# my %args = args_by_tag($SPEC{myfunc1}, {foo=>1, bar=>2, baz=>3, qux=>4}, 't2'); # (foo=>1, bar=>2)
#
#=head2 argnames_by_tag
#
#Usage:
#
# my @arg_names = argnames_by_tag($meta, $tag);
#
#Will select only argument names which have tag C<$tag>.
#
#=head2 func_args_by_tag
#
#Usage:
#
# my %args = func_args_by_tag($func_name, \%args0, $tag);
#
#Like L</args_by_tag> except that instead of supplying Rinci function metadata,
#you supply a function name. Rinci metadata will be searched in C<%SPEC>
#variable.
#
#=head2 func_argnames_by_tag
#
#Usage:
#
# my @argnames = func_argnames_by_tag($func_name, $tag);
#
#Like L</argnames_by_tag> except that instead of supplying Rinci function
#metadata, you supply a function name. Rinci metadata will be searched in
#C<%SPEC> variable.
#
#=head2 call_with_its_args
#
#Usage:
#
# my $res = call_with_its_args($func_name, \%args);
#
#Call function with arguments taken from C<%args>. Only arguments which the
#function declares it accepts will be passed.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Util>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Util>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2020, 2017, 2016, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Util>
#
#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.
#
#=cut
### Perinci/Sub/Util/ResObj.pm ###
#package Perinci::Sub::Util::ResObj;
#
#use strict;
#use Carp;
#
#use overload
#    q("") => sub {
#        my $res = shift; "ERROR $res->[0]: $res->[1]\n" . Carp::longmess();
#    };
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-28'; # DATE
#our $DIST = 'Perinci-Sub-Util'; # DIST
#our $VERSION = '0.472'; # VERSION
#
#1;
## ABSTRACT: An object that represents enveloped response suitable for die()-ing
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Util::ResObj - An object that represents enveloped response suitable for die()-ing
#
#=head1 VERSION
#
#This document describes version 0.472 of Perinci::Sub::Util::ResObj (from Perl distribution Perinci-Sub-Util), released on 2023-10-28.
#
#=head1 SYNOPSIS
#
#Currently unused. See L<Perinci::Sub::Util>'s C<warn_err> and C<die_err>
#instead.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Util>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Util>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2020, 2017, 2016, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Util>
#
#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.
#
#=cut
### Perinci/Sub/Util/Sort.pm ###
#package Perinci::Sub::Util::Sort;
#
#use 5.010;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-28'; # DATE
#our $DIST = 'Perinci-Sub-Util'; # DIST
#our $VERSION = '0.472'; # VERSION
#
#our @EXPORT_OK = qw(
#                       sort_args
#               );
#
#our %SPEC;
#
#sub sort_args {
#    my $args = shift;
#    sort {
#        (($args->{$a}{pos} // 9999) <=> ($args->{$b}{pos} // 9999)) ||
#            $a cmp $b
#        } keys %$args;
#}
#
#1;
## ABSTRACT: Sort routines
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Util::Sort - Sort routines
#
#=head1 VERSION
#
#This document describes version 0.472 of Perinci::Sub::Util::Sort (from Perl distribution Perinci-Sub-Util), released on 2023-10-28.
#
#=head1 SYNOPSIS
#
# use Perinci::Sub::Util::Sort qw(sort_args);
#
# my $meta = {
#     v => 1.1,
#     args => {
#         a1 => { pos=>0 },
#         a2 => { pos=>1 },
#         opt1 => {},
#         opt2 => {},
#     },
# };
# my @args = sort_args($meta->{args}); # ('a1','a2','opt1','opt2')
#
#=head1 FUNCTIONS
#
#=head2 sort_args(\%args) => LIST
#
#Sort argument in args property by pos, then by name.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Util>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Util>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 2020, 2017, 2016, 2015, 2014 by perlancar <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.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Util>
#
#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.
#
#=cut
### String/Wildcard/Bash.pm ###
#package String::Wildcard::Bash;
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter 'import';
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-08-12'; # DATE
#our $DIST = 'String-Wildcard-Bash'; # DIST
#our $VERSION = '0.045'; # VERSION
#
#our @EXPORT_OK = 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
#               );
#
#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 contains_brace_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{bash_brace};
#    }
#    0;
#}
#
#sub contains_joker_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{bash_joker};
#    }
#    0;
#}
#
#sub contains_class_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{bash_class};
#    }
#    0;
#}
#
#sub contains_qmark_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{bash_joker} && $m{bash_joker} eq '?';
#    }
#    0;
#}
#
#sub contains_glob_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{bash_joker} && $m{bash_joker} eq '*';
#    }
#    0;
#}
#
#sub contains_globstar_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{bash_joker} && $m{bash_joker} eq '**';
#    }
#    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 $opt_globstar = $opts->{globstar} // 0;
#    my $opt_ps       = $opts->{path_separator} // '/';
#
#    die "Please use a single character for path_separator" unless length($opt_ps) == 1;
#    my $q_ps =
#        $opt_ps eq '-' ? "\\-" :
#        $opt_ps eq '/' ? '/' :
#        quotemeta($opt_ps);
#
#    my $re_not_ps        = "[^$q_ps]";
#    my $re_not_dot       = "[^.]";
#    my $re_not_dot_or_ps = "[^.$q_ps]";
#
#    my @res;
#    my $p;
#    my $after_pathsep;
#    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({
#                        brace    => 0,
#                        dotglob  => $opt_dotglob,
#                        globstar => $opt_globstar,
#                    }, $_)} @elems), ")";
#            } else {
#                push @res, quotemeta($m{bash_brace});
#            }
#
#        } elsif (defined($p = $m{bash_joker})) {
#            if ($p eq '?') {
#                push @res, '.';
#            } elsif ($p eq '*' || $p eq '**' && !$opt_globstar) {
#                push @res, $opt_dotglob || (@res && !$after_pathsep) ?
#                    "$re_not_ps*" : "$re_not_dot_or_ps$re_not_ps*";
#            } elsif ($p eq '**') { # and with 'globstar' option set
#                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
#joker (C<*>, and not C<**>) wildcard pattern.
#
#=head2 contains_globstar_wildcard
#
#Like L</contains_wildcard>, but only return true if string contains the globstar
#joker (C<**> and not C<*>) wildcard pattern.
#
#=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[^/]*"
#
#=item * globstar
#
#Bool. Default is false. Whether globstar (C<**>) can match across subdirectories
#(matches path separator). The default behavior follows bash; that is, globstar
#option is off and C<**> behaves like C<*>.
#
#This setting is similar to shell behavior (shopt) setting C<globstar>.
#
# convert_wildcard_to_re({},                         '*'); # => "[^.][^/]*"
# convert_wildcard_to_re({},                        '**'); # => "[^.][^/]*"
# convert_wildcard_to_re({globstar=>1},             '**'); # => "(?:[^/.][^/]*)(?:/+[^/.][^/]*)*"
# convert_wildcard_to_re({globstar=>1, dotglob=>1}, '**'); # => ".*"
#
#=item * path_separator
#
#String, 1 character. Default is C</>. Can be used to customize the path
#separator.
#
#=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 SEE ALSO
#
#L<Regexp::Wildcards> can also convert a string with wildcard pattern to
#equivalent regexp pattern, like L</convert_wildcard_to_re>. Can handle Unix
#wildcards as well as SQL and DOS/Win32. As of this writing (v1.05), it does not
#handle character class (C<[...]>) and interprets brace expansion differently
#than bash. String::Wildcard::Bash's C<convert_wildcard_to_re> follows bash
#behavior more closely and also provides more options.
#
#Other C<String::Wildcard::*> modules.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 CONTRIBUTOR
#
#=for stopwords Steven Haryanto
#
#Steven Haryanto <stevenharyanto@gmail.com>
#
#=head1 CONTRIBUTING
#
#
#To contribute, you can send patches by email/via RT, or send pull requests on
#GitHub.
#
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
#L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
#that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2019, 2015, 2014 by perlancar <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.
#
#=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.
#
#=cut