#!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.122
# on Sat Oct 10 19:58:23 2020. You probably should not manually edit this file.

# NO_PERINCI_CMDLINE_SCRIPT
# PERINCI_CMDLINE_COMPLETER_SCRIPT: {program_name=>"reposdb-inline",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>{ls=>"/App/reposdb/list_repos","remove-all-tags"=>"/App/reposdb/remove_all_repo_tags","remove-tag"=>"/App/reposdb/remove_repo_tag",touch=>"/App/reposdb/touch_repo"},url=>"/App/reposdb/"}
# FRAGMENT id=shcompgen-hint completer=1 for=reposdb-inline
our $DATE = '2020-10-10'; # DATE
our $VERSION = '0.007'; # VERSION
# PODNAME: _reposdb-inline
# ABSTRACT: Completer script for reposdb-inline

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=>"reposdb-inline",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>{ls=>"/App/reposdb/list_repos","remove-all-tags"=>"/App/reposdb/remove_all_repo_tags","remove-tag"=>"/App/reposdb/remove_repo_tag",touch=>"/App/reposdb/touch_repo"},url=>"/App/reposdb/"};

my $meta = {_orig_args_as=>undef,_orig_result_naked=>undef,args_as=>"hash",description=>"\n`repos.db` is a SQLite database that lists repository names along with some\nextra data. They have various uses, but my first use-case for this is to store\nlast commit/status/pull time (updated via a post-commit git hook or `gitwrap`).\nThis is useful to speed up like syncing of repositories in `Git::Bunch` that\nwants to find out which of the hundreds/thousand+ git repositories are \"the most\nrecently used\" to prioritize these repositories first. Using information from\n`repos.db` is faster than having to `git status` or even stat() each repository.\n\n",entity_date=>undef,entity_v=>undef,result_naked=>0,summary=>"Manipulate repos.db",v=>1.1};

my $sc_metas = do{my$a={ls=>{_orig_args_as=>undef,_orig_result_naked=>undef,args=>{detail=>{cmdline_aliases=>{l=>{}},schema=>["bool",{},{}],tags=>["category:field-selection"]},has_tags=>{element_completion=>sub{package App::reposdb;use warnings;use strict;no feature;use feature ':5.10';my(%args) = @_;my $word = $args{'word'} // '';my $cmdline = $args{'cmdline'};my $r = $args{'r'};return undef unless $cmdline;$$r{'read_config'} = 1;my $res = $cmdline->parse_argv($r);my $args = $$res[2];_set_args_default($args);my $dbh = _connect_db($args);my %tags;my $sth = $dbh->prepare('SELECT tags FROM repos WHERE tags IS NOT NULL');$sth->execute;while (my($t) = $sth->fetchrow_array) {do {my @tags = split(/,/, $t, 0);$tags{$_} = 1 foreach (@tags)};}require Complete::Util;Complete::Util::complete_array_elem('word', $word, 'array', [keys %tags])},schema=>["array",{of=>"str*",req=>1},{}],tags=>["category:filtering"],"x.name.is_plural"=>1,"x.name.singular"=>"has_tag"},lacks_tags=>{element_completion=>'fix',schema=>["array",{of=>"str*",req=>1},{}],tags=>["category:filtering"],"x.name.is_plural"=>1,"x.name.singular"=>"lacks_tag"},reposdb_path=>{req=>1,schema=>["str",{req=>1},{}],tags=>["common"]},sorts=>{default=>["name"],schema=>["array",{of=>["str*","in",["name","-name","commit_time","-commit_time","status_time","-status_time","pull_time","-pull_time"]],req=>1},{}],tags=>["category:sorting"],"x.name.is_plural"=>1}},args_as=>"hash",entity_date=>undef,entity_v=>undef,result_naked=>0,summary=>"List repositories registered in repos.db",v=>1.1},"remove-all-tags"=>{_orig_args_as=>undef,_orig_result_naked=>undef,args=>{repo=>{completion=>sub{package App::reposdb;use warnings;use strict;no feature;use feature ':5.10';my(%args) = @_;my $word = $args{'word'} // '';my $cmdline = $args{'cmdline'};my $r = $args{'r'};return undef unless $cmdline;$$r{'read_config'} = 1;my $res = $cmdline->parse_argv($r);my $args = $$res[2];_set_args_default($args);my $dbh = _connect_db($args);my @repos;my $sth = $dbh->prepare('SELECT name FROM repos');$sth->execute;while (my($n) = $sth->fetchrow_array) {do {push @repos, $n};}require Complete::Util;Complete::Util::complete_array_elem('word', $word, 'array', \@repos)},pos=>0,schema=>["str",{req=>1},{}]},reposdb_path=>{req=>1,schema=>["str",{req=>1},{}],tags=>'fix'}},args_as=>"hash",entity_date=>undef,entity_v=>undef,result_naked=>0,summary=>"Remove all tags from a repo (by default the current repo)",v=>1.1},"remove-tag"=>{_orig_args_as=>undef,_orig_result_naked=>undef,args=>{repo=>{completion=>'fix',pos=>0,schema=>["str",{req=>1},{}]},reposdb_path=>{req=>1,schema=>["str",{req=>1},{}],tags=>'fix'},tags=>{element_completion=>'fix',greedy=>1,pos=>1,req=>1,schema=>["array",{of=>"str*",req=>1},{}],"x.name.is_plural"=>1}},args_as=>"hash",entity_date=>undef,entity_v=>undef,result_naked=>0,summary=>"Remove tag from a repo (by default the current repo)",v=>1.1},touch=>{_orig_args_as=>undef,_orig_result_naked=>undef,args=>{commit_time=>{schema=>["bool",{is=>1},{}]},pull_time=>{schema=>["bool",{is=>1},{}]},repo=>{completion=>'fix',pos=>0,schema=>["str",{req=>1},{}]},reposdb_path=>{req=>1,schema=>["str",{req=>1},{}],tags=>'fix'},status_time=>{schema=>["bool",{is=>1},{}]},to=>{schema=>["date",{req=>1},{}]}},args_as=>"hash",args_rels=>{req_some=>[1,3,["commit_time","status_time","pull_time"]]},entity_date=>undef,entity_v=>undef,result_naked=>0,summary=>"Touch the timestamp(s) of a repo (by default current repo)",v=>1.1}};$a->{ls}{args}{lacks_tags}{element_completion}=$a->{ls}{args}{has_tags}{element_completion};$a->{"remove-all-tags"}{args}{reposdb_path}{tags}=$a->{ls}{args}{reposdb_path}{tags};$a->{"remove-tag"}{args}{repo}{completion}=$a->{"remove-all-tags"}{args}{repo}{completion};$a->{"remove-tag"}{args}{reposdb_path}{tags}=$a->{ls}{args}{reposdb_path}{tags};$a->{"remove-tag"}{args}{tags}{element_completion}=$a->{ls}{args}{has_tags}{element_completion};$a->{touch}{args}{repo}{completion}=$a->{"remove-all-tags"}{args}{repo}{completion};$a->{touch}{args}{reposdb_path}{tags}=$a->{ls}{args}{reposdb_path}{tags};$a};

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"},subcommands=>{getopt=>"subcommands",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'action'} = 'subcommands';$$r{'skip_parse_subcommand_argv'} = 1},show_in_usage=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($self, $r) = @_;not $$r{'subcommand_name'}},summary=>"List available subcommands",usage=>"--subcommands"},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)"},view_result=>{getopt=>"view-result:s",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'view_result'} = 1;$$r{'viewer'} = $val if length $val},summary=>"View output using a viewer",tags=>["category:output"],value_label=>"program"}};

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

_reposdb-inline - Completer script for reposdb-inline

=head1 VERSION

This document describes version 0.007 of App::reposdb (from Perl distribution App-reposdb), released on 2020-10-10.

=head1 HOMEPAGE

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

=head1 SOURCE

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

=head1 BUGS

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

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

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2020, 2017, 2016 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,39632,1;193
Complete/Common.pm,46035,6507,2;1432
Complete/Env.pm,52566,5656,3;1628
Complete/File.pm,58247,14391,4;1886
Complete/Getopt/Long.pm,72670,36047,5;2353
Complete/Path.pm,108742,13757,6;3338
Complete/Sah.pm,122523,16459,7;3755
Complete/Tcsh.pm,139007,6850,8;4200
Complete/Util.pm,145882,40883,9;4456
Data/Clean.pm,186787,17013,10;5874
Data/Clean/ForJSON.pm,203830,8992,11;6446
Data/Clean/FromJSON.pm,212853,3100,12;6739
Data/Dmp.pm,215973,13835,13;6863
Data/ModeMerge.pm,229834,26971,14;7312
Data/ModeMerge/Config.pm,256838,14454,15;8097
Data/ModeMerge/Mode/ADD.pm,271327,2657,16;8621
Data/ModeMerge/Mode/Base.pm,274020,22041,17;8741
Data/ModeMerge/Mode/CONCAT.pm,296099,1741,18;9414
Data/ModeMerge/Mode/DELETE.pm,297878,2738,19;9493
Data/ModeMerge/Mode/KEEP.pm,300652,2463,20;9623
Data/ModeMerge/Mode/NORMAL.pm,303153,2800,21;9742
Data/ModeMerge/Mode/SUBTRACT.pm,305993,3373,22;9886
Data/Sah/Normalize.pm,309396,9038,23;10029
Data/Sah/Resolve.pm,318462,7505,24;10303
Data/Sah/Util/Type.pm,325997,9456,25;10542
Function/Fallback/CoreOrPP.pm,335491,5030,26;10842
Getopt/Long/Negate/EN.pm,340554,5332,27;11037
Getopt/Long/Util.pm,345914,17146,28;11186
Lingua/EN/PluralToSingular.pm,363098,14259,29;11816
Log/ger.pm,377376,11278,30;12563
Log/ger/Filter.pm,388680,1149,31;12908
Log/ger/Filter/Code.pm,389860,1395,32;12974
Log/ger/Format.pm,391281,1293,33;13056
Log/ger/Format/Default.pm,392608,3299,34;13129
Log/ger/Format/None.pm,395938,1269,35;13247
Log/ger/Heavy.pm,397232,18144,36;13314
Log/ger/Layout.pm,415402,1229,37;13715
Log/ger/Output.pm,416657,1358,38;13783
Log/ger/Output/Array.pm,418047,1585,39;13862
Log/ger/Output/Null.pm,419663,1273,40;13948
Log/ger/Output/String.pm,420969,2305,41;14016
Log/ger/Plugin.pm,423300,2038,42;14121
Log/ger/Plugin/MultilevelLog.pm,425378,5006,43;14236
Log/ger/Util.pm,430408,10231,44;14415
Mo.pm,440653,591,45;14743
Mo/Golf.pm,441263,8174,46;14747
Mo/Inline.pm,449458,3471,47;14983
Mo/Moose.pm,452949,533,48;15124
Mo/Mouse.pm,453502,563,49;15129
Mo/build.pm,454085,248,50;15134
Mo/builder.pm,454355,338,51;15138
Mo/chain.pm,454713,216,52;15142
Mo/coerce.pm,454950,330,53;15146
Mo/default.pm,455302,435,54;15150
Mo/exporter.pm,455760,176,55;15154
Mo/import.pm,455957,185,56;15158
Mo/importer.pm,456165,207,57;15162
Mo/is.pm,456389,228,58;15166
Mo/nonlazy.pm,456639,129,59;15170
Mo/option.pm,456789,259,60;15174
Mo/required.pm,457071,340,61;15178
Mo/xs.pm,457428,256,62;15182
Module/Installed/Tiny.pm,457717,7196,63;15186
Perinci/Sub/Complete.pm,464945,56384,64;15421
Perinci/Sub/GetArgs/Argv.pm,521365,55430,65;17026
Perinci/Sub/GetArgs/Array.pm,576832,7479,66;18519
Perinci/Sub/Normalize.pm,584344,7303,67;18779
Perinci/Sub/Util.pm,591675,21083,68;19014
Perinci/Sub/Util/Args.pm,612791,6274,69;19775
Perinci/Sub/Util/ResObj.pm,619100,1545,70;20029
Perinci/Sub/Util/Sort.pm,620678,1957,71;20090
Regexp/Stringify.pm,622663,5418,72;20181
Sah/Schema/rinci/function_meta.pm,628123,7198,73;20378
Sah/Schema/rinci/meta.pm,635354,3699,74;20646
Sah/Schema/rinci/result_meta.pm,639093,3586,75;20810
Sah/SchemaR/rinci/function_meta.pm,642722,6270,76;20965
Sah/SchemaR/rinci/meta.pm,649026,3012,77;21023
Sah/SchemaR/rinci/result_meta.pm,652079,2346,78;21081
Sah/Schemas/Rinci.pm,654454,1286,79;21139
String/LineNumber.pm,655769,2512,80;21195
String/PerlQuote.pm,658309,3383,81;21313
String/Wildcard/Bash.pm,661724,9637,82;21438
YAML/Old.pm,671381,3321,83;21768
YAML/Old/Dumper.pm,674729,17730,84;21885
YAML/Old/Dumper/Base.pm,692491,3735,85;22462
YAML/Old/Error.pm,696252,5985,86;22573
YAML/Old/Loader.pm,702264,25286,87;22764
YAML/Old/Loader/Base.pm,727582,1235,88;23535
YAML/Old/Marshall.pm,728846,934,89;23572
YAML/Old/Mo.pm,729803,3416,90;23619
YAML/Old/Node.pm,733244,4692,91;23699
YAML/Old/Tag.pm,737960,240,92;23917
YAML/Old/Types.pm,738226,6708,93;23936

### 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-04-16'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.335'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       point
#                       parse_cmdline
#                       join_wordbreak_words
#                       format_completion
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
#    my ($user, $slash) = @_;
#    my @ent;
#    if (length $user) {
#        @ent = getpwnam($user);
#    } else {
#        @ent = getpwuid($>);
#        $user = $ent[0];
#    }
#    return $ent[7] . $slash if @ent;
#    "~$user$slash"; # return as-is when failed
#}
#
#sub _add_unquoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word, $after_ws) = @_;
#
#    #say "D:add_unquoted word=$word is_cur_word=$is_cur_word after_ws=$after_ws";
#
#    $word =~ s!^(~)(\w*)(/|\z) |  # 1) tilde  2) username  3) optional slash
#               \\(.)           |  # 4) escaped char
#               \$(\w+)            # 5) variable name
#              !
#                  $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
#                      $4 ? $4 :
#                          ($is_cur_word ? "\$$5" : $ENV{$5})
#                              !egx;
#    $word;
#}
#
#sub _add_double_quoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word) = @_;
#
#    $word =~ s!\\(.)           |  # 1) escaped char
#               \$(\w+)            # 2) variable name
#              !
#                  $1 ? $1 :
#                      ($is_cur_word ? "\$$2" : $ENV{$2})
#                          !egx;
#    $word;
#}
#
#sub _add_single_quoted {
#    my $word = shift;
#    $word =~ s/\\(.)/$1/g;
#    $word;
#}
#
#$SPEC{point} = {
#    v => 1.1,
#    summary => 'Return line with point marked by a marker',
#    description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
#    point("^foo") # => ("foo", 0)
#    point("fo^o") # => ("foo", 2)
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line which contains a marker character',
#            schema => 'str*',
#            pos => 0,
#        },
#        marker => {
#            summary => 'Marker character',
#            schema => ['str*', len=>1],
#            default => '^',
#            pos => 1,
#        },
#    },
#    result_naked => 1,
#};
#sub point {
#    my ($line, $marker) = @_;
#    $marker //= '^';
#
#    my $point = index($line, $marker);
#    die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
#    $line =~ s/\Q$marker\E//;
#    ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
#    v => 1.1,
#    summary => 'Parse shell command-line for processing by completion routines',
#    description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
#    command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
#    ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
#    ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
#   variable substitution for `COMP_WORDS`). However, note that special shell
#   variables that are not environment variables like `$0`, `$_`, `$IFS` will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
#  By default `COMP_WORDBREAKS` is:
#
#    "'@><=;|&(:
#
#  So if raw command-line is:
#
#    command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#  then the parse result will be:
#
#    ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#  which is annoying sometimes. But we follow bash here so we can more easily
#  accept input from a joined `COMP_WORDS` if we write completion bash functions,
#  e.g. (in the example, `foo` is a Perl script):
#
#    _foo ()
#    {
#        local words=(${COMP_CWORDS[@]})
#        # add things to words, etc
#        local point=... # calculate the new point
#        COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
#    }
#
#  To avoid these word-breaking characters to be split/grouped, we can escape
#  them with backslash or quote them, e.g.:
#
#    command "http://example.com:80" Foo\:\:Bar
#
#  which bash will parse as:
#
#    ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
#  and we parse as:
#
#    ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
#  equivalent:
#
#    % cmd --foo=bar
#    % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line, defaults to COMP_LINE environment',
#            schema => 'str*',
#            pos => 0,
#        },
#        point => {
#            summary => 'Point/position to complete in command-line, '.
#                'defaults to COMP_POINT',
#            schema => 'int*',
#            pos => 1,
#        },
#        opts => {
#            summary => 'Options',
#            schema => 'hash*',
#            description => <<'_',
#
#Optional. Known options:
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
#  position of cursor, for example (`^` marks the position of cursor):
#  `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
#  doing tab completion.
#
#_
#            schema => 'hash*',
#            pos => 2,
#        },
#    },
#    result => {
#        schema => ['array*', len=>2],
#        description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in `@ARGV`), you need to strip the first element from
#`$words` and reduce `$cword` by 1.
#
#
#_
#    },
#    result_naked => 1,
#    links => [
#    ],
#};
#sub parse_cmdline {
#    no warnings 'uninitialized';
#    my ($line, $point, $opts) = @_;
#
#    $line  //= $ENV{COMP_LINE};
#    $point //= $ENV{COMP_POINT} // 0;
#
#    die "$0: COMP_LINE not set, make sure this script is run under ".
#        "bash completion (e.g. through complete -C)\n" unless defined $line;
#
#    log_trace "[compbash] parse_cmdline(): input: line=<$line> point=<$point>"
#        if $ENV{COMPLETE_BASH_TRACE};
#
#    my @words;
#    my $cword;
#    my $pos = 0;
#    my $pos_min_ws = 0;
#    my $after_ws = 1; # XXX what does this variable mean?
#    my $chunk;
#    my $add_blank;
#    my $is_cur_word;
#    $line =~ s!(                                                         # 1) everything
#                  (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*)               |  #  2) open "  3) content  4) space after
#                  (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*)               |  #  5) open '  6) content  7) space after
#                  ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) |  #  8) unquoted word  9) space after
#                  ([\@><=|&\(:]+) |                                      #  10) non-whitespace word-breaking characters
#                  \s+
#              )!
#                  $pos += length($1);
#                  #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
#                  #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
#                  if ($2 || $5 || defined($8)) {
#                      # double-quoted/single-quoted/unquoted chunk
#
#                      if (not(defined $cword)) {
#                          $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
#                          #say "D:pos_min_ws=$pos_min_ws";
#                          if ($point <= $pos_min_ws) {
#                              $cword = @words - ($after_ws ? 0 : 1);
#                          } elsif ($point < $pos) {
#                              $cword = @words + 1 - ($after_ws ? 0 : 1);
#                              $add_blank = 1;
#                          }
#                      }
#
#                      if ($after_ws) {
#                          $is_cur_word = defined($cword) && $cword==@words;
#                      } else {
#                          $is_cur_word = defined($cword) && $cword==@words-1;
#                      }
#                      #say "D:is_cur_word=$is_cur_word";
#                      $chunk =
#                          $2 ? _add_double_quoted($3, $is_cur_word) :
#                              $5 ? _add_single_quoted($6) :
#                              _add_unquoted($8, $is_cur_word, $after_ws);
#                      if ($opts && $opts->{truncate_current_word} &&
#                              $is_cur_word && $pos > $point) {
#                          $chunk = substr(
#                              $chunk, 0, length($chunk)-($pos_min_ws-$point));
#                          #say "D:truncating current word to <$chunk>";
#                      }
#                      if ($after_ws) {
#                          push @words, $chunk;
#                      } else {
#                          $words[-1] .= $chunk;
#                      }
#                      if ($add_blank) {
#                          push @words, '';
#                          $add_blank = 0;
#                      }
#                      $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
#
#                  } elsif ($10) {
#                      # non-whitespace word-breaking characters
#                      push @words, $10;
#                      $after_ws = 1;
#                  } else {
#                      # whitespace
#                      $after_ws = 1;
#                  }
#    !egx;
#
#    $cword //= @words;
#    $words[$cword] //= '';
#
#    log_trace "[compbash] parse_cmdline(): result: words=%s, cword=%s", \@words, $cword
#        if $ENV{COMPLETE_BASH_TRACE};
#
#    [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
#    v => 1.1,
#    summary => 'Post-process parse_cmdline() result by joining some words',
#    description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
#    "'@><=;|&(:
#
#So if command-line is:
#
#    command --module=Data::Dump bob@example.org
#
#then they will be parsed as:
#
#    ["command", "--module", "=", "Data", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
#    ["command", "--module=Data::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
#    my ($words, $cword) = @_;
#    my $new_words = [];
#    my $i = -1;
#    while (++$i < @$words) {
#        my $w = $words->[$i];
#        if ($w =~ /\A[\@=:]+\z/) {
#            if (@$new_words and $#$new_words != $cword) {
#                $new_words->[-1] .= $w;
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            } else {
#                push @$new_words, $w;
#            }
#            if ($i+1 < @$words) {
#                $i++;
#                $new_words->[-1] .= $words->[$i];
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            }
#        } else {
#            push @$new_words, $w;
#        }
#    }
#    log_trace "[compbash] join_wordbreak_words(): result: words=%s, cword=%d", $new_words, $cword
#        if $ENV{COMPLETE_BASH_TRACE};
#    [$new_words, $cword];
#}
#
#sub _terminal_width {
#    # XXX need to cache?
#    if (eval { require Term::Size; 1 }) {
#        my ($cols, undef) = Term::Size::chars(*STDOUT{IO});
#        $cols // 80;
#    } else {
#        $ENV{COLUMNS} // 80;
#    }
#}
#
## 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.335 of Complete::Bash (from Perl distribution Complete-Bash), released on 2020-04-16.
#
#=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 --module=Data::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "--module", "=", "Data", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want C<:>, C<@> to be part of word. So this
#routine will convert the above into:
#
# ["command", "--module=Data::Dump", 'bob@example.org']
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#
#
#=head2 parse_cmdline
#
#Usage:
#
# parse_cmdline($cmdline, $point, $opts) -> array
#
#Parse shell command-line for processing by completion routines.
#
#This function basically converts C<COMP_LINE> (str) and C<COMP_POINT> (int) into
#something like (but not exactly the same as) C<COMP_WORDS> (array) and
#C<COMP_CWORD> (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's C<COMP_WORDS> contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (C<COMP_WORDS[COMP_CWORD]>) (bash does not perform
#   variable substitution for C<COMP_WORDS>). However, note that special shell
#   variables that are not environment variables like C<$0>, C<$_>, C<$IFS> will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (C<~>) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for C<COMP_WORDS>);
#
#Caveats:
#
#=over
#
#=item * Like bash, we group non-whitespace word-breaking characters into its own word.
#By default C<COMP_WORDBREAKS> is:
#
#"'@><=;|&(:
#
#So if raw command-line is:
#
#command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#then the parse result will be:
#
#["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#which is annoying sometimes. But we follow bash here so we can more easily
#accept input from a joined C<COMP_WORDS> if we write completion bash functions,
#e.g. (in the example, C<foo> is a Perl script):
#
#I<foo ()
#{
#    local words=(${COMP>CWORDS[@]})
#    # add things to words, etc
#    local point=... # calculate the new point
#    COMPREPLY=( C<COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo> )
#}
#
#To avoid these word-breaking characters to be split/grouped, we can escape
#them with backslash or quote them, e.g.:
#
#command "http://example.com:80" Foo\:\:Bar
#
#which bash will parse as:
#
#["command", "\"http://example.com:80\"", "Foo\:\:Bar"]
#
#and we parse as:
#
#["command", "http://example.com:80", "Foo::Bar"]
#
#=item * Due to the way bash parses the command line (see above), the two below are
#equivalent:
#
#% cmd --foo=bar
#% cmd --foo = bar
#
#=back
#
#Because they both expand to C<['--foo', '=', 'bar']>. But obviously
#L<Getopt::Long> does not regard the two as equivalent.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line, defaults to COMP_LINE environment.
#
#=item * B<$opts> => I<hash>
#
#Options.
#
#Optional. Known options:
#
#=over
#
#=item * C<truncate_current_word> (bool). If set to 1, will truncate current word to the
#position of cursor, for example (C<^> marks the position of cursor):
#C<--vers^oo> to C<--vers> instead of C<--versoo>. This is more convenient when
#doing tab completion.
#
#=back
#
#=item * B<$point> => I<int>
#
#PointE<sol>position to complete in command-line, defaults to COMP_POINT.
#
#
#=back
#
#Return value:  (array)
#
#
#Return a 2-element array: C<[$words, $cword]>. C<$words> is array of str,
#equivalent to C<COMP_WORDS> provided by bash to shell functions. C<$cword> is an
#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-09-09'; # DATE
#our $DIST = 'Complete-Getopt-Long'; # DIST
#our $VERSION = '0.480'; # 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('[compgl] entering default completion routine') if $COMPLETE_GETOPT_LONG_TRACE;
#
#    # try completing '$...' with shell variables
#    if ($word =~ /\A\$/ && $COMPLETE_GETOPT_LONG_DEFAULT_ENV) {
#        log_trace('[compgl] completing shell variable') if $COMPLETE_GETOPT_LONG_TRACE;
#        {
#            my $compres = Complete::Env::complete_env(
#                word=>$word);
#            last unless @$compres;
#            $fres = {words=>$compres, esc_mode=>'shellvar'};
#            goto RETURN_RES;
#        }
#        # if empty, fallback to searching file
#    }
#
#    # try completing '~foo' with user dir (appending / if user's home exists)
#    if ($word =~ m!\A~([^/]*)\z! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing userdir, user=%s", $1) if $COMPLETE_GETOPT_LONG_TRACE;
#        {
#            eval { require Unix::Passwd::File };
#            last if $@;
#            my $res = Unix::Passwd::File::list_users(detail=>1);
#            last unless $res->[0] == 200;
#            my $compres = Complete::Util::complete_array_elem(
#                array=>[map {"~" . $_->{user} . ((-d $_->{home}) ? "/":"")}
#                            @{ $res->[2] }],
#                word=>$word,
#            );
#            last unless @$compres;
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#        # if empty, fallback to searching file
#    }
#
#    # try completing '~/blah' or '~foo/blah' as if completing file, but do not
#    # expand ~foo (this is supported by complete_file(), so we just give it off
#    # to the routine)
#    if ($word =~ m!\A(~[^/]*)/! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing file, path=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE;
#        $fres = Complete::Util::hashify_answer(
#            Complete::File::complete_file(word=>$word),
#            {path_sep=>'/'}
#        );
#        goto RETURN_RES;
#    }
#
#    # try completing something that contains wildcard with glob. for
#    # convenience, we add '*' at the end so that when user type [AB] it is
#    # treated like [AB]*.
#    require String::Wildcard::Bash;
#    if (String::Wildcard::Bash::contains_wildcard($word) && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing with wildcard glob, glob=<%s>", "$word*") if $COMPLETE_GETOPT_LONG_TRACE;
#        {
#            my $compres = [glob("$word*")];
#            last unless @$compres;
#            for (@$compres) {
#                $_ .= "/" if (-d $_);
#            }
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#        # if empty, fallback to searching file
#    }
#
#    if ($COMPLETE_GETOPT_LONG_DEFAULT_FILE) {
#        log_trace("[compgl] completing with file, file=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE;
#        $fres = Complete::Util::hashify_answer(
#            Complete::File::complete_file(word=>$word),
#            {path_sep=>'/'}
#        );
#    }
#
#  RETURN_RES:
#    log_trace("[compgl] leaving default completion routine, result=%s", $fres) if $COMPLETE_GETOPT_LONG_TRACE;
#    $fres;
#}
#
## return the possible options. if there is only one candidate (unambiguous
## expansion) then scalar will be returned. otherwise, an array of candidates
## will be returned.
#sub _matching_opts {
#    my ($opt, $opts) = @_;
#    my %candidates;
#    for (sort {length($a)<=>length($b)} keys %$opts) {
#        next unless index($_, $opt) == 0;
#        $candidates{$_} = $opts->{$_};
#        last if $opt eq $_;
#    }
#    \%candidates;
#}
#
## mark an option (and all its aliases) as seen
#sub _mark_seen {
#    my ($seen_opts, $opt, $opts) = @_;
#    my $opthash = $opts->{$opt};
#    return unless $opthash;
#    my $ospec = $opthash->{ospec};
#    for (keys %$opts) {
#        my $v = $opts->{$_};
#        $seen_opts->{$_}++ if $v->{ospec} eq $ospec;
#    }
#}
#
#$SPEC{complete_cli_arg} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using '.
#        'Getopt::Long specification',
#    description => <<'_',
#
#This routine can complete option names, where the option names are retrieved
#from <pm:Getopt::Long> specification. If you provide completion routine in
#`completion`, you can also complete _option values_ and _arguments_.
#
#Note that this routine does not use <pm:Getopt::Long> (it does its own parsing)
#and currently is not affected by Getopt::Long's configuration. Its behavior
#mimics Getopt::Long under these configuration: `no_ignore_case`, `bundling` (or
#`no_bundling` if the `bundling` option is turned off). Which I think is the
#sensible default. This routine also does not currently support `auto_help` and
#`auto_version`, so you'll need to add those options specifically if you want to
#recognize `--help/-?` and `--version`, respectively.
#
#_
#    args => {
#        getopt_spec => {
#            summary => 'Getopt::Long specification',
#            schema  => 'array*',
#            req     => 1,
#        },
#        completion => {
#            summary     =>
#                'Completion routine to complete option value/argument',
#            schema      => 'code*',
#            description => <<'_',
#
#Completion code will receive a hash of arguments (`%args`) containing these
#keys:
#
#* `type` (str, what is being completed, either `optval`, or `arg`)
#* `word` (str, word to be completed)
#* `cword` (int, position of words in the words array, starts from 0)
#* `opt` (str, option name, e.g. `--str`; undef if we're completing argument)
#* `ospec` (str, Getopt::Long option spec, e.g. `str|S=s`; undef when completing
#  argument)
#* `argpos` (int, argument position, zero-based; undef if type='optval')
#* `nth` (int, the number of times this option has seen before, starts from 0
#  that means this is the first time this option has been seen; undef when
#  type='arg')
#* `seen_opts` (hash, all the options seen in `words`)
#* `parsed_opts` (hash, options parsed the standard/raw way)
#
#as well as all keys from `extras` (but these won't override the above keys).
#
#and is expected to return a completion answer structure as described in
#`Complete` which is either a hash or an array. The simplest form of answer is
#just to return an array of strings. The various `complete_*` function like those
#in <pm:Complete::Util> or the other `Complete::*` modules are suitable to use
#here.
#
#Completion routine can also return undef to express declination, in which case
#the default completion routine will then be consulted. The default routine
#completes from shell environment variables (`$FOO`), Unix usernames (`~foo`),
#and files/directories.
#
#Example:
#
#    use Complete::Unix qw(complete_user);
#    use Complete::Util qw(complete_array_elem);
#    complete_cli_arg(
#        getopt_spec => [
#            'help|h'   => sub{...},
#            'format=s' => \$format,
#            'user=s'   => \$user,
#        ],
#        completion  => sub {
#            my %args  = @_;
#            my $word  = $args{word};
#            my $ospec = $args{ospec};
#            if ($ospec && $ospec eq 'format=s') {
#                complete_array_elem(array=>[qw/json text xml yaml/], word=>$word);
#            } else {
#                complete_user(word=>$word);
#            }
#        },
#    );
#
#_
#        },
#        words => {
#            summary     => 'Command line arguments, like @ARGV',
#            description => <<'_',
#
#See function `parse_cmdline` in <pm:Complete::Bash> on how to produce this (if
#you're using bash).
#
#_
#            schema      => 'array*',
#            req         => 1,
#        },
#        cword => {
#            summary     =>
#                "Index in words of the word we're trying to complete",
#            description => <<'_',
#
#See function `parse_cmdline` in <pm:Complete::Bash> on how to produce this (if
#you're using bash).
#
#_
#            schema      => 'int*',
#            req         => 1,
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `type`, `word`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#        bundling => {
#            schema  => 'bool*',
#            default => 1,
#            'summary.alt.bool.not' => 'Turn off bundling',
#            description => <<'_',
#
#If you turn off bundling, completion of short-letter options won't support
#bundling (e.g. `-b<tab>` won't add more single-letter options), but single-dash
#multiletter options can be recognized. Currently only those specified with a
#single dash will be completed. For example if you have `-foo=s` in your option
#specification, `-f<tab>` can complete it.
#
#This can be used to complete old-style programs, e.g. emacs which has options
#like `-nw`, `-nbc` etc (but also have double-dash options like
#`--no-window-system` or `--no-blinking-cursor`).
#
#_
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => ['any*' => of => ['hash*', 'array*']],
#        description => <<'_',
#
#You can use `format_completion` function in <pm:Complete::Bash> module to format
#the result of this function for bash.
#
#_
#    },
#};
#sub complete_cli_arg {
#    require Complete::Util;
#    require Getopt::Long::Util;
#
#    my %args = @_;
#
#    my $fname = __PACKAGE__ . "::complete_cli_arg"; # XXX use __SUB__
#    my $fres;
#
#    $args{words} or die "Please specify words";
#    my @words = @{ $args{words} };
#    defined(my $cword = $args{cword}) or die "Please specify cword";
#    my $gospec = $args{getopt_spec} or die "Please specify getopt_spec";
#    my $comp = $args{completion};
#    my $extras = $args{extras} // {};
#    my $bundling = $args{bundling} // 1;
#    my %parsed_opts;
#
#    # backward compatibility: gospec was expected to be a hash, now an array
#    if (ref $gospec eq 'HASH') {
#        my $ary_gospec = [];
#        for (keys %$gospec) {
#            push @$ary_gospec, $_;
#            push @$ary_gospec, $gospec->{$_} if ref $gospec->{$_};
#        }
#        $gospec = $ary_gospec;
#    }
#
#    log_trace('[compgl] entering %s(), words=%s, cword=%d, word=<%s>',
#              $fname, \@words, $cword, $words[$cword]) if $COMPLETE_GETOPT_LONG_TRACE;
#
#    # strip hash storage from getopt_spec
#    shift @$gospec if ref $gospec->[0] eq 'HASH';
#
#    # parse all options first & supply default completion routine
#    my %opts;
#    my $i = -1;
#    while (++$i <= $#{$gospec}) {
#        my $ospec = $gospec->[$i];
#        my $dest  = $i+1 <= $#{$gospec} && ref $gospec->[$i+1] ?
#            splice(@$gospec, $i+1, 1) : undef;
#
#        my $res = Getopt::Long::Util::parse_getopt_long_opt_spec($ospec)
#            or die "Can't parse option spec '$ospec'";
#        next if $res->{is_arg};
#        $res->{min_vals} //= $res->{type} ? 1 : 0;
#        $res->{max_vals} //= $res->{type} || $res->{opttype} ? 1:0;
#        for my $o0 (@{ $res->{opts} }) {
#            my @ary = $res->{is_neg} && length($o0) > 1 ?
#                ([$o0, 0], ["no$o0",1], ["no-$o0",1]) : ([$o0,0]);
#            for my $elem (@ary) {
#                my $o = $elem->[0];
#                my $is_neg = $elem->[1];
#                my $k = length($o)==1 ||
#                    (!$bundling && $res->{dash_prefix} eq '-') ?
#                        "-$o" : "--$o";
#                $opts{$k} = {
#                    name => $k,
#                    ospec => $ospec,
#                    dest  => $dest,
#                    parsed => $res,
#                    is_neg => $is_neg,
#                };
#            }
#        }
#    }
#    my @optnames = sort keys %opts;
#
#    my $code_get_summary = sub {
#        # currently we only extract summaries from Rinci metadata and
#        # Perinci::CmdLine object
#        return unless $extras;
#        my $ggls_res = $extras->{ggls_res};
#        return unless $ggls_res;
#        my $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};
#
#        return $ospecmeta->{summary} if defined $ospecmeta->{summary};
#
#        if ($ospecmeta->{is_alias}) {
#            my $real_ospecmeta = $specmeta->{ $ospecmeta->{alias_for} };
#            my $real_opt = $real_ospecmeta->{parsed}{opts}[0];
#            $real_opt = length($real_opt) == 1 ? "-$real_opt" : "--$real_opt";
#            return "Alias for $real_opt";
#        }
#
#        if (defined(my $coptname = $ospecmeta->{common_opt})) {
#            # it's a common Perinci::CmdLine option
#            my $coptspec = $cmdline->{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 $matching_opts = _matching_opts($opt, \%opts);
#
#            if (keys(%$matching_opts) == 1) {
#                my $opthash = $matching_opts->{ (keys %$matching_opts)[0] };
#                $opt = $opthash->{name};
#                $expects[$i]{optname} = $opt;
#                my $nth = $seen_opts{$opt} // 0;
#                $expects[$i]{nth} = $nth;
#                _mark_seen(\%seen_opts, $opt, \%opts);
#
#                my $min_vals = $opthash->{parsed}{min_vals};
#                my $max_vals = $opthash->{parsed}{max_vals};
#                #say "D:min_vals=$min_vals, max_vals=$max_vals";
#
#                # detect = after --opt
#                if ($i+1 < @words && $words[$i+1] eq '=') {
#                    $i++;
#                    $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
#                    # force expecting a value due to =
#                    $min_vals = 1;
#                    $max_vals = $min_vals if $max_vals < $min_vals;
#                }
#
#                for (1 .. $min_vals) {
#                    $i++;
#                    last WORD if $i >= @words;
#                    $expects[$i]{optval} = $opt;
#                    $expects[$i]{nth} = $nth;
#                    push @{ $parsed_opts{$opt} }, $words[$i];
#                }
#                for (1 .. $max_vals-$min_vals) {
#                    last if $i+$_ >= @words;
#                    last if $words[$i+$_] =~ /\A-/; # a new option
#                    $expects[$i+$_]{optval} = $opt; # but can also be optname
#                    $expects[$i]{nth} = $nth;
#                    push @{ $parsed_opts{$opt} }, $words[$i+$_];
#                }
#            } else {
#                # an unknown or still ambiguous option, assume it doesn't
#                # require argument, unless it's --opt= or --opt=foo
#                $opt = undef;
#                $expects[$i]{optname} = $opt;
#                my $possible_optnames = [sort keys %$matching_opts];
#                $expects[$i]{possible_optnames} = $possible_optnames;
#
#                # detect = after --opt
#                if ($i+1 < @words && $words[$i+1] eq '=') {
#                    $i++;
#                    $expects[$i] = {separator=>1, optval=>undef, possible_optnames=>$possible_optnames, word=>''};
#                    if ($i+1 < @words) {
#                        $i++;
#                        $expects[$i]{optval} = $opt;
#                        $expects[$i]{possible_optnames} = $possible_optnames;
#                    }
#                }
#            }
#        } else {
#            $expects[$i]{optname} = '';
#            $expects[$i]{arg} = 1;
#            $expects[$i]{argpos} = $argpos++;
#        }
#    }
#
#    my $exp = $expects[$cword];
#    my $word = $exp->{word} // $words[$cword];
#
#    #use DD; say "D:opts: "; dd \%opts;
#    #use DD; print "D:words: "; dd \@words;
#    #say "D:cword: $cword";
#    #use DD; print "D:expects: "; dd \@expects;
#    #use DD; print "D:seen_opts: "; dd \%seen_opts;
#    #use DD; print "D:parsed_opts: "; dd \%parsed_opts;
#    #use DD; print "D:exp: "; dd $exp;
#    #use DD; say "D:word:<$word>";
#
#    my @answers;
#
#    # complete option names
#    {
#        last if $word =~ /\A[^-]/;
#        last unless exists $exp->{optname};
#        last if defined($exp->{do_complete_optname}) &&
#            !$exp->{do_complete_optname};
#        if ($exp->{comp_result}) {
#            push @answers, $exp->{comp_result};
#            last;
#        }
#        #say "D:completing option names";
#        my $opt = $exp->{optname};
#        my @o;
#        my @osumms;
#        my $o_has_summaries;
#        for my $optname (@optnames) {
#            my $repeatable = 0;
#            next if $exp->{short_only} && $optname =~ /\A--/;
#            if ($seen_opts{$optname}) {
#                my $opthash = $opts{$optname};
#                my $parsed = $opthash->{parsed};
#                my $dest = $opthash->{dest};
#                if (ref $dest eq 'ARRAY') {
#                    $repeatable = 1;
#                } elsif ($parsed->{desttype} || $parsed->{is_inc}) {
#                    $repeatable = 1;
#                }
#            }
#            # skip options that have been specified and not repeatable
#            #use DD; dd {'$_'=>$_, seen=>$seen_opts{$_}, repeatable=>$repeatable, opt=>$opt};
#            next if $seen_opts{$optname} && !$repeatable && (
#                # long option has been specified
#                (!$opt || $opt ne $optname) ||
#                     # short option (in a bundle) has been specified
#                    (defined($exp->{prefix}) &&
#                         index($exp->{prefix}, substr($opt, 1, 1)) >= 0));
#            if (defined $exp->{prefix}) {
#                my $o = $optname; $o =~ s/\A-//;
#                push @o, "$exp->{prefix}$o";
#            } else {
#                push @o, $optname;
#            }
#            my $summ = $code_get_summary->($optname) // '';
#            if (length $summ) {
#                $o_has_summaries = 1;
#                push @osumms, $summ;
#            } else {
#                push @osumms, '';
#            }
#        }
#        #use DD; dd \@o;
#        #use DD; dd \@osumms;
#        my $compres = Complete::Util::complete_array_elem(
#            array => \@o, word => $word,
#            (summaries => \@osumms) x !!$o_has_summaries,
#        );
#        log_trace('[compgl] adding result from option names, '.
#                      'matching options=%s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
#        push @answers, $compres;
#        if (!exists($exp->{optval}) && !exists($exp->{arg})) {
#            $fres = {words=>$compres, esc_mode=>'option'};
#            goto RETURN_RES;
#        }
#    }
#
#    # complete option value
#    {
#        last unless exists($exp->{optval});
#        #say "D:completing option value";
#        my $opt = $exp->{optval};
#        my $opthash; $opthash = $opts{$opt} if $opt;
#        my %compargs = (
#            %$extras,
#            type=>'optval', words=>\@words, cword=>$args{cword},
#            word=>$word, opt=>($opt // $exp->{possible_optnames}), ospec=>$opthash->{ospec},
#            argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
#            parsed_opts=>\%parsed_opts,
#        );
#        my $compres;
#        if ($comp) {
#            log_trace("[compgl] invoking routine supplied from 'completion' argument to complete option value, option=<%s>", $opt) if $COMPLETE_GETOPT_LONG_TRACE;
#            $compres = $comp->(%compargs);
#            Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
#                if defined $exp->{prefix};
#            log_trace('[compgl] adding result from routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
#        }
#        if (!$compres || !$comp) {
#            $compres = _default_completion(%compargs);
#            Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
#                if defined $exp->{prefix};
#            log_trace('[compgl] adding result from default '.
#                          'completion routine') if $COMPLETE_GETOPT_LONG_TRACE;
#        }
#        push @answers, $compres;
#    }
#
#    # complete argument
#    {
#        last unless exists($exp->{arg});
#        my %compargs = (
#            %$extras,
#            type=>'arg', words=>\@words, cword=>$args{cword},
#            word=>$word, opt=>undef, ospec=>undef,
#            argpos=>$exp->{argpos}, seen_opts=>\%seen_opts,
#            parsed_opts=>\%parsed_opts,
#        );
#        log_trace('[compgl] invoking \'completion\' routine '.
#                      'to complete argument') if $COMPLETE_GETOPT_LONG_TRACE;
#        my $compres; $compres = $comp->(%compargs) if $comp;
#        if (!defined $compres) {
#            $compres = _default_completion(%compargs);
#            log_trace('[compgl] adding result from default '.
#                          'completion routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE;
#        }
#        push @answers, $compres;
#    }
#
#    log_trace("[compgl] combining result from %d source(s)", scalar @answers) if $COMPLETE_GETOPT_LONG_TRACE;
#    $fres = Complete::Util::combine_answers(@answers) // [];
#
#  RETURN_RES:
#    log_trace("[compgl] leaving %s(), result=%s", $fname, $fres) if $COMPLETE_GETOPT_LONG_TRACE;
#    $fres;
#}
#
#1;
## ABSTRACT: Complete command-line argument using Getopt::Long specification
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Getopt::Long - Complete command-line argument using Getopt::Long specification
#
#=head1 VERSION
#
#This document describes version 0.480 of Complete::Getopt::Long (from Perl distribution Complete-Getopt-Long), released on 2020-09-09.
#
#=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-06-04'; # DATE
#our $DIST = 'Complete-Sah'; # DIST
#our $VERSION = '0.007'; # 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
#        my $merged_cs = {};
#        for my $cs0 (@{ $rsch->[1] // [] }, $cs) {
#            for (keys %$cs0) {
#                $merged_cs->{$_} = $cs0->{$_};
#            }
#        }
#        $cs = $merged_cs;
#        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\::gen_completion(%s) ...", $mod, $xcargs);
#                    $comp = $fref->(%$xcargs);
#                } else {
#                    log_trace("[compsah] module %s is not installed, skipped", $mod);
#                }
#            }
#            if ($comp) {
#                my %cargs = (
#                    %{$args{extras} // {}},
#                    word=>$word, arg=>$args{arg}, args=>$args{args},
#                );
#                log_trace("[compsah] using arg completion routine from schema's 'x.completion' attribute with args (%s)", \%cargs);
#                $fres = $comp->(%cargs);
#                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.007 of Complete::Sah (from Perl distribution Complete-Sah), released on 2020-06-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-28'; # 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-28.
#
#=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($optspec, $key_label, $separator, $value_label) -> 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 $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-06-04'; # DATE
#our $DIST = 'Perinci-Sub-Complete'; # DIST
#our $VERSION = '0.943'; # 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 %s\::gen_completion(%s) ...", $mod, $xcargs);
#                        $comp = $fref->(%$xcargs);
#                    } else {
#                        log_trace("[comp][periscomp] module %s is not installed, skipped", $mod);
#                    }
#                }
#                if ($comp) {
#                    log_trace("[comp][periscomp] using arg completion routine from arg spec's 'x.completion' attribute");
#                    last GET_COMP_ROUTINE;
#                }
#            }
#            my $ent = $arg_spec->{'x.schema.entity'};
#            if ($ent) {
#                require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::ArgEntity::$ent";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[comp][periscomp] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    if (defined &{"$mod\::complete_arg_val"}) {
#                        log_trace("[comp][periscomp] invoking complete_arg_val() from %s ...", $mod);
#                        $comp = \&{"$mod\::complete_arg_val"};
#                        last GET_COMP_ROUTINE;
#                    } else {
#                        log_trace("[comp][periscomp] module %s doesn't define complete_arg_val(), skipped", $mod);
#                    }
#                } else {
#                    log_trace("[comp][periscomp] module %s not installed, skipped", $mod);
#                }
#            }
#        } # GET_COMP_ROUTINE
#
#        if ($comp) {
#            if (ref($comp) eq 'CODE') {
#                my %cargs = (
#                    %$extras,
#                    word=>$word, arg=>$arg, args=>$args{args},
#                );
#                log_trace("[comp][periscomp] invoking arg completion routine with args (%s)", \%cargs);
#                $fres = $comp->(%cargs);
#                return; # from eval
#            } elsif (ref($comp) eq 'ARRAY') {
#                # this is deprecated but will be supported for some time
#                log_trace("[comp][periscomp] using array specified in arg completion routine: %s", $comp);
#                $fres = complete_array_elem(array=>$comp, word=>$word);
#                $static++;
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'completion' property is not a coderef or arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_val request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_val => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, word=>$word},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; # from eval
#                }
#                $fres = $res->[2];
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; # from eval
#        }
#
#        my $fres_from_arg_examples;
#      COMPLETE_FROM_ARG_EXAMPLES:
#        {
#            my $egs = $arg_spec->{examples};
#            unless ($egs) {
#                log_trace("[comp][periscomp] arg spec does not specify examples");
#                last COMPLETE_FROM_ARG_EXAMPLES;
#            }
#            my @array;
#            my @summaries;
#            for my $eg (@$egs) {
#                if (ref $eg eq 'HASH') {
#                    next unless defined $eg->{value};
#                    next if ref $eg->{value};
#                    push @array, $eg->{value};
#                    push @summaries, $eg->{summary};
#                } else {
#                    next unless defined $eg;
#                    next if ref $eg;
#                    push @array, $eg;
#                    push @summaries, undef;
#                }
#            }
#            $fres_from_arg_examples = complete_array_elem(
#                word=>$word, array=>\@array, summaries=>\@summaries);
#            $static //= 1;
#        } # COMPLETE_FROM_ARG_EXAMPLES
#
#        my $fres_from_schema;
#      COMPLETE_FROM_SCHEMA:
#        {
#            my $sch = $arg_spec->{schema};
#            unless ($sch) {
#                log_trace("[comp][periscomp] arg spec does not specify schema");
#                last COMPLETE_FROM_SCHEMA;
#            }
#            # XXX normalize schema if not normalized
#            $fres_from_schema = complete_from_schema(
#                arg=>$arg, extras=>$extras, schema=>$sch, word=>$word,
#            );
#            $static //= 1;
#        } # COMPLETE_FROM_SCHEMA
#
#        $fres = combine_answers(grep {defined} (
#            $fres_from_arg_examples,
#            $fres_from_schema,
#        ));
#    };
#    log_debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        log_trace("[comp][periscomp] no completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_val, result=%s", $fres);
#    $fres;
#}
#
#gen_modified_sub(
#    output_name  => 'complete_arg_elem',
#    install_sub  => 0,
#    base_name    => 'complete_arg_val',
#    summary      => 'Given argument name and function metadata, '.
#        'complete array element',
#    add_args     => {
#        index => {
#            summary => 'Index of element to complete',
#            schema  => ['str*'],
#        },
#    },
#);
#sub complete_arg_elem {
#    require Data::Sah::Normalize;
#
#    my %args = @_;
#
#    my $fres;
#
#    log_trace("[comp][periscomp] entering complete_arg_elem, arg=<%s>, index=<%d>",
#                 $args{arg}, $args{index});
#
#    my $extras = $args{extras} // {};
#
#    my $ourextras = {arg=>$args{arg}, args=>$args{args}};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    defined(my $index = $args{index}) or do {
#        log_trace("[comp][periscomp] index is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#    # XXX reject if meta's v is not 1.1
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { # completion sub can die, etc.
#
#        my $elcomp;
#      GET_ELCOMP_ROUTINE:
#        {
#            $elcomp = $arg_spec->{element_completion};
#            if ($elcomp) {
#                log_trace("[comp][periscomp] using arg element completion routine from 'element_completion' property");
#                last GET_ELCOMP_ROUTINE;
#            }
#            my $xelcomp = $arg_spec->{'x.element_completion'};
#            if ($xelcomp) {
#                if (ref($xelcomp) eq 'CODE') {
#                    $elcomp = $xelcomp;
#                } else {
#                    my ($submod, $xcargs);
#                    if (ref($xelcomp) eq 'ARRAY') {
#                        $submod = $xelcomp->[0];
#                        $xcargs = $xelcomp->[1];
#                    } else {
#                        $submod = $xelcomp;
#                        $xcargs = {};
#                    }
#                    my $mod = "Perinci::Sub::XCompletion::$submod";
#                    require Module::Installed::Tiny;
#                    if (Module::Installed::Tiny::module_installed($mod)) {
#                        log_trace("[comp][periscomp] loading module %s ...", $mod);
#                        my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                        require $mod_pm;
#                        my $fref = \&{"$mod\::gen_completion"};
#                        log_trace("[comp][periscomp] invoking %s\::gen_completion(%s) ...", $mod, $xcargs);
#                        $elcomp = $fref->(%$xcargs);
#                    } else {
#                        log_trace("[comp][periscomp] module %s is not installed, skipped", $mod);
#                    }
#                }
#                if ($elcomp) {
#                    log_trace("[comp][periscomp] using arg element completion routine from 'x.element_completion' attribute");
#                    last GET_ELCOMP_ROUTINE;
#                }
#            }
#            my $ent = $arg_spec->{'x.schema.element_entity'};
#            if ($ent) {
#                require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::ArgEntity::$ent";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[comp][periscomp] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    if (defined &{"$mod\::complete_arg_val"}) {
#                        log_trace("[comp][periscomp] invoking complete_arg_val() from %s ...", $mod);
#                        $elcomp = \&{"$mod\::complete_arg_val"};
#                        last GET_ELCOMP_ROUTINE;
#                    } else {
#                        log_trace("[comp][periscomp] module %s doesn't defined complete_arg_val(), skipped", $mod);
#                    }
#                } else {
#                    log_trace("[comp][periscomp] module %s is not installed, skipped", $mod);
#                }
#            }
#        } # GET_ELCOMP_ROUTINE
#
#        $ourextras->{index} = $index;
#        if ($elcomp) {
#            if (ref($elcomp) eq 'CODE') {
#                my %cargs = (
#                    %$extras,
#                    %$ourextras,
#                    word=>$word,
#                );
#                log_trace("[comp][periscomp] invoking arg element completion routine with args (%s)", \%cargs);
#                $fres = $elcomp->(%cargs);
#                return; # from eval
#            } elsif (ref($elcomp) eq 'ARRAY') {
#                log_trace("[comp][periscomp] using array specified in arg element completion routine: %s", $elcomp);
#                $fres = complete_array_elem(array=>$elcomp, word=>$word);
#                $static = $word eq '';
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'element_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_elem request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_elem => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, args=>$args{args}, word=>$word,
#                     index=>$index},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; # from eval
#                }
#                $fres = $res->[2];
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; # from eval
#        } # if ($elcomp)
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            log_trace("[comp][periscomp] arg spec does not specify schema, declining");
#            return; # from eval
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'array') {
#            log_trace("[comp][periscomp] can't complete element for non-array");
#            return; # from eval
#        }
#
#        unless ($cs->{of}) {
#            log_trace("[comp][periscomp] schema does not specify 'of' clause, declining");
#            return; # from eval
#        }
#
#        # normalize subschema because normalize_schema (as of 0.01) currently
#        # does not do it yet
#        my $elsch = Data::Sah::Normalize::normalize_schema($cs->{of});
#
#        $fres = complete_from_schema(
#            schema=>$elsch, word=>$word,
#            schema_is_normalized=>1,
#        );
#    };
#    log_debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        log_trace("[comp][periscomp] no completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_elem, result=%s", $fres);
#    $fres;
#}
#
#$SPEC{complete_arg_index} = {
#    v => 1.1,
#    summary => 'Given argument name and function metadata, complete arg element index',
#    description => <<'_',
#
#This is only relevant for arguments which have `index_completion` property set
#(currently only `hash` type arguments). When that property is not set, will
#simply return undef.
#
#Completion routine will get `%args`, with the following keys:
#
#* `word` (str, the word to be completed)
#* `arg` (str, the argument name which value is currently being completed)
#* `args` (hash, the argument hash to the function, so far)
#
#as well as extra keys from `extras` (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#<pm:Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata, must be normalized',
#            schema => 'hash*',
#            req => 1,
#        },
#        arg => {
#            summary => 'Argument name',
#            schema => 'str*',
#            req => 1,
#        },
#        word => {
#            summary => 'Word to be completed',
#            schema => ['str*', default => ''],
#        },
#        args => {
#            summary => 'Collected arguments so far, '.
#                'will be passed to completion routines',
#            schema  => 'hash',
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array', # XXX of => str*
#    },
#};
#sub complete_arg_index {
#    require Data::Sah::Normalize;
#
#    my %args = @_;
#
#    my $fres;
#
#    log_trace("[comp][periscomp] entering complete_arg_index, arg=<%s>",
#                 $args{arg});
#
#    my $extras = $args{extras} // {};
#
#    my $ourextras = {arg=>$args{arg}, args=>$args{args}};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#    # XXX reject if meta's v is not 1.1
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { # completion sub can die, etc.
#
#        my $idxcomp;
#      GET_IDXCOMP_ROUTINE:
#        {
#            $idxcomp = $arg_spec->{index_completion};
#            if ($idxcomp) {
#                log_trace("[comp][periscomp] using arg element index completion routine from 'index_completion' property");
#                last GET_IDXCOMP_ROUTINE;
#            }
#        } # GET_IDXCOMP_ROUTINE
#
#        if ($idxcomp) {
#            if (ref($idxcomp) eq 'CODE') {
#                my %cargs = (
#                    %$extras,
#                    %$ourextras,
#                    word=>$word,
#                );
#                log_trace("[comp][periscomp] invoking arg element index completion routine with args (%s)", \%cargs);
#                $fres = $idxcomp->(%cargs);
#                return; # from eval
#            } elsif (ref($idxcomp) eq 'ARRAY') {
#                log_trace("[comp][periscomp] using array specified in arg element index completion routine: %s", $idxcomp);
#                $fres = complete_array_elem(array=>$idxcomp, word=>$word);
#                $static = $word eq '';
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'index_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_index request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_index => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, args=>$args{args}, word=>$word},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; # from eval
#                }
#                $fres = $res->[2];
#                return; # from eval
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; # from eval
#        } # if ($idxcomp)
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            log_trace("[comp][periscomp] arg spec does not specify schema, declining");
#            return; # from eval
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'hash') {
#            log_trace("[comp][periscomp] can't complete element index for non-hash");
#            return; # from eval
#        }
#
#        # collect known keys from some clauses
#        my %keys;
#        if ($cs->{keys}) {
#            $keys{$_}++ for keys %{ $cs->{keys} };
#        }
#        if ($cs->{indices}) {
#            $keys{$_}++ for keys %{ $cs->{indices} };
#        }
#        if ($cs->{req_keys}) {
#            $keys{$_}++ for @{ $cs->{req_keys} };
#        }
#        if ($cs->{allowed_keys}) {
#            $keys{$_}++ for @{ $cs->{allowed_keys} };
#        }
#
#        # exclude keys that have been specified in collected args
#        for (keys %{$args{args}{$arg} // {}}) {
#            delete $keys{$_};
#        }
#
#        $fres = complete_hash_key(word => $word, hash => \%keys);
#
#    }; # eval
#    log_debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        log_trace("[comp][periscomp] no index completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_index, result=%s", $fres);
#    $fres;
#}
#
#$SPEC{complete_cli_arg} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using Rinci function metadata',
#    description => <<'_',
#
#This routine uses <pm:Perinci::Sub::GetArgs::Argv> to generate <pm:Getopt::Long>
#specification from arguments list in Rinci function metadata and common options.
#Then, it will use <pm:Complete::Getopt::Long> to complete option names, option
#values, as well as arguments.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata',
#            schema => 'hash*',
#            req => 1,
#        },
#        words => {
#            summary => 'Command-line arguments',
#            schema => ['array*' => {of=>'str*'}],
#            req => 1,
#        },
#        cword => {
#            summary => 'On which argument cursor is located (zero-based)',
#            schema => 'int*',
#            req => 1,
#        },
#        completion => {
#            summary => 'Supply custom completion routine',
#            description => <<'_',
#
#If supplied, instead of the default completion routine, this code will be called
#instead. Will receive all arguments that <pm:Complete::Getopt::Long> will pass,
#and additionally:
#
#* `arg` (str, the name of function argument)
#* `args` (hash, the function arguments formed so far)
#* `index` (int, if completing argument element value)
#
#_
#            schema => 'code*',
#        },
#        per_arg_json => {
#            summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
#            schema  => 'bool',
#        },
#        per_arg_yaml => {
#            summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
#            schema  => 'bool',
#        },
#        common_opts => {
#            summary => 'Common options',
#            description => <<'_',
#
#A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
#option specification), `handler` (Getopt::Long handler). Will be passed to
#`get_args_from_argv()`. Example:
#
#    {
#        help => {
#            getopt  => 'help|h|?',
#            handler => sub { ... },
#            summary => 'Display help and exit',
#        },
#        version => {
#            getopt  => 'version|v',
#            handler => sub { ... },
#            summary => 'Display version and exit',
#        },
#    }
#
#_
#            schema => ['hash*'],
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#        func_arg_starts_at => {
#            schema  => 'int*',
#            default => 0,
#            description => <<'_',
#
#This is a (temporary?) workaround for <pm:Perinci::CmdLine>. In an application
#with subcommands (e.g. `cmd --verbose subcmd arg0 arg1 ...`), then `words` will
#still contain the subcommand name. Positional function arguments then start at 1
#not 0. This option allows offsetting function arguments.
#
#_
#        },
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#        description => <<'_',
#
#You can use `format_completion` function in <pm:Complete::Bash> module to format
#the result of this function for bash.
#
#_
#    },
#};
#sub complete_cli_arg {
#    require Complete::Getopt::Long;
#    require Perinci::Sub::GetArgs::Argv;
#
#    my %args   = @_;
#    my $meta   = $args{meta} or die "Please specify meta";
#    my $words  = $args{words} or die "Please specify words";
#    my $cword  = $args{cword}; defined($cword) or die "Please specify cword";
#    my $copts  = $args{common_opts} // {};
#    my $comp   = $args{completion};
#    my $extras = {
#        %{ $args{extras} // {} },
#        words => $args{words},
#        cword => $args{cword},
#    };
#
#    my $fname = __PACKAGE__ . "::complete_cli_arg"; # XXX use __SUB__
#    my $fres;
#
#    my $word   = $words->[$cword];
#    my $args_prop = $meta->{args} // {};
#
#    log_trace('[comp][periscomp] entering %s(), words=%s, cword=%d, word=<%s>',
#                 $fname, $words, $cword, $word);
#
#    my $ggls_res = Perinci::Sub::GetArgs::Argv::gen_getopt_long_spec_from_meta(
#        meta         => $meta,
#        common_opts  => $copts,
#        per_arg_json => $args{per_arg_json},
#        per_arg_yaml => $args{per_arg_yaml},
#        ignore_converted_code => 1,
#    );
#    die "Can't generate getopt spec from meta: $ggls_res->[0] - $ggls_res->[1]"
#        unless $ggls_res->[0] == 200;
#    $extras->{ggls_res} = $ggls_res;
#    my $gospec = $ggls_res->[2];
#    my $specmeta = $ggls_res->[3]{'func.specmeta'};
#
#    my $gares = Perinci::Sub::GetArgs::Argv::get_args_from_argv(
#        argv   => [@$words],
#        meta   => $meta,
#        strict => 0,
#    );
#
#    my $copts_by_ospec = {};
#    for (keys %$copts) { $copts_by_ospec->{$copts->{$_}{getopt}}=$copts->{$_} }
#
#    my $compgl_comp = sub {
#        log_trace("[comp][periscomp] entering completion routine (that we supply to Complete::Getopt::Long)");
#        my %cargs = @_;
#        my $type  = $cargs{type};
#        my $ospec = $cargs{ospec} // '';
#        my $word  = $cargs{word};
#
#        my $fres;
#
#        my %rargs = (
#            riap_server_url => $args{riap_server_url},
#            riap_uri        => $args{riap_uri},
#            riap_client     => $args{riap_client},
#        );
#
#        $extras->{parsed_opts} = $cargs{parsed_opts};
#
#        if (my $sm = $specmeta->{$ospec}) {
#            $cargs{type} = 'optval';
#            if ($sm->{arg}) {
#                log_trace("[comp][periscomp] completing option value for a known function argument, arg=<%s>, ospec=<%s>", $sm->{arg}, $ospec);
#                $cargs{arg} = $sm->{arg};
#                my $arg_spec = $args_prop->{$sm->{arg}} or goto RETURN_RES;
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                    my $compres;
#                    eval { $compres = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    log_trace("[comp][periscomp] result from 'completion' routine: %s", $compres);
#                    if ($compres) {
#                        $fres = $compres;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($ospec =~ /\@$/) {
#                    $fres = complete_arg_elem(
#                        meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                        word=>$word, index=>$cargs{nth}, # XXX correct index
#                        extras=>$extras, %rargs);
#                    goto RETURN_RES;
#                } elsif ($ospec =~ /\%$/) {
#                    if ($word =~ /(.*?)=(.*)/s) {
#                        my $key = $1;
#                        my $val = $2;
#                        $fres = complete_arg_elem(
#                            meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                            word=>$val, index=>$key,
#                            extras=>$extras, %rargs);
#                        modify_answer(answer=>$fres, prefix=>"$key=");
#                        goto RETURN_RES;
#                    } else {
#                        $fres = complete_arg_index(
#                            meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                            word=>$word, extras=>$extras, %rargs);
#                        modify_answer(answer=>$fres, suffix=>"=");
#                        $fres->{path_sep} = "=";
#                        # XXX actually not entirely correct, we want normal
#                        # escaping but without escaping "=", maybe we should
#                        # allow customizing, e.g. esc_mode=normal, dont_esc="="
#                        # (list of characters to not escape)
#                        $fres->{esc_mode} = "none";
#                        goto RETURN_RES;
#                    }
#                } else {
#                    $fres = complete_arg_val(
#                        meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                        word=>$word, extras=>$extras, %rargs);
#                    goto RETURN_RES;
#                }
#            } else {
#                log_trace("[comp][periscomp] completing option value for a common option, ospec=<%s>", $ospec);
#                $cargs{arg}  = undef;
#                my $codata = $copts_by_ospec->{$ospec};
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{completion}) {
#                    $cargs{arg}  = undef;
#                    log_trace("[comp][periscomp] completing with common option's 'completion' property with args (%s)", \%cargs);
#                    my $res;
#                    eval { $res = $codata->{completion}->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{schema}) {
#                    require Data::Sah::Normalize;
#                    my $nsch = Data::Sah::Normalize::normalize_schema(
#                        $codata->{schema});
#                    log_trace("[comp][periscomp] completing with common option's schema");
#                    $fres = complete_from_schema(
#                        schema => $nsch, word=>$word,
#                        schema_is_normalized=>1,
#                    );
#                    goto RETURN_RES;
#                }
#                goto RETURN_RES;
#            }
#        } elsif ($type eq 'arg') {
#            log_trace("[comp][periscomp] completing argument #%d", $cargs{argpos});
#            $cargs{type} = 'arg';
#
#            my $pos = $cargs{argpos};
#            my $fasa = $args{func_arg_starts_at} // 0;
#
#            # find if there is a non-slurpy argument with the exact position
#            for my $an (keys %$args_prop) {
#                my $arg_spec = $args_prop->{$an};
#                next unless !($arg_spec->{slurpy} // $arg_spec->{greedy}) &&
#                    defined($arg_spec->{pos}) && $arg_spec->{pos} == $pos - $fasa;
#                log_trace("[comp][periscomp] this argument position is for non-slurpy function argument <%s>", $an);
#                $cargs{arg} = $an;
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_val(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            # find if there is a slurpy argument which takes elements at that
#            # position
#            for my $an (sort {
#                ($args_prop->{$b}{pos} // 9999) <=> ($args_prop->{$a}{pos} // 9999)
#            } keys %$args_prop) {
#                my $arg_spec = $args_prop->{$an};
#                next unless ($arg_spec->{slurpy} // $arg_spec->{greedy}) &&
#                    defined($arg_spec->{pos}) && $arg_spec->{pos} <= $pos - $fasa;
#                my $index = $pos - $fasa - $arg_spec->{pos};
#                $cargs{arg} = $an;
#                $cargs{index} = $index;
#                log_trace("[comp][periscomp] this position is for slurpy function argument <%s>'s element[%d]", $an, $index);
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_elem(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, index=>$index, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            log_trace("[comp][periscomp] there is no matching function argument at this position");
#            if ($comp) {
#                log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument with args (%s)", \%cargs);
#                my $res;
#                eval { $res = $comp->(%cargs) };
#                log_debug("[comp][periscomp] completion died: $@") if $@;
#                if ($res) {
#                    $fres = $res;
#                    goto RETURN_RES;
#                }
#            }
#            goto RETURN_RES;
#        } else {
#            log_trace("[comp][periscomp] completing option value for an unknown/ambiguous option, declining ...");
#            # decline because there's nothing in Rinci metadata that can aid us
#            goto RETURN_RES;
#        }
#      RETURN_RES:
#        log_trace("[comp][periscomp] leaving completion routine (that we supply to Complete::Getopt::Long)");
#        $fres;
#    }; # completion routine
#
#    $fres = Complete::Getopt::Long::complete_cli_arg(
#        getopt_spec => $gospec,
#        words       => $words,
#        cword       => $cword,
#        completion  => $compgl_comp,
#        extras      => $extras,
#    );
#
#  RETURN_RES:
#    log_trace('[comp][periscomp] leaving %s(), result=%s',
#                 $fname, $fres);
#    $fres;
#}
#
#1;
## ABSTRACT: Complete command-line argument using Rinci metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Complete - Complete command-line argument using Rinci metadata
#
#=head1 VERSION
#
#This document describes version 0.943 of Perinci::Sub::Complete (from Perl distribution Perinci-Sub-Complete), released on 2020-06-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 $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-09-09'; # DATE
#our $DIST = 'Perinci-Sub-GetArgs-Argv'; # DIST
#our $VERSION = '0.845'; # 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} = {
#                        (summary   => $alspec->{summary}) x !!defined($alspec->{summary}),
#                        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` or `allow_unknown_options`. :-)
#
#_
#        },
#        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.845 of Perinci::Sub::GetArgs::Argv (from Perl distribution Perinci-Sub-GetArgs-Argv), released on 2020-09-09.
#
#=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 extraE<sol>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> or C<allow_unknown_options>. :-)
#
#
#=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) 2020, 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 $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-09-23'; # DATE
#our $DIST = 'Sah-Schemas-Rinci'; # DIST
#our $VERSION = '1.1.94.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 => {},
#                naked_result => {},
#                env_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 => {},
#            },
#        },
#    },
#
#    examples => [
#        {value=>{}, valid=>1},
#        {
#            value=>{v=>1.1, summary=>"Some function", args=>{a1=>{}, a2=>{}}},
#            valid=>1,
#        },
#        # XXX we have not implemented property & attribute checking
#    ],
#
#}, {}];
#
#$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.94.0 of Sah::Schema::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=head1 SYNOPSIS
#
#To check data against this schema (requires L<Data::Sah>):
#
# use Data::Sah qw(gen_validator);
# my $validator = gen_validator("rinci::function_meta*");
# say $validator->($data) ? "valid" : "INVALID!";
#
# # Data::Sah can also create validator that returns nice error message string
# # and/or coerced value. Data::Sah can even create validator that targets other
# # language, like JavaScript. All from the same schema. See its documentation
# # for more details.
#
#To validate function parameters against this schema (requires L<Params::Sah>):
#
# use Params::Sah qw(gen_validator);
#
# sub myfunc {
#     my @args = @_;
#     state $validator = gen_validator("rinci::function_meta*");
#     $validator->(\@args);
#     ...
# }
#
#To specify schema in L<Rinci> function metadata and use the metadata with
#L<Perinci::CmdLine> to create a CLI:
#
# # in lib/MyApp.pm
# package MyApp;
# our %SPEC;
# $SPEC{myfunc} = {
#     v => 1.1,
#     summary => 'Routine to do blah ...',
#     args => {
#         arg1 => {
#             summary => 'The blah blah argument',
#             schema => ['rinci::function_meta*'],
#         },
#         ...
#     },
# };
# sub myfunc {
#     my %args = @_;
#     ...
# }
# 1;
#
# # in myapp.pl
# package main;
# use Perinci::CmdLine::Any;
# Perinci::CmdLine::Any->new(url=>'MyApp::myfunc')->run;
#
# # in command-line
# % ./myapp.pl --help
# myapp - Routine to do blah ...
# ...
#
# % ./myapp.pl --version
#
# % ./myapp.pl --arg1 ...
#
#Sample data:
#
# {}  # valid
#
# {args=>{a1=>{},a2=>{}},summary=>"Some function",v=>1.1}  # valid
#
#=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) 2020, 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 $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-09-23'; # DATE
#our $DIST = 'Sah-Schemas-Rinci'; # DIST
#our $VERSION = '1.1.94.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 => {},
#            },
#        },
#    },
#
#    examples => [
#        {value=>{}, valid=>1},
#        {
#            value=>{summary=>"Some summary"},
#            valid=>1,
#        },
#        # XXX we have not implemented property & attribute checking
#    ],
#
#}, {}];
#
#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.94.0 of Sah::Schema::rinci::meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=head1 SYNOPSIS
#
#To check data against this schema (requires L<Data::Sah>):
#
# use Data::Sah qw(gen_validator);
# my $validator = gen_validator("rinci::meta*");
# say $validator->($data) ? "valid" : "INVALID!";
#
# # Data::Sah can also create validator that returns nice error message string
# # and/or coerced value. Data::Sah can even create validator that targets other
# # language, like JavaScript. All from the same schema. See its documentation
# # for more details.
#
#To validate function parameters against this schema (requires L<Params::Sah>):
#
# use Params::Sah qw(gen_validator);
#
# sub myfunc {
#     my @args = @_;
#     state $validator = gen_validator("rinci::meta*");
#     $validator->(\@args);
#     ...
# }
#
#To specify schema in L<Rinci> function metadata and use the metadata with
#L<Perinci::CmdLine> to create a CLI:
#
# # in lib/MyApp.pm
# package MyApp;
# our %SPEC;
# $SPEC{myfunc} = {
#     v => 1.1,
#     summary => 'Routine to do blah ...',
#     args => {
#         arg1 => {
#             summary => 'The blah blah argument',
#             schema => ['rinci::meta*'],
#         },
#         ...
#     },
# };
# sub myfunc {
#     my %args = @_;
#     ...
# }
# 1;
#
# # in myapp.pl
# package main;
# use Perinci::CmdLine::Any;
# Perinci::CmdLine::Any->new(url=>'MyApp::myfunc')->run;
#
# # in command-line
# % ./myapp.pl --help
# myapp - Routine to do blah ...
# ...
#
# % ./myapp.pl --version
#
# % ./myapp.pl --arg1 ...
#
#Sample data:
#
# {}  # valid
#
# {summary=>"Some summary"}  # valid
#
#=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) 2020, 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 = '2020-09-23'; # DATE
#our $VERSION = '1.1.94.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 => {},
#    },
#
#    examples => [
#        {value=>{}, valid=>1},
#        {
#            value=>{stream=>1},
#            valid=>1,
#        },
#        # XXX we have not implemented property & attribute checking
#    ],
#
#}, {}];
#
#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.94.0 of Sah::Schema::rinci::result_meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=head1 SYNOPSIS
#
#To check data against this schema (requires L<Data::Sah>):
#
# use Data::Sah qw(gen_validator);
# my $validator = gen_validator("rinci::result_meta*");
# say $validator->($data) ? "valid" : "INVALID!";
#
# # Data::Sah can also create validator that returns nice error message string
# # and/or coerced value. Data::Sah can even create validator that targets other
# # language, like JavaScript. All from the same schema. See its documentation
# # for more details.
#
#To validate function parameters against this schema (requires L<Params::Sah>):
#
# use Params::Sah qw(gen_validator);
#
# sub myfunc {
#     my @args = @_;
#     state $validator = gen_validator("rinci::result_meta*");
#     $validator->(\@args);
#     ...
# }
#
#To specify schema in L<Rinci> function metadata and use the metadata with
#L<Perinci::CmdLine> to create a CLI:
#
# # in lib/MyApp.pm
# package MyApp;
# our %SPEC;
# $SPEC{myfunc} = {
#     v => 1.1,
#     summary => 'Routine to do blah ...',
#     args => {
#         arg1 => {
#             summary => 'The blah blah argument',
#             schema => ['rinci::result_meta*'],
#         },
#         ...
#     },
# };
# sub myfunc {
#     my %args = @_;
#     ...
# }
# 1;
#
# # in myapp.pl
# package main;
# use Perinci::CmdLine::Any;
# Perinci::CmdLine::Any->new(url=>'MyApp::myfunc')->run;
#
# # in command-line
# % ./myapp.pl --help
# myapp - Routine to do blah ...
# ...
#
# % ./myapp.pl --version
#
# % ./myapp.pl --arg1 ...
#
#Sample data:
#
# {}  # valid
#
# {stream=>1}  # valid
#
#=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) 2020, 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 = '2020-09-23'; # DATE
#our $VERSION = '1.1.94.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,examples=>[{valid=>1,value=>{}},{valid=>1,value=>{args=>{a1=>{},a2=>{}},summary=>"Some function",v=>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',env_result=>{},naked_result=>{},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,examples=>'fix',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][0]{examples}=$a->[1][0]{_prop}{args}{_value_prop}{element_meta}{examples};$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.94.0 of Sah::SchemaR::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=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) 2020, 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 = '2020-09-23'; # DATE
#our $VERSION = '1.1.94.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,examples=>[{valid=>1,value=>{}},{valid=>1,value=>{summary=>"Some summary"}}],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.94.0 of Sah::SchemaR::rinci::meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=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) 2020, 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 = '2020-09-23'; # DATE
#our $VERSION = '1.1.94.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,examples=>[{valid=>1,value=>{}},{valid=>1,value=>{stream=>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.94.0 of Sah::SchemaR::rinci::result_meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=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) 2020, 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 = '2020-09-23'; # DATE
#our $VERSION = '1.1.94.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.94.0 of Sah::Schemas::Rinci (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=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) 2020, 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;