#!perl

# BEGIN DATAPACK CODE
{
    my $toc;
    my $data_linepos = 1;
    unshift @INC, sub {
        $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]}) {
            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;
        }
        return;
    };
}
# END DATAPACK CODE

# Note: This completer script is generated by App::GenPericmdCompleterScript version 0.121
# on Wed Apr 29 23:56:38 2020. You probably should not manually edit this file.

# NO_PERINCI_CMDLINE_SCRIPT
# PERINCI_CMDLINE_COMPLETER_SCRIPT: {program_name=>"pick-random-lines",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/App/PickRandomLines/pick_random_lines"}
# FRAGMENT id=shcompgen-hint completer=1 for=pick-random-lines
our $DATE = '2020-04-29'; # DATE
our $VERSION = '0.020'; # VERSION
# PODNAME: _pick-random-lines
# ABSTRACT: Completer script for pick-random-lines

use 5.010;
use strict;
use warnings;

die "Please run this script under shell completion\n" unless $ENV{COMP_LINE} || $ENV{COMMAND_LINE};

my $args = {program_name=>"pick-random-lines",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/App/PickRandomLines/pick_random_lines"};

my $meta = {_orig_args_as=>undef,_orig_result_naked=>undef,args=>{algorithm=>{default=>"scan",description=>"\n`scan` is the algorithm described in the `perlfaq` manual (`perldoc -q \"random\nline\"). This algorithm scans the whole input once and picks one or more lines\nrandomly from it.\n\n`seek` is the algorithm employed by the Perl module `File::RandomLine`. It works\nby seeking a file randomly and finding the next line (repeated `n` number of\ntimes). This algorithm is faster when the input is very large as it avoids\nhaving to scan the whole input. But it requires that the input is seekable (a\nsingle file, stdin is not supported and currently multiple files are not\nsupported as well). *Might produce duplicate lines*.\n\n",schema=>["str",{in=>["scan","seek"],req=>1},{}]},files=>{description=>"\nIf none is specified, will get input from stdin.\n\n",greedy=>1,pos=>0,schema=>["array",{of=>"filename*",req=>1},{}],"x.name.is_plural"=>1},num_lines=>{cmdline_aliases=>{n=>{}},default=>1,description=>"\nIf input contains less lines than the requested number of lines, then will only\nreturn as many lines as the input contains.\n\n",schema=>["int",{min=>1,req=>1},{}]}},args_as=>"hash",description=>"\nTODO:\n* option to allow or disallow duplicates\n\n",entity_date=>undef,entity_v=>undef,links=>[{url=>"pm:Data::Unixish::pick"}],result_naked=>0,summary=>"Pick one or more random lines from input",v=>1.1};

my $sc_metas = {};

my $copts = {format=>{default=>undef,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,schema=>["str*","in",["text","text-simple","text-pretty","json","json-pretty","csv","html","html+datatables","perl"]],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},order=>0,summary=>"Display help message and exit",usage=>"--help (or -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'} = -t STDOUT ? 'json-pretty' : 'json'},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=>{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},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},summary=>"Display program's version and exit",usage=>"--version (or -v)"}};

my $r = {};

# 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
# XXX read_env

# complete with periscomp
my $compres;
{
    require Perinci::Sub::Complete;
    $compres = Perinci::Sub::Complete::complete_cli_arg(
        meta => defined($scn) ? $sc_metas->{$scn} : $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) {
                require Complete::Util;
                return Complete::Util::complete_array_elem(
                    array => [keys %{ $args->{subcommands} }],
                    word  => $words->[$cword]);
            }

            # otherwise let periscomp do its thing
            return undef;
        },
    );
}

# 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

_pick-random-lines - Completer script for pick-random-lines

=head1 VERSION

This document describes version 0.020 of Perinci::CmdLine::Base (from Perl distribution App-PickRandomLines), released on 2020-04-29.

=head1 HOMEPAGE

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

=head1 SOURCE

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

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-PickRandomLines>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2020 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__DATA__
Data::Section::Seekable v1
Clone/PP.pm,20,6331,0;0
Complete/Bash.pm,6376,39376,1;193
Complete/Common.pm,45779,6507,2;1427
Complete/Env.pm,52310,5656,3;1623
Complete/File.pm,57991,14391,4;1881
Complete/Getopt/Long.pm,72414,36039,5;2348
Complete/Path.pm,108478,13757,6;3330
Complete/Sah.pm,122259,16328,7;3747
Complete/Tcsh.pm,138612,6850,8;4189
Complete/Util.pm,145487,40883,9;4445
Data/Clean.pm,186392,17013,10;5863
Data/Clean/ForJSON.pm,203435,8992,11;6435
Data/Clean/FromJSON.pm,212458,3100,12;6728
Data/Dmp.pm,215578,13835,13;6852
Data/ModeMerge.pm,229439,26971,14;7301
Data/ModeMerge/Config.pm,256443,14454,15;8086
Data/ModeMerge/Mode/ADD.pm,270932,2657,16;8610
Data/ModeMerge/Mode/Base.pm,273625,22041,17;8730
Data/ModeMerge/Mode/CONCAT.pm,295704,1741,18;9403
Data/ModeMerge/Mode/DELETE.pm,297483,2738,19;9482
Data/ModeMerge/Mode/KEEP.pm,300257,2463,20;9612
Data/ModeMerge/Mode/NORMAL.pm,302758,2800,21;9731
Data/ModeMerge/Mode/SUBTRACT.pm,305598,3373,22;9875
Data/Sah/Normalize.pm,309001,9038,23;10018
Data/Sah/Resolve.pm,318067,7505,24;10292
Data/Sah/Util/Type.pm,325602,9456,25;10531
Function/Fallback/CoreOrPP.pm,335096,5030,26;10831
Getopt/Long/Negate/EN.pm,340159,5332,27;11026
Getopt/Long/Util.pm,345519,17134,28;11175
Lingua/EN/PluralToSingular.pm,362691,14259,29;11805
Log/ger.pm,376969,11278,30;12552
Log/ger/Filter.pm,388273,1149,31;12897
Log/ger/Filter/Code.pm,389453,1395,32;12963
Log/ger/Format.pm,390874,1293,33;13045
Log/ger/Format/Default.pm,392201,3299,34;13118
Log/ger/Format/None.pm,395531,1269,35;13236
Log/ger/Heavy.pm,396825,18144,36;13303
Log/ger/Layout.pm,414995,1229,37;13704
Log/ger/Output.pm,416250,1358,38;13772
Log/ger/Output/Array.pm,417640,1585,39;13851
Log/ger/Output/Null.pm,419256,1273,40;13937
Log/ger/Output/String.pm,420562,2305,41;14005
Log/ger/Plugin.pm,422893,2038,42;14110
Log/ger/Plugin/MultilevelLog.pm,424971,5006,43;14225
Log/ger/Util.pm,430001,10231,44;14404
Mo.pm,440246,591,45;14732
Mo/Golf.pm,440856,8174,46;14736
Mo/Inline.pm,449051,3471,47;14972
Mo/Moose.pm,452542,533,48;15113
Mo/Mouse.pm,453095,563,49;15118
Mo/build.pm,453678,248,50;15123
Mo/builder.pm,453948,338,51;15127
Mo/chain.pm,454306,216,52;15131
Mo/coerce.pm,454543,330,53;15135
Mo/default.pm,454895,435,54;15139
Mo/exporter.pm,455353,176,55;15143
Mo/import.pm,455550,185,56;15147
Mo/importer.pm,455758,207,57;15151
Mo/is.pm,455982,228,58;15155
Mo/nonlazy.pm,456232,129,59;15159
Mo/option.pm,456382,259,60;15163
Mo/required.pm,456664,340,61;15167
Mo/xs.pm,457021,256,62;15171
Module/Installed/Tiny.pm,457310,7196,63;15175
Perinci/Sub/Complete.pm,464538,55886,64;15410
Perinci/Sub/GetArgs/Argv.pm,520460,55172,65;17007
Perinci/Sub/GetArgs/Array.pm,575669,7479,66;18495
Perinci/Sub/Normalize.pm,583181,7303,67;18755
Perinci/Sub/Util.pm,590512,21083,68;18990
Perinci/Sub/Util/Args.pm,611628,6274,69;19751
Perinci/Sub/Util/ResObj.pm,617937,1545,70;20005
Perinci/Sub/Util/Sort.pm,619515,1957,71;20066
Regexp/Stringify.pm,621500,5418,72;20157
Sah/Schema/rinci/function_meta.pm,626960,5179,73;20354
Sah/Schema/rinci/meta.pm,632172,1842,74;20541
Sah/Schema/rinci/result_meta.pm,634054,1825,75;20626
Sah/SchemaR/rinci/function_meta.pm,635922,6027,76;20704
Sah/SchemaR/rinci/meta.pm,641983,2929,77;20762
Sah/SchemaR/rinci/result_meta.pm,644953,2277,78;20820
Sah/Schemas/Rinci.pm,647259,1280,79;20878
String/LineNumber.pm,648568,2512,80;20934
String/PerlQuote.pm,651108,3383,81;21052
String/Wildcard/Bash.pm,654523,9637,82;21177
YAML/Old.pm,664180,3321,83;21507
YAML/Old/Dumper.pm,667528,17730,84;21624
YAML/Old/Dumper/Base.pm,685290,3735,85;22201
YAML/Old/Error.pm,689051,5985,86;22312
YAML/Old/Loader.pm,695063,25286,87;22503
YAML/Old/Loader/Base.pm,720381,1235,88;23274
YAML/Old/Marshall.pm,721645,934,89;23311
YAML/Old/Mo.pm,722602,3416,90;23358
YAML/Old/Node.pm,726043,4692,91;23438
YAML/Old/Tag.pm,730759,240,92;23656
YAML/Old/Types.pm,731025,6708,93;23675

### Clone/PP.pm ###
#package Clone::PP;
#
#use 5.006;
#use strict;
#use warnings;
#use vars qw($VERSION @EXPORT_OK);
#use Exporter;
#
#$VERSION = 1.07;
#
#@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;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-01-28'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.334'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       point
#                       parse_cmdline
#                       join_wordbreak_words
#                       format_completion
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
#    my ($user, $slash) = @_;
#    my @ent;
#    if (length $user) {
#        @ent = getpwnam($user);
#    } else {
#        @ent = getpwuid($>);
#        $user = $ent[0];
#    }
#    return $ent[7] . $slash if @ent;
#    "~$user$slash"; # return as-is when failed
#}
#
#sub _add_unquoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word, $after_ws) = @_;
#
#    #say "D:add_unquoted word=$word is_cur_word=$is_cur_word after_ws=$after_ws";
#
#    $word =~ s!^(~)(\w*)(/|\z) |  # 1) tilde  2) username  3) optional slash
#               \\(.)           |  # 4) escaped char
#               \$(\w+)            # 5) variable name
#              !
#                  $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
#                      $4 ? $4 :
#                          ($is_cur_word ? "\$$5" : $ENV{$5})
#                              !egx;
#    $word;
#}
#
#sub _add_double_quoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word) = @_;
#
#    $word =~ s!\\(.)           |  # 1) escaped char
#               \$(\w+)            # 2) variable name
#              !
#                  $1 ? $1 :
#                      ($is_cur_word ? "\$$2" : $ENV{$2})
#                          !egx;
#    $word;
#}
#
#sub _add_single_quoted {
#    my $word = shift;
#    $word =~ s/\\(.)/$1/g;
#    $word;
#}
#
#$SPEC{point} = {
#    v => 1.1,
#    summary => 'Return line with point marked by a marker',
#    description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
#    point("^foo") # => ("foo", 0)
#    point("fo^o") # => ("foo", 2)
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line which contains a marker character',
#            schema => 'str*',
#            pos => 0,
#        },
#        marker => {
#            summary => 'Marker character',
#            schema => ['str*', len=>1],
#            default => '^',
#            pos => 1,
#        },
#    },
#    result_naked => 1,
#};
#sub point {
#    my ($line, $marker) = @_;
#    $marker //= '^';
#
#    my $point = index($line, $marker);
#    die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
#    $line =~ s/\Q$marker\E//;
#    ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
#    v => 1.1,
#    summary => 'Parse shell command-line for processing by completion routines',
#    description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
#    command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
#    ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
#    ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
#   variable substitution for `COMP_WORDS`). However, note that special shell
#   variables that are not environment variables like `$0`, `$_`, `$IFS` will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
#  By default `COMP_WORDBREAKS` is:
#
#    "'@><=;|&(:
#
#  So if raw command-line is:
#
#    command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#  then the parse result will be:
#
#    ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#  which is annoying sometimes. But we follow bash here so we can more easily
#  accept input from a joined `COMP_WORDS` if we write completion bash functions,
#  e.g. (in the example, `foo` is a Perl script):
#
#    _foo ()
#    {
#        local words=(${COMP_CWORDS[@]})
#        # add things to words, etc
#        local point=... # calculate the new point
#        COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
#    }
#
#  To avoid these word-breaking characters to be split/grouped, we can escape
#  them with backslash or quote them, e.g.:
#
#    command "http://example.com:80" Foo\:\:Bar
#
#  which bash will parse as:
#
#    ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
#  and we parse as:
#
#    ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
#  equivalent:
#
#    % cmd --foo=bar
#    % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line, defaults to COMP_LINE environment',
#            schema => 'str*',
#            pos => 0,
#        },
#        point => {
#            summary => 'Point/position to complete in command-line, '.
#                'defaults to COMP_POINT',
#            schema => 'int*',
#            pos => 1,
#        },
#        opts => {
#            summary => 'Options',
#            schema => 'hash*',
#            description => <<'_',
#
#Optional. Known options:
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
#  position of cursor, for example (`^` marks the position of cursor):
#  `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
#  doing tab completion.
#
#_
#            schema => 'hash*',
#            pos => 2,
#        },
#    },
#    result => {
#        schema => ['array*', len=>2],
#        description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#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] 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] 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 -MData::Dump bob@example.org
#
#then they will be parsed as:
#
#    ["command", "-MData", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
#    ["command", "-MData::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;
#        }
#    }
#    [$new_words, $cword];
#}
#
#sub _terminal_width {
#    # XXX need to cache?
#    if (eval { require Term::Size; 1 }) {
#        my ($cols, undef) = Term::Size::chars(*STDOUT{IO});
#        $cols // 80;
#    } else {
#        $ENV{COLUMNS} // 80;
#    }
#}
#
## given terminal width & number of columns, calculate column width
#sub _column_width {
#    my ($terminal_width, $num_columns) = @_;
#    if (defined $num_columns && $num_columns > 0) {
#        int( ($terminal_width - ($num_columns-1)*2) / $num_columns ) - 1;
#    } else {
#        undef;
#    }
#}
#
## given terminal width & column width, calculate number of columns
#sub _num_columns {
#    my ($terminal_width, $column_width) = @_;
#    my $n = int( ($terminal_width+2) / ($column_width+2) );
#    $n >= 1 ? $n : 1;
#}
#
#$SPEC{format_completion} = {
#    v => 1.1,
#    summary => 'Format completion for output (for shell)',
#    description => <<'_',
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the `Complete`
#POD. Aside from `words`, this function also recognizes these keys:
#
#_
#    args_as => 'array',
#    args => {
#        completion => {
#            summary => 'Completion answer structure',
#            description => <<'_',
#
#Either an array or hash. See function description for more details.
#
#_
#            schema=>['any*' => of => ['hash*', 'array*']],
#            req=>1,
#            pos=>0,
#        },
#        opts => {
#            summary => 'Specify options',
#            schema=>'hash*',
#            pos=>1,
#            description => <<'_',
#
#Known options:
#
#* as
#
#  Either `string` (the default) or `array` (to return array of lines instead of
#  the lines joined together). Returning array is useful if you are doing
#  completion inside `Term::ReadLine`, for example, where the library expects an
#  array.
#
#* esc_mode
#
#  Escaping mode for entries. Either `default` (most nonalphanumeric characters
#  will be escaped), `shellvar` (like `default`, but dollar sign `$` will also be
#  escaped, convenient when completing environment variables for example),
#  `filename` (currently equals to `default`), `option` (currently equals to
#  `default`), or `none` (no escaping will be done).
#
#* word
#
#  A workaround. String. For now, see source code for more details.
#
#* show_summaries
#
#  Whether to show item's summaries. Boolean, default is from
#  COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
#  An answer item contain summary, which is a short description about the item,
#  e.g.:
#
#      [{word=>"-a"    , summary=>"Show hidden files"},
#       {word=>"-l"    , summary=>"Show details"},
#       {word=>"--sort", summary=>"Specify sort order"}],
#
#  When summaries are not shown, user will just be seeing something like:
#
#      -a
#      -l
#      --sort
#
#  But when summaries are shown, user will see:
#
#      -a         -- Show hidden files
#      -l         -- Show details
#      --sort     -- Specify sort order
#
#  which is quite helpful.
#
#* workaround_with_wordbreaks
#
#  Boolean. Default is true. See source code for more details.
#
#_
#
#        },
#    },
#    result => {
#        summary => 'Formatted string (or array, if `as` is set to `array`)',
#        schema => ['any*' => of => ['str*', 'array*']],
#    },
#    result_naked => 1,
#};
#sub format_completion {
#    my ($hcomp, $opts) = @_;
#
#    $opts //= {};
#
#    $hcomp = {words=>$hcomp} unless ref($hcomp) eq 'HASH';
#    my $words    = $hcomp->{words};
#    my $as       = $opts->{as} // 'string';
#    # 'escmode' key is deprecated (Complete 0.11-) and will be removed later
#    my $esc_mode = $opts->{esc_mode} // $ENV{COMPLETE_BASH_DEFAULT_ESC_MODE} //
#        'default';
#    my $path_sep = $hcomp->{path_sep};
#
#    # 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 unless $ENV{COMPLETE_BASH_FZF};
#        my $items = $ENV{COMPLETE_BASH_FZF_ITEMS} // 100;
#        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.334 of Complete::Bash (from Perl distribution Complete-Bash), released on 2020-01-28.
#
#=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, msg, payload, meta]
#
#Post-process parse_cmdline() result by joining some words.
#
#C<parse_cmdline()>, like bash, splits some characters that are considered as
#word-breaking characters:
#
# "'@><=;|&(:
#
#So if command-line is:
#
# command -MData::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "-MData", "::", "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", "-MData::Dump", 'bob@example.org']
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#
#
#=head2 parse_cmdline
#
#Usage:
#
# parse_cmdline($cmdline, $point, $opts) -> array
#
#Parse shell command-line for processing by completion routines.
#
#This function basically converts C<COMP_LINE> (str) and C<COMP_POINT> (int) into
#something like (but not exactly the same as) C<COMP_WORDS> (array) and
#C<COMP_CWORD> (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's C<COMP_WORDS> contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (C<COMP_WORDS[COMP_CWORD]>) (bash does not perform
#   variable substitution for C<COMP_WORDS>). However, note that special shell
#   variables that are not environment variables like C<$0>, C<$_>, C<$IFS> will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (C<~>) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for C<COMP_WORDS>);
#
#Caveats:
#
#=over
#
#=item * Like bash, we group non-whitespace word-breaking characters into its own word.
#By default C<COMP_WORDBREAKS> is:
#
#"'@><=;|&(:
#
#So if raw command-line is:
#
#command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#then the parse result will be:
#
#["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#which is annoying sometimes. But we follow bash here so we can more easily
#accept input from a joined C<COMP_WORDS> if we write completion bash functions,
#e.g. (in the example, C<foo> is a Perl script):
#
#I<foo ()
#{
#    local words=(${COMP>CWORDS[@]})
#    # add things to words, etc
#    local point=... # calculate the new point
#    COMPREPLY=( C<COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo> )
#}
#
#To avoid these word-breaking characters to be split/grouped, we can escape
#them with backslash or quote them, e.g.:
#
#command "http://example.com:80" Foo\:\:Bar
#
#which bash will parse as:
#
#["command", "\"http://example.com:80\"", "Foo\:\:Bar"]
#
#and we parse as:
#
#["command", "http://example.com:80", "Foo::Bar"]
#
#=item * Due to the way bash parses the command line (see above), the two below are
#equivalent:
#
#% cmd --foo=bar
#% cmd --foo = bar
#
#=back
#
#Because they both expand to C<['--foo', '=', 'bar']>. But obviously
#L<Getopt::Long> does not regard the two as equivalent.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line, defaults to COMP_LINE environment.
#
#=item * B<$opts> => I<hash>
#
#Options.
#
#Optional. Known options:
#
#=over
#
#=item * C<truncate_current_word> (bool). If set to 1, will truncate current word to the
#position of cursor, for example (C<^> marks the position of cursor):
#C<--vers^oo> to C<--vers> instead of C<--versoo>. This is more convenient when
#doing tab completion.
#
#=back
#
#=item * B<$point> => I<int>
#
#Point/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>.
#
#=head2 COMPLETE_BASH_FZF_ITEMS
#
#Uint. Default 100. The minimum number of items to trigger passing completion
#answer to 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 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.
#
#=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 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 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/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;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-10'; # DATE
#our $DIST = 'Complete-Getopt-Long'; # DIST
#our $VERSION = '0.477'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#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('[comp][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('[comp][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("[comp][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("[comp][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("[comp][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("[comp][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("[comp][compgl] leaving default completion routine, result=%s", $fres) if $COMPLETE_GETOPT_LONG_TRACE;
#    $fres;
#}
#
## return the key/element if $opt matches exactly a key/element in $opts (which
## can be an array/hash) OR expands unambiguously to exactly one key/element in
## $opts, otherwise return undef. e.g. _expand1('--fo', [qw/--foo --bar --baz
## --fee --feet/]) and _expand('--fee', ...) will respectively return '--foo' and
## '--fee' because it expands/is unambiguous in the list, but _expand1('--ba',
## ...) or _expand1('--qux', ...) will both return undef because '--ba' expands
## ambiguously (--bar/--baz) while '--qux' cannot be expanded.
#sub _expand1 {
#    my ($opt, $opts) = @_;
#    my @candidates;
#    my $is_hash = ref($opts) eq 'HASH';
#    for ($is_hash ? (sort {length($a)<=>length($b)} keys %$opts) : @$opts) {
#        next unless index($_, $opt) == 0;
#        push @candidates, $is_hash ? $opts->{$_} : $_;
#        last if $opt eq $_;
#    }
#    return @candidates == 1 ? $candidates[0] : undef;
#}
#
## 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('[comp][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 $cmdline = $extras->{cmdline};
#        return unless $cmdline;
#        my $r = $extras->{r};
#        return unless $r;
#
#        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};
#
#        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->{common_opts}{$coptname};
#            #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 $opthash = _expand1($opt, \%opts);
#
#            if ($opthash) {
#                $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 a value due to =
#                    if (!$max_vals) { $min_vals = $max_vals = 1 }
#                }
#
#                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 option, assume it doesn't require argument, unless
#                # it's --opt= or --opt=foo
#                $opt = undef;
#                $expects[$i]{optname} = $opt;
#
#                # detect = after --opt
#                if ($i+1 < @words && $words[$i+1] eq '=') {
#                    $i++;
#                    $expects[$i] = {separator=>1, optval=>undef, word=>''};
#                    if ($i+1 < @words) {
#                        $i++;
#                        $expects[$i]{optval} = $opt;
#                    }
#                }
#            }
#        } else {
#            $expects[$i]{optname} = '';
#            $expects[$i]{arg} = 1;
#            $expects[$i]{argpos} = $argpos++;
#        }
#    }
#
#    my $exp = $expects[$cword];
#    my $word = $exp->{word} // $words[$cword];
#
#    #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('[comp][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, ospec=>$opthash->{ospec},
#            argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
#            parsed_opts=>\%parsed_opts,
#        );
#        my $compres;
#        if ($comp) {
#            log_trace("[comp][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('[comp][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('[comp][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('[comp][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('[comp][compgl] adding result from default '.
#                          'completion routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
#        }
#        push @answers, $compres;
#    }
#
#    log_trace("[comp][compgl] combining result from %d source(s)", scalar @answers) if $COMPLETE_GETOPT_LONG_TRACE;
#    $fres = Complete::Util::combine_answers(@answers) // [];
#
#  RETURN_RES:
#    log_trace("[comp][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.477 of Complete::Getopt::Long (from Perl distribution Complete-Getopt-Long), released on 2020-04-10.
#
#=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 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.
#
#=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 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 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/Path.pm ###
#package Complete::Path;
#
#our $DATE = '2017-07-03'; # DATE
#our $VERSION = '0.24'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#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*',
#        #},
#    },
#    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 $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!;
#
#    # 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;
#    }
#
#    my $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);
#        }
#    }
#
#    my @res;
#    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";
#            #say "D:p=$p";
#            {
#                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 && $dig_leaf) {
#                {
#                    my $p2 = _dig_leaf($p, $list_func, $is_dir_func, $filter_func, $path_sep);
#                    last 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);
#                    }
#                }
#            }
#
#            # 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;
#        }
#    }
#
#    \@res;
#}
#1;
## ABSTRACT: Complete path
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Path - Complete path
#
#=head1 VERSION
#
#This document describes version 0.24 of Complete::Path (from Perl distribution Complete-Path), released on 2017-07-03.
#
#=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<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<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://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Path>
#
#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) 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;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-04'; # DATE
#our $DIST = 'Complete-Sah'; # DIST
#our $VERSION = '0.006'; # VERSION
#
#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);
#
#our %SPEC;
#require Exporter;
#our @ISA       = qw(Exporter);
#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.
#
#_
#    args => {
#        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,
#        },
#    },
#};
#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, $cs) = @{$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';
#        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 = $rsch->[0];
#        # let's just merge everything, for quick checking of clause
#        $cs = {};
#        for my $cs0 (@{ $rsch->[1] // [] }) {
#            for (keys %$cs0) {
#                $cs->{$_} = $cs0->{$_};
#            }
#        }
#        log_trace("[compsah] retrieving schema from module %s, base type=%s", $pkg, $type);
#    }
#
#    my $static;
#    my $words;
#    my $summaries;
#    eval {
#        if (my $xcomp = $cs->{'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's gen_completion(%s) ...", $mod, $xcargs);
#                    $comp = $fref->(%$xcargs);
#                } else {
#                    log_trace("[compsah] module %s is not installed, skipped", $mod);
#                }
#            }
#            if ($comp) {
#                log_trace("[compsah] using arg completion routine from schema's 'x.completion' attribute");
#                $fres = $comp->(
#                    %{$args{extras} // {}},
#                    word=>$word, arg=>$args{arg}, args=>$args{args});
#                return; # from eval
#                }
#            }
#
#        if ($cs->{is} && !ref($cs->{is})) {
#            log_trace("[compsah] adding completion from schema's 'is' clause");
#            push @$words, $cs->{is};
#            push @$summaries, undef;
#            $static++;
#            return; # from eval. there should not be any other value
#        }
#        if ($cs->{in}) {
#            log_trace("[compsah] adding completion from schema's 'in' clause");
#            for my $i (0..$#{ $cs->{in} }) {
#                next if ref $cs->{in}[$i];
#                push @$words    , $cs->{in}[$i];
#                push @$summaries, $cs->{'x.in.summaries'} ? $cs->{'x.in.summaries'}[$i] : undef;
#            }
#            $static++;
#            return; # from eval. there should not be any other value
#        }
#        if ($cs->{'examples'}) {
#            log_trace("[compsah] adding completion from schema's 'examples' clause");
#            for my $eg (@{ $cs->{'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 ($cs->{of} && @{ $cs->{of} }) {
#
#                $fres = combine_answers(
#                    grep { defined } map {
#                        complete_from_schema(schema=>$_, word => $word)
#                    } @{ $cs->{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 ($cs->{between} &&
#                    $cs->{between}[0] - $cs->{between}[0] <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'between' clause");
#                for ($cs->{between}[0] .. $cs->{between}[1]) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif ($cs->{xbetween} &&
#                         $cs->{xbetween}[0] - $cs->{xbetween}[0] <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'xbetween' clause");
#                for ($cs->{xbetween}[0]+1 .. $cs->{xbetween}[1]-1) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($cs->{min}) && defined($cs->{max}) &&
#                         $cs->{max}-$cs->{min} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'min' & 'max' clauses");
#                for ($cs->{min} .. $cs->{max}) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($cs->{min}) && defined($cs->{xmax}) &&
#                         $cs->{xmax}-$cs->{min} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'min' & 'xmax' clauses");
#                for ($cs->{min} .. $cs->{xmax}-1) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($cs->{xmin}) && defined($cs->{max}) &&
#                         $cs->{max}-$cs->{xmin} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'xmin' & 'max' clauses");
#                for ($cs->{xmin}+1 .. $cs->{max}) {
#                    push @$words, $_;
#                    push @$summaries, undef;
#                }
#                $static++;
#            } elsif (defined($cs->{xmin}) && defined($cs->{xmax}) &&
#                         $cs->{xmax}-$cs->{xmin} <= $limit) {
#                log_trace("[compsah] adding completion from schema's 'xmin' & 'xmax' clauses");
#                for ($cs->{xmin}+1 .. $cs->{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 $cs->{between} &&
#                            ($i < $cs->{between}[0] ||
#                                 $i > $cs->{between}[1]);
#                        next if $cs->{xbetween} &&
#                            ($i <= $cs->{xbetween}[0] ||
#                                 $i >= $cs->{xbetween}[1]);
#                        next if defined($cs->{min} ) && $i <  $cs->{min};
#                        next if defined($cs->{xmin}) && $i <= $cs->{xmin};
#                        next if defined($cs->{max} ) && $i >  $cs->{max};
#                        next if defined($cs->{xmin}) && $i >= $cs->{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 $cs->{between} &&
#                            ($f < $cs->{between}[0] ||
#                                 $f > $cs->{between}[1]);
#                        next if $cs->{xbetween} &&
#                            ($f <= $cs->{xbetween}[0] ||
#                                 $f >= $cs->{xbetween}[1]);
#                        next if defined($cs->{min} ) && $f <  $cs->{min};
#                        next if defined($cs->{xmin}) && $f <= $cs->{xmin};
#                        next if defined($cs->{max} ) && $f >  $cs->{max};
#                        next if defined($cs->{xmin}) && $f >= $cs->{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 $cs->{prefilters};
#        # TODO: make replace_map in Complete::Util equivalent as
#        # Str::replace_map's map.
#        for my $entry (@{ $cs->{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.006 of Complete::Sah (from Perl distribution Complete-Sah), released on 2020-03-04.
#
#=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) -> [status, msg, payload, 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) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#=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 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.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019 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/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;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-01-28'; # DATE
#our $DIST = 'Complete-Util'; # DIST
#our $VERSION = '0.611'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Complete::Common qw(:all);
#
#use Exporter qw(import);
#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
#               );
#
#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;
#    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;
#    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 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 ref($ans) eq 'HASH' ? (@{$ans->{words} // []} ? 1:0) : (@$ans ? 1:0);
#}
#
#sub __min(@) {
#    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    = $args{array} or die "Please specify array";
#    my $summaries = $args{summaries};
#    my $word      = $args{word} // "";
#
#    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 ($args{exclude}) {
#        $excluden = {};
#        for my $el (@{$args{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 (my $rmap = $args{replace_map}) {
#        $rmapn = {};
#        $rev_rmapn = {};
#        for my $k (keys %$rmap) {
#            my $kn = $ci ? uc($k) : $k; $kn =~ s/_/-/g if $map_case;
#            my @vn;
#            for my $v (@{ $rmap->{$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      = $args{hash} or die "Please specify hash";
#    my $word      = $args{word} // "";
#    my $summaries = $args{summaries};
#    my $summaries_from_hash_values = $args{summaries_from_hash_values};
#
#    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 $uniq      = delete $args{uniq};
#    my $remaining = delete $args{remaining};
#
#    my $ci = $Complete::Common::OPT_CI;
#
#    my @mentioned_elems = split /\Q$sep\E/, $word, -1;
#    my $cae_word = @mentioned_elems ? pop(@mentioned_elems) : '';
#
#    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(
#        %args,
#        word  => $cae_word,
#        array => $remaining_elems,
#    );
#
#    my $prefix = join($sep, @mentioned_elems);
#    $prefix .= $sep if @mentioned_elems;
#    $cae_res = [map { "$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]$sep", is_partial=>1}];
#    }
#    $cae_res;
#}
#
#$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 undef 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 = $args{answer};
#    my $words = ref($answer) eq 'HASH' ? $answer->{words} : $answer;
#
#    if (defined(my $prefix = $args{prefix})) {
#        for (@$words) {
#            if (ref $_ eq 'HASH') {
#                $_->{word} = "$prefix$_->{word}";
#            } else {
#                $_ = "$prefix$_";
#            }
#        }
#    }
#    if (defined(my $suffix = $args{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 = $args{answer};
#    my $words = ref($answer) eq 'HASH' ? $answer->{words} : $answer;
#
#    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.611 of Complete::Util (from Perl distribution Complete-Util), released on 2020-01-28.
#
#=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]>
#
#
#=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]>
#
#=item * B<exclude> => I<array>
#
#=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]>
#
#=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]>
#
#=item * B<exclude> => I<array>
#
#=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: ",")
#
#=item * B<summaries> => I<array[str]>
#
#=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_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>
#
#=item * B<summaries> => I<hash>
#
#=item * B<summaries_from_hash_values> => I<true>
#
#=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>
#
#=item * B<prefix> => I<str>
#
#=item * B<suffix> => I<str>
#
#
#=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 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.
#
#=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 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2017, 2016, 2015, 2014, 2013 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Data/Clean.pm ###
#package Data::Clean;
#
#our $DATE = '2020-04-07'; # DATE
#our $VERSION = '0.507'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#sub new {
#    my ($class, %opts) = @_;
#    my $self = bless {_opts=>\%opts}, $class;
#    log_trace("Cleanser options: %s", \%opts);
#
#    my $cd = $self->_generate_cleanser_code;
#    for my $mod (keys %{ $cd->{modules} }) {
#        (my $mod_pm = "$mod.pm") =~ s!::!/!g;
#        require $mod_pm;
#    }
#    $self->{_cd} = $cd;
#    $self->{_code} = eval $cd->{src};
#    {
#        last unless $cd->{clone_func} =~ /(.+)::(.+)/;
#        (my $mod_pm = "$1.pm") =~ s!::!/!g;
#        require $mod_pm;
#    }
#    die "Can't generate code: $@" if $@;
#
#    $self;
#}
#
#sub command_call_method {
#    my ($self, $cd, $args) = @_;
#    my $mn = $args->[0];
#    die "Invalid method name syntax" unless $mn =~ /\A\w+\z/;
#    return "{{var}} = {{var}}->$mn; \$ref = ref({{var}})";
#}
#
#sub command_call_func {
#    my ($self, $cd, $args) = @_;
#    my $fn = $args->[0];
#    die "Invalid func name syntax" unless $fn =~ /\A\w+(::\w+)*\z/;
#    return "{{var}} = $fn({{var}}); \$ref = ref({{var}})";
#}
#
#sub command_one_or_zero {
#    my ($self, $cd, $args) = @_;
#    return "{{var}} = {{var}} ? 1:0; \$ref = ''";
#}
#
#sub command_deref_scalar_one_or_zero {
#    my ($self, $cd, $args) = @_;
#    return "{{var}} = \${ {{var}} } ? 1:0; \$ref = ''";
#}
#
#sub command_deref_scalar {
#    my ($self, $cd, $args) = @_;
#    return '{{var}} = ${ {{var}} }; $ref = ref({{var}})';
#}
#
#sub command_stringify {
#    my ($self, $cd, $args) = @_;
#    return '{{var}} = "{{var}}"; $ref = ""';
#}
#
#sub command_replace_with_ref {
#    my ($self, $cd, $args) = @_;
#    return '{{var}} = $ref; $ref = ""';
#}
#
#sub command_replace_with_str {
#    require String::PerlQuote;
#
#    my ($self, $cd, $args) = @_;
#    return "{{var}} = ".String::PerlQuote::double_quote($args->[0]).'; $ref=""';
#}
#
#sub command_unbless {
#    my ($self, $cd, $args) = @_;
#
#    return join(
#        "",
#        'my $reftype = Scalar::Util::reftype({{var}}); ',
#        '{{var}} = $reftype eq "HASH" ? {%{ {{var}} }} :',
#        ' $reftype eq "ARRAY" ? [@{ {{var}} }] :',
#        ' $reftype eq "SCALAR" ? \(my $copy = ${ {{var}} }) :',
#        ' $reftype eq "CODE" ? sub { goto &{ {{var}} } } :',
#        '(die "Cannot unbless object with type $ref")',
#    );
#}
#
#sub command_clone {
#    my ($self, $cd, $args) = @_;
#
#    my $limit = $args->[0] // 1;
#    return join(
#        "",
#        "if (++\$ctr_circ <= $limit) { ",
#        "{{var}} = $cd->{clone_func}({{var}}); redo ",
#        "} else { ",
#        "{{var}} = 'CIRCULAR'; \$ref = '' }",
#    );
#}
#
#sub command_unbless_ffc_inlined {
#    my ($self, $cd, $args) = @_;
#
#    # code taken from Function::Fallback::CoreOrPP 0.07
#    $cd->{subs}{unbless} //= <<'EOC';
#    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} );
#    } else {
#        die "Can't handle $ref";
#    }
#EOC
#
#    "{{var}} = \$sub_unbless->({{var}}); \$ref = ref({{var}})";
#}
#
## test
#sub command_die {
#    my ($self, $cd, $args) = @_;
#    return "die";
#}
#
#sub _generate_cleanser_code {
#    my $self = shift;
#    my $opts = $self->{_opts};
#
#    # compilation data, a structure that will be passed around between routines
#    # during the generation of cleanser code.
#    my $cd = {
#        modules => {}, # key = module name, val = version
#        clone_func   => $self->{_opts}{'!clone_func'},
#        code => '',
#        subs => {},
#    };
#
#    $cd->{modules}{'Scalar::Util'} //= 0;
#    $cd->{modules}{'Data::Dmp'} //= 0 if $opts->{'!debug'};
#
#    if (!$cd->{clone_func}) {
#        $cd->{clone_func} = 'Clone::PP::clone';
#    }
#    {
#        last unless $cd->{clone_func} =~ /(.+)::(.+)/;
#        $cd->{modules}{$1} //= 0;
#    }
#
#    my (@code, @stmts_ary, @stmts_hash, @stmts_main);
#
#    my $n = 0;
#    my $add_stmt = sub {
#        my $which = shift;
#        if ($which eq 'if' || $which eq 'new_if') {
#            my ($cond0, $act0) = @_;
#            for ([\@stmts_ary, '$e', 'ary'],
#                 [\@stmts_hash, '$h->{$k}', 'hash'],
#                 [\@stmts_main, '$_', 'main']) {
#                my $act  = $act0 ; $act  =~ s/\Q{{var}}\E/$_->[1]/g;
#                my $cond = $cond0; $cond =~ s/\Q{{var}}\E/$_->[1]/g;
#                if ($opts->{'!debug'}) { unless (@{ $_->[0] }) { push @{ $_->[0] }, '    print "DEBUG:'.$_->[2].' cleaner: val=", Data::Dmp::dmp_ellipsis('.$_->[1].'), ", ref=$ref\n"; '."\n" } }
#                push @{ $_->[0] }, "    ".($n && $which ne 'new_if' ? "els":"")."if ($cond) { $act }\n";
#            }
#            $n++;
#        } else {
#            my ($stmt0) = @_;
#            for ([\@stmts_ary, '$e', 'ary'],
#                 [\@stmts_hash, '$h->{$k}', 'hash'],
#                 [\@stmts_main, '$_', 'main']) {
#                my $stmt = $stmt0; $stmt =~ s/\Q{{var}}\E/$_->[1]/g;
#                push @{ $_->[0] }, "    $stmt;\n";
#            }
#        }
#    };
#    my $add_if = sub {
#        $add_stmt->('if', @_);
#    };
#    my $add_new_if = sub {
#        $add_stmt->('new_if', @_);
#    };
#    my $add_if_ref = sub {
#        my ($ref, $act0) = @_;
#        $add_if->("\$ref eq '$ref'", $act0);
#    };
#    my $add_new_if_ref = sub {
#        my ($ref, $act0) = @_;
#        $add_new_if->("\$ref eq '$ref'", $act0);
#    };
#
#    # catch circular references
#    my $circ = $opts->{-circular};
#    if ($circ) {
#        my $meth = "command_$circ->[0]";
#        die "Can't handle command $circ->[0] for option '-circular'" unless $self->can($meth);
#        my @args = @$circ; shift @args;
#        my $act = $self->$meth($cd, \@args);
#        if ($opts->{'!debug'}) { $add_stmt->('stmt', 'print "DEBUG: main cleaner: ref=$ref, " . {{var}} . "\n"'); }
#        $add_new_if->('$ref && $refs{ {{var}} }++', $act);
#    }
#
#    # catch object of specified classes (e.g. DateTime, etc)
#    for my $on (grep {/\A\w*(::\w+)*\z/} sort keys %$opts) {
#        my $o = $opts->{$on};
#        next unless $o;
#        my $meth = "command_$o->[0]";
#        die "Can't handle command $o->[0] for option '$on'" unless $self->can($meth);
#        my @args = @$o; shift @args;
#        my $act = $self->$meth($cd, \@args);
#        $add_if_ref->($on, $act);
#    }
#
#    # catch general object not caught by previous
#    for my $p ([-obj => 'Scalar::Util::blessed({{var}})']) {
#        my $o = $opts->{$p->[0]};
#        next unless $o;
#        my $meth = "command_$o->[0]";
#        die "Can't handle command $o->[0] for option '$p->[0]'" unless $self->can($meth);
#        my @args = @$o; shift @args;
#        $add_if->($p->[1], $self->$meth($cd, \@args));
#    }
#
#    # recurse array and hash
#    if ($opts->{'!recurse_obj'}) {
#        $add_stmt->('stmt', 'my $reftype=Scalar::Util::reftype({{var}})//""');
#        $add_new_if->('$reftype eq "ARRAY"', '$process_array->({{var}})');
#        $add_if->('$reftype eq "HASH"' , '$process_hash->({{var}})');
#    } else {
#        $add_new_if_ref->("ARRAY", '$process_array->({{var}})');
#        $add_if_ref->("HASH" , '$process_hash->({{var}})');
#    }
#
#    # lastly, catch any reference left
#    for my $p ([-ref => '$ref']) {
#        my $o = $opts->{$p->[0]};
#        next unless $o;
#        my $meth = "command_$o->[0]";
#        die "Can't handle command $o->[0] for option '$p->[0]'" unless $self->can($meth);
#        my @args = @$o; shift @args;
#        $add_if->($p->[1], $self->$meth($cd, \@args));
#    }
#
#    push @code, 'sub {'."\n";
#
#    for (sort keys %{$cd->{subs}}) {
#        push @code, "state \$sub_$_ = sub { ".$cd->{subs}{$_}." };\n";
#    }
#
#    push @code, 'my $data = shift;'."\n";
#    push @code, 'state %refs;'."\n" if $circ;
#    push @code, 'state $ctr_circ;'."\n" if $circ;
#    push @code, 'state $process_array;'."\n";
#    push @code, 'state $process_hash;'."\n";
#    push @code, (
#        'if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { ',
#        'my $ref=ref($e);'."\n",
#        join("", @stmts_ary).'} } }'."\n"
#    );
#    push @code, (
#        'if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { ',
#        'my $ref=ref($h->{$k});'."\n",
#        join("", @stmts_hash).'} } }'."\n"
#    );
#    push @code, '%refs = (); $ctr_circ=0;'."\n" if $circ;
#    push @code, (
#        'for ($data) { ',
#        'my $ref=ref($_);'."\n",
#        join("", @stmts_main).'}'."\n"
#    );
#    push @code, 'print "DEBUG: main cleaner: result: ", Data::Dmp::dmp_ellipsis($data), "\n";'."\n" if $opts->{'!debug'};
#    push @code, '$data'."\n";
#    push @code, '}'."\n";
#
#    my $code = join("", @code).";";
#
#    if ($ENV{LOG_CLEANSER_CODE} && log_is_trace()) {
#        require String::LineNumber;
#        log_trace("Cleanser code:\n%s",
#                     $ENV{LINENUM} // 1 ?
#                         String::LineNumber::linenum($code) : $code);
#    }
#
#    $cd->{src} = $code;
#
#    $cd;
#}
#
#sub clean_in_place {
#    my ($self, $data) = @_;
#
#    $self->{_code}->($data);
#}
#
#sub clone_and_clean {
#    no strict 'refs';
#
#    my ($self, $data) = @_;
#    my $clone = &{$self->{_cd}{clone_func}}($data);
#    $self->clean_in_place($clone);
#}
#
#1;
## ABSTRACT: Clean data structure
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Clean - Clean data structure
#
#=head1 VERSION
#
#This document describes version 0.507 of Data::Clean (from Perl distribution Data-Clean), released on 2020-04-07.
#
#=head1 SYNOPSIS
#
# use Data::Clean;
#
# my $cleanser = Data::Clean->new(
#     # specify how to deal with specific classes
#     'DateTime'     => [call_method => 'epoch'], # replace object with its epoch
#     'Time::Moment' => [call_method => 'epoch'], # replace object with its epoch
#     'Regexp'       => ['stringify'], # replace $obj with "$obj"
#
#     # specify how to deal with all scalar refs
#     SCALAR         => ['deref_scalar'], # replace \1 with 1
#
#     # specify how to deal with circular reference
#     -circular      => ['clone'],
#
#     # specify how to deal with all other kinds of objects
#     -obj           => ['unbless'],
#
#     # recurse into object
#     #'!recurse_obj'=> 1,
#
#     # generate cleaner with debugging messages
#     #'!debug'      => 1,
# );
#
# # to get cleansed data
# my $cleansed_data = $cleanser->clone_and_clean($data);
#
# # to replace original data with cleansed one
# $cleanser->clean_in_place($data);
#
#=head1 DESCRIPTION
#
#This class can be used to process a data structure by replacing some forms of
#data items with other forms. One of the main uses is to clean "unsafe" data,
#e.g. clean a data structure so it can be encoded to JSON (see
#L<Data::Clean::ForJSON>, which is a thin wrapper over this class).
#
#As can be seen from the example, you specify a list of transformations to be
#done, and then this class will generate an appropriate Perl code to do the
#cleansing. This class is faster than the other ways of processing, e.g.
#L<Data::Rmap> (see L<Bencher::Scenarios::DataCleansing> for some benchmarks).
#
#=for Pod::Coverage ^(command_.+)$
#
#=head1 METHODS
#
#=head2 new(%opts) => $obj
#
#Create a new instance.
#
#Options specify what to do with certain category of data. Option keys are either
#reference types (like C<HASH>, C<ARRAY>, C<SCALAR>) or class names (like
#C<Foo::Bar>), or C<-obj> (to match all kinds of objects, a.k.a. blessed
#references), C<-circular> (to match circular references), C<-ref> (to refer to
#any kind of references, used to process references not handled by other
#options). Option values are arrayrefs, the first element of the array is command
#name, to specify what to do with the reference/class. The rest are command
#arguments.
#
#Note that arrayrefs and hashrefs are always walked into, so it's not trapped by
#C<-ref>.
#
#Default for C<%opts>: C<< -ref => 'stringify' >>.
#
#Option keys that start with C<!> are special:
#
#=over
#
#=item * !recurse_obj (bool)
#
#Can be set to true to to recurse into objects if they are hash- or array-based.
#By default objects are not recursed into. Note that if you enable this option,
#object options (like C<Foo::Bar> or C<-obj>) won't work for hash- and
#array-based objects because they will be recursed instead.
#
#=item * !clone_func (str)
#
#Set fully qualified name of clone function to use. The default is to use
#C<Clone::PP::clone>.
#
#The clone module (all but the last part of the C<!clone_func> value) will
#automatically be loaded using C<require()>.
#
#=item * !debug (bool)
#
#If set to true, will generate code to print debugging messages. For debugging
#only.
#
#=back
#
#Available commands:
#
#=over 4
#
#=item * ['stringify']
#
#This will stringify a reference like C<{}> to something like C<HASH(0x135f998)>.
#
#=item * ['replace_with_ref']
#
#This will replace a reference like C<{}> with C<HASH>.
#
#=item * ['replace_with_str', STR]
#
#This will replace a reference like C<{}> with I<STR>.
#
#=item * ['call_method' => STR]
#
#This will call a method named I<STR> and use its return as the replacement. For
#example: C<< DateTime->from_epoch(epoch=>1000) >> when processed with C<<
#[call_method => 'epoch'] >> will become 1000.
#
#=item * ['call_func', STR]
#
#This will call a function named I<STR> with value as argument and use its return
#as the replacement.
#
#=item * ['one_or_zero']
#
#This will perform C<< $val ? 1:0 >>.
#
#=item * ['deref_scalar_one_or_zero']
#
#This will perform C<< ${$val} ? 1:0 >>.
#
#=item * ['deref_scalar']
#
#This will replace a scalar reference like \1 with 1.
#
#=item * ['unbless']
#
#This will perform unblessing using L<Function::Fallback::CoreOrPP::unbless()>.
#Should be done only for objects (C<-obj>).
#
#=item * ['die']
#
#Die. Only for testing.
#
#=item * ['code', STR]
#
#This will replace with I<STR> treated as Perl code.
#
#=item * ['clone', INT]
#
#This command is useful if you have circular references and want to expand/copy
#them. For example:
#
# my $def_opts = { opt1 => 'default', opt2 => 0 };
# my $users    = { alice => $def_opts, bob => $def_opts, charlie => $def_opts };
#
#C<$users> contains three references to the same data structure. With the default
#behaviour of C<< -circular => [replace_with_str => 'CIRCULAR'] >> the cleaned
#data structure will be:
#
# { alice   => { opt1 => 'default', opt2 => 0 },
#   bob     => 'CIRCULAR',
#   charlie => 'CIRCULAR' }
#
#But with C<< -circular => ['clone'] >> option, the data structure will be
#cleaned to become (the C<$def_opts> is cloned):
#
# { alice   => { opt1 => 'default', opt2 => 0 },
#   bob     => { opt1 => 'default', opt2 => 0 },
#   charlie => { opt1 => 'default', opt2 => 0 }, }
#
#The command argument specifies the number of references to clone as a limit (the
#default is 50), since a cyclical structure can lead to infinite cloning. Above
#this limit, the circular references will be replaced with a string
#C<"CIRCULAR">. For example:
#
# my $a = [1]; push @$a, $a;
#
#With C<< -circular => ['clone', 2] >> the data will be cleaned as:
#
# [1, [1, [1, "CIRCULAR"]]]
#
#With C<< -circular => ['clone', 3] >> the data will be cleaned as:
#
# [1, [1, [1, [1, "CIRCULAR"]]]]
#
#=back
#
#=head2 $obj->clean_in_place($data) => $cleaned
#
#Clean $data. Modify data in-place.
#
#=head2 $obj->clone_and_clean($data) => $cleaned
#
#Clean $data. Clone $data first.
#
#=head1 ENVIRONMENT
#
#=over
#
#=item * LOG_CLEANSER_CODE => BOOL (default: 0)
#
#Can be enabled if you want to see the generated cleanser code. It is logged at
#level C<trace> using L<Log::ger>.
#
#=item * LINENUM => BOOL (default: 1)
#
#When logging cleanser code, whether to give line numbers.
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Clean>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Clean>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Clean>
#
#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
#
#Related modules: L<Data::Rmap>, L<Hash::Sanitize>, L<Data::Walk>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2017, 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
### Data/Clean/ForJSON.pm ###
#package Data::Clean::ForJSON;
#
#our $DATE = '2019-11-26'; # DATE
#our $VERSION = '0.395'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Data::Clean);
#use vars qw($creating_singleton);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       clean_json_in_place
#                       clone_and_clean_json
#               );
#
#sub new {
#    my ($class, %opts) = @_;
#
#    if (!%opts && !$creating_singleton) {
#        warn "You are creating a new ".__PACKAGE__." object without customizing options. ".
#            "You probably want to call get_cleanser() yet to get a singleton instead?";
#    }
#
#    $opts{DateTime}  //= [call_method => 'epoch'];
#    $opts{'Time::Moment'} //= [call_method => 'epoch'];
#    $opts{'Math::BigInt'} //= [call_method => 'bstr'];
#    $opts{Regexp}    //= ['stringify'];
#    $opts{version}   //= ['stringify'];
#
#    $opts{SCALAR}    //= ['deref_scalar'];
#    $opts{-ref}      //= ['replace_with_ref'];
#    $opts{-circular} //= ['clone'];
#    $opts{-obj}      //= ['unbless'];
#
#    $opts{'!recurse_obj'} //= 1;
#    $class->SUPER::new(%opts);
#}
#
#sub get_cleanser {
#    my $class = shift;
#    local $creating_singleton = 1;
#    state $singleton = $class->new;
#    $singleton;
#}
#
#sub clean_json_in_place {
#    __PACKAGE__->get_cleanser->clean_in_place(@_);
#}
#
#sub clone_and_clean_json {
#    __PACKAGE__->get_cleanser->clone_and_clean(@_);
#}
#
#1;
## ABSTRACT: Clean data so it is safe to output to JSON
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Clean::ForJSON - Clean data so it is safe to output to JSON
#
#=head1 VERSION
#
#This document describes version 0.395 of Data::Clean::ForJSON (from Perl distribution Data-Clean-ForJSON), released on 2019-11-26.
#
#=head1 SYNOPSIS
#
# use Data::Clean::ForJSON;
# my $cleanser = Data::Clean::ForJSON->get_cleanser;
# my $data     = { code=>sub {}, re=>qr/abc/i };
#
# my $cleaned;
#
# # modifies data in-place
# $cleaned = $cleanser->clean_in_place($data);
#
# # ditto, but deep clone first, return
# $cleaned = $cleanser->clone_and_clean($data);
#
# # now output it
# use JSON;
# print encode_json($cleaned); # prints '{"code":"CODE","re":"(?^i:abc)"}'
#
#Functional shortcuts:
#
# use Data::Clean::ForJSON qw(clean_json_in_place clone_and_clean_json);
#
# # equivalent to Data::Clean::ForJSON->get_cleanser->clean_in_place($data)
# clean_json_in_place($data);
#
# # equivalent to Data::Clean::ForJSON->get_cleanser->clone_and_clean($data)
# $cleaned = clone_and_clean_json($data);
#
#=head1 DESCRIPTION
#
#This class cleans data from anything that might be problematic when encoding to
#JSON. This includes coderefs, globs, and so on. Here's what it will do by
#default:
#
#=over
#
#=item * Change DateTime and Time::Moment object to its epoch value
#
#=item * Change Regexp and version object to its string value
#
#=item * Change scalar references (e.g. \1) to its scalar value (e.g. 1)
#
#=item * Change other references (non-hash, non-array) to its ref() value (e.g. "GLOB", "CODE")
#
#=item * Clone circular references
#
#With a default limit of 1, meaning that if a reference is first seen again for
#the first time, it will be cloned. But if it is seen again for the second time,
#it will be replaced with "CIRCULAR".
#
#To change the default limit, customize your cleanser object:
#
# $cleanser = Data::Clean::ForJSON->new(
#     -circular => ["clone", 4],
# );
#
#or you can perform other action for circular references, see L<Data::Clean> for
#more details.
#
#=item * Unbless other types of objects
#
#=back
#
#Cleaning recurses into objects.
#
#Data that has been cleaned will probably not be convertible back to the
#original, due to information loss (for example, coderefs converted to string
#C<"CODE">).
#
#The design goals are good performance, good defaults, and just enough
#flexibility. The original use-case is for returning JSON response in HTTP API
#service.
#
#This module is significantly faster than modules like L<Data::Rmap> or
#L<Data::Visitor::Callback> because with something like Data::Rmap you repeatedly
#invoke callback for each data item. This module, on the other hand, generates a
#cleanser code using eval(), using native Perl for() loops.
#
#If C<LOG_CLEANSER_CODE> environment is set to true, the generated cleanser code
#will be logged using L<Log::ger> at trace level. You can see it, e.g. using
#L<Log::ger::Output::Screen>:
#
# % LOG_CLEANSER_CODE=1 perl -MLog::ger::Output=Screen -MLog::ger::Level::trace -MData::Clean::ForJSON \
#   -e'$c=Data::Clean::ForJSON->new; ...'
#
#=head1 FUNCTIONS
#
#None of the functions are exported by default.
#
#=head2 clean_json_in_place($data)
#
#A shortcut for:
#
# Data::Clean::ForJSON->get_cleanser->clean_in_place($data)
#
#=head2 clone_and_clean_json($data) => $cleaned
#
#A shortcut for:
#
# $cleaned = Data::Clean::ForJSON->get_cleanser->clone_and_clean($data)
#
#=head1 METHODS
#
#=head2 CLASS->get_cleanser => $obj
#
#Return a singleton instance, with default options. Use C<new()> if you want to
#customize options.
#
#=head2 CLASS->new() => $obj
#
#Create a new instance.
#
#=head2 $obj->clean_in_place($data) => $cleaned
#
#Clean $data. Modify data in-place.
#
#=head2 $obj->clone_and_clean($data) => $cleaned
#
#Clean $data. Clone $data first.
#
#=head1 FAQ
#
#=head2 Why clone/modify? Why not directly output JSON?
#
#So that the data can be used for other stuffs, like outputting to YAML, etc.
#
#=head2 Why is it slow?
#
#If you use C<new()> instead of C<get_cleanser()>, make sure that you do not
#construct the Data::Clean::ForJSON object repeatedly, as the constructor
#generates the cleanser code first using eval(). A short benchmark (run on my
#slow Atom netbook):
#
# % bench -MData::Clean::ForJSON -b'$c=Data::Clean::ForJSON->new' \
#     'Data::Clean::ForJSON->new->clone_and_clean([1..100])' \
#     '$c->clone_and_clean([1..100])'
# Benchmarking sub { Data::Clean::ForJSON->new->clean_in_place([1..100]) }, sub { $c->clean_in_place([1..100]) } ...
# a: 302 calls (291.3/s), 1.037s (3.433ms/call)
# b: 7043 calls (4996/s), 1.410s (0.200ms/call)
# Fastest is b (17.15x a)
#
#Second, you can turn off some checks if you are sure you will not be getting bad
#data. For example, if you know that your input will not contain circular
#references, you can turn off circular detection:
#
# $cleanser = Data::Clean::ForJSON->new(-circular => 0);
#
#Benchmark:
#
# $ perl -MData::Clean::ForJSON -MBench -E '
#   $data = [[1],[2],[3],[4],[5]];
#   bench {
#       circ   => sub { state $c = Data::Clean::ForJSON->new;               $c->clone_and_clean($data) },
#       nocirc => sub { state $c = Data::Clean::ForJSON->new(-circular=>0); $c->clone_and_clean($data) }
#   }, -1'
# circ: 9456 calls (9425/s), 1.003s (0.106ms/call)
# nocirc: 13161 calls (12885/s), 1.021s (0.0776ms/call)
# Fastest is nocirc (1.367x circ)
#
#The less number of checks you do, the faster the cleansing process will be.
#
#=head2 Why am I getting 'Not a CODE reference at lib/Data/Clean.pm line xxx'?
#
#[2013-08-07 ] This error message is from Data::Clone::clone() when it is cloning
#an object. If you are cleaning objects, instead of using clone_and_clean(), try
#using clean_in_place(). Or, clone your data first using something else like
#L<Sereal>.
#
#=head1 ENVIRONMENT
#
#=head2 LOG_CLEANSER_CODE
#
#Bool. Can be set to true to log cleanser code using L<Log::ger> at C<trace>
#level.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Clean-ForJSON>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Clean-ForJSON>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Clean-ForJSON>
#
#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<Data::Rmap>
#
#L<Data::Visitor::Callback>
#
#L<Data::Abridge> is similar in goal, which is to let Perl data structures (which
#might contain stuffs unsupported in JSON) be encodeable to JSON. But unlike
#Data::Clean::ForJSON, it has some (currently) non-configurable rules, like
#changing a coderef with a hash C<< {CODE=>'\&main::__ANON__'} >> or a scalar ref
#with C<< {SCALAR=>'value'} >> and so on. Note that the abridging process is
#similarly unidirectional (you cannot convert back the original Perl data
#structure).
#
#Some benchmarks in L<Bencher::Scenarios::DataCleansing>. You can see that
#Data::Clean::ForJSON can be several times faster than, say, Data::Rmap.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Data/Clean/FromJSON.pm ###
#package Data::Clean::FromJSON;
#
#our $DATE = '2019-11-26'; # DATE
#our $VERSION = '0.395'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Data::Clean);
#use vars qw($creating_singleton);
#
#sub new {
#    my ($class, %opts) = @_;
#    if (!%opts && !$creating_singleton) {
#        warn "You are creating a new ".__PACKAGE__." object without customizing options. ".
#            "You probably want to call get_cleanser() yet to get a singleton instead?";
#    }
#
#    $opts{"JSON::PP::Boolean"} //= ['deref_scalar_one_or_zero'];
#
#    $class->SUPER::new(%opts);
#}
#
#sub get_cleanser {
#    my $class = shift;
#    local $creating_singleton = 1;
#    state $singleton = $class->new;
#    $singleton;
#}
#
#1;
## ABSTRACT: Clean data from JSON decoder
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Clean::FromJSON - Clean data from JSON decoder
#
#=head1 VERSION
#
#This document describes version 0.395 of Data::Clean::FromJSON (from Perl distribution Data-Clean-ForJSON), released on 2019-11-26.
#
#=head1 SYNOPSIS
#
# use Data::Clean::FromJSON;
# use JSON;
# my $cleanser = Data::Clean::FromJSON->get_cleanser;
# my $data    = JSON->new->decode('[true]'); # -> [bless(do{\(my $o=1)},"JSON::XS::Boolean")]
# my $cleaned = $cleanser->clean_in_place($data); # -> [1]
#
#=head1 DESCRIPTION
#
#This class can "clean" data that comes from a JSON encoder. Currently what it
#does is:
#
#=over
#
#=item * Convert boolean objects to simple Perl values
#
#=back
#
#=head1 METHODS
#
#=head2 CLASS->get_cleanser => $obj
#
#Return a singleton instance, with default options. Use C<new()> if you want to
#customize options.
#
#=head2 CLASS->new() => $obj
#
#=head2 $obj->clean_in_place($data) => $cleaned
#
#Clean $data. Modify data in-place.
#
#=head2 $obj->clone_and_clean($data) => $cleaned
#
#Clean $data. Clone $data first.
#
#=head1 FAQ
#
#=head2 Why am I getting 'Modification of a read-only value attempted at lib/Data/Clean.pm line xxx'?
#
#[2013-10-15 ] This is also from Data::Clone::clone() when it encounters
#JSON::{PP,XS}::Boolean objects. You can use clean_in_place() instead of
#clone_and_clean(), or clone your data using other cloner like L<Sereal>.
#
#=head1 ENVIRONMENT
#
#LOG_CLEANSER_CODE
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Clean-ForJSON>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Clean-ForJSON>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Clean-ForJSON>
#
#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) 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Data/Dmp.pm ###
### no critic: Modules::ProhibitAutomaticExportation
#
#package Data::Dmp;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-07'; # DATE
#our $DIST = 'Data-Dmp'; # DIST
#our $VERSION = '0.240'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Scalar::Util qw(looks_like_number blessed reftype refaddr);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT = qw(dd dmp);
#our @EXPORT_OK = qw(dd_ellipsis dmp_ellipsis);
#
## for when dealing with circular refs
#our %_seen_refaddrs;
#our %_subscripts;
#our @_fixups;
#
#our $OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS = 70;
#our $OPT_PERL_VERSION = "5.010";
#our $OPT_REMOVE_PRAGMAS = 0;
#our $OPT_DEPARSE = 1;
#our $OPT_STRINGIFY_NUMBERS = 0;
#
## BEGIN COPY PASTE FROM Data::Dump
#my %esc = (
#    "\a" => "\\a",
#    "\b" => "\\b",
#    "\t" => "\\t",
#    "\n" => "\\n",
#    "\f" => "\\f",
#    "\r" => "\\r",
#    "\e" => "\\e",
#);
#
## put a string value in double quotes
#sub _double_quote {
#    local($_) = $_[0];
#
#    # If there are many '"' we might want to use qq() instead
#    s/([\\\"\@\$])/\\$1/g;
#    return qq("$_") unless /[^\040-\176]/;  # fast exit
#
#    s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
#    # no need for 3 digits in escape for these
#    s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
#    s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
#    s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
#    return qq("$_");
#}
## END COPY PASTE FROM Data::Dump
#
#sub _dump_code {
#    my $code = shift;
#
#    state $deparse = do {
#        require B::Deparse;
#        B::Deparse->new("-l"); # -i option doesn't have any effect?
#    };
#
#    my $res = $deparse->coderef2text($code);
#
#    my ($res_before_first_line, $res_after_first_line) =
#        $res =~ /(.+?)^(#line .+)/ms;
#
#    if ($OPT_REMOVE_PRAGMAS) {
#        $res_before_first_line = "{";
#    } elsif ($OPT_PERL_VERSION < 5.016) {
#        # older perls' feature.pm doesn't yet support q{no feature ':all';}
#        # so we replace it with q{no feature}.
#        $res_before_first_line =~ s/no feature ':all';/no feature;/m;
#    }
#    $res_after_first_line =~ s/^#line .+//gm;
#
#    $res = "sub" . $res_before_first_line . $res_after_first_line;
#    $res =~ s/^\s+//gm;
#    $res =~ s/\n+//g;
#    $res =~ s/;\}\z/}/;
#    $res;
#}
#
#sub _quote_key {
#    $_[0] =~ /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ ||
#        $_[0] =~ /\A-?[1-9][0-9]{0,8}\z/ ? $_[0] : _double_quote($_[0]);
#}
#
#sub _dump {
#    my ($val, $subscript) = @_;
#
#    my $ref = ref($val);
#    if ($ref eq '') {
#        if (!defined($val)) {
#            return "undef";
#        } elsif (looks_like_number($val) && !$OPT_STRINGIFY_NUMBERS &&
#                     # perl does several normalizations to number literal, e.g.
#                     # "+1" becomes 1, 0123 is octal literal, etc. make sure we
#                     # only leave out quote when the number is not normalized
#                     $val eq $val+0 &&
#                     # perl also doesn't recognize Inf and NaN as numeric
#                     # literals (ref: perldata) so these unquoted literals will
#                     # choke under 'use strict "subs"
#                     $val !~ /\A-?(?:inf(?:inity)?|nan)\z/i
#                 ) {
#            return $val;
#        } else {
#            return _double_quote($val);
#        }
#    }
#    my $refaddr = refaddr($val);
#    $_subscripts{$refaddr} //= $subscript;
#    if ($_seen_refaddrs{$refaddr}++) {
#        push @_fixups, "\$a->$subscript=\$a",
#            ($_subscripts{$refaddr} ? "->$_subscripts{$refaddr}" : ""), ";";
#        return "'fix'";
#    }
#
#    my $class;
#
#    if ($ref eq 'Regexp' || $ref eq 'REGEXP') {
#        require Regexp::Stringify;
#        return Regexp::Stringify::stringify_regexp(
#            regexp=>$val, with_qr=>1, plver=>$OPT_PERL_VERSION);
#    }
#
#    if (blessed $val) {
#        $class = $ref;
#        $ref = reftype($val);
#    }
#
#    my $res;
#    if ($ref eq 'ARRAY') {
#        $res = "[";
#        my $i = 0;
#        for (@$val) {
#            $res .= "," if $i;
#            $res .= _dump($_, "$subscript\[$i]");
#            $i++;
#        }
#        $res .= "]";
#    } elsif ($ref eq 'HASH') {
#        $res = "{";
#        my $i = 0;
#        for (sort keys %$val) {
#            $res .= "," if $i++;
#            my $k = _quote_key($_);
#            my $v = _dump($val->{$_}, "$subscript\{$k}");
#            $res .= "$k=>$v";
#        }
#        $res .= "}";
#    } elsif ($ref eq 'SCALAR') {
#        $res = "\\"._dump($$val, $subscript);
#    } elsif ($ref eq 'REF') {
#        $res = "\\"._dump($$val, $subscript);
#    } elsif ($ref eq 'CODE') {
#        $res = $OPT_DEPARSE ? _dump_code($val) : 'sub{"DUMMY"}';
#    } else {
#        die "Sorry, I can't dump $val (ref=$ref) yet";
#    }
#
#    $res = "bless($res,"._double_quote($class).")" if defined($class);
#    $res;
#}
#
#our $_is_dd;
#our $_is_ellipsis;
#sub _dd_or_dmp {
#    local %_seen_refaddrs;
#    local %_subscripts;
#    local @_fixups;
#
#    my $res;
#    if (@_ > 1) {
#        $res = "(" . join(",", map {_dump($_, '')} @_) . ")";
#    } else {
#        $res = _dump($_[0], '');
#    }
#    if (@_fixups) {
#        $res = "do{my\$a=$res;" . join("", @_fixups) . "\$a}";
#    }
#
#    if ($_is_ellipsis) {
#        $res = substr($res, 0, $OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS) . '...'
#            if length($res) > $OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS;
#    }
#
#    if ($_is_dd) {
#        say $res;
#        return wantarray() || @_ > 1 ? @_ : $_[0];
#    } else {
#        return $res;
#    }
#}
#
#sub dd { local $_is_dd=1; _dd_or_dmp(@_) } # goto &sub doesn't work with local
#sub dmp { goto &_dd_or_dmp }
#
#sub dd_ellipsis { local $_is_dd=1; local $_is_ellipsis=1; _dd_or_dmp(@_) }
#sub dmp_ellipsis { local $_is_ellipsis=1; _dd_or_dmp(@_) }
#
#1;
## ABSTRACT: Dump Perl data structures as Perl code
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Dmp - Dump Perl data structures as Perl code
#
#=head1 VERSION
#
#This document describes version 0.240 of Data::Dmp (from Perl distribution Data-Dmp), released on 2020-04-07.
#
#=head1 SYNOPSIS
#
# use Data::Dmp; # exports dd() and dmp()
# dd [1, 2, 3]; # prints "[1,2,3]"
# $a = dmp({a => 1}); # -> "{a=>1}"
#
#Print truncated dump (capped at L</$Data::Dmp::OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS>
#characters):
#
# use Data::Dmp qw(dd_ellipsis dmp_ellipsis);
# dd_ellipsis [1..100];
#
#=head1 DESCRIPTION
#
#Data::Dmp is a Perl dumper like L<Data::Dumper>. It's compact (only about 200
#lines of code long), starts fast and does not use any non-core modules except
#L<Regexp::Stringify> when dumping regexes. It produces compact single-line
#output (similar to L<Data::Dumper::Concise>). It roughly has the same speed as
#Data::Dumper (usually a bit faster for smaller structures) and faster than
#L<Data::Dump>, but does not offer the various formatting options. It supports
#dumping objects, regexes, circular structures, coderefs. Its code is first based
#on L<Data::Dump>: I removed all the parts that I don't need, particularly the
#pretty formatting stuffs) and added some features that I need like proper regex
#dumping and coderef deparsing.
#
#=head1 VARIABLES
#
#=head2 $Data::Dmp::OPT_PERL_VERSION
#
#String, default: 5.010.
#
#Set target Perl version. If you set this to, say C<5.010>, then the dumped code
#will keep compatibility with Perl 5.10.0. This is used in the following ways:
#
#=over
#
#=item * passed to L<Regexp::Stringify>
#
#=item * when dumping code references
#
#For example, in perls earlier than 5.016, feature.pm does not understand:
#
# no feature ':all';
#
#so we replace it with:
#
# no feature;
#
#=back
#
#=head2 $Data::Dmp::OPT_REMOVE_PRAGMAS
#
#Bool, default: 0.
#
#If set to 1, then pragmas at the start of coderef dump will be removed. Coderef
#dump is produced by L<B::Deparse> and is of the form like:
#
# sub { use feature 'current_sub', 'evalbytes', 'fc', 'say', 'state', 'switch', 'unicode_strings', 'unicode_eval'; $a <=> $b }
#
#If you want to dump short coderefs, the pragmas might be distracting. You can
#turn turn on this option which will make the above dump become:
#
# sub { $a <=> $b }
#
#Note that without the pragmas, the dump might be incorrect.
#
#=head2 $Data::Dmp::OPT_DEPARSE
#
#Bool, default: 1.
#
#Can be set to 0 to skip deparsing code. Coderefs will be dumped as
#C<sub{"DUMMY"}> instead, like in Data::Dump.
#
#=head2 $Data::Dmp::OPT_STRINGIFY_NUMBERS
#
#Bool, default: 0.
#
#If set to true, will dump numbers as quoted string, e.g. 123 as "123" instead of
#123. This might be helpful if you want to compute the hash of or get a canonical
#representation of data structure.
#
#=head2 $Data::Dmp::OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS
#
#Int, default: 70.
#
#Used by L</dd_ellipsis> and L</dmp_ellipsis>.
#
#=head1 BENCHMARKS
#
# [1..10]:
#                      Rate    Data::Dump Data::Dumper Data::Dmp
# Data::Dump    32032+-55/s            --       -64.6%    -73.9%
# Data::Dumper 90580+-110/s 182.77+-0.59%           --    -26.1%
# Data::Dmp    122575+-43/s 282.66+-0.67% 35.32+-0.17%        --
# 
# [1..100]:
#                       Rate    Data::Dump   Data::Dmp Data::Dumper
# Data::Dump   3890.6+-5.9/s            --      -73.7%       -73.7%
# Data::Dmp     14768.3+-5/s 279.59+-0.59%          --        -0.1%
# Data::Dumper   14790+-87/s   280.2+-2.3% 0.15+-0.59%           --
# 
# Some mixed structure:
#                     Rate    Data::Dump   Data::Dmp Data::Dumper
# Data::Dump    9035+-17/s            --      -68.3%       -80.9%
# Data::Dmp    28504+-10/s 215.47+-0.59%          --       -39.6%
# Data::Dumper 47188+-55/s   422.3+-1.1% 65.55+-0.2%           --
#
#=head1 FUNCTIONS
#
#=head2 dd
#
#Usage:
#
# dd($data, ...); # returns $data
#
#Exported by default. Like C<Data::Dump>'s C<dd> (a.k.a. C<dump>), print one or
#more data to STDOUT. Unlike C<Data::Dump>'s C<dd>, it I<always> prints and
#return I<the original data> (like L<XXX>), making it convenient to insert into
#expressions. This also removes ambiguity and saves one C<wantarray()> call.
#
#=head2 dmp
#
#Usage:
#
# my $dump = dmp($data, ...);
#
#Exported by default. Return dump result as string. Unlike C<Data::Dump>'s C<dd>
#(a.k.a. C<dump>), it I<never> prints and only return the dump result.
#
#=head2 dd_ellipsis
#
#Usage:
#
# dd_ellipsis($data, ...); # returns data
#
#Just like L</dd>, except will truncate its output to
#L</$Data::Dmp::OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS> characters if dump is too long.
#Note that truncated dump will probably not be valid Perl code.
#
#=head2 dmp_ellipsis
#
#Usage:
#
# my $dump = dd_ellipsis($data, ...); # returns data
#
#Just like L</dmp>, except will truncate dump result to
#L</$Data::Dmp::OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS> characters if dump is too long.
#Note that truncated dump will probably not be valid Perl code.
#
#=head1 FAQ
#
#=head2 When to use Data::Dmp? How does it compare to other dumper modules?
#
#Data::Dmp might be suitable for you if you want a relatively fast pure-Perl data
#structure dumper to eval-able Perl code. It produces compact, single-line Perl
#code but offers little/no formatting options. Data::Dmp and Data::Dump module
#family usually produce Perl code that is "more eval-able", e.g. it can recreate
#circular structure.
#
#L<Data::Dump> produces visually nicer output (some alignment, use of range
#operator to shorten lists, use of base64 for binary data, etc) but no built-in
#option to produce compact/single-line output. It's more suitable for debugging.
#It's also relatively slow. I usually use its variant, L<Data::Dump::Color>, for
#console debugging.
#
#L<Data::Dumper> is a core module, offers a lot of formatting options (like
#disabling hash key sorting, setting verboseness/indent level, and so on) but you
#usually have to configure it quite a bit before it does exactly like you want
#(that's why there are modules on CPAN that are just wrapping Data::Dumper with
#some configuration, like L<Data::Dumper::Concise> et al). It does not support
#dumping Perl code that can recreate circular structures.
#
#Of course, dumping to eval-able Perl code is slow (not to mention the cost of
#re-loading the code back to in-memory data, via eval-ing) compared to dumping to
#JSON, YAML, Sereal, or other format. So you need to decide first whether this is
#the appropriate route you want to take. (But note that there is also
#L<Data::Dumper::Limited> and L<Data::Undump> which uses a format similar to
#Data::Dumper but lets you load the serialized data without eval-ing them, thus
#achieving the speed comparable to JSON::XS).
#
#=head2 Is the output guaranteed to be single line dump?
#
#No. Some things can still produce multiline dump, e.g. newline in regular
#expression.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Dmp>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Dmp>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Dmp>
#
#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<Data::Dump> and other variations/derivate works in Data::Dump::*.
#
#L<Data::Dumper> and its variants.
#
#L<Data::Printer>.
#
#L<YAML>, L<JSON>, L<Storable>, L<Sereal>, and other serialization formats.
#
#=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
### Data/ModeMerge.pm ###
#package Data::ModeMerge;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT = qw(mode_merge);
#
#sub mode_merge {
#    my ($l, $r, $config_vars) = @_;
#    my $mm = __PACKAGE__->new(config => $config_vars);
#    $mm->merge($l, $r);
#}
#
#has config => (is => "rw");
#
## hash of modename => handler
#has modes => (is => 'rw', default => sub { {} });
#
#has combine_rules => (is => 'rw');
#
## merging process state
#has path => (is => "rw", default => sub { [] });
#has errors => (is => "rw", default => sub { [] });
#has mem => (is => "rw", default => sub { {} }); # for handling circular refs. {key=>{res=>[...], todo=>[sub1, ...]}, ...}
#has cur_mem_key => (is => "rw"); # for handling circular refs. instead of passing around this as argument, we put it here.
#
#sub _in($$) {
#    state $load_dmp = do { require Data::Dmp };
#    my ($self, $needle, $haystack) = @_;
#    return 0 unless defined($needle);
#    my $r1 = ref($needle);
#    my $f1 = $r1 ? Data::Dmp::dmp($needle) : undef;
#    for (@$haystack) {
#        my $r2 = ref($_);
#        next if $r1 xor $r2;
#        return 1 if  $r2 && $f1 eq Data::Dmp::dmp($_);
#        return 1 if !$r2 && $needle eq $_;
#    }
#    0;
#}
#
#sub BUILD {
#    require Data::ModeMerge::Config;
#
#    my ($self, $args) = @_;
#
#    if ($self->config) {
#        # some sanity checks
#        my $is_hashref = ref($self->config) eq 'HASH';
#        die "config must be a hashref or a Data::ModeMerge::Config" unless
#            $is_hashref || UNIVERSAL::isa($self->config, "Data::ModeMerge::Config");
#        $self->config(Data::ModeMerge::Config->new(%{ $self->config })) if $is_hashref;
#    } else {
#        $self->config(Data::ModeMerge::Config->new);
#    }
#
#    for (qw(NORMAL KEEP ADD CONCAT SUBTRACT DELETE)) {
#	$self->register_mode($_);
#    }
#
#    if (!$self->combine_rules) {
#        $self->combine_rules({
#            # "left + right" => [which mode to use, which mode after merge]
#            'ADD+ADD'            => ['ADD'     , 'ADD'   ],
#            #'ADD+CONCAT'         => undef,
#            'ADD+DELETE'         => ['DELETE'  , 'DELETE'],
#            #'ADD+KEEP'           => undef,
#            'ADD+NORMAL'         => ['NORMAL'  , 'NORMAL'],
#            'ADD+SUBTRACT'       => ['SUBTRACT', 'ADD'   ],
#
#            #'CONCAT+ADD'         => undef,
#            'CONCAT+CONCAT'      => ['CONCAT'  , 'CONCAT'],
#            'CONCAT+DELETE'      => ['DELETE'  , 'DELETE'],
#            #'CONCAT+KEEP'        => undef,
#            'CONCAT+NORMAL'      => ['NORMAL'  , 'NORMAL'],
#            #'CONCAT+SUBTRACT'    => undef,
#
#            'DELETE+ADD'         => ['NORMAL'  , 'ADD'     ],
#            'DELETE+CONCAT'      => ['NORMAL'  , 'CONCAT'  ],
#            'DELETE+DELETE'      => ['DELETE'  , 'DELETE'  ],
#            'DELETE+KEEP'        => ['NORMAL'  , 'KEEP'    ],
#            'DELETE+NORMAL'      => ['NORMAL'  , 'NORMAL'  ],
#            'DELETE+SUBTRACT'    => ['NORMAL'  , 'SUBTRACT'],
#
#            'KEEP+ADD'          => ['KEEP', 'KEEP'],
#            'KEEP+CONCAT'       => ['KEEP', 'KEEP'],
#            'KEEP+DELETE'       => ['KEEP', 'KEEP'],
#            'KEEP+KEEP'         => ['KEEP', 'KEEP'],
#            'KEEP+NORMAL'       => ['KEEP', 'KEEP'],
#            'KEEP+SUBTRACT'     => ['KEEP', 'KEEP'],
#
#            'NORMAL+ADD'        => ['ADD'     , 'NORMAL'],
#            'NORMAL+CONCAT'     => ['CONCAT'  , 'NORMAL'],
#            'NORMAL+DELETE'     => ['DELETE'  , 'NORMAL'],
#            'NORMAL+KEEP'       => ['NORMAL'  , 'KEEP'  ],
#            'NORMAL+NORMAL'     => ['NORMAL'  , 'NORMAL'],
#            'NORMAL+SUBTRACT'   => ['SUBTRACT', 'NORMAL'],
#
#            'SUBTRACT+ADD'      => ['SUBTRACT', 'SUBTRACT'],
#            #'SUBTRACT+CONCAT'   => undef,
#            'SUBTRACT+DELETE'   => ['DELETE'  , 'DELETE'  ],
#            #'SUBTRACT+KEEP'     => undef,
#            'SUBTRACT+NORMAL'   => ['NORMAL'  , 'NORMAL'  ],
#            'SUBTRACT+SUBTRACT' => ['ADD'     , 'SUBTRACT'],
#        });
#    }
#}
#
#sub push_error {
#    my ($self, $errmsg) = @_;
#    push @{ $self->errors }, [[@{ $self->path }], $errmsg];
#    return;
#}
#
#sub register_mode {
#    my ($self, $name0) = @_;
#    my $obj;
#    if (ref($name0)) {
#        my $obj = $name0;
#    } elsif ($name0 =~ /^\w+(::\w+)+$/) {
#        eval "require $name0; \$obj = $name0->new";
#        die "Can't load module $name0: $@" if $@;
#    } elsif ($name0 =~ /^\w+$/) {
#        my $modname = "Data::ModeMerge::Mode::$name0";
#        eval "require $modname; \$obj = $modname->new";
#        die "Can't load module $modname: $@" if $@;
#    } else {
#        die "Invalid mode name $name0";
#    }
#    my $name = $obj->name;
#    die "Mode $name already registered" if $self->modes->{$name};
#    $obj->merger($self);
#    $self->modes->{$name} = $obj;
#}
#
#sub check_prefix {
#    my ($self, $hash_key) = @_;
#    die "Hash key not a string" if ref($hash_key);
#    my $dis = $self->config->disable_modes;
#    if (defined($dis) && ref($dis) ne 'ARRAY') {
#        $self->push_error("Invalid config value `disable_modes`: must be an array");
#        return;
#    }
#    for my $mh (sort { $b->precedence_level <=> $a->precedence_level }
#                grep { !$dis || !$self->_in($_->name, $dis) }
#                values %{ $self->modes }) {
#        if ($mh->check_prefix($hash_key)) {
#            return $mh->name;
#        }
#    }
#    return;
#}
#
#sub check_prefix_on_hash {
#    my ($self, $hash) = @_;
#    die "Not a hash" unless ref($hash) eq 'HASH';
#    my $res = 0;
#    for (keys %$hash) {
#	do { $res++; last } if $self->check_prefix($_);
#    }
#    $res;
#}
#
#sub add_prefix {
#    my ($self, $hash_key, $mode) = @_;
#    die "Hash key not a string" if ref($hash_key);
#    my $dis = $self->config->disable_modes;
#    if (defined($dis) && ref($dis) ne 'ARRAY') {
#        die "Invalid config value `disable_modes`: must be an array";
#    }
#    if ($dis && $self->_in($mode, $dis)) {
#        $self->push_error("Can't add prefix for currently disabled mode `$mode`");
#        return $hash_key;
#    }
#    my $mh = $self->modes->{$mode} or die "Unknown mode: $mode";
#    $mh->add_prefix($hash_key);
#}
#
#sub remove_prefix {
#    my ($self, $hash_key) = @_;
#    die "Hash key not a string" if ref($hash_key);
#    my $dis = $self->config->disable_modes;
#    if (defined($dis) && ref($dis) ne 'ARRAY') {
#        die "Invalid config value `disable_modes`: must be an array";
#    }
#    for my $mh (sort { $b->precedence_level <=> $a->precedence_level }
#                grep { !$dis || !$self->_in($_->name, $dis) }
#                values %{ $self->modes }) {
#        if ($mh->check_prefix($hash_key)) {
#            my $r = $mh->remove_prefix($hash_key);
#            if (wantarray) { return ($r, $mh->name) }
#            else           { return $r }
#        }
#    }
#    if (wantarray) { return ($hash_key, $self->config->default_mode) }
#    else           { return $hash_key }
#}
#
#sub remove_prefix_on_hash {
#    my ($self, $hash) = @_;
#    die "Not a hash" unless ref($hash) eq 'HASH';
#    for (keys %$hash) {
#	my $old = $_;
#	$_ = $self->remove_prefix($_);
#	next unless $old ne $_;
#	die "Conflict when removing prefix on hash: $old -> $_ but $_ already exists"
#	    if exists $hash->{$_};
#	$hash->{$_} = $hash->{$old};
#	delete $hash->{$old};
#    }
#    $hash;
#}
#
#sub merge {
#    my ($self, $l, $r) = @_;
#    $self->path([]);
#    $self->errors([]);
#    $self->mem({});
#    $self->cur_mem_key(undef);
#    my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
#    {
#        success => !@{ $self->errors },
#        error   => (@{ $self->errors } ?
#                    join(", ",
#                         map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
#                             @{ $self->errors }) : ''),
#        result  => $res,
#        backup  => $backup,
#    };
#}
#
## handle circular refs: process todo's
#sub _process_todo {
#    my ($self) = @_;
#    if ($self->cur_mem_key) {
#        for my $mk (keys %{ $self->mem }) {
#            my $res = $self->mem->{$mk}{res};
#            if (defined($res) && @{ $self->mem->{$mk}{todo} }) {
#                #print "DEBUG: processing todo for mem<$mk>\n";
#                for (@{  $self->mem->{$mk}{todo} }) {
#                    $_->(@$res);
#                    return if @{ $self->errors };
#                }
#                $self->mem->{$mk}{todo} = [];
#            }
#        }
#    }
#}
#
#sub _merge {
#    my ($self, $key, $l, $r, $mode) = @_;
#    my $c = $self->config;
#    $mode //= $c->default_mode;
#
#    my $mh = $self->modes->{$mode};
#    die "Can't find handler for mode $mode" unless $mh;
#
#    # determine which merge method we will call
#    my $rl = ref($l);
#    my $rr = ref($r);
#    my $tl = $rl eq 'HASH' ? 'HASH' : $rl eq 'ARRAY' ? 'ARRAY' : $rl eq 'CODE' ? 'CODE' : !$rl ? 'SCALAR' : '';
#    my $tr = $rr eq 'HASH' ? 'HASH' : $rr eq 'ARRAY' ? 'ARRAY' : $rr eq 'CODE' ? 'CODE' : !$rr ? 'SCALAR' : '';
#    if (!$tl) { $self->push_error("Unknown type in left side: $rl"); return }
#    if (!$tr) { $self->push_error("Unknown type in right side: $rr"); return }
#    if (!$c->allow_create_array && $tl ne 'ARRAY' && $tr eq 'ARRAY') {
#        $self->push_error("Not allowed to create array"); return;
#    }
#    if (!$c->allow_create_hash && $tl ne 'HASH' && $tr eq 'HASH') {
#        $self->push_error("Not allowed to create hash"); return;
#    }
#    if (!$c->allow_destroy_array && $tl eq 'ARRAY' && $tr ne 'ARRAY') {
#        $self->push_error("Not allowed to destroy array"); return;
#    }
#    if (!$c->allow_destroy_hash && $tl eq 'HASH' && $tr ne 'HASH') {
#        $self->push_error("Not allowed to destroy hash"); return;
#    }
#    my $meth = "merge_${tl}_${tr}";
#    if (!$mh->can($meth)) { $self->push_error("No merge method found for $tl + $tr (mode $mode)"); return }
#
#    #$self->_process_todo;
#    # handle circular refs: add to todo if necessary
#    my $memkey;
#    if ($rl || $rr) {
#        $memkey = sprintf "%s%s %s%s %s %s",
#            (defined($l) ? ($rl ? 2 : 1) : 0),
#            (defined($l) ? "$l" : ''),
#            (defined($r) ? ($rr ? 2 : 1) : 0),
#            (defined($r) ? "$r" : ''),
#            $mode,
#            $self->config;
#        #print "DEBUG: number of keys in mem = ".scalar(keys %{ $self->mem })."\n";
#        #print "DEBUG: mem keys = \n".join("", map { "  $_\n" } keys %{ $self->mem }) if keys %{ $self->mem };
#        #print "DEBUG: calculating memkey = <$memkey>\n";
#    }
#    if ($memkey) {
#        if (exists $self->mem->{$memkey}) {
#            $self->_process_todo;
#            if (defined $self->mem->{$memkey}{res}) {
#                #print "DEBUG: already calculated, using cached result\n";
#                return @{ $self->mem->{$memkey}{res} };
#            } else {
#                #print "DEBUG: detecting circular\n";
#                return ($key, undef, undef, 1);
#            }
#        } else {
#            $self->mem->{$memkey} = {res=>undef, todo=>[]};
#            $self->cur_mem_key($memkey);
#            #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
#            my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
#            #print "DEBUG: setting res for mem<$memkey>\n";
#            $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
#            $self->_process_todo;
#            return ($newkey, $res, $backup);
#        }
#    } else {
#        $self->_process_todo;
#        #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
#        return $mh->$meth($key, $l, $r);
#    }
#}
#
## returns 1 if a is included in b (e.g. [user => "jajang"] in included in [user
## => jajang => "quota"], but [user => "paijo"] is not)
#sub _path_is_included {
#    my ($self, $p1, $p2) = @_;
#    my $res = 1;
#    for my $i (0..@$p1-1) {
#        do { $res = 0; last } if !defined($p2->[$i]) || $p1->[$i] ne $p2->[$i];
#    }
#    #print "_path_is_included([".join(", ", @$p1)."], [".join(", ", @$p2)."])? $res\n";
#    $res;
#}
#
#1;
## ABSTRACT: Merge two nested data structures, with merging modes and options
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge - Merge two nested data structures, with merging modes and options
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
#    use Data::ModeMerge;
#
#    my $hash1 = { a=>1,    c=>1, d=>{  da =>[1]} };
#    my $hash2 = { a=>2, "-c"=>2, d=>{"+da"=>[2]} };
#
#
#    # if you want Data::ModeMerge to behave like many other merging
#    # modules (e.g. Hash::Merge or Data::Merger), turn off modes
#    # (prefix) parsing and options key parsing.
#
#    my $mm = Data::ModeMerge->new(config => {parse_prefix=>0, options_key=>undef});
#    my $res = $mm->merge($hash1, $hash2);
#    die $res->{error} if $res->{error};
#    # $res->{result} -> { a=>2, c=>1, "-c"=>2, d=>{da=>[1], "+da"=>[2]} }
#
#
#    # otherwise Data::ModeMerge will parse prefix as well as options
#    # key
#
#    my $res = $mm->merge($hash1, $hash2);
#    die $res->{error} if $res->{error};
#    # $res->{result} -> { a=>2, c=>-1, d=>{da=>[1,2]} }
#
#    $res = $merge({  a =>1, {  a2 =>1, ""=>{parse_prefix=>0}},
#                  {".a"=>2, {".a2"=>2                       }});
#    # $res->{result} -> { a=>12, {a2=>1, ".a2"=>2} }, parse_prefix is turned off in just the subhash
#
#
#    # procedural interface
#
#    my $res = mode_merge($hash1, $hash2, {allow_destroy_hash=>0});
#
#=head1 DESCRIPTION
#
#There are already several modules on CPAN to do recursive data
#structure merging, like L<Data::Merger> and
#L<Hash::Merge>. C<Data::ModeMerge> differs in that it offers merging
#"modes" and "options". It provides greater flexibility on what the
#result of a merge between two data should/can be. This module may or
#may not be what you need.
#
#One application of this module is in handling configuration. Often
#there are multiple levels of configuration, e.g. in your typical Unix
#command-line program there are system-wide config file in /etc,
#per-user config file under ~/, and command-line options. It's
#convenient programatically to load each of those in a hash and then
#merge system-wide hash with the per-user hash, and then merge the
#result with the command-line hash to get the a single hash as the
#final configuration. Your program can from there on deal with this
#just one hash instead of three.
#
#In a typical merging process between two hashes (left-side and
#right-side), when there is a conflicting key, then the right-side key
#will override the left-side. This is usually the desired behaviour in
#our said program as the system-wide config is there to provide
#defaults, and the per-user config (and the command-line arguments)
#allow a user to override those defaults.
#
#But suppose that the user wants to I<unset> a certain configuration
#setting that is defined by the system-wide config? She can't do that
#unless she edits the system-wide config (in which she might need admin
#rights), or the program allows the user to disregard the system-wide
#config. The latter is usually what's implemented by many Unix
#programs, e.g. the C<-noconfig> command-line option in C<mplayer>. But
#this has two drawbacks: a slightly added complexity in the program
#(need to provide a special, extra comand-line option) and the user
#loses all the default settings in the system-wide config. What she
#needed in the first place was to just unset I<a single setting> (a
#single key-value pair of the hash).
#
#L<Data::ModeMerge> comes to the rescue. It provides a so-called
#C<DELETE mode>.
#
# mode_merge({foo=>1, bar=>2}, {"!foo"=>undef, bar=>3, baz=>1});
#
#will result ini:
#
# {bar=>3, baz=>1}
#
#The C<!> prefix tells Data::ModeMerge to do a DELETE mode merging. So
#the final result will lack the C<foo> key.
#
#On the other hand, what if the system admin wants to I<protect> a
#certain configuration setting from being overriden by the user or the
#command-line? This is useful in a hosting or other retrictive
#environment where we want to limit users' freedom to some levels. This
#is possible via the KEEP mode merging.
#
# mode_merge({"^bar"=>2, "^baz"=>1}, {bar=>3, "!baz"=>0, qux=>7});
#
#will result in:
#
# {"^bar"=>2, "^baz"=>1, qux=>7}
#
#effectively protecting C<bar> and C<baz> from being
#overriden/deleted/etc.
#
#Aside from the two mentioned modes, there are also a few others
#available by default: ADD (prefix C<+>), CONCAT (prefix C<.>),
#SUBTRACT (prefix C<->), as well as the plain ol' NORMAL/override
#(optional prefix C<*>).
#
#You can add other modes by writing a mode handler module.
#
#You can change the default prefixes for each mode if you want. You can
#disable each mode individually.
#
#You can default to always using a certain mode, like the NORMAL mode,
#and ignore all the prefixes, in which case Data::ModeMerge will behave
#like most other merge modules.
#
#There are a few other options like whether or not the right side is
#allowed a "change the structure" of the left side (e.g. replacing a
#scalar with an array/hash, destroying an existing array/hash with
#scalar), maximum length of scalar/array/hash, etc.
#
#You can change default mode, prefixes, disable/enable modes, etc on a
#per-hash basis using the so-called B<options key>. See the B<OPTIONS
#KEY> section for more details.
#
#This module can handle (though not all possible cases)
#circular/recursive references.
#
#=for Pod::Coverage ^(BUILD)$
#
#=head1 MERGING PREFIXES AND YOUR DATA
#
#Merging with this module means you need to be careful when your hash
#keys might contain one of the mode prefixes characters by accident,
#because it will trigger the wrong merge mode and moreover the prefix
#characters will be B<stripped> from the final result (unless you
#configure the module not to do so).
#
#A rather common case is when you have regexes in your hash
#keys. Regexes often begins with C<^>, which coincidentally is a prefix
#for the KEEP mode. Or perhaps you have dot filenames as hash keys,
#where it clashes with the CONCAT mode. Or perhaps shell wildcards,
#where C<*> is also used as the prefix for NORMAL mode.
#
#To avoid clashes, you can either:
#
#=over 4
#
#=item * exclude the keys using
#C<exclude_merge>/C<include_merge>/C<exclude_parse>/C<include_parse>
#config settings
#
#=item * turn off some modes which you don't want via the
#C<disable_modes> config
#
#=item * change the prefix for that mode so that it doesn't clash with
#your data via the C<set_prefix> config
#
#=item * disable prefix parsing altogether via setting C<parse_prefix>
#config to 0
#
#=back
#
#You can do this via the configuration, or on a per-hash basis, using
#the options key.
#
#See L<Data::ModeMerge::Config> for more details on configuration.
#
#=head1 OPTIONS KEY
#
#Aside from merging mode prefixes, you also need to watch out if your
#hash contains a "" (empty string) key, because by default this is the
#key used for options key.
#
#Options key are used to specify configuration on a per-hash basis.
#
#If your hash keys might contain "" keys which are not meant to be an
#options key, you can either:
#
#=over 4
#
#=item * change the name of the key for options key, via setting
#C<options_key> config to another string.
#
#=item * turn off options key mechanism,
#by setting C<options_key> config to undef.
#
#=back
#
#See L<Data::ModeMerge::Config> for more details about options key.
#
#=head1 MERGING MODES
#
#=head2 NORMAL (optional '*' prefix on left/right side)
#
# mode_merge({  a =>11, b=>12}, {  b =>22, c=>23}); # {a=>11, b=>22, c=>23}
# mode_merge({"*a"=>11, b=>12}, {"*b"=>22, c=>23}); # {a=>11, b=>22, c=>23}
#
#=head2 ADD ('+' prefix on the right side)
#
# mode_merge({i=>3}, {"+i"=>4, "+j"=>1}); # {i=>7, j=>1}
# mode_merge({a=>[1]}, {"+a"=>[2, 3]}); # {a=>[1, 2, 3]}
#
#Additive merge on hashes will be treated like a normal merge.
#
#=head2 CONCAT ('.' prefix on the right side)
#
# mode_merge({i=>3}, {".i"=>4, ".j"=>1}); # {i=>34, j=>1}
#
#Concative merge on arrays will be treated like additive merge.
#
#=head2 SUBTRACT ('-' prefix on the right side)
#
# mode_merge({i=>3}, {"-i"=>4}); # {i=>-1}
# mode_merge({a=>["a","b","c"]}, {"-a"=>["b"]}); # {a=>["a","c"]}
#
#Subtractive merge on hashes behaves like a normal merge, except that
#each key on the right-side hash without any prefix will be assumed to
#have a DELETE prefix, i.e.:
#
# mode_merge({h=>{a=>1, b=>1}}, {-h=>{a=>2, "+b"=>2, c=>2}})
#
#is equivalent to:
#
# mode_merge({h=>{a=>1, b=>1}}, {h=>{"!a"=>2, "+b"=>2, "!c"=>2}})
#
#and will merge to become:
#
# {h=>{b=>3}}
#
#=head2 DELETE ('!' prefix on the right side)
#
# mode_merge({x=>WHATEVER}, {"!x"=>WHATEVER}); # {}
#
#=head2 KEEP ('^' prefix on the left/right side)
#
#If you add '^' prefix on the left side, it will be protected from
#being replaced/deleted/etc.
#
# mode_merge({'^x'=>WHATEVER1}, {"x"=>WHATEVER2}); # {x=>WHATEVER1}
#
#For hashes, KEEP mode means that all keys on the left side will not be
#replaced/modified/deleted, *but* you can still add more keys from the
#right side hash.
#
# mode_merge({a=>1, b=>2, c=>3},
#            {a=>4, '^c'=>1, d=>5},
#            {default_mode=>'KEEP'});
#            # {a=>1, b=>2, c=>3, d=>5}
#
#Multiple prefixes on the right side is allowed, where the merging will
#be done by precedence level (highest first):
#
# mode_merge({a=>[1,2]}, {'-a'=>[1], '+a'=>[10]}); # {a=>[2,10]}
#
#but not on the left side:
#
# mode_merge({a=>1, '^a'=>2}, {a=>3}); # error!
#
#Precedence levels (from highest to lowest):
#
# KEEP
# NORMAL
# SUBTRACT
# CONCAT ADD
# DELETE
#
#=head1 CREATING AND USING YOUR OWN MODE
#
#Let's say you want to add a mode named C<FOO>. It will have the prefix
#'?'.
#
#Create the mode handler class,
#e.g. C<Data::ModeMerge::Mode::FOO>. It's probably best to subclass
#from L<Data::ModeMerge::Mode::Base>. The class must implement name(),
#precedence_level(), default_prefix(), default_prefix_re(), and
#merge_{SCALAR,ARRAY,HASH}_{SCALAR,ARRAY,HASH}(). For more details, see
#the source code of Base.pm and one of the mode handlers
#(e.g. NORMAL.pm).
#
#To use the mode, register it:
#
# my $mm = Data::ModeMerge->new;
# $mm->register_mode('FOO');
#
#This will require C<Data::ModeMerge::Mode::FOO>. After that, define
#the operations against other modes:
#
# # if there's FOO on the left and NORMAL on the right, what mode
# # should the merge be done in (FOO), and what the mode should be
# # after the merge? (NORMAL)
# $mm->combine_rules->{"FOO+NORMAL"} = ["FOO", "NORMAL"];
#
# # we don't define FOO+ADD
#
# $mm->combine_rules->{"FOO+KEEP"} = ["KEEP", "KEEP"];
#
# # and so on
#
#=head1 FUNCTIONS
#
#=head2 mode_merge($l, $r[, $config_vars])
#
#A non-OO wrapper for merge() method. Exported by default. See C<merge>
#method for more details.
#
#=head1 ATTRIBUTES
#
#=head2 config
#
#A hashref for config. See L<Data::ModeMerge::Config>.
#
#=head2 modes
#
#=head2 combine_rules
#
#=head2 path
#
#=head2 errors
#
#=head2 mem
#
#=head2 cur_mem_key
#
#=head1 METHODS
#
#For typical usage, you only need merge().
#
#=head2 push_error($errmsg)
#
#Used by mode handlers to push error when doing merge. End users
#normally should not need this.
#
#=head2 register_mode($name_or_package_or_obj)
#
#Register a mode. Will die if mode with the same name already exists.
#
#=head2 check_prefix($hash_key)
#
#Check whether hash key has prefix for certain mode. Return the name of
#the mode, or undef if no prefix is detected.
#
#=head2 check_prefix_on_hash($hash)
#
#This is like C<check_prefix> but performed on every key of the
#specified hash. Return true if any of the key contain a merge prefix.
#
#=head2 add_prefix($hash_key, $mode)
#
#Return hash key with added prefix with specified mode. Log merge error
#if mode is unknown or is disabled.
#
#=head2 remove_prefix($hash_key)
#
#Return hash key will any prefix removed.
#
#=head2 remove_prefix_on_hash($hash)
#
#This is like C<remove_prefix> but performed on every key of the
#specified hash. Return the same hash but with prefixes removed.
#
#=head2 merge($l, $r)
#
#Merge two nested data structures. Returns the result hash: {
#success=>0|1, error=>'...', result=>..., backup=>... }. The 'error'
#key is set to contain an error message if there is an error. The merge
#result is in the 'result' key. The 'backup' key contains replaced
#elements from the original hash/array.
#
#=head1 FAQ
#
#=head2 What is this module good for? Why would I want to use this module instead of the other hash merge modules?
#
#If you just need to (deeply) merge two hashes, chances are you do not
#need this module. Use, for example, L<Hash::Merge>, which is also
#flexible enough because it allows you to set merging behaviour for
#merging different types (e.g. SCALAR vs ARRAY).
#
#You might need this module if your data is recursive/self-referencing
#(which, last time I checked, is not handled well by Hash::Merge), or
#if you want to be able to merge differently (i.e. apply different
#merging B<modes>) according to different prefixes on the key, or
#through special key. In other words, you specify merging modes from
#inside the hash itself.
#
#I originally wrote Data::ModeMerge this for L<Data::Schema> and
#L<Config::Tree>. I want to reuse the "parent" schema (or
#configuration) in more ways other than just override conflicting
#keys. I also want to be able to allow the parent to protect certain
#keys from being overriden. I found these two features lacking in all
#merging modules that I've evaluated prior to writing Data::ModeMerge.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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<Data::ModeMerge::Config>
#
#Other merging modules on CPAN: L<Data::Merger> (from Data-Utilities),
#L<Hash::Merge>, L<Hash::Merge::Simple>
#
#L<Data::Schema> and L<Config::Tree> (among others, two modules which
#use Data::ModeMerge)
#
#=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
### Data/ModeMerge/Config.pm ###
#package Data::ModeMerge::Config;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use Mo qw(build default);
#
#has recurse_hash          => (is => 'rw', default => sub{1});
#has recurse_array         => (is => 'rw', default => sub{0});
#has parse_prefix          => (is => 'rw', default => sub{1});
#has wanted_path           => (is => 'rw');
#has default_mode          => (is => 'rw', default => sub{'NORMAL'});
#has disable_modes         => (is => 'rw');
#has allow_create_array    => (is => 'rw', default => sub{1});
#has allow_create_hash     => (is => 'rw', default => sub{1});
#has allow_destroy_array   => (is => 'rw', default => sub{1});
#has allow_destroy_hash    => (is => 'rw', default => sub{1});
#has exclude_parse         => (is => 'rw');
#has exclude_parse_regex   => (is => 'rw');
#has include_parse         => (is => 'rw');
#has include_parse_regex   => (is => 'rw');
#has exclude_merge         => (is => 'rw');
#has exclude_merge_regex   => (is => 'rw');
#has include_merge         => (is => 'rw');
#has include_merge_regex   => (is => 'rw');
#has set_prefix            => (is => 'rw');
#has readd_prefix          => (is => 'rw', default => sub{1});
#has premerge_pair_filter  => (is => 'rw');
#has options_key           => (is => 'rw', default => sub{''});
#has allow_override        => (is => 'rw');
#has disallow_override     => (is => 'rw');
#
## list of config settings only available in merger-object's config
## (not in options key)
#sub _config_config {
#    state $a = [qw/
#        wanted_path
#        options_key
#        allow_override
#        disallow_override
#                  /];
#}
#
## list of config settings available in options key
#sub _config_ok {
#    state $a = [qw/
#        recurse_hash
#        recurse_array
#        parse_prefix
#        default_mode
#        disable_modes
#        allow_create_array
#        allow_create_hash
#        allow_destroy_array
#        allow_destroy_hash
#        exclude_parse
#        exclude_parse_regex
#        include_parse
#        include_parse_regex
#        exclude_merge
#        exclude_merge_regex
#        include_merge
#        include_merge_regex
#        set_prefix
#        readd_prefix
#        premerge_pair_filter
#                  /];
#}
#
#1;
## ABSTRACT: Data::ModeMerge configuration
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Config - Data::ModeMerge configuration
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Config (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# # getting configuration
# if ($mm->config->allow_extra_hash_keys) { ... }
#
# # setting configuration
# $mm->config->max_warnings(100);
#
#=head1 DESCRIPTION
#
#Configuration variables for Data::ModeMerge.
#
#=head1 ATTRIBUTES
#
#=head2 recurse_hash => BOOL
#
#Context: config, options key
#
#Default: 1
#
#Whether to recursively merge hash. When 1, each key-value pair between
#2 hashes will be recursively merged. Otherwise, the right-side hash
#will just replace the left-side.
#
#Options key will not be parsed under recurse_hash=0.
#
#Example:
#
# mode_merge({h=>{a=>1}}, {h=>{b=>1}}                   ); # {h=>{a=>1, b=>1}}
# mode_merge({h=>{a=>1}}, {h=>{b=>1}}, {recurse_hash=>0}); # {h=>{b=>1}}
#
#=head2 recurse_array => BOOL
#
#Context: config, options key
#
#Default: 0
#
#Whether to recursively merge array. When 1, each element is
#recursively merged. Otherwise, the right-side array will just replace
#the left-side.
#
#Example:
#
# mode_merge([1, 1], [4]                    ); # [4, 1]
# mode_merge([1, 1], [4], {recurse_array=>0}); # [2]
#
#=head2 parse_prefix => BOOL
#
#Context: config, options key
#
#Default: 1
#
#Whether to parse merge prefix in hash keys. If set to 0, merging
#behaviour is similar to most other nested merge modules.
#
# mode_merge({a=>1}, {"+a"=>2}                   ); # {a=>3}
# mode_merge({a=>1}, {"+a"=>2}, {parse_prefix=>0}); # {a=>1, "+a"=>2}
#
#=head2 wanted_path => ARRAYREF
#
#Context: config, options key
#
#Default: undef
#
#If set, merging is only done to the specified "branch". Useful to save
#time/storage when merging large hash "trees" while you only want a
#certain branch of the trees (e.g. resolving just a config variable
#from several config hashes).
#
#Example:
#
# mode_merge(
#   {
#    user => {
#      jajang => { quota => 100, admin => 1 },
#      paijo  => { quota =>  50, admin => 0 },
#      kuya   => { quota => 150, admin => 0 },
#    },
#    groups => [qw/admin staff/],
#   },
#   {
#    user => {
#      jajang => { quota => 1000 },
#    }
#   }
# );
#
#With wanted_path unset, the result would be:
#
#   {
#    user => {
#      jajang => { quota => 1000, admin => 1 },
#      paijo  => { quota =>   50, admin => 0 },
#      kuya   => { quota =>  150, admin => 0 },
#    }
#    groups => [qw/admin staff/],
#   }
#
#With wanted_path set to ["user", "jajang", "quota"] (in other words,
#you're saying that you'll be disregarding other branches), the result
#would be:
#
#   {
#    user => {
#      jajang => { quota => 1000, admin => undef },
#    }
#   }
#
#=head2 default_mode => 'NORMAL' | 'ADD' | 'CONCAT' | 'SUBTRACT' | 'DELETE' | 'KEEP' | ...
#
#Context: config, options key
#
#Default: NORMAL
#
#Example:
#
# mode_merge(3, 4                         ); # 4
# mode_merge(3, 4, {default_mode => "ADD"}); # 7
#
#=head2 disable_modes => ARRAYREF
#
#Context: config, options key
#
#Default: []
#
#List of modes to ignore the prefixes of.
#
#Example:
#
# mode_merge({add=>1, del=>2, concat=>3},
#            {add=>2, "!del"=>0, .concat=>4},
#            {disable_modes=>[qw/CONCAT/]});
# #          {add=>3,         concat=>3, .concat=>4}
#
#See also: C<parse_prefix> which if set to 0 will in effect disable all
#modes except the default mode.
#
#=head2 allow_create_array => BOOL
#
#Context: config, options key
#
#Default: 1
#
#If enabled, then array creation will be allowed (from something
#non-array, like a hash/scalar). Setting to 0 is useful if you want to
#avoid the merge to "change the structure" of the left side.
#
#Example:
#
# mode_merge(1, [1,2]                         ); # success, result=[1,2]
# mode_merge(1, [1,2], {allow_create_array=>0}); # failed, can't create array
#
#=head2 allow_create_hash => BOOL
#
#Context: config, options key
#
#Default: 1
#
#If enabled, then hash creation will be allowed (from something
#non-hash, like array/scalar). Setting to 0 is useful if you want to
#avoid the merge to "change the structure" of the left side.
#
#Example:
#
# mode_merge(1, {a=>1}                        ); # success, result={a=>1}
# mode_merge(1, {a=>1}, {allow_create_hash=>0}); # failed, can't create hash
#
#=head2 allow_destroy_array => BOOL
#
#Context: config, options key
#
#Default: 1
#
#If enabled, then replacing array on the left side with non-array
#(e.g. hash/scalar) on the right side is allowed. Setting to 0 is
#useful if you want to avoid the merge to "change the structure" of the
#left side.
#
#Example:
#
# mode_merge([1,2], {}                          ); # success, result={}
# mode_merge([1,2], {}, {allow_destroy_array=>0}); # failed, can't destroy array
#
#=head2 allow_destroy_hash => BOOL
#
#Context: config, options key
#
#Default: 1
#
#If enabled, then replacing hash on the left side with non-hash
#(e.g. array/scalar) on the right side is allowed. Setting to 0 is
#useful if you want to avoid the merge to "change the structure" of the
#left side.
#
#Example:
#
# mode_merge({a=>1}, []                         ); # success, result=[]
# mode_merge({a=>1}, [], {allow_destroy_hash=>0}); # failed, can't destroy hash
#
#=head2 exclude_parse => ARRAYREF
#
#Context: config, options key
#
#Default: undef
#
#The list of hash keys that should not be parsed for prefix and merged
#as-is using the default mode.
#
#If C<include_parse> is also mentioned then only keys in
#C<include_parse> and not in C<exclude_parse> will be parsed for
#prefix.
#
#Example:
#
# mode_merge({a=>1, b=>2}, {"+a"=>3, "+b"=>4}, {exclude_parse=>["+b"]}); # {a=>4, b=>2, "+b"=>4}
#
#=head2 exclude_parse_regex => REGEX
#
#Context: config, options key
#
#Default: undef
#
#Just like C<exclude_parse> but using regex instead of list.
#
#=head2 include_parse => ARRAYREF
#
#Context: config, options key
#
#Default: undef
#
#If specified, then only hash keys listed by this setting will be
#parsed for prefix. The rest of the keys will not be parsed and merged
#as-is using the default mode.
#
#If C<exclude_parse> is also mentioned then only keys in
#C<include_parse> and not in C<exclude_parse> will be parsed for
#prefix.
#
#Example:
#
# mode_merge({a=>1, b=>2, c=>3}, {"+a"=>4, "+b"=>5, "+c"=>6},
#            {include_parse=>["+a"]}); # {a=>1, "+a"=>4, b=>7, c=>3, "+c"=>6}
#
#=head2 include_parse_regex => REGEX
#
#Context: config, options key
#
#Default: undef
#
#Just like C<include_parse> but using regex instead of list.
#
#=head2 exclude_merge => ARRAYREF
#
#Context: config, options key
#
#Default: undef
#
#The list of hash keys on the left side that should not be merged and
#instead copied directly to the result. All merging keys on the right
#side will be ignored.
#
#If C<include_merge> is also mentioned then only keys in
#C<include_merge> and not in C<exclude_merge> will be merged.
#
#Example:
#
# mode_merge({a=>1}, {"+a"=>20, "-a"=>30}, {exclude_merge=>["a"]}); # {a=>1}
#
#=head2 exclude_merge_regex => REGEX
#
#Context: config, options key
#
#Default: undef
#
#Just like C<exclude_merge> but using regex instead of list.
#
#=head2 include_merge => ARRAYREF
#
#Context: config, options key
#
#Default: undef
#
#If specified, then only hash keys listed by this setting will be
#merged.
#
#If C<exclude_merge> is also mentioned then only keys in
#C<include_merge> and not in C<exclude_merge> will be merged.
#
#Example:
#
# mode_merge({a=>1, b=>2, c=>3}, {"+a"=>40, "+b"=>50, "+c"=>60, "!c"=>70},
#            {include_merge=>["a"]}); # {a=>41, b=>2, c=>3}
#
#=head2 include_merge_regex => ARRAYREF
#
#Context: config, options key
#
#Default: undef
#
#Just like C<include_merge> but using regex instead of list.
#
#=head2 set_prefix => HASHREF
#
#Context: config, options key
#
#Default: undef
#
#Temporarily change the prefix character for each mode. Value is
#hashref where each hash key is mode and the value is a new prefix
#string.
#
# mode_merge({a=>1, c=>2}, {'+a'=>10, '.c'=>20});                                        # {a=>11, c=>220}
# mode_merge({a=>1, c=>2}, {'+a'=>10, '.c'=>20}, {set_prefix=>{ADD=>'.', CONCAT=>'+'}}); # {a=>110, c=>22}
#
#=head2 readd_prefix => BOOL
#
#Context: config, options key
#
#Default: 1
#
#When merging two hashes, the prefixes are first stripped before
#merging. After merging is done, the prefixes by default will be
#re-added. This is done so that modes which are "sticky" (like KEEP)
#can propagate their mode). Setting C<readd_prefix> to 0 will prevent
#their stickiness.
#
# mode_merge({"^a"=>1}, {a=>2});                    # {"^a"=>1}
# mode_merge({"^a"=>1}, {a=>2}, {readd_prefix=>0}); # { "a"=>1}
#
#=head2 premerge_pair_filter => CODEREF
#
#Context: config, options key
#
#Default: undef
#
#Pass the key and value of each hash pair to a subroutine before
#merging (and before the keys are stripped for mode prefixes). Will
#push error if there is conflicting key in the hash.
#
#The subroutine should return a list of new key(s) and value(s). If key
#is undef then it means the pair should be discarded. This way, the
#filter is able to add or remove pairs from the hash.
#
# mode_merge({a=>1}, {"+amok"=>2},
#            {premerge_pair_filter=>sub{ uc(substr($_[0],0,2)), $_[1]*2 }});
# # {"A"=>6}
#
#=head2 options_key => STR
#
#Context: config
#
#Default: '' (empty string)
#
#If defined, then when merging two hashes, this key will be searched
#first on the left-side and right-side hash. The values will then be
#merged and override (many of) the configuration.
#
#Options key is analogous to Apache's C<.htaccess> mechanism, which
#allows setting configuration on a per-directory (per-hash)
#basis. There's even an C<allow_override> config similar to Apache
#directive of the same name.
#
#If you want to disable processing of options key, set this to undef.
#
#Example:
#
# mode_merge({a=>1, {x=>3}},
#            {a=>2, {x=>4}},
#            {default_mode=>'ADD'}); # {a=>3, {x=>7}}
# mode_merge({a=>1, {x=>3}},
#            {a=>2, {x=>4, ''=>{default_mode=>'CONCAT'}}},
#            {default_mode=>'ADD'}); # {a=>3, {x=>34}}
#
#On the above example, C<default_mode> is set to ADD. But in the
#{x=>...} subhash, C<default_mode> is changed to CONCAT by the options
#key.
#
#=head2 allow_override => REGEX
#
#Context: config
#
#Default: undef
#
#If defined, then only config names matching regex will be able to be
#set in options key.
#
#If C<disallow_override> is also set, then only config names matching
#C<allow_override> and not matching C<disallow_override> will be able
#to be set in options key.
#
#=head2 disallow_override => REGEX
#
#Context: config
#
#Default: undef
#
#If defined, then config names matching regex will not be able to be
#set in options key.
#
#For example, if you want to restrict "structural changes" in merging
#while still allowing options key, you can set C<allow_create_hash>,
#C<allow_destroy_hash>, C<allow_create_array>, and
#C<allow_destroy_array> all to 0 and C<disallow_override> to
#C<allow_create|allow_destroy> to forbid overriding via options key.
#
#If C<disallow_override> is also set, then only config names matching
#C<allow_override> and not matching C<disallow_override> will be able
#to be set in options key.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/ModeMerge/Mode/ADD.pm ###
#package Data::ModeMerge::Mode::ADD;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#use Mo qw(build default);
#extends 'Data::ModeMerge::Mode::NORMAL';
#
#sub name { 'ADD' }
#
#sub precedence_level { 3 }
#
#sub default_prefix { '+' }
#
#sub default_prefix_re { qr/^\+/ }
#
#sub merge_SCALAR_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, ( $l // 0 ) + $r);
#}
#
#sub merge_SCALAR_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't add scalar and array");
#    return;
#}
#
#sub merge_SCALAR_HASH {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't add scalar and hash");
#    return;
#}
#
#sub merge_ARRAY_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't add array and scalar");
#    return;
#}
#
#sub merge_ARRAY_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    ($key, [ @$l, @$r ]);
#}
#
#sub merge_ARRAY_HASH {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't add array and hash");
#    return;
#}
#
#sub merge_HASH_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't add hash and scalar");
#    return;
#}
#
#sub merge_HASH_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't add hash and array");
#    return;
#}
#
#1;
## ABSTRACT: Handler for Data::ModeMerge ADD merge mode
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Mode::ADD - Handler for Data::ModeMerge ADD merge mode
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Mode::ADD (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# use Data::ModeMerge;
#
#=head1 DESCRIPTION
#
#This is the class to handle ADD merge mode.
#
#=for Pod::Coverage ^merge_.*
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/ModeMerge/Mode/Base.pm ###
#package Data::ModeMerge::Mode::Base;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#
##use Data::Dmp;
#
##use Log::Any '$log';
#use Mo qw(build default);
#
##use Data::Clone qw/clone/;
#
#has merger => (is => 'rw');
#has prefix => (is => 'rw');
#has prefix_re => (is => 'rw');
#has check_prefix_sub => (is => 'rw');
#has add_prefix_sub => (is => 'rw');
#has remove_prefix_sub => (is => 'rw');
#
#sub name {
#    die "Subclass must provide name()";
#}
#
#sub precedence_level {
#    die "Subclass must provide precedence_level()";
#}
#
#sub default_prefix {
#    die "Subclass must provide default_prefix()";
#}
#
#sub default_prefix_re {
#    die "Subclass must provide default_prefix_re()";
#}
#
#sub BUILD {
#    my ($self) = @_;
#    $self->prefix($self->default_prefix);
#    $self->prefix_re($self->default_prefix_re);
#}
#
#sub check_prefix {
#    my ($self, $hash_key) = @_;
#    if ($self->check_prefix_sub) {
#        $self->check_prefix_sub->($hash_key);
#    } else {
#        $hash_key =~ $self->prefix_re;
#    }
#}
#
#sub add_prefix {
#    my ($self, $hash_key) = @_;
#    if ($self->add_prefix_sub) {
#        $self->add_prefix_sub->($hash_key);
#    } else {
#        $self->prefix . $hash_key;
#    }
#}
#
#sub remove_prefix {
#    my ($self, $hash_key) = @_;
#    if ($self->remove_prefix_sub) {
#        $self->remove_prefix_sub->($hash_key);
#    } else {
#        my $re = $self->prefix_re;
#        $hash_key =~ s/$re//;
#        $hash_key;
#    }
#}
#
#sub merge_ARRAY_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#    return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
#    return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
#    my @res;
#    my @backup;
#    my $la = @$l;
#    my $lb = @$r;
#    push @{ $mm->path }, -1;
#    for my $i (0..($la > $lb ? $la : $lb)-1) {
#        #print "DEBUG: merge_A_A: #$i: a->[$i]=".Data::Dumper->new([$l->[$i]])->Indent(0)->Terse(1)->Dump.", b->[$i]=".Data::Dumper->new([$r->[$i]])->Indent(0)->Terse(1)->Dump."\n";
#        $mm->path->[-1] = $i;
#        if ($i < $la && $i < $lb) {
#            push @backup, $l->[$i];
#            my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
#            last if @{ $mm->errors };
#            if ($is_circular) {
#                push @res, undef;
#                #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
#                push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
#                    my ($subnewkey, $subres, $subbackup) = @_;
#                    #print "DEBUG: Entering todo subroutine (i=$i)\n";
#                    $res[$i] = $subres;
#                }
#            } else {
#                push @res, $subres;# if defined($newkey); = we allow DELETE on array?
#            }
#        } elsif ($i < $la) {
#            push @res, $l->[$i];
#        } else {
#            push @res, $r->[$i];
#        }
#    }
#    pop @{ $mm->path };
#    ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
#    my ($self, $h, $desc, $sub) = @_;
#    my $mm = $self->merger;
#
#    if (ref($sub) ne 'CODE') {
#        $mm->push_error("$desc failed: filter must be a coderef");
#        return;
#    }
#
#    my $res = {};
#    for (keys %$h) {
#        my @r = $sub->($_, $h->{$_});
#        while (my ($k, $v) = splice @r, 0, 2) {
#            next unless defined $k;
#            if (exists $res->{$k}) {
#                $mm->push_error("$desc failed; key conflict: ".
#                                "$_ -> $k, but key $k already exists");
#                return;
#            }
#            $res->{$k} = $v;
#        }
#    }
#
#    $res;
#}
#
## turn {[prefix]key => val, ...} into { key => [MODE, val], ...}, push
## error if there's conflicting key
#sub _gen_left {
#    my ($self, $l, $mode, $esub, $ep, $ip, $epr, $ipr) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#    #print "DEBUG: Entering _gen_left(".dmp($l).", $mode, ...)\n";
#
#    if ($c->premerge_pair_filter) {
#        $l = $self->_prefilter_hash($l, "premerge filter left hash",
#                                    $c->premerge_pair_filter);
#        return if @{ $mm->errors };
#    }
#
#    my $hl = {};
#    if ($c->parse_prefix) {
#        for (keys %$l) {
#            my $do_parse = 1;
#            $do_parse = 0 if $do_parse && $ep  &&  $mm->_in($_, $ep);
#            $do_parse = 0 if $do_parse && $ip  && !$mm->_in($_, $ip);
#            $do_parse = 0 if $do_parse && $epr &&  /$epr/;
#            $do_parse = 0 if $do_parse && $ipr && !/$ipr/;
#
#            if ($do_parse) {
#                my $old = $_;
#                my $m2;
#                ($_, $m2) = $mm->remove_prefix($_);
#                next if $esub && !$esub->($_);
#                if ($old ne $_ && exists($l->{$_})) {
#                    $mm->push_error("Conflict when removing prefix on left-side ".
#                                    "hash key: $old -> $_ but $_ already exists");
#                    return;
#                }
#                $hl->{$_} = [$m2, $l->{$old}];
#            } else {
#                next if $esub && !$esub->($_);
#                $hl->{$_} = [$mode, $l->{$_}];
#            }
#        }
#    } else {
#        for (keys %$l) {
#            next if $esub && !$esub->($_);
#            $hl->{$_} = [$mode, $l->{$_}];
#        }
#    }
#
#    #print "DEBUG: Leaving _gen_left, result = ".dmp($hl)."\n";
#    $hl;
#}
#
## turn {[prefix]key => val, ...} into { key => {MODE=>val, ...}, ...},
## push error if there's conflicting key+MODE
#sub _gen_right {
#    my ($self, $r, $mode, $esub, $ep, $ip, $epr, $ipr) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#    #print "DEBUG: Entering _gen_right(".dmp($r).", $mode, ...)\n";
#
#    if ($c->premerge_pair_filter) {
#        $r = $self->_prefilter_hash($r, "premerge filter right hash",
#                                    $c->premerge_pair_filter);
#        return if @{ $mm->errors };
#    }
#
#    my $hr = {};
#    if ($c->parse_prefix) {
#        for (keys %$r) {
#            my $do_parse = 1;
#            $do_parse = 0 if $do_parse && $ep  &&  $mm->_in($_, $ep);
#            $do_parse = 0 if $do_parse && $ip  && !$mm->_in($_, $ip);
#            $do_parse = 0 if $do_parse && $epr &&  /$epr/;
#            $do_parse = 0 if $do_parse && $ipr && !/$ipr/;
#
#            if ($do_parse) {
#                my $old = $_;
#                my $m2;
#                ($_, $m2) = $mm->remove_prefix($_);
#                next if $esub && !$esub->($_);
#                if (exists $hr->{$_}{$m2}) {
#                    $mm->push_error("Conflict when removing prefix on right-side ".
#                                    "hash key: $old($m2) -> $_ ($m2) but $_ ($m2) ".
#                                    "already exists");
#                    return;
#                }
#                $hr->{$_}{$m2} = $r->{$old};
#            } else {
#                next if $esub && !$esub->($_);
#                $hr->{$_} = {$mode => $r->{$_}};
#            }
#        }
#    } else {
#        for (keys %$r) {
#            next if $esub && !$esub->($_);
#            $hr->{$_} = {$mode => $r->{$_}}
#        }
#    }
#    #print "DEBUG: Leaving _gen_right, result = ".dmp($hr)."\n";
#    $hr;
#}
#
## merge two hashes which have been prepared by _gen_left and
## _gen_right, will result in { key => [final_mode, val], ... }
#sub _merge_gen {
#    my ($self, $hl, $hr, $mode, $em, $im, $emr, $imr) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#    #print "DEBUG: Entering _merge_gen(".dmp($hl).", ".dmp($hr).", $mode, ...)\n";
#
#    my $res = {};
#    my $backup = {};
#
#    my %k = map {$_=>1} keys(%$hl), keys(%$hr);
#    push @{ $mm->path }, "";
#  K:
#    for my $k (keys %k) {
#        my @o;
#        $mm->path->[-1] = $k;
#        my $do_merge = 1;
#        $do_merge = 0 if $do_merge && $em  &&  $mm->_in($k, $em);
#        $do_merge = 0 if $do_merge && $im  && !$mm->_in($k, $im);
#        $do_merge = 0 if $do_merge && $emr && $k =~ /$emr/;
#        $do_merge = 0 if $do_merge && $imr && $k !~ /$imr/;
#
#        if (!$do_merge) {
#            $res->{$k} = $hl->{$k} if $hl->{$k};
#            next K;
#        }
#
#        $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
#        if ($hl->{$k}) {
#            push @o, $hl->{$k};
#        }
#        if ($hr->{$k}) {
#            my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
#            #print "DEBUG: \\%m=".Data::Dumper->new([\%m])->Indent(0)->Terse(1)->Dump."\n";
#            push @o, map { [$_, $hr->{$k}{$_}] } sort { $m{$b} <=> $m{$a} } keys %m;
#        }
#        my $final_mode;
#        my $is_circular;
#        my $v;
#        #print "DEBUG: k=$k, o=".Data::Dumper->new([\@o])->Indent(0)->Terse(1)->Dump."\n";
#        for my $i (0..$#o) {
#            if ($i == 0) {
#                my $mh = $mm->modes->{$o[$i][0]};
#                if (@o == 1 &&
#                        (($hl->{$k} && $mh->can("merge_left_only")) ||
#                         ($hr->{$k} && $mh->can("merge_right_only")))) {
#                    # there's only left-side or right-side
#                    my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
#                    my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); # XXX handle circular?
#                    next K unless defined($subnewkey);
#                    $final_mode = $newmode;
#                    $v = $res;
#                } else {
#                    $final_mode = $o[$i][0];
#                    $v = $o[$i][1];
#                }
#            } else {
#                my $m = $mm->combine_rules->{"$final_mode+$o[$i][0]"}
#                    or do {
#                        $mm->push_error("Can't merge $final_mode + $o[$i][0]");
#                        return;
#                    };
#                #print "DEBUG: merge $final_mode+$o[$i][0] = $m->[0], $m->[1]\n";
#                my ($subnewkey, $subbackup);
#                ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
#                return if @{ $mm->errors };
#                if ($is_circular) {
#                    if ($i < $#o) {
#                        $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
#                        return;
#                    }
#                    #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
#                    push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
#                        my ($subnewkey, $subres, $subbackup) = @_;
#                        #print "DEBUG: Entering todo subroutine (k=$k)\n";
#                        my $final_mode = $m->[1];
#                        #XXX return unless defined($subnewkey);
#                        $res->{$k} = [$m->[1], $subres];
#                        if ($c->readd_prefix) {
#                            # XXX if there is a conflict error in
#                            # _readd_prefix, how to adjust path?
#                            $self->_readd_prefix($res, $k, $c->default_mode);
#                        } else {
#                            $res->{$k} = $res->{$k}[1];
#                        }
#                    };
#                    delete $res->{$k};
#                }
#                next K unless defined $subnewkey;
#                $final_mode = $m->[1];
#            }
#        }
#        $res->{$k} = [$final_mode, $v] unless $is_circular;
#    }
#    pop @{ $mm->path };
#    #print "DEBUG: Leaving _merge_gen, res = ".dmp($res)."\n";
#    ($res, $backup);
#}
#
## hh is {key=>[MODE, val], ...} which is the format returned by _merge_gen
#sub _readd_prefix {
#    my ($self, $hh, $k, $defmode) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#    my $m = $hh->{$k}[0];
#    if ($m eq $defmode) {
#        $hh->{$k} = $hh->{$k}[1];
#    } else {
#        my $kp = $mm->modes->{$m}->add_prefix($k);
#        if (exists $hh->{$kp}) {
#            $mm->push_error("BUG: conflict when re-adding prefix after merge: $kp");
#            return;
#        }
#        $hh->{$kp} = $hh->{$k}[1];
#        delete $hh->{$k};
#    }
#}
#
#sub merge_HASH_HASH {
#    my ($self, $key, $l, $r, $mode) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#    $mode //= $c->default_mode;
#    #print "DEBUG: entering merge_H_H(".dmp($l).", ".dmp($r).", $mode), config=($c)=",dmp($c),"\n";
#    #$log->trace("using config($c)");
#
#    return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_hash;
#    return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
#    # STEP 1. MERGE LEFT & RIGHT OPTIONS KEY
#    my $config_replaced;
#    my $orig_c = $c;
#    my $ok = $c->options_key;
#    {
#        last unless defined $ok;
#
#        my $okl = $self->_gen_left ($l, $mode, sub {$_[0] eq $ok});
#        return if @{ $mm->errors };
#
#        my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
#        return if @{ $mm->errors };
#
#        push @{ $mm->path }, $ok;
#        my ($res, $backup);
#        {
#            local $c->{readd_prefix} = 0;
#            ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
#        }
#        pop @{ $mm->path };
#        return if @{ $mm->errors };
#
#        #print "DEBUG: merge options key (".dmp($okl).", ".dmp($okr).") = ".dmp($res)."\n";
#
#        $res = $res->{$ok} ? $res->{$ok}[1] : undef;
#        if (defined($res) && ref($res) ne 'HASH') {
#            $mm->push_error("Invalid options key after merge: value must be hash");
#            return;
#        }
#        last unless keys %$res;
#        #$log->tracef("cloning config ...");
#        # Data::Clone by default does *not* deep-copy object
#        #my $c2 = clone($c);
#        my $c2 = bless({ %$c }, ref($c));
#
#        for (keys %$res) {
#            if ($c->allow_override) {
#                my $re = $c->allow_override;
#                if (!/$re/) {
#                    $mm->push_error("Configuration in options key `$_` not allowed by allow_override $re");
#                    return;
#                }
#            }
#            if ($c->disallow_override) {
#                my $re = $c->disallow_override;
#                if (/$re/) {
#                    $mm->push_error("Configuration in options key `$_` not allowed by disallow_override $re");
#                    return;
#                }
#            }
#            if ($mm->_in($_, $c->_config_config)) {
#                $mm->push_error("Configuration not allowed in options key: $_");
#                return;
#            }
#            if ($_ ne $ok && !$mm->_in($_, $c->_config_ok)) {
#                $mm->push_error("Unknown configuration in options key: $_");
#                return;
#            }
#            $c2->$_($res->{$_}) unless $_ eq $ok;
#        }
#        $mm->config($c2);
#        $config_replaced++;
#        $c = $c2;
#        #$log->trace("config now changed to $c2");
#    }
#
#    my $sp = $c->set_prefix;
#    my $saved_prefixes;
#    if (defined($sp)) {
#        if (ref($sp) ne 'HASH') {
#            $mm->push_error("Invalid config value `set_prefix`: must be a hash");
#            return;
#        }
#        $saved_prefixes = {};
#        for my $mh (values %{ $mm->modes }) {
#            my $n = $mh->name;
#            if ($sp->{$n}) {
#                $saved_prefixes->{$n} = {
#                    prefix => $mh->prefix,
#                    prefix_re => $mh->prefix_re,
#                    check_prefix_sub => $mh->check_prefix_sub,
#                    add_prefix_sub => $mh->add_prefix_sub,
#                    remove_prefix_sub => $mh->remove_prefix_sub,
#                };
#                $mh->prefix($sp->{$n});
#                my $re = quotemeta($sp->{$n});
#                $mh->prefix_re(qr/^$re/);
#                $mh->check_prefix_sub(undef);
#                $mh->add_prefix_sub(undef);
#                $mh->remove_prefix_sub(undef);
#            }
#        }
#    }
#
#    my $ep = $c->exclude_parse;
#    my $ip = $c->include_parse;
#    if (defined($ep) && ref($ep) ne 'ARRAY') {
#        $mm->push_error("Invalid config value `exclude_parse`: must be an array");
#        return;
#    }
#    if (defined($ip) && ref($ip) ne 'ARRAY') {
#        $mm->push_error("Invalid config value `include_parse`: must be an array");
#        return;
#    }
#
#    my $epr = $c->exclude_parse_regex;
#    my $ipr = $c->include_parse_regex;
#    if (defined($epr)) {
#        eval { $epr = qr/$epr/ };
#        if ($@) {
#            $mm->push_error("Invalid config value `exclude_parse_regex`: invalid regex: $@");
#            return;
#        }
#    }
#    if (defined($ipr)) {
#        eval { $ipr = qr/$ipr/ };
#        if ($@) {
#            $mm->push_error("Invalid config value `include_parse_regex`: invalid regex: $@");
#            return;
#        }
#    }
#
#    # STEP 2. PREPARE LEFT HASH
#    my $hl = $self->_gen_left ($l, $mode, sub {defined($ok) ? $_[0] ne $ok : 1}, $ep, $ip, $epr, $ipr);
#    return if @{ $mm->errors };
#
#    # STEP 3. PREPARE RIGHT HASH
#    my $hr = $self->_gen_right($r, $mode, sub {defined($ok) ? $_[0] ne $ok : 1}, $ep, $ip, $epr, $ipr);
#    return if @{ $mm->errors };
#
#    #print "DEBUG: hl=".Data::Dumper->new([$hl])->Indent(0)->Terse(1)->Dump."\n";
#    #print "DEBUG: hr=".Data::Dumper->new([$hr])->Indent(0)->Terse(1)->Dump."\n";
#
#    my $em = $c->exclude_merge;
#    my $im = $c->include_merge;
#    if (defined($em) && ref($em) ne 'ARRAY') {
#        $mm->push_error("Invalid config value `exclude_marge`: must be an array");
#        return;
#    }
#    if (defined($im) && ref($im) ne 'ARRAY') {
#        $mm->push_error("Invalid config value `include_merge`: must be an array");
#        return;
#    }
#
#    my $emr = $c->exclude_merge_regex;
#    my $imr = $c->include_merge_regex;
#    if (defined($emr)) {
#        eval { $emr = qr/$emr/ };
#        if ($@) {
#            $mm->push_error("Invalid config value `exclude_merge_regex`: invalid regex: $@");
#            return;
#        }
#    }
#    if (defined($imr)) {
#        eval { $imr = qr/$imr/ };
#        if ($@) {
#            $mm->push_error("Invalid config value `include_merge_regex`: invalid regex: $@");
#            return;
#        }
#    }
#
#    # STEP 4. MERGE LEFT & RIGHT
#    my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
#    return if @{ $mm->errors };
#
#    #print "DEBUG: intermediate res(5) = ".Data::Dumper->new([$res])->Indent(0)->Terse(1)->Dump."\n";
#
#    # STEP 5. TURN BACK {key=>[MODE=>val]}, ...} INTO {(prefix)key => val, ...}
#    if ($c->readd_prefix) {
#        for my $k (keys %$res) {
#            $self->_readd_prefix($res, $k, $c->default_mode);
#        }
#    } else {
#        $res->{$_} = $res->{$_}[1] for keys %$res;
#    }
#
#    if ($saved_prefixes) {
#        for (keys %$saved_prefixes) {
#            my $mh = $mm->modes->{$_};
#            my $s = $saved_prefixes->{$_};
#            $mh->prefix($s->{prefix});
#            $mh->prefix_re($s->{prefix_re});
#            $mh->check_prefix_sub($s->{check_prefix_sub});
#            $mh->add_prefix_sub($s->{add_prefix_sub});
#            $mh->remove_prefix_sub($s->{remove_prefix_sub});
#        }
#    }
#
#    # restore config
#    if ($config_replaced) {
#        $mm->config($orig_c);
#        #print "DEBUG: Restored config, config=", dmp($mm->config), "\n";
#    }
#
#    #print "DEBUG: backup = ".Data::Dumper->new([$backup])->Indent(0)->Terse(1)->Dump."\n";
#    #print "DEBUG: leaving merge_H_H, result = ".dmp($res)."\n";
#    ($key, $res, $backup);
#}
#
#1;
## ABSTRACT: Base class for Data::ModeMerge mode handler
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Mode::Base - Base class for Data::ModeMerge mode handler
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Mode::Base (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# use Data::ModeMerge;
#
#=head1 DESCRIPTION
#
#This is the base class for mode type handlers.
#
#=for Pod::Coverage ^(BUILD|merge_.+)$
#
#=head1 ATTRIBUTES
#
#=head2 merger
#
#=head2 prefix
#
#=head2 prefix_re
#
#=head2 check_prefix_sub
#
#=head2 add_prefix_sub
#
#=head2 remove_prefix_sub
#
#=head1 METHODS
#
#=head2 name
#
#Return name of mode. Subclass must override this method.
#
#=head2 precedence_level
#
#Return precedence level, which is a number. The greater the number,
#the higher the precedence. Subclass must override this method.
#
#=head2 default_prefix
#
#Return default prefix. Subclass must override this method.
#
#=head2 default_prefix_re
#
#Return default prefix regex. Subclass must override this method.
#
#=head2 check_prefix($hash_key)
#
#Return true if hash key has prefix for this mode.
#
#=head2 add_prefix($hash_key)
#
#Return hash key with added prefix of this mode.
#
#=head2 remove_prefix($hash_key)
#
#Return hash key with prefix of this mode prefix removed.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/ModeMerge/Mode/CONCAT.pm ###
#package Data::ModeMerge::Mode::CONCAT;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#use Mo qw(build default);
#extends 'Data::ModeMerge::Mode::ADD';
#
#sub name { 'CONCAT' }
#
#sub precedence_level { 2 }
#
#sub default_prefix { '.' }
#
#sub default_prefix_re { qr/^\./ }
#
#sub merge_SCALAR_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, ($l // "") . $r);
#}
#
#1;
## ABSTRACT: Handler for Data::ModeMerge CONCAT merge mode
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Mode::CONCAT - Handler for Data::ModeMerge CONCAT merge mode
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Mode::CONCAT (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# use Data::ModeMerge;
#
#=head1 DESCRIPTION
#
#This is the class to handle CONCAT merge mode.
#
#=for Pod::Coverage ^merge_.*
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/ModeMerge/Mode/DELETE.pm ###
#package Data::ModeMerge::Mode::DELETE;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#use Mo qw(build default);
#extends 'Data::ModeMerge::Mode::Base';
#
#sub name { 'DELETE' }
#
#sub precedence_level { 1 }
#
#sub default_prefix { '!' }
#
#sub default_prefix_re { qr/^!/ }
#
## merge_left_only and merge_right_only are a bit different: they are
## called with $l only or $r only instead of both, and should return an
## extra argument $mode, i.e. ($key, $result, $backup, $is_circular,
## $mode)
#sub merge_left_only {
#    my ($self, $key, $l) = @_;
#    return;
#}
#
#sub merge_right_only {
#    my ($self, $key, $r) = @_;
#    return;
#}
#
#sub merge_SCALAR_SCALAR {
#    return;
#}
#
#sub merge_SCALAR_ARRAY {
#    return;
#}
#
#sub merge_SCALAR_HASH {
#    return;
#}
#
#sub merge_ARRAY_SCALAR {
#    return;
#}
#
#sub merge_ARRAY_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->config->allow_destroy_array or
#        $self->merger->push_error("Now allowed to destroy array via DELETE mode");
#    return;
#}
#
#sub merge_ARRAY_HASH {
#    return;
#}
#
#sub merge_HASH_SCALAR {
#    return;
#}
#
#sub merge_HASH_ARRAY {
#    return;
#}
#
#sub merge_HASH_HASH {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->config->allow_destroy_hash or
#        $self->merger->push_error("Now allowed to destroy hash via DELETE mode");
#    return;
#}
#
#1;
## ABSTRACT: Handler for Data::ModeMerge DELETE merge mode
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Mode::DELETE - Handler for Data::ModeMerge DELETE merge mode
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Mode::DELETE (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# use Data::ModeMerge;
#
#=head1 DESCRIPTION
#
#This is the class to handle DELETE merge mode.
#
#=for Pod::Coverage ^merge_.*
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/ModeMerge/Mode/KEEP.pm ###
#package Data::ModeMerge::Mode::KEEP;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#use Mo qw(build default);
#extends 'Data::ModeMerge::Mode::Base';
#
#sub name { 'KEEP' }
#
#sub precedence_level { 6 }
#
#sub default_prefix { '^' }
#
#sub default_prefix_re { qr/^\^/ }
#
#sub merge_SCALAR_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l);
#}
#
#sub merge_SCALAR_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l);
#}
#
#sub merge_SCALAR_HASH {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l);
#}
#
#sub merge_ARRAY_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l);
#}
#
#sub merge_ARRAY_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    $self->SUPER::merge_ARRAY_ARRAY($key, $l, $r, 'KEEP');
#};
#
#sub merge_ARRAY_HASH {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l);
#}
#
#sub merge_HASH_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l);
#}
#
#sub merge_HASH_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l);
#}
#
#sub merge_HASH_HASH {
#    my ($self, $key, $l, $r) = @_;
#    $self->SUPER::merge_HASH_HASH($key, $l, $r, 'KEEP');
#};
#
#1;
## ABSTRACT: Handler for Data::ModeMerge KEEP merge mode
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Mode::KEEP - Handler for Data::ModeMerge KEEP merge mode
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Mode::KEEP (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# use Data::ModeMerge;
#
#=head1 DESCRIPTION
#
#This is the class to handle KEEP merge mode.
#
#=for Pod::Coverage ^merge_.*
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/ModeMerge/Mode/NORMAL.pm ###
#package Data::ModeMerge::Mode::NORMAL;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#use Mo qw(build default);
#extends 'Data::ModeMerge::Mode::Base';
#
#sub name { 'NORMAL' }
#
#sub precedence_level { 5 }
#
#sub default_prefix { '*' }
#
#sub default_prefix_re { qr/^\*/ }
#
#sub merge_SCALAR_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_SCALAR_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_SCALAR_HASH {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_SCALAR_CODE {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_ARRAY_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_ARRAY_HASH {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_ARRAY_CODE {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_HASH_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_HASH_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_HASH_CODE {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_CODE_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_CODE_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_CODE_HASH {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#sub merge_CODE_CODE {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $r);
#}
#
#1;
## ABSTRACT: Handler for Data::ModeMerge NORMAL merge mode
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Mode::NORMAL - Handler for Data::ModeMerge NORMAL merge mode
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Mode::NORMAL (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# use Data::ModeMerge;
#
#=head1 DESCRIPTION
#
#This is the class to handle NORMAL merge mode.
#
#=for Pod::Coverage ^merge_.*
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/ModeMerge/Mode/SUBTRACT.pm ###
#package Data::ModeMerge::Mode::SUBTRACT;
#
#our $DATE = '2016-07-22'; # DATE
#our $VERSION = '0.35'; # VERSION
#
#use 5.010;
#use strict;
#use warnings;
#use Mo qw(build default);
#extends 'Data::ModeMerge::Mode::NORMAL';
#
#sub name { 'SUBTRACT' }
#
#sub precedence_level { 4 }
#
#sub default_prefix { '-' }
#
#sub default_prefix_re { qr/^-/ }
#
#sub merge_SCALAR_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    ($key, $l - $r);
#}
#
#sub merge_SCALAR_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't subtract scalar and array");
#    return;
#}
#
#sub merge_SCALAR_HASH {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't subtract scalar and hash");
#    return;
#}
#
#sub merge_ARRAY_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't subtract array and scalar");
#    return;
#}
#
#sub merge_ARRAY_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    my @res;
#    my $mm = $self->merger;
#    for (@$l) {
#        push @res, $_ unless $mm->_in($_, $r);
#    }
#    ($key, \@res);
#}
#
#sub merge_ARRAY_HASH {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't subtract array and hash");
#    return;
#}
#
#sub merge_HASH_SCALAR {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't subtract hash and scalar");
#    return;
#}
#
#sub merge_HASH_ARRAY {
#    my ($self, $key, $l, $r) = @_;
#    $self->merger->push_error("Can't subtract hash and array");
#    return;
#}
#
#sub merge_HASH_HASH {
#    my ($self, $key, $l, $r) = @_;
#    my $mm = $self->merger;
#
#    my %res;
#    my $r2 = {};
#    for (keys %$r) {
#        my $k = $mm->check_prefix($_) ? $_ : $mm->add_prefix($_, 'DELETE');
#        if ($k ne $_ && exists($r->{$k})) {
#            $mm->push_error("Conflict when adding DELETE prefix on right-side hash key $_ ".
#                            "for SUBTRACT merge: key $k already exists");
#            return;
#        }
#        $r2->{$k} = $r->{$_};
#    }
#    $mm->_merge($key, $l, $r2, 'NORMAL');
#}
#
#1;
## ABSTRACT: Handler for Data::ModeMerge SUBTRACT merge mode
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::ModeMerge::Mode::SUBTRACT - Handler for Data::ModeMerge SUBTRACT merge mode
#
#=head1 VERSION
#
#This document describes version 0.35 of Data::ModeMerge::Mode::SUBTRACT (from Perl distribution Data-ModeMerge), released on 2016-07-22.
#
#=head1 SYNOPSIS
#
# use Data::ModeMerge;
#
#=head1 DESCRIPTION
#
#This is the class to handle SUBTRACT merge mode.
#
#=for Pod::Coverage ^merge_.*
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-ModeMerge>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-ModeMerge>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-ModeMerge>
#
#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
### Data/Sah/Normalize.pm ###
#package Data::Sah::Normalize;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $DATE = '2018-09-10'; # DATE
#our $VERSION = '0.050'; # VERSION
#
#require Exporter;
#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($;$) {
#    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($) {
#    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 "'def' in extras must be a hash"
#                if exists $extras->{def} && ref($extras->{def}) ne 'HASH';
#            return [$t, $clset, { %{$extras} }];
#        } 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.050 of Data::Sah::Normalize (from Perl distribution Data-Sah-Normalize), released on 2018-09-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 and extras (but clause set's and extras' 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 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.
#
#=head1 SEE ALSO
#
#L<Sah>, L<Data::Sah>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2018, 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
### Data/Sah/Resolve.pm ###
#package Data::Sah::Resolve;
#
#our $DATE = '2017-04-19'; # DATE
#our $VERSION = '0.007'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(resolve_schema);
#
#sub _resolve {
#    my ($opts, $type, $clsets, $seen) = @_;
#
#    die "Recursive schema definition: ".join(" -> ", @$seen, $type)
#        if grep { $type eq $_ } @$seen;
#    push @$seen, $type;
#
#    (my $typemod_pm = "Data/Sah/Type/$type.pm") =~ s!::!/!g;
#    eval { require $typemod_pm; 1 };
#    my $err = $@;
#    # already a builtin-type, so just return the schema's type name & clause set
#    return [$type, $clsets] unless $err;
#    die "Can't check whether $type is a builtin Sah type: $err"
#        unless $err =~ /\ACan't locate/;
#
#    # not a type, try a schema under Sah::Schema
#    my $schmod = "Sah::Schema::$type";
#    (my $schmod_pm = "$schmod.pm") =~ s!::!/!g;
#    eval { require $schmod_pm; 1 };
#    die "Not a known built-in Sah type '$type' (can't locate ".
#        "Data::Sah::Type::$type) and not a known schema name '$type' ($@)"
#            if $@;
#    no strict 'refs';
#    my $sch2 = ${"$schmod\::schema"};
#    die "BUG: Schema module $schmod doesn't contain \$schema" unless $sch2;
#    unshift @$clsets, $sch2->[1];
#    _resolve($opts, $sch2->[0], $clsets, $seen);
#}
#
#sub resolve_schema {
#    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
#    my $sch = shift;
#
#    unless ($opts->{schema_is_normalized}) {
#        require Data::Sah::Normalize;
#        $sch =  Data::Sah::Normalize::normalize_schema($sch);
#    }
#    $opts->{merge_clause_sets} //= 1;
#
#    my $seen = [];
#    my $res = _resolve($opts, $sch->[0], keys(%{$sch->[1]}) ? [$sch->[1]] : [], $seen);
#
#  MERGE:
#    {
#        last unless $opts->{merge_clause_sets};
#        last if @{ $res->[1] } < 2;
#
#        my @clsets = (shift @{ $res->[1] });
#        for my $clset (@{ $res->[1] }) {
#            my $has_merge_mode_keys;
#            for (keys %$clset) {
#                if (/\Amerge\./) {
#                    $has_merge_mode_keys = 1;
#                    last;
#                }
#            }
#            if ($has_merge_mode_keys) {
#                state $merger = do {
#                    require Data::ModeMerge;
#                    my $mm = Data::ModeMerge->new(config => {
#                        recurse_array => 1,
#                    });
#                    $mm->modes->{NORMAL}  ->prefix   ('merge.normal.');
#                    $mm->modes->{NORMAL}  ->prefix_re(qr/\Amerge\.normal\./);
#                    $mm->modes->{ADD}     ->prefix   ('merge.add.');
#                    $mm->modes->{ADD}     ->prefix_re(qr/\Amerge\.add\./);
#                    $mm->modes->{CONCAT}  ->prefix   ('merge.concat.');
#                    $mm->modes->{CONCAT}  ->prefix_re(qr/\Amerge\.concat\./);
#                    $mm->modes->{SUBTRACT}->prefix   ('merge.subtract.');
#                    $mm->modes->{SUBTRACT}->prefix_re(qr/\Amerge\.subtract\./);
#                    $mm->modes->{DELETE}  ->prefix   ('merge.delete.');
#                    $mm->modes->{DELETE}  ->prefix_re(qr/\Amerge\.delete\./);
#                    $mm->modes->{KEEP}    ->prefix   ('merge.keep.');
#                    $mm->modes->{KEEP}    ->prefix_re(qr/\Amerge\.keep\./);
#                    $mm;
#                };
#                my $merge_res = $merger->merge($clsets[-1], $clset);
#                unless ($merge_res->{success}) {
#                    die "Can't merge clause set: $merge_res->{error}";
#                }
#                $clsets[-1] = $merge_res->{result};
#            } else {
#                push @clsets, $clset;
#            }
#        }
#
#        $res->[1] = \@clsets;
#    }
#
#    $res->[2] = $seen if $opts->{return_intermediates};
#
#    $res;
#}
#
#1;
## ABSTRACT: Resolve Sah schema
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Sah::Resolve - Resolve Sah schema
#
#=head1 VERSION
#
#This document describes version 0.007 of Data::Sah::Resolve (from Perl distribution Data-Sah-Resolve), released on 2017-04-19.
#
#=head1 SYNOPSIS
#
# use Data::Sah::Resolve qw(resolve_schema);
#
# my $sch = resolve_schema("int");
# # => ["int", []]
#
# my $sch = resolve_schema("posint*");
# # => ["int", [{min=>1}, {req=>1}]
#
# my $sch = resolve_schema([posint => div_by => 3]);
# # => ["int", {min=>1}, {div_by=>3}]
#
# my $sch = resolve_schema(["posint", "merge.delete.min"=>undef, div_by => 3]);
# # => ["int", {div_by=>3}]
#
#=head1 DESCRIPTION
#
#=head1 FUNCTIONS
#
#=head2 resolve_schema([ \%opts, ] $sch) => sch
#
#Sah schemas can be defined in terms of other schemas. The resolving process
#follows the base schema recursively until it finds a builtin type as the base.
#
#This routine performs the following steps:
#
#=over
#
#=item 1. Normalize the schema
#
#Unless C<schema_is_normalized> option is true, in which case schema is assumed
#to be normalized already.
#
#=item 2. Check if the schema's type is a builtin type
#
#Currently this is done by checking if the module of the name C<<
#Data::Sah::Type::<type> >> is loadable. If it is a builtin type then we are
#done.
#
#=item 3. Check if the schema's type is the name of another schema
#
#This is done by checking if C<< Sah::Schema::<name> >> module exists and is
#loadable. If this is the case then we retrieve the base schema from the
#C<$schema> variable in the C<< Sah::Schema::<name> >> package and repeat the
#process while accumulating and/or merging the clause sets.
#
#=item 4. If schema's type is neither, we die.
#
#=back
#
#Returns C<< [base_type, clause_sets] >>. If C<return_intermediates> option is
#true, then the third elements will be the list of intermediate schema names.
#
#Example 1: C<int>.
#
#First we normalize to C<< ["int",{},{}] >>. The type is C<int> and it is a
#builtin type (L<Data::Sah::Type::int> exists) so the final result is C<< ["int",
#[]] >>.
#
#Example 2: C<posint*>.
#
#First we normalize to C<< ["posint",{req=>1},{}] >>. The type is C<posint> and
#it is the name of another schema (L<Sah::Schema::posint>). We retrieve the
#schema which is C<< ["int", {summary=>"Positive integer (1,2,3,...)", min=>1},
#{}] >>. We now try to resolve C<int> and find that it's a builtin type. So the
#final result is: C<< ["int", [ {req=>1}, {summary=>"Positive integer
#(1,2,3,...)", min=>1} ]] >>.
#
#Known options:
#
#=over
#
#=item * schema_is_normalized => bool (default: 0)
#
#When set to true, function will skip normalizing schema and assume input schema
#is normalized.
#
#=item * merge_clause_sets => bool (default: 1)
#
#=item * return_intermediates => bool
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Resolve>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Resolve>.
#
#=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-Resolve>
#
#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<Sah>, L<Data::Sah>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2017, 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
### Data/Sah/Util/Type.pm ###
#package Data::Sah::Util::Type;
#
#our $DATE = '2016-12-09'; # DATE
#our $VERSION = '0.46'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(get_type is_type is_simple is_numeric is_collection is_ref);
#
## XXX absorb and use metadata from Data::Sah::Type::*
#our $type_metas = {
#    all   => {scalar=>0, numeric=>0, ref=>0},
#    any   => {scalar=>0, numeric=>0, ref=>0},
#    array => {scalar=>0, numeric=>0, ref=>1},
#    bool  => {scalar=>1, numeric=>0, ref=>0},
#    buf   => {scalar=>1, numeric=>0, ref=>0},
#    cistr => {scalar=>1, numeric=>0, ref=>0},
#    code  => {scalar=>1, numeric=>0, ref=>1},
#    float => {scalar=>1, numeric=>1, ref=>0},
#    hash  => {scalar=>0, numeric=>0, ref=>1},
#    int   => {scalar=>1, numeric=>1, ref=>0},
#    num   => {scalar=>1, numeric=>1, ref=>0},
#    obj   => {scalar=>1, numeric=>0, ref=>1},
#    re    => {scalar=>1, numeric=>0, ref=>1, simple=>1},
#    str   => {scalar=>1, numeric=>0, ref=>0},
#    undef => {scalar=>1, numeric=>0, ref=>0},
#    date     => {scalar=>1, numeric=>0, ref=>0},
#    duration => {scalar=>1, numeric=>0, ref=>0},
#};
#
#sub get_type {
#    my $sch = shift;
#
#    if (ref($sch) eq 'ARRAY') {
#        $sch = $sch->[0];
#    }
#
#    if (defined($sch) && !ref($sch)) {
#        $sch =~ s/\*\z//;
#        return $sch;
#    } else {
#        return undef;
#    }
#}
#
#sub _normalize {
#    require Data::Sah::Normalize;
#
#    my ($sch, $opts) = @_;
#    return $sch if $opts->{schema_is_normalized};
#    return Data::Sah::Normalize::normalize_schema($sch);
#}
#
## for any|all to pass a criteria, we assume that all of the schemas in the 'of'
## clause must also pass (and there must not be '!of', 'of&', or that kind of
## thing.
#sub _handle_any_all {
#    my ($sch, $opts, $crit) = @_;
#    $sch = _normalize($sch, $opts);
#    return 0 if $sch->[1]{'of.op'};
#    my $of = $sch->[1]{of};
#    return 0 unless $of && ref($of) eq 'ARRAY' && @$of;
#    for (@$of) {
#        return 0 unless $crit->($_);
#    }
#    1;
#}
#
#sub is_type {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    $type;
#}
#
#sub is_simple {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_simple(shift) });
#    }
#    return $tmeta->{simple} // ($tmeta->{scalar} && !$tmeta->{ref});
#}
#
#sub is_collection {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_collection(shift) });
#    }
#    return !$tmeta->{scalar};
#}
#
#sub is_numeric {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_numeric(shift) });
#    }
#    return $tmeta->{numeric};
#}
#
#sub is_ref {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_ref(shift) });
#    }
#    return $tmeta->{ref};
#}
#
#1;
## ABSTRACT: Utility functions related to types
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Sah::Util::Type - Utility functions related to types
#
#=head1 VERSION
#
#This document describes version 0.46 of Data::Sah::Util::Type (from Perl distribution Data-Sah-Util-Type), released on 2016-12-09.
#
#=head1 SYNOPSIS
#
# use Data::Sah::Util::Type qw(
#     get_type
#     is_type
#     is_simple is_numeric is_collection is_ref
# );
#
# say get_type("int");                          # -> int
# say get_type("int*");                         # -> int
# say get_type([int => min=>0]);                # -> int
# say get_type("foo");                          # -> foo (doesn't check type is known)
#
# say is_type("int*");                          # -> 1
# say is_type("foo");                           # -> 0
#
# say is_simple("int");                          # -> 1
# say is_simple("array");                        # -> 0
# say is_simple([any => of => ["float", "str"]); # -> 1
# say is_simple("re");                           # -> 1
# say is_simple("foo");                          # -> 0
#
# say is_collection("array*");            # -> 1
# say is_collection(["hash", of=>"int"]); # -> 1
# say is_collection("str");               # -> 0
# say is_collection("foo");               # -> 0
#
# say is_ref("code*"); # -> 1
# say is_ref("array"); # -> 1
# say is_ref("str");   # -> 0
# say is_ref("foo");   # -> 0
#
# say is_numeric(["int", min=>0]); # -> 1
# say is_numeric("str");           # -> 0
# say is_numeric("foo");           # -> 0
#
#=head1 DESCRIPTION
#
#This module provides some secondary utility functions related to L<Sah> and
#L<Data::Sah>. It is deliberately distributed separately from the Data-Sah main
#distribution to be differentiated from Data::Sah::Util which contains "primary"
#utilities and is distributed with Data-Sah.
#
#Reference table for simple/collection/ref/numeric criteria of builtin types:
#
# +----------+-----------+---------------+--------+------------+
# | type     | is_simple | is_collection | is_ref | is_numeric |
# +----------+-----------+---------------+--------+------------+
# | array    |           | 1             | 1      |            |
# | bool     | 1         |               |        |            |
# | buf      | 1         |               |        |            |
# | cistr    | 1         |               |        |            |
# | code     |           |               | 1      |            |
# | date     | 1         |               |        |            |
# | duration | 1         |               |        |            |
# | float    | 1         |               |        | 1          |
# | hash     |           | 1             | 1      |            |
# | int      | 1         |               |        | 1          |
# | num      | 1         |               |        | 1          |
# | obj      |           |               | 1      |            |
# | re       | 1         |               | 1      |            |
# | str      | 1         |               |        |            |
# | undef    | 1         |               |        |            |
# +----------+-----------+---------------+--------+------------+
#
#=head1 FUNCTIONS
#
#None exported by default, but they are exportable.
#
#=head2 get_type($sch) => STR
#
#Return type name.
#
#=head2 is_type($sch) => STR
#
#Return type name if type in schema is known, or undef.
#
#=head2 is_simple($sch[, \%opts]) => BOOL
#
#Simple means "scalar" or can be represented as a scalar. This is currently used
#to determine if a builtin type can be specified as an argument or option value
#in command-line.
#
#This includes C<re>, C<bool>, as well as C<date> and C<duration>.
#
#If type is C<all>, then for this routine to be true all of the mentioned types
#must be simple. If type is C<any>, then for this routine to be true at least one
#of the mentioned types must be simple.
#
#Options:
#
#=over
#
#=item * schema_is_normalized => BOOL
#
#=back
#
#=head2 is_collection($sch[, \%opts]) => BOOL
#
#Collection means C<array> or C<hash>.
#
#If type is C<all>, then for this routine to be true all of the mentioned types
#must be collection. If type is C<any>, then for this routine to be true at least
#one of the mentioned types must be collection.
#
#=head2 is_ref($sch[, \%opts]) => BOOL
#
#"Ref" means generally a reference in Perl. But C<date> and C<duration> are not
#regarded as "ref". Regular expression on the other hand is regarded as a ref.
#
#If type is C<all>, then for this routine to be true all of the mentioned types
#must be "ref". If type is C<any>, then for this routine to be true at least one
#of the mentioned types must be "ref".
#
#=head2 is_numeric($sch[, \%opts]) => BOOL
#
#Currently, only C<num>, C<int>, and C<float> are numeric.
#
#If type is C<all>, then for this routine to be true all of the mentioned types
#must be numeric. If type is C<any>, then for this routine to be true at least
#one of the mentioned types must be numeric.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Util-Type>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Util-Type>.
#
#=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-Util-Type>
#
#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<Data::Sah>
#
#=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
### 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/Negate/EN.pm ###
#package Getopt::Long::Negate::EN;
#
#our $DATE = '2019-04-23'; # DATE
#our $VERSION = '0.060'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(negations_for_option);
#
#sub negations_for_option {
#    my $word = shift;
#
#    if    ($word =~ /\Awith([_-].+)/   ) { return ("without$1") }
#    elsif ($word =~ /\Awithout([_-].+)/) { return ("with$1")    }
#
#    elsif ($word =~ /\Ais([_-].+)/     ) { return ("isnt$1")    }
#    elsif ($word =~ /\Aisnt([_-].+)/   ) { return ("is$1")      }
#    elsif ($word =~ /\Aare([_-].+)/    ) { return ("arent$1")   }
#    elsif ($word =~ /\Aarent([_-].+)/  ) { return ("are$1")     }
#
#    elsif ($word =~ /\Ahas([_-].+)/    ) { return ("hasnt$1")   }
#    elsif ($word =~ /\Ahave([_-].+)/   ) { return ("havent$1")  }
#    elsif ($word =~ /\Ahasnt([_-].+)/  ) { return ("has$1")     }
#    elsif ($word =~ /\Ahavent([_-].+)/ ) { return ("have$1")    }
#
#    elsif ($word =~ /\Acan([_-].+)/    ) { return ("cant$1")    }
#    elsif ($word =~ /\Acant([_-].+)/   ) { return ("can$1")     }
#
#    elsif ($word =~ /\Aenabled([_-].+)/ ) { return ("disabled$1") }
#    elsif ($word =~ /\Adisabled([_-].+)/) { return ("enabled$1")  }
#    elsif ($word =~ /\Aenable([_-].+)/ )  { return ("disable$1")  }
#    elsif ($word =~ /\Adisable([_-].+)/)  { return ("enable$1")   }
#
#    elsif ($word =~ /\Aallowed([_-].+)/ )   { return ("disallowed$1") }
#    elsif ($word =~ /\Adisallowed([_-].+)/) { return ("allowed$1")    }
#    elsif ($word =~ /\Aallow([_-].+)/ )     { return ("disallow$1")   }
#    elsif ($word =~ /\Adisallow([_-].+)/)   { return ("allow$1")      }
#
#    elsif ($word =~ /\Ainclude([_-].+)/ ) { return ("exclude$1") }
#    elsif ($word =~ /\Aexclude([_-].+)/ ) { return ("include$1") }
#
#    elsif ($word =~ /\Ano[_-](.+)/     ) { return ($1)          }
#
#    else {
#        # default from Getopt::Long
#        return ("no-$word", "no$word");
#    }
#}
#
#1;
## ABSTRACT: Better negation of boolean option names
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Getopt::Long::Negate::EN - Better negation of boolean option names
#
#=head1 VERSION
#
#This document describes version 0.060 of Getopt::Long::Negate::EN (from Perl distribution Getopt-Long-Negate-EN), released on 2019-04-23.
#
#=head1 SYNOPSIS
#
# use Getopt::Long::Negate::EN qw(negations_for_option);
#
# # the Getopt::Long's default
# @negs = negations_for_option('foo'); # ('no-foo', 'nofoo')
#
# @negs = negations_for_option('with-foo');    # ('without-foo')
# @negs = negations_for_option('without-foo'); # ('with-foo')
#
# @negs = negations_for_option('is-foo');      # ('isnt-foo')
# @negs = negations_for_option('isnt-foo');    # ('is-foo')
# @negs = negations_for_option('are-foo');     # ('isnt-foo')
# @negs = negations_for_option('arent-foo');   # ('arent-foo')
#
# @negs = negations_for_option('has-foo');     # ('hasnt-foo')
# @negs = negations_for_option('hasnt-foo');   # ('has-foo')
# @negs = negations_for_option('have-foo');    # ('havent-foo')
# @negs = negations_for_option('havent-foo');  # ('have-foo')
#
# @negs = negations_for_option('can-foo');     # ('cant-foo')
# @negs = negations_for_option('cant-foo');    # ('can-foo')
#
# @negs = negations_for_option('enabled-foo'); # ('disabled-foo')
# @negs = negations_for_option('disabled-foo');# ('enabled-foo')
# @negs = negations_for_option('enable-foo');  # ('disable-foo')
# @negs = negations_for_option('disable-foo'); # ('enable-foo')
#
# @negs = negations_for_option('allowed-foo');    # ('disallowed-foo')
# @negs = negations_for_option('disallowed-foo'); # ('allowed-foo')
# @negs = negations_for_option('allow-foo');      # ('disallow-foo')
# @negs = negations_for_option('disallow-foo');   # ('allow-foo')
#
# @negs = negations_for_option('include-foo'); # ('exclude-foo')
# @negs = negations_for_option('exclude-foo'); # ('include-foo')
#
# @negs = negations_for_option('no-foo');      # ('foo')
#
#=head1 DESCRIPTION
#
#This module aims to provide a nicer negative boolean option names. By default,
#L<Getopt::Long> provides options C<--foo> as well as C<--no-foo> and C<--nofoo>
#if you specify boolean option specification C<foo!>. But this produces
#awkward/incorrect English word like C<--nowith-foo> or C<--no-is-foo>. In those
#two cases, C<--without-foo> and C<--isnt-foo> are better option names.
#
#=head1 FUNCTIONS
#
#None are exported by default, but they are exportable.
#
#=head2 negations_for_option($str) => list
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Getopt-Long-Negate-EN>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Getopt-Long-Negate-EN>.
#
#=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-Negate-EN>
#
#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) 2019, 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
### Getopt/Long/Util.pm ###
#package Getopt::Long::Util;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-27'; # DATE
#our $DIST = 'Getopt-Long-Util'; # DIST
#our $VERSION = '0.891'; # VERSION
#
#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
#               );
#
#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 undef;
#    my %res = %+;
#
#    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=somelabel  (if you provide 'value_label')
#    --debug!       ->  --(no)debug
#
#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',
#        },
#        value_label => {
#            schema => 'str*',
#        },
#
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => '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 $res = '';
#    my $i = 0;
#    for (@{ $parse->{opts} }) {
#        $i++;
#        $res .= ($opts->{separator} // ", ") if length($res);
#        if ($parse->{is_neg} && length($_) > 1) {
#            $res .= "--(no)$_";
#        } else {
#            if (length($_) > 1) {
#                $res .= "--$_";
#            } else {
#                $res .= "-$_";
#            }
#            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};
#                $res .= "[" if $parse->{opttype};
#                $res .= ($parse->{type} && $parse->{desttype} eq '%' ? " " : "=");
#                $res .= "key=" if $parse->{desttype} eq '%';
#                $res .= $value_label;
#                $res .= "]" if $parse->{opttype};
#            }
#            $res .= "+" if ($parse->{desttype} // '') eq '@';
#        }
#    }
#    $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;
#}
#
#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.891 of Getopt::Long::Util (from Perl distribution Getopt-Long-Util), released on 2020-04-27.
#
#=head1 FUNCTIONS
#
#
#=head2 detect_getopt_long_script
#
#Usage:
#
# detect_getopt_long_script(%args) -> [status, msg, payload, 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) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#
#
#=head2 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
#
#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=somelabel  (if you provide 'value_label')
# --debug!       ->  --(no)debug
#
#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<key_label> => I<str> (default: "key")
#
#=item * B<$optspec>* => I<str>
#
#=item * B<separator> => I<str> (default: ", ")
#
#=item * B<value_label> => I<str>
#
#
#=back
#
#Return value:  (str)
#
#
#
#=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>
#
#
#=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 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.
#
#=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 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 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
### Lingua/EN/PluralToSingular.pm ###
#package Lingua::EN::PluralToSingular;
#use warnings;
#use strict;
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw/to_singular is_plural/;
#our $VERSION = '0.21';
#
## Irregular plurals.
#
## References:
## http://www.macmillandictionary.com/thesaurus-category/british/Irregular-plurals
## http://web2.uvcs.uvic.ca/elc/studyzone/330/grammar/irrplu.htm
## http://www.scribd.com/doc/3271143/List-of-100-Irregular-Plural-Nouns-in-English
#
## This mixes latin/greek plurals and anglo-saxon together. It may be
## desirable to split things like corpora and genera from "feet" and
## "geese" at some point.
#
#my %irregular = (qw/
#    analyses analysis
#    brethren brother
#    children child
#    corpora corpus
#    craftsmen craftsman
#    crises crisis
#    criteria criterion
#    curricula curriculum
#    feet foot
#    fungi fungus
#    geese goose
#    genera genus
#    gentlemen gentleman
#    indices index
#    lice louse
#    matrices matrix
#    memoranda memorandum
#    men man
#    mice mouse
#    monies money
#    neuroses neurosis
#    nuclei nucleus
#    oases oasis
#    oxen ox
#    pence penny
#    people person
#    phenomena phenomenon
#    quanta quantum
#    strata stratum
#    teeth tooth
#    testes testis
#    these this
#    theses thesis
#    those that
#    women woman
#ad-men ad-man
#admen adman
#aircraftmen aircraftman
#airmen airman
#airwomen airwoman
#alaskamen alaskaman
#aldermen alderman
#anchormen anchorman
#ape-men ape-man
#assemblymen assemblyman
#backwoodsmen backwoodsman
#bandsmen bandsman
#barmen barman
#barrow-men barrow-man
#batmen batman
#batsmen batsman
#beggarmen beggarman
#beggarwomen beggarwoman
#behmen behman
#boatmen boatman
#bogeymen bogeyman
#bowmen bowman
#brakemen brakeman
#bushmen bushman
#businessmen businessman
#businesswomen businesswoman
#busmen busman
#byre-men byre-man
#cabmen cabman
#cameramen cameraman
#carmen carman
#cattlemen cattleman
#cavalrymen cavalryman
#cavemen caveman
#chairmen chairman
#chairwomen chairwoman
#chapmen chapman
#charwomen charwoman
#chessmen chessman
#chinamen chinaman
#churchmen churchman
#clansmen clansman
#classmen classman
#clemen cleman
#clergymen clergyman
#coachmen coachman
#coalmen coalman
#cognomen cognoman
#con-men con-man
#congressmen congressman
#congresswomen congresswoman
#councilmen councilman
#councilwomen councilwoman
#countrymen countryman
#countrywomen countrywoman
#cowmen cowman
#cracksmen cracksman
#craftsmen craftsman
#cragsmen cragsman
#crewmen crewman
#cyclamen cyclaman
#dairymen dairyman
#dalesmen dalesman
#doormen doorman
#draftsmen draftsman
#draughtsmen draughtsman
#dustmen dustman
#dutchmen dutchman
#englishmen englishman
#englishwomen englishwoman
#ex-servicemen ex-serviceman
#excisemen exciseman
#fellow-men fellow-man
#ferrymen ferryman
#fieldsmen fieldsman
#firemen fireman
#fishermen fisherman
#flagmen flagman
#footmen footman
#foremen foreman
#forewomen forewoman
#freedmen freedman
#freemen freeman
#frenchmen frenchman
#frenchwomen frenchwoman
#freshmen freshman
#frogmen frogman
#frontiersmen frontiersman
#g-men g-man
#gentlemen gentleman
#gentlewomen gentlewoman
#germen german
#god-men god-man
#gombeen-men gombeen-man
#groundsmen groundsman
#guardsmen guardsman
#gunmen gunman
#handymen handyman
#hangmen hangman
#harmen harman
#he-men he-man
#headmen headman
#helmsmen helmsman
#hemmen hemman
#henchmen henchman
#herdsmen herdsman
#highwaymen highwayman
#horsemen horseman
#horsewomen horsewoman
#housemen houseman
#huntsmen huntsman
#husbandmen husbandman
#hymen hyman
#icemen iceman
#indiamen indiaman
#infantrymen infantryman
#irishmen irishman
#irishwomen irishwoman
#jazzmen jazzman
#journeymen journeyman
#jurymen juryman
#kinmen kinman
#kinsmen kinsman
#kinswomen kinswoman
#klansmen klansman
#landsmen landsman
#laundrymen laundryman
#laundrywomen laundrywoman
#lawmen lawman
#laymen layman
#liegemen liegeman
#liftmen liftman
#linemen lineman
#linesmen linesman
#linkmen linkman
#liverymen liveryman
#lobstermen lobsterman
#longshoremen longshoreman
#lumbermen lumberman
#madmen madman
#madwomen madwoman
#mailmen mailman
#marksmen marksman
#medicine-men medicine-man
#men man
#merchantmen merchantman
#mermen merman
#middlemen middleman
#midshipmen midshipman
#militiamen militiaman
#milkmen milkman
#minutemen minuteman
#motormen motorman
#muffin-men muffin-man
#musclemen muscleman
#needlewomen needlewoman
#newsmen newsman
#newspapermen newspaperman
#newswomen newswoman
#night-watchmen night-watchman
#noblemen nobleman
#nomen noman
#norsemen norseman
#northmen northman
#nurserymen nurseryman
#oarsmen oarsman
#oarswomen oarswoman
#oehmen oehman
#oilmen oilman
#ombudsmen ombudsman
#orangemen orangeman
#pantrymen pantryman
#patrolmen patrolman
#pitchmen pitchman
#pitmen pitman
#placemen placeman
#plainsmen plainsman
#ploughmen ploughman
#pointsmen pointsman
#policemen policeman
#policewomen policewoman
#postmen postman
#potmen potman
#pressmen pressman
#property-men property-man
#quarrymen quarryman
#raftsmen raftsman
#ragmen ragman
#railwaymen railwayman
#repairmen repairman
#riflemen rifleman
#roadmen roadman
#roundsmen roundsman
#salarymen salaryman
#salesmen salesman
#saleswomen saleswoman
#salmen salman
#sandwichmen sandwichman
#schoolmen schoolman
#scotchmen scotchman
#scotchwomen scotchwoman
#scotsmen scotsman
#scotswomen scotswoman
#seamen seaman
#seedsmen seedsman
#servicemen serviceman
#showmen showman
#sidesmen sidesman
#signalmen signalman
#snowmen snowman
#specimen speciman
#spokesmen spokesman
#spokeswomen spokeswoman
#sportsmen sportsman
#stablemen stableman
#stamen staman
#stammen stamman
#statesmen statesman
#steersmen steersman
#supermen superman
#superwomen superwoman
#switchmen switchman
#swordsmen swordsman
#t-men t-man
#tallymen tallyman
#taxmen taxman
#townsmen townsman
#tradesmen tradesman
#trainmen trainman
#trenchermen trencherman
#tribesmen tribesman
#turkmen turkman
#tutankhamen tutankhaman
#underclassmen underclassman
#vestrymen vestryman
#vonallmen vonallman
#washerwomen washerwoman
#watchmen watchman
#watermen waterman
#weathermen weatherman
#welshmen welshman
#women woman
#woodmen woodman
#woodsmen woodsman
#workmen workman
#yachtsmen yachtsman
#yeomen yeoman
#/);
#
## Words ending in ves need care, since the ves may become "f" or "fe".
#
## References:
## http://www.macmillandictionary.com/thesaurus-category/british/Irregular-plurals
#
#my %ves = (qw/
#    calves calf
#    dwarves dwarf
#    elves elf
#    halves half
#    knives knife
#    leaves leaf
#    lives life
#    loaves loaf
#    scarves scarf
#    sheaves sheaf
#    shelves shelf
#    wharves wharf 
#    wives wife
#    wolves wolf
#/);
#
## A dictionary of plurals.
#
#my %plural = (
#    # Words ending in "us" which are plural, in contrast to words like
#    # "citrus" or "bogus".
#    'menus' => 'menu',
#    'buses' => 'bus',
#    %ves,
#    %irregular,
#);
#
## A store of words which are the same in both singular and plural.
#
#my @no_change = qw/
#                      deer
#                      ides
#                      fish
#                      means
#                      offspring
#                      series
#                      sheep
#                      species
#                  /;
#
#@plural{@no_change} = @no_change;
#
## A store of words which look like plurals but are not.
#
## References:
#
## http://wiki.answers.com/Q/What_are_some_examples_of_singular_nouns_ending_in_S
## http://virtuallinguist.typepad.com/the_virtual_linguist/2009/10/singular-nouns-ending-in-s.html
#
#my @not_plural = (qw/
#Aries
#Charles
#Gonzales 
#Hades 
#Hercules 
#Hermes 
#Holmes 
#Hughes 
#Ives 
#Jacques 
#James 
#Keyes 
#Mercedes 
#Naples 
#Oates 
#Raines 
#Texas
#athletics
#bogus
#bus
#cactus
#cannabis
#caries
#chaos
#citrus
#clothes
#corps
#corpus
#devious
#dias
#facies
#famous
#hippopotamus
#homunculus
#iris
#lens
#mathematics
#metaphysics
#metropolis
#mews
#minus
#miscellaneous
#molasses
#mrs
#narcissus
#news
#octopus
#ourselves
#papyrus
#perhaps
#physics
#platypus
#plus
#previous
#pus
#rabies
#scabies
#sometimes
#stylus
#themselves
#this
#thus
#various
#yes
#nucleus
#synchronous
#/);
#
#my %not_plural;
#
#@not_plural{@not_plural} = (1) x @not_plural;
#
## A store of words which end in "oe" and whose plural ends in "oes".
#
## References
## http://www.scrabblefinder.com/ends-with/oe/
#
## Also used
#
## perl -n -e 'print if /oe$/' < /usr/share/dict/words
#
#my @oes = (qw/
#canoes
#does
#foes
#gumshoes
#hoes
#horseshoes
#oboes
#shoes
#snowshoes
#throes
#toes
#/);
#
#my %oes;
#
#@oes{@oes} = (1) x @oes;
#
## A store of words which end in "ie" and whose plural ends in "ies".
#
## References:
## http://www.scrabblefinder.com/ends-with/ie/
## (most of the words are invalid, the above list was manually searched
## for useful words).
#
## Also get a good list using
#
## perl -n -e 'print if /ie$/' < /usr/share/dict/words 
#
## There are too many obscure words there though.
#
## Also, I'm deliberately not including "Bernie" and "Bessie" since the
## plurals are rare I think. 
#
#my @ies = (qw/
#Aussies
#Valkryies
#aunties
#bogies
#brownies
#calories
#charlies
#coolies
#coteries
#curies
#cuties
#dies
#genies
#goalies
#kilocalories
#lies
#magpies
#menagerie
#movies
#neckties
#pies
#porkpies
#prairies
#quickies
#reveries
#rookies
#sorties
#stogies
#talkies
#ties
#zombies
#/);
#
#my %ies;
#
#@ies{@ies} = (1) x @ies;
#
## Words which end in -se, so that we want the singular to change from
## -ses to -se. This also contains verbs like "deceases", so that they
## don't trigger spell checker errors.
#
#my @ses = (qw/
#automates
#bases
#cases
#causes
#ceases
#closes
#cornflakes
#creases
#databases
#deceases
#flakes
#horses
#increases
#mates
#parses
#purposes
#races
#releases
#tenses
#/);
#
#my %ses;
#@ses{@ses} = (1) x @ses;
## A regular expression which matches the end of words like "dishes"
## and "sandwiches". $1 is a capture which contains the part of the
## word which should be kept in a substitution.
#
#my $es_re = qr/([^aeiou]s|ch|sh)es$/;
#
## Plurals ending -i, singular is either -us, -o or something else
## See https://en.wiktionary.org/wiki/Category:English_irregular_plurals_ending_in_%22-i%22
#
## -i to -us
#my @i_to_us = (qw/
#abaci
#abaculi
#acanthi
#acini
#alumni
#anthocauli
#bacilli
#baetuli
#cacti
#calculi
#calli
#catheti
#emboli
#emeriti
#esophagi
#foci
#foeti
#fumuli
#fungi
#gonococci
#hippopotami
#homunculi
#incubi
#loci
#macrofungi
#macronuclei
#naevi
#nuclei
#obeli
#octopi
#oeconomi
#oesophagi
#panni
#periœci
#phocomeli
#phoeti
#platypi
#polypi
#precunei
#radii
#rhombi
#sarcophagi
#solidi
#stimuli
#succubi
#syllabi
#thesauri
#thrombi
#tori
#trophi
#uteri
#viri
#virii
#xiphopagi
#zygomatici
#/);
#
#my %i_to_us;
#@i_to_us{@i_to_us} = (1) x @i_to_us;
#
## -i to -o
#my @i_to_o = (qw/
#    alveoli
#    ghetti
#    manifesti
#    ostinati
#    pianissimi
#    scenarii
#    stiletti
#    torsi
#/);
#
#my %i_to_o;
#@i_to_o{@i_to_o} = (1) x @i_to_o;
#
## -i to something else
#
#my %i_to_other = (
#    improvisatori => 'improvisatore',
#    rhinoceri => 'rhinoceros',
#    scaloppini => 'scaloppine'
#);
#
## See documentation below.
#
#sub to_singular
#{
#    my ($word) = @_;
#    # The return value.
#    my $singular = $word;
#    if (! $not_plural{$word}) {
#        # The word is not in the list of exceptions.
#        if ($plural{$word}) {
#            # The word has an irregular plural, like "children", or
#            # "geese", so look up the singular in the table.
#            $singular = $plural{$word};
#        }
#        elsif ($word =~ /s$/) {
#            # The word ends in "s".
#            if ($word =~ /'s$/) {
#            # report's, etc.
#            ;
#            }
#            elsif (length ($word) <= 2) {
#            # is, as, letter s, etc.
#            ;
#            }
#            elsif ($word =~ /ss$/) {
#            # useless, etc.
#            ;
#            }
#            elsif ($word =~ /sis$/) {
#            # basis, dialysis etc.
#            ;
#            }
#            elsif ($word =~ /ies$/) {
#                # The word ends in "ies".
#                if ($ies{$word}) {
#                    # Lies -> lie
#                    $singular =~ s/ies$/ie/;
#                }
#                else {
#                    # Fries -> fry
#                    $singular =~ s/ies$/y/;
#                }
#            }
#            elsif ($word =~ /oes$/) {
#                # The word ends in "oes".
#                if ($oes{$word}) {
#                    # Toes -> toe
#                    $singular =~ s/oes$/oe/;
#                }
#                else {
#                    # Potatoes -> potato
#                    $singular =~ s/oes$/o/;
#                }
#            }
#            elsif ($word =~ /xes$/) {
#                # The word ends in "xes".
#		        $singular =~ s/xes$/x/;
#            }
#            elsif ($word =~ /ses$/) {
#                if ($ses{$word}) {
#                    $singular =~ s/ses$/se/;
#                }
#                else {
#                    $singular =~ s/ses$/s/;
#                }
#	        }
#            elsif ($word =~ $es_re) {
#                # Sandwiches -> sandwich
#                # Dishes -> dish
#                $singular =~ s/$es_re/$1/;
#            }
#            else {
#                # Now the program has checked for every exception it
#                # can think of, so it assumes that it is OK to remove
#                # the "s" from the end of the word.
#                $singular =~ s/s$//;
#            }
#        }
#        elsif ($word =~ /i$/) {
#            if ($i_to_us{$word}) {
#                $singular =~ s/i$/us/;
#            }
#            elsif ($i_to_o{$word}) {
#                $singular =~ s/i$/o/;
#            }
#            if ($i_to_other{$word}) {
#                $singular = $i_to_other{$word};
#            }
#        }
#
#    }
#    return $singular;
#}
#
#sub is_plural
#{
#    my ($word) = @_;
#    my $singular = to_singular ($word);
#    my $is_plural;
#    if ($singular ne $word) {
#	$is_plural = 1;
#    }
#    elsif ($plural{$singular} && $plural{$singular} eq $singular) {
#	$is_plural = 1;
#    }
#    else {
#	$is_plural = 0;
#    }
#    return $is_plural;
#}
#
#1;
### Log/ger.pm ###
#package Log::ger;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # 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.037
#
#=head1 SYNOPSIS
#
#=head2 Producing logs
#
#In your module (producer):
#
# package Foo;
# use Log::ger; # will install some logger routines e.g. log_warn, log_error
#
# sub foo {
#     ...
#     # produce some logs. no need to configure output or level.
#     log_error "an error occured: %03d - %s", $errcode, $errmsg;
#     ...
#     log_debug "http response: %s", $http; # automatic dumping of data
# }
# 1;
#
#=head2 Consuming logs
#
#=head3 Choosing an output
#
#In your application (consumer/listener):
#
# use Foo;
# use Log::ger::Output 'Screen'; # configure output
# # level is by default 'warn'
# foo(); # the error message is shown, but debug message is 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.
#
#=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
#
#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) 2020, 2019, 2018, 2017 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
### Log/ger/Filter.pm ###
#package Log::ger::Filter;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # 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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Filter/Code.pm ###
#package Log::ger::Filter::Code;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
#use strict;
#use warnings;
#
#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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Format.pm ###
#package Log::ger::Format;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # 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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Format/Default.pm ###
#package Log::ger::Format::Default;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
#use strict;
#use warnings;
#
#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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Format/None.pm ###
#package Log::ger::Format::None;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # 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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Heavy.pm ###
#package Log::ger::Heavy;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
##IFUNBUILT
## use strict;
## use warnings;
##END IFUNBUILT
#
#package
#    Log::ger;
#
##IFUNBUILT
## use vars qw(
##                $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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Layout.pm ###
#package Log::ger::Layout;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # 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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Output.pm ###
#package Log::ger::Output;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # 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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Output/Array.pm ###
#package Log::ger::Output::Array;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
#use strict;
#use warnings;
#
#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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Output/Null.pm ###
#package Log::ger::Output::Null;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # 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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Output/String.pm ###
#package Log::ger::Output::String;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
#use strict;
#use warnings;
#
#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.037
#
#=head1 SYNOPSIS
#
# use var '$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) 2020, 2019, 2018, 2017 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
### Log/ger/Plugin.pm ###
#package Log::ger::Plugin;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Log/ger/Plugin/MultilevelLog.pm ###
#package Log::ger::Plugin::MultilevelLog;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#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::Plugin::MultilevelLog - Create a log($LEVEL, ...) subroutine/method
#
#=head1 VERSION
#
#version 0.037
#
#=head1 SYNOPSIS
#
# use Log::ger::Plugin 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);
#
#=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 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::Plugin::HashArgs>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2017 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
### Log/ger/Util.pm ###
#package Log::ger::Util;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-03-11'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.037'; # VERSION
#
#use strict;
#use warnings;
#
#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';
#        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.037
#
#=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) 2020, 2019, 2018, 2017 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
### Mo.pm ###
#package Mo;
#$Mo::VERSION = '0.40';
#$VERSION='0.40';
#no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};@_=(default,@_)if!($#_%2);$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};
### Mo/Golf.pm ###
###
## name:      Mo::Golf
## abstract:  Module for Compacting Mo Modules
## author:    Ingy döt Net <ingy@ingy.net>
## license:   perl
## copyright: 2011
## see:
## - Mo
#
#use strict;
#use warnings;
#package Mo::Golf;
#
#our $VERSION='0.40';
#
#use PPI;
#
## This is the mapping of common names to shorter forms that still make some
## sense.
#my %short_names = (
#    (
#        map {($_, substr($_, 0, 1))}
#        qw(
#            args builder class default exports features
#            generator import is_lazy method MoPKG name
#            nonlazy_defaults options reftype self
#        )
#    ),
#    build_subs => 'B',
#    old_constructor => 'C',
#    caller_pkg => 'P',
#);
#
#my %short_barewords = ( EAGERINIT => q{':E'}, NONLAZY => q{':N'} );
#
#my %hands_off = map {($_,1)} qw'&import *import';
#
#sub import {
#    return unless @_ == 2 and $_[1] eq 'golf';
#    binmode STDOUT;
#    my $text = do { local $/; <> };
#    print STDOUT golf( $text );
#};
#
#sub golf {
#    my ( $text ) = @_;
#
#    my $tree = PPI::Document->new( \$text );
#
#    my %finder_subs = _finder_subs();
#
#    my @order = qw( comments duplicate_whitespace whitespace trailing_whitespace );
#
#    for my $name ( @order ) {
#        my $elements = $tree->find( $finder_subs{$name} );
#        die $@ if !defined $elements;
#        $_->delete for @{ $elements || [] };
#    }
#
#    $tree->find( $finder_subs{$_} )
#      for qw( del_superfluous_concat del_last_semicolon_in_block separate_version shorten_var_names shorten_barewords );
#    die $@ if $@;
#
#    for my $name ( 'double_semicolon' ) {
#        my $elements = $tree->find( $finder_subs{$name} );
#        die $@ if !defined $elements;
#        $_->delete for @{ $elements || [] };
#    }
#
#    return $tree->serialize . "\n";
#}
#
#sub tok { "PPI::Token::$_[0]" }
#
#sub _finder_subs {
#    return (
#        comments => sub { $_[1]->isa( tok 'Comment' ) },
#
#        duplicate_whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#
#            $current->set_content(' ') if 1 < length $current->content;
#
#            return 0 if !$current->next_token;
#            return 0 if !$current->next_token->isa( tok 'Whitespace' );
#            return 1;
#        },
#
#        whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#            my $prev = $current->previous_token;
#            my $next = $current->next_token;
#
#            return 1 if $prev->isa( tok 'Number' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # my $P
#            return 1 if $prev->isa( tok 'Word' )   and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # my $P
#            return 1 if $prev->isa( tok 'Symbol' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; # $VERSION =  but not $v and
#
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Single' ) and $next->content =~ /^\W/; # eq ''
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Double' ) and $next->content =~ /^\W/; # eq ""
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Symbol' )        and $next->content =~ /^\W/; # eq $v
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Structure' )     and $next->content =~ /^\W/; # eq (
#
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Symbol' );           # my $P
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Structure' );        # sub {
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Quote::Double' );    # eval "
#            return 1 if $prev->isa( tok 'Symbol' )     and $next->isa( tok 'Structure' );        # %a )
#            return 1 if $prev->isa( tok 'ArrayIndex' ) and $next->isa( tok 'Operator' );         # $#_ ?
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Cast' );             # exists &$_
#            return 0;
#        },
#
#        trailing_whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#            my $prev = $current->previous_token;
#
#            return 1 if $prev->isa( tok 'Structure' );                                           # ;[\n\s]
#            return 1 if $prev->isa( tok 'Operator' ) and $prev->content =~ /\W$/;                # = 0.24
#            return 1 if $prev->isa( tok 'Quote::Double' );                                       # " .
#            return 1 if $prev->isa( tok 'Quote::Single' );                                       # ' }
#
#            return 0;
#        },
#
#        double_semicolon => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Structure' );
#            return 0 if $current->content ne ';';
#
#            my $prev = $current->previous_token;
#
#            return 0 if !$prev->isa( tok 'Structure' );
#            return 0 if $prev->content ne ';';
#
#            return 1;
#        },
#
#        del_last_semicolon_in_block => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( 'PPI::Structure::Block' );
#
#            my $last = $current->last_token;
#
#            return 0 if !$last->isa( tok 'Structure' );
#            return 0 if $last->content ne '}';
#
#            my $maybe_semi = $last->previous_token;
#
#            return 0 if !$maybe_semi->isa( tok 'Structure' );
#            return 0 if $maybe_semi->content ne ';';
#
#            $maybe_semi->delete;
#
#            return 1;
#        },
#
#        del_superfluous_concat => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Operator' );
#
#            my $prev = $current->previous_token;
#            my $next = $current->next_token;
#
#            return 0 if $current->content ne '.';
#            return 0 if !$prev->isa( tok 'Quote::Double' );
#            return 0 if !$next->isa( tok 'Quote::Double' );
#
#            $current->delete;
#            $prev->set_content( $prev->{separator} . $prev->string . $next->string . $prev->{separator} );
#            $next->delete;
#
#            return 1;
#        },
#
#        separate_version => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( 'PPI::Statement' );
#
#            my $first = $current->first_token;
#            return 0 if $first->content ne '$VERSION';
#
#            $current->$_( PPI::Token::Whitespace->new( "\n" ) ) for qw( insert_before insert_after );
#
#            return 1;
#        },
#
#        shorten_var_names => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Symbol' );
#
#            my $long_name = $current->canonical;
#
#            return 1 if $hands_off{$long_name};
#            (my $name = $long_name) =~ s/^([\$\@\%])// or die $long_name;
#            my $sigil = $1;
#            die "variable $long_name conflicts with shortened var name"
#                if grep {
#                    $name eq $_
#                } values %short_names;
#
#            my $short_name = $short_names{$name};
#            $current->set_content( "$sigil$short_name" ) if $short_name;
#
#            return 1;
#        },
#
#        shorten_barewords => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Word' );
#
#            my $name = $current->content;
#
#            die "bareword $name conflicts with shortened bareword"
#                if grep {
#                    $name eq $_
#                } values %short_barewords;
#
#            my $short_name = $short_barewords{$name};
#            $current->set_content( $short_name ) if $short_name;
#
#            return 1;
#        },
#    );
#}
#
#=head1 SYNOPSIS
#
#    perl -MMo::Golf=golf < src/Mo/foo.pm > lib/Mo/foo.pm
#
#=head1 DESCRIPTION
#
#This is the module that is responsible for taking Mo code (which is
#documented and fairly readable) and reducing it to a single undecipherable
#line.
### Mo/Inline.pm ###
###
## name:      Mo::Inline
## abstract:  Inline Mo and Features into your package
## author:    Ingy döt Net <ingy@ingy.net>
## license:   perl
## copyright: 2011
## see:
## - Mo
#
#package Mo::Inline;
#use Mo;
#
#our $VERSION='0.40';
#
#use IO::All;
#
#my $matcher = qr/((?m:^#\s*use Mo(\s.*)?;.*\n))(?:#.*\n)*(?:.{400,}\n)?/;
#
#sub run {
#    my $self = shift;
#    my @files;
#    if (not @_ and -d 'lib') {
#        print "Searching the 'lib' directory for a Mo to inline:\n";
#        @_ = 'lib';
#    }
#    if (not @_ or @_ == 1 and $_[0] =~ /^(?:-\?|-h|--help)$/) {
#        print usage();
#        return 0;
#    }
#    for my $name (@_) {
#        die "No file or directory called '$name'"
#            unless -e $name;
#        die "'$name' is not a Perl module"
#            if -f $name and $name !~ /\.pm$/;
#        if (-f $name) {
#            push @files, $name;
#        }
#        elsif (-d $name) {
#            push @_, grep /\.pm$/, map { "$_" } io($name)->All_Files;
#        }
#    }
#
#    die "No .pm files specified"
#        unless @files;
#
#    for my $file (@files) {
#        my $text = io($file)->all;
#        if ($text !~ $matcher) {
#            print "Ignoring $file - No Mo to Inline!\n";
#            next;
#        }
#        $self->inline($file, 1);
#    }
#}
#
#sub inline {
#    my ($self, $file, $noisy) = @_;
#    my $text = io($file)->all;
#    $text =~ s/$matcher/"$1" . &inliner($2)/eg;
#    io($file)->print($text);
#    print "Mo Inlined $file\n"
#        if $noisy;
#}
#
#sub inliner {
#    my $mo = shift;
#    require Mo;
#    my @features = grep {$_ ne 'qw'} ($mo =~ /(\w+)/g);
#    for (@features) {
#        eval "require Mo::$_; 1" or die $@;
#    }
#    my $inline = '';
#    $inline .= $_ for map {
#        my $module = $_;
#        $module .= '.pm';
#        my @lines = io($INC{$module})->chomp->getlines;
#        $lines[-1];
#    } ('Mo', map { s!::!/!g; "Mo/$_" } @features);
#    return <<"...";
##   The following line of code was produced from the previous line by
##   Mo::Inline version $VERSION
#$inline\@f=qw[@features];use strict;use warnings;
#...
#}
#
#sub usage {
#    <<'...';
#Usage: mo-linline <perl module files or directories>
#
#...
#}
#
#1;
#
#=head1 SYNOPSIS
#
#In your Mo module:
#
#    # This is effectively your own private Mo(ose) setup
#    package MyModule::Mo;
#    # use Mo qw'build builder default import';
#    1;
#
#From the command line:
#
#    > mo-inline lib/MyModule/Mo.pm
#
#or:
#
#    > mo-inline lib/
#
#or (if you are really lazy):
#
#    > mo-inline
#
#Then from another module:
#
#    package MyModule::Foo;
#    use MyModule::Mo;       # gets build, builder and default automatically
#
#=head1 DESCRIPTION
#
#Mo is so small that you can easily inline it, along with any feature modules.
#Mo provides a script called C<mo-inline> that will do it for you.
#
#All you need to do is comment out the line that uses Mo, and run C<mo-inline>
#on the file. C<mo-inline> will find such comments and do the inlining for you.
#It will also replace any old inlined Mo with the latest version.
#
#What Mo could you possibly want?
#
#=head1 AUTOMATIC FEATURES
#
#By using the L<Mo::import> feature, all uses of your Mo class will turn on all
#the features you specified. You can override it if you want, but that will be
#the default.
#
#=head1 REAL WORLD EXAMPLES
#
#For real world examples of Mo inlined using C<mo-inline>, see L<YAML::Mo>,
#L<Pegex::Mo> and L<TestML::Mo>.
### Mo/Moose.pm ###
#package Mo::Moose;
#$Mo::Moose::VERSION = '0.40';$M="Mo::";
#$VERSION='0.40';
#*{$M.'Moose::e'}=sub{my($P,$e)=@_;$P=~s/::$//;%$e=(M=>1);require Moose;Moose->import({into=>$P});Moose::Util::MetaRole::apply_metaroles(for=>$P,class_metaroles=>{attribute=>['Attr::Trait']},)};BEGIN{package Attr::Trait;
#$Attr::Trait::VERSION = '0.40';use Moose::Role;around _process_options=>sub{my$orig=shift;my$c=shift;my($n,$o)=@_;$o->{is}||='rw';$o->{lazy}||=1 if defined$o->{default}or defined$o->{builder};$c->$orig(@_)};$INC{'Attr/Trait.pm'}=1}
### Mo/Mouse.pm ###
#package Mo::Mouse;
#$Mo::Mouse::VERSION = '0.40';$M="Mo::";
#$VERSION='0.40';
#*{$M.'Mouse::e'}=sub{my($P,$e)=@_;$P=~s/::$//;%$e=(M=>1);require Mouse;require Mouse::Util::MetaRole;Mouse->import({into=>$P});Mouse::Util::MetaRole::apply_metaroles(for=>$P,class_metaroles=>{attribute=>['Attr::Trait']},)};BEGIN{package Attr::Trait;
#$Attr::Trait::VERSION = '0.40';use Mouse::Role;around _process_options=>sub{my$orig=shift;my$c=shift;my($n,$o)=@_;$o->{is}||='rw';$o->{lazy}||=1 if defined$o->{default}or defined$o->{builder};$c->$orig(@_)};$INC{'Attr/Trait.pm'}=1}
### Mo/build.pm ###
#package Mo::build;
#$Mo::build::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'build::e'}=sub{my($P,$e)=@_;$e->{new}=sub{$c=shift;my$s=&{$M.Object::new}($c,@_);my@B;do{@B=($c.::BUILD,@B)}while($c)=@{$c.::ISA};exists&$_&&&$_($s)for@B;$s}};
### Mo/builder.pm ###
#package Mo::builder;
#$Mo::builder::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=\&{$P.$b}and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};
### Mo/chain.pm ###
#package Mo::chain;
#$Mo::chain::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'chain::e'}=sub{my($P,$e,$o)=@_;$o->{chain}=sub{my($m,$n,%a)=@_;$a{chain}or return$m;sub{$#_?($m->(@_),return$_[0]):$m->(@_)}}};
### Mo/coerce.pm ###
#package Mo::coerce;
#$Mo::coerce::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'coerce::e'}=sub{my($P,$e,$o)=@_;$o->{coerce}=sub{my($m,$n,%a)=@_;$a{coerce}or return$m;sub{$#_?$m->($_[0],$a{coerce}->($_[1])):$m->(@_)}};my$C=$e->{new}||*{$M.Object::new}{CODE};$e->{new}=sub{my$s=$C->(@_);$s->$_($s->{$_})for keys%$s;$s}};
### Mo/default.pm ###
#package Mo::default;
#$Mo::default::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;exists$a{default}or return$m;my($d,$r)=$a{default};my$g='HASH'eq($r=ref$d)?sub{+{%$d}}:'ARRAY'eq$r?sub{[@$d]}:'CODE'eq$r?$d:sub{$d};my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=$g and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$g->(@_):$m->(@_)}}};
### Mo/exporter.pm ###
#package Mo::exporter;
#$Mo::exporter::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'exporter::e'}=sub{my($P)=@_;if(@{$M.EXPORT}){*{$P.$_}=\&{$M.$_}for@{$M.EXPORT}}};
### Mo/import.pm ###
#package Mo::import;
#$Mo::import::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};
### Mo/importer.pm ###
#package Mo::importer;
#$Mo::importer::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'importer::e'}=sub{my($P,$e,$o,$f)=@_;(my$pkg=$P)=~s/::$//;&{$P.'importer'}($pkg,@$f)if defined&{$P.'importer'}};
### Mo/is.pm ###
#package Mo::is;
#$Mo::is::VERSION = '0.40';$M="Mo::";
#$VERSION='0.40';
#*{$M.'is::e'}=sub{my($P,$e,$o)=@_;$o->{is}=sub{my($m,$n,%a)=@_;$a{is}or return$m;sub{$#_&&$a{is}eq'ro'&&caller ne'Mo::coerce'?die$n.' is ro':$m->(@_)}}};
### Mo/nonlazy.pm ###
#package Mo::nonlazy;
#$Mo::nonlazy::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'nonlazy::e'}=sub{${shift().':N'}=1};
### Mo/option.pm ###
#package Mo::option;
#$Mo::option::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'option::e'}=sub{my($P,$e,$o)=@_;$o->{option}=sub{my($m,$n,%a)=@_;$a{option}or return$m;my$n2=$n;*{$P."read_$n2"}=sub{$_[0]->{$n2}};sub{$#_?$m->(@_):$m->(@_,1);$_[0]}}};
### Mo/required.pm ###
#package Mo::required;
#$Mo::required::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'required::e'}=sub{my($P,$e,$o)=@_;$o->{required}=sub{my($m,$n,%a)=@_;if($a{required}){my$C=*{$P."new"}{CODE}||*{$M.Object::new}{CODE};no warnings 'redefine';*{$P."new"}=sub{my$s=$C->(@_);my%a=@_[1..$#_];die$n." required"if!exists$a{$n};$s}}$m}};
### Mo/xs.pm ###
#package Mo::xs;
#$Mo::xs::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#require Class::XSAccessor;*{$M.'xs::e'}=sub{my($P,$e,$o,$f)=@_;$P=~s/::$//;$e->{has}=sub{my($n,%a)=@_;Class::XSAccessor->import(class=>$P,accessors=>{$n=>$n})}if!grep!/^xs$/,@$f};
### Module/Installed/Tiny.pm ###
#package Module::Installed::Tiny;
#
#our $DATE = '2020-01-04'; # DATE
#our $VERSION = '0.004'; # VERSION
#
#use strict;
#use warnings;
#
#use Exporter qw(import);
#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 _module_source {
#    my $name_pm = shift;
#
#    for my $entry (@INC) {
#        next unless defined $entry;
#        my $ref = ref($entry);
#        my ($is_hook, @hook_res);
#        if ($ref eq 'ARRAY') {
#            $is_hook++;
#            @hook_res = $entry->[0]->($entry, $name_pm);
#        } elsif (UNIVERSAL::can($entry, 'INC')) {
#            $is_hook++;
#            @hook_res = $entry->INC($name_pm);
#        } elsif ($ref eq 'CODE') {
#            $is_hook++;
#            @hook_res = $entry->($entry, $name_pm);
#        } else {
#            my $path = "$entry$SEPARATOR$name_pm";
#            if (-f $path) {
#                open my($fh), "<", $path
#                    or die "Can't locate $name_pm: $path: $!";
#                local $/;
#                return wantarray ? (scalar <$fh>, $path) : scalar <$fh>;
#            }
#        }
#
#        if ($is_hook) {
#            next unless @hook_res;
#            my $prepend_ref; $prepend_ref = shift @hook_res if ref($hook_res[0]) eq 'SCALAR';
#            my $fh         ; $fh          = shift @hook_res if ref($hook_res[0]) eq 'GLOB';
#            my $code       ; $code        = shift @hook_res if ref($hook_res[0]) eq 'CODE';
#            my $code_state ; $code_state  = shift @hook_res if @hook_res;
#            if ($fh) {
#                my $src = "";
#                local $_;
#                while (!eof($fh)) {
#                    $_ = <$fh>;
#                    if ($code) {
#                        $code->($code, $code_state);
#                    }
#                    $src .= $_;
#                }
#                $src = $$prepend_ref . $src if $prepend_ref;
#                return wantarray ? ($src, $entry) : $src;
#            } elsif ($code) {
#                my $src = "";
#                local $_;
#                while ($code->($code, $code_state)) {
#                    $src .= $_;
#                }
#                $src = $$prepend_ref . $src if $prepend_ref;
#                return wantarray ? ($src, $entry) : $src;
#            }
#        }
#    }
#
#    die "Can't locate $name_pm in \@INC (\@INC contains: ".join(" ", @INC).")";
#}
#
#sub module_source {
#    my $name = shift;
#
#    # convert Foo::Bar -> Foo/Bar.pm
#    my $name_pm;
#    if ($name =~ /\A\w+(?:::\w+)*\z/) {
#        ($name_pm = "$name.pm") =~ s!::!$SEPARATOR!g;
#    } else {
#        $name_pm = $name;
#    }
#
#    _module_source $name_pm;
#}
#
#sub module_installed {
#    my $name = shift;
#
#    # convert Foo::Bar -> Foo/Bar.pm
#    my $name_pm;
#    if ($name =~ /\A\w+(?:::\w+)*\z/) {
#        ($name_pm = "$name.pm") =~ s!::!$SEPARATOR!g;
#    } else {
#        $name_pm = $name;
#    }
#
#    return 1 if exists $INC{$name_pm};
#
#    if (eval { _module_source $name_pm; 1 }) {
#        1;
#    } else {
#        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.004 of Module::Installed::Tiny (from Perl distribution Module-Installed-Tiny), released on 2020-01-04.
#
#=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
# }
#
#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_installed($name) => bool
#
#Check that module named C<$name> is available to load. This means that: either
#the module file exists on the filesystem and searchable in C<@INC> and the
#contents of the file can be retrieved, or when there is a require hook in
#C<@INC>, the module's source can be retrieved from the hook.
#
#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>.
#
#=head2 module_source($name) => str | (str, source_name)
#
#Return module's source code, without actually loading it. Die on failure (e.g.
#module named C<$name> not found in C<@INC>).
#
#In list context:
#
# my @res = module_source($name);
#
#will return the list:
#
#(str, source_name)
#
#where C<str> is the module source code and C<source_name> is source information
#(file path, or the @INC ref entry when entry is a ref).
#
#=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 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.
#
#=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 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 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
### Perinci/Sub/Complete.pm ###
#package Perinci::Sub::Complete;
#
#our $DATE = '2020-03-04'; # DATE
#our $VERSION = '0.942'; # VERSION
#
#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 Perinci::Sub::Util qw(gen_modified_sub);
#
#require Exporter;
#our @ISA       = qw(Exporter);
#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 gen_completion() from %s ...", $mod);
#                        $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') {
#                log_trace("[comp][periscomp] invoking arg completion routine");
#                $fres = $comp->(
#                    %$extras,
#                    word=>$word, arg=>$arg, args=>$args{args});
#                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 gen_completion() from %s ...", $mod);
#                        $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') {
#                log_trace("[comp][periscomp] invoking arg element completion routine");
#                $fres = $elcomp->(
#                    %$extras,
#                    %$ourextras,
#                    word=>$word);
#                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') {
#                log_trace("[comp][periscomp] invoking arg element index completion routine");
#                $fres = $idxcomp->(
#                    %$extras,
#                    %$ourextras,
#                    word=>$word);
#                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");
#                    my $compres;
#                    eval { $compres = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    log_trace("[comp][periscomp] result from 'completion' routine: %s", $compres);
#                    if ($compres) {
#                        $fres = $compres;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($ospec =~ /\@$/) {
#                    $fres = complete_arg_elem(
#                        meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                        word=>$word, index=>$cargs{nth}, # XXX correct index
#                        extras=>$extras, %rargs);
#                    goto RETURN_RES;
#                } elsif ($ospec =~ /\%$/) {
#                    if ($word =~ /(.*?)=(.*)/s) {
#                        my $key = $1;
#                        my $val = $2;
#                        $fres = complete_arg_elem(
#                            meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                            word=>$val, index=>$key,
#                            extras=>$extras, %rargs);
#                        modify_answer(answer=>$fres, prefix=>"$key=");
#                        goto RETURN_RES;
#                    } else {
#                        $fres = complete_arg_index(
#                            meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                            word=>$word, extras=>$extras, %rargs);
#                        modify_answer(answer=>$fres, suffix=>"=");
#                        $fres->{path_sep} = "=";
#                        # XXX actually not entirely correct, we want normal
#                        # escaping but without escaping "=", maybe we should
#                        # allow customizing, e.g. esc_mode=normal, dont_esc="="
#                        # (list of characters to not escape)
#                        $fres->{esc_mode} = "none";
#                        goto RETURN_RES;
#                    }
#                } else {
#                    $fres = complete_arg_val(
#                        meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                        word=>$word, extras=>$extras, %rargs);
#                    goto RETURN_RES;
#                }
#            } else {
#                log_trace("[comp][periscomp] completing option value for a common option, ospec=<%s>", $ospec);
#                $cargs{arg}  = undef;
#                my $codata = $copts_by_ospec->{$ospec};
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{completion}) {
#                    $cargs{arg}  = undef;
#                    log_trace("[comp][periscomp] completing with common option's 'completion' property");
#                    my $res;
#                    eval { $res = $codata->{completion}->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{schema}) {
#                    require Data::Sah::Normalize;
#                    my $nsch = Data::Sah::Normalize::normalize_schema(
#                        $codata->{schema});
#                    log_trace("[comp][periscomp] completing with common option's schema");
#                    $fres = complete_from_schema(
#                        schema => $nsch, word=>$word,
#                        schema_is_normalized=>1,
#                    );
#                    goto RETURN_RES;
#                }
#                goto RETURN_RES;
#            }
#        } elsif ($type eq 'arg') {
#            log_trace("[comp][periscomp] completing argument #%d", $cargs{argpos});
#            $cargs{type} = 'arg';
#
#            my $pos = $cargs{argpos};
#            my $fasa = $args{func_arg_starts_at} // 0;
#
#            # find if there is a non-slurpy argument with the exact position
#            for my $an (keys %$args_prop) {
#                my $arg_spec = $args_prop->{$an};
#                next unless !($arg_spec->{slurpy} // $arg_spec->{greedy}) &&
#                    defined($arg_spec->{pos}) && $arg_spec->{pos} == $pos - $fasa;
#                log_trace("[comp][periscomp] this argument position is for non-slurpy function argument <%s>", $an);
#                $cargs{arg} = $an;
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $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");
#                    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");
#                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.942 of Perinci::Sub::Complete (from Perl distribution Perinci-Sub-Complete), released on 2020-03-04.
#
#=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, msg, payload, 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) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#=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 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.
#
#=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 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012, 2011 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/GetArgs/Argv.pm ###
#package Perinci::Sub::GetArgs::Argv;
#
#our $DATE = '2019-06-26'; # DATE
#our $VERSION = '0.843'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
##use Log::Any '$log';
#
#use Data::Sah::Normalize qw(normalize_schema);
#use Data::Sah::Util::Type qw(is_type is_simple);
#use Getopt::Long::Negate::EN qw(negations_for_option);
#use Getopt::Long::Util qw(parse_getopt_long_opt_spec);
#use List::Util qw(first);
#use Perinci::Sub::GetArgs::Array qw(get_args_from_array);
#use Perinci::Sub::Util qw(err);
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       gen_getopt_long_spec_from_meta
#                       get_args_from_argv
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Get subroutine arguments from command line arguments (@ARGV)',
#};
#
## retun ($success?, $errmsg, $res)
#sub _parse_json {
#    my $str = shift;
#
#    state $json = do {
#        require JSON::PP;
#        JSON::PP->new->allow_nonref;
#    };
#
#    # to rid of those JSON::PP::Boolean objects which currently choke
#    # Data::Sah-generated validator code. in the future Data::Sah can be
#    # modified to handle those, or we use a fork of JSON::PP which doesn't
#    # produce those in the first place (probably only when performance is
#    # critical).
#    state $cleanser = do {
#        if (eval { require Data::Clean::FromJSON; 1 }) {
#            Data::Clean::FromJSON->get_cleanser;
#        } else {
#            undef;
#        }
#    };
#
#    my $res;
#    eval { $res = $json->decode($str); $cleanser->clean_in_place($res) if $cleanser };
#    my $e = $@;
#    return (!$e, $e, $res);
#}
#
#sub _parse_yaml {
#    no warnings 'once';
#
#    state $yaml_xs_available = do {
#        if (eval { require YAML::XS; 1 }) {
#            1;
#        } else {
#            require YAML::Old;
#            0;
#        }
#    };
#
#    my $str = shift;
#
#    #local $YAML::Syck::ImplicitTyping = 1;
#    my $res;
#    eval {
#        if ($yaml_xs_available) {
#            $res = YAML::XS::Load($str);
#        } else {
#            # YAML::Old is too strict, it requires "--- " header and newline
#            # ending
#            $str = "--- $str" unless $str =~ /\A--- /;
#            $str .= "\n" unless $str =~ /\n\z/;
#            $res = YAML::Old::Load($str);
#        }
#    };
#    my $e = $@;
#    return (!$e, $e, $res);
#}
#
#sub _arg2opt {
#    my $opt = shift;
#    $opt =~ s/[^A-Za-z0-9-]+/-/g; # foo.bar_baz becomes --foo-bar-baz
#    $opt;
#}
#
## this subroutine checks whether a schema mentions a coercion rule from simple
## types (e.g. 'str_comma_sep', etc).
#sub _is_coercible_from_simple {
#    my $nsch = shift;
#    my $cset = $nsch->[1] or return 0;
#    my $rules = $cset->{'x.perl.coerce_rules'} // $cset->{'x.coerce_rules'}
#        or return 0;
#    for my $rule (@$rules) {
#        next unless $rule =~ /\A([^_]+)_/;
#        return 1 if is_simple($1);
#    }
#    0;
#}
#
#sub _is_simple_or_coercible_from_simple {
#    my $nsch = shift;
#    is_simple($nsch) || _is_coercible_from_simple($nsch);
#}
#
## this routine's job is to avoid using Data::Sah::Resolve unless it needs to, to
## reduce startup overhead
#sub _is_simple_or_array_of_simple_or_hash_of_simple {
#    my $nsch = shift;
#
#    my $is_simple = 0;
#    my $is_array_of_simple = 0;
#    my $is_hash_of_simple = 0;
#    my $eltype;
#
#    my $type = $nsch->[0];
#    my $cset = $nsch->[1];
#
#    {
#        # if not known as builtin type, then resolve it first
#        unless (is_type($nsch)) {
#            require Data::Sah::Resolve;
#            my $res = Data::Sah::Resolve::resolve_schema(
#                {merge_clause_sets => 0}, $nsch);
#            $type = $res->[0];
#            $cset = $res->[1][0] // {};
#        }
#
#        $is_simple = _is_simple_or_coercible_from_simple([$type, $cset]);
#        last if $is_simple;
#
#        if ($type eq 'array') {
#            my $elnsch = $cset->{of} // $cset->{each_elem};
#            last unless $elnsch;
#            $elnsch = normalize_schema($elnsch);
#            $eltype = $elnsch->[0];
#
#            # if not known as builtin type, then resolve it first
#            unless (is_type($elnsch)) {
#                require Data::Sah::Resolve;
#                my $res = Data::Sah::Resolve::resolve_schema(
#                    {merge_clause_sets => 0}, $elnsch);
#                $elnsch = [$res->[0], $res->[1][0] // {}]; # XXX we only take the first clause set
#                $eltype = $res->[0];
#            }
#
#            $is_array_of_simple = _is_simple_or_coercible_from_simple($elnsch);
#            last;
#        }
#
#        if ($type eq 'hash') {
#            my $elnsch = $cset->{of} // $cset->{each_value} // $cset->{each_elem};
#            last unless $elnsch;
#            $elnsch = normalize_schema($elnsch);
#            $eltype = $elnsch->[0];
#
#            # if not known as builtin type, then resolve it first
#            unless (is_type($elnsch)) {
#                require Data::Sah::Resolve;
#                my $res = Data::Sah::Resolve::resolve_schema(
#                    {merge_clause_sets => 0}, $elnsch);
#                $elnsch = [$res->[0], $res->[1][0] // {}]; # XXX we only take the first clause set
#                $eltype = $res->[0];
#            }
#
#            $is_hash_of_simple = _is_simple_or_coercible_from_simple($elnsch);
#            last;
#        }
#    }
#
#    #{ no warnings 'uninitialized'; say "D:$nsch->[0]: is_simple=<$is_simple>, is_array_of_simple=<$is_array_of_simple>, is_hash_of_simple=<$is_hash_of_simple>, type=<$type>, eltype=<$eltype>" };
#    ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype);
#}
#
## return one or more triplets of Getopt::Long option spec, its parsed structure,
## and extra stuffs. we do this to avoid having to call
## parse_getopt_long_opt_spec().
#sub _opt2ospec {
#    my ($opt, $schema, $arg_spec) = @_;
#    my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
#        _is_simple_or_array_of_simple_or_hash_of_simple($schema);
#
#    my (@opts, @types, @isaos, @ishos);
#
#    if ($is_array_of_simple || $is_hash_of_simple) {
#        my $singular_opt;
#        if ($arg_spec && $arg_spec->{'x.name.is_plural'}) {
#            if ($arg_spec->{'x.name.singular'}) {
#                $singular_opt = _arg2opt($arg_spec->{'x.name.singular'});
#            } else {
#                require Lingua::EN::PluralToSingular;
#                $singular_opt = Lingua::EN::PluralToSingular::to_singular($opt);
#            }
#        } else {
#            $singular_opt = $opt;
#        }
#        push @opts , $singular_opt;
#        push @types, $eltype;
#        push @isaos, $is_array_of_simple ? 1:0;
#        push @ishos, $is_hash_of_simple  ? 1:0;
#    }
#
#    if ($is_simple || !@opts) {
#        push @opts , $opt;
#        push @types, $type;
#        push @isaos, 0;
#        push @ishos, 0;
#    }
#
#    my @res;
#
#    for my $i (0..$#opts) {
#        my $opt   = $opts[$i];
#        my $type  = $types[$i];
#        my $isaos = $isaos[$i];
#        my $ishos = $ishos[$i];
#
#        if ($type eq 'bool') {
#            if (length $opt == 1) {
#                # single-letter option like -b doesn't get --nob.
#                push @res, ($opt, {opts=>[$opt]}), undef;
#            } elsif ($cset->{is} || $cset->{is_true}) {
#                # an always-true bool ('true' or [bool => {is=>1}] or
#                # [bool=>{is_true=>1}] also means it's a flag and should not get
#                # --nofoo.
#                push @res, ($opt, {opts=>[$opt]}), undef;
#            } elsif ((defined $cset->{is} && !$cset->{is}) ||
#                         (defined $cset->{is_true} && !$cset->{is_true})) {
#                # an always-false bool ('false' or [bool => {is=>0}] or
#                # [bool=>{is_true=>0}] also means it's a flag and should only be
#                # getting --nofoo.
#                for (negations_for_option($opt)) {
#                    push @res, $_, {opts=>[$_]}, {is_neg=>1, pos_opts=>[$opt]};
#                }
#            } else {
#                # a regular bool gets --foo as well as --nofoo
#                my @negs = negations_for_option($opt);
#                push @res, $opt, {opts=>[$opt]}, {is_neg=>0, neg_opts=>\@negs};
#                for (@negs) {
#                    push @res, $_, {opts=>[$_]}, {is_neg=>1, pos_opts=>[$opt]};
#                }
#            }
#        } elsif ($type eq 'buf') {
#            push @res, (
#                "$opt=s", {opts=>[$opt], desttype=>"", type=>"s"}, undef,
#                "$opt-base64=s", {opts=>["$opt-base64"], desttype=>"", type=>"s"}, {is_base64=>1},
#            );
#        } else {
#            my $t = ($type eq 'int' ? 's' : $type eq 'float' ? 's' : 's') .
#                ($isaos ? '@' : $ishos ? '%' : '');
#            push @res, ("$opt=$t", {opts=>[$opt], desttype=>"", type=>$t}, undef);
#        }
#    }
#
#    @res;
#}
#
#sub _args2opts {
#    my %args = @_;
#
#    my $argprefix        = $args{argprefix};
#    my $parent_args      = $args{parent_args};
#    my $meta             = $args{meta};
#    my $seen_opts        = $args{seen_opts};
#    my $seen_common_opts = $args{seen_common_opts};
#    my $seen_func_opts   = $args{seen_func_opts};
#    my $rargs            = $args{rargs};
#    my $go_spec          = $args{go_spec};
#    my $specmeta         = $args{specmeta};
#
#    my $args_prop = $meta->{args} // {};
#
#    for my $arg (keys %$args_prop) {
#        my $fqarg    = "$argprefix$arg";
#        my $arg_spec = $args_prop->{$arg};
#        next if grep { $_ eq 'hidden' || $_ eq 'hidden-cli' }
#            @{ $arg_spec->{tags} // [] };
#        my $sch      = $arg_spec->{schema} // ['any', {}];
#        my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
#            _is_simple_or_array_of_simple_or_hash_of_simple($sch);
#
#        # XXX normalization of 'of' clause should've been handled by sah itself
#        if ($type eq 'array' && $cset->{of}) {
#            $cset->{of} = normalize_schema($cset->{of});
#        }
#        my $opt = _arg2opt($fqarg);
#        if ($seen_opts->{$opt}) {
#            my $i = 1;
#            my $opt2;
#            while (1) {
#                $opt2 = "$opt-arg" . ($i > 1 ? $i : '');
#                last unless $seen_opts->{$opt2};
#                $i++;
#            }
#            $opt = $opt2;
#        }
#
#        my $stash = {};
#
#        # why we use coderefs here? due to Getopt::Long's behavior. when
#        # @ARGV=qw() and go_spec is ('foo=s' => \$opts{foo}) then %opts will
#        # become (foo=>undef). but if go_spec is ('foo=s' => sub { $opts{foo} =
#        # $_[1] }) then %opts will become (), which is what we prefer, so we can
#        # later differentiate "unspecified" (exists($opts{foo}) == false) and
#        # "specified as undef" (exists($opts{foo}) == true but
#        # defined($opts{foo}) == false).
#
#        my $handler = sub {
#            my ($val, $val_set);
#
#            # how many times have been called for this argument?
#            my $num_called = ++$stash->{called}{$arg};
#
#            # hashify rargs till the end of the handler scope if it happens to
#            # be an array (this is the case when we want to fill values using
#            # element_meta).
#            my $rargs = do {
#                if (ref($rargs) eq 'ARRAY') {
#                    $rargs->[$num_called-1] //= {};
#                    $rargs->[$num_called-1];
#                } else {
#                    $rargs;
#                }
#            };
#
#            if ($is_simple) {
#                $val_set = 1; $val = $_[1];
#                $rargs->{$arg} = $val;
#            } elsif ($is_array_of_simple) {
#                $rargs->{$arg} //= [];
#                $val_set = 1; $val = $_[1];
#                push @{ $rargs->{$arg} }, $val;
#            } elsif ($is_hash_of_simple) {
#                $rargs->{$arg} //= {};
#                $val_set = 1; $val = $_[2];
#                $rargs->{$arg}{$_[1]} = $val;
#            } else {
#                {
#                    my ($success, $e, $decoded);
#                    ($success, $e, $decoded) = _parse_json($_[1]);
#                    if ($success) {
#                        $val_set = 1; $val = $decoded;
#                        $rargs->{$arg} = $val;
#                        last;
#                    }
#                    ($success, $e, $decoded) = _parse_yaml($_[1]);
#                    if ($success) {
#                        $val_set = 1; $val = $decoded;
#                        $rargs->{$arg} = $val;
#                        last;
#                    }
#                    die "Invalid YAML/JSON in arg '$fqarg'";
#                }
#            }
#            if ($val_set && $arg_spec->{cmdline_on_getopt}) {
#                $arg_spec->{cmdline_on_getopt}->(
#                    arg=>$arg, fqarg=>$fqarg, value=>$val, args=>$rargs,
#                    opt=>$opt,
#                );
#            }
#        }; # handler
#
#        my @triplets = _opt2ospec($opt, $sch, $arg_spec);
#        my $aliases_processed;
#        while (my ($ospec, $parsed, $extra) = splice @triplets, 0, 3) {
#            $extra //= {};
#            if ($extra->{is_neg}) {
#                $go_spec->{$ospec} = sub { $handler->($_[0], 0) };
#            } elsif (defined $extra->{is_neg}) {
#                $go_spec->{$ospec} = sub { $handler->($_[0], 1) };
#            } elsif ($extra->{is_base64}) {
#                $go_spec->{$ospec} = sub {
#                    require MIME::Base64;
#                    my $decoded = MIME::Base64::decode($_[1]);
#                    $handler->($_[0], $decoded);
#                };
#            } else {
#                $go_spec->{$ospec} = $handler;
#            }
#
#            $specmeta->{$ospec} = {arg=>$arg, fqarg=>$fqarg, parsed=>$parsed, %$extra};
#            for (@{ $parsed->{opts} }) {
#                $seen_opts->{$_}++; $seen_func_opts->{$_} = $fqarg;
#            }
#
#            if ($parent_args->{per_arg_json} && !$is_simple) {
#                my $jopt = "$opt-json";
#                if ($seen_opts->{$jopt}) {
#                    warn "Clash of option: $jopt, not added";
#                } else {
#                    my $jospec = "$jopt=s";
#                    my $parsed = {type=>"s", opts=>[$jopt]};
#                    $go_spec->{$jospec} = sub {
#                        my ($success, $e, $decoded);
#                        ($success, $e, $decoded) = _parse_json($_[1]);
#                        if ($success) {
#                            $rargs->{$arg} = $decoded;
#                        } else {
#                            die "Invalid JSON in option --$jopt: $_[1]: $e";
#                        }
#                    };
#                    $specmeta->{$jospec} = {arg=>$arg, fqarg=>$fqarg, is_json=>1, parsed=>$parsed, %$extra};
#                    $seen_opts->{$jopt}++; $seen_func_opts->{$jopt} = $fqarg;
#                }
#            }
#            if ($parent_args->{per_arg_yaml} && !$is_simple) {
#                my $yopt = "$opt-yaml";
#                if ($seen_opts->{$yopt}) {
#                    warn "Clash of option: $yopt, not added";
#                } else {
#                    my $yospec = "$yopt=s";
#                    my $parsed = {type=>"s", opts=>[$yopt]};
#                    $go_spec->{$yospec} = sub {
#                        my ($success, $e, $decoded);
#                        ($success, $e, $decoded) = _parse_yaml($_[1]);
#                        if ($success) {
#                            $rargs->{$arg} = $decoded;
#                        } else {
#                            die "Invalid YAML in option --$yopt: $_[1]: $e";
#                        }
#                    };
#                    $specmeta->{$yospec} = {arg=>$arg, fqarg=>$fqarg, is_yaml=>1, parsed=>$parsed, %$extra};
#                    $seen_opts->{$yopt}++; $seen_func_opts->{$yopt} = $fqarg;
#                }
#            }
#
#            # parse argv_aliases
#            if ($arg_spec->{cmdline_aliases} && !$aliases_processed++) {
#                for my $al (keys %{$arg_spec->{cmdline_aliases}}) {
#                    my $alspec = $arg_spec->{cmdline_aliases}{$al};
#                    my $alsch = $alspec->{schema} //
#                        $alspec->{is_flag} ? [bool=>{req=>1,is=>1}] : $sch;
#                    my $altype = $alsch->[0];
#                    my $alopt = _arg2opt("$argprefix$al");
#                    if ($seen_opts->{$alopt}) {
#                        warn "Clash of cmdline_alias option $al";
#                        next;
#                    }
#                    my $alcode = $alspec->{code};
#                    my $alospec;
#                    my $parsed;
#                    if ($alcode && $alsch->[0] eq 'bool') {
#                        # bool --alias doesn't get --noalias if has code
#                        $alospec = $alopt; # instead of "$alopt!"
#                        $parsed = {opts=>[$alopt]};
#                    } else {
#                        ($alospec, $parsed) = _opt2ospec($alopt, $alsch);
#                    }
#
#                    if ($alcode) {
#                        if ($alcode eq 'CODE') {
#                            if ($parent_args->{ignore_converted_code}) {
#                                $alcode = sub {};
#                            } else {
#                                return [
#                                    501,
#                                    join("",
#                                         "Code in cmdline_aliases for arg $fqarg ",
#                                         "got converted into string, probably ",
#                                         "because of JSON/YAML transport"),
#                                ];
#                            }
#                        }
#                        # alias handler
#                        $go_spec->{$alospec} = sub {
#
#                            # do the same like in arg handler
#                            my $num_called = ++$stash->{called}{$arg};
#                            my $rargs = do {
#                                if (ref($rargs) eq 'ARRAY') {
#                                    $rargs->[$num_called-1] //= {};
#                                    $rargs->[$num_called-1];
#                                } else {
#                                    $rargs;
#                                }
#                            };
#
#                            $alcode->($rargs, $_[1]);
#                        };
#                    } else {
#                        $go_spec->{$alospec} = $handler;
#                    }
#                    $specmeta->{$alospec} = {
#                        alias     => $al,
#                        is_alias  => 1,
#                        alias_for => $ospec,
#                        arg       => $arg,
#                        fqarg     => $fqarg,
#                        is_code   => $alcode ? 1:0,
#                        parsed    => $parsed,
#                        %$extra,
#                    };
#                    push @{$specmeta->{$ospec}{($alcode ? '':'non').'code_aliases'}},
#                        $alospec;
#                    $seen_opts->{$alopt}++; $seen_func_opts->{$alopt} = $fqarg;
#                }
#            } # cmdline_aliases
#
#            # submetadata
#            if ($arg_spec->{meta}) {
#                $rargs->{$arg} = {};
#                my $res = _args2opts(
#                    %args,
#                    argprefix => "$argprefix$arg\::",
#                    meta      => $arg_spec->{meta},
#                    rargs     => $rargs->{$arg},
#                );
#                return $res if $res;
#            }
#
#            # element submetadata
#            if ($arg_spec->{element_meta}) {
#                $rargs->{$arg} = [];
#                my $res = _args2opts(
#                    %args,
#                    argprefix => "$argprefix$arg\::",
#                    meta      => $arg_spec->{element_meta},
#                    rargs     => $rargs->{$arg},
#                );
#                return $res if $res;
#            }
#        } # for ospec triplet
#
#    } # for arg
#
#    undef;
#}
#
#$SPEC{gen_getopt_long_spec_from_meta} = {
#    v           => 1.1,
#    summary     => 'Generate Getopt::Long spec from Rinci function metadata',
#    description => <<'_',
#
#This routine will produce a <pm:Getopt::Long> specification from Rinci function
#metadata, as well as some more data structure in the result metadata to help
#producing a command-line help/usage message.
#
#Function arguments will be mapped to command-line options with the same name,
#with non-alphanumeric characters changed to `-` (`-` is preferred over `_`
#because it lets user avoid pressing Shift on popular keyboards). For example:
#`file_size` becomes `file-size`, `file_size.max` becomes `file-size-max`. If
#function argument option name clashes with command-line option or another
#existing option, it will be renamed to `NAME-arg` (or `NAME-arg2` and so on).
#For example: `help` will become `help-arg` (if `common_opts` contains `help`,
#that is).
#
#Each command-line alias (`cmdline_aliases` property) in the argument
#specification will also be added as command-line option, except if it clashes
#with an existing option, in which case this function will warn and skip adding
#the alias. For more information about `cmdline_aliases`, see `Rinci::function`.
#
#For arguments with type of `bool`, Getopt::Long will by default also
#automatically recognize `--noNAME` or `--no-NAME` in addition to `--name`. So
#this function will also check those names for clashes.
#
#For arguments with type array of simple scalar, `--NAME` can be specified more
#than once to append to the array.
#
#If `per_arg_json` setting is active, and argument's schema is not a "required
#simple scalar" (e.g. an array, or a nullable string), then `--NAME-json` will
#also be added to let users input undef (through `--NAME-json null`) or a
#non-scalar value (e.g. `--NAME-json '[1,2,3]'`). If this name conflicts with
#another existing option, a warning will be displayed and the option will not be
#added.
#
#If `per_arg_yaml` setting is active, and argument's schema is not a "required
#simple scalar" (e.g. an array, or a nullable string), then `--NAME-yaml` will
#also be added to let users input undef (through `--NAME-yaml '~'`) or a
#non-scalar value (e.g. `--NAME-yaml '[foo, bar]'`). If this name conflicts with
#another existing option, a warning will be displayed and the option will not be
#added. YAML can express a larger set of values, e.g. binary data, circular
#references, etc.
#
#Will produce a hash (Getopt::Long spec), with `func.specmeta`, `func.opts`,
#`func.common_opts`, `func.func_opts` that contain extra information
#(`func.specmeta` is a hash of getopt spec name and a hash of extra information
#while `func.*opts` lists all used option names).
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata',
#            schema  => 'hash*',
#            req     => 1,
#        },
#        meta_is_normalized => {
#            schema => 'bool*',
#        },
#        args => {
#            summary => 'Reference to hash which will store the result',
#            schema  => 'hash*',
#        },
#        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*'],
#        },
#        per_arg_json => {
#            summary => 'Whether to add --NAME-json for non-simple arguments',
#            schema  => 'bool',
#            default => 0,
#            description => <<'_',
#
#Will also interpret command-line arguments as JSON if assigned to function
#arguments, if arguments' schema is not simple scalar.
#
#_
#        },
#        per_arg_yaml => {
#            summary => 'Whether to add --NAME-yaml for non-simple arguments',
#            schema  => 'bool',
#            default => 0,
#            description => <<'_',
#
#Will also interpret command-line arguments as YAML if assigned to function
#arguments, if arguments' schema is not simple scalar.
#
#_
#        },
#        ignore_converted_code => {
#            summary => 'Whether to ignore coderefs converted to string',
#            schema => 'bool',
#            default => 0,
#            description => <<'_',
#
#Across network through JSON encoding, coderef in metadata (e.g. in
#`cmdline_aliases` property) usually gets converted to string `CODE`. In some
#cases, like for tab completion, this is pretty harmless so you can turn this
#option on. For example, in the case of `cmdline_aliases`, the effect is just
#that command-line aliases code are not getting executed, but this is usually
#okay.
#
#_
#        },
#    },
#};
#sub gen_getopt_long_spec_from_meta {
#    my %fargs = @_;
#
#    my $meta       = $fargs{meta} or return [400, "Please specify meta"];
#    unless ($fargs{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
#    }
#    my $co           = $fargs{common_opts} // {};
#    my $per_arg_yaml = $fargs{per_arg_yaml} // 0;
#    my $per_arg_json = $fargs{per_arg_json} // 0;
#    my $ignore_converted_code = $fargs{ignore_converted_code};
#    my $rargs        = $fargs{args} // {};
#
#    my %go_spec;
#    my %specmeta; # key = option spec, val = hash of extra info
#    my %seen_opts;
#    my %seen_common_opts;
#    my %seen_func_opts;
#
#    for my $k (keys %$co) {
#        my $v = $co->{$k};
#        my $ospec   = $v->{getopt};
#        my $handler = $v->{handler};
#        my $res = parse_getopt_long_opt_spec($ospec)
#            or return [400, "Can't parse common opt spec '$ospec'"];
#        $go_spec{$ospec} = $handler;
#        $specmeta{$ospec} = {common_opt=>$k, arg=>undef, parsed=>$res};
#        for (@{ $res->{opts} }) {
#            return [412, "Clash of common opt '$_'"] if $seen_opts{$_};
#            $seen_opts{$_}++; $seen_common_opts{$_} = $ospec;
#            if ($res->{is_neg}) {
#                $seen_opts{"no$_"}++ ; $seen_common_opts{"no$_"}  = $ospec;
#                $seen_opts{"no-$_"}++; $seen_common_opts{"no-$_"} = $ospec;
#            }
#        }
#    }
#
#    my $res = _args2opts(
#        argprefix        => "",
#        parent_args      => \%fargs,
#        meta             => $meta,
#        seen_opts        => \%seen_opts,
#        seen_common_opts => \%seen_common_opts,
#        seen_func_opts   => \%seen_func_opts,
#        rargs            => $rargs,
#        go_spec          => \%go_spec,
#        specmeta         => \%specmeta,
#    );
#    return $res if $res;
#
#    my $opts        = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_opts)];
#    my $common_opts = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_common_opts)];
#    my $func_opts   = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_func_opts)];
#    my $opts_by_common = {};
#    for my $k (keys %$co) {
#        my $v = $co->{$k};
#        my $ospec = $v->{getopt};
#        my @opts;
#        for (keys %seen_common_opts) {
#            next unless $seen_common_opts{$_} eq $ospec;
#            push @opts, (length($_)>1 ? "--$_":"-$_");
#        }
#        $opts_by_common->{$ospec} = [sort @opts];
#    }
#
#    my $opts_by_arg = {};
#    for (keys %seen_func_opts) {
#        my $fqarg = $seen_func_opts{$_};
#        push @{ $opts_by_arg->{$fqarg} }, length($_)>1 ? "--$_":"-$_";
#    }
#    for (keys %$opts_by_arg) {
#        $opts_by_arg->{$_} = [sort @{ $opts_by_arg->{$_} }];
#    }
#
#    [200, "OK", \%go_spec,
#     {
#         "func.specmeta"       => \%specmeta,
#         "func.opts"           => $opts,
#         "func.common_opts"    => $common_opts,
#         "func.func_opts"      => $func_opts,
#         "func.opts_by_arg"    => $opts_by_arg,
#         "func.opts_by_common" => $opts_by_common,
#     }];
#}
#
#$SPEC{get_args_from_argv} = {
#    v => 1.1,
#    summary => 'Get subroutine arguments (%args) from command-line arguments '.
#        '(@ARGV)',
#    description => <<'_',
#
#Using information in Rinci function metadata's `args` property, parse command
#line arguments `@argv` into hash `%args`, suitable for passing into subroutines.
#
#Currently uses <pm:Getopt::Long>'s `GetOptions` to do the parsing.
#
#As with GetOptions, this function modifies its `argv` argument, so you might
#want to copy the original `argv` first (or pass a copy instead) if you want to
#preserve the original.
#
#See also: gen_getopt_long_spec_from_meta() which is the routine that generates
#the specification.
#
#_
#    args => {
#        argv => {
#            schema => ['array*' => {
#                of => 'str*',
#            }],
#            description => 'If not specified, defaults to @ARGV',
#        },
#        args => {
#            summary => 'Specify input args, with some arguments preset',
#            schema  => ['hash'],
#        },
#        meta => {
#            schema => ['hash*' => {}],
#            req => 1,
#        },
#        meta_is_normalized => {
#            summary => 'Can be set to 1 if your metadata is normalized, '.
#                'to avoid duplicate effort',
#            schema => 'bool',
#            default => 0,
#        },
#        strict => {
#            schema => ['bool' => {default=>1}],
#            summary => 'Strict mode',
#            description => <<'_',
#
#If set to 0, will still return parsed argv even if there are parsing errors
#(reported by Getopt::Long). If set to 1 (the default), will die upon error.
#
#Normally you would want to use strict mode, for more error checking. Setting off
#strict is used by, for example, Perinci::Sub::Complete during completion where
#the command-line might still be incomplete.
#
#Should probably be named `ignore_errors`. :-)
#
#_
#        },
#        per_arg_yaml => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Whether to recognize --ARGNAME-yaml',
#            description => <<'_',
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
#    % script.pl --name-yaml '~'
#
#See also: per_arg_json. You should enable just one instead of turning on both.
#
#_
#        },
#        per_arg_json => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Whether to recognize --ARGNAME-json',
#            description => <<'_',
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
#    % script.pl --name-json 'null'
#
#But every other string will need to be quoted:
#
#    % script.pl --name-json '"foo"'
#
#See also: per_arg_yaml. You should enable just one instead of turning on both.
#
#_
#        },
#        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*'],
#        },
#        allow_extra_elems => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Allow extra/unassigned elements in argv',
#            description => <<'_',
#
#If set to 1, then if there are array elements unassigned to one of the
#arguments, instead of generating an error, this function will just ignore them.
#
#This option will be passed to Perinci::Sub::GetArgs::Array's allow_extra_elems.
#
#_
#        },
#        on_missing_required_args => {
#            schema => 'code',
#            summary => 'Execute code when there is missing required args',
#            description => <<'_',
#
#This can be used to give a chance to supply argument value from other sources if
#not specified by command-line options. Perinci::CmdLine, for example, uses this
#hook to supply value from STDIN or file contents (if argument has `cmdline_src`
#specification key set).
#
#This hook will be called for each missing argument. It will be supplied hash
#arguments: (arg => $the_missing_argument_name, args =>
#$the_resulting_args_so_far, spec => $the_arg_spec).
#
#The hook can return true if it succeeds in making the missing situation
#resolved. In this case, this function will not report the argument as missing.
#
#_
#        },
#        ignore_converted_code => {
#            summary => 'Whether to ignore coderefs converted to string',
#            schema => 'bool',
#            default => 0,
#            description => <<'_',
#
#Across network through JSON encoding, coderef in metadata (e.g. in
#`cmdline_aliases` property) usually gets converted to string `CODE`. In some
#cases, like for tab completion, this is harmless so you can turn this option on.
#
#_
#        },
#        ggls_res => {
#            summary => 'Full result from gen_getopt_long_spec_from_meta()',
#            schema  => 'array*', # XXX envres
#            description => <<'_',
#
#If you already call `gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
#here, to avoid calculating twice.
#
#_
#            tags => ['category:optimization'],
#        },
#    },
#    result => {
#        description => <<'_',
#
#Error codes:
#
#* 400 - Error in Getopt::Long option specification, e.g. in common_opts.
#
#* 500 - failure in GetOptions, meaning argv is not valid according to metadata
#  specification (only if 'strict' mode is enabled).
#
#* 501 - coderef in cmdline_aliases got converted into a string, probably because
#  the metadata was transported (e.g. through Riap::HTTP/Riap::Simple).
#
#_
#    },
#};
#sub get_args_from_argv {
#    require Getopt::Long;
#
#    my %fargs = @_;
#    my $argv       = $fargs{argv} // \@ARGV;
#    my $meta       = $fargs{meta} or return [400, "Please specify meta"];
#    unless ($fargs{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
#    }
#    my $strict            = $fargs{strict} // 1;
#    my $common_opts       = $fargs{common_opts} // {};
#    my $per_arg_yaml      = $fargs{per_arg_yaml} // 0;
#    my $per_arg_json      = $fargs{per_arg_json} // 0;
#    my $allow_extra_elems = $fargs{allow_extra_elems} // 0;
#    my $on_missing        = $fargs{on_missing_required_args};
#    my $ignore_converted_code = $fargs{ignore_converted_code};
#    #$log->tracef("-> get_args_from_argv(), argv=%s", $argv);
#
#    # to store the resulting args
#    my $rargs = $fargs{args} // {};
#
#    # 1. first we generate Getopt::Long spec
#    my $genres = $fargs{ggls_res} // gen_getopt_long_spec_from_meta(
#        meta => $meta, meta_is_normalized => 1,
#        args => $rargs,
#        common_opts  => $common_opts,
#        per_arg_json => $per_arg_json,
#        per_arg_yaml => $per_arg_yaml,
#        ignore_converted_code => $ignore_converted_code,
#    );
#    return err($genres->[0], "Can't generate Getopt::Long spec", $genres)
#        if $genres->[0] != 200;
#    my $go_spec = $genres->[2];
#
#    # 2. then we run GetOptions to fill $rargs from command-line opts
#    #$log->tracef("GetOptions spec: %s", \@go_spec);
#    {
#        local $SIG{__WARN__} = sub{} if !$strict;
#        my $old_go_conf = Getopt::Long::Configure(
#            $strict ? "no_pass_through" : "pass_through",
#            "no_ignore_case", "permute", "no_getopt_compat", "gnu_compat", "bundling");
#        my $res = Getopt::Long::GetOptionsFromArray($argv, %$go_spec);
#        Getopt::Long::Configure($old_go_conf);
#        unless ($res) {
#            return [500, "GetOptions failed"] if $strict;
#        }
#    }
#
#    # 3. then we try to fill $rargs from remaining command-line arguments (for
#    # args which have 'pos' spec specified)
#
#    my $args_prop = $meta->{args};
#
#    if (@$argv) {
#        my $res = get_args_from_array(
#            array=>$argv, meta => $meta,
#            meta_is_normalized => 1,
#            allow_extra_elems => $allow_extra_elems,
#        );
#        if ($res->[0] != 200 && $strict) {
#            return err(500, "Get args from array failed", $res);
#        } elsif ($strict && $res->[0] != 200) {
#            return err("Can't get args from argv", $res);
#        } elsif ($res->[0] == 200) {
#            my $pos_args = $res->[2];
#            for my $name (keys %$pos_args) {
#                my $arg_spec = $args_prop->{$name};
#                my $val      = $pos_args->{$name};
#                if (exists $rargs->{$name}) {
#                    return [400, "You specified option --$name but also ".
#                                "argument #".$arg_spec->{pos}] if $strict;
#                }
#                my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
#                    _is_simple_or_array_of_simple_or_hash_of_simple($arg_spec->{schema});
#
#                if (($arg_spec->{slurpy} // $arg_spec->{greedy}) && ref($val) eq 'ARRAY' &&
#                        !$is_array_of_simple && !$is_hash_of_simple) {
#                    my $i = 0;
#                    for (@$val) {
#                      TRY_PARSING_AS_JSON_YAML:
#                        {
#                            my ($success, $e, $decoded);
#                            if ($per_arg_json) {
#                                ($success, $e, $decoded) = _parse_json($_);
#                                if ($success) {
#                                    $_ = $decoded;
#                                    last TRY_PARSING_AS_JSON_YAML;
#                                } else {
#                                    warn "Failed trying to parse argv #$i as JSON: $e";
#                                }
#                            }
#                            if ($per_arg_yaml) {
#                                ($success, $e, $decoded) = _parse_yaml($_);
#                                if ($success) {
#                                    $_ = $decoded;
#                                    last TRY_PARSING_AS_JSON_YAML;
#                                } else {
#                                    warn "Failed trying to parse argv #$i as YAML: $e";
#                                }
#                            }
#                        }
#                        $i++;
#                    }
#                }
#                if (!($arg_spec->{slurpy} // $arg_spec->{greedy}) && !$is_simple) {
#                  TRY_PARSING_AS_JSON_YAML:
#                    {
#                        my ($success, $e, $decoded);
#                        if ($per_arg_json) {
#                            ($success, $e, $decoded) = _parse_json($val);
#                            if ($success) {
#                                $val = $decoded;
#                                last TRY_PARSING_AS_JSON_YAML;
#                            } else {
#                                warn "Failed trying to parse argv #$arg_spec->{pos} as JSON: $e";
#                            }
#                        }
#                        if ($per_arg_yaml) {
#                            ($success, $e, $decoded) = _parse_yaml($val);
#                            if ($success) {
#                                $val = $decoded;
#                                last TRY_PARSING_AS_JSON_YAML;
#                            } else {
#                                warn "Failed trying to parse argv #$arg_spec->{pos} as YAML: $e";
#                            }
#                        }
#                    }
#                }
#                $rargs->{$name} = $val;
#                # we still call cmdline_on_getopt for this
#                if ($arg_spec->{cmdline_on_getopt}) {
#                    if ($arg_spec->{slurpy} // $arg_spec->{greedy}) {
#                        $arg_spec->{cmdline_on_getopt}->(
#                            arg=>$name, fqarg=>$name, value=>$_, args=>$rargs,
#                            opt=>undef, # this marks that value is retrieved from cmdline arg
#                        ) for @$val;
#                    } else {
#                        $arg_spec->{cmdline_on_getopt}->(
#                            arg=>$name, fqarg=>$name, value=>$val, args=>$rargs,
#                            opt=>undef, # this marks that value is retrieved from cmdline arg
#                        );
#                    }
#                }
#            }
#        }
#    }
#
#    # 4. check missing required args
#
#    my %missing_args;
#    for my $arg (keys %$args_prop) {
#        my $arg_spec = $args_prop->{$arg};
#        if (!exists($rargs->{$arg})) {
#            next unless $arg_spec->{req};
#            # give a chance to hook to set missing arg
#            if ($on_missing) {
#                next if $on_missing->(arg=>$arg, args=>$rargs, spec=>$arg_spec);
#            }
#            next if exists $rargs->{$arg};
#            $missing_args{$arg} = 1;
#        }
#    }
#
#    # 5. check 'deps', currently we only support 'arg' dep type
#    {
#        last unless $strict;
#
#        for my $arg (keys %$args_prop) {
#            my $arg_spec = $args_prop->{$arg};
#            next unless exists $rargs->{$arg};
#            next unless $arg_spec->{deps};
#            my $dep_arg = $arg_spec->{deps}{arg};
#            next unless $dep_arg;
#            return [400, "You specify '$arg', but don't specify '$dep_arg' ".
#                        "(upon which '$arg' depends)"]
#                unless exists $rargs->{$dep_arg};
#        }
#    }
#
#    #$log->tracef("<- get_args_from_argv(), args=%s, remaining argv=%s",
#    #             $rargs, $argv);
#    [200, "OK", $rargs, {
#        "func.missing_args" => [sort keys %missing_args],
#        "func.gen_getopt_long_spec_result" => $genres,
#    }];
#}
#
#1;
## ABSTRACT: Get subroutine arguments from command line arguments (@ARGV)
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::GetArgs::Argv - Get subroutine arguments from command line arguments (@ARGV)
#
#=head1 VERSION
#
#This document describes version 0.843 of Perinci::Sub::GetArgs::Argv (from Perl distribution Perinci-Sub-GetArgs-Argv), released on 2019-06-26.
#
#=head1 SYNOPSIS
#
# use Perinci::Sub::GetArgs::Argv;
#
# my $res = get_args_from_argv(argv=>\@ARGV, meta=>$meta, ...);
#
#=head1 DESCRIPTION
#
#This module provides C<get_args_from_argv()>, which parses command line
#arguments (C<@ARGV>) into subroutine arguments (C<%args>). This module is used
#by L<Perinci::CmdLine>. For explanation on how command-line options are
#processed, see Perinci::CmdLine's documentation.
#
#=head1 FUNCTIONS
#
#
#=head2 gen_getopt_long_spec_from_meta
#
#Usage:
#
# gen_getopt_long_spec_from_meta(%args) -> [status, msg, payload, meta]
#
#Generate Getopt::Long spec from Rinci function metadata.
#
#This routine will produce a L<Getopt::Long> specification from Rinci function
#metadata, as well as some more data structure in the result metadata to help
#producing a command-line help/usage message.
#
#Function arguments will be mapped to command-line options with the same name,
#with non-alphanumeric characters changed to C<-> (C<-> is preferred over C<_>
#because it lets user avoid pressing Shift on popular keyboards). For example:
#C<file_size> becomes C<file-size>, C<file_size.max> becomes C<file-size-max>. If
#function argument option name clashes with command-line option or another
#existing option, it will be renamed to C<NAME-arg> (or C<NAME-arg2> and so on).
#For example: C<help> will become C<help-arg> (if C<common_opts> contains C<help>,
#that is).
#
#Each command-line alias (C<cmdline_aliases> property) in the argument
#specification will also be added as command-line option, except if it clashes
#with an existing option, in which case this function will warn and skip adding
#the alias. For more information about C<cmdline_aliases>, see C<Rinci::function>.
#
#For arguments with type of C<bool>, Getopt::Long will by default also
#automatically recognize C<--noNAME> or C<--no-NAME> in addition to C<--name>. So
#this function will also check those names for clashes.
#
#For arguments with type array of simple scalar, C<--NAME> can be specified more
#than once to append to the array.
#
#If C<per_arg_json> setting is active, and argument's schema is not a "required
#simple scalar" (e.g. an array, or a nullable string), then C<--NAME-json> will
#also be added to let users input undef (through C<--NAME-json null>) or a
#non-scalar value (e.g. C<--NAME-json '[1,2,3]'>). If this name conflicts with
#another existing option, a warning will be displayed and the option will not be
#added.
#
#If C<per_arg_yaml> setting is active, and argument's schema is not a "required
#simple scalar" (e.g. an array, or a nullable string), then C<--NAME-yaml> will
#also be added to let users input undef (through C<--NAME-yaml '~'>) or a
#non-scalar value (e.g. C<--NAME-yaml '[foo, bar]'>). If this name conflicts with
#another existing option, a warning will be displayed and the option will not be
#added. YAML can express a larger set of values, e.g. binary data, circular
#references, etc.
#
#Will produce a hash (Getopt::Long spec), with C<func.specmeta>, C<func.opts>,
#C<func.common_opts>, C<func.func_opts> that contain extra information
#(C<func.specmeta> is a hash of getopt spec name and a hash of extra information
#while C<func.*opts> lists all used option names).
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<args> => I<hash>
#
#Reference to hash which will store the result.
#
#=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<ignore_converted_code> => I<bool> (default: 0)
#
#Whether to ignore coderefs converted to string.
#
#Across network through JSON encoding, coderef in metadata (e.g. in
#C<cmdline_aliases> property) usually gets converted to string C<CODE>. In some
#cases, like for tab completion, this is pretty harmless so you can turn this
#option on. For example, in the case of C<cmdline_aliases>, the effect is just
#that command-line aliases code are not getting executed, but this is usually
#okay.
#
#=item * B<meta>* => I<hash>
#
#Rinci function metadata.
#
#=item * B<meta_is_normalized> => I<bool>
#
#=item * B<per_arg_json> => I<bool> (default: 0)
#
#Whether to add --NAME-json for non-simple arguments.
#
#Will also interpret command-line arguments as JSON if assigned to function
#arguments, if arguments' schema is not simple scalar.
#
#=item * B<per_arg_yaml> => I<bool> (default: 0)
#
#Whether to add --NAME-yaml for non-simple arguments.
#
#Will also interpret command-line arguments as YAML if assigned to function
#arguments, if arguments' schema is not simple scalar.
#
#=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:  (any)
#
#
#
#=head2 get_args_from_argv
#
#Usage:
#
# get_args_from_argv(%args) -> [status, msg, payload, meta]
#
#Get subroutine arguments (%args) from command-line arguments (@ARGV).
#
#Using information in Rinci function metadata's C<args> property, parse command
#line arguments C<@argv> into hash C<%args>, suitable for passing into subroutines.
#
#Currently uses L<Getopt::Long>'s C<GetOptions> to do the parsing.
#
#As with GetOptions, this function modifies its C<argv> argument, so you might
#want to copy the original C<argv> first (or pass a copy instead) if you want to
#preserve the original.
#
#See also: gen_getopt_long_spec_from_meta() which is the routine that generates
#the specification.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<allow_extra_elems> => I<bool> (default: 0)
#
#Allow extra/unassigned elements in argv.
#
#If set to 1, then if there are array elements unassigned to one of the
#arguments, instead of generating an error, this function will just ignore them.
#
#This option will be passed to Perinci::Sub::GetArgs::Array's allow_extra_elems.
#
#=item * B<args> => I<hash>
#
#Specify input args, with some arguments preset.
#
#=item * B<argv> => I<array[str]>
#
#If not specified, defaults to @ARGV
#
#=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<ggls_res> => I<array>
#
#Full result from gen_getopt_long_spec_from_meta().
#
#If you already call C<gen_getopt_long_spec_from_meta()>, you can pass the I<full> enveloped result
#here, to avoid calculating twice.
#
#=item * B<ignore_converted_code> => I<bool> (default: 0)
#
#Whether to ignore coderefs converted to string.
#
#Across network through JSON encoding, coderef in metadata (e.g. in
#C<cmdline_aliases> property) usually gets converted to string C<CODE>. In some
#cases, like for tab completion, this is harmless so you can turn this option on.
#
#=item * B<meta>* => I<hash>
#
#=item * B<meta_is_normalized> => I<bool> (default: 0)
#
#Can be set to 1 if your metadata is normalized, to avoid duplicate effort.
#
#=item * B<on_missing_required_args> => I<code>
#
#Execute code when there is missing required args.
#
#This can be used to give a chance to supply argument value from other sources if
#not specified by command-line options. Perinci::CmdLine, for example, uses this
#hook to supply value from STDIN or file contents (if argument has C<cmdline_src>
#specification key set).
#
#This hook will be called for each missing argument. It will be supplied hash
#arguments: (arg => $the_missing_argument_name, args =>
#$the_resulting_args_so_far, spec => $the_arg_spec).
#
#The hook can return true if it succeeds in making the missing situation
#resolved. In this case, this function will not report the argument as missing.
#
#=item * B<per_arg_json> => I<bool> (default: 0)
#
#Whether to recognize --ARGNAME-json.
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
# % script.pl --name-json 'null'
#
#But every other string will need to be quoted:
#
# % script.pl --name-json '"foo"'
#
#See also: per_arg_yaml. You should enable just one instead of turning on both.
#
#=item * B<per_arg_yaml> => I<bool> (default: 0)
#
#Whether to recognize --ARGNAME-yaml.
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
# % script.pl --name-yaml '~'
#
#See also: per_arg_json. You should enable just one instead of turning on both.
#
#=item * B<strict> => I<bool> (default: 1)
#
#Strict mode.
#
#If set to 0, will still return parsed argv even if there are parsing errors
#(reported by Getopt::Long). If set to 1 (the default), will die upon error.
#
#Normally you would want to use strict mode, for more error checking. Setting off
#strict is used by, for example, Perinci::Sub::Complete during completion where
#the command-line might still be incomplete.
#
#Should probably be named C<ignore_errors>. :-)
#
#=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:  (any)
#
#
#Error codes:
#
#=over
#
#=item * 400 - Error in Getopt::Long option specification, e.g. in common_opts.
#
#=item * 500 - failure in GetOptions, meaning argv is not valid according to metadata
#specification (only if 'strict' mode is enabled).
#
#=item * 501 - coderef in cmdline_aliases got converted into a string, probably because
#the metadata was transported (e.g. through Riap::HTTP/Riap::Simple).
#
#=back
#
#=head1 FAQ
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-GetArgs-Argv>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-GetArgs-Argv>.
#
#=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-GetArgs-Argv>
#
#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) 2019, 2017, 2016, 2015, 2014, 2013, 2012, 2011 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/GetArgs/Array.pm ###
#package Perinci::Sub::GetArgs::Array;
#
#our $DATE = '2019-04-15'; # DATE
#our $VERSION = '0.170'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
##use Log::Any '$log';
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(get_args_from_array);
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#};
#
#$SPEC{get_args_from_array} = {
#    v => 1.1,
#    summary => 'Get subroutine arguments (%args) from array',
#    description => <<'_',
#
#Using information in metadata's `args` property (particularly the `pos` and
#`slurpy` arg type clauses), extract arguments from an array into a hash
#`\%args`, suitable for passing into subs.
#
#Example:
#
#    my $meta = {
#        v => 1.1,
#        summary => 'Multiply 2 numbers (a & b)',
#        args => {
#            a => {schema=>'num*', pos=>0},
#            b => {schema=>'num*', pos=>1},
#        }
#    }
#
#then `get_args_from_array(array=>[2, 3], meta=>$meta)` will produce:
#
#    [200, "OK", {a=>2, b=>3}]
#
#_
#    args => {
#        array => {
#            schema => ['array*' => {}],
#            req => 1,
#            description => <<'_',
#
#NOTE: array will be modified/emptied (elements will be taken from the array as
#they are put into the resulting args). Copy your array first if you want to
#preserve its content.
#
#_
#        },
#        meta => {
#            schema => ['hash*' => {}],
#            req => 1,
#        },
#        meta_is_normalized => {
#            summary => 'Can be set to 1 if your metadata is normalized, '.
#                'to avoid duplicate effort',
#            schema => 'bool',
#            default => 0,
#        },
#        allow_extra_elems => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Allow extra/unassigned elements in array',
#            description => <<'_',
#
#If set to 1, then if there are array elements unassigned to one of the arguments
#(due to missing `pos`, for example), instead of generating an error, the
#function will just ignore them.
#
#_
#        },
#    },
#};
#sub get_args_from_array {
#    my %fargs = @_;
#    my $ary  = $fargs{array} or return [400, "Please specify array"];
#    my $meta = $fargs{meta} or return [400, "Please specify meta"];
#    unless ($fargs{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata(
#            $meta);
#    }
#    my $allow_extra_elems = $fargs{allow_extra_elems} // 0;
#
#    my $rargs = {};
#
#    my $args_p = $meta->{args} // {};
#    for my $i (reverse 0..@$ary-1) {
#        #$log->tracef("i=$i");
#        while (my ($a, $as) = each %$args_p) {
#            my $o = $as->{pos};
#            if (defined($o) && $o == $i) {
#                if ($as->{slurpy} // $as->{greedy}) {
#                    my $type = $as->{schema}[0];
#                    my @elems = splice(@$ary, $i);
#                    if ($type eq 'array') {
#                        $rargs->{$a} = \@elems;
#                    } elsif ($type eq 'hash') {
#                        $rargs->{$a} = {};
#                        for my $j (0..$#elems) {
#                            my $elem = $elems[$j];
#                            unless ($elem =~ /(.*?)=(.*)/) {
#                                return [400, "Invalid key=value pair in element #$j"];
#                            }
#                            $rargs->{$a}{$1} = $2;
#                        }
#                    } else {
#                        $rargs->{$a} = join " ", @elems;
#                    }
#                    #$log->tracef("assign %s to arg->{$a}", $rargs->{$a});
#                } else {
#                    $rargs->{$a} = splice(@$ary, $i, 1);
#                    #$log->tracef("assign %s to arg->{$a}", $rargs->{$a});
#                }
#            }
#        }
#    }
#
#    return [400, "There are extra, unassigned elements in array: [".
#                join(", ", @$ary)."]"] if @$ary && !$allow_extra_elems;
#
#    [200, "OK", $rargs];
#}
#
#1;
## ABSTRACT: Get subroutine arguments (%args) from array
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::GetArgs::Array - Get subroutine arguments (%args) from array
#
#=head1 VERSION
#
#This document describes version 0.170 of Perinci::Sub::GetArgs::Array (from Perl distribution Perinci-Sub-GetArgs-Array), released on 2019-04-15.
#
#=head1 SYNOPSIS
#
# use Perinci::Sub::GetArgs::Array;
#
# my $res = get_args_from_array(array=>\@ary, meta=>$meta, ...);
#
#=head1 DESCRIPTION
#
#This module provides get_args_from_array(). This module is used by, among
#others, L<Perinci::Sub::GetArgs::Argv>.
#
#=head1 FUNCTIONS
#
#
#=head2 get_args_from_array
#
#Usage:
#
# get_args_from_array(%args) -> [status, msg, payload, meta]
#
#Get subroutine arguments (%args) from array.
#
#Using information in metadata's C<args> property (particularly the C<pos> and
#C<slurpy> arg type clauses), extract arguments from an array into a hash
#C<\%args>, suitable for passing into subs.
#
#Example:
#
# my $meta = {
#     v => 1.1,
#     summary => 'Multiply 2 numbers (a & b)',
#     args => {
#         a => {schema=>'num*', pos=>0},
#         b => {schema=>'num*', pos=>1},
#     }
# }
#
#then C<< get_args_from_array(array=E<gt>[2, 3], meta=E<gt>$meta) >> will produce:
#
# [200, "OK", {a=>2, b=>3}]
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<allow_extra_elems> => I<bool> (default: 0)
#
#Allow extra/unassigned elements in array.
#
#If set to 1, then if there are array elements unassigned to one of the arguments
#(due to missing C<pos>, for example), instead of generating an error, the
#function will just ignore them.
#
#=item * B<array>* => I<array>
#
#NOTE: array will be modified/emptied (elements will be taken from the array as
#they are put into the resulting args). Copy your array first if you want to
#preserve its content.
#
#=item * B<meta>* => I<hash>
#
#=item * B<meta_is_normalized> => I<bool> (default: 0)
#
#Can be set to 1 if your metadata is normalized, to avoid duplicate effort.
#
#=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:  (any)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-GetArgs-Array>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-GetArgs-Array>.
#
#=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-GetArgs-Array>
#
#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) 2019, 2016, 2015, 2014, 2013, 2012, 2011 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/Normalize.pm ###
#package Perinci::Sub::Normalize;
#
#our $DATE = '2018-09-10'; # DATE
#our $VERSION = '0.200'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       normalize_function_metadata
#               );
#
#sub _normalize{
#    my ($meta, $ver, $opts, $proplist, $nmeta, $prefix, $modprefix) = @_;
#
#    my $opt_aup = $opts->{allow_unknown_properties};
#    my $opt_nss = $opts->{normalize_sah_schemas};
#    my $opt_rip = $opts->{remove_internal_properties};
#
#    if (defined $ver) {
#        defined($meta->{v}) && $meta->{v} eq $ver
#            or die "$prefix: Metadata version must be $ver";
#    }
#
#  KEY:
#    for my $k (keys %$meta) {
#        die "Invalid prop/attr syntax '$k', must be word/dotted-word only"
#            unless $k =~ /\A(\w+)(?:\.(\w+(?:\.\w+)*))?(?:\((\w+)\))?\z/;
#
#        my ($prop, $attr);
#        if (defined $3) {
#            $prop = $1;
#            $attr = defined($2) ? "$2.alt.lang.$3" : "alt.lang.$3";
#        } else {
#            $prop = $1;
#            $attr = $2;
#        }
#
#        my $nk = "$prop" . (defined($attr) ? ".$attr" : "");
#
#        # strip property/attr started with _
#        if ($prop =~ /\A_/ || defined($attr) && $attr =~ /\A_|\._/) {
#            unless ($opt_rip) {
#                $nmeta->{$nk} = $meta->{$k};
#            }
#            next KEY;
#        }
#
#        my $prop_proplist = $proplist->{$prop};
#
#        # try to load module that declare new props first
#        if (!$opt_aup && !$prop_proplist) {
#            $modprefix //= $prefix;
#            my $mod = "Perinci/Sub/Property$modprefix/$prop.pm";
#            eval { require $mod };
#            # hide technical error message from require()
#            if ($@) {
#                die "Unknown property '$prefix/$prop' (and couldn't ".
#                    "load property module '$mod'): $@" if $@;
#            }
#            $prop_proplist = $proplist->{$prop};
#        }
#        die "Unknown property '$prefix/$prop'"
#            unless $opt_aup || $prop_proplist;
#
#        if ($prop_proplist && $prop_proplist->{_prop}) {
#            die "Property '$prefix/$prop' must be a hash"
#                unless ref($meta->{$k}) eq 'HASH';
#            $nmeta->{$nk} = {};
#            _normalize(
#                $meta->{$k},
#                $prop_proplist->{_ver},
#                $opts,
#                $prop_proplist->{_prop},
#                $nmeta->{$nk},
#                "$prefix/$prop",
#            );
#        } elsif ($prop_proplist && $prop_proplist->{_elem_prop}) {
#            die "Property '$prefix/$prop' must be an array"
#                unless ref($meta->{$k}) eq 'ARRAY';
#            $nmeta->{$nk} = [];
#            my $i = 0;
#            for (@{ $meta->{$k} }) {
#                my $href = {};
#                if (ref($_) eq 'HASH') {
#                    _normalize(
#                        $_,
#                        $prop_proplist->{_ver},
#                        $opts,
#                        $prop_proplist->{_elem_prop},
#                        $href,
#                        "$prefix/$prop/$i",
#                    );
#                    push @{ $nmeta->{$nk} }, $href;
#                } else {
#                    push @{ $nmeta->{$nk} }, $_;
#                }
#                $i++;
#            }
#        } elsif ($prop_proplist && $prop_proplist->{_value_prop}) {
#            die "Property '$prefix/$prop' must be a hash"
#                unless ref($meta->{$k}) eq 'HASH';
#            $nmeta->{$nk} = {};
#            for (keys %{ $meta->{$k} }) {
#                $nmeta->{$nk}{$_} = {};
#                die "Property '$prefix/$prop/$_' must be a hash"
#                    unless ref($meta->{$k}{$_}) eq 'HASH';
#                _normalize(
#                    $meta->{$k}{$_},
#                    $prop_proplist->{_ver},
#                    $opts,
#                    $prop_proplist->{_value_prop},
#                    $nmeta->{$nk}{$_},
#                    "$prefix/$prop/$_",
#                    ($prop eq 'args' ? "$prefix/arg" : undef),
#                );
#            }
#        } else {
#            if ($k eq 'schema' && $opt_nss) { # XXX currently hardcoded
#                require Data::Sah::Normalize;
#                $nmeta->{$nk} = Data::Sah::Normalize::normalize_schema(
#                    $meta->{$k});
#            } else {
#                $nmeta->{$nk} = $meta->{$k};
#            }
#        }
#    }
#
#    $nmeta;
#}
#
#sub normalize_function_metadata($;$) {
#    my ($meta, $opts) = @_;
#
#    $opts //= {};
#
#    $opts->{allow_unknown_properties}    //= 0;
#    $opts->{normalize_sah_schemas}       //= 1;
#    $opts->{remove_internal_properties}  //= 0;
#
#    require Sah::Schema::rinci::function_meta;
#    my $sch = $Sah::Schema::rinci::function_meta::schema;
#    my $sch_proplist = $sch->[1]{_prop}
#        or die "BUG: Rinci schema structure changed (1a)";
#
#    _normalize($meta, 1.1, $opts, $sch_proplist, {}, '');
#}
#
#1;
## ABSTRACT: Normalize Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Normalize - Normalize Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 0.200 of Perinci::Sub::Normalize (from Perl distribution Perinci-Sub-Normalize), released on 2018-09-10.
#
#=head1 SYNOPSIS
#
# use Perinci::Sub::Normalize qw(normalize_function_metadata);
#
# my $nmeta = normalize_function_metadata($meta);
#
#=head1 FUNCTIONS
#
#=head2 normalize_function_metadata($meta[ , \%opts ]) => HASH
#
#Normalize and check L<Rinci> function metadata C<$meta>. Return normalized
#metadata, which is a shallow copy of C<$meta>. Die on error.
#
#Available options:
#
#=over
#
#=item * allow_unknown_properties => BOOL (default: 0)
#
#If set to true, will die if there are unknown properties.
#
#=item * normalize_sah_schemas => BOOL (default: 1)
#
#By default, L<Sah> schemas e.g. in C<result/schema> or C<args/*/schema> property
#is normalized using L<Data::Sah>'s C<normalize_schema>. Set this to 0 if you
#don't want this.
#
#=item * remove_internal_properties => BOOL (default: 0)
#
#If set to 1, all properties and attributes starting with underscore (C<_>) with
#will be stripped. According to L<DefHash> specification, they are ignored and
#usually contain notes/comments/extra information.
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Normalize>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Normalize>.
#
#=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-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.
#
#=head1 SEE ALSO
#
#L<Rinci::function>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2018, 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.pm ###
#package Perinci::Sub::Util;
#
#our $DATE = '2017-01-31'; # DATE
#our $VERSION = '0.46'; # 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 => <<'_',
#
#If not specified will use `base_code` (which will then be required).
#
#_
#        },
#        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{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.46 of Perinci::Sub::Util (from Perl distribution Perinci-Sub-Util), released on 2017-01-31.
#
#=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($base_name, $output_name, $set_args) -> 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(%args) -> [status, msg, result, meta]
#
#Generate modified metadata (and subroutine) based on another.
#
#Often you'll want to create another sub (and its metadata) based on another, but
#with some modifications, e.g. add/remove/rename some arguments, change summary,
#add/remove some properties, and so on.
#
#Instead of cloning the Rinci metadata and modify it manually yourself, this
#routine provides some shortcuts.
#
#You can specify base sub/metadata using C<base_name> (string, subroutine name,
#either qualified or not) or C<base_code> (coderef) + C<base_meta> (hash).
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<add_args> => I<hash>
#
#Arguments to add.
#
#=item * B<base_code> => I<code>
#
#Base subroutine code.
#
#If you specify this, you'll also need to specify C<base_meta>.
#
#Alternatively, you can specify C<base_name> instead, to let this routine search
#the base subroutine from existing Perl package.
#
#=item * B<base_meta> => I<hash>
#
#Base Rinci metadata.
#
#=item * B<base_name> => I<str>
#
#Subroutine name (either qualified or not).
#
#If not qualified with package name, will be searched in the caller's package.
#Rinci metadata will be searched in C<%SPEC> package variable.
#
#Alternatively, you can also specify C<base_code> and C<base_meta>.
#
#=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.
#
#If not specified will use C<base_code> (which will then be required).
#
#=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.
#
#=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 (result) 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/sharyanto/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) 2017 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 = '2017-01-31'; # DATE
#our $VERSION = '0.46'; # 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 = 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.46 of Perinci::Sub::Util::Args (from Perl distribution Perinci-Sub-Util), released on 2017-01-31.
#
#=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/sharyanto/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) 2017 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 = '2017-01-31'; # DATE
#our $VERSION = '0.46'; # 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.46 of Perinci::Sub::Util::ResObj (from Perl distribution Perinci-Sub-Util), released on 2017-01-31.
#
#=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/sharyanto/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) 2017 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 = '2017-01-31'; # DATE
#our $VERSION = '0.46'; # 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.46 of Perinci::Sub::Util::Sort (from Perl distribution Perinci-Sub-Util), released on 2017-01-31.
#
#=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/sharyanto/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) 2017 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
### Regexp/Stringify.pm ###
#package Regexp::Stringify;
#
#our $DATE = '2016-10-29'; # DATE
#our $VERSION = '0.06'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use re qw(regexp_pattern);
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(stringify_regexp);
#
#our %SPEC;
#
#$SPEC{stringify_regexp} = {
#    v => 1.1,
#    summary => 'Stringify a Regexp object',
#    description => <<'_',
#
#This routine is an alternative to Perl's default stringification of Regexp
#object (i.e.:`"$re"`) and has some features/options, e.g.: producing regexp
#string that is compatible with certain perl versions.
#
#If given a string (or other non-Regexp object), will return it as-is.
#
#_
#    args => {
#        regexp => {
#            schema => 're*',
#            req => 1,
#            pos => 0,
#        },
#        plver => {
#            summary => 'Target perl version',
#            schema => 'str*',
#            description => <<'_',
#
#Try to produce a regexp object compatible with a certain perl version (should at
#least be >= 5.10).
#
#For example, in perl 5.14 regex stringification changes, e.g. `qr/hlagh/i` would
#previously be stringified as `(?i-xsm:hlagh)`, but now it's stringified as
#`(?^i:hlagh)`. If you set `plver` to 5.10 or 5.12, then this routine will
#still produce the former. It will also ignore regexp modifiers that are
#introduced in newer perls.
#
#Note that not all regexp objects are translatable to older perls, e.g. if they
#contain constructs not known to older perls like `(?^...)` before perl 5.14.
#
#_
#        },
#        with_qr => {
#            schema  => 'bool',
#            description => <<'_',
#
#If you set this to 1, then `qr/a/i` will be stringified as `'qr/a/i'` instead as
#`'(?^i:a)'`. The resulting string can then be eval-ed to recreate the Regexp
#object.
#
#_
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'str*',
#    },
#};
#sub stringify_regexp {
#    my %args = @_;
#
#    my $re = $args{regexp};
#    return $re unless ref($re) eq 'Regexp';
#    my $plver = $args{plver} // $^V;
#
#    my ($pat, $mod) = regexp_pattern($re);
#
#    my $ge_5140 = version->parse($plver) >= version->parse('5.14.0');
#    unless ($ge_5140) {
#        $mod =~ s/[adlu]//g;
#    }
#
#    if ($args{with_qr}) {
#        return "qr($pat)$mod";
#    } else {
#        if ($ge_5140) {
#            return "(^$mod:$pat)";
#        } else {
#            return "(?:(?$mod-)$pat)";
#        }
#    }
#}
#
#1;
## ABSTRACT: Stringify a Regexp object
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Regexp::Stringify - Stringify a Regexp object
#
#=head1 VERSION
#
#This document describes version 0.06 of Regexp::Stringify (from Perl distribution Regexp-Stringify), released on 2016-10-29.
#
#=head1 SYNOPSIS
#
#Assuming this runs on Perl 5.14 or newer.
#
# use Regexp::Stringify qw(stringify_regexp);
# $str = stringify_regexp(regexp=>qr/a/i);                       # '(^i:a)'
# $str = stringify_regexp(regexp=>qr/a/i, with_qr=>1);           # 'qr(a)i'
# $str = stringify_regexp(regexp=>qr/a/i, plver=>5.010);         # '(?:(?i-)a)'
# $str = stringify_regexp(regexp=>qr/a/ui, plver=>5.010);        # '(?:(?i-)a)'
#
#=head1 FUNCTIONS
#
#
#=head2 stringify_regexp(%args) -> str
#
#Stringify a Regexp object.
#
#This routine is an alternative to Perl's default stringification of Regexp
#object (i.e.:C<"$re">) and has some features/options, e.g.: producing regexp
#string that is compatible with certain perl versions.
#
#If given a string (or other non-Regexp object), will return it as-is.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<plver> => I<str>
#
#Target perl version.
#
#Try to produce a regexp object compatible with a certain perl version (should at
#least be >= 5.10).
#
#For example, in perl 5.14 regex stringification changes, e.g. C<qr/hlagh/i> would
#previously be stringified as C<(?i-xsm:hlagh)>, but now it's stringified as
#C<(?^i:hlagh)>. If you set C<plver> to 5.10 or 5.12, then this routine will
#still produce the former. It will also ignore regexp modifiers that are
#introduced in newer perls.
#
#Note that not all regexp objects are translatable to older perls, e.g. if they
#contain constructs not known to older perls like C<(?^...)> before perl 5.14.
#
#=item * B<regexp>* => I<re>
#
#=item * B<with_qr> => I<bool>
#
#If you set this to 1, then C<qr/a/i> will be stringified as C<'qr/a/i'> instead as
#C<'(?^i:a)'>. The resulting string can then be eval-ed to recreate the Regexp
#object.
#
#=back
#
#Return value:  (str)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Regexp-Stringify>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Regexp-Stringify>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Regexp-Stringify>
#
#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
### Sah/Schema/rinci/function_meta.pm ###
#package Sah::Schema::rinci::function_meta;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Normalize ();
#use Sah::Schema::rinci::meta ();
#
#our $schema = [hash => {
#    summary => 'Rinci function metadata',
#
#    # tmp
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        # from common rinci metadata
#        entity_v => {},
#        entity_date => {},
#        links => {},
#
#        is_func => {},
#        is_meth => {},
#        is_class_meth => {},
#        args => {
#            _value_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                # common rinci metadata
#                links => {},
#
#                schema => {},
#                filters => {},
#                default => {},
#                req => {},
#                pos => {},
#                slurpy => {},
#                greedy => {}, # old alias for slurpy, will be removed in Rinci 1.2
#                partial => {},
#                stream => {},
#                is_password => {},
#                cmdline_aliases => {
#                    _value_prop => {
#                        summary => {},
#                        description => {},
#                        schema => {},
#                        code => {},
#                        is_flag => {},
#                    },
#                },
#                cmdline_on_getopt => {},
#                cmdline_prompt => {},
#                completion => {},
#                index_completion => {},
#                element_completion => {},
#                cmdline_src => {},
#                meta => 'fix',
#                element_meta => 'fix',
#                deps => {
#                    _keys => {
#                        arg => {},
#                        all => {},
#                        any => {},
#                        none => {},
#                    },
#                },
#                examples => {},
#            },
#        },
#        args_as => {},
#        args_rels => {},
#        result => {
#            _prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                schema => {},
#                statuses => {
#                    _value_prop => {
#                        # from defhash
#                        summary => {},
#                        description => {},
#                        schema => {},
#                    },
#                },
#                partial => {},
#                stream => {},
#            },
#        },
#        result_naked => {},
#        examples => {
#            _elem_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                args => {},
#                argv => {},
#                src => {},
#                src_plang => {},
#                status => {},
#                result => {},
#                test => {},
#            },
#        },
#        features => {
#            _keys => {
#                reverse => {},
#                tx => {},
#                dry_run => {},
#                pure => {},
#                immutable => {},
#                idempotent => {},
#                check_arg => {},
#            },
#        },
#        deps => {
#            _keys => {
#                all => {},
#                any => {},
#                none => {},
#                env => {},
#                prog => {},
#                pkg => {},
#                func => {},
#                code => {},
#                tmp_dir => {},
#                trash_dir => {},
#            },
#        },
#    },
#}, {}];
#
#$schema->[1]{_prop}{args}{_value_prop}{meta} = $schema->[1];
#$schema->[1]{_prop}{args}{_value_prop}{element_meta} = $schema->[1];
#
## just so the dzil plugin won't complain about schema not being normalized.
## because this is a circular structure and normalizing creates a shallow copy.
#
#$schema = Data::Sah::Normalize::normalize_schema($schema);
#
#1;
## ABSTRACT: Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schema::rinci::function_meta - Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::Schema::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#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) 2019, 2018, 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
### Sah/Schema/rinci/meta.pm ###
#package Sah::Schema::rinci::meta;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#our %_dh_props = (
#    v => {},
#    defhash_v => {},
#    name => {},
#    caption => {},
#    summary => {},
#    description => {},
#    tags => {},
#    default_lang => {},
#    x => {},
#);
#
#our $schema = [hash => {
#    summary => 'Rinci metadata',
#    # tmp
#    _ver => 1.1, # this has the effect of version checking
#    _prop => {
#        %_dh_props,
#
#        entity_v => {},
#        entity_date => {},
#        links => {
#            _elem_prop => {
#                %_dh_props,
#
#                url => {},
#            },
#        },
#    },
#}, {}];
#
#1;
## ABSTRACT: Rinci metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schema::rinci::meta - Rinci metadata
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::Schema::rinci::meta (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#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) 2019, 2018, 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
### Sah/Schema/rinci/result_meta.pm ###
#package Sah::Schema::rinci::result_meta;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Sah::Schema::rinci::meta;
#
#our $schema = [hash => {
#    summary => 'Rinci envelope result metadata',
#
#    # tmp
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        schema => {},
#        perm_err => {},
#        func => {}, # XXX func.*
#        cmdline => {}, # XXX cmdline.*
#        logs => {},
#        prev => {},
#        results => {},
#        part_start => {},
#        part_len => {},
#        len => {},
#        stream => {},
#    },
#}, {}];
#
#1;
## ABSTRACT: Rinci envelope result metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schema::rinci::result_meta - Rinci envelope result metadata
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::Schema::rinci::result_meta (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#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) 2019, 2018, 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
### Sah/SchemaR/rinci/function_meta.pm ###
#package Sah::SchemaR::rinci::function_meta;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#our $rschema = do{my$a=["hash",[{_prop=>{args=>{_value_prop=>{caption=>{},cmdline_aliases=>{_value_prop=>{code=>{},description=>{},is_flag=>{},schema=>{},summary=>{}}},cmdline_on_getopt=>{},cmdline_prompt=>{},cmdline_src=>{},completion=>{},default=>{},default_lang=>{},defhash_v=>{},deps=>{_keys=>{all=>{},any=>{},arg=>{},none=>{}}},description=>{},element_completion=>{},element_meta=>{_prop=>'fix',_ver=>1.1,summary=>"Rinci function metadata"},examples=>{},filters=>{},greedy=>{},index_completion=>{},is_password=>{},links=>{},meta=>'fix',name=>{},partial=>{},pos=>{},req=>{},schema=>{},slurpy=>{},stream=>{},summary=>{},tags=>{},v=>{},x=>{}}},args_as=>{},args_rels=>{},caption=>'fix',default_lang=>'fix',defhash_v=>'fix',deps=>{_keys=>{all=>{},any=>{},code=>{},env=>{},func=>{},none=>{},pkg=>{},prog=>{},tmp_dir=>{},trash_dir=>{}}},description=>'fix',entity_date=>{},entity_v=>{},examples=>{_elem_prop=>{args=>{},argv=>{},caption=>'fix',default_lang=>'fix',defhash_v=>'fix',description=>'fix',name=>'fix',result=>{},src=>{},src_plang=>{},status=>{},summary=>'fix',tags=>'fix',test=>{},v=>'fix',x=>'fix'}},features=>{_keys=>{check_arg=>{},dry_run=>{},idempotent=>{},immutable=>{},pure=>{},reverse=>{},tx=>{}}},is_class_meth=>{},is_func=>{},is_meth=>{},links=>{},name=>'fix',result=>{_prop=>{caption=>'fix',default_lang=>'fix',defhash_v=>'fix',description=>'fix',name=>'fix',partial=>{},schema=>{},statuses=>{_value_prop=>{description=>{},schema=>{},summary=>{}}},stream=>{},summary=>'fix',tags=>'fix',v=>'fix',x=>'fix'}},result_naked=>{},summary=>'fix',tags=>'fix',v=>'fix',x=>'fix'},_ver=>1.1,summary=>"Rinci function metadata"}],["hash"]];$a->[1][0]{_prop}{args}{_value_prop}{element_meta}{_prop}=$a->[1][0]{_prop};$a->[1][0]{_prop}{args}{_value_prop}{meta}=$a->[1][0]{_prop}{args}{_value_prop}{element_meta};$a->[1][0]{_prop}{caption}=$a->[1][0]{_prop}{args}{_value_prop}{caption};$a->[1][0]{_prop}{default_lang}=$a->[1][0]{_prop}{args}{_value_prop}{default_lang};$a->[1][0]{_prop}{defhash_v}=$a->[1][0]{_prop}{args}{_value_prop}{defhash_v};$a->[1][0]{_prop}{description}=$a->[1][0]{_prop}{args}{_value_prop}{description};$a->[1][0]{_prop}{examples}{_elem_prop}{caption}=$a->[1][0]{_prop}{args}{_value_prop}{caption};$a->[1][0]{_prop}{examples}{_elem_prop}{default_lang}=$a->[1][0]{_prop}{args}{_value_prop}{default_lang};$a->[1][0]{_prop}{examples}{_elem_prop}{defhash_v}=$a->[1][0]{_prop}{args}{_value_prop}{defhash_v};$a->[1][0]{_prop}{examples}{_elem_prop}{description}=$a->[1][0]{_prop}{args}{_value_prop}{description};$a->[1][0]{_prop}{examples}{_elem_prop}{name}=$a->[1][0]{_prop}{args}{_value_prop}{name};$a->[1][0]{_prop}{examples}{_elem_prop}{summary}=$a->[1][0]{_prop}{args}{_value_prop}{summary};$a->[1][0]{_prop}{examples}{_elem_prop}{tags}=$a->[1][0]{_prop}{args}{_value_prop}{tags};$a->[1][0]{_prop}{examples}{_elem_prop}{v}=$a->[1][0]{_prop}{args}{_value_prop}{v};$a->[1][0]{_prop}{examples}{_elem_prop}{x}=$a->[1][0]{_prop}{args}{_value_prop}{x};$a->[1][0]{_prop}{name}=$a->[1][0]{_prop}{args}{_value_prop}{name};$a->[1][0]{_prop}{result}{_prop}{caption}=$a->[1][0]{_prop}{args}{_value_prop}{caption};$a->[1][0]{_prop}{result}{_prop}{default_lang}=$a->[1][0]{_prop}{args}{_value_prop}{default_lang};$a->[1][0]{_prop}{result}{_prop}{defhash_v}=$a->[1][0]{_prop}{args}{_value_prop}{defhash_v};$a->[1][0]{_prop}{result}{_prop}{description}=$a->[1][0]{_prop}{args}{_value_prop}{description};$a->[1][0]{_prop}{result}{_prop}{name}=$a->[1][0]{_prop}{args}{_value_prop}{name};$a->[1][0]{_prop}{result}{_prop}{summary}=$a->[1][0]{_prop}{args}{_value_prop}{summary};$a->[1][0]{_prop}{result}{_prop}{tags}=$a->[1][0]{_prop}{args}{_value_prop}{tags};$a->[1][0]{_prop}{result}{_prop}{v}=$a->[1][0]{_prop}{args}{_value_prop}{v};$a->[1][0]{_prop}{result}{_prop}{x}=$a->[1][0]{_prop}{args}{_value_prop}{x};$a->[1][0]{_prop}{summary}=$a->[1][0]{_prop}{args}{_value_prop}{summary};$a->[1][0]{_prop}{tags}=$a->[1][0]{_prop}{args}{_value_prop}{tags};$a->[1][0]{_prop}{v}=$a->[1][0]{_prop}{args}{_value_prop}{v};$a->[1][0]{_prop}{x}=$a->[1][0]{_prop}{args}{_value_prop}{x};$a};
#
#1;
## ABSTRACT: Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::SchemaR::rinci::function_meta - Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::SchemaR::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 DESCRIPTION
#
#This module is automatically generated by Dist::Zilla::Plugin::Sah::Schemas during distribution build.
#
#A Sah::SchemaR::* module is useful if a client wants to quickly lookup the base type of a schema without having to do any extra resolving. With Sah::Schema::*, one might need to do several lookups if a schema is based on another schema, and so on. Compare for example L<Sah::Schema::poseven> vs L<Sah::SchemaR::poseven>, where in Sah::SchemaR::poseven one can immediately get that the base type is C<int>. Currently L<Perinci::Sub::Complete> uses Sah::SchemaR::* instead of Sah::Schema::* for reduced startup overhead when doing tab completion.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#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) 2019, 2018, 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
### Sah/SchemaR/rinci/meta.pm ###
#package Sah::SchemaR::rinci::meta;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#our $rschema = do{my$a=["hash",[{_prop=>{caption=>{},default_lang=>{},defhash_v=>{},description=>{},entity_date=>{},entity_v=>{},links=>{_elem_prop=>{caption=>'fix',default_lang=>'fix',defhash_v=>'fix',description=>'fix',name=>{},summary=>{},tags=>{},url=>{},v=>{},x=>{}}},name=>'fix',summary=>'fix',tags=>'fix',v=>'fix',x=>'fix'},_ver=>1.1,summary=>"Rinci metadata"}],["hash"]];$a->[1][0]{_prop}{links}{_elem_prop}{caption}=$a->[1][0]{_prop}{caption};$a->[1][0]{_prop}{links}{_elem_prop}{default_lang}=$a->[1][0]{_prop}{default_lang};$a->[1][0]{_prop}{links}{_elem_prop}{defhash_v}=$a->[1][0]{_prop}{defhash_v};$a->[1][0]{_prop}{links}{_elem_prop}{description}=$a->[1][0]{_prop}{description};$a->[1][0]{_prop}{name}=$a->[1][0]{_prop}{links}{_elem_prop}{name};$a->[1][0]{_prop}{summary}=$a->[1][0]{_prop}{links}{_elem_prop}{summary};$a->[1][0]{_prop}{tags}=$a->[1][0]{_prop}{links}{_elem_prop}{tags};$a->[1][0]{_prop}{v}=$a->[1][0]{_prop}{links}{_elem_prop}{v};$a->[1][0]{_prop}{x}=$a->[1][0]{_prop}{links}{_elem_prop}{x};$a};
#
#1;
## ABSTRACT: Rinci metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::SchemaR::rinci::meta - Rinci metadata
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::SchemaR::rinci::meta (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 DESCRIPTION
#
#This module is automatically generated by Dist::Zilla::Plugin::Sah::Schemas during distribution build.
#
#A Sah::SchemaR::* module is useful if a client wants to quickly lookup the base type of a schema without having to do any extra resolving. With Sah::Schema::*, one might need to do several lookups if a schema is based on another schema, and so on. Compare for example L<Sah::Schema::poseven> vs L<Sah::SchemaR::poseven>, where in Sah::SchemaR::poseven one can immediately get that the base type is C<int>. Currently L<Perinci::Sub::Complete> uses Sah::SchemaR::* instead of Sah::Schema::* for reduced startup overhead when doing tab completion.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#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) 2019, 2018, 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
### Sah/SchemaR/rinci/result_meta.pm ###
#package Sah::SchemaR::rinci::result_meta;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#our $rschema = ["hash",[{_prop=>{caption=>{},cmdline=>{},default_lang=>{},defhash_v=>{},description=>{},func=>{},len=>{},logs=>{},name=>{},part_len=>{},part_start=>{},perm_err=>{},prev=>{},results=>{},schema=>{},stream=>{},summary=>{},tags=>{},v=>{},x=>{}},_ver=>1.1,summary=>"Rinci envelope result metadata"}],["hash"]];
#
#1;
## ABSTRACT: Rinci envelope result metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::SchemaR::rinci::result_meta - Rinci envelope result metadata
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::SchemaR::rinci::result_meta (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 DESCRIPTION
#
#This module is automatically generated by Dist::Zilla::Plugin::Sah::Schemas during distribution build.
#
#A Sah::SchemaR::* module is useful if a client wants to quickly lookup the base type of a schema without having to do any extra resolving. With Sah::Schema::*, one might need to do several lookups if a schema is based on another schema, and so on. Compare for example L<Sah::Schema::poseven> vs L<Sah::SchemaR::poseven>, where in Sah::SchemaR::poseven one can immediately get that the base type is C<int>. Currently L<Perinci::Sub::Complete> uses Sah::SchemaR::* instead of Sah::Schema::* for reduced startup overhead when doing tab completion.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#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) 2019, 2018, 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
### Sah/Schemas/Rinci.pm ###
#package Sah::Schemas::Rinci;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#1;
## ABSTRACT: Sah schemas for Rinci
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schemas::Rinci - Sah schemas for Rinci
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::Schemas::Rinci (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#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<Sah> - specification
#
#L<Data::Sah>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2016 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### String/LineNumber.pm ###
#package String::LineNumber;
#
#our $DATE = '2014-12-10'; # DATE
#our $VERSION = '0.01'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       linenum
#               );
#
#sub linenum {
#    my ($str, $opts) = @_;
#    $opts //= {};
#    $opts->{width}      //= 4;
#    $opts->{zeropad}    //= 0;
#    $opts->{skip_empty} //= 1;
#
#    my $i = 0;
#    $str =~ s/^(([\t ]*\S)?.*)/
#        sprintf(join("",
#                     "%",
#                     ($opts->{zeropad} && !($opts->{skip_empty}
#                                                && !defined($2)) ? "0" : ""),
#                     $opts->{width}, "s",
#                     "|%s"),
#                ++$i && $opts->{skip_empty} && !defined($2) ? "" : $i,
#                $1)/meg;
#
#    $str;
#}
#
#1;
## ABSTRACT: Give line number to each line of string
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#String::LineNumber - Give line number to each line of string
#
#=head1 VERSION
#
#This document describes version 0.01 of String::LineNumber (from Perl distribution String-LineNumber), released on 2014-12-10.
#
#=head1 FUNCTIONS
#
#=head2 linenum($str, \%opts) => STR
#
#Add line numbers. For example:
#
#     1|line1
#     2|line2
#      |
#     4|line4
#
#Known options:
#
#=over 4
#
#=item * width => INT (default: 4)
#
#=item * zeropad => BOOL (default: 0)
#
#If turned on, will output something like:
#
#  0001|line1
#  0002|line2
#      |
#  0004|line4
#
#=item * skip_empty => BOOL (default: 1)
#
#If set to false, keep printing line number even if line is empty:
#
#     1|line1
#     2|line2
#     3|
#     4|line4
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/String-LineNumber>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-String-LineNumber>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-LineNumber>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### String/PerlQuote.pm ###
#package String::PerlQuote;
#
#our $DATE = '2016-10-07'; # DATE
#our $VERSION = '0.02'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       single_quote
#                       double_quote
#               );
#
## BEGIN COPY PASTE FROM Data::Dump
#my %esc = (
#    "\a" => "\\a",
#    "\b" => "\\b",
#    "\t" => "\\t",
#    "\n" => "\\n",
#    "\f" => "\\f",
#    "\r" => "\\r",
#    "\e" => "\\e",
#);
#
## put a string value in double quotes
#sub double_quote {
#  local($_) = $_[0];
#  # If there are many '"' we might want to use qq() instead
#  s/([\\\"\@\$])/\\$1/g;
#  return qq("$_") unless /[^\040-\176]/;  # fast exit
#
#  s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
#  # no need for 3 digits in escape for these
#  s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
#  s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
#  s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
#  return qq("$_");
#}
## END COPY PASTE FROM Data::Dump
#
#sub single_quote {
#  local($_) = $_[0];
#  s/([\\'])/\\$1/g;
#  return qq('$_');
#}
#1;
## ABSTRACT: Quote a string as Perl does
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#String::PerlQuote - Quote a string as Perl does
#
#=head1 VERSION
#
#This document describes version 0.02 of String::PerlQuote (from Perl distribution String-PerlQuote), released on 2016-10-07.
#
#=head1 FUNCTIONS
#
#=head2 double_quote($str) => STR
#
#Quote or encode C<$str> to the Perl double quote (C<">) literal representation
#of the string. Example:
#
# say double_quote("a");        # => "a"     (with the quotes)
# say double_quote("a\n");      # => "a\n"
# say double_quote('"');        # => "\""
# say double_quote('$foo');     # => "\$foo"
#
#This code is taken from C<quote()> in L<Data::Dump>. Maybe I didn't look more
#closely, but I couldn't a module that provides a function to do something like
#this. L<String::Escape>, for example, provides C<qqbackslash> but it does not
#escape C<$>.
#
#=head2 single_quote($str) => STR
#
#Like C<double_quote> but will produce a Perl single quote literal representation
#instead of the double quote ones. In single quotes, only literal backslash C<\>
#and single quote character C<'> are escaped, the rest are displayed as-is, so
#the result might span multiple lines or contain other non-printable characters.
#
# say single_quote("Mom's");    # => 'Mom\'s' (with the quotes)
# say single_quote("a\\");      # => 'a\\"
# say single_quote('"');        # => '"'
# say single_quote("\$foo");    # => '$foo'
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/String-PerlQuote>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-String-PerlQuote>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-PerlQuote>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2016 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### String/Wildcard/Bash.pm ###
#package String::Wildcard::Bash;
#
#our $DATE = '2019-08-30'; # DATE
#our $VERSION = '0.043'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       $RE_WILDCARD_BASH
#                       contains_wildcard
#                       convert_wildcard_to_sql
#                       convert_wildcard_to_re
#               );
#
#our $re_bash_brace_element =
#    qr(
#          (?:(?:\\\\ | \\, | \\\{ | \\\} | [^\\\{,\}])*)
#  )x;
#
## note: order is important here, brace encloses the other
#our $RE_WILDCARD_BASH =
#    qr(
#          # non-escaped brace expression, with at least one comma
#          (?P<bash_brace>
#              (?<!\\)(?P<slashes_before_bash_brace>\\\\)*\{
#              (?P<bash_brace_content>
#                  $re_bash_brace_element(?:, $re_bash_brace_element )+
#              )
#              (?<!\\)(?:\\\\)*\}
#          )
#      |
#          # non-escaped brace expression, to catch * or ? or [...] inside so
#          # they don't go to below pattern, because bash doesn't consider them
#          # wildcards, e.g. '/{et?,us*}' expands to '/etc /usr', but '/{et?}'
#          # doesn't expand at all to /etc.
#          (?P<literal_brace_single_element>
#              (?<!\\)(?:\\\\)*\{
#              $re_bash_brace_element
#              (?<!\\)(?:\\\\)*\}
#          )
#      |
#          (?P<bash_class>
#              # non-empty, non-escaped character class
#              (?<!\\)(?:\\\\)*\[
#              (?:  \\\\ | \\\[ | \\\] | [^\\\[\]] )+
#              (?<!\\)(?:\\\\)*\]
#          )
#      |
#          (?P<bash_joker>
#              # non-escaped * and ?
#              (?<!\\)(?:\\\\)*(?:\*\*?|\?)
#          )
#      |
#          (?P<sql_joker>
#              # non-escaped % and ?
#              (?<!\\)(?:\\\\)*[%_]
#          )
#      |
#          (?P<literal>
#              [^\\\[\]\{\}*?%_]+
#          |
#              .+?
#          )
#      )ox;
#
#sub contains_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{bash_brace} || $m{bash_class} || $m{bash_joker};
#    }
#    0;
#}
#
#sub convert_wildcard_to_sql {
#    my $opts = ref $_[0] eq 'HASH' ? shift : {};
#    my $str = shift;
#
#    my @res;
#    my $p;
#    while ($str =~ /$RE_WILDCARD_BASH/g) {
#        my %m = %+;
#        if (defined($p = $m{bash_brace_content})) {
#            die "Cannot convert brace pattern '$p' to SQL";
#        } elsif ($p = $m{bash_joker}) {
#            if ($m{bash_joker} eq '*' || $m{bash_joker} eq '**') {
#                push @res, "%";
#            } else {
#                push @res, "_";
#            }
#        } elsif ($p = $m{sql_joker}) {
#            push @res, "\\$p";
#        } elsif (defined($p = $m{literal_brace_single_element})) {
#            die "Currently cannot convert brace literal '$p' to SQL";
#        } elsif (defined($p = $m{bash_class})) {
#            die "Currently cannot convert class pattern '$p' to SQL";
#        } elsif (defined($p = $m{literal})) {
#            push @res, $p;
#        }
#    }
#
#    join "", @res;
#}
#
#sub convert_wildcard_to_re {
#    my $opts = ref $_[0] eq 'HASH' ? shift : {};
#    my $str = shift;
#
#    my $opt_brace   = $opts->{brace} // 1;
#    my $opt_dotglob = $opts->{dotglob} // 0;
#
#    my @res;
#    my $p;
#    while ($str =~ /$RE_WILDCARD_BASH/g) {
#        my %m = %+;
#        if (defined($p = $m{bash_brace_content})) {
#            push @res, quotemeta($m{slashes_before_bash_brace}) if
#                $m{slashes_before_bash_brace};
#            if ($opt_brace) {
#                my @elems;
#                while ($p =~ /($re_bash_brace_element)(,|\z)/g) {
#                    push @elems, $1;
#                    last unless $2;
#                }
#                #use DD; dd \@elems;
#                push @res, "(?:", join("|", map {
#                    convert_wildcard_to_re({
#                        bash_brace => 0,
#                        dotglob    => $opt_dotglob || @res,
#                    }, $_)} @elems), ")";
#            } else {
#                push @res, quotemeta($m{bash_brace});
#            }
#
#        } elsif (defined($p = $m{bash_joker})) {
#            if ($p eq '?') {
#                push @res, '.';
#            } elsif ($p eq '*') {
#                push @res, $opt_dotglob || @res ? '.*' : '[^.].*';
#            } elsif ($p eq '**') {
#                push @res, '.*';
#            }
#
#        } elsif (defined($p = $m{literal_brace_single_element})) {
#            push @res, quotemeta($p);
#        } elsif (defined($p = $m{bash_class})) {
#            # XXX no need to escape some characters?
#            push @res, $p;
#        } elsif (defined($p = $m{sql_joker})) {
#            push @res, quotemeta($p);
#        } elsif (defined($p = $m{literal})) {
#            push @res, quotemeta($p);
#        }
#    }
#
#    join "", @res;
#}
#
#1;
## ABSTRACT: Bash wildcard string routines
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#String::Wildcard::Bash - Bash wildcard string routines
#
#=head1 VERSION
#
#This document describes version 0.043 of String::Wildcard::Bash (from Perl distribution String-Wildcard-Bash), released on 2019-08-30.
#
#=head1 SYNOPSIS
#
#    use String::Wildcard::Bash qw(
#        $RE_WILDCARD_BASH
#        contains_wildcard
#        convert_wildcard_to_sql
#        convert_wildcard_to_re
#    );
#
#    say 1 if contains_wildcard(""));      # -> 0
#    say 1 if contains_wildcard("ab*"));   # -> 1
#    say 1 if contains_wildcard("ab\\*")); # -> 0
#
#    say convert_wildcard_to_sql("foo*");  # -> "foo%"
#
#    say convert_wildcard_to_re("foo*");   # -> "foo.*"
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(qqquote)$
#
#=head1 VARIABLES
#
#=head2 $RE_WILDCARD_BASH
#
#=head1 FUNCTIONS
#
#=head2 contains_wildcard
#
#Usage:
#
# $bool = contains_wildcard($wildcard_str)
#
#Return true if C<$str> contains wildcard pattern. Wildcard patterns include
#I<joker> such as C<*> (meaning zero or more of any characters) and C<?> (exactly
#one of any character), I<character class> C<[...]>, and I<brace> C<{...,}>
#(brace expansion). A pattern can be escaped using a bacslash so it becomes
#literal, e.g. C<foo\*> does not contain wildcard because it's C<foo> followed by
#a literal asterisk C<*>.
#
#Aside from the abovementioned wildcard patterns, bash does other types of
#expansions/substitutions too, but these are not considered wildcard. These
#include tilde expansion (e.g. C<~> becomes C</home/alice>), parameter and
#variable expansion (e.g. C<$0> and C<$HOME>), arithmetic expression (e.g.
#C<$[1+2]>), or history (C<!>).
#
#Although this module has 'Bash' in its name, this set of wildcards should be
#applicable to other Unix shells. Haven't checked completely though.
#
#For more specific needs, e.g. you want to check if a string just contains joker
#and not other types of wildcard patterns, use L</"$RE_WILDCARD_BASH"> directly.
#
#=head2 convert_wildcard_to_sql
#
#Usage:
#
# $sql_str = convert_wildcard_to_sql($wildcard_str);
#
#Convert bash wildcard to SQL pattern. This includes:
#
#=over
#
#=item * converting unescaped C<*> to C<%>
#
#=item * converting unescaped C<?> to C<_>
#
#=item * escaping unescaped C<%>
#
#=item * escaping unescaped C<_>
#
#=back
#
#Unsupported constructs will cause the function to die.
#
#=head2 convert_wildcard_to_re
#
#Usage:
#
# $re_str = convert_wildcard_to_re([ \%opts, ] $wildcard_str);
#
#Convert bash wildcard to regular expression string.
#
#Known options:
#
#=over
#
#=item * brace
#
#Bool. Default is true. Whether to expand braces or not. If set to false, will
#simply treat brace as literals.
#
#Examples:
#
# convert_wildcard_to_re(            "{a,b}"); # => "(?:a|b)"
# convert_wildcard_to_re({brace=>0}, "{a,b}"); # => "\\{a\\,b\\}"
#
#=item * dotglob
#
#Bool. Default is false. Whether joker C<*> (asterisk) will match a dot file. The
#default behavior follows bash; that is, dot file must be matched explicitly with
#C<.*>.
#
#This setting is similar to shell behavior (shopt) setting C<dotglob>.
#
#Examples:
#
# convert_wildcard_to_re({}          , '*a*'); # => "[^.].*a.*"
# convert_wildcard_to_re({dotglob=>1}, '*a*'); # => ".*a.*"
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/String-Wildcard-Bash>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-String-Wildcard-Bash>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-Wildcard-Bash>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#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 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
### YAML/Old.pm ###
#package YAML::Old;
#our $VERSION = '1.23';
#
#use YAML::Old::Mo;
#
#use Exporter;
#push @YAML::Old::ISA, 'Exporter';
#our @EXPORT = qw{ Dump Load };
#our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
#our (
#    $UseCode, $DumpCode, $LoadCode,
#    $SpecVersion,
#    $UseHeader, $UseVersion, $UseBlock, $UseFold, $UseAliases,
#    $Indent, $SortKeys, $Preserve,
#    $AnchorPrefix, $CompressSeries, $InlineSeries, $Purity,
#    $Stringify, $Numify
#);
#
#
#use YAML::Old::Node; # XXX This is a temp fix for Module::Build
#use Scalar::Util qw/ openhandle /;
#
## XXX This VALUE nonsense needs to go.
#use constant VALUE => "\x07YAML\x07VALUE\x07";
#
## YAML Object Properties
#has dumper_class => default => sub {'YAML::Old::Dumper'};
#has loader_class => default => sub {'YAML::Old::Loader'};
#has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
#has loader_object => default => sub {$_[0]->init_action_object("loader")};
#
#sub Dump {
#    my $yaml = YAML::Old->new;
#    $yaml->dumper_class($YAML::DumperClass)
#        if $YAML::DumperClass;
#    return $yaml->dumper_object->dump(@_);
#}
#
#sub Load {
#    my $yaml = YAML::Old->new;
#    $yaml->loader_class($YAML::LoaderClass)
#        if $YAML::LoaderClass;
#    return $yaml->loader_object->load(@_);
#}
#
#{
#    no warnings 'once';
#    # freeze/thaw is the API for Storable string serialization. Some
#    # modules make use of serializing packages on if they use freeze/thaw.
#    *freeze = \ &Dump;
#    *thaw   = \ &Load;
#}
#
#sub DumpFile {
#    my $OUT;
#    my $filename = shift;
#    if (openhandle $filename) {
#        $OUT = $filename;
#    }
#    else {
#        my $mode = '>';
#        if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
#            ($mode, $filename) = ($1, $2);
#        }
#        open $OUT, $mode, $filename
#          or YAML::Old::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, "$!");
#    }
#    binmode $OUT, ':utf8';  # if $Config{useperlio} eq 'define';
#    local $/ = "\n"; # reset special to "sane"
#    print $OUT Dump(@_);
#    unless (ref $filename eq 'GLOB') {
#        close $OUT
#          or do {
#              my $errsav = $!;
#              YAML::Old::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT_CLOSE', $filename, $errsav);
#          }
#    }
#}
#
#sub LoadFile {
#    my $IN;
#    my $filename = shift;
#    if (openhandle $filename) {
#        $IN = $filename;
#    }
#    else {
#        open $IN, '<', $filename
#          or YAML::Old::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, "$!");
#    }
#    binmode $IN, ':utf8';  # if $Config{useperlio} eq 'define';
#    return Load(do { local $/; <$IN> });
#}
#
#sub init_action_object {
#    my $self = shift;
#    my $object_class = (shift) . '_class';
#    my $module_name = $self->$object_class;
#    eval "require $module_name";
#    $self->die("Error in require $module_name - $@")
#        if $@ and "$@" !~ /Can't locate/;
#    my $object = $self->$object_class->new;
#    $object->set_global_options;
#    return $object;
#}
#
#my $global = {};
#sub Bless {
#    require YAML::Old::Dumper::Base;
#    YAML::Old::Dumper::Base::bless($global, @_)
#}
#sub Blessed {
#    require YAML::Old::Dumper::Base;
#    YAML::Old::Dumper::Base::blessed($global, @_)
#}
#sub global_object { $global }
#
#1;
### YAML/Old/Dumper.pm ###
#package YAML::Old::Dumper;
#
#use YAML::Old::Mo;
#extends 'YAML::Old::Dumper::Base';
#
#use YAML::Old::Dumper::Base;
#use YAML::Old::Node;
#use YAML::Old::Types;
#use Scalar::Util qw();
#use B ();
#use Carp ();
#
## Context constants
#use constant KEY       => 3;
#use constant BLESSED   => 4;
#use constant FROMARRAY => 5;
#use constant VALUE     => "\x07YAML\x07VALUE\x07";
#
## Common YAML character sets
#my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
#my $LIT_CHAR    = '|';
#
##==============================================================================
## OO version of Dump. YAML->new->dump($foo);
#sub dump {
#    my $self = shift;
#    $self->stream('');
#    $self->document(0);
#    for my $document (@_) {
#        $self->{document}++;
#        $self->transferred({});
#        $self->id_refcnt({});
#        $self->id_anchor({});
#        $self->anchor(1);
#        $self->level(0);
#        $self->offset->[0] = 0 - $self->indent_width;
#        $self->_prewalk($document);
#        $self->_emit_header($document);
#        $self->_emit_node($document);
#    }
#    return $self->stream;
#}
#
## Every YAML document in the stream must begin with a YAML header, unless
## there is only a single document and the user requests "no header".
#sub _emit_header {
#    my $self = shift;
#    my ($node) = @_;
#    if (not $self->use_header and
#        $self->document == 1
#       ) {
#        $self->die('YAML_DUMP_ERR_NO_HEADER')
#          unless ref($node) =~ /^(HASH|ARRAY)$/;
#        $self->die('YAML_DUMP_ERR_NO_HEADER')
#          if ref($node) eq 'HASH' and keys(%$node) == 0;
#        $self->die('YAML_DUMP_ERR_NO_HEADER')
#          if ref($node) eq 'ARRAY' and @$node == 0;
#        # XXX Also croak if aliased, blessed, or ynode
#        $self->headless(1);
#        return;
#    }
#    $self->{stream} .= '---';
## XXX Consider switching to 1.1 style
#    if ($self->use_version) {
##         $self->{stream} .= " #YAML:1.0";
#    }
#}
#
## Walk the tree to be dumped and keep track of its reference counts.
## This function is where the Dumper does all its work. All type
## transfers happen here.
#sub _prewalk {
#    my $self = shift;
#    my $stringify = $self->stringify;
#    my ($class, $type, $node_id) = $self->node_info(\$_[0], $stringify);
#
#    # Handle typeglobs
#    if ($type eq 'GLOB') {
#        $self->transferred->{$node_id} =
#          YAML::Old::Type::glob->yaml_dump($_[0]);
#        $self->_prewalk($self->transferred->{$node_id});
#        return;
#    }
#
#    # Handle regexps
#    if (ref($_[0]) eq 'Regexp') {
#        return;
#    }
#
#    # Handle Purity for scalars.
#    # XXX can't find a use case yet. Might be YAGNI.
#    if (not ref $_[0]) {
#        $self->{id_refcnt}{$node_id}++ if $self->purity;
#        return;
#    }
#
#    # Make a copy of original
#    my $value = $_[0];
#    ($class, $type, $node_id) = $self->node_info($value, $stringify);
#
#    # Must be a stringified object.
#    return if (ref($value) and not $type);
#
#    # Look for things already transferred.
#    if ($self->transferred->{$node_id}) {
#        (undef, undef, $node_id) = (ref $self->transferred->{$node_id})
#          ? $self->node_info($self->transferred->{$node_id}, $stringify)
#          : $self->node_info(\ $self->transferred->{$node_id}, $stringify);
#        $self->{id_refcnt}{$node_id}++;
#        return;
#    }
#
#    # Handle code refs
#    if ($type eq 'CODE') {
#        $self->transferred->{$node_id} = 'placeholder';
#        YAML::Old::Type::code->yaml_dump(
#            $self->dump_code,
#            $_[0],
#            $self->transferred->{$node_id}
#        );
#        ($class, $type, $node_id) =
#          $self->node_info(\ $self->transferred->{$node_id}, $stringify);
#        $self->{id_refcnt}{$node_id}++;
#        return;
#    }
#
#    # Handle blessed things
#    if (defined $class) {
#        if ($value->can('yaml_dump')) {
#            $value = $value->yaml_dump;
#        }
#        elsif ($type eq 'SCALAR') {
#            $self->transferred->{$node_id} = 'placeholder';
#            YAML::Old::Type::blessed->yaml_dump
#              ($_[0], $self->transferred->{$node_id});
#            ($class, $type, $node_id) =
#              $self->node_info(\ $self->transferred->{$node_id}, $stringify);
#            $self->{id_refcnt}{$node_id}++;
#            return;
#        }
#        else {
#            $value = YAML::Old::Type::blessed->yaml_dump($value);
#        }
#        $self->transferred->{$node_id} = $value;
#        (undef, $type, $node_id) = $self->node_info($value, $stringify);
#    }
#
#    # Handle YAML Blessed things
#    require YAML::Old;
#    if (defined YAML::Old->global_object()->{blessed_map}{$node_id}) {
#        $value = YAML::Old->global_object()->{blessed_map}{$node_id};
#        $self->transferred->{$node_id} = $value;
#        ($class, $type, $node_id) = $self->node_info($value, $stringify);
#        $self->_prewalk($value);
#        return;
#    }
#
#    # Handle hard refs
#    if ($type eq 'REF' or $type eq 'SCALAR') {
#        $value = YAML::Old::Type::ref->yaml_dump($value);
#        $self->transferred->{$node_id} = $value;
#        (undef, $type, $node_id) = $self->node_info($value, $stringify);
#    }
#
#    # Handle ref-to-glob's
#    elsif ($type eq 'GLOB') {
#        my $ref_ynode = $self->transferred->{$node_id} =
#          YAML::Old::Type::ref->yaml_dump($value);
#
#        my $glob_ynode = $ref_ynode->{&VALUE} =
#          YAML::Old::Type::glob->yaml_dump($$value);
#
#        (undef, undef, $node_id) = $self->node_info($glob_ynode, $stringify);
#        $self->transferred->{$node_id} = $glob_ynode;
#        $self->_prewalk($glob_ynode);
#        return;
#    }
#
#    # Increment ref count for node
#    return if ++($self->{id_refcnt}{$node_id}) > 1;
#
#    # Keep on walking
#    if ($type eq 'HASH') {
#        $self->_prewalk($value->{$_})
#            for keys %{$value};
#        return;
#    }
#    elsif ($type eq 'ARRAY') {
#        $self->_prewalk($_)
#            for @{$value};
#        return;
#    }
#
#    # Unknown type. Need to know about it.
#    $self->warn(<<"...");
#YAML::Old::Dumper can't handle dumping this type of data.
#Please report this to the author.
#
#id:    $node_id
#type:  $type
#class: $class
#value: $value
#
#...
#
#    return;
#}
#
## Every data element and sub data element is a node.
## Everything emitted goes through this function.
#sub _emit_node {
#    my $self = shift;
#    my ($type, $node_id);
#    my $ref = ref($_[0]);
#    if ($ref) {
#        if ($ref eq 'Regexp') {
#            $self->_emit(' !!perl/regexp');
#            $self->_emit_str("$_[0]");
#            return;
#        }
#        (undef, $type, $node_id) = $self->node_info($_[0], $self->stringify);
#    }
#    else {
#        $type = $ref || 'SCALAR';
#        (undef, undef, $node_id) = $self->node_info(\$_[0], $self->stringify);
#    }
#
#    my ($ynode, $tag) = ('') x 2;
#    my ($value, $context) = (@_, 0);
#
#    if (defined $self->transferred->{$node_id}) {
#        $value = $self->transferred->{$node_id};
#        $ynode = ynode($value);
#        if (ref $value) {
#            $tag = defined $ynode ? $ynode->tag->short : '';
#            (undef, $type, $node_id) =
#              $self->node_info($value, $self->stringify);
#        }
#        else {
#            $ynode = ynode($self->transferred->{$node_id});
#            $tag = defined $ynode ? $ynode->tag->short : '';
#            $type = 'SCALAR';
#            (undef, undef, $node_id) =
#              $self->node_info(
#                  \ $self->transferred->{$node_id},
#                  $self->stringify
#              );
#        }
#    }
#    elsif ($ynode = ynode($value)) {
#        $tag = $ynode->tag->short;
#    }
#
#    if ($self->use_aliases) {
#        $self->{id_refcnt}{$node_id} ||= 0;
#        if ($self->{id_refcnt}{$node_id} > 1) {
#            if (defined $self->{id_anchor}{$node_id}) {
#                $self->{stream} .= ' *' . $self->{id_anchor}{$node_id} . "\n";
#                return;
#            }
#            my $anchor = $self->anchor_prefix . $self->{anchor}++;
#            $self->{stream} .= ' &' . $anchor;
#            $self->{id_anchor}{$node_id} = $anchor;
#        }
#    }
#
#    return $self->_emit_str("$value")   # Stringified object
#      if ref($value) and not $type;
#    return $self->_emit_scalar($value, $tag)
#      if $type eq 'SCALAR' and $tag;
#    return $self->_emit_str($value)
#      if $type eq 'SCALAR';
#    return $self->_emit_mapping($value, $tag, $node_id, $context)
#      if $type eq 'HASH';
#    return $self->_emit_sequence($value, $tag)
#      if $type eq 'ARRAY';
#    $self->warn('YAML_DUMP_WARN_BAD_NODE_TYPE', $type);
#    return $self->_emit_str("$value");
#}
#
## A YAML mapping is akin to a Perl hash.
#sub _emit_mapping {
#    my $self = shift;
#    my ($value, $tag, $node_id, $context) = @_;
#    $self->{stream} .= " !$tag" if $tag;
#
#    # Sometimes 'keys' fails. Like on a bad tie implementation.
#    my $empty_hash = not(eval {keys %$value});
#    $self->warn('YAML_EMIT_WARN_KEYS', $@) if $@;
#    return ($self->{stream} .= " {}\n") if $empty_hash;
#
#    # If CompressSeries is on (default) and legal is this context, then
#    # use it and make the indent level be 2 for this node.
#    if ($context == FROMARRAY and
#        $self->compress_series and
#        not (defined $self->{id_anchor}{$node_id} or $tag or $empty_hash)
#       ) {
#        $self->{stream} .= ' ';
#        $self->offset->[$self->level+1] = $self->offset->[$self->level] + 2;
#    }
#    else {
#        $context = 0;
#        $self->{stream} .= "\n"
#          unless $self->headless && not($self->headless(0));
#        $self->offset->[$self->level+1] =
#          $self->offset->[$self->level] + $self->indent_width;
#    }
#
#    $self->{level}++;
#    my @keys;
#    if ($self->sort_keys == 1) {
#        if (ynode($value)) {
#            @keys = keys %$value;
#        }
#        else {
#            @keys = sort keys %$value;
#        }
#    }
#    elsif ($self->sort_keys == 2) {
#        @keys = sort keys %$value;
#    }
#    # XXX This is hackish but sometimes handy. Not sure whether to leave it in.
#    elsif (ref($self->sort_keys) eq 'ARRAY') {
#        my $i = 1;
#        my %order = map { ($_, $i++) } @{$self->sort_keys};
#        @keys = sort {
#            (defined $order{$a} and defined $order{$b})
#              ? ($order{$a} <=> $order{$b})
#              : ($a cmp $b);
#        } keys %$value;
#    }
#    else {
#        @keys = keys %$value;
#    }
#    # Force the YAML::VALUE ('=') key to sort last.
#    if (exists $value->{&VALUE}) {
#        for (my $i = 0; $i < @keys; $i++) {
#            if ($keys[$i] eq &VALUE) {
#                splice(@keys, $i, 1);
#                push @keys, &VALUE;
#                last;
#            }
#        }
#    }
#
#    for my $key (@keys) {
#        $self->_emit_key($key, $context);
#        $context = 0;
#        $self->{stream} .= ':';
#        $self->_emit_node($value->{$key});
#    }
#    $self->{level}--;
#}
#
## A YAML series is akin to a Perl array.
#sub _emit_sequence {
#    my $self = shift;
#    my ($value, $tag) = @_;
#    $self->{stream} .= " !$tag" if $tag;
#
#    return ($self->{stream} .= " []\n") if @$value == 0;
#
#    $self->{stream} .= "\n"
#      unless $self->headless && not($self->headless(0));
#
#    # XXX Really crufty feature. Better implemented by ynodes.
#    if ($self->inline_series and
#        @$value <= $self->inline_series and
#        not (scalar grep {ref or /\n/} @$value)
#       ) {
#        $self->{stream} =~ s/\n\Z/ /;
#        $self->{stream} .= '[';
#        for (my $i = 0; $i < @$value; $i++) {
#            $self->_emit_str($value->[$i], KEY);
#            last if $i == $#{$value};
#            $self->{stream} .= ', ';
#        }
#        $self->{stream} .= "]\n";
#        return;
#    }
#
#    $self->offset->[$self->level + 1] =
#      $self->offset->[$self->level] + $self->indent_width;
#    $self->{level}++;
#    for my $val (@$value) {
#        $self->{stream} .= ' ' x $self->offset->[$self->level];
#        $self->{stream} .= '-';
#        $self->_emit_node($val, FROMARRAY);
#    }
#    $self->{level}--;
#}
#
## Emit a mapping key
#sub _emit_key {
#    my $self = shift;
#    my ($value, $context) = @_;
#    $self->{stream} .= ' ' x $self->offset->[$self->level]
#      unless $context == FROMARRAY;
#    $self->_emit_str($value, KEY);
#}
#
## Emit a blessed SCALAR
#sub _emit_scalar {
#    my $self = shift;
#    my ($value, $tag) = @_;
#    $self->{stream} .= " !$tag";
#    $self->_emit_str($value, BLESSED);
#}
#
#sub _emit {
#    my $self = shift;
#    $self->{stream} .= join '', @_;
#}
#
## Emit a string value. YAML has many scalar styles. This routine attempts to
## guess the best style for the text.
#sub _emit_str {
#    my $self = shift;
#    my $type = $_[1] || 0;
#
#    # Use heuristics to find the best scalar emission style.
#    $self->offset->[$self->level + 1] =
#      $self->offset->[$self->level] + $self->indent_width;
#    $self->{level}++;
#
#    my $sf = $type == KEY ? '' : ' ';
#    my $sb = $type == KEY ? '? ' : ' ';
#    my $ef = $type == KEY ? '' : "\n";
#    my $eb = "\n";
#
#    while (1) {
#        $self->_emit($sf),
#        $self->_emit_plain($_[0]),
#        $self->_emit($ef), last
#          if not defined $_[0];
#        $self->_emit($sf, '=', $ef), last
#          if $_[0] eq VALUE;
#        $self->_emit($sf),
#        $self->_emit_double($_[0]),
#        $self->_emit($ef), last
#          if $_[0] =~ /$ESCAPE_CHAR/;
#        if ($_[0] =~ /\n/) {
#            $self->_emit($sb),
#            $self->_emit_block($LIT_CHAR, $_[0]),
#            $self->_emit($eb), last
#              if $self->use_block;
#              Carp::cluck "[YAML::Old] \$UseFold is no longer supported"
#              if $self->use_fold;
#            $self->_emit($sf),
#            $self->_emit_double($_[0]),
#            $self->_emit($ef), last
#              if length $_[0] <= 30;
#            $self->_emit($sf),
#            $self->_emit_double($_[0]),
#            $self->_emit($ef), last
#              if $_[0] !~ /\n\s*\S/;
#            $self->_emit($sb),
#            $self->_emit_block($LIT_CHAR, $_[0]),
#            $self->_emit($eb), last;
#        }
#        $self->_emit($sf),
#        $self->_emit_number($_[0]),
#        $self->_emit($ef), last
#          if $self->is_literal_number($_[0]);
#        $self->_emit($sf),
#        $self->_emit_plain($_[0]),
#        $self->_emit($ef), last
#          if $self->is_valid_plain($_[0]);
#        $self->_emit($sf),
#        $self->_emit_double($_[0]),
#        $self->_emit($ef), last
#          if $_[0] =~ /'/;
#        $self->_emit($sf),
#        $self->_emit_single($_[0]),
#        $self->_emit($ef);
#        last;
#    }
#
#    $self->{level}--;
#
#    return;
#}
#
#sub is_literal_number {
#    my $self = shift;
#    # Stolen from JSON::Tiny
#    return B::svref_2object(\$_[0])->FLAGS & (B::SVp_IOK | B::SVp_NOK)
#            && 0 + $_[0] eq $_[0];
#}
#
#sub _emit_number {
#    my $self = shift;
#    return $self->_emit_plain($_[0]);
#}
#
## Check whether or not a scalar should be emitted as an plain scalar.
#sub is_valid_plain {
#    my $self = shift;
#    return 0 unless length $_[0];
#    return 0 if $self->quote_numeric_strings and Scalar::Util::looks_like_number($_[0]);
#    # refer to YAML::Old::Loader::parse_inline_simple()
#    return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;
#    return 0 if $_[0] =~ /[\{\[\]\},]/;
#    return 0 if $_[0] =~ /[:\-\?]\s/;
#    return 0 if $_[0] =~ /\s#/;
#    return 0 if $_[0] =~ /\:(\s|$)/;
#    return 0 if $_[0] =~ /[\s\|\>]$/;
#    return 0 if $_[0] eq '-';
#    return 1;
#}
#
#sub _emit_block {
#    my $self = shift;
#    my ($indicator, $value) = @_;
#    $self->{stream} .= $indicator;
#    $value =~ /(\n*)\Z/;
#    my $chomp = length $1 ? (length $1 > 1) ? '+' : '' : '-';
#    $value = '~' if not defined $value;
#    $self->{stream} .= $chomp;
#    $self->{stream} .= $self->indent_width if $value =~ /^\s/;
#    $self->{stream} .= $self->indent($value);
#}
#
## Plain means that the scalar is unquoted.
#sub _emit_plain {
#    my $self = shift;
#    $self->{stream} .= defined $_[0] ? $_[0] : '~';
#}
#
## Double quoting is for single lined escaped strings.
#sub _emit_double {
#    my $self = shift;
#    (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
#    $self->{stream} .= qq{"$escaped"};
#}
#
## Single quoting is for single lined unescaped strings.
#sub _emit_single {
#    my $self = shift;
#    my $item = shift;
#    $item =~ s{'}{''}g;
#    $self->{stream} .= "'$item'";
#}
#
##==============================================================================
## Utility subroutines.
##==============================================================================
#
## Indent a scalar to the current indentation level.
#sub indent {
#    my $self = shift;
#    my ($text) = @_;
#    return $text unless length $text;
#    $text =~ s/\n\Z//;
#    my $indent = ' ' x $self->offset->[$self->level];
#    $text =~ s/^/$indent/gm;
#    $text = "\n$text";
#    return $text;
#}
#
## Escapes for unprintable characters
#my @escapes = qw(\0   \x01 \x02 \x03 \x04 \x05 \x06 \a
#                 \x08 \t   \n   \v   \f   \r   \x0e \x0f
#                 \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17
#                 \x18 \x19 \x1a \e   \x1c \x1d \x1e \x1f
#                );
#
## Escape the unprintable characters
#sub escape {
#    my $self = shift;
#    my ($text) = @_;
#    $text =~ s/\\/\\\\/g;
#    $text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;
#    return $text;
#}
#
#1;
### YAML/Old/Dumper/Base.pm ###
#package YAML::Old::Dumper::Base;
#
#use YAML::Old::Mo;
#
#use YAML::Old::Node;
#
## YAML Dumping options
#has spec_version    => default => sub {'1.0'};
#has indent_width    => default => sub {2};
#has use_header      => default => sub {1};
#has use_version     => default => sub {0};
#has sort_keys       => default => sub {1};
#has anchor_prefix   => default => sub {''};
#has dump_code       => default => sub {0};
#has use_block       => default => sub {0};
#has use_fold        => default => sub {0};
#has compress_series => default => sub {1};
#has inline_series   => default => sub {0};
#has use_aliases     => default => sub {1};
#has purity          => default => sub {0};
#has stringify       => default => sub {0};
#has quote_numeric_strings => default => sub {0};
#
## Properties
#has stream      => default => sub {''};
#has document    => default => sub {0};
#has transferred => default => sub {{}};
#has id_refcnt   => default => sub {{}};
#has id_anchor   => default => sub {{}};
#has anchor      => default => sub {1};
#has level       => default => sub {0};
#has offset      => default => sub {[]};
#has headless    => default => sub {0};
#has blessed_map => default => sub {{}};
#
## Global Options are an idea taken from Data::Dumper. Really they are just
## sugar on top of real OO properties. They make the simple Dump/Load API
## easy to configure.
#sub set_global_options {
#    my $self = shift;
#    $self->spec_version($YAML::SpecVersion)
#      if defined $YAML::SpecVersion;
#    $self->indent_width($YAML::Indent)
#      if defined $YAML::Indent;
#    $self->use_header($YAML::UseHeader)
#      if defined $YAML::UseHeader;
#    $self->use_version($YAML::UseVersion)
#      if defined $YAML::UseVersion;
#    $self->sort_keys($YAML::SortKeys)
#      if defined $YAML::SortKeys;
#    $self->anchor_prefix($YAML::AnchorPrefix)
#      if defined $YAML::AnchorPrefix;
#    $self->dump_code($YAML::DumpCode || $YAML::UseCode)
#      if defined $YAML::DumpCode or defined $YAML::UseCode;
#    $self->use_block($YAML::UseBlock)
#      if defined $YAML::UseBlock;
#    $self->use_fold($YAML::UseFold)
#      if defined $YAML::UseFold;
#    $self->compress_series($YAML::CompressSeries)
#      if defined $YAML::CompressSeries;
#    $self->inline_series($YAML::InlineSeries)
#      if defined $YAML::InlineSeries;
#    $self->use_aliases($YAML::UseAliases)
#      if defined $YAML::UseAliases;
#    $self->purity($YAML::Purity)
#      if defined $YAML::Purity;
#    $self->stringify($YAML::Stringify)
#      if defined $YAML::Stringify;
#    $self->quote_numeric_strings($YAML::QuoteNumericStrings)
#      if defined $YAML::QuoteNumericStrings;
#}
#
#sub dump {
#    my $self = shift;
#    $self->die('dump() not implemented in this class.');
#}
#
#sub blessed {
#    my $self = shift;
#    my ($ref) = @_;
#    $ref = \$_[0] unless ref $ref;
#    my (undef, undef, $node_id) = YAML::Old::Mo::Object->node_info($ref);
#    $self->{blessed_map}->{$node_id};
#}
#
#sub bless {
#    my $self = shift;
#    my ($ref, $blessing) = @_;
#    my $ynode;
#    $ref = \$_[0] unless ref $ref;
#    my (undef, undef, $node_id) = YAML::Old::Mo::Object->node_info($ref);
#    if (not defined $blessing) {
#        $ynode = YAML::Old::Node->new($ref);
#    }
#    elsif (ref $blessing) {
#        $self->die() unless ynode($blessing);
#        $ynode = $blessing;
#    }
#    else {
#        no strict 'refs';
#        my $transfer = $blessing . "::yaml_dump";
#        $self->die() unless defined &{$transfer};
#        $ynode = &{$transfer}($ref);
#        $self->die() unless ynode($ynode);
#    }
#    $self->{blessed_map}->{$node_id} = $ynode;
#    my $object = ynode($ynode) or $self->die();
#    return $object;
#}
#
#1;
### YAML/Old/Error.pm ###
#package YAML::Old::Error;
#
#use YAML::Old::Mo;
#
#has 'code';
#has 'type' => default => sub {'Error'};
#has 'line';
#has 'document';
#has 'arguments' => default => sub {[]};
#
#my ($error_messages, %line_adjust);
#
#sub format_message {
#    my $self = shift;
#    my $output = 'YAML::Old ' . $self->type . ': ';
#    my $code = $self->code;
#    if ($error_messages->{$code}) {
#        $code = sprintf($error_messages->{$code}, @{$self->arguments});
#    }
#    $output .= $code . "\n";
#
#    $output .= '   Code: ' . $self->code . "\n"
#        if defined $self->code;
#    $output .= '   Line: ' . $self->line . "\n"
#        if defined $self->line;
#    $output .= '   Document: ' . $self->document . "\n"
#        if defined $self->document;
#    return $output;
#}
#
#sub error_messages {
#    $error_messages;
#}
#
#%$error_messages = map {s/^\s+//;s/\\n/\n/;$_} split "\n", <<'...';
#YAML_PARSE_ERR_BAD_CHARS
#  Invalid characters in stream. This parser only supports printable ASCII
#YAML_PARSE_ERR_BAD_MAJOR_VERSION
#  Can't parse a %s document with a 1.0 parser
#YAML_PARSE_WARN_BAD_MINOR_VERSION
#  Parsing a %s document with a 1.0 parser
#YAML_PARSE_WARN_MULTIPLE_DIRECTIVES
#  '%s directive used more than once'
#YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
#  No text allowed after indicator
#YAML_PARSE_ERR_NO_ANCHOR
#  No anchor for alias '*%s'
#YAML_PARSE_ERR_NO_SEPARATOR
#  Expected separator '---'
#YAML_PARSE_ERR_SINGLE_LINE
#  Couldn't parse single line value
#YAML_PARSE_ERR_BAD_ANCHOR
#  Invalid anchor
#YAML_DUMP_ERR_INVALID_INDENT
#  Invalid Indent width specified: '%s'
#YAML_LOAD_USAGE
#  usage: YAML::Old::Load($yaml_stream_scalar)
#YAML_PARSE_ERR_BAD_NODE
#  Can't parse node
#YAML_PARSE_ERR_BAD_EXPLICIT
#  Unsupported explicit transfer: '%s'
#YAML_DUMP_USAGE_DUMPCODE
#  Invalid value for DumpCode: '%s'
#YAML_LOAD_ERR_FILE_INPUT
#  Couldn't open %s for input:\n%s
#YAML_DUMP_ERR_FILE_CONCATENATE
#  Can't concatenate to YAML file %s
#YAML_DUMP_ERR_FILE_OUTPUT
#  Couldn't open %s for output:\n%s
#YAML_DUMP_ERR_FILE_OUTPUT_CLOSE
#  Error closing %s:\n%s
#YAML_DUMP_ERR_NO_HEADER
#  With UseHeader=0, the node must be a plain hash or array
#YAML_DUMP_WARN_BAD_NODE_TYPE
#  Can't perform serialization for node type: '%s'
#YAML_EMIT_WARN_KEYS
#  Encountered a problem with 'keys':\n%s
#YAML_DUMP_WARN_DEPARSE_FAILED
#  Deparse failed for CODE reference
#YAML_DUMP_WARN_CODE_DUMMY
#  Emitting dummy subroutine for CODE reference
#YAML_PARSE_ERR_MANY_EXPLICIT
#  More than one explicit transfer
#YAML_PARSE_ERR_MANY_IMPLICIT
#  More than one implicit request
#YAML_PARSE_ERR_MANY_ANCHOR
#  More than one anchor
#YAML_PARSE_ERR_ANCHOR_ALIAS
#  Can't define both an anchor and an alias
#YAML_PARSE_ERR_BAD_ALIAS
#  Invalid alias
#YAML_PARSE_ERR_MANY_ALIAS
#  More than one alias
#YAML_LOAD_ERR_NO_CONVERT
#  Can't convert implicit '%s' node to explicit '%s' node
#YAML_LOAD_ERR_NO_DEFAULT_VALUE
#  No default value for '%s' explicit transfer
#YAML_LOAD_ERR_NON_EMPTY_STRING
#  Only the empty string can be converted to a '%s'
#YAML_LOAD_ERR_BAD_MAP_TO_SEQ
#  Can't transfer map as sequence. Non numeric key '%s' encountered.
#YAML_DUMP_ERR_BAD_GLOB
#  '%s' is an invalid value for Perl glob
#YAML_DUMP_ERR_BAD_REGEXP
#  '%s' is an invalid value for Perl Regexp
#YAML_LOAD_ERR_BAD_MAP_ELEMENT
#  Invalid element in map
#YAML_LOAD_WARN_DUPLICATE_KEY
#  Duplicate map key '%s' found. Ignoring.
#YAML_LOAD_ERR_BAD_SEQ_ELEMENT
#  Invalid element in sequence
#YAML_PARSE_ERR_INLINE_MAP
#  Can't parse inline map
#YAML_PARSE_ERR_INLINE_SEQUENCE
#  Can't parse inline sequence
#YAML_PARSE_ERR_BAD_DOUBLE
#  Can't parse double quoted string
#YAML_PARSE_ERR_BAD_SINGLE
#  Can't parse single quoted string
#YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
#  Can't parse inline implicit value '%s'
#YAML_PARSE_ERR_BAD_IMPLICIT
#  Unrecognized implicit value '%s'
#YAML_PARSE_ERR_INDENTATION
#  Error. Invalid indentation level
#YAML_PARSE_ERR_INCONSISTENT_INDENTATION
#  Inconsistent indentation level
#YAML_LOAD_WARN_UNRESOLVED_ALIAS
#  Can't resolve alias *%s
#YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
#  No 'REGEXP' element for Perl regexp
#YAML_LOAD_WARN_BAD_REGEXP_ELEM
#  Unknown element '%s' in Perl regexp
#YAML_LOAD_WARN_GLOB_NAME
#  No 'NAME' element for Perl glob
#YAML_LOAD_WARN_PARSE_CODE
#  Couldn't parse Perl code scalar: %s
#YAML_LOAD_WARN_CODE_DEPARSE
#  Won't parse Perl code unless $YAML::LoadCode is set
#YAML_EMIT_ERR_BAD_LEVEL
#  Internal Error: Bad level detected
#YAML_PARSE_WARN_AMBIGUOUS_TAB
#  Amibiguous tab converted to spaces
#YAML_LOAD_WARN_BAD_GLOB_ELEM
#  Unknown element '%s' in Perl glob
#YAML_PARSE_ERR_ZERO_INDENT
#  Can't use zero as an indentation width
#YAML_LOAD_WARN_GLOB_IO
#  Can't load an IO filehandle. Yet!!!
#...
#
#%line_adjust = map {($_, 1)}
#  qw(YAML_PARSE_ERR_BAD_MAJOR_VERSION
#     YAML_PARSE_WARN_BAD_MINOR_VERSION
#     YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
#     YAML_PARSE_ERR_NO_ANCHOR
#     YAML_PARSE_ERR_MANY_EXPLICIT
#     YAML_PARSE_ERR_MANY_IMPLICIT
#     YAML_PARSE_ERR_MANY_ANCHOR
#     YAML_PARSE_ERR_ANCHOR_ALIAS
#     YAML_PARSE_ERR_BAD_ALIAS
#     YAML_PARSE_ERR_MANY_ALIAS
#     YAML_LOAD_ERR_NO_CONVERT
#     YAML_LOAD_ERR_NO_DEFAULT_VALUE
#     YAML_LOAD_ERR_NON_EMPTY_STRING
#     YAML_LOAD_ERR_BAD_MAP_TO_SEQ
#     YAML_LOAD_ERR_BAD_STR_TO_INT
#     YAML_LOAD_ERR_BAD_STR_TO_DATE
#     YAML_LOAD_ERR_BAD_STR_TO_TIME
#     YAML_LOAD_WARN_DUPLICATE_KEY
#     YAML_PARSE_ERR_INLINE_MAP
#     YAML_PARSE_ERR_INLINE_SEQUENCE
#     YAML_PARSE_ERR_BAD_DOUBLE
#     YAML_PARSE_ERR_BAD_SINGLE
#     YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
#     YAML_PARSE_ERR_BAD_IMPLICIT
#     YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
#     YAML_LOAD_WARN_BAD_REGEXP_ELEM
#     YAML_LOAD_WARN_REGEXP_CREATE
#     YAML_LOAD_WARN_GLOB_NAME
#     YAML_LOAD_WARN_PARSE_CODE
#     YAML_LOAD_WARN_CODE_DEPARSE
#     YAML_LOAD_WARN_BAD_GLOB_ELEM
#     YAML_PARSE_ERR_ZERO_INDENT
#    );
#
#package YAML::Old::Warning;
#
#our @ISA = 'YAML::Old::Error';
#
#1;
### YAML/Old/Loader.pm ###
#package YAML::Old::Loader;
#
#use YAML::Old::Mo;
#extends 'YAML::Old::Loader::Base';
#
#use YAML::Old::Loader::Base;
#use YAML::Old::Types;
#use YAML::Old::Node;
#
## Context constants
#use constant LEAF       => 1;
#use constant COLLECTION => 2;
#use constant VALUE      => "\x07YAML\x07VALUE\x07";
#use constant COMMENT    => "\x07YAML\x07COMMENT\x07";
#
## Common YAML character sets
#my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
#my $FOLD_CHAR   = '>';
#my $LIT_CHAR    = '|';
#my $LIT_CHAR_RX = "\\$LIT_CHAR";
#
#sub load {
#    my $self = shift;
#    $self->stream($_[0] || '');
#    return $self->_parse();
#}
#
## Top level function for parsing. Parse each document in order and
## handle processing for YAML headers.
#sub _parse {
#    my $self = shift;
#    my (%directives, $preface);
#    $self->{stream} =~ s|\015\012|\012|g;
#    $self->{stream} =~ s|\015|\012|g;
#    $self->line(0);
#    $self->die('YAML_PARSE_ERR_BAD_CHARS')
#      if $self->stream =~ /$ESCAPE_CHAR/;
#    $self->{stream} =~ s/(.)\n\Z/$1/s;
#    $self->lines([split /\x0a/, $self->stream, -1]);
#    $self->line(1);
#    # Throw away any comments or blanks before the header (or start of
#    # content for headerless streams)
#    $self->_parse_throwaway_comments();
#    $self->document(0);
#    $self->documents([]);
#    # Add an "assumed" header if there is no header and the stream is
#    # not empty (after initial throwaways).
#    if (not $self->eos) {
#        if ($self->lines->[0] !~ /^---(\s|$)/) {
#            unshift @{$self->lines}, '---';
#            $self->{line}--;
#        }
#    }
#
#    # Main Loop. Parse out all the top level nodes and return them.
#    while (not $self->eos) {
#        $self->anchor2node({});
#        $self->{document}++;
#        $self->done(0);
#        $self->level(0);
#        $self->offset->[0] = -1;
#
#        if ($self->lines->[0] =~ /^---\s*(.*)$/) {
#            my @words = split /\s+/, $1;
#            %directives = ();
#            while (@words && $words[0] =~ /^#(\w+):(\S.*)$/) {
#                my ($key, $value) = ($1, $2);
#                shift(@words);
#                if (defined $directives{$key}) {
#                    $self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',
#                      $key, $self->document);
#                    next;
#                }
#                $directives{$key} = $value;
#            }
#            $self->preface(join ' ', @words);
#        }
#        else {
#            $self->die('YAML_PARSE_ERR_NO_SEPARATOR');
#        }
#
#        if (not $self->done) {
#            $self->_parse_next_line(COLLECTION);
#        }
#        if ($self->done) {
#            $self->{indent} = -1;
#            $self->content('');
#        }
#
#        $directives{YAML} ||= '1.0';
#        $directives{TAB} ||= 'NONE';
#        ($self->{major_version}, $self->{minor_version}) =
#          split /\./, $directives{YAML}, 2;
#        $self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION', $directives{YAML})
#          if $self->major_version ne '1';
#        $self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION', $directives{YAML})
#          if $self->minor_version ne '0';
#        $self->die('Unrecognized TAB policy')
#          unless $directives{TAB} =~ /^(NONE|\d+)(:HARD)?$/;
#
#        push @{$self->documents}, $self->_parse_node();
#    }
#    return wantarray ? @{$self->documents} : $self->documents->[-1];
#}
#
## This function is the dispatcher for parsing each node. Every node
## recurses back through here. (Inlines are an exception as they have
## their own sub-parser.)
#sub _parse_node {
#    my $self = shift;
#    my $preface = $self->preface;
#    $self->preface('');
#    my ($node, $type, $indicator, $escape, $chomp) = ('') x 5;
#    my ($anchor, $alias, $explicit, $implicit, $class) = ('') x 5;
#    ($anchor, $alias, $explicit, $implicit, $preface) =
#      $self->_parse_qualifiers($preface);
#    if ($anchor) {
#        $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
#    }
#    $self->inline('');
#    while (length $preface) {
#        my $line = $self->line - 1;
#        if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
#            $indicator = $1;
#            $chomp = $2 if defined($2);
#        }
#        else {
#            $self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR') if $indicator;
#            $self->inline($preface);
#            $preface = '';
#        }
#    }
#    if ($alias) {
#        $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
#          unless defined $self->anchor2node->{$alias};
#        if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
#            $node = $self->anchor2node->{$alias};
#        }
#        else {
#            $node = do {my $sv = "*$alias"};
#            push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
#        }
#    }
#    elsif (length $self->inline) {
#        $node = $self->_parse_inline(1, $implicit, $explicit);
#        if (length $self->inline) {
#            $self->die('YAML_PARSE_ERR_SINGLE_LINE');
#        }
#    }
#    elsif ($indicator eq $LIT_CHAR) {
#        $self->{level}++;
#        $node = $self->_parse_block($chomp);
#        $node = $self->_parse_implicit($node) if $implicit;
#        $self->{level}--;
#    }
#    elsif ($indicator eq $FOLD_CHAR) {
#        $self->{level}++;
#        $node = $self->_parse_unfold($chomp);
#        $node = $self->_parse_implicit($node) if $implicit;
#        $self->{level}--;
#    }
#    else {
#        $self->{level}++;
#        $self->offset->[$self->level] ||= 0;
#        if ($self->indent == $self->offset->[$self->level]) {
#            if ($self->content =~ /^-( |$)/) {
#                $node = $self->_parse_seq($anchor);
#            }
#            elsif ($self->content =~ /(^\?|\:( |$))/) {
#                $node = $self->_parse_mapping($anchor);
#            }
#            elsif ($preface =~ /^\s*$/) {
#                $node = $self->_parse_implicit('');
#            }
#            else {
#                $self->die('YAML_PARSE_ERR_BAD_NODE');
#            }
#        }
#        else {
#            $node = undef;
#        }
#        $self->{level}--;
#    }
#    $#{$self->offset} = $self->level;
#
#    if ($explicit) {
#        if ($class) {
#            if (not ref $node) {
#                my $copy = $node;
#                undef $node;
#                $node = \$copy;
#            }
#            CORE::bless $node, $class;
#        }
#        else {
#            $node = $self->_parse_explicit($node, $explicit);
#        }
#    }
#    if ($anchor) {
#        if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
#            # XXX Can't remember what this code actually does
#            for my $ref (@{$self->anchor2node->{$anchor}}) {
#                ${$ref->[0]} = $node;
#                $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
#                    $anchor, $ref->[1]);
#            }
#        }
#        $self->anchor2node->{$anchor} = $node;
#    }
#    return $node;
#}
#
## Preprocess the qualifiers that may be attached to any node.
#sub _parse_qualifiers {
#    my $self = shift;
#    my ($preface) = @_;
#    my ($anchor, $alias, $explicit, $implicit, $token) = ('') x 5;
#    $self->inline('');
#    while ($preface =~ /^[&*!]/) {
#        my $line = $self->line - 1;
#        if ($preface =~ s/^\!(\S+)\s*//) {
#            $self->die('YAML_PARSE_ERR_MANY_EXPLICIT') if $explicit;
#            $explicit = $1;
#        }
#        elsif ($preface =~ s/^\!\s*//) {
#            $self->die('YAML_PARSE_ERR_MANY_IMPLICIT') if $implicit;
#            $implicit = 1;
#        }
#        elsif ($preface =~ s/^\&([^ ,:]*)\s*//) {
#            $token = $1;
#            $self->die('YAML_PARSE_ERR_BAD_ANCHOR')
#              unless $token =~ /^[a-zA-Z0-9]+$/;
#            $self->die('YAML_PARSE_ERR_MANY_ANCHOR') if $anchor;
#            $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $alias;
#            $anchor = $token;
#        }
#        elsif ($preface =~ s/^\*([^ ,:]*)\s*//) {
#            $token = $1;
#            $self->die('YAML_PARSE_ERR_BAD_ALIAS')
#              unless $token =~ /^[a-zA-Z0-9]+$/;
#            $self->die('YAML_PARSE_ERR_MANY_ALIAS') if $alias;
#            $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $anchor;
#            $alias = $token;
#        }
#    }
#    return ($anchor, $alias, $explicit, $implicit, $preface);
#}
#
## Morph a node to it's explicit type
#sub _parse_explicit {
#    my $self = shift;
#    my ($node, $explicit) = @_;
#    my ($type, $class);
#    if ($explicit =~ /^\!?perl\/(hash|array|ref|scalar)(?:\:(\w(\w|\:\:)*)?)?$/) {
#        ($type, $class) = (($1 || ''), ($2 || ''));
#
#        # FIXME # die unless uc($type) eq ref($node) ?
#
#        if ( $type eq "ref" ) {
#            $self->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'XXX', $explicit)
#            unless exists $node->{VALUE()} and scalar(keys %$node) == 1;
#
#            my $value = $node->{VALUE()};
#            $node = \$value;
#        }
#
#        if ( $type eq "scalar" and length($class) and !ref($node) ) {
#            my $value = $node;
#            $node = \$value;
#        }
#
#        if ( length($class) ) {
#            CORE::bless($node, $class);
#        }
#
#        return $node;
#    }
#    if ($explicit =~ m{^!?perl/(glob|regexp|code)(?:\:(\w(\w|\:\:)*)?)?$}) {
#        ($type, $class) = (($1 || ''), ($2 || ''));
#        my $type_class = "YAML::Old::Type::$type";
#        no strict 'refs';
#        if ($type_class->can('yaml_load')) {
#            return $type_class->yaml_load($node, $class, $self);
#        }
#        else {
#            $self->die('YAML_LOAD_ERR_NO_CONVERT', 'XXX', $explicit);
#        }
#    }
#    # This !perl/@Foo and !perl/$Foo are deprecated but still parsed
#    elsif ($YAML::TagClass->{$explicit} ||
#           $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}
#          ) {
#        $class = $YAML::TagClass->{$explicit} || $2;
#        if ($class->can('yaml_load')) {
#            require YAML::Old::Node;
#            return $class->yaml_load(YAML::Old::Node->new($node, $explicit));
#        }
#        else {
#            if (ref $node) {
#                return CORE::bless $node, $class;
#            }
#            else {
#                return CORE::bless \$node, $class;
#            }
#        }
#    }
#    elsif (ref $node) {
#        require YAML::Old::Node;
#        return YAML::Old::Node->new($node, $explicit);
#    }
#    else {
#        # XXX This is likely wrong. Failing test:
#        # --- !unknown 'scalar value'
#        return $node;
#    }
#}
#
## Parse a YAML mapping into a Perl hash
#sub _parse_mapping {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $mapping = $self->preserve ? YAML::Old::Node->new({}) : {};
#    $self->anchor2node->{$anchor} = $mapping;
#    my $key;
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        # If structured key:
#        if ($self->{content} =~ s/^\?\s*//) {
#            $self->preface($self->content);
#            $self->_parse_next_line(COLLECTION);
#            $key = $self->_parse_node();
#            $key = "$key";
#        }
#        # If "default" key (equals sign)
#        elsif ($self->{content} =~ s/^\=\s*//) {
#            $key = VALUE;
#        }
#        # If "comment" key (slash slash)
#        elsif ($self->{content} =~ s/^\=\s*//) {
#            $key = COMMENT;
#        }
#        # Regular scalar key:
#        else {
#            $self->inline($self->content);
#            $key = $self->_parse_inline();
#            $key = "$key";
#            $self->content($self->inline);
#            $self->inline('');
#        }
#
#        unless ($self->{content} =~ s/^:\s*//) {
#            $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
#        }
#        $self->preface($self->content);
#        my $line = $self->line;
#        $self->_parse_next_line(COLLECTION);
#        my $value = $self->_parse_node();
#        if (exists $mapping->{$key}) {
#            $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY', $key);
#        }
#        else {
#            $mapping->{$key} = $value;
#        }
#    }
#    return $mapping;
#}
#
## Parse a YAML sequence into a Perl array
#sub _parse_seq {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $seq = [];
#    $self->anchor2node->{$anchor} = $seq;
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        if ($self->content =~ /^-(?: (.*))?$/) {
#            $self->preface(defined($1) ? $1 : '');
#        }
#        else {
#            $self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT');
#        }
#
#        # Check whether the preface looks like a YAML mapping ("key: value").
#        # This is complicated because it has to account for the possibility
#        # that a key is a quoted string, which itself may contain escaped
#        # quotes.
#        my $preface = $self->preface;
#        if ( $preface =~ /^ (\s*) ( \w .*?               \: (?:\ |$).*) $/x  or
#             $preface =~ /^ (\s*) ((') (?:''|[^'])*? ' \s* \: (?:\ |$).*) $/x or
#             $preface =~ /^ (\s*) ((") (?:\\\\|[^"])*? " \s* \: (?:\ |$).*) $/x
#           ) {
#            $self->indent($self->offset->[$self->level] + 2 + length($1));
#            $self->content($2);
#            $self->level($self->level + 1);
#            $self->offset->[$self->level] = $self->indent;
#            $self->preface('');
#            push @$seq, $self->_parse_mapping('');
#            $self->{level}--;
#            $#{$self->offset} = $self->level;
#        }
#        else {
#            $self->_parse_next_line(COLLECTION);
#            push @$seq, $self->_parse_node();
#        }
#    }
#    return $seq;
#}
#
## Parse an inline value. Since YAML supports inline collections, this is
## the top level of a sub parsing.
#sub _parse_inline {
#    my $self = shift;
#    my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
#    $self->{inline} =~ s/^\s*(.*)\s*$/$1/; # OUCH - mugwump
#    my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
#    ($anchor, $alias, $explicit, $implicit, $self->{inline}) =
#      $self->_parse_qualifiers($self->inline);
#    if ($anchor) {
#        $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
#    }
#    $implicit ||= $top_implicit;
#    $explicit ||= $top_explicit;
#    ($top_implicit, $top_explicit) = ('', '');
#    if ($alias) {
#        $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
#          unless defined $self->anchor2node->{$alias};
#        if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
#            $node = $self->anchor2node->{$alias};
#        }
#        else {
#            $node = do {my $sv = "*$alias"};
#            push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
#        }
#    }
#    elsif ($self->inline =~ /^\{/) {
#        $node = $self->_parse_inline_mapping($anchor);
#    }
#    elsif ($self->inline =~ /^\[/) {
#        $node = $self->_parse_inline_seq($anchor);
#    }
#    elsif ($self->inline =~ /^"/) {
#        $node = $self->_parse_inline_double_quoted();
#        $node = $self->_unescape($node);
#        $node = $self->_parse_implicit($node) if $implicit;
#    }
#    elsif ($self->inline =~ /^'/) {
#        $node = $self->_parse_inline_single_quoted();
#        $node = $self->_parse_implicit($node) if $implicit;
#    }
#    else {
#        if ($top) {
#            $node = $self->inline;
#            $self->inline('');
#        }
#        else {
#            $node = $self->_parse_inline_simple();
#        }
#        $node = $self->_parse_implicit($node) unless $explicit;
#
#        if ($self->numify and defined $node and not ref $node and length $node
#            and $node =~ m/\A-?(?:0|[1-9][0-9]*)?(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?\z/) {
#            $node += 0;
#        }
#    }
#    if ($explicit) {
#        $node = $self->_parse_explicit($node, $explicit);
#    }
#    if ($anchor) {
#        if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
#            for my $ref (@{$self->anchor2node->{$anchor}}) {
#                ${$ref->[0]} = $node;
#                $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
#                    $anchor, $ref->[1]);
#            }
#        }
#        $self->anchor2node->{$anchor} = $node;
#    }
#    return $node;
#}
#
## Parse the inline YAML mapping into a Perl hash
#sub _parse_inline_mapping {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $node = {};
#    $self->anchor2node->{$anchor} = $node;
#
#    $self->die('YAML_PARSE_ERR_INLINE_MAP')
#      unless $self->{inline} =~ s/^\{\s*//;
#    while (not $self->{inline} =~ s/^\s*\}\s*//) {
#        my $key = $self->_parse_inline();
#        $self->die('YAML_PARSE_ERR_INLINE_MAP')
#          unless $self->{inline} =~ s/^\: \s*//;
#        my $value = $self->_parse_inline();
#        if (exists $node->{$key}) {
#            $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY', $key);
#        }
#        else {
#            $node->{$key} = $value;
#        }
#        next if $self->inline =~ /^\s*\}/;
#        $self->die('YAML_PARSE_ERR_INLINE_MAP')
#          unless $self->{inline} =~ s/^\,\s*//;
#    }
#    return $node;
#}
#
## Parse the inline YAML sequence into a Perl array
#sub _parse_inline_seq {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $node = [];
#    $self->anchor2node->{$anchor} = $node;
#
#    $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
#      unless $self->{inline} =~ s/^\[\s*//;
#    while (not $self->{inline} =~ s/^\s*\]\s*//) {
#        my $value = $self->_parse_inline();
#        push @$node, $value;
#        next if $self->inline =~ /^\s*\]/;
#        $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
#          unless $self->{inline} =~ s/^\,\s*//;
#    }
#    return $node;
#}
#
## Parse the inline double quoted string.
#sub _parse_inline_double_quoted {
#    my $self = shift;
#    my $node;
#    # https://rt.cpan.org/Public/Bug/Display.html?id=90593
#    if ($self->inline =~ /^"((?:(?:\\"|[^"]){0,32766}){0,32766})"\s*(.*)$/) {
#        $node = $1;
#        $self->inline($2);
#        $node =~ s/\\"/"/g;
#    }
#    else {
#        $self->die('YAML_PARSE_ERR_BAD_DOUBLE');
#    }
#    return $node;
#}
#
#
## Parse the inline single quoted string.
#sub _parse_inline_single_quoted {
#    my $self = shift;
#    my $node;
#    if ($self->inline =~ /^'((?:(?:''|[^']){0,32766}){0,32766})'\s*(.*)$/) {
#        $node = $1;
#        $self->inline($2);
#        $node =~ s/''/'/g;
#    }
#    else {
#        $self->die('YAML_PARSE_ERR_BAD_SINGLE');
#    }
#    return $node;
#}
#
## Parse the inline unquoted string and do implicit typing.
#sub _parse_inline_simple {
#    my $self = shift;
#    my $value;
#    if ($self->inline =~ /^(|[^!@#%^&*].*?)(?=[\[\]\{\},]|, |: |- |:\s*$|$)/) {
#        $value = $1;
#        substr($self->{inline}, 0, length($1)) = '';
#    }
#    else {
#        $self->die('YAML_PARSE_ERR_BAD_INLINE_IMPLICIT', $value);
#    }
#    return $value;
#}
#
#sub _parse_implicit {
#    my $self = shift;
#    my ($value) = @_;
#    $value =~ s/\s*$//;
#    return $value if $value eq '';
#    return undef if $value =~ /^~$/;
#    return $value
#      unless $value =~ /^[\@\`]/ or
#             $value =~ /^[\-\?]\s/;
#    $self->die('YAML_PARSE_ERR_BAD_IMPLICIT', $value);
#}
#
## Unfold a YAML multiline scalar into a single string.
#sub _parse_unfold {
#    my $self = shift;
#    my ($chomp) = @_;
#    my $node = '';
#    my $space = 0;
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        $node .= $self->content. "\n";
#        $self->_parse_next_line(LEAF);
#    }
#    $node =~ s/^(\S.*)\n(?=\S)/$1 /gm;
#    $node =~ s/^(\S.*)\n(\n+\S)/$1$2/gm;
#    $node =~ s/\n*\Z// unless $chomp eq '+';
#    $node .= "\n" unless $chomp;
#    return $node;
#}
#
## Parse a YAML block style scalar. This is like a Perl here-document.
#sub _parse_block {
#    my $self = shift;
#    my ($chomp) = @_;
#    my $node = '';
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        $node .= $self->content . "\n";
#        $self->_parse_next_line(LEAF);
#    }
#    return $node if '+' eq $chomp;
#    $node =~ s/\n*\Z/\n/;
#    $node =~ s/\n\Z// if $chomp eq '-';
#    return $node;
#}
#
## Handle Perl style '#' comments. Comments must be at the same indentation
## level as the collection line following them.
#sub _parse_throwaway_comments {
#    my $self = shift;
#    while (@{$self->lines} and
#           $self->lines->[0] =~ m{^\s*(\#|$)}
#          ) {
#        shift @{$self->lines};
#        $self->{line}++;
#    }
#    $self->eos($self->{done} = not @{$self->lines});
#}
#
## This is the routine that controls what line is being parsed. It gets called
## once for each line in the YAML stream.
##
## This routine must:
## 1) Skip past the current line
## 2) Determine the indentation offset for a new level
## 3) Find the next _content_ line
##   A) Skip over any throwaways (Comments/blanks)
##   B) Set $self->indent, $self->content, $self->line
## 4) Expand tabs appropriately
#sub _parse_next_line {
#    my $self = shift;
#    my ($type) = @_;
#    my $level = $self->level;
#    my $offset = $self->offset->[$level];
#    $self->die('YAML_EMIT_ERR_BAD_LEVEL') unless defined $offset;
#    shift @{$self->lines};
#    $self->eos($self->{done} = not @{$self->lines});
#    if ($self->eos) {
#        $self->offset->[$level + 1] = $offset + 1;
#        return;
#    }
#    $self->{line}++;
#
#    # Determine the offset for a new leaf node
#    if ($self->preface =~
#        qr/(?:^|\s)(?:$FOLD_CHAR|$LIT_CHAR_RX)(?:-|\+)?(\d*)\s*$/
#       ) {
#        $self->die('YAML_PARSE_ERR_ZERO_INDENT')
#          if length($1) and $1 == 0;
#        $type = LEAF;
#        if (length($1)) {
#            $self->offset->[$level + 1] = $offset + $1;
#        }
#        else {
#            # First get rid of any comments.
#            while (@{$self->lines} && ($self->lines->[0] =~ /^\s*#/)) {
#                $self->lines->[0] =~ /^( *)/;
#                last unless length($1) <= $offset;
#                shift @{$self->lines};
#                $self->{line}++;
#            }
#            $self->eos($self->{done} = not @{$self->lines});
#            return if $self->eos;
#            if ($self->lines->[0] =~ /^( *)\S/ and length($1) > $offset) {
#                $self->offset->[$level+1] = length($1);
#            }
#            else {
#                $self->offset->[$level+1] = $offset + 1;
#            }
#        }
#        $offset = $self->offset->[++$level];
#    }
#    # Determine the offset for a new collection level
#    elsif ($type == COLLECTION and
#           $self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/) {
#        $self->_parse_throwaway_comments();
#        if ($self->eos) {
#            $self->offset->[$level+1] = $offset + 1;
#            return;
#        }
#        else {
#            $self->lines->[0] =~ /^( *)\S/ or
#                $self->die('YAML_PARSE_ERR_NONSPACE_INDENTATION');
#            if (length($1) > $offset) {
#                $self->offset->[$level+1] = length($1);
#            }
#            else {
#                $self->offset->[$level+1] = $offset + 1;
#            }
#        }
#        $offset = $self->offset->[++$level];
#    }
#
#    if ($type == LEAF) {
#        while (@{$self->lines} and
#               $self->lines->[0] =~ m{^( *)(\#)} and
#               length($1) < $offset
#              ) {
#            shift @{$self->lines};
#            $self->{line}++;
#        }
#        $self->eos($self->{done} = not @{$self->lines});
#    }
#    else {
#        $self->_parse_throwaway_comments();
#    }
#    return if $self->eos;
#
#    if ($self->lines->[0] =~ /^---(\s|$)/) {
#        $self->done(1);
#        return;
#    }
#    if ($type == LEAF and
#        $self->lines->[0] =~ /^ {$offset}(.*)$/
#       ) {
#        $self->indent($offset);
#        $self->content($1);
#    }
#    elsif ($self->lines->[0] =~ /^\s*$/) {
#        $self->indent($offset);
#        $self->content('');
#    }
#    else {
#        $self->lines->[0] =~ /^( *)(\S.*)$/;
#        while ($self->offset->[$level] > length($1)) {
#            $level--;
#        }
#        $self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
#          if $self->offset->[$level] != length($1);
#        $self->indent(length($1));
#        $self->content($2);
#    }
#    $self->die('YAML_PARSE_ERR_INDENTATION')
#      if $self->indent - $offset > 1;
#}
#
##==============================================================================
## Utility subroutines.
##==============================================================================
#
## Printable characters for escapes
#my %unescapes = (
#   0 => "\x00",
#   a => "\x07",
#   t => "\x09",
#   n => "\x0a",
#   'v' => "\x0b", # Potential v-string error on 5.6.2 if not quoted
#   f => "\x0c",
#   r => "\x0d",
#   e => "\x1b",
#   '\\' => '\\',
#  );
#
## Transform all the backslash style escape characters to their literal meaning
#sub _unescape {
#    my $self = shift;
#    my ($node) = @_;
#    $node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/
#              (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;
#    return $node;
#}
#
#1;
### YAML/Old/Loader/Base.pm ###
#package YAML::Old::Loader::Base;
#
#use YAML::Old::Mo;
#
#has load_code     => default => sub {0};
#has preserve      => default => sub {0};
#has stream        => default => sub {''};
#has document      => default => sub {0};
#has line          => default => sub {0};
#has documents     => default => sub {[]};
#has lines         => default => sub {[]};
#has eos           => default => sub {0};
#has done          => default => sub {0};
#has anchor2node   => default => sub {{}};
#has level         => default => sub {0};
#has offset        => default => sub {[]};
#has preface       => default => sub {''};
#has content       => default => sub {''};
#has indent        => default => sub {0};
#has major_version => default => sub {0};
#has minor_version => default => sub {0};
#has inline        => default => sub {''};
#has numify        => default => sub {0};
#
#sub set_global_options {
#    my $self = shift;
#    $self->load_code($YAML::LoadCode || $YAML::UseCode)
#      if defined $YAML::LoadCode or defined $YAML::UseCode;
#    $self->preserve($YAML::Preserve) if defined $YAML::Preserve;
#    $self->numify($YAML::Numify) if defined $YAML::Numify;
#}
#
#sub load {
#    die 'load() not implemented in this class.';
#}
#
#1;
### YAML/Old/Marshall.pm ###
#use strict; use warnings;
#package YAML::Old::Marshall;
#
#use YAML::Old::Node ();
#
#sub import {
#    my $class = shift;
#    no strict 'refs';
#    my $package = caller;
#    unless (grep { $_ eq $class} @{$package . '::ISA'}) {
#        push @{$package . '::ISA'}, $class;
#    }
#
#    my $tag = shift;
#    if ( $tag ) {
#        no warnings 'once';
#        $YAML::TagClass->{$tag} = $package;
#        ${$package . "::YamlTag"} = $tag;
#    }
#}
#
#sub yaml_dump {
#    my $self = shift;
#    no strict 'refs';
#    my $tag = ${ref($self) . "::YamlTag"} || 'perl/' . ref($self);
#    $self->yaml_node($self, $tag);
#}
#
#sub yaml_load {
#    my ($class, $node) = @_;
#    if (my $ynode = $class->yaml_ynode($node)) {
#        $node = $ynode->{NODE};
#    }
#    bless $node, $class;
#}
#
#sub yaml_node {
#    shift;
#    YAML::Old::Node->new(@_);
#}
#
#sub yaml_ynode {
#    shift;
#    YAML::Old::Node::ynode(@_);
#}
#
#1;
### YAML/Old/Mo.pm ###
#package YAML::Old::Mo;
## use Mo qw[builder default import];
##   The following line of code was produced from the previous line by
##   Mo::Inline version 0.40
#no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};@_=(default,@_)if!($#_%2);$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=\&{$P.$b}and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;exists$a{default}or return$m;my($d,$r)=$a{default};my$g='HASH'eq($r=ref$d)?sub{+{%$d}}:'ARRAY'eq$r?sub{[@$d]}:'CODE'eq$r?$d:sub{$d};my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=$g and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$g->(@_):$m->(@_)}}};my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};@f=qw[builder default import];use strict;use warnings;
#
#our $DumperModule = 'Data::Dumper';
#
#my ($_new_error, $_info, $_scalar_info);
#
#no strict 'refs';
#*{$M.'Object::die'} = sub {
#    my $self = shift;
#    my $error = $self->$_new_error(@_);
#    $error->type('Error');
#    Carp::croak($error->format_message);
#};
#
#*{$M.'Object::warn'} = sub {
#    my $self = shift;
#    return unless $^W;
#    my $error = $self->$_new_error(@_);
#    $error->type('Warning');
#    Carp::cluck($error->format_message);
#};
#
## This code needs to be refactored to be simpler and more precise, and no,
## Scalar::Util doesn't DWIM.
##
## Can't handle:
## * blessed regexp
#*{$M.'Object::node_info'} = sub {
#    my $self = shift;
#    my $stringify = $_[1] || 0;
#    my ($class, $type, $id) =
#        ref($_[0])
#        ? $stringify
#          ? &$_info("$_[0]")
#          : do {
#              require overload;
#              my @info = &$_info(overload::StrVal($_[0]));
#              if (ref($_[0]) eq 'Regexp') {
#                  @info[0, 1] = (undef, 'REGEXP');
#              }
#              @info;
#          }
#        : &$_scalar_info($_[0]);
#    ($class, $type, $id) = &$_scalar_info("$_[0]")
#        unless $id;
#    return wantarray ? ($class, $type, $id) : $id;
#};
#
##-------------------------------------------------------------------------------
#$_info = sub {
#    return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o);
#};
#
#$_scalar_info = sub {
#    my $id = 'undef';
#    if (defined $_[0]) {
#        \$_[0] =~ /\((\w+)\)$/o or CORE::die();
#        $id = "$1-S";
#    }
#    return (undef, undef, $id);
#};
#
#$_new_error = sub {
#    require Carp;
#    my $self = shift;
#    require YAML::Old::Error;
#
#    my $code = shift || 'unknown error';
#    my $error = YAML::Old::Error->new(code => $code);
#    $error->line($self->line) if $self->can('line');
#    $error->document($self->document) if $self->can('document');
#    $error->arguments([@_]);
#    return $error;
#};
#
#1;
### YAML/Old/Node.pm ###
#use strict; use warnings;
#package YAML::Old::Node;
#
#use YAML::Old::Tag;
#require YAML::Old::Mo;
#
#use Exporter;
#our @ISA     = qw(Exporter YAML::Old::Mo::Object);
#our @EXPORT  = qw(ynode);
#
#sub ynode {
#    my $self;
#    if (ref($_[0]) eq 'HASH') {
#        $self = tied(%{$_[0]});
#    }
#    elsif (ref($_[0]) eq 'ARRAY') {
#        $self = tied(@{$_[0]});
#    }
#    elsif (ref(\$_[0]) eq 'GLOB') {
#        $self = tied(*{$_[0]});
#    }
#    else {
#        $self = tied($_[0]);
#    }
#    return (ref($self) =~ /^yaml_/) ? $self : undef;
#}
#
#sub new {
#    my ($class, $node, $tag) = @_;
#    my $self;
#    $self->{NODE} = $node;
#    my (undef, $type) = YAML::Old::Mo::Object->node_info($node);
#    $self->{KIND} = (not defined $type) ? 'scalar' :
#                    ($type eq 'ARRAY') ? 'sequence' :
#                    ($type eq 'HASH') ? 'mapping' :
#                    $class->die("Can't create YAML::Old::Node from '$type'");
#    tag($self, ($tag || ''));
#    if ($self->{KIND} eq 'scalar') {
#        yaml_scalar->new($self, $_[1]);
#        return \ $_[1];
#    }
#    my $package = "yaml_" . $self->{KIND};
#    $package->new($self)
#}
#
#sub node { $_->{NODE} }
#sub kind { $_->{KIND} }
#sub tag {
#    my ($self, $value) = @_;
#    if (defined $value) {
#               $self->{TAG} = YAML::Old::Tag->new($value);
#        return $self;
#    }
#    else {
#       return $self->{TAG};
#    }
#}
#sub keys {
#    my ($self, $value) = @_;
#    if (defined $value) {
#               $self->{KEYS} = $value;
#        return $self;
#    }
#    else {
#       return $self->{KEYS};
#    }
#}
#
##==============================================================================
#package yaml_scalar;
#
#@yaml_scalar::ISA = qw(YAML::Old::Node);
#
#sub new {
#    my ($class, $self) = @_;
#    tie $_[2], $class, $self;
#}
#
#sub TIESCALAR {
#    my ($class, $self) = @_;
#    bless $self, $class;
#    $self
#}
#
#sub FETCH {
#    my ($self) = @_;
#    $self->{NODE}
#}
#
#sub STORE {
#    my ($self, $value) = @_;
#    $self->{NODE} = $value
#}
#
##==============================================================================
#package yaml_sequence;
#
#@yaml_sequence::ISA = qw(YAML::Old::Node);
#
#sub new {
#    my ($class, $self) = @_;
#    my $new;
#    tie @$new, $class, $self;
#    $new
#}
#
#sub TIEARRAY {
#    my ($class, $self) = @_;
#    bless $self, $class
#}
#
#sub FETCHSIZE {
#    my ($self) = @_;
#    scalar @{$self->{NODE}};
#}
#
#sub FETCH {
#    my ($self, $index) = @_;
#    $self->{NODE}[$index]
#}
#
#sub STORE {
#    my ($self, $index, $value) = @_;
#    $self->{NODE}[$index] = $value
#}
#
#sub undone {
#    die "Not implemented yet"; # XXX
#}
#
#*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
#*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
#*undone; # XXX Must implement before release
#
##==============================================================================
#package yaml_mapping;
#
#@yaml_mapping::ISA = qw(YAML::Old::Node);
#
#sub new {
#    my ($class, $self) = @_;
#    @{$self->{KEYS}} = sort keys %{$self->{NODE}};
#    my $new;
#    tie %$new, $class, $self;
#    $new
#}
#
#sub TIEHASH {
#    my ($class, $self) = @_;
#    bless $self, $class
#}
#
#sub FETCH {
#    my ($self, $key) = @_;
#    if (exists $self->{NODE}{$key}) {
#        return (grep {$_ eq $key} @{$self->{KEYS}})
#               ? $self->{NODE}{$key} : undef;
#    }
#    return $self->{HASH}{$key};
#}
#
#sub STORE {
#    my ($self, $key, $value) = @_;
#    if (exists $self->{NODE}{$key}) {
#        $self->{NODE}{$key} = $value;
#    }
#    elsif (exists $self->{HASH}{$key}) {
#        $self->{HASH}{$key} = $value;
#    }
#    else {
#        if (not grep {$_ eq $key} @{$self->{KEYS}}) {
#            push(@{$self->{KEYS}}, $key);
#        }
#        $self->{HASH}{$key} = $value;
#    }
#    $value
#}
#
#sub DELETE {
#    my ($self, $key) = @_;
#    my $return;
#    if (exists $self->{NODE}{$key}) {
#        $return = $self->{NODE}{$key};
#    }
#    elsif (exists $self->{HASH}{$key}) {
#        $return = delete $self->{NODE}{$key};
#    }
#    for (my $i = 0; $i < @{$self->{KEYS}}; $i++) {
#        if ($self->{KEYS}[$i] eq $key) {
#            splice(@{$self->{KEYS}}, $i, 1);
#        }
#    }
#    return $return;
#}
#
#sub CLEAR {
#    my ($self) = @_;
#    @{$self->{KEYS}} = ();
#    %{$self->{HASH}} = ();
#}
#
#sub FIRSTKEY {
#    my ($self) = @_;
#    $self->{ITER} = 0;
#    $self->{KEYS}[0]
#}
#
#sub NEXTKEY {
#    my ($self) = @_;
#    $self->{KEYS}[++$self->{ITER}]
#}
#
#sub EXISTS {
#    my ($self, $key) = @_;
#    exists $self->{NODE}{$key}
#}
#
#1;
### YAML/Old/Tag.pm ###
#use strict; use warnings;
#package YAML::Old::Tag;
#
#use overload '""' => sub { ${$_[0]} };
#
#sub new {
#    my ($class, $self) = @_;
#    bless \$self, $class
#}
#
#sub short {
#    ${$_[0]}
#}
#
#sub canonical {
#    ${$_[0]}
#}
#
#1;
### YAML/Old/Types.pm ###
#package YAML::Old::Types;
#
#use YAML::Old::Mo;
#use YAML::Old::Node;
#
## XXX These classes and their APIs could still use some refactoring,
## but at least they work for now.
##-------------------------------------------------------------------------------
#package YAML::Old::Type::blessed;
#
#use YAML::Old::Mo; # XXX
#
#sub yaml_dump {
#    my $self = shift;
#    my ($value) = @_;
#    my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
#    no strict 'refs';
#    my $kind = lc($type) . ':';
#    my $tag = ${$class . '::ClassTag'} ||
#              "!perl/$kind$class";
#    if ($type eq 'REF') {
#        YAML::Old::Node->new(
#            {(&YAML::Old::VALUE, ${$_[0]})}, $tag
#        );
#    }
#    elsif ($type eq 'SCALAR') {
#        $_[1] = $$value;
#        YAML::Old::Node->new($_[1], $tag);
#    }
#    elsif ($type eq 'GLOB') {
#        # blessed glob support is minimal, and will not round-trip
#        # initial aim: to not cause an error
#        return YAML::Old::Type::glob->yaml_dump($value, $tag);
#    } else {
#        YAML::Old::Node->new($value, $tag);
#    }
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::undef;
#
#sub yaml_dump {
#    my $self = shift;
#}
#
#sub yaml_load {
#    my $self = shift;
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::glob;
#
#sub yaml_dump {
#    my $self = shift;
#    # $_[0] remains as the glob
#    my $tag = pop @_ if 2==@_;
#
#    $tag = '!perl/glob:' unless defined $tag;
#    my $ynode = YAML::Old::Node->new({}, $tag);
#    for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
#        my $value = *{$_[0]}{$type};
#        $value = $$value if $type eq 'SCALAR';
#        if (defined $value) {
#            if ($type eq 'IO') {
#                my @stats = qw(device inode mode links uid gid rdev size
#                               atime mtime ctime blksize blocks);
#                undef $value;
#                $value->{stat} = YAML::Old::Node->new({});
#                if ($value->{fileno} = fileno(*{$_[0]})) {
#                    local $^W;
#                    map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
#                    $value->{tell} = tell(*{$_[0]});
#                }
#            }
#            $ynode->{$type} = $value;
#        }
#    }
#    return $ynode;
#}
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class, $loader) = @_;
#    my ($name, $package);
#    if (defined $node->{NAME}) {
#        $name = $node->{NAME};
#        delete $node->{NAME};
#    }
#    else {
#        $loader->warn('YAML_LOAD_WARN_GLOB_NAME');
#        return undef;
#    }
#    if (defined $node->{PACKAGE}) {
#        $package = $node->{PACKAGE};
#        delete $node->{PACKAGE};
#    }
#    else {
#        $package = 'main';
#    }
#    no strict 'refs';
#    if (exists $node->{SCALAR}) {
#        *{"${package}::$name"} = \$node->{SCALAR};
#        delete $node->{SCALAR};
#    }
#    for my $elem (qw(ARRAY HASH CODE IO)) {
#        if (exists $node->{$elem}) {
#            if ($elem eq 'IO') {
#                $loader->warn('YAML_LOAD_WARN_GLOB_IO');
#                delete $node->{IO};
#                next;
#            }
#            *{"${package}::$name"} = $node->{$elem};
#            delete $node->{$elem};
#        }
#    }
#    for my $elem (sort keys %$node) {
#        $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem);
#    }
#    return *{"${package}::$name"};
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::code;
#
#my $dummy_warned = 0;
#my $default = '{ "DUMMY" }';
#
#sub yaml_dump {
#    my $self = shift;
#    my $code;
#    my ($dumpflag, $value) = @_;
#    my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
#    my $tag = "!perl/code";
#    $tag .= ":$class" if defined $class;
#    if (not $dumpflag) {
#        $code = $default;
#    }
#    else {
#        bless $value, "CODE" if $class;
#        eval { require B::Deparse };
#        return if $@;
#        my $deparse = B::Deparse->new();
#        eval {
#            local $^W = 0;
#            $code = $deparse->coderef2text($value);
#        };
#        if ($@) {
#            warn YAML::Old::YAML_DUMP_WARN_DEPARSE_FAILED() if $^W;
#            $code = $default;
#        }
#        bless $value, $class if $class;
#        chomp $code;
#        $code .= "\n";
#    }
#    $_[2] = $code;
#    YAML::Old::Node->new($_[2], $tag);
#}
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class, $loader) = @_;
#    if ($loader->load_code) {
#        my $code = eval "package main; sub $node";
#        if ($@) {
#            $loader->warn('YAML_LOAD_WARN_PARSE_CODE', $@);
#            return sub {};
#        }
#        else {
#            CORE::bless $code, $class if $class;
#            return $code;
#        }
#    }
#    else {
#        return CORE::bless sub {}, $class if $class;
#        return sub {};
#    }
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::ref;
#
#sub yaml_dump {
#    my $self = shift;
#    YAML::Old::Node->new({(&YAML::Old::VALUE, ${$_[0]})}, '!perl/ref')
#}
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class, $loader) = @_;
#    $loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'ptr')
#      unless exists $node->{&YAML::Old::VALUE};
#    return \$node->{&YAML::Old::VALUE};
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::regexp;
#
## XXX Be sure to handle blessed regexps (if possible)
#sub yaml_dump {
#    die "YAML::Old::Type::regexp::yaml_dump not currently implemented";
#}
#
#use constant _QR_TYPES => {
#    '' => sub { qr{$_[0]} },
#    x => sub { qr{$_[0]}x },
#    i => sub { qr{$_[0]}i },
#    s => sub { qr{$_[0]}s },
#    m => sub { qr{$_[0]}m },
#    ix => sub { qr{$_[0]}ix },
#    sx => sub { qr{$_[0]}sx },
#    mx => sub { qr{$_[0]}mx },
#    si => sub { qr{$_[0]}si },
#    mi => sub { qr{$_[0]}mi },
#    ms => sub { qr{$_[0]}sm },
#    six => sub { qr{$_[0]}six },
#    mix => sub { qr{$_[0]}mix },
#    msx => sub { qr{$_[0]}msx },
#    msi => sub { qr{$_[0]}msi },
#    msix => sub { qr{$_[0]}msix },
#};
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class) = @_;
#    return qr{$node} unless $node =~ /^\(\?([\^\-xism]*):(.*)\)\z/s;
#    my ($flags, $re) = ($1, $2);
#    $flags =~ s/-.*//;
#    $flags =~ s/^\^//;
#    my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
#    my $qr = &$sub($re);
#    bless $qr, $class if length $class;
#    return $qr;
#}
#
#1;