—

              
#!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.10
# on Fri Jun  9 18:15:13 2017. You probably should not manually edit this file.
# NO_PERINCI_CMDLINE_SCRIPT
# PERINCI_CMDLINE_COMPLETER_SCRIPT: {program_name=>"check-module-version",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/Module/CheckVersion/check_module_version"}
# FRAGMENT id=shcompgen-hint completer=1 for=check-module-version
our $DATE = '2017-06-09'; # DATE
our $VERSION = '0.08'; # VERSION
# PODNAME: _check-module-version
# ABSTRACT: Completer script for check-module-version
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=>"check-module-version",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>undef,url=>"/Module/CheckVersion/check_module_version"};
my $meta = {_orig_args_as=>undef,_orig_result_naked=>undef,args=>{check_latest_version=>{default=>1,schema=>["bool",{},{}]},default_authority_scheme=>{default=>"cpan",description=>"\nIf a module does not set `\$AUTHORITY` (which contains string like\n`<scheme>:<extra>` like `cpan:PERLANCAR`), the default authority scheme will be\ndetermined from this setting. The module `Module::CheckVersion::<scheme>` module\nis used to implement actual checking.\n\nCan also be set to undef, in which case when module's `\$AUTHORITY` is not\navailable, will return 412 status.\n\n",schema=>["str",{},{}]},module=>{description=>"\nThis routine will try to load the module, and retrieve its `\$VERSION`. If\nloading fails will assume module's installed version is undef.\n\n",pos=>0,req=>1,schema=>["str",{match=>qr(\A\w+(::\w+)*\z),req=>1},{}]}},args_as=>"hash",description=>"\nDesigned to be more general and able to provide more information in the future\nin addition to mere checking of latest version, but checking latest version is\ncurrently the only implemented feature.\n\nCan handle non-CPAN modules, as long as you put the appropriate `\$AUTHORITY` in\nyour modules and create the `Module::CheckVersion::<scheme>` to handle your\nauthority scheme.\n\n",entity_date=>undef,entity_v=>undef,result_naked=>0,summary=>"Check module (e.g. check latest version) with CPAN (or equivalent repo)",v=>1.1};
my $sc_metas = {};
my $copts = {format=>{default=>undef,getopt=>"format=s",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$r->{'format'} = $val},is_settable_via_config=>1,schema=>["str*","in",["text","text-simple","text-pretty","json","json-pretty","csv","html","html+datatables"]],summary=>"Choose output format, e.g. json, text",tags=>["category:output"]},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"]},version=>{getopt=>"version|v",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$r->{'action'} = 'version';$r->{'skip_parse_subcommand_argv'} = 1},summary=>"Display program's version and exit",usage=>"--version (or -v)"}};
my $r = {};
# get words
my $shell;
my ($words, $cword);
if ($ENV{COMP_LINE}) { $shell = "bash"; require Complete::Bash; require Encode; ($words,$cword) = @{ Complete::Bash::parse_cmdline() }; ($words,$cword) = @{ Complete::Bash::join_wordbreak_words($words,$cword) }; $words = [map {Encode::decode("UTF-8", $_)} @$words]; }
elsif ($ENV{COMMAND_LINE}) { $shell = "tcsh"; require Complete::Tcsh; ($words,$cword) = @{ Complete::Tcsh::parse_cmdline() }; }
@ARGV = @$words;
# strip program name
shift @$words; $cword--;
# parse common_opts which potentially sets subcommand
{
    require Getopt::Long;
    my $old_go_conf = Getopt::Long::Configure('pass_through', 'no_ignore_case', 'bundling', 'no_auto_abbrev', 'no_getopt_compat', 'gnu_compat');
    my @go_spec;
    for my $k (keys %$copts) { push @go_spec, $copts->{$k}{getopt} => sub { my ($go, $val) = @_; $copts->{$k}{handler}->($go, $val, $r); } }
    Getopt::Long::GetOptions(@go_spec);
    Getopt::Long::Configure($old_go_conf);
}
# select subcommand
my $scn = $r->{subcommand_name};
my $scn_from = $r->{subcommand_name_from};
if (!defined($scn) && defined($args->{default_subcommand})) {
    # get from default_subcommand
    if ($args->{get_subcommand_from_arg} == 1) {
        $scn = $args->{default_subcommand};
        $scn_from = "default_subcommand";
    } elsif ($args->{get_subcommand_from_arg} == 2 && !@ARGV) {
        $scn = $args->{default_subcommand};
        $scn_from = "default_subcommand";
    }
}
if (!defined($scn) && $args->{subcommands} && @ARGV) {
    # get from first command-line arg
    $scn = shift @ARGV;
    $scn_from = "arg";
}
if (defined($scn) && !$sc_metas->{$scn}) { undef $scn } # unknown subcommand name
# XXX read_env
# complete with periscomp
my $compres;
{
    require Perinci::Sub::Complete;
    $compres = Perinci::Sub::Complete::complete_cli_arg(
        meta => defined($scn) ? $sc_metas->{$scn} : $meta,
        words => $words,
        cword => $cword,
        common_opts => $copts,
        riap_server_url => undef,
        riap_uri => undef,
        extras => {r=>$r, cmdline=>undef},
        func_arg_starts_at => (($scn_from//"") eq "arg" ? 1:0),
        completion => sub {
            my %args = @_;
            my $type = $args{type};
            # user specifies custom completion routine, so use that first
            if ($args->{completion}) {
                my $res = $args->{completion}->(%args);
                return $res if $res;
            }
            # if subcommand name has not been supplied and we're at arg#0,
            # complete subcommand name
            if ($args->{subcommands} &&
                $scn_from ne "--cmd" &&
                     $type eq "arg" && $args{argpos}==0) {
                require Complete::Util;
                return Complete::Util::complete_array_elem(
                    array => [keys %{ $args->{subcommands} }],
                    word  => $words->[$cword]);
            }
            # otherwise let periscomp do its thing
            return undef;
        },
    );
}
# display result
if    ($shell eq "bash") { print Complete::Bash::format_completion($compres, {word=>$words->[$cword]}) }
elsif ($shell eq "tcsh") { print Complete::Tcsh::format_completion($compres) }
HideShow 41 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
_check-module-version - Completer script for check-module-version
=head1 VERSION
This document describes version 0.08 of Perinci::CmdLine::Base (from Perl distribution Module-CheckVersion), released on 2017-06-09.
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/Module-CheckVersion>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-Module-CheckVersion>.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Module-CheckVersion>
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, 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
__DATA__
Data::Section::Seekable v1
Clone/PP.pm,20,1884,0;0
Complete/Bash.pm,1929,17459,1;71
Complete/Common.pm,19415,945,2;596
Complete/Env.pm,20384,2999,3;635
Complete/File.pm,23408,8532,4;760
Complete/Getopt/Long.pm,31972,18507,5;1033
Complete/Path.pm,50504,7990,6;1587
Complete/Tcsh.pm,58519,2757,7;1848
Complete/Util.pm,61301,20695,8;1953
Data/Clean.pm,82018,7970,9;2663
Data/Clean/FromJSON.pm,90019,536,10;2935
Data/Clean/JSON.pm,90582,1140,11;2967
Data/Dmp.pm,91742,4396,12;3019
Data/ModeMerge.pm,96164,10593,13;3203
Data/ModeMerge/Config.pm,106790,2140,14;3521
Data/ModeMerge/Mode/ADD.pm,108965,1373,15;3592
Data/ModeMerge/Mode/Base.pm,110374,16705,16;3661
Data/ModeMerge/Mode/CONCAT.pm,127117,442,17;4191
Data/ModeMerge/Mode/DELETE.pm,127597,1218,18;4219
Data/ModeMerge/Mode/KEEP.pm,128851,1174,19;4294
Data/ModeMerge/Mode/NORMAL.pm,130063,1501,20;4362
Data/ModeMerge/Mode/SUBTRACT.pm,131604,2064,21;4455
Data/Sah/Normalize.pm,133698,6073,22;4547
Data/Sah/Resolve.pm,139799,3692,23;4728
Data/Sah/Util/Type.pm,143521,3406,24;4836
Function/Fallback/CoreOrPP.pm,146965,1761,25;4965
Getopt/Long/Negate/EN.pm,148759,1797,26;5056
Getopt/Long/Util.pm,150584,9068,27;5108
Lingua/EN/PluralToSingular.pm,159690,5931,28;5439
Log/Any.pm,165640,2731,29;5851
Log/Any/Adapter.pm,168398,367,30;5965
Log/Any/Adapter/Base.pm,168797,772,31;5994
Log/Any/Adapter/File.pm,169601,1925,32;6031
Log/Any/Adapter/Null.pm,171558,382,33;6098
Log/Any/Adapter/Stderr.pm,171974,1229,34;6121
Log/Any/Adapter/Stdout.pm,173237,1229,35;6171
Log/Any/Adapter/Test.pm,174498,4762,36;6221
Log/Any/Adapter/Util.pm,179292,3230,37;6418
Log/Any/IfLOG.pm,182547,1381,38;6575
Log/Any/Manager.pm,183955,5286,39;6640
Log/Any/Proxy.pm,189266,2544,40;6836
Log/Any/Proxy/Null.pm,191840,937,41;6926
Log/Any/Proxy/Test.pm,192807,499,42;6972
Log/Any/Test.pm,193330,275,43;7003
Mo.pm,193619,591,44;7019
Mo/Golf.pm,194229,7519,45;7023
Mo/Inline.pm,201769,2047,46;7240
Mo/Moose.pm,203836,533,47;7326
Mo/Mouse.pm,204389,563,48;7331
Mo/build.pm,204972,248,49;7336
Mo/builder.pm,205242,338,50;7340
Mo/chain.pm,205600,216,51;7344
Mo/coerce.pm,205837,330,52;7348
Mo/default.pm,206189,435,53;7352
Mo/exporter.pm,206647,176,54;7356
Mo/import.pm,206844,185,55;7360
Mo/importer.pm,207052,207,56;7364
Mo/is.pm,207276,228,57;7368
Mo/nonlazy.pm,207526,129,58;7372
Mo/option.pm,207676,259,59;7376
Mo/required.pm,207958,340,60;7380
Mo/xs.pm,208315,256,61;7384
Module/Installed/Tiny.pm,208604,3030,62;7388
Perinci/Sub/Complete.pm,211666,46145,63;7505
Perinci/Sub/GetArgs/Argv.pm,257847,38098,64;8716
Perinci/Sub/GetArgs/Array.pm,295982,3800,65;9765
Perinci/Sub/Normalize.pm,299815,4885,66;9896
Perinci/Sub/Util.pm,304728,12303,67;10048
Perinci/Sub/Util/Args.pm,317064,3131,68;10486
Perinci/Sub/Util/ResObj.pm,320230,243,69;10603
Perinci/Sub/Util/Sort.pm,320506,463,70;10618
Regexp/Stringify.pm,320997,2473,71;10647
Sah/Schema/rinci/function_meta.pm,323512,3632,72;10746
Sah/Schema/rinci/meta.pm,327177,683,73;10884
Sah/Schema/rinci/result_meta.pm,327900,611,74;10927
Sah/SchemaR/rinci/function_meta.pm,328554,7833,75;10962
Sah/SchemaR/rinci/meta.pm,336421,1990,76;11133
Sah/SchemaR/rinci/result_meta.pm,338452,960,77;11192
Sah/Schemas/Rinci.pm,339441,108,78;11233
String/LineNumber.pm,339578,859,79;11242
String/PerlQuote.pm,340465,890,80;11282
String/Wildcard/Bash.pm,341387,2159,81;11332
YAML/Old.pm,343566,2533,82;11420
YAML/Old/Dumper.pm,346126,14625,83;11521
YAML/Old/Dumper/Base.pm,360783,3367,84;12025
YAML/Old/Error.pm,364176,5986,85;12128
YAML/Old/Loader.pm,370189,21662,86;12319
YAML/Old/Loader/Base.pm,391883,1025,87;13018
YAML/Old/Marshall.pm,392937,939,88;13051
YAML/Old/Mo.pm,393899,2688,89;13098
YAML/Old/Node.pm,396612,4412,90;13170
YAML/Old/Tag.pm,401048,240,91;13388
YAML/Old/Types.pm,401314,5701,92;13407
### Clone/PP.pm ###
#package Clone::PP;
#
#use 5.006;
#use strict;
#use warnings;
#use vars qw($VERSION @EXPORT_OK);
#use Exporter;
#
#$VERSION = 1.06;
#
#@EXPORT_OK = qw( clone );
#sub import { goto &Exporter::import } 
#
#use vars qw( $CloneSelfMethod $CloneInitMethod );
#$CloneSelfMethod ||= 'clone_self';
#$CloneInitMethod ||= 'clone_init';
#
#use vars qw( %CloneCache );
#
#sub clone {
#  my $source = shift;
#
#  return undef if not defined($source);
#  
#  my $depth = shift;
#  return $source if ( defined $depth and $depth -- < 1 );
#  
#  local %CloneCache = ( undef => undef ) unless ( exists $CloneCache{undef} );
#  
#  return $CloneCache{ $source } if ( defined $CloneCache{ $source } );
#  
#  my $ref_type = ref $source or return $source;
#  
#  my $class_name;
#  if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
#    $class_name = $ref_type;
#    $ref_type = $1;
#    return $CloneCache{ $source } = $source->$CloneSelfMethod() 
#                                 if $source->can($CloneSelfMethod);
#  }
#  
#  
#  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 {
#    $CloneCache{ $source } = $copy = $source;
#  }
#  
#  if ( $class_name ) {
#    bless $copy, $class_name;
#    $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
#  }
#  
#  return $copy;
#}
#
#1;
#
#__END__
#
### Complete/Bash.pm ###
#package Complete::Bash;
#
#our $DATE = '2016-12-28'; 
#our $VERSION = '0.31'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#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"; 
#}
#
#sub _add_unquoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word, $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;
#
#
#    my @words;
#    my $cword;
#    my $pos = 0;
#    my $pos_min_ws = 0;
#    my $after_ws = 1; 
#    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] //= '';
#
#    [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
#    v => 1.1,
#    summary => 'Post-process parse_cmdline() result by joining some words',
#    description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
#    "'@><=;|&(:
#
#So if command-line is:
#
#    command -MData::Dump bob@example.org
#
#then they will be parsed as:
#
#    ["command", "-MData", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
#    ["command", "-MData::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
#    my ($words, $cword) = @_;
#    my $new_words = [];
#    my $i = -1;
#    while (++$i < @$words) {
#        my $w = $words->[$i];
#        if ($w =~ /\A[\@=:]+\z/) {
#            if (@$new_words and $#$new_words != $cword) {
#                $new_words->[-1] .= $w;
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            } else {
#                push @$new_words, $w;
#            }
#            if ($i+1 < @$words) {
#                $i++;
#                $new_words->[-1] .= $words->[$i];
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            }
#        } else {
#            push @$new_words, $w;
#        }
#    }
#    [$new_words, $cword];
#}
#
#$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:
#
#* `as` (str): 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` (str): Escaping mode for entries. Either `default` (most
#  nonalphanumeric characters will be escaped), `shellvar` (like `default`, but
#  dollar sign `$` will not 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).
#
#* `path_sep` (str): If set, will enable "path mode", useful for
#  completing/drilling-down path. Below is the description of "path mode".
#
#  In shell, when completing filename (e.g. `foo`) and there is only a single
#  possible completion (e.g. `foo` or `foo.txt`), the shell will display the
#  completion in the buffer and automatically add a space so the user can move to
#  the next argument. This is also true when completing other values like
#  variables or program names.
#
#  However, when completing directory (e.g. `/et` or `Downloads`) and there is
#  solely a single completion possible and it is a directory (e.g. `/etc` or
#  `Downloads`), the shell automatically adds the path separator character
#  instead (`/etc/` or `Downloads/`). The user can press Tab again to complete
#  for files/directories inside that directory, and so on. This is obviously more
#  convenient compared to when shell adds a space instead.
#
#  The `path_sep` option, when set, will employ a trick to mimic this behaviour.
#  The trick is, if you have a completion array of `['foo/']`, it will be changed
#  to `['foo/', 'foo/ ']` (the second element is the first element with added
#  space at the end) to prevent bash from adding a space automatically.
#
#  Path mode is not restricted to completing filesystem paths. Anything path-like
#  can use it. For example when you are completing Java or Perl module name (e.g.
#  `com.company.product.whatever` or `File::Spec::Unix`) you can use this mode
#  (with `path_sep` appropriately set to, e.g. `.` or `::`).
#
#_
#    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 => {
#            schema=>'hash*',
#            pos=>1,
#        },
#    },
#    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 $comp     = $hcomp->{words};
#    my $as       = $hcomp->{as} // 'string';
#    my $esc_mode = $hcomp->{esc_mode} // $hcomp->{escmode} // 'default';
#    my $path_sep = $hcomp->{path_sep};
#
#    if (defined($path_sep) && @$comp == 1) {
#        my $re = qr/\Q$path_sep\E\z/;
#        my $word;
#        if (ref($comp->[0]) eq 'HASH') {
#            $comp = [$comp->[0], {word=>"$comp->[0] "}] if
#                $comp->[0]{word} =~ $re;
#        } else {
#            $comp = [$comp->[0], "$comp->[0] "]
#                if $comp->[0] =~ $re;
#        }
#    }
#
#    if (defined($opts->{word})) {
#        if ($opts->{word} =~ s/(.+[\@><=;|&\(:])//) {
#            my $prefix = $1;
#            for (@$comp) {
#                if (ref($_) eq 'HASH') {
#                    $_->{word} =~ s/\A\Q$prefix\E//i;
#                } else {
#                    s/\A\Q$prefix\E//i;
#                }
#            }
#        }
#    }
#
#    my @res;
#    for my $entry (@$comp) {
#        my $word = ref($entry) eq 'HASH' ? $entry->{word} : $entry;
#        if ($esc_mode eq 'shellvar') {
#            $word =~ s!([^A-Za-z0-9,+._/\$~-])!\\$1!g;
#        } elsif ($esc_mode eq 'none') {
#        } else {
#            $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
#        }
#        push @res, $word;
#    }
#
#    if ($as eq 'array') {
#        return \@res;
#    } else {
#        return join("", map {($_, "\n")} @res);
#    }
#}
#
#1;
#
#__END__
#
### Complete/Common.pm ###
#package Complete::Common;
#
#our $DATE = '2016-01-05'; 
#our $VERSION = '0.22'; 
#
#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;
#
#__END__
#
### Complete/Env.pm ###
#package Complete::Env;
#
#our $DATE = '2016-10-18'; 
#our $VERSION = '0.39'; 
#
#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 => {
#        word     => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
#    },
#    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 => {
#        word     => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
#        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 => {
#        word     => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_path_env_elem {
#    my %args  = @_;
#    complete_env_elem(word => $args{word}, env => 'PATH');
#}
#
#1;
#
#__END__
#
### Complete/File.pm ###
#package Complete::File;
#
#our $DATE = '2016-10-20'; 
#our $VERSION = '0.42'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#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;
#
#    my $result_prefix;
#    my $starting_path = $args{starting_path} // '.';
#    if ($handle_tilde && $word =~ s!\A(~[^/]*)/!!) {
#        $result_prefix = "$1/";
#        my @dir = File::Glob::glob($1); 
#        return [] unless @dir;
#        $starting_path = Encode::decode('UTF-8', $dir[0]);
#    } elsif ($allow_dot && $word =~ s!\A((?:\.\.?/+)+|/+)!!) {
#        $starting_path = $1;
#        $result_prefix = $1;
#        $starting_path =~ s#/+\z## unless $starting_path =~ m!\A/!;
#    }
#
#    return [] if !$allow_dot &&
#        $word =~ m!(?:\A|/)\.\.?(?:\z|/)!;
#
#    my $list = sub {
#        my ($path, $intdir, $isint) = @_;
#        opendir my($dh), $path or return undef;
#        my @res;
#        for (sort readdir $dh) {
#            next if ($_ eq '.' || $_ eq '..') && $intdir eq '';
#            next if $isint && !(-d "$path/$_");
#            push @res, Encode::decode('UTF-8', $_);
#        }
#        \@res;
#    };
#
#
#    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};
#    }
#
#    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;
#        };
#    }
#
#    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;
#        };
#    }
#
#    my $filter_dir;
#    if ($args{_dir}) {
#        $filter_dir = sub { return 0 unless (-d $_[0]); 1 };
#    }
#
#    my $filter_xdir;
#    if ($args{exclude_dir}) {
#        $filter_xdir = sub { return 0 if (-d $_[0]); 1 };
#    }
#
#    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;
#    };
#
#    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,
#    );
#}
#
#$SPEC{complete_dir} = do {
#    my $spec = {%{ $SPEC{complete_file} }}; 
#
#    $spec->{summary} = 'Complete directory from local filesystem '.
#        '(wrapper for complete_dir() that only picks directories)';
#    $spec->{args} = { %{$spec->{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;
#
#__END__
#
### Complete/Getopt/Long.pm ###
#package Complete::Getopt::Long;
#
#our $DATE = '2017-01-13'; 
#our $VERSION = '0.46'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_cli_arg
#               );
#
#our %SPEC;
#
#sub _default_completion {
#    require Complete::Env;
#    require Complete::File;
#    require Complete::Util;
#
#    my %args = @_;
#    my $word = $args{word} // '';
#
#    my $fres;
#
#    if ($word =~ /\A\$/) {
#        {
#            my $compres = Complete::Env::complete_env(
#                word=>$word);
#            last unless @$compres;
#            $fres = {words=>$compres, esc_mode=>'shellvar'};
#            goto RETURN_RES;
#        }
#    }
#
#    if ($word =~ m!\A~([^/]*)\z!) {
#        {
#            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 ($word =~ m!\A(~[^/]*)/!) {
#        $fres = {words=>Complete::File::complete_file(word=>$word),
#                 path_sep=>'/'};
#        goto RETURN_RES;
#    }
#
#    require String::Wildcard::Bash;
#    if (String::Wildcard::Bash::contains_wildcard($word)) {
#        {
#            my $compres = [glob("$word*")];
#            last unless @$compres;
#            for (@$compres) {
#                $_ .= "/" if (-d $_);
#            }
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#    }
#    $fres = {words=>Complete::File::complete_file(word=>$word),
#             path_sep=>'/'};
#  RETURN_RES:
#    $fres;
#}
#
#sub _expand1 {
#    my ($opt, $opts) = @_;
#    my @candidates;
#    my $is_hash = ref($opts) eq 'HASH';
#    for ($is_hash ? (sort {length($a)<=>length($b)} keys %$opts) : @$opts) {
#        next unless index($_, $opt) == 0;
#        push @candidates, $is_hash ? $opts->{$_} : $_;
#        last if $opt eq $_;
#    }
#    return @candidates == 1 ? $candidates[0] : undef;
#}
#
#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  => 'hash*',
#            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"; 
#    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;
#
#
#    my %opts;
#    for my $ospec (keys %$gospec) {
#        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 @o = $res->{is_neg} && length($o0) > 1 ?
#                ($o0, "no$o0", "no-$o0") : ($o0);
#            for my $o (@o) {
#                my $k = length($o)==1 ||
#                    (!$bundling && $res->{dash_prefix} eq '-') ?
#                        "-$o" : "--$o";
#                $opts{$k} = {
#                    name => $k,
#                    ospec => $ospec, 
#                    parsed => $res,
#                };
#            }
#        }
#    }
#    my @optnames = sort keys %opts;
#
#    my %seen_opts;
#
#
#    my @expects;
#
#    my $i = -1;
#    my $argpos = 0;
#
#  WORD:
#    while (1) {
#        last WORD if ++$i >= @words;
#        my $word = $words[$i];
#
#        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-/) {
#
#          SHORT_OPTS:
#            {
#                last unless $opts{"-".substr($word,1,1)};
#
#                last unless $bundling;
#
#                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) {
#                        @inswords = ();
#                        $expects[$i]{short_only} = 0;
#                        $rest = $word;
#                        last EXPAND;
#                    }
#                    if ($opthash->{parsed}{max_vals}) {
#                        _mark_seen(\%seen_opts, $opt, \%opts);
#
#                        if ($i == $j) {
#                            $words[$i] = $opt;
#                        } else {
#                            push @inswords, $opt;
#                            $j++;
#                        }
#
#                        my $expand;
#                        if (length $rest) {
#                            $expand++;
#                            $expects[$j > $i ? $j+1 : $j+2]{do_complete_optname} = 0;
#                            $expects[$j > $i ? $j+1 : $j+2]{optval} = $opt;
#                        } else {
#                            $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;
#                    }
#                    _mark_seen(\%seen_opts, $opt, \%opts);
#                    if ($i == $j) {
#                        $words[$i] = $opt;
#                    } else {
#                        push @inswords, $opt;
#                    }
#                    $j++;
#                }
#
#
#                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;
#            } 
#
#          SPLIT_EQUAL:
#            {
#                if ($word =~ /\A(--?[^=]+)(=)(.*)/) {
#                    splice @words, $i, 1, $1, $2, $3;
#                    $word = $1;
#                    $cword += 2 if $cword >= $i;
#                }
#            }
#
#            my $opt = $word;
#            my $opthash = _expand1($opt, \%opts);
#
#            if ($opthash) {
#                $opt = $opthash->{name};
#                $expects[$i]{optname} = $opt;
#                my $nth = $seen_opts{$opt} // 0;
#                $expects[$i]{nth} = $nth;
#                _mark_seen(\%seen_opts, $opt, \%opts);
#
#                my $min_vals = $opthash->{parsed}{min_vals};
#                my $max_vals = $opthash->{parsed}{max_vals};
#
#                if ($i+1 < @words && $words[$i+1] eq '=') {
#                    $i++;
#                    $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
#                    if (!$max_vals) { $min_vals = $max_vals = 1 }
#                }
#
#                for (1 .. $min_vals) {
#                    $i++;
#                    last WORD if $i >= @words;
#                    $expects[$i]{optval} = $opt;
#                    $expects[$i]{nth} = $nth;
#                    push @{ $parsed_opts{$opt} }, $words[$i];
#                }
#                for (1 .. $max_vals-$min_vals) {
#                    last if $i+$_ >= @words;
#                    last if $words[$i+$_] =~ /\A-/; 
#                    $expects[$i+$_]{optval} = $opt; 
#                    $expects[$i]{nth} = $nth;
#                    push @{ $parsed_opts{$opt} }, $words[$i+$_];
#                }
#            } else {
#                $opt = undef;
#                $expects[$i]{optname} = $opt;
#
#                if ($i+1 < @words && $words[$i+1] eq '=') {
#                    $i++;
#                    $expects[$i] = {separator=>1, optval=>undef, word=>''};
#                    if ($i+1 < @words) {
#                        $i++;
#                        $expects[$i]{optval} = $opt;
#                    }
#                }
#            }
#        } else {
#            $expects[$i]{optname} = '';
#            $expects[$i]{arg} = 1;
#            $expects[$i]{argpos} = $argpos++;
#        }
#    }
#
#    my $exp = $expects[$cword];
#    my $word = $exp->{word} // $words[$cword];
#
#
#    my @answers;
#
#    {
#        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;
#        }
#        my $opt = $exp->{optname};
#        my @o;
#        for (@optnames) {
#            my $repeatable = 0;
#            next if $exp->{short_only} && /\A--/;
#            if ($seen_opts{$_}) {
#                my $opthash = $opts{$_};
#                my $ospecval = $gospec->{$opthash->{ospec}};
#                my $parsed = $opthash->{parsed};
#                if (ref($ospecval) eq 'ARRAY') {
#                    $repeatable = 1;
#                } elsif ($parsed->{desttype} || $parsed->{is_inc}) {
#                    $repeatable = 1;
#                }
#            }
#            next if $seen_opts{$_} && !$repeatable && (
#                (!$opt || $opt ne $_) ||
#                    (defined($exp->{prefix}) &&
#                         index($exp->{prefix}, substr($opt, 1, 1)) >= 0));
#            if (defined $exp->{prefix}) {
#                my $o = $_; $o =~ s/\A-//;
#                push @o, "$exp->{prefix}$o";
#            } else {
#                push @o, $_;
#            }
#        }
#        my $compres = Complete::Util::complete_array_elem(
#            array => \@o, word => $word);
#        push @answers, $compres;
#        if (!exists($exp->{optval}) && !exists($exp->{arg})) {
#            $fres = {words=>$compres, esc_mode=>'option'};
#            goto RETURN_RES;
#        }
#    }
#
#    {
#        last unless exists($exp->{optval});
#        my $opt = $exp->{optval};
#        my $opthash = $opts{$opt} if $opt;
#        my %compargs = (
#            %$extras,
#            type=>'optval', words=>\@words, cword=>$args{cword},
#            word=>$word, opt=>$opt, ospec=>$opthash->{ospec},
#            argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
#            parsed_opts=>\%parsed_opts,
#        );
#        my $compres;
#        if ($comp) {
#            $compres = $comp->(%compargs);
#            Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
#                if defined $exp->{prefix};
#        }
#        if (!$compres || !$comp) {
#            $compres = _default_completion(%compargs);
#            Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
#                if defined $exp->{prefix};
#        }
#        push @answers, $compres;
#    }
#
#    {
#        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,
#        );
#        my $compres = $comp->(%compargs) if $comp;
#        if (!defined $compres) {
#            $compres = _default_completion(%compargs);
#        }
#        push @answers, $compres;
#    }
#
#    $fres = Complete::Util::combine_answers(@answers) // [];
#
#  RETURN_RES:
#    $fres;
#}
#
#1;
#
#__END__
#
### Complete/Path.pm ###
#package Complete::Path;
#
#our $DATE = '2016-06-17'; 
#our $VERSION = '0.23'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#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; 
#            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_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!;
#
#    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;
#    }
#
#    my $leaf = pop @intermediate_dirs;
#    @intermediate_dirs = ('') if !@intermediate_dirs;
#
#
#    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) {
#            @dirs = ($starting_path);
#        } else {
#            @dirs = @candidate_paths;
#        }
#
#        if ($i == $#intermediate_dirs && $intdir eq '') {
#            @candidate_paths = @dirs;
#            last;
#        }
#
#        my @new_candidate_paths;
#        for my $dir (@dirs) {
#            my $listres = $list_func->($dir, $intdir, 1);
#            next unless $listres && @$listres;
#            my $matches = Complete::Util::complete_array_elem(
#                word => $intdir, array => $listres,
#            );
#            my $exact_matches = [grep {
#                $_ eq $intdir || $_ eq $intdir_with_path_sep
#            } @$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;
#            }
#
#        }
#        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) {
#        my $listres = $list_func->($dir, $leaf, 0);
#        next unless $listres && @$listres;
#        my $matches = Complete::Util::complete_array_elem(
#            word => $leaf, array => $listres,
#        );
#
#      L1:
#        for my $e (@$matches) {
#            my $p = $dir =~ $re_ends_with_path_sep ?
#                "$dir$e" : "$dir$path_sep$e";
#            {
#                local $_ = $p; 
#                next L1 if $filter_func && !$filter_func->($p);
#            }
#
#            my $is_dir;
#            if ($e =~ $re_ends_with_path_sep) {
#                $is_dir = 1;
#            } else {
#                local $_ = $p; 
#                $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;
#
#                    if ($p =~ $re_ends_with_path_sep) {
#                        $is_dir = 1;
#                    } else {
#                        local $_ = $p; 
#                        $is_dir = $is_dir_func->($p);
#                    }
#                }
#            }
#
#            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;
#
#__END__
#
### Complete/Tcsh.pm ###
#package Complete::Tcsh;
#
#our $DATE = '2015-09-09'; 
#our $VERSION = '0.02'; 
#
#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;
#
#__END__
#
### Complete/Util.pm ###
#package Complete::Util;
#
#our $DATE = '2016-12-10'; 
#our $VERSION = '0.58'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#use Complete::Common qw(:all);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       hashify_answer
#                       arrayify_answer
#                       combine_answers
#                       modify_answer
#                       complete_array_elem
#                       complete_hash_key
#                       complete_comma_sep
#               );
#
#our %SPEC;
#
#our $COMPLETE_UTIL_TRACE = $ENV{COMPLETE_UTIL_TRACE} // 0;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'General completion routine',
#    description => <<'_',
#
#This package provides some generic completion routine that follows the
#<pm:Complete> convention (if you are looking for bash/shell tab completion
#routine, 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 => {
#        arg => {
#            summary => '',
#            schema  => ['any*' => of => ['array*','hash*']],
#            req => 1,
#            pos => 0,
#        },
#        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 => {
#        arg => {
#            summary => '',
#            schema  => ['any*' => of => ['array*','hash*']],
#            req => 1,
#            pos => 0,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'array*',
#    },
#};
#sub arrayify_answer {
#    my $ans = shift;
#    if (ref($ans) eq 'HASH') {
#        $ans = $ans->{words};
#    }
#    $ans;
#}
#
#sub __min(@) {
#    my $m = $_[0];
#    for (@_) {
#        $m = $_ if $_ < $m;
#    }
#    $m;
#}
#
#our $code_editdist;
#our $editdist_flex;
#
#sub __editdist {
#    my @a = split //, shift;
#    my @b = split //, shift;
#
#    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,
#        greedy => 1,
#    },
#    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: normal string prefix matching, word-mode matching (see
#`Complete::Common::OPT_WORD_MODE` for more details), char-mode matching (see
#`Complete::Common::OPT_CHAR_MODE` for more details), and fuzzy matching (see
#`Complete::Common::OPT_FUZZY` for more details).
#
#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 $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->tracef("[computil] entering complete_array_elem(), word=<%s>", $word)
#        if $COMPLETE_UTIL_TRACE;
#
#    my $res;
#
#    unless (@$array0) {
#        $res = []; goto RETURN_RES;
#    }
#
#    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; 
#    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; 
#    my @array ;  
#    my @arrayn;  
#
#    $log->tracef("[computil] Trying normal string-prefix matching ...") if $COMPLETE_UTIL_TRACE;
#    for my $el (@$array0) {
#        my $eln = $ci ? uc($el) : $el; $eln =~ s/_/-/g if $map_case;
#        next if $excluden && $excluden->{$eln};
#        push @array , $el;
#        push @arrayn, $eln;
#        push @words , $el if 0==index($eln, $wordn);
#        if ($rmapn && $rmapn->{$eln}) {
#            for my $vn (@{ $rmapn->{$eln} }) {
#                push @array , $el;
#                push @arrayn, $vn;
#                push @words , $vn if 0==index($vn, $wordn);
#            }
#        }
#    }
#    $log->tracef("[computil] Result from normal string-prefix matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#
#    {
#        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->tracef("[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;
#                }
#                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; 
#                    if ($tmp =~ $re) {
#                        $match++;
#                        last;
#                    }
#                }
#            }
#            next unless $match;
#            push @words, $array[$i];
#        }
#        $log->tracef("[computil] Result from word-mode matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#    }
#
#    if ($char_mode && !@words && length($wordn) && length($wordn) <= 7) {
#        my $re = join(".*", map {quotemeta} split(//, $wordn));
#        $re = qr/$re/;
#        $log->tracef("[computil] Trying char-mode matching (re=%s) ...", $re) if $COMPLETE_UTIL_TRACE;
#        for my $i (0..$#array) {
#            push @words, $array[$i] if $arrayn[$i] =~ $re;
#        }
#        $log->tracef("[computil] Result from char-mode matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#    }
#
#    if ($fuzzy && !@words) {
#        $log->tracef("[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;
#
#
#        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};
#                }
#                next unless $d <= $maxd;
#                push @words, $array[$i];
#                next ELEM;
#            }
#        }
#        $log->tracef("[computil] Result from fuzzy matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#    }
#
#    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;
#            }
#        }
#    }
#
#    $res =$ci ? [sort {lc($a) cmp lc($b)} @words] : [sort @words];
#
#  RETURN_RES:
#    $log->tracef("[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 },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_hash_key {
#    my %args  = @_;
#    my $hash      = $args{hash} or die "Please specify hash";
#    my $word      = $args{word} // "";
#
#    complete_array_elem(
#        word=>$word, array=>[sort keys %$hash],
#    );
#}
#
#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];
#
#    {
#        last unless @$cae_res == 1;
#        last if @$remaining_elems <= 1;
#        $cae_res->[0] .= $sep;
#    }
#    $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*']], 
#                    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->{$_};
#                }
#            }
#        }
#    }
#
#    if ($final->{words}) {
#        $final->{words} = [
#            sort {
#                (ref($a) ? $a->{word} : $a) cmp
#                    (ref($b) ? $b->{word} : $b);
#            }
#                @{ $final->{words} }];
#    }
#
#    $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*']], 
#            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})) {
#        $_ = "$prefix$_" for @$words;
#    }
#    if (defined(my $suffix = $args{suffix})) {
#        $_ = "$_$suffix" for @$words;
#    }
#    undef;
#}
#
#1;
#
#__END__
#
### Data/Clean.pm ###
#package Data::Clean;
#
#our $DATE = '2017-01-14'; 
#our $VERSION = '0.48'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#sub new {
#    my ($class, %opts) = @_;
#    my $self = bless {_opts=>\%opts}, $class;
#    $log->tracef("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 {
#    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_die {
#    my ($self, $cd, $args) = @_;
#    return "die";
#}
#
#sub _generate_cleanser_code {
#    my $self = shift;
#    my $opts = $self->{_opts};
#
#    my $cd = {
#        modules => {}, 
#        clone_func   => $self->{_opts}{'!clone_func'},
#        code => '',
#    };
#
#    $cd->{modules}{'Scalar::Util'} //= 0;
#
#    if (!$cd->{clone_func}) {
#        if (eval { require Data::Clone; 1 }) {
#            $cd->{clone_func} = 'Data::Clone::clone';
#        } else {
#            $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;
#                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);
#    };
#
#    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);
#        $add_new_if->('$ref && $refs{ {{var}} }++', $act);
#    }
#
#    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);
#    }
#
#    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));
#    }
#
#    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}})');
#    }
#
#    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";
#    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, '$data'."\n";
#    push @code, '}'."\n";
#
#    my $code = join("", @code).";";
#
#    if ($ENV{LOG_CLEANSER_CODE} && $log->is_trace) {
#        require String::LineNumber;
#        $log->tracef("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;
#
#__END__
#
### Data/Clean/FromJSON.pm ###
#package Data::Clean::FromJSON;
#
#our $DATE = '2017-01-15'; 
#our $VERSION = '0.38'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Data::Clean);
#
#sub new {
#    my ($class, %opts) = @_;
#    $opts{"JSON::PP::Boolean"} //= ['one_or_zero'];
#
#    $opts{"JSON::XS::Boolean"} //= ['one_or_zero'];
#
#    $opts{"Cpanel::JSON::XS::Boolean"} //= ['one_or_zero'];
#
#    $class->SUPER::new(%opts);
#}
#
#sub get_cleanser {
#    my $class = shift;
#    state $singleton = $class->new;
#    $singleton;
#}
#
#1;
#
#__END__
#
### Data/Clean/JSON.pm ###
#package Data::Clean::JSON;
#
#our $DATE = '2017-01-15'; 
#our $VERSION = '0.38'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Data::Clean);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       clean_json_in_place
#                       clone_and_clean_json
#               );
#
#sub new {
#    my ($class, %opts) = @_;
#    $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;
#    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;
#
#__END__
#
### Data/Dmp.pm ###
#package Data::Dmp;
#
#our $DATE = '2017-01-30'; 
#our $VERSION = '0.23'; 
#
#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 %_seen_refaddrs;
#our %_subscripts;
#our @_fixups;
#
#our $OPT_PERL_VERSION = "5.010";
#our $OPT_REMOVE_PRAGMAS = 0;
#our $OPT_DEPARSE = 1;
#our $OPT_STRINGIFY_NUMBERS = 0;
#
#my %esc = (
#    "\a" => "\\a",
#    "\b" => "\\b",
#    "\t" => "\\t",
#    "\n" => "\\n",
#    "\f" => "\\f",
#    "\r" => "\\r",
#    "\e" => "\\e",
#);
#
#sub _double_quote {
#    local($_) = $_[0];
#
#    s/([\\\"\@\$])/\\$1/g;
#    return qq("$_") unless /[^\040-\176]/;  
#
#    s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
#    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("$_");
#}
#
#sub _dump_code {
#    my $code = shift;
#
#    state $deparse = do {
#        require B::Deparse;
#        B::Deparse->new("-l"); 
#    };
#
#    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) {
#        $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 &&
#                     $val eq $val+0 &&
#                     $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;
#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_dd) {
#        say $res;
#        return wantarray() || @_ > 1 ? @_ : $_[0];
#    } else {
#        return $res;
#    }
#}
#
#sub dd { local $_is_dd=1; _dd_or_dmp(@_) } 
#sub dmp { goto &_dd_or_dmp }
#
#1;
#
#__END__
#
### Data/ModeMerge.pm ###
#package Data::ModeMerge;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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");
#
#has modes => (is => 'rw', default => sub { {} });
#
#has combine_rules => (is => 'rw');
#
#has path => (is => "rw", default => sub { [] });
#has errors => (is => "rw", default => sub { [] });
#has mem => (is => "rw", default => sub { {} }); 
#has cur_mem_key => (is => "rw"); 
#
#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) {
#        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({
#            'ADD+ADD'            => ['ADD'     , 'ADD'   ],
#            'ADD+DELETE'         => ['DELETE'  , 'DELETE'],
#            'ADD+NORMAL'         => ['NORMAL'  , 'NORMAL'],
#            'ADD+SUBTRACT'       => ['SUBTRACT', 'ADD'   ],
#
#            'CONCAT+CONCAT'      => ['CONCAT'  , 'CONCAT'],
#            'CONCAT+DELETE'      => ['DELETE'  , 'DELETE'],
#            'CONCAT+NORMAL'      => ['NORMAL'  , 'NORMAL'],
#
#            '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+DELETE'   => ['DELETE'  , 'DELETE'  ],
#            '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,
#    };
#}
#
#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} }) {
#                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;
#
#    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 }
#
#    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;
#    }
#    if ($memkey) {
#        if (exists $self->mem->{$memkey}) {
#            $self->_process_todo;
#            if (defined $self->mem->{$memkey}{res}) {
#                return @{ $self->mem->{$memkey}{res} };
#            } else {
#                return ($key, undef, undef, 1);
#            }
#        } else {
#            $self->mem->{$memkey} = {res=>undef, todo=>[]};
#            $self->cur_mem_key($memkey);
#            my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
#            $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
#            $self->_process_todo;
#            return ($newkey, $res, $backup);
#        }
#    } else {
#        $self->_process_todo;
#        return $mh->$meth($key, $l, $r);
#    }
#}
#
#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];
#    }
#    $res;
#}
#
#1;
#
#__END__
#
### Data/ModeMerge/Config.pm ###
#package Data::ModeMerge::Config;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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');
#
#sub _config_config {
#    state $a = [qw/
#        wanted_path
#        options_key
#        allow_override
#        disallow_override
#                  /];
#}
#
#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;
#
#__END__
#
### Data/ModeMerge/Mode/ADD.pm ###
#package Data::ModeMerge::Mode::ADD;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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;
#
#__END__
#
### Data/ModeMerge/Mode/Base.pm ###
#package Data::ModeMerge::Mode::Base;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#
#use Mo qw(build default);
#
#
#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) {
#        $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;
#                push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
#                    my ($subnewkey, $subres, $subbackup) = @_;
#                    $res[$i] = $subres;
#                }
#            } else {
#                push @res, $subres;
#            }
#        } 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;
#}
#
#sub _gen_left {
#    my ($self, $l, $mode, $esub, $ep, $ip, $epr, $ipr) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#
#    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->{$_}];
#        }
#    }
#
#    $hl;
#}
#
#sub _gen_right {
#    my ($self, $r, $mode, $esub, $ep, $ip, $epr, $ipr) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#
#    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->{$_}}
#        }
#    }
#    $hr;
#}
#
#sub _merge_gen {
#    my ($self, $hl, $hr, $mode, $em, $im, $emr, $imr) = @_;
#    my $mm = $self->merger;
#    my $c = $mm->config;
#
#
#    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} };
#            push @o, map { [$_, $hr->{$k}{$_}] } sort { $m{$b} <=> $m{$a} } keys %m;
#        }
#        my $final_mode;
#        my $is_circular;
#        my $v;
#        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")))) {
#                    my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
#                    my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); 
#                    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;
#                    };
#                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;
#                    }
#                    push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
#                        my ($subnewkey, $subres, $subbackup) = @_;
#                        my $final_mode = $m->[1];
#                        $res->{$k} = [$m->[1], $subres];
#                        if ($c->readd_prefix) {
#                            $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 };
#    ($res, $backup);
#}
#
#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;
#
#    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);
#
#    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 };
#
#
#        $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;
#        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;
#    }
#
#    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;
#        }
#    }
#
#    my $hl = $self->_gen_left ($l, $mode, sub {defined($ok) ? $_[0] ne $ok : 1}, $ep, $ip, $epr, $ipr);
#    return if @{ $mm->errors };
#
#    my $hr = $self->_gen_right($r, $mode, sub {defined($ok) ? $_[0] ne $ok : 1}, $ep, $ip, $epr, $ipr);
#    return if @{ $mm->errors };
#
#
#    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;
#        }
#    }
#
#    my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
#    return if @{ $mm->errors };
#
#
#    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});
#        }
#    }
#
#    if ($config_replaced) {
#        $mm->config($orig_c);
#    }
#
#    ($key, $res, $backup);
#}
#
#1;
#
#__END__
#
### Data/ModeMerge/Mode/CONCAT.pm ###
#package Data::ModeMerge::Mode::CONCAT;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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;
#
#__END__
#
### Data/ModeMerge/Mode/DELETE.pm ###
#package Data::ModeMerge::Mode::DELETE;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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/^!/ }
#
#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;
#
#__END__
#
### Data/ModeMerge/Mode/KEEP.pm ###
#package Data::ModeMerge::Mode::KEEP;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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;
#
#__END__
#
### Data/ModeMerge/Mode/NORMAL.pm ###
#package Data::ModeMerge::Mode::NORMAL;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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;
#
#__END__
#
### Data/ModeMerge/Mode/SUBTRACT.pm ###
#package Data::ModeMerge::Mode::SUBTRACT;
#
#our $DATE = '2016-07-22'; 
#our $VERSION = '0.35'; 
#
#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;
#
#__END__
#
### Data/Sah/Normalize.pm ###
#package Data::Sah::Normalize;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $DATE = '2015-09-06'; 
#our $VERSION = '0.04'; 
#
#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};
#
#        my $expr;
#        if ($c =~ s/=\z//) {
#            $expr++;
#            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'"; 
#            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";
#            }
#        }
#
#        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};
#
#
#    $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 {
#                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 = {};
#        }
#
#        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;
#
#__END__
#
### Data/Sah/Resolve.pm ###
#package Data::Sah::Resolve;
#
#our $DATE = '2017-04-19'; 
#our $VERSION = '0.007'; 
#
#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 = $@;
#    return [$type, $clsets] unless $err;
#    die "Can't check whether $type is a builtin Sah type: $err"
#        unless $err =~ /\ACan't locate/;
#
#    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;
#
#__END__
#
### Data/Sah/Util/Type.pm ###
#package Data::Sah::Util::Type;
#
#our $DATE = '2016-12-09'; 
#our $VERSION = '0.46'; 
#
#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);
#
#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);
#}
#
#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;
#
#__END__
#
### Function/Fallback/CoreOrPP.pm ###
#package Function::Fallback::CoreOrPP;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $VERSION = '0.08'; 
#
#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);
#    return $ref unless $r;
#
#    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;
#
#__END__
#
### Getopt/Long/Negate/EN.pm ###
#package Getopt::Long::Negate::EN;
#
#our $DATE = '2016-03-01'; 
#our $VERSION = '0.05'; 
#
#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 =~ /\Ano[_-](.+)/     ) { return ($1)          }
#
#    else {
#        return ("no-$word", "no$word");
#    }
#}
#
#1;
#
#__END__
#
### Getopt/Long/Util.pm ###
#package Getopt::Long::Util;
#
#our $DATE = '2016-10-30'; 
#our $VERSION = '0.88'; 
#
#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=>''},
#        },
#    ],
#};
#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;
#}
#
#$SPEC{humanize_getopt_long_opt_spec} = {
#    v => 1.1,
#    description => <<'_',
#
#Convert <pm:Getopt::Long> option specification like `help|h|?` or `--foo=s` or
#`debug!` into, respectively, `--help, -h, -?` or `--foo=s` or `--(no)debug`.
#Will die if can't parse the string. The output is suitable for including in
#help/usage text.
#
#_
#    args => {
#        optspec => {
#            schema => 'str*',
#            req => 1,
#            pos => 0,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'str*',
#    },
#};
#sub humanize_getopt_long_opt_spec {
#    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 .= ", " if length($res);
#        if ($parse->{is_neg} && length($_) > 1) {
#            $res .= "--(no)$_";
#        } else {
#            if (length($_) > 1) {
#                $res .= "--$_";
#            } else {
#                $res .= "-$_";
#            }
#            $res .= "=$parse->{type}" if $i==1 && $parse->{type};
#        }
#    }
#    $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;
#            }
#            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>;
#            }
#        }
#        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;
#        }
#
#
#
#        for (split /^/, $str) {
#            if (/^\s*(use|require)\s+(Getopt::Long(?:::Complete)?)(\s|;|$)/) {
#                $yesno = 1;
#                $extrameta{'func.module'} = $2;
#                last DETECT;
#            }
#        }
#
#        $reason = "Can't find any statement requiring Getopt::Long(?::Complete)? module";
#    } 
#
#    [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;
#}
#
#
#__END__
#
### 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.18';
#
#
#
#
#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
#    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
#/);
#
#
#
#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
#/);
#
#
#my %plural = (
#    'menus' => 'menu',
#    'buses' => 'bus',
#    %ves,
#    %irregular,
#);
#
#
#my @no_change = qw/
#                      deer
#                      ides
#                      fish
#                      means
#                      offspring
#                      series
#                      sheep
#                      species
#                  /;
#
#@plural{@no_change} = @no_change;
#
#
#
#
#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
#/);
#
#my %not_plural;
#
#@not_plural{@not_plural} = (1) x @not_plural;
#
#
#
#
#
#my @oes = (qw/
#canoes
#does
#foes
#gumshoes
#hoes
#horseshoes
#oboes
#shoes
#snowshoes
#throes
#toes
#/);
#
#my %oes;
#
#@oes{@oes} = (1) x @oes;
#
#
#
#
#
#
#
#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;
#
#
#my @ses = (qw/
#horses
#tenses
#/);
#
#my %ses;
#@ses{@ses} = (1) x @ses;
#
#my $es_re = qr/([^aeiou]s|ch|sh)es$/;
#
#
#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;
#
#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;
#
#my %i_to_other = (
#    improvisatori => 'improvisatore',
#    rhinoceri => 'rhinoceros',
#    scaloppini => 'scaloppine'
#);
#
#
#sub to_singular
#{
#    my ($word) = @_;
#    my $singular = $word;
#    if (! $not_plural{$word}) {
#        if ($plural{$word}) {
#            $singular = $plural{$word};
#        }
#        elsif ($word =~ /s$/) {
#            if ($word =~ /'s$/) {
#            ;
#            }
#            elsif (length ($word) <= 2) {
#            ;
#            }
#            elsif ($word =~ /ss$/) {
#            ;
#            }
#            elsif ($word =~ /sis$/) {
#            ;
#            }
#            elsif ($word =~ /ies$/) {
#                if ($ies{$word}) {
#                    $singular =~ s/ies$/ie/;
#                }
#                else {
#                    $singular =~ s/ies$/y/;
#                }
#            }
#            elsif ($word =~ /oes$/) {
#                if ($oes{$word}) {
#                    $singular =~ s/oes$/oe/;
#                }
#                else {
#                    $singular =~ s/oes$/o/;
#                }
#            }
#            elsif ($word =~ /xes$/) {
#                       $singular =~ s/xes$/x/;
#            }
#            elsif ($word =~ /ses$/) {
#                if ($ses{$word}) {
#                    $singular =~ s/ses$/se/;
#                }
#                else {
#                    $singular =~ s/ses$/s/;
#                }
#               }
#            elsif ($word =~ $es_re) {
#                $singular =~ s/$es_re/$1/;
#            }
#            else {
#                $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/Any.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any;
#
#our $VERSION = '1.042';
#
#use Log::Any::Manager;
#use Log::Any::Proxy::Null;
#use Log::Any::Adapter::Util qw(
#  require_dynamic
#  detection_aliases
#  detection_methods
#  log_level_aliases
#  logging_aliases
#  logging_and_detection_methods
#  logging_methods
#);
#
#our $OverrideDefaultAdapterClass;
#our $OverrideDefaultProxyClass;
#
#{
#    my $manager = Log::Any::Manager->new();
#    sub _manager { return $manager }
#}
#
#sub import {
#    my $class  = shift;
#    my $caller = caller();
#
#    my @export_params = ( $caller, @_ );
#    $class->_export_to_caller(@export_params);
#}
#
#sub _export_to_caller {
#    my $class  = shift;
#    my $caller = shift;
#
#    my $saw_log_param;
#    my @params;
#    while ( my $param = shift @_ ) {
#        if ( $param eq '$log' ) {
#            $saw_log_param = 1;    
#            next;                  
#        }
#        else {
#            push @params, $param, shift @_;    
#        }
#    }
#
#    unless ( @params % 2 == 0 ) {
#        require Carp;
#        Carp::croak("Argument list not balanced: @params");
#    }
#
#    if ($saw_log_param) {
#        no strict 'refs';
#        my $proxy = $class->get_logger( category => $caller, @params );
#        my $varname = "$caller\::log";
#        *$varname = \$proxy;
#    }
#}
#
#sub get_logger {
#    my ( $class, %params ) = @_;
#    no warnings 'once';
#
#    my $proxy_class = $class->_get_proxy_class( delete $params{proxy_class} );
#    my $category =
#      defined $params{category} ? delete $params{'category'} : caller;
#
#    if ( my $default = delete $params{'default_adapter'} ) {
#        my @default_adapter_params = ();
#        if (ref $default eq 'ARRAY') {
#            ($default, @default_adapter_params) = @{ $default };
#        }
#        $class->_manager->set_default(
#            $category, $default, @default_adapter_params
#        );
#    }
#
#    my $adapter = $class->_manager->get_adapter( $category );
#
#    require_dynamic($proxy_class);
#    return $proxy_class->new(
#        %params, adapter => $adapter, category => $category,
#    );
#}
#
#sub _get_proxy_class {
#    my ( $self, $proxy_name ) = @_;
#    return $Log::Any::OverrideDefaultProxyClass
#      if $Log::Any::OverrideDefaultProxyClass;
#    return "Log::Any::Proxy" if !$proxy_name && _manager->has_consumer;
#    return "Log::Any::Proxy::Null" if !$proxy_name;
#    my $proxy_class = (
#          substr( $proxy_name, 0, 1 ) eq '+'
#        ? substr( $proxy_name, 1 )
#        : "Log::Any::Proxy::$proxy_name"
#    );
#    return $proxy_class;
#}
#
#sub set_adapter {
#    my $class = shift;
#    Log::Any->_manager->set(@_);
#}
#
#1;
#
#__END__
#
### Log/Any/Adapter.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter;
#
#our $VERSION = '1.042';
#
#use Log::Any;
#
#sub import {
#    my $pkg = shift;
#    Log::Any->_manager->set(@_) if (@_);
#}
#
#sub set {
#    my $pkg = shift;
#    Log::Any->_manager->set(@_)
#}
#
#sub remove {
#    my $pkg = shift;
#    Log::Any->_manager->remove(@_)
#}
#
#1;
#
#__END__
#
### Log/Any/Adapter/Base.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Base;
#
#our $VERSION = '1.042';
#
#use Log::Any::Adapter::Util qw/make_method dump_one_line/;
#
#sub new {
#    my $class = shift;
#    my $self  = {@_};
#    bless $self, $class;
#    $self->init(@_);
#    return $self;
#}
#
#sub init { }
#
#for my $method ( Log::Any::Adapter::Util::logging_and_detection_methods() ) {
#    no strict 'refs';
#    *$method = sub {
#        my $class = ref( $_[0] ) || $_[0];
#        die "$class does not implement $method";
#    };
#}
#
#sub delegate_method_to_slot {
#    my ( $class, $slot, $method, $adapter_method ) = @_;
#
#    make_method( $method,
#        sub { my $self = shift; return $self->{$slot}->$adapter_method(@_) },
#        $class );
#}
#
#1;
### Log/Any/Adapter/File.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::File;
#
#our $VERSION = '1.042';
#
#use Config;
#use Fcntl qw/:flock/;
#use IO::File;
#use Log::Any::Adapter::Util ();
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
#
#my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
#sub new {
#    my ( $class, $file, @args ) = @_;
#    return $class->SUPER::new( file => $file, log_level => $trace_level, @args );
#}
#
#sub init {
#    my $self = shift;
#    if ( exists $self->{log_level} ) {
#        $self->{log_level} = Log::Any::Adapter::Util::numeric_level( $self->{log_level} )
#            unless $self->{log_level} =~ /^\d+$/;
#    }
#    else {
#        $self->{log_level} = $trace_level;
#    }
#    my $file = $self->{file};
#    my $binmode ||= ':utf8';
#    $binmode = ":$binmode" unless substr($binmode,0,1) eq ':';
#    open( $self->{fh}, ">>$binmode", $file )
#      or die "cannot open '$file' for append: $!";
#    $self->{fh}->autoflush(1);
#}
#
#foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
#    no strict 'refs';
#    my $method_level = Log::Any::Adapter::Util::numeric_level( $method );
#    *{$method} = sub {
#        my ( $self, $text ) = @_;
#        return if $method_level > $self->{log_level};
#        my $msg = sprintf( "[%s] %s\n", scalar(localtime), $text );
#        flock($self->{fh}, LOCK_EX) if $HAS_FLOCK;
#        $self->{fh}->print($msg);
#        flock($self->{fh}, LOCK_UN) if $HAS_FLOCK;
#      }
#}
#
#foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
#    no strict 'refs';
#    my $base = substr($method,3);
#    my $method_level = Log::Any::Adapter::Util::numeric_level( $base );
#    *{$method} = sub {
#        return !!(  $method_level <= $_[0]->{log_level} );
#    };
#}
#
#1;
#
#__END__
#
### Log/Any/Adapter/Null.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Null;
#
#our $VERSION = '1.042';
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#use Log::Any::Adapter::Util ();
#
#
#foreach my $method (Log::Any::Adapter::Util::logging_and_detection_methods()) {
#    no strict 'refs';
#    *{$method} = sub { return '' }; 
#}
#
#1;
#
#__END__
#
### Log/Any/Adapter/Stderr.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Stderr;
#
#our $VERSION = '1.042';
#
#use Log::Any::Adapter::Util ();
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
#
#sub init {
#    my ($self) = @_;
#    if ( exists $self->{log_level} ) {
#        $self->{log_level} =
#          Log::Any::Adapter::Util::numeric_level( $self->{log_level} )
#          unless $self->{log_level} =~ /^\d+$/;
#    }
#    else {
#        $self->{log_level} = $trace_level;
#    }
#}
#
#foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
#    no strict 'refs';
#    my $method_level = Log::Any::Adapter::Util::numeric_level($method);
#    *{$method} = sub {
#        my ( $self, $text ) = @_;
#        return if $method_level > $self->{log_level};
#        print STDERR "$text\n";
#    };
#}
#
#foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
#    no strict 'refs';
#    my $base = substr( $method, 3 );
#    my $method_level = Log::Any::Adapter::Util::numeric_level($base);
#    *{$method} = sub {
#        return !!( $method_level <= $_[0]->{log_level} );
#    };
#}
#
#1;
#
#__END__
#
### Log/Any/Adapter/Stdout.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Stdout;
#
#our $VERSION = '1.042';
#
#use Log::Any::Adapter::Util ();
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
#
#sub init {
#    my ($self) = @_;
#    if ( exists $self->{log_level} ) {
#        $self->{log_level} =
#          Log::Any::Adapter::Util::numeric_level( $self->{log_level} )
#          unless $self->{log_level} =~ /^\d+$/;
#    }
#    else {
#        $self->{log_level} = $trace_level;
#    }
#}
#
#foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
#    no strict 'refs';
#    my $method_level = Log::Any::Adapter::Util::numeric_level($method);
#    *{$method} = sub {
#        my ( $self, $text ) = @_;
#        return if $method_level > $self->{log_level};
#        print STDOUT "$text\n";
#    };
#}
#
#foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
#    no strict 'refs';
#    my $base = substr( $method, 3 );
#    my $method_level = Log::Any::Adapter::Util::numeric_level($base);
#    *{$method} = sub {
#        return !!( $method_level <= $_[0]->{log_level} );
#    };
#}
#
#1;
#
#__END__
#
### Log/Any/Adapter/Test.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Test;
#
#our $VERSION = '1.042';
#
#use Log::Any::Adapter::Util qw/dump_one_line/;
#use Test::Builder;
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#my $tb = Test::Builder->new();
#my @msgs;
#
#
#sub new {
#    my $class = shift;
#    if ( defined $Log::Any::OverrideDefaultAdapterClass
#        && $Log::Any::OverrideDefaultAdapterClass eq __PACKAGE__ )
#    {
#        my $category = pop @_;
#        return $class->SUPER::new( category => $category );
#    }
#    else {
#        return $class->SUPER::new(@_);
#    }
#}
#
#foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
#    no strict 'refs';
#    *{$method} = sub { 1 };
#}
#
#foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
#    no strict 'refs';
#    *{$method} = sub {
#        my ( $self, $msg ) = @_;
#        push(
#            @msgs,
#            {
#                message  => $msg,
#                level    => $method,
#                category => $self->{category}
#            }
#        );
#    };
#}
#
#
#sub msgs {
#    my $self = shift;
#
#    return \@msgs;
#}
#
#sub clear {
#    my ($self) = @_;
#
#    @msgs = ();
#}
#
#sub contains_ok {
#    my ( $self, $regex, $test_name ) = @_;
#
#    local $Test::Builder::Level = $Test::Builder::Level + 1;
#
#    $test_name ||= "log contains '$regex'";
#    my $found =
#      _first_index( sub { $_->{message} =~ /$regex/ }, @{ $self->msgs } );
#    if ( $found != -1 ) {
#        splice( @{ $self->msgs }, $found, 1 );
#        $tb->ok( 1, $test_name );
#    }
#    else {
#        $tb->ok( 0, $test_name );
#        $tb->diag( "could not find message matching $regex" );
#        _diag_msgs();
#    }
#}
#
#sub category_contains_ok {
#    my ( $self, $category, $regex, $test_name ) = @_;
#
#    local $Test::Builder::Level = $Test::Builder::Level + 1;
#
#    $test_name ||= "log for $category contains '$regex'";
#    my $found =
#      _first_index(
#        sub { $_->{category} eq $category && $_->{message} =~ /$regex/ },
#        @{ $self->msgs } );
#    if ( $found != -1 ) {
#        splice( @{ $self->msgs }, $found, 1 );
#        $tb->ok( 1, $test_name );
#    }
#    else {
#        $tb->ok( 0, $test_name );
#        $tb->diag( "could not find $category message matching $regex" );
#        _diag_msgs();
#    }
#}
#
#sub does_not_contain_ok {
#    my ( $self, $regex, $test_name ) = @_;
#
#    local $Test::Builder::Level = $Test::Builder::Level + 1;
#
#    $test_name ||= "log does not contain '$regex'";
#    my $found =
#      _first_index( sub { $_->{message} =~ /$regex/ }, @{ $self->msgs } );
#    if ( $found != -1 ) {
#        $tb->ok( 0, $test_name );
#        $tb->diag( "found message matching $regex: " . $self->msgs->[$found]->{message} );
#    }
#    else {
#        $tb->ok( 1, $test_name );
#    }
#}
#
#sub category_does_not_contain_ok {
#    my ( $self, $category, $regex, $test_name ) = @_;
#
#    local $Test::Builder::Level = $Test::Builder::Level + 1;
#
#    $test_name ||= "log for $category contains '$regex'";
#    my $found =
#      _first_index(
#        sub { $_->{category} eq $category && $_->{message} =~ /$regex/ },
#        @{ $self->msgs } );
#    if ( $found != -1 ) {
#        $tb->ok( 0, $test_name );
#        $tb->diag( "found $category message matching $regex: "
#              . $self->msgs->[$found] );
#    }
#    else {
#        $tb->ok( 1, $test_name );
#    }
#}
#
#sub empty_ok {
#    my ( $self, $test_name ) = @_;
#
#    local $Test::Builder::Level = $Test::Builder::Level + 1;
#
#    $test_name ||= "log is empty";
#    if ( !@{ $self->msgs } ) {
#        $tb->ok( 1, $test_name );
#    }
#    else {
#        $tb->ok( 0, $test_name );
#        $tb->diag( "log is not empty" );
#        _diag_msgs();
#        $self->clear();
#    }
#}
#
#sub contains_only_ok {
#    my ( $self, $regex, $test_name ) = @_;
#
#    local $Test::Builder::Level = $Test::Builder::Level + 1;
#
#    $test_name ||= "log contains only '$regex'";
#    my $count = scalar( @{ $self->msgs } );
#    if ( $count == 1 ) {
#        local $Test::Builder::Level = $Test::Builder::Level + 1;
#        $self->contains_ok( $regex, $test_name );
#    }
#    else {
#        $tb->ok( 0, $test_name );
#        _diag_msgs();
#    }
#}
#
#sub _diag_msgs {
#    my $count = @msgs;
#    if ( ! $count ) {
#        $tb->diag("log contains no messages");
#    }
#    else {
#        $tb->diag("log contains $count message" . ( $count > 1 ? "s:" : ":"));
#        $tb->diag(dump_one_line($_)) for @msgs;
#    }
#}
#
#sub _first_index {
#    my $f = shift;
#    for my $i ( 0 .. $#_ ) {
#        local *_ = \$_[$i];
#        return $i if $f->();
#    }
#    return -1;
#}
#
#
#1;
### Log/Any/Adapter/Util.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Util;
#
#our $VERSION = '1.042';
#
#use Exporter;
#our @ISA = qw/Exporter/;
#
#my %LOG_LEVELS;
#BEGIN {
#    %LOG_LEVELS = (
#        EMERGENCY => 0,
#        ALERT     => 1,
#        CRITICAL  => 2,
#        ERROR     => 3,
#        WARNING   => 4,
#        NOTICE    => 5,
#        INFO      => 6,
#        DEBUG     => 7,
#        TRACE     => 8,
#    );
#}
#
#use constant \%LOG_LEVELS;
#
#our @EXPORT_OK = qw(
#  cmp_deeply
#  detection_aliases
#  detection_methods
#  dump_one_line
#  log_level_aliases
#  logging_aliases
#  logging_and_detection_methods
#  logging_methods
#  make_method
#  numeric_level
#  read_file
#  require_dynamic
#);
#
#push @EXPORT_OK, keys %LOG_LEVELS;
#
#our %EXPORT_TAGS = ( 'levels' => [ keys %LOG_LEVELS ] );
#
#my ( %LOG_LEVEL_ALIASES, @logging_methods, @logging_aliases, @detection_methods,
#    @detection_aliases, @logging_and_detection_methods );
#
#BEGIN {
#    %LOG_LEVEL_ALIASES = (
#        inform => 'info',
#        warn   => 'warning',
#        err    => 'error',
#        crit   => 'critical',
#        fatal  => 'critical'
#    );
#    @logging_methods =
#      qw(trace debug info notice warning error critical alert emergency);
#    @logging_aliases               = keys(%LOG_LEVEL_ALIASES);
#    @detection_methods             = map { "is_$_" } @logging_methods;
#    @detection_aliases             = map { "is_$_" } @logging_aliases;
#    @logging_and_detection_methods = ( @logging_methods, @detection_methods );
#}
#
#
#sub logging_methods               { @logging_methods }
#
#
#sub detection_methods             { @detection_methods }
#
#
#sub logging_and_detection_methods { @logging_and_detection_methods }
#
#
#sub log_level_aliases             { %LOG_LEVEL_ALIASES }
#
#
#sub logging_aliases               { @logging_aliases }
#
#
#sub detection_aliases             { @detection_aliases }
#
#
#sub numeric_level {
#    my ($level) = @_;
#    my $canonical =
#      exists $LOG_LEVEL_ALIASES{$level} ? $LOG_LEVEL_ALIASES{$level} : $level;
#    return $LOG_LEVELS{ uc($canonical) };
#}
#
#
#*dump_one_line = sub {
#    require Data::Dumper;
#
#    my $dumper = sub {
#        my ($value) = @_;
#
#        return Data::Dumper->new( [$value] )->Indent(0)->Sortkeys(1)->Quotekeys(0)
#        ->Terse(1)->Useqq(1)->Dump();
#    };
#
#    my $string = $dumper->(@_);
#    no warnings 'redefine';
#    *dump_one_line = $dumper;
#    return $string;
#};
#
#
#sub make_method {
#    my ( $method, $code, $pkg ) = @_;
#
#    $pkg ||= caller();
#    no strict 'refs';
#    *{ $pkg . "::$method" } = $code;
#}
#
#
#sub require_dynamic {
#    my ($class) = @_;
#
#    return 1 if $class->can('new'); 
#
#    unless ( defined( eval "require $class; 1" ) )
#    {    
#        die $@;
#    }
#}
#
#
#sub read_file {
#    my ($file) = @_;
#
#    local $/ = undef;
#    open( my $fh, '<:utf8', $file ) 
#      or die "cannot open '$file': $!";
#    my $contents = <$fh>;
#    return $contents;
#}
#
#
#sub cmp_deeply {
#    my ( $ref1, $ref2, $name ) = @_;
#
#    my $tb = Test::Builder->new();
#    $tb->is_eq( dump_one_line($ref1), dump_one_line($ref2), $name );
#}
#
#require Log::Any;
#
#1;
#
#
#
#__END__
#
### Log/Any/IfLOG.pm ###
#package Log::Any::IfLOG;
#
#our $DATE = '2016-06-16'; 
#our $VERSION = '0.08'; 
#
#our $DEBUG;
#our $ENABLE_LOG;
#
#my $log_singleton;
#sub __log_singleton {
#    if (!$log_singleton) { $log_singleton = Log::Any::IfLOG::DumbObj->new }
#    $log_singleton;
#}
#
#sub __log_enabled {
#    if (defined $ENABLE_LOG) {
#        return $ENABLE_LOG;
#    } elsif ($INC{'Log/Any.pm'}) {
#        return 1;
#    } else {
#        return
#            $ENV{LOG} || $ENV{TRACE} || $ENV{DEBUG} ||
#            $ENV{VERBOSE} || $ENV{QUIET} || $ENV{LOG_LEVEL};
#    }
#}
#
#sub import {
#    my $self = shift;
#
#    my $caller = caller();
#    if (__log_enabled()) {
#        require Log::Any;
#        Log::Any->_export_to_caller($caller, @_);
#    } else {
#        my $saw_log_param = grep { $_ eq '$log' } @_;
#        if ($saw_log_param) {
#            __log_singleton(); 
#            *{"$caller\::log"} = \$log_singleton;
#        }
#    }
#}
#
#sub get_logger {
#    if (__log_enabled()) {
#        require Log::Any;
#        my $class = shift;
#        if ($class eq 'Log::Any::IfLOG') {
#            Log::Any->get_logger(@_);
#        } else {
#            Log::Any::get_logger($class, @_);
#        }
#    } else {
#        return __log_singleton();
#    }
#}
#
#package
#    Log::Any::IfLOG::DumbObj;
#sub new { my $o = ""; bless \$o, shift }
#sub AUTOLOAD { 0 }
#
#1;
#
#__END__
#
### Log/Any/Manager.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Manager;
#
#our $VERSION = '1.042';
#
#sub new {
#    my $class = shift;
#    my $self  = {
#        entries         => [],
#        category_cache  => {},
#        default_adapter => {},
#    };
#    bless $self, $class;
#
#    return $self;
#}
#
#sub has_consumer {
#    my ( $self ) = @_;
#    return !!( @{ $self->{entries} } || keys %{ $self->{default_adapter} } );
#}
#
#sub get_adapter {
#    my ( $self, $category ) = @_;
#
#    my $category_cache = $self->{category_cache};
#    if ( !defined( $category_cache->{$category} ) ) {
#        my $entry = $self->_choose_entry_for_category($category);
#        my $adapter = $self->_new_adapter_for_entry( $entry, $category );
#        $category_cache->{$category} = { entry => $entry, adapter => $adapter };
#    }
#    return $category_cache->{$category}->{adapter};
#}
#
#{
#    no warnings 'once';
#    *get_logger = \&get_adapter;    
#}
#
#sub _choose_entry_for_category {
#    my ( $self, $category ) = @_;
#
#    foreach my $entry ( @{ $self->{entries} } ) {
#        if ( $category =~ $entry->{pattern} ) {
#            return $entry;
#        }
#    }
#    my $default = $self->{default_adapter}{$category}
#        || [ $self->_get_adapter_class("Null"), [] ];
#    my ($adapter_class, $adapter_params) = @$default;
#    _require_dynamic($adapter_class);
#    return {
#        adapter_class  => $adapter_class,
#        adapter_params => $adapter_params,
#    };
#}
#
#sub _new_adapter_for_entry {
#    my ( $self, $entry, $category ) = @_;
#
#    return $entry->{adapter_class}
#      ->new( @{ $entry->{adapter_params} }, category => $category );
#}
#
#sub set_default {
#    my ( $self, $category, $adapter_name, @adapter_params ) = @_;
#    Log::Any::Proxy::Null->inflate_nulls;
#    my $adapter_class = $self->_get_adapter_class($adapter_name);
#    $self->{default_adapter}{$category} = [$adapter_class, \@adapter_params];
#}
#
#sub set {
#    my $self = shift;
#    my $options;
#    if ( ref( $_[0] ) eq 'HASH' ) {
#        $options = shift(@_);
#    }
#    my ( $adapter_name, @adapter_params ) = @_;
#
#    unless ( defined($adapter_name) && $adapter_name =~ /\S/ ) {
#        require Carp;
#        Carp::croak("expected adapter name");
#    }
#
#    my $pattern = $options->{category};
#    if ( !defined($pattern) ) {
#        $pattern = qr/.*/;
#    }
#    elsif ( !ref($pattern) ) {
#        $pattern = qr/^\Q$pattern\E$/;
#    }
#
#    my $adapter_class = $self->_get_adapter_class($adapter_name);
#    _require_dynamic($adapter_class);
#
#    my $entry = $self->_new_entry( $pattern, $adapter_class, \@adapter_params );
#    unshift( @{ $self->{entries} }, $entry );
#
#    $self->_reselect_matching_adapters($pattern);
#
#    if ( my $lex_ref = $options->{lexically} ) {
#        $$lex_ref = Log::Any::Manager::_Guard->new(
#            sub { $self->remove($entry) unless _in_global_destruction() } );
#    }
#
#    Log::Any::Proxy::Null->inflate_nulls;
#    return $entry;
#}
#
#sub remove {
#    my ( $self, $entry ) = @_;
#
#    my $pattern = $entry->{pattern};
#    $self->{entries} = [ grep { $_ ne $entry } @{ $self->{entries} } ];
#    $self->_reselect_matching_adapters($pattern);
#}
#
#sub _new_entry {
#    my ( $self, $pattern, $adapter_class, $adapter_params ) = @_;
#
#    return {
#        pattern        => $pattern,
#        adapter_class  => $adapter_class,
#        adapter_params => $adapter_params,
#    };
#}
#
#sub _reselect_matching_adapters {
#    my ( $self, $pattern ) = @_;
#
#    return if _in_global_destruction();
#
#    while ( my ( $category, $category_info ) =
#        each( %{ $self->{category_cache} } ) )
#    {
#        my $new_entry = $self->_choose_entry_for_category($category);
#        if ( $new_entry ne $category_info->{entry} ) {
#            my $new_adapter =
#              $self->_new_adapter_for_entry( $new_entry, $category );
#            %{ $category_info->{adapter} } = %$new_adapter;
#            bless( $category_info->{adapter}, ref($new_adapter) );
#            $category_info->{entry} = $new_entry;
#        }
#    }
#}
#
#sub _get_adapter_class {
#    my ( $self, $adapter_name ) = @_;
#    return $Log::Any::OverrideDefaultAdapterClass if $Log::Any::OverrideDefaultAdapterClass;
#    $adapter_name =~ s/^Log:://;    
#    my $adapter_class = (
#          substr( $adapter_name, 0, 1 ) eq '+'
#        ? substr( $adapter_name, 1 )
#        : "Log::Any::Adapter::$adapter_name"
#    );
#    return $adapter_class;
#}
#
#if ( defined ${^GLOBAL_PHASE} ) {
#    eval 'sub _in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1' 
#      or die $@;
#}
#else {
#    require B;
#    my $started = !B::main_start()->isa(q[B::NULL]);
#    unless ($started) {
#        eval '0 && $started; CHECK { $started = 1 }; 1' 
#          or die $@;
#    }
#    eval 
#      '0 && $started; sub _in_global_destruction () { $started && B::main_start()->isa(q[B::NULL]) }; 1'
#      or die $@;
#}
#
#sub _require_dynamic {
#    my ($class) = @_;
#
#    return 1 if $class->can('new'); 
#
#    unless ( defined( eval "require $class; 1" ) )
#    {    
#        die $@;
#    }
#}
#
#package    
#  Log::Any::Manager::_Guard;
#
#sub new { bless $_[1], $_[0] }
#
#sub DESTROY { $_[0]->() }
#
#1;
### Log/Any/Proxy.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Proxy;
#
#our $VERSION = '1.042';
#
#use Log::Any::Adapter::Util ();
#
#sub _default_formatter {
#    my ( $cat, $lvl, $format, @params ) = @_;
#    return $format->() if ref($format) eq 'CODE';
#    my @new_params =
#      map {
#           !defined($_) ? '<undef>'
#          : ref($_)     ? Log::Any::Adapter::Util::dump_one_line($_)
#          : $_
#      } @params;
#    no warnings;
#    return sprintf( $format, @new_params );
#}
#
#sub new {
#    my $class = shift;
#    my $self = { formatter => \&_default_formatter, @_ };
#    unless ( $self->{adapter} ) {
#        require Carp;
#        Carp::croak("$class requires an 'adapter' parameter");
#    }
#    unless ( $self->{category} ) {
#        require Carp;
#        Carp::croak("$class requires an 'category' parameter")
#    }
#    bless $self, $class;
#    $self->init(@_);
#    return $self;
#}
#
#sub init { }
#
#for my $attr (qw/adapter filter formatter prefix/) {
#    no strict 'refs';
#    *{$attr} = sub { return $_[0]->{$attr} };
#}
#
#my %aliases = Log::Any::Adapter::Util::log_level_aliases();
#
#foreach my $name ( Log::Any::Adapter::Util::logging_methods(), keys(%aliases) )
#{
#    my $realname    = $aliases{$name} || $name;
#    my $namef       = $name . "f";
#    my $is_name     = "is_$name";
#    my $is_realname = "is_$realname";
#    my $numeric     = Log::Any::Adapter::Util::numeric_level($realname);
#    no strict 'refs';
#    *{$is_name} = sub {
#        my ($self) = @_;
#        return $self->{adapter}->$is_realname;
#    };
#    *{$name} = sub {
#        my ( $self, @parts ) = @_;
#        my $message = join(" ", grep { defined($_) && length($_) } @parts );
#        if ( length $message ) {
#            $message = $self->{filter}->( $self->{category}, $numeric, $message )
#              if defined $self->{filter};
#            if ( defined $message and length $message ) {
#                $message = "$self->{prefix}$message"
#                  if defined $self->{prefix} && length $self->{prefix};
#                $self->{adapter}->$realname($message);
#            }
#        }
#        return $message if defined wantarray;
#    };
#    *{$namef} = sub {
#        my ( $self, @args ) = @_;
#        return unless $self->{adapter}->$is_realname;
#        my $message =
#          $self->{formatter}->( $self->{category}, $numeric, @args );
#        return unless defined $message and length $message;
#        return $self->$name($message);
#    };
#}
#
#1;
#
#
#
#__END__
#
### Log/Any/Proxy/Null.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Proxy::Null;
#
#our $VERSION = '1.042';
#
#use Log::Any::Adapter::Util ();
#use Log::Any::Proxy;
#our @ISA = qw/Log::Any::Proxy/;
#
#my @nulls;
#
#sub new {
#    my $obj = shift->SUPER::new( @_ );
#    push @nulls, $obj;
#    return $obj;
#}
#
#sub inflate_nulls {
#    bless shift( @nulls ), 'Log::Any::Proxy' while @nulls;
#}
#
#my %aliases = Log::Any::Adapter::Util::log_level_aliases();
#
#foreach my $name ( Log::Any::Adapter::Util::logging_methods(), keys(%aliases) )
#{
#    my $namef       = $name . "f";
#    my $super_name  = "SUPER::" . $name;
#    my $super_namef = "SUPER::" . $namef;
#    no strict 'refs';
#    *{$name} = sub {
#        return unless defined wantarray;
#        return shift->$super_name( @_ );
#    };
#    *{$namef} = sub {
#        return unless defined wantarray;
#        return shift->$super_namef( @_ );
#    };
#}
#
#1;
#
#__END__
#
### Log/Any/Proxy/Test.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Proxy::Test;
#
#our $VERSION = '1.042';
#
#use Log::Any::Proxy;
#our @ISA = qw/Log::Any::Proxy/;
#
#my @test_methods = qw(
#  msgs
#  clear
#  contains_ok
#  category_contains_ok
#  does_not_contain_ok
#  category_does_not_contain_ok
#  empty_ok
#  contains_only_ok
#);
#
#foreach my $name (@test_methods) {
#    no strict 'refs';
#    *{$name} = sub {
#        my $self = shift;
#        $self->{adapter}->$name(@_);
#    };
#}
#
#1;
### Log/Any/Test.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Test;
#
#our $VERSION = '1.042';
#
#no warnings 'once';
#$Log::Any::OverrideDefaultAdapterClass = 'Log::Any::Adapter::Test';
#$Log::Any::OverrideDefaultProxyClass   = 'Log::Any::Proxy::Test';
#
#1;
#
#__END__
#
### 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 ###
#
#use strict;
#use warnings;
#package Mo::Golf;
#
#our $VERSION='0.40';
#
#use PPI;
#
#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/; 
#            return 1 if $prev->isa( tok 'Word' )   and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Symbol' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
#
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Single' ) and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Double' ) and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Symbol' )        and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Structure' )     and $next->content =~ /^\W/; 
#
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Symbol' );           
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Structure' );        
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Quote::Double' );    
#            return 1 if $prev->isa( tok 'Symbol' )     and $next->isa( tok 'Structure' );        
#            return 1 if $prev->isa( tok 'ArrayIndex' ) and $next->isa( tok 'Operator' );         
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Cast' );             
#            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' );                                           
#            return 1 if $prev->isa( tok 'Operator' ) and $prev->content =~ /\W$/;                
#            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;
#        },
#    );
#}
#
### Mo/Inline.pm ###
#
#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;
#
### 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 = '2016-08-04'; 
#our $VERSION = '0.003'; 
#
#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 scalar <$fh>;
#            }
#        }
#
#        if ($is_hook) {
#            next unless @hook_res;
#            my $prepend_ref = shift @hook_res if ref($hook_res[0]) eq 'SCALAR';
#            my $fh          = shift @hook_res if ref($hook_res[0]) eq 'GLOB';
#            my $code        = shift @hook_res if ref($hook_res[0]) eq 'CODE';
#            my $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 $src;
#            } elsif ($code) {
#                my $src = "";
#                local $_;
#                while ($code->($code, $code_state)) {
#                    $src .= $_;
#                }
#                $src = $$prepend_ref . $src if $prepend_ref;
#                return $src;
#            }
#        }
#    }
#
#    die "Can't locate $name_pm in \@INC (\@INC contains: ".join(" ", @INC).")";
#}
#
#sub module_source {
#    my $name = shift;
#
#    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;
#
#    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;
#
#__END__
#
### Perinci/Sub/Complete.pm ###
#package Perinci::Sub::Complete;
#
#our $DATE = '2017-01-15'; 
#our $VERSION = '0.91'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#use Complete::Util qw(hashify_answer complete_array_elem complete_hash_key combine_answers modify_answer);
#use Complete::Common qw(:all);
#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.
#
#_
#    },
#);
#
#$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 => {
#            summary => 'Must be normalized',
#            req => 1,
#        },
#        word => {
#            schema => [str => default => ''],
#            req => 1,
#        },
#    },
#};
#sub complete_from_schema {
#    my %args = @_;
#    my $sch  = $args{schema}; 
#    my $word = $args{word} // "";
#
#    my $fres;
#    $log->tracef("[comp][periscomp] entering complete_from_schema, word=<%s>, schema=%s", $word, $sch);
#
#    my ($type, $cs) = @{$sch};
#
#    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 };
#        goto RETURN_RES if $@;
#        my $rsch = ${"$pkg\::rschema"};
#        $type = $rsch->[0];
#        $cs = {};
#        for my $cs0 (@{ $rsch->[1] // [] }) {
#            for (keys %$cs0) {
#                $cs->{$_} = $cs0->{$_};
#            }
#        }
#        $log->tracef("[comp][periscomp] retrieving schema from module %s, base type=%s", $pkg, $type);
#    }
#
#    my $static;
#    my $words;
#    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->tracef("[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"};
#                    $comp = $fref->(%$xcargs);
#                }
#            }
#            if ($comp) {
#                $log->tracef("[comp][periscomp] using arg completion routine from schema's 'x.completion' attribute");
#                $fres = $comp->(
#                    %{$args{extras} // {}},
#                    word=>$word, arg=>$args{arg}, args=>$args{args});
#                return; 
#                }
#            }
#
#        if ($cs->{is} && !ref($cs->{is})) {
#            $log->tracef("[comp][periscomp] adding completion from schema's 'is' clause");
#            push @$words, $cs->{is};
#            $static++;
#            return; 
#        }
#        if ($cs->{in}) {
#            $log->tracef("[comp][periscomp] adding completion from schema's 'in' clause");
#            push @$words, grep {!ref($_)} @{ $cs->{in} };
#            $static++;
#            return; 
#        }
#        if ($type eq 'any') {
#            require Data::Sah::Normalize;
#            if ($cs->{of} && @{ $cs->{of} }) {
#                $fres = combine_answers(
#                    grep { defined } map {
#                        complete_from_schema(
#                            schema=>Data::Sah::Normalize::normalize_schema($_),
#                            word => $word,
#                        )
#                    } @{ $cs->{of} }
#                );
#                goto RETURN_RES; 
#            }
#        }
#        if ($type eq 'bool') {
#            $log->tracef("[comp][periscomp] adding completion from possible values of bool");
#            push @$words, 0, 1;
#            $static++;
#            return; 
#        }
#        if ($type eq 'int') {
#            my $limit = 100;
#            if ($cs->{between} &&
#                    $cs->{between}[0] - $cs->{between}[0] <= $limit) {
#                $log->tracef("[comp][periscomp] adding completion from schema's 'between' clause");
#                push @$words, $cs->{between}[0] .. $cs->{between}[1];
#                $static++;
#            } elsif ($cs->{xbetween} &&
#                         $cs->{xbetween}[0] - $cs->{xbetween}[0] <= $limit) {
#                $log->tracef("[comp][periscomp] adding completion from schema's 'xbetween' clause");
#                push @$words, $cs->{xbetween}[0]+1 .. $cs->{xbetween}[1]-1;
#                $static++;
#            } elsif (defined($cs->{min}) && defined($cs->{max}) &&
#                         $cs->{max}-$cs->{min} <= $limit) {
#                $log->tracef("[comp][periscomp] adding completion from schema's 'min' & 'max' clauses");
#                push @$words, $cs->{min} .. $cs->{max};
#                $static++;
#            } elsif (defined($cs->{min}) && defined($cs->{xmax}) &&
#                         $cs->{xmax}-$cs->{min} <= $limit) {
#                $log->tracef("[comp][periscomp] adding completion from schema's 'min' & 'xmax' clauses");
#                push @$words, $cs->{min} .. $cs->{xmax}-1;
#                $static++;
#            } elsif (defined($cs->{xmin}) && defined($cs->{max}) &&
#                         $cs->{max}-$cs->{xmin} <= $limit) {
#                $log->tracef("[comp][periscomp] adding completion from schema's 'xmin' & 'max' clauses");
#                push @$words, $cs->{xmin}+1 .. $cs->{max};
#                $static++;
#            } elsif (defined($cs->{xmin}) && defined($cs->{xmax}) &&
#                         $cs->{xmax}-$cs->{xmin} <= $limit) {
#                $log->tracef("[comp][periscomp] adding completion from schema's 'xmin' & 'xmax' clauses");
#                push @$words, $cs->{xmin}+1 .. $cs->{xmax}-1;
#                $static++;
#            } elsif (length($word) && $word !~ /\A-?\d*\z/) {
#                $log->tracef("[comp][periscomp] word not an int");
#                $words = [];
#            } else {
#                $words = [];
#                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;
#                    }
#                }
#                $words = [sort @$words];
#            }
#            return; 
#        }
#        if ($type eq 'float') {
#            if (length($word) && $word !~ /\A-?\d*(\.\d*)?\z/) {
#                $log->tracef("[comp][periscomp] word not a float");
#                $words = [];
#            } else {
#                $words = [];
#                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;
#                    }
#                }
#            }
#            return; 
#        }
#    }; 
#
#    $log->tracef("[periscomp] complete_from_schema died: %s", $@) if $@;
#
#    goto RETURN_RES unless $words;
#    $fres = hashify_answer(
#        complete_array_elem(array=>$words, word=>$word),
#        {static=>$static && $word eq '' ? 1:0},
#    );
#
#  RETURN_RES:
#    $log->tracef("[comp][periscomp] leaving complete_from_schema, result=%s", $fres);
#    $fres;
#}
#
#$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', 
#    },
#};
#sub complete_arg_val {
#    my %args = @_;
#
#    $log->tracef("[comp][periscomp] entering complete_arg_val, arg=<%s>", $args{arg});
#    my $fres;
#
#    my $extras = $args{extras} // {};
#
#    my $meta = $args{meta} or do {
#        $log->tracef("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        $log->tracef("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        $log->tracef("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { 
#
#        my $comp;
#      GET_COMP_ROUTINE:
#        {
#            $comp = $arg_spec->{completion};
#            if ($comp) {
#                $log->tracef("[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->tracef("[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"};
#                        $comp = $fref->(%$xcargs);
#                    }
#                }
#                if ($comp) {
#                    $log->tracef("[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->tracef("[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->tracef("[comp][periscomp] using arg completion routine from complete_arg_val() from %s", $mod);
#                        $comp = \&{"$mod\::complete_arg_val"};
#                        last GET_COMP_ROUTINE;
#                    }
#                }
#            }
#        } 
#
#        if ($comp) {
#            if (ref($comp) eq 'CODE') {
#                $log->tracef("[comp][periscomp] invoking arg completion routine");
#                $fres = $comp->(
#                    %$extras,
#                    word=>$word, arg=>$arg, args=>$args{args});
#                return; 
#            } elsif (ref($comp) eq 'ARRAY') {
#                $log->tracef("[comp][periscomp] using array specified in arg completion routine: %s", $comp);
#                $fres = complete_array_elem(array=>$comp, word=>$word);
#                $static++;
#                return; 
#            }
#
#            $log->tracef("[comp][periscomp] arg spec's 'completion' property is not a coderef or arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                $log->tracef("[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->tracef("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; 
#                }
#                $fres = $res->[2];
#                return; 
#            }
#
#            $log->tracef("[comp][periscomp] declining");
#            return; 
#        }
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            $log->tracef("[comp][periscomp] arg spec does not specify schema, declining");
#            return; 
#        };
#
#
#        $fres = complete_from_schema(arg=>$arg, extras=>$extras, schema=>$sch, word=>$word);
#    };
#    $log->debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        $log->tracef("[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->tracef("[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->tracef("[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->tracef("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        $log->tracef("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    defined(my $index = $args{index}) or do {
#        $log->tracef("[comp][periscomp] index is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        $log->tracef("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { 
#
#        my $elcomp;
#      GET_ELCOMP_ROUTINE:
#        {
#            $elcomp = $arg_spec->{element_completion};
#            if ($elcomp) {
#                $log->tracef("[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->tracef("[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"};
#                        $elcomp = $fref->(%$xcargs);
#                    }
#                }
#                if ($elcomp) {
#                    $log->tracef("[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->tracef("[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->tracef("[comp][periscomp] using arg element completion routine from complete_arg_val() from %s", $mod);
#                        $elcomp = \&{"$mod\::complete_arg_val"};
#                        last GET_ELCOMP_ROUTINE;
#                    }
#                }
#            }
#        } 
#
#        $ourextras->{index} = $index;
#        if ($elcomp) {
#            if (ref($elcomp) eq 'CODE') {
#                $log->tracef("[comp][periscomp] invoking arg element completion routine");
#                $fres = $elcomp->(
#                    %$extras,
#                    %$ourextras,
#                    word=>$word);
#                return; 
#            } elsif (ref($elcomp) eq 'ARRAY') {
#                $log->tracef("[comp][periscomp] using array specified in arg element completion routine: %s", $elcomp);
#                $fres = complete_array_elem(array=>$elcomp, word=>$word);
#                $static = $word eq '';
#            }
#
#            $log->tracef("[comp][periscomp] arg spec's 'element_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                $log->tracef("[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->tracef("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; 
#                }
#                $fres = $res->[2];
#                return; 
#            }
#
#            $log->tracef("[comp][periscomp] declining");
#            return; 
#        } 
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            $log->tracef("[comp][periscomp] arg spec does not specify schema, declining");
#            return; 
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'array') {
#            $log->tracef("[comp][periscomp] can't complete element for non-array");
#            return; 
#        }
#
#        unless ($cs->{of}) {
#            $log->tracef("[comp][periscomp] schema does not specify 'of' clause, declining");
#            return; 
#        }
#
#        my $elsch = Data::Sah::Normalize::normalize_schema($cs->{of});
#
#        $fres = complete_from_schema(schema=>$elsch, word=>$word);
#    };
#    $log->debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        $log->tracef("[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->tracef("[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', 
#    },
#};
#sub complete_arg_index {
#    require Data::Sah::Normalize;
#
#    my %args = @_;
#
#    my $fres;
#
#    $log->tracef("[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->tracef("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        $log->tracef("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        $log->tracef("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { 
#
#        my $idxcomp;
#      GET_IDXCOMP_ROUTINE:
#        {
#            $idxcomp = $arg_spec->{index_completion};
#            if ($idxcomp) {
#                $log->tracef("[comp][periscomp] using arg element index completion routine from 'index_completion' property");
#                last GET_IDXCOMP_ROUTINE;
#            }
#        } 
#
#        if ($idxcomp) {
#            if (ref($idxcomp) eq 'CODE') {
#                $log->tracef("[comp][periscomp] invoking arg element index completion routine");
#                $fres = $idxcomp->(
#                    %$extras,
#                    %$ourextras,
#                    word=>$word);
#                return; 
#            } elsif (ref($idxcomp) eq 'ARRAY') {
#                $log->tracef("[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->tracef("[comp][periscomp] arg spec's 'index_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                $log->tracef("[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->tracef("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; 
#                }
#                $fres = $res->[2];
#                return; 
#            }
#
#            $log->tracef("[comp][periscomp] declining");
#            return; 
#        } 
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            $log->tracef("[comp][periscomp] arg spec does not specify schema, declining");
#            return; 
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'hash') {
#            $log->tracef("[comp][periscomp] can't complete element index for non-hash");
#            return; 
#        }
#
#        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} };
#        }
#
#        for (keys %{$args{args}{$arg} // {}}) {
#            delete $keys{$_};
#        }
#
#        $fres = complete_hash_key(word => $word, hash => \%keys);
#
#    }; 
#    $log->debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        $log->tracef("[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->tracef("[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"; 
#    my $fres;
#
#    my $word   = $words->[$cword];
#    my $args_prop = $meta->{args} // {};
#
#    $log->tracef('[comp][periscomp] entering %s(), words=%s, cword=%d, word=<%s>',
#                 $fname, $words, $cword, $word);
#
#    my $genres = 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: $genres->[0] - $genres->[1]"
#        unless $genres->[0] == 200;
#    my $gospec = $genres->[2];
#    my $specmeta = $genres->[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->tracef("[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->tracef("[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->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $compres;
#                    eval { $compres = $comp->(%cargs) };
#                    $log->debug("[comp][periscomp] completion died: $@") if $@;
#                    $log->tracef("[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}, 
#                        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} = "=";
#                        $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->tracef("[comp][periscomp] completing option value for a common option, ospec=<%s>", $ospec);
#                $cargs{arg}  = undef;
#                my $codata = $copts_by_ospec->{$ospec};
#                if ($comp) {
#                    $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    $log->debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{completion}) {
#                    $cargs{arg}  = undef;
#                    $log->tracef("[comp][periscomp] completing with common option's 'completion' property");
#                    my $res;
#                    eval { $res = $codata->{completion}->(%cargs) };
#                    $log->debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{schema}) {
#                    require Data::Sah::Normalize;
#                    my $nsch = Data::Sah::Normalize::normalize_schema(
#                        $codata->{schema});
#                    $log->tracef("[comp][periscomp] completing with common option's schema");
#                    $fres = complete_from_schema(
#                        schema => $nsch, word=>$word);
#                    goto RETURN_RES;
#                }
#                goto RETURN_RES;
#            }
#        } elsif ($type eq 'arg') {
#            $log->tracef("[comp][periscomp] completing argument #%d", $cargs{argpos});
#            $cargs{type} = 'arg';
#
#            my $pos = $cargs{argpos};
#            my $fasa = $args{func_arg_starts_at} // 0;
#
#            for my $an (keys %$args_prop) {
#                my $arg_spec = $args_prop->{$an};
#                next unless !$arg_spec->{greedy} &&
#                    defined($arg_spec->{pos}) && $arg_spec->{pos} == $pos - $fasa;
#                $log->tracef("[comp][periscomp] this argument position is for non-greedy function argument <%s>", $an);
#                $cargs{arg} = $an;
#                if ($comp) {
#                    $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    $log->debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_val(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            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->{greedy} &&
#                    defined($arg_spec->{pos}) && $arg_spec->{pos} <= $pos - $fasa;
#                my $index = $pos - $fasa - $arg_spec->{pos};
#                $cargs{arg} = $an;
#                $cargs{index} = $index;
#                $log->tracef("[comp][periscomp] this position is for greedy function argument <%s>'s element[%d]", $an, $index);
#                if ($comp) {
#                    $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    $log->debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_elem(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, index=>$index, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            $log->tracef("[comp][periscomp] there is no matching function argument at this position");
#            if ($comp) {
#                $log->tracef("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                my $res;
#                eval { $res = $comp->(%cargs) };
#                $log->debug("[comp][periscomp] completion died: $@") if $@;
#                if ($res) {
#                    $fres = $res;
#                    goto RETURN_RES;
#                }
#            }
#            goto RETURN_RES;
#        } else {
#            $log->tracef("[comp][periscomp] completing option value for an unknown/ambiguous option, declining ...");
#            goto RETURN_RES;
#        }
#      RETURN_RES:
#        $log->tracef("[comp][periscomp] leaving completion routine (that we supply to Complete::Getopt::Long)");
#        $fres;
#    }; 
#
#    $fres = Complete::Getopt::Long::complete_cli_arg(
#        getopt_spec => $gospec,
#        words       => $words,
#        cword       => $cword,
#        completion  => $compgl_comp,
#        extras      => $extras,
#    );
#
#  RETURN_RES:
#    $log->tracef('[comp][periscomp] leaving %s(), result=%s',
#                 $fname, $fres);
#    $fres;
#}
#
#1;
#
#__END__
#
### Perinci/Sub/GetArgs/Argv.pm ###
#package Perinci::Sub::GetArgs::Argv;
#
#our $DATE = '2017-04-19'; 
#our $VERSION = '0.81'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#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)',
#};
#
#sub _parse_json {
#    my $str = shift;
#
#    state $json = do {
#        require JSON::PP;
#        JSON::PP->new->allow_nonref;
#    };
#
#    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;
#
#    my $res;
#    eval {
#        if ($yaml_xs_available) {
#            $res = YAML::XS::Load($str);
#        } else {
#            $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; 
#    $opt;
#}
#
#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);
#}
#
#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];
#
#    {
#        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];
#
#            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] // {}]; 
#                $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];
#
#            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] // {}]; 
#                $eltype = $res->[0];
#            }
#
#            $is_hash_of_simple = _is_simple_or_coercible_from_simple($elnsch);
#            last;
#        }
#    }
#
#    ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype);
#}
#
#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 || $cset->{is}) {
#                push @res, ($opt, {opts=>[$opt]}), undef;
#            } else {
#                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' ? 'i' : $type eq 'float' ? 'f' : '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);
#
#        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 = {};
#
#
#        my $handler = sub {
#            my ($val, $val_set);
#
#            my $num_called = ++$stash->{called}{$arg};
#
#            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,
#                );
#            }
#        }; 
#
#        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;
#                }
#            }
#
#            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') {
#                        $alospec = $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"),
#                                ];
#                            }
#                        }
#                        $go_spec->{$alospec} = sub {
#
#                            my $num_called = ++$stash->{called}{$arg};
#                            my $rargs = do {
#                                if (ref($rargs) eq 'ARRAY') {
#                                    $rargs->[$num_called-1] //= {};
#                                    $rargs->[$num_called-1];
#                                } else {
#                                    $rargs;
#                                }
#                            };
#
#                            $alcode->($rargs, $_[1]);
#                        };
#                    } else {
#                        $go_spec->{$alospec} = $handler;
#                    }
#                    $specmeta->{$alospec} = {
#                        alias     => $al,
#                        is_alias  => 1,
#                        alias_for => $ospec,
#                        arg       => $arg,
#                        fqarg     => $fqarg,
#                        is_code   => $alcode ? 1:0,
#                        parsed    => $parsed,
#                        %$extra,
#                    };
#                    push @{$specmeta->{$ospec}{($alcode ? '':'non').'code_aliases'}},
#                        $alospec;
#                    $seen_opts->{$alopt}++; $seen_func_opts->{$alopt} = $fqarg;
#                }
#            } 
#
#            if ($arg_spec->{meta}) {
#                $rargs->{$arg} = {};
#                my $res = _args2opts(
#                    %args,
#                    argprefix => "$argprefix$arg\::",
#                    meta      => $arg_spec->{meta},
#                    rargs     => $rargs->{$arg},
#                );
#                return $res if $res;
#            }
#
#            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;
#            }
#        } 
#
#    } 
#
#    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; 
#    my %seen_opts;
#    my %seen_common_opts;
#    my %seen_func_opts;
#
#    for my $k (keys %$co) {
#        my $v = $co->{$k};
#        my $ospec   = $v->{getopt};
#        my $handler = $v->{handler};
#        my $res = parse_getopt_long_opt_spec($ospec)
#            or return [400, "Can't parse common opt spec '$ospec'"];
#        $go_spec{$ospec} = $handler;
#        $specmeta{$ospec} = {common_opt=>$k, arg=>undef, parsed=>$res};
#        for (@{ $res->{opts} }) {
#            return [412, "Clash of common opt '$_'"] if $seen_opts{$_};
#            $seen_opts{$_}++; $seen_common_opts{$_} = $ospec;
#            if ($res->{is_neg}) {
#                $seen_opts{"no$_"}++ ; $seen_common_opts{"no$_"}  = $ospec;
#                $seen_opts{"no-$_"}++; $seen_common_opts{"no-$_"} = $ospec;
#            }
#        }
#    }
#
#    my $res = _args2opts(
#        argprefix        => "",
#        parent_args      => \%fargs,
#        meta             => $meta,
#        seen_opts        => \%seen_opts,
#        seen_common_opts => \%seen_common_opts,
#        seen_func_opts   => \%seen_func_opts,
#        rargs            => $rargs,
#        go_spec          => \%go_spec,
#        specmeta         => \%specmeta,
#    );
#    return $res if $res;
#
#    my $opts        = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_opts)];
#    my $common_opts = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_common_opts)];
#    my $func_opts   = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_func_opts)];
#    my $opts_by_common = {};
#    for my $k (keys %$co) {
#        my $v = $co->{$k};
#        my $ospec = $v->{getopt};
#        my @opts;
#        for (keys %seen_common_opts) {
#            next unless $seen_common_opts{$_} eq $ospec;
#            push @opts, (length($_)>1 ? "--$_":"-$_");
#        }
#        $opts_by_common->{$ospec} = [sort @opts];
#    }
#
#    my $opts_by_arg = {};
#    for (keys %seen_func_opts) {
#        my $fqarg = $seen_func_opts{$_};
#        push @{ $opts_by_arg->{$fqarg} }, length($_)>1 ? "--$_":"-$_";
#    }
#    for (keys %$opts_by_arg) {
#        $opts_by_arg->{$_} = [sort @{ $opts_by_arg->{$_} }];
#    }
#
#    [200, "OK", \%go_spec,
#     {
#         "func.specmeta"       => \%specmeta,
#         "func.opts"           => $opts,
#         "func.common_opts"    => $common_opts,
#         "func.func_opts"      => $func_opts,
#         "func.opts_by_arg"    => $opts_by_arg,
#         "func.opts_by_common" => $opts_by_common,
#     }];
#}
#
#$SPEC{get_args_from_argv} = {
#    v => 1.1,
#    summary => 'Get subroutine arguments (%args) from command-line arguments '.
#        '(@ARGV)',
#    description => <<'_',
#
#Using information in Rinci function metadata's `args` property, parse command
#line arguments `@argv` into hash `%args`, suitable for passing into subroutines.
#
#Currently uses <pm:Getopt::Long>'s `GetOptions` to do the parsing.
#
#As with GetOptions, this function modifies its `argv` argument, so you might
#want to copy the original `argv` first (or pass a copy instead) if you want to
#preserve the original.
#
#See also: gen_getopt_long_spec_from_meta() which is the routine that generates
#the specification.
#
#_
#    args => {
#        argv => {
#            schema => ['array*' => {
#                of => 'str*',
#            }],
#            description => 'If not specified, defaults to @ARGV',
#        },
#        args => {
#            summary => 'Specify input args, with some arguments preset',
#            schema  => ['hash'],
#        },
#        meta => {
#            schema => ['hash*' => {}],
#            req => 1,
#        },
#        meta_is_normalized => {
#            summary => 'Can be set to 1 if your metadata is normalized, '.
#                'to avoid duplicate effort',
#            schema => 'bool',
#            default => 0,
#        },
#        strict => {
#            schema => ['bool' => {default=>1}],
#            summary => 'Strict mode',
#            description => <<'_',
#
#If set to 0, will still return parsed argv even if there are parsing errors
#(reported by Getopt::Long). If set to 1 (the default), will die upon error.
#
#Normally you would want to use strict mode, for more error checking. Setting off
#strict is used by, for example, Perinci::Sub::Complete during completion where
#the command-line might still be incomplete.
#
#Should probably be named `ignore_errors`. :-)
#
#_
#        },
#        per_arg_yaml => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Whether to recognize --ARGNAME-yaml',
#            description => <<'_',
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
#    % script.pl --name-yaml '~'
#
#See also: per_arg_json. You should enable just one instead of turning on both.
#
#_
#        },
#        per_arg_json => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Whether to recognize --ARGNAME-json',
#            description => <<'_',
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
#    % script.pl --name-json 'null'
#
#But every other string will need to be quoted:
#
#    % script.pl --name-json '"foo"'
#
#See also: per_arg_yaml. You should enable just one instead of turning on both.
#
#_
#        },
#        common_opts => {
#            summary => 'Common options',
#            description => <<'_',
#
#A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
#option specification), `handler` (Getopt::Long handler). Will be passed to
#`get_args_from_argv()`. Example:
#
#    {
#        help => {
#            getopt  => 'help|h|?',
#            handler => sub { ... },
#            summary => 'Display help and exit',
#        },
#        version => {
#            getopt  => 'version|v',
#            handler => sub { ... },
#            summary => 'Display version and exit',
#        },
#    }
#
#_
#            schema => ['hash*'],
#        },
#        allow_extra_elems => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Allow extra/unassigned elements in argv',
#            description => <<'_',
#
#If set to 1, then if there are array elements unassigned to one of the
#arguments, instead of generating an error, this function will just ignore them.
#
#This option will be passed to Perinci::Sub::GetArgs::Array's allow_extra_elems.
#
#_
#        },
#        on_missing_required_args => {
#            schema => 'code',
#            summary => 'Execute code when there is missing required args',
#            description => <<'_',
#
#This can be used to give a chance to supply argument value from other sources if
#not specified by command-line options. Perinci::CmdLine, for example, uses this
#hook to supply value from STDIN or file contents (if argument has `cmdline_src`
#specification key set).
#
#This hook will be called for each missing argument. It will be supplied hash
#arguments: (arg => $the_missing_argument_name, args =>
#$the_resulting_args_so_far, spec => $the_arg_spec).
#
#The hook can return true if it succeeds in making the missing situation
#resolved. In this case, this function will not report the argument as missing.
#
#_
#        },
#        ignore_converted_code => {
#            summary => 'Whether to ignore coderefs converted to string',
#            schema => 'bool',
#            default => 0,
#            description => <<'_',
#
#Across network through JSON encoding, coderef in metadata (e.g. in
#`cmdline_aliases` property) usually gets converted to string `CODE`. In some
#cases, like for tab completion, this is harmless so you can turn this option on.
#
#_
#        },
#    },
#    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};
#
#    my $rargs = $fargs{args} // {};
#
#    my $genres = 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];
#
#    {
#        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;
#        }
#    }
#
#
#    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->{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->{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;
#                if ($arg_spec->{cmdline_on_getopt}) {
#                    if ($arg_spec->{greedy}) {
#                        $arg_spec->{cmdline_on_getopt}->(
#                            arg=>$name, fqarg=>$name, value=>$_, args=>$rargs,
#                            opt=>undef, 
#                        ) for @$val;
#                    } else {
#                        $arg_spec->{cmdline_on_getopt}->(
#                            arg=>$name, fqarg=>$name, value=>$val, args=>$rargs,
#                            opt=>undef, 
#                        );
#                    }
#                }
#            }
#        }
#    }
#
#
#    my %missing_args;
#    for my $arg (keys %$args_prop) {
#        my $arg_spec = $args_prop->{$arg};
#        if (!exists($rargs->{$arg})) {
#            next unless $arg_spec->{req};
#            if ($on_missing) {
#                next if $on_missing->(arg=>$arg, args=>$rargs, spec=>$arg_spec);
#            }
#            next if exists $rargs->{$arg};
#            $missing_args{$arg} = 1;
#        }
#    }
#
#    {
#        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};
#        }
#    }
#
#    [200, "OK", $rargs, {
#        "func.missing_args" => [sort keys %missing_args],
#        "func.gen_getopt_long_spec_result" => $genres,
#    }];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/GetArgs/Array.pm ###
#package Perinci::Sub::GetArgs::Array;
#
#our $DATE = '2016-12-10'; 
#our $VERSION = '0.16'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#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
#`greedy` 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) {
#        while (my ($a, $as) = each %$args_p) {
#            my $o = $as->{pos};
#            if (defined($o) && $o == $i) {
#                if ($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;
#                    }
#                } else {
#                    $rargs->{$a} = splice(@$ary, $i, 1);
#                }
#            }
#        }
#    }
#
#    return [400, "There are extra, unassigned elements in array: [".
#                join(", ", @$ary)."]"] if @$ary && !$allow_extra_elems;
#
#    [200, "OK", $rargs];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Normalize.pm ###
#package Perinci::Sub::Normalize;
#
#our $DATE = '2016-12-11'; 
#our $VERSION = '0.19'; 
#
#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" : "");
#
#        if ($prop =~ /\A_/ || defined($attr) && $attr =~ /\A_|\._/) {
#            unless ($opt_rip) {
#                $nmeta->{$nk} = $meta->{$k};
#            }
#            next KEY;
#        }
#
#        my $prop_proplist = $proplist->{$prop};
#
#        if (!$opt_aup && !$prop_proplist) {
#            $modprefix //= $prefix;
#            my $mod = "Perinci/Sub/Property$modprefix/$prop.pm";
#            eval { require $mod };
#            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) { 
#                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;
#
#__END__
#
### Perinci/Sub/Util.pm ###
#package Perinci::Sub::Util;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#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; 
#our $_i; 
#sub err {
#    require Scalar::Util;
#
#    my @caller = CORE::caller(1);
#    if (!@caller) {
#        @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;
#
#    if (!$meta->{logs}) {
#
#        my $stack_trace;
#        {
#            no warnings;
#            last unless $STACK_TRACE // $INC{"Carp/Always.pm"};
#            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,
#        };
#    }
#
#    [$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) { 
#        $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*', 
#        },
#        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*'], 
#            },
#        }],
#    },
#};
#sub gen_modified_sub {
#    require Function::Fallback::CoreOrPP;
#
#    my %args = @_;
#
#    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;
#
#    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);
#    }
#
#    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;
#
#__END__
#
### Perinci/Sub/Util/Args.pm ###
#package Perinci::Sub::Util::Args;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#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;
#
#__END__
#
### Perinci/Sub/Util/ResObj.pm ###
#package Perinci::Sub::Util::ResObj;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#use Carp;
#use overload
#    q("") => sub {
#        my $res = shift; "ERROR $err->[0]: $err->[1]\n" . Carp::longmess();
#    };
#
#1;
#
#__END__
#
### Perinci/Sub/Util/Sort.pm ###
#package Perinci::Sub::Util::Sort;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#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;
#
#__END__
#
### Regexp/Stringify.pm ###
#package Regexp::Stringify;
#
#our $DATE = '2016-10-29'; 
#our $VERSION = '0.06'; 
#
#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;
#
#__END__
#
### Sah/Schema/rinci/function_meta.pm ###
#package Sah::Schema::rinci::function_meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Normalize ();
#use Sah::Schema::rinci::meta ();
#
#our $schema = [hash => {
#    summary => 'Rinci function metadata',
#
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        entity_v => {},
#        entity_date => {},
#        links => {},
#
#        is_func => {},
#        is_meth => {},
#        is_class_meth => {},
#        args => {
#            _value_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                links => {},
#
#                schema => {},
#                filters => {},
#                default => {},
#                req => {},
#                pos => {},
#                greedy => {},
#                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 => {},
#                    },
#                },
#            },
#        },
#        args_as => {},
#        args_rels => {},
#        result => {
#            _prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                schema => {},
#                statuses => {
#                    _value_prop => {
#                        summary => {},
#                        description => {},
#                        schema => {},
#                    },
#                },
#                partial => {},
#                stream => {},
#            },
#        },
#        result_naked => {},
#        examples => {
#            _elem_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                args => {},
#                argv => {},
#                src => {},
#                src_plang => {},
#                status => {},
#                result => {},
#                test => {},
#            },
#        },
#        features => {
#            _keys => {
#                reverse => {},
#                tx => {},
#                dry_run => {},
#                pure => {},
#                immutable => {},
#                idempotent => {},
#                check_arg => {},
#            },
#        },
#        deps => {
#            _keys => {
#                all => {},
#                any => {},
#                none => {},
#                env => {},
#                prog => {},
#                pkg => {},
#                func => {},
#                code => {},
#                tmp_dir => {},
#                trash_dir => {},
#            },
#        },
#    },
#}, {}];
#
#$schema->[1]{_prop}{args}{_value_prop}{meta} = $schema->[1];
#$schema->[1]{_prop}{args}{_value_prop}{element_meta} = $schema->[1];
#
#
#$schema = Data::Sah::Normalize::normalize_schema($schema);
#
#1;
#
#__END__
#
### Sah/Schema/rinci/meta.pm ###
#package Sah::Schema::rinci::meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#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',
#    _ver => 1.1, 
#    _prop => {
#        %_dh_props,
#
#        entity_v => {},
#        entity_date => {},
#        links => {
#            _elem_prop => {
#                %_dh_props,
#
#                url => {},
#            },
#        },
#    },
#}, {}];
#
#1;
#
#__END__
#
### Sah/Schema/rinci/result_meta.pm ###
#package Sah::Schema::rinci::result_meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Sah::Schema::rinci::meta;
#
#our $schema = [hash => {
#    summary => 'Rinci envelope result metadata',
#
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        perm_err => {},
#        func => {}, 
#        cmdline => {}, 
#        logs => {},
#        prev => {},
#        results => {},
#        part_start => {},
#        part_len => {},
#        len => {},
#        stream => {},
#    },
#}, {}];
#
#1;
#
#__END__
#
### Sah/SchemaR/rinci/function_meta.pm ###
#package Sah::SchemaR::rinci::function_meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#our $rschema = do {
#  my $a = [
#    "hash",
#    [
#      {
#        _prop   => {
#                     args => {
#                       _value_prop => {
#                         caption => {},
#                         cmdline_aliases => {
#                           _value_prop => { code => {}, description => {}, is_flag => {}, schema => {}, summary => {} },
#                         },
#                         cmdline_on_getopt => {},
#                         cmdline_prompt => {},
#                         cmdline_src => {},
#                         completion => {},
#                         default => {},
#                         default_lang => {},
#                         defhash_v => {},
#                         deps => { _keys => { all => {}, any => {}, arg => {}, none => {} } },
#                         description => {},
#                         element_completion => {},
#                         element_meta => { _prop => 'fix', _ver => 1.1, summary => "Rinci function metadata" },
#                         filters => {},
#                         greedy => {},
#                         index_completion => {},
#                         is_password => {},
#                         links => {},
#                         meta => 'fix',
#                         name => {},
#                         partial => {},
#                         pos => {},
#                         req => {},
#                         schema => {},
#                         stream => {},
#                         summary => {},
#                         tags => {},
#                         v => {},
#                         x => {},
#                       },
#                     },
#                     args_as => {},
#                     args_rels => {},
#                     caption => 'fix',
#                     default_lang => 'fix',
#                     defhash_v => 'fix',
#                     deps => {
#                       _keys => {
#                         all       => {},
#                         any       => {},
#                         code      => {},
#                         env       => {},
#                         func      => {},
#                         none      => {},
#                         pkg       => {},
#                         prog      => {},
#                         tmp_dir   => {},
#                         trash_dir => {},
#                       },
#                     },
#                     description => 'fix',
#                     entity_date => {},
#                     entity_v => {},
#                     examples => {
#                       _elem_prop => {
#                         args => {},
#                         argv => {},
#                         caption => 'fix',
#                         default_lang => 'fix',
#                         defhash_v => 'fix',
#                         description => 'fix',
#                         name => 'fix',
#                         result => {},
#                         src => {},
#                         src_plang => {},
#                         status => {},
#                         summary => 'fix',
#                         tags => 'fix',
#                         test => {},
#                         v => 'fix',
#                         x => 'fix',
#                       },
#                     },
#                     features => {
#                       _keys => {
#                         check_arg => {},
#                         dry_run => {},
#                         idempotent => {},
#                         immutable => {},
#                         pure => {},
#                         reverse => {},
#                         tx => {},
#                       },
#                     },
#                     is_class_meth => {},
#                     is_func => {},
#                     is_meth => {},
#                     links => {},
#                     name => 'fix',
#                     result => {
#                       _prop => {
#                         caption => 'fix',
#                         default_lang => 'fix',
#                         defhash_v => 'fix',
#                         description => 'fix',
#                         name => 'fix',
#                         partial => {},
#                         schema => {},
#                         statuses => {
#                           _value_prop => { description => {}, schema => {}, summary => {} },
#                         },
#                         stream => {},
#                         summary => 'fix',
#                         tags => 'fix',
#                         v => 'fix',
#                         x => 'fix',
#                       },
#                     },
#                     result_naked => {},
#                     summary => 'fix',
#                     tags => 'fix',
#                     v => 'fix',
#                     x => 'fix',
#                   },
#        _ver    => 1.1,
#        summary => "Rinci function metadata",
#      },
#    ],
#    ["hash"],
#  ];
#  $a->[1][0]{_prop}{args}{_value_prop}{element_meta}{_prop} = $a->[1][0]{_prop};
#  $a->[1][0]{_prop}{args}{_value_prop}{meta} = $a->[1][0]{_prop}{args}{_value_prop}{element_meta};
#  $a->[1][0]{_prop}{caption} = $a->[1][0]{_prop}{args}{_value_prop}{caption};
#  $a->[1][0]{_prop}{default_lang} = $a->[1][0]{_prop}{args}{_value_prop}{default_lang};
#  $a->[1][0]{_prop}{defhash_v} = $a->[1][0]{_prop}{args}{_value_prop}{defhash_v};
#  $a->[1][0]{_prop}{description} = $a->[1][0]{_prop}{args}{_value_prop}{description};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{caption} = $a->[1][0]{_prop}{args}{_value_prop}{caption};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{default_lang} = $a->[1][0]{_prop}{args}{_value_prop}{default_lang};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{defhash_v} = $a->[1][0]{_prop}{args}{_value_prop}{defhash_v};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{description} = $a->[1][0]{_prop}{args}{_value_prop}{description};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{name} = $a->[1][0]{_prop}{args}{_value_prop}{name};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{summary} = $a->[1][0]{_prop}{args}{_value_prop}{summary};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{tags} = $a->[1][0]{_prop}{args}{_value_prop}{tags};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{v} = $a->[1][0]{_prop}{args}{_value_prop}{v};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{x} = $a->[1][0]{_prop}{args}{_value_prop}{x};
#  $a->[1][0]{_prop}{name} = $a->[1][0]{_prop}{args}{_value_prop}{name};
#  $a->[1][0]{_prop}{result}{_prop}{caption} = $a->[1][0]{_prop}{args}{_value_prop}{caption};
#  $a->[1][0]{_prop}{result}{_prop}{default_lang} = $a->[1][0]{_prop}{args}{_value_prop}{default_lang};
#  $a->[1][0]{_prop}{result}{_prop}{defhash_v} = $a->[1][0]{_prop}{args}{_value_prop}{defhash_v};
#  $a->[1][0]{_prop}{result}{_prop}{description} = $a->[1][0]{_prop}{args}{_value_prop}{description};
#  $a->[1][0]{_prop}{result}{_prop}{name} = $a->[1][0]{_prop}{args}{_value_prop}{name};
#  $a->[1][0]{_prop}{result}{_prop}{summary} = $a->[1][0]{_prop}{args}{_value_prop}{summary};
#  $a->[1][0]{_prop}{result}{_prop}{tags} = $a->[1][0]{_prop}{args}{_value_prop}{tags};
#  $a->[1][0]{_prop}{result}{_prop}{v} = $a->[1][0]{_prop}{args}{_value_prop}{v};
#  $a->[1][0]{_prop}{result}{_prop}{x} = $a->[1][0]{_prop}{args}{_value_prop}{x};
#  $a->[1][0]{_prop}{summary} = $a->[1][0]{_prop}{args}{_value_prop}{summary};
#  $a->[1][0]{_prop}{tags} = $a->[1][0]{_prop}{args}{_value_prop}{tags};
#  $a->[1][0]{_prop}{v} = $a->[1][0]{_prop}{args}{_value_prop}{v};
#  $a->[1][0]{_prop}{x} = $a->[1][0]{_prop}{args}{_value_prop}{x};
#  $a;
#};
#
#1;
#
#__END__
#
### Sah/SchemaR/rinci/meta.pm ###
#package Sah::SchemaR::rinci::meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#our $rschema = do {
#  my $a = [
#    "hash",
#    [
#      {
#        _prop   => {
#                     caption => {},
#                     default_lang => {},
#                     defhash_v => {},
#                     description => {},
#                     entity_date => {},
#                     entity_v => {},
#                     links => {
#                       _elem_prop => {
#                         caption => 'fix',
#                         default_lang => 'fix',
#                         defhash_v => 'fix',
#                         description => 'fix',
#                         name => {},
#                         summary => {},
#                         tags => {},
#                         url => {},
#                         v => {},
#                         x => {},
#                       },
#                     },
#                     name => 'fix',
#                     summary => 'fix',
#                     tags => 'fix',
#                     v => 'fix',
#                     x => 'fix',
#                   },
#        _ver    => 1.1,
#        summary => "Rinci metadata",
#      },
#    ],
#    ["hash"],
#  ];
#  $a->[1][0]{_prop}{links}{_elem_prop}{caption} = $a->[1][0]{_prop}{caption};
#  $a->[1][0]{_prop}{links}{_elem_prop}{default_lang} = $a->[1][0]{_prop}{default_lang};
#  $a->[1][0]{_prop}{links}{_elem_prop}{defhash_v} = $a->[1][0]{_prop}{defhash_v};
#  $a->[1][0]{_prop}{links}{_elem_prop}{description} = $a->[1][0]{_prop}{description};
#  $a->[1][0]{_prop}{name} = $a->[1][0]{_prop}{links}{_elem_prop}{name};
#  $a->[1][0]{_prop}{summary} = $a->[1][0]{_prop}{links}{_elem_prop}{summary};
#  $a->[1][0]{_prop}{tags} = $a->[1][0]{_prop}{links}{_elem_prop}{tags};
#  $a->[1][0]{_prop}{v} = $a->[1][0]{_prop}{links}{_elem_prop}{v};
#  $a->[1][0]{_prop}{x} = $a->[1][0]{_prop}{links}{_elem_prop}{x};
#  $a;
#};
#
#1;
#
#__END__
#
### Sah/SchemaR/rinci/result_meta.pm ###
#package Sah::SchemaR::rinci::result_meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#our $rschema = [
#  "hash",
#  [
#    {
#      _prop   => {
#                   caption => {},
#                   cmdline => {},
#                   default_lang => {},
#                   defhash_v => {},
#                   description => {},
#                   func => {},
#                   len => {},
#                   logs => {},
#                   name => {},
#                   part_len => {},
#                   part_start => {},
#                   perm_err => {},
#                   prev => {},
#                   results => {},
#                   stream => {},
#                   summary => {},
#                   tags => {},
#                   v => {},
#                   x => {},
#                 },
#      _ver    => 1.1,
#      summary => "Rinci envelope result metadata",
#    },
#  ],
#  ["hash"],
#];
#
#1;
#
#__END__
#
### Sah/Schemas/Rinci.pm ###
#package Sah::Schemas::Rinci;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#1;
#
#__END__
#
### String/LineNumber.pm ###
#package String::LineNumber;
#
#our $DATE = '2014-12-10'; 
#our $VERSION = '0.01'; 
#
#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;
#
#__END__
#
### String/PerlQuote.pm ###
#package String::PerlQuote;
#
#our $DATE = '2016-10-07'; 
#our $VERSION = '0.02'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       single_quote
#                       double_quote
#               );
#
#my %esc = (
#    "\a" => "\\a",
#    "\b" => "\\b",
#    "\t" => "\\t",
#    "\n" => "\\n",
#    "\f" => "\\f",
#    "\r" => "\\r",
#    "\e" => "\\e",
#);
#
#sub double_quote {
#  local($_) = $_[0];
#  s/([\\\"\@\$])/\\$1/g;
#  return qq("$_") unless /[^\040-\176]/;  
#
#  s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
#  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("$_");
#}
#
#sub single_quote {
#  local($_) = $_[0];
#  s/([\\'])/\\$1/g;
#  return qq('$_');
#}
#1;
#
#__END__
#
### String/Wildcard/Bash.pm ###
#package String::Wildcard::Bash;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $VERSION = '0.03'; 
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       $RE_WILDCARD_BASH
#                       contains_wildcard
#                       convert_wildcard_to_sql
#               );
#
#our $RE_WILDCARD_BASH =
#    qr(
#          # non-escaped brace expression, with at least one comma
#          (?P<brace>
#              (?<!\\)(?:\\\\)*\{
#              (?:           \\\\ | \\\{ | \\\} | [^\\\{\}] )*
#              (?:, (?:  \\\\ | \\\{ | \\\} | [^\\\{\}] )* )+
#              (?<!\\)(?:\\\\)*\}
#          )
#      |
#          # 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<braceno>
#              (?<!\\)(?:\\\\)*\{
#              (?:           \\\\ | \\\{ | \\\} | [^\\\{\}] )*
#              (?<!\\)(?:\\\\)*\}
#          )
#      |
#          (?P<class>
#              # non-empty, non-escaped character class
#              (?<!\\)(?:\\\\)*\[
#              (?:  \\\\ | \\\[ | \\\] | [^\\\[\]] )+
#              (?<!\\)(?:\\\\)*\]
#          )
#      |
#          (?P<joker>
#              # non-escaped * and ?
#              (?<!\\)(?:\\\\)*[*?]
#          )
#      |
#          (?P<sql_wc>
#              # non-escaped % and ?
#              (?<!\\)(?:\\\\)*[%_]
#          )
#      )ox;
#
#sub contains_wildcard {
#    my $str = shift;
#
#    while ($str =~ /$RE_WILDCARD_BASH/go) {
#        my %m = %+;
#        return 1 if $m{brace} || $m{class} || $m{joker};
#    }
#    0;
#}
#
#sub convert_wildcard_to_sql {
#    my $str = shift;
#
#    $str =~ s/$RE_WILDCARD_BASH/
#        if ($+{joker}) {
#            if ($+{joker} eq '*') {
#                "%";
#            } else {
#                "_";
#            }
#        } elsif ($+{sql_wc}) {
#            "\\$+{sql_wc}";
#        } else {
#            $&;
#        }
#    /eg;
#
#    $str;
#}
#
#1;
#
#__END__
#
### YAML/Old.pm ###
#use strict; use warnings;
#package YAML::Old;
#our $VERSION = '1.07';
#
#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 };
#
#use YAML::Old::Node; 
#
#{
#    package
#    YAML;
#    use constant VALUE => "\x07YAML\x07VALUE\x07";
#}
#
#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::Old::DumperClass)
#        if $YAML::Old::DumperClass;
#    return $yaml->dumper_object->dump(@_);
#}
#
#sub Load {
#    my $yaml = YAML::Old->new;
#    $yaml->loader_class($YAML::Old::LoaderClass)
#        if $YAML::Old::LoaderClass;
#    return $yaml->loader_object->load(@_);
#}
#
#{
#    no warnings 'once';
#    *freeze = \ &Dump;
#    *thaw   = \ &Load;
#}
#
#sub DumpFile {
#    my $OUT;
#    my $filename = shift;
#    if (ref $filename eq 'GLOB') {
#        $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';  
#    local $/ = "\n"; 
#    print $OUT Dump(@_);
#}
#
#sub LoadFile {
#    my $IN;
#    my $filename = shift;
#    if (ref $filename eq 'GLOB') {
#        $IN = $filename;
#    }
#    else {
#        open $IN, '<', $filename
#          or YAML::Old::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
#    }
#    binmode $IN, ':utf8';  
#    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 constant KEY       => 3;
#use constant BLESSED   => 4;
#use constant FROMARRAY => 5;
#use constant VALUE     => "\x07YAML\x07VALUE\x07";
#
#my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
#my $LIT_CHAR    = '|';
#
#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;
#}
#
#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;
#        $self->headless(1);
#        return;
#    }
#    $self->{stream} .= '---';
#    if ($self->use_version) {
#    }
#}
#
#sub _prewalk {
#    my $self = shift;
#    my $stringify = $self->stringify;
#    my ($class, $type, $node_id) = $self->node_info(\$_[0], $stringify);
#
#    if ($type eq 'GLOB') {
#        $self->transferred->{$node_id} =
#          YAML::Old::Type::glob->yaml_dump($_[0]);
#        $self->_prewalk($self->transferred->{$node_id});
#        return;
#    }
#
#    if (ref($_[0]) eq 'Regexp') {
#        return;
#    }
#
#    if (not ref $_[0]) {
#        $self->{id_refcnt}{$node_id}++ if $self->purity;
#        return;
#    }
#
#    my $value = $_[0];
#    ($class, $type, $node_id) = $self->node_info($value, $stringify);
#
#    return if (ref($value) and not $type);
#
#    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;
#    }
#
#    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;
#    }
#
#    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);
#    }
#
#    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;
#    }
#
#    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);
#    }
#
#    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;
#    }
#
#    return if ++($self->{id_refcnt}{$node_id}) > 1;
#
#    if ($type eq 'HASH') {
#        $self->_prewalk($value->{$_})
#            for keys %{$value};
#        return;
#    }
#    elsif ($type eq 'ARRAY') {
#        $self->_prewalk($_)
#            for @{$value};
#        return;
#    }
#
#    $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;
#}
#
#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")   
#      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");
#}
#
#sub _emit_mapping {
#    my $self = shift;
#    my ($value, $tag, $node_id, $context) = @_;
#    $self->{stream} .= " !$tag" if $tag;
#
#    my $empty_hash = not(eval {keys %$value});
#    $self->warn('YAML_EMIT_WARN_KEYS', $@) if $@;
#    return ($self->{stream} .= " {}\n") if $empty_hash;
#
#    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;
#    }
#    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;
#    }
#    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}--;
#}
#
#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));
#
#    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}--;
#}
#
#sub _emit_key {
#    my $self = shift;
#    my ($value, $context) = @_;
#    $self->{stream} .= ' ' x $self->offset->[$self->level]
#      unless $context == FROMARRAY;
#    $self->_emit_str($value, KEY);
#}
#
#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 '', @_;
#}
#
#sub _emit_str {
#    my $self = shift;
#    my $type = $_[1] || 0;
#
#    $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] \$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_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_valid_plain {
#    my $self = shift;
#    return 0 unless length $_[0];
#    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);
#}
#
#sub _emit_plain {
#    my $self = shift;
#    $self->{stream} .= defined $_[0] ? $_[0] : '~';
#}
#
#sub _emit_double {
#    my $self = shift;
#    (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
#    $self->{stream} .= qq{"$escaped"};
#}
#
#sub _emit_single {
#    my $self = shift;
#    my $item = shift;
#    $item =~ s{'}{''}g;
#    $self->{stream} .= "'$item'";
#}
#
#
#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;
#}
#
#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
#                );
#
#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;
#
#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 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 {{}};
#
#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;
#}
#
#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 ' . $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+//;$_} split "\n", <<'...';
#YAML_PARSE_ERR_BAD_CHARS
#  Invalid characters in stream. This parser only supports printable ASCII
#YAML_PARSE_ERR_NO_FINAL_NEWLINE
#  Stream does not end with newline character
#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_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 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 constant LEAF       => 1;
#use constant COLLECTION => 2;
#use constant VALUE      => "\x07YAML\x07VALUE\x07";
#use constant COMMENT    => "\x07YAML\x07COMMENT\x07";
#
#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();
#}
#
#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->die('YAML_PARSE_ERR_NO_FINAL_NEWLINE')
#      if length($self->stream) and
#         $self->{stream} !~ s/(.)\n\Z/$1/s;
#    $self->lines([split /\x0a/, $self->stream, -1]);
#    $self->line(1);
#    $self->_parse_throwaway_comments();
#    $self->document(0);
#    $self->documents([]);
#    if (not $self->eos) {
#        if ($self->lines->[0] !~ /^---(\s|$)/) {
#            unshift @{$self->lines}, '---';
#            $self->{line}--;
#        }
#    }
#
#    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];
#}
#
#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') {
#            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;
#}
#
#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);
#}
#
#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 || ''));
#
#
#        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);
#        }
#    }
#    elsif ($YAML::Old::TagClass->{$explicit} ||
#           $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}
#          ) {
#        $class = $YAML::Old::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 {
#        return $node;
#    }
#}
#
#sub _parse_mapping {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $mapping = {};
#    $self->anchor2node->{$anchor} = $mapping;
#    my $key;
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        if ($self->{content} =~ s/^\?\s*//) {
#            $self->preface($self->content);
#            $self->_parse_next_line(COLLECTION);
#            $key = $self->_parse_node();
#            $key = "$key";
#        }
#        elsif ($self->{content} =~ s/^\=\s*//) {
#            $key = VALUE;
#        }
#        elsif ($self->{content} =~ s/^\=\s*//) {
#            $key = COMMENT;
#        }
#        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');
#        }
#        else {
#            $mapping->{$key} = $value;
#        }
#    }
#    return $mapping;
#}
#
#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');
#        }
#        if ($self->preface =~ /^(\s*)(\w.*\:(?: |$).*)$/) {
#            $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;
#}
#
#sub _parse_inline {
#    my $self = shift;
#    my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
#    $self->{inline} =~ s/^\s*(.*)\s*$/$1/; 
#    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 ($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;
#}
#
#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*\}//) {
#        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');
#        }
#        else {
#            $node->{$key} = $value;
#        }
#        next if $self->inline =~ /^\s*\}/;
#        $self->die('YAML_PARSE_ERR_INLINE_MAP')
#          unless $self->{inline} =~ s/^\,\s*//;
#    }
#    return $node;
#}
#
#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*\]//) {
#        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;
#}
#
#sub _parse_inline_double_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_DOUBLE');
#    }
#    return $node;
#}
#
#
#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;
#}
#
#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);
#}
#
#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;
#}
#
#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;
#}
#
#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});
#}
#
#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});
#    return if $self->eos;
#    $self->{line}++;
#
#    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 {
#            while (@{$self->lines} && ($self->lines->[0] =~ /^\s*#/)) {
#                $self->lines->[0] =~ /^( *)/ or die;
#                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];
#    }
#    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 die;
#            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;
#}
#
#
#my %unescapes = (
#   0 => "\x00",
#   a => "\x07",
#   t => "\x09",
#   n => "\x0a",
#   'v' => "\x0b", 
#   f => "\x0c",
#   r => "\x0d",
#   e => "\x1b",
#   '\\' => '\\',
#  );
#
#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 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 {''};
#
#sub set_global_options {
#    my $self = shift;
#    $self->load_code($YAML::LoadCode || $YAML::UseCode)
#      if defined $YAML::LoadCode or defined $YAML::UseCode;
#}
#
#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::Old::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;
#
#no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{bless{@_[1..$#_]},$_[0]};*{$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}};$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;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)=@_;$a{default}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$a{default}->(@_):$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);
#};
#
#*{$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"; 
#}
#
#*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
#*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
#*undone; 
#
#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;
#
#package YAML::Old::Type::blessed;
#
#use YAML::Old::Mo; 
#
#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::VALUE, ${$_[0]})}, $tag
#        );
#    }
#    elsif ($type eq 'SCALAR') {
#        $_[1] = $$value;
#        YAML::Old::Node->new($_[1], $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;
#    my $ynode = YAML::Old::Node->new({}, '!perl/glob:');
#    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 { use B::Deparse };
#        return if $@;
#        my $deparse = B::Deparse->new();
#        eval {
#            local $^W = 0;
#            $code = $deparse->coderef2text($value);
#        };
#        if ($@) {
#            warn YAML::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::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::VALUE};
#    return \$node->{&YAML::VALUE};
#}
#
#package YAML::Old::Type::regexp;
#
#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;