#!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.125
# on Sat Jun 17 09:02:58 2023. You probably should not manually edit this file.

# NO_PERINCI_CMDLINE_SCRIPT
# PERINCI_CMDLINE_COMPLETER_SCRIPT: {load_module=>["App::AcmeCpanauthors"],program_name=>"acme-cpanauthors",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/App/AcmeCpanauthors/acme_cpanauthors"}
# FRAGMENT id=shcompgen-hint completer=1 for=acme-cpanauthors
# PODNAME: _acme-cpanauthors
# ABSTRACT: Completer script for acme-cpanauthors

use 5.010;
use strict;
use warnings;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-06-17'; # DATE
our $DIST = 'App-AcmeCpanauthors'; # DIST
our $VERSION = '0.004'; # VERSION
die "Please run this script under shell completion\n" unless $ENV{COMP_LINE} || $ENV{COMMAND_LINE};

# require extra modules
use App::AcmeCpanauthors ();

my $args = {load_module=>["App::AcmeCpanauthors"],program_name=>"acme-cpanauthors",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/App/AcmeCpanauthors/acme_cpanauthors"};

my $meta = {_orig_args_as=>undef,_orig_result_naked=>undef,args=>{action=>{cmdline_aliases=>{L=>{code=>sub{package App::AcmeCpanauthors;use warnings;use strict;no feature;use feature ':5.10';$_[0]{'action'} = 'list_cpan'},is_flag=>1,summary=>"Shortcut for --action list_cpan"},list_cpan=>{code=>sub{package App::AcmeCpanauthors;use warnings;use strict;no feature;use feature ':5.10';$_[0]{'action'} = 'list_cpan'},is_flag=>1,summary=>"Shortcut for --action list_cpan"},list_ids=>{code=>sub{package App::AcmeCpanauthors;use warnings;use strict;no feature;use feature ':5.10';$_[0]{'action'} = 'list_ids'},is_flag=>1,summary=>"Shortcut for --action list_ids"},list_installed=>{code=>sub{package App::AcmeCpanauthors;use warnings;use strict;no feature;use feature ':5.10';$_[0]{'action'} = 'list_installed'},is_flag=>1,summary=>"Shortcut for --action list_installed"}},req=>1,schema=>["str",{in=>["list_cpan","list_installed","list_ids"],req=>1}]},detail=>{cmdline_aliases=>{l=>{}},schema=>["bool",{}],summary=>"Display more information when listing modules/result"},lcpan=>{schema=>["bool",{}],summary=>"Use local CPAN mirror first when available (for -L)"},module=>{completion=>sub{package App::AcmeCpanauthors;use warnings;use strict;no feature;use feature ':5.10';require Complete::Module;my(%args) = @_;my $res = Complete::Module::complete_module('word', $args{'word'}, 'find_pod', 0, 'find_prefix', 0, 'ns_prefix', 'Acme::CPANAuthors');$$res{'words'} = [grep({not _should_skip($_);} @{$$res{'words'};})]},pos=>0,schema=>["str",{req=>1}],summary=>"Acme::CPANAuthors::* module name, without Acme::CPANAuthors:: prefix"}},args_as=>"hash",entity_date=>undef,entity_v=>undef,examples=>[{argv=>["--list-installed"],summary=>"List installed Acme::CPANAuthors::* modules",test=>0,"x.doc.show_result"=>0},{argv=>["--list-cpan"],summary=>"List available Acme::CPANAuthors::* modules on CPAN",test=>0,"x.doc.show_result"=>0},{argv=>["-L","--lcpan"],summary=>"Like previous example, but use local CPAN mirror first",test=>0,"x.doc.show_result"=>0},{argv=>["--list-ids","Indonesian"],summary=>"List PAUSE ID's of Indonesian authors",test=>0,"x.doc.show_result"=>0}],result_naked=>0,summary=>"Unofficial CLI for Acme::CPANAuthors",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) }

=pod

=encoding UTF-8

=head1 NAME

_acme-cpanauthors - Completer script for acme-cpanauthors

=head1 VERSION

This document describes version 0.004 of main::_DataPacker (from Perl distribution App-AcmeCpanauthors), released on 2023-06-17.

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/App-AcmeCpanauthors>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-App-AcmeCpanauthors>.

=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, 2017, 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=App-AcmeCpanauthors>

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,14391,4;1950
Complete/Getopt/Long.pm,74774,36939,5;2417
Complete/Path.pm,111738,17195,6;3436
Complete/Sah.pm,128957,18068,7;3951
Complete/Tcsh.pm,147050,6850,8;4435
Complete/Util.pm,153925,51040,9;4691
Data/Sah/Normalize.pm,204995,9925,10;6436
Function/Fallback/CoreOrPP.pm,214958,5030,11;6736
Getopt/Long/Util.pm,220016,24293,12;6931
Log/ger.pm,244328,12239,13;7763
Log/ger/Filter.pm,256593,1220,14;8135
Log/ger/Filter/Code.pm,257844,1413,15;8202
Log/ger/Format.pm,259283,1364,16;8284
Log/ger/Format/Default.pm,260681,3317,17;8358
Log/ger/Format/MultilevelLog.pm,264038,5154,18;8476
Log/ger/Format/None.pm,269223,1340,19;8659
Log/ger/Heavy.pm,270588,18221,20;8727
Log/ger/Layout.pm,288835,1300,21;9129
Log/ger/Output.pm,290161,1429,22;9198
Log/ger/Output/Array.pm,291622,1603,23;9278
Log/ger/Output/Null.pm,293256,1344,24;9364
Log/ger/Output/String.pm,294633,2328,25;9433
Log/ger/Plugin.pm,296987,2056,26;9538
Log/ger/Plugin/MultilevelLog.pm,299083,3830,27;9653
Log/ger/Util.pm,302937,10301,28;9782
Module/Installed/Tiny.pm,313271,14112,29;10110
Perinci/Sub/Complete.pm,327415,57325,30;10535
Perinci/Sub/Util.pm,384768,22252,31;12163
Perinci/Sub/Util/Args.pm,407053,6306,32;12966
Perinci/Sub/Util/ResObj.pm,413394,1571,33;13220
Perinci/Sub/Util/Sort.pm,414998,1983,34;13281
String/Wildcard/Bash.pm,417013,15067,35;13372

### 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-07'; # 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-07.
#
#=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 = '2019-12-18'; # DATE
#our $VERSION = '0.440'; # 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,
#        },
#    },
#    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,
#    );
#
#    # 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.440 of Complete::File (from Perl distribution Complete-File), released on 2019-12-18.
#
#=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<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<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>
#
#This is also an alternative to specifying full C<filter>. Set this to true if you
#do not want directories.
#
#If you only want directories, take a look at C<complete_dir()>.
#
#=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<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://rt.cpan.org/Public/Dist/Display.html?Name=Complete-File>
#
#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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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 of data structure
#     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::LogGer>.
#
#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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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::LogGer>.
#
#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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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 = '2022-06-10'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.040'; # 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.040
#
#=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) 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-08-28'; # DATE
#our $DIST = 'Perinci-Sub-Complete'; # DIST
#our $VERSION = '0.945'; # 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.945 of Perinci::Sub::Complete (from Perl distribution Perinci-Sub-Complete), released on 2022-08-28.
#
#=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, 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;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-10-20'; # DATE
#our $DIST = 'Perinci-Sub-Util'; # DIST
#our $VERSION = '0.470'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#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 => {
#        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`.
#
#_
#        },
#        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 => <<'_',
#
#Subroutine will be put in the specified name. If the name is not qualified with
#package name, will use caller's package. If no `output_code` is specified, the
#base subroutine reference will be assigned here.
#
#Note that this argument is optional.
#
#_
#        },
#        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,
#        },
#    },
#    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 ($base_code, $base_meta);
#    if ($args{base_name}) {
#        my ($pkg, $leaf);
#        if ($args{base_name} =~ /(.+)::(.+)/) {
#            ($pkg, $leaf) = ($1, $2);
#        } else {
#            $pkg  = CORE::caller();
#            $leaf = $args{base_name};
#        }
#        no strict 'refs';
#        $base_code = \&{"$pkg\::$leaf"};
#        $base_meta = ${"$pkg\::SPEC"}{$leaf};
#        die "Can't find Rinci metadata for $pkg\::$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
#    if ($args{output_name}) {
#        my ($pkg, $leaf);
#        if ($args{output_name} =~ /(.+)::(.+)/) {
#            ($pkg, $leaf) = ($1, $2);
#        } else {
#            $pkg  = CORE::caller();
#            $leaf = $args{output_name};
#        }
#        no strict 'refs';
#        no warnings 'redefine';
#        *{"$pkg\::$leaf"}       = $output_code if $args{install_sub} // 1;
#        ${"$pkg\::SPEC"}{$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*',
#        },
#        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.
#
#_
#            req => 1,
#            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 ($output_name =~ /(.+)::(.+)/) {
#        ($output_pkg, $output_leaf) = ($1, $2);
#    } else {
#        $output_pkg  = $caller;
#        $output_leaf = $output_name;
#    }
#
#    my $base_sub = \&{"$base_pkg\::$base_leaf"};
#
#    my $res = gen_modified_sub(
#        base_name   => "$base_pkg\::$base_leaf",
#        output_name => "$output_pkg\::$output_leaf",
#        output_code => sub {
#            no strict 'refs';
#            $base_sub->(@_, %$set_args);
#        },
#        remove_args => [keys %$set_args],
#        install => 1,
#    );
#
#    die "Can't generate curried sub: $res->[0] - $res->[1]"
#        unless $res->[0] == 200;
#
#    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.470 of Perinci::Sub::Util (from Perl distribution Perinci-Sub-Util), released on 2020-10-20.
#
#=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( [ \%optional_named_args ] , $base_name, $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.
#
#=item * B<set_args> => I<hash>
#
#Arguments to set.
#
#
#=back
#
#Return value:  (any)
#
#
#
#=head2 gen_modified_sub
#
#Usage:
#
# gen_modified_sub(%args) -> [status, msg, payload, 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>.
#
#=item * B<description> => I<str>
#
#Description for the mod subroutine.
#
#=item * B<install_sub> => I<bool> (default: 1)
#
#=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.
#
#Subroutine will be put in the specified name. If the name is not qualified with
#package name, will use caller's package. If no C<output_code> is specified, the
#base subroutine reference will be assigned here.
#
#Note that this argument is optional.
#
#=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) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (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 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.
#
#=head1 SEE ALSO
#
#L<Perinci>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 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
### Perinci/Sub/Util/Args.pm ###
#package Perinci::Sub::Util::Args;
#
#our $DATE = '2020-10-20'; # DATE
#our $VERSION = '0.470'; # VERSION
#
#use 5.010001;
#use strict 'subs', 'vars';
#use warnings;
#
#use Exporter qw(import);
#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.470 of Perinci::Sub::Util::Args (from Perl distribution Perinci-Sub-Util), released on 2020-10-20.
#
#=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 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.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 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
### Perinci/Sub/Util/ResObj.pm ###
#package Perinci::Sub::Util::ResObj;
#
#our $DATE = '2020-10-20'; # DATE
#our $VERSION = '0.470'; # VERSION
#
#use Carp;
#use overload
#    q("") => sub {
#        my $res = shift; "ERROR $err->[0]: $err->[1]\n" . Carp::longmess();
#    };
#
#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.470 of Perinci::Sub::Util::ResObj (from Perl distribution Perinci-Sub-Util), released on 2020-10-20.
#
#=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 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.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 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
### Perinci/Sub/Util/Sort.pm ###
#package Perinci::Sub::Util::Sort;
#
#our $DATE = '2020-10-20'; # DATE
#our $VERSION = '0.470'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#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.470 of Perinci::Sub::Util::Sort (from Perl distribution Perinci-Sub-Util), released on 2020-10-20.
#
#=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 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.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 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
### 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
