#!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.08
# on Sat Oct  1 17:06:44 2016. You probably should not manually edit this file.

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

use 5.010;
use strict;
use warnings;

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

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

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

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

my $sc_metas = {};

my $copts = {format=>{default=>undef,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"]],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');
    my @go_spec;
    for my $k (keys %$copts) { push @go_spec, $copts->{$k}{getopt} => sub { my ($go, $val) = @_; $copts->{$k}{handler}->($go, $val, $r); } }
    Getopt::Long::GetOptions(@go_spec);
    Getopt::Long::Configure($old_go_conf);
}

# select subcommand
my $scn = $r->{subcommand_name};
my $scn_from = $r->{subcommand_name_from};
if (!defined($scn) && defined($args->{default_subcommand})) {
    # get from default_subcommand
    if ($args->{get_subcommand_from_arg} == 1) {
        $scn = $args->{default_subcommand};
        $scn_from = "default_subcommand";
    } elsif ($args->{get_subcommand_from_arg} == 2 && !@ARGV) {
        $scn = $args->{default_subcommand};
        $scn_from = "default_subcommand";
    }
}
if (!defined($scn) && $args->{subcommands} && @ARGV) {
    # get from first command-line arg
    $scn = shift @ARGV;
    $scn_from = "arg";
}

if (defined($scn) && !$sc_metas->{$scn}) { undef $scn } # unknown subcommand name
# XXX read_env

# complete with periscomp
my $compres;
{
    require Perinci::Sub::Complete;
    $compres = Perinci::Sub::Complete::complete_cli_arg(
        meta => defined($scn) ? $sc_metas->{$scn} : $meta,
        words => $words,
        cword => $cword,
        common_opts => $copts,
        riap_server_url => undef,
        riap_uri => undef,
        extras => {r=>$r, cmdline=>undef},
        func_arg_starts_at => (($scn_from//"") eq "arg" ? 1:0),
        completion => sub {
            my %args = @_;
            my $type = $args{type};

            # user specifies custom completion routine, so use that first
            if ($args->{completion}) {
                my $res = $args->{completion}->(%args);
                return $res if $res;
            }
            # if subcommand name has not been supplied and we're at arg#0,
            # complete subcommand name
            if ($args->{subcommands} &&
                $scn_from ne "--cmd" &&
                     $type eq "arg" && $args{argpos}==0) {
                require Complete::Util;
                return Complete::Util::complete_array_elem(
                    array => [keys %{ $args->{subcommands} }],
                    word  => $words->[$cword]);
            }

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

# display result
if    ($shell eq "bash") { print Complete::Bash::format_completion($compres, {word=>$words->[$cword]}) }
elsif ($shell eq "tcsh") { print Complete::Tcsh::format_completion($compres) }

=pod

=encoding UTF-8

=head1 NAME

_acme-cpanauthors - Completer script for acme-cpanauthors

=head1 VERSION

This document describes version 0.002 of App::AcmeCpanauthors (from Perl distribution App-AcmeCpanauthors), released on 2016-10-01.

=head1 HOMEPAGE

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

=head1 SOURCE

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

=head1 BUGS

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

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

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

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

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

=cut

__DATA__
Data::Section::Seekable v1
Capture/Tiny.pm,24,10382,0;0
Class/Inspector.pm,10433,5934,1;337
Class/Inspector/Functions.pm,16404,708,2;634
Clone/PP.pm,17132,1884,3;681
Complete/Bash.pm,19041,17458,4;752
Complete/Common.pm,36526,945,5;1277
Complete/Env.pm,37495,1269,6;1316
Complete/File.pm,38789,6044,7;1376
Complete/Getopt/Long.pm,44865,18523,8;1578
Complete/Path.pm,63413,7990,9;2108
Complete/Tcsh.pm,71428,2757,10;2369
Complete/Util.pm,74210,16082,11;2474
Data/Dmp.pm,90312,4238,12;3036
Data/Dump.pm,94571,12066,13;3215
Data/Dump/FilterContext.pm,106672,1740,14;3748
Data/Dump/Filtered.pm,108442,812,15;3842
Data/Dump/Trace.pm,109281,6339,16;3875
Data/ModeMerge.pm,115646,10593,17;4141
Data/ModeMerge/Config.pm,126272,2140,18;4459
Data/ModeMerge/Mode/ADD.pm,128447,1373,19;4530
Data/ModeMerge/Mode/Base.pm,129856,16705,20;4599
Data/ModeMerge/Mode/CONCAT.pm,146599,442,21;5129
Data/ModeMerge/Mode/DELETE.pm,147079,1218,22;5157
Data/ModeMerge/Mode/KEEP.pm,148333,1174,23;5232
Data/ModeMerge/Mode/NORMAL.pm,149545,1501,24;5300
Data/ModeMerge/Mode/SUBTRACT.pm,151086,2064,25;5393
Data/Sah.pm,153170,2541,26;5485
Data/Sah/Coerce.pm,155738,2739,27;5598
Data/Sah/Coerce/js/bool/float.pm,158518,560,28;5708
Data/Sah/Coerce/js/bool/str.pm,159117,717,29;5748
Data/Sah/Coerce/js/date/float_epoch.pm,159881,590,30;5791
Data/Sah/Coerce/js/date/obj_Date.pm,160515,597,31;5831
Data/Sah/Coerce/js/date/str.pm,161151,625,32;5870
Data/Sah/Coerce/js/duration/float_secs.pm,161826,741,33;5909
Data/Sah/Coerce/js/duration/str_iso8601.pm,162618,967,34;5951
Data/Sah/Coerce/perl/bool/str.pm,163626,561,35;5994
Data/Sah/Coerce/perl/date/float_epoch.pm,164236,1162,36;6032
Data/Sah/Coerce/perl/date/obj_DateTime.pm,165448,1094,37;6085
Data/Sah/Coerce/perl/date/obj_TimeMoment.pm,166594,1232,38;6137
Data/Sah/Coerce/perl/date/str_iso8601.pm,167875,1494,39;6189
Data/Sah/Coerce/perl/duration/float_secs.pm,169421,970,40;6244
Data/Sah/Coerce/perl/duration/obj_DateTimeDuration.pm,170453,1137,41;6292
Data/Sah/Coerce/perl/duration/str_human.pm,171641,1719,42;6341
Data/Sah/Coerce/perl/duration/str_iso8601.pm,173413,1447,43;6391
Data/Sah/CoerceCommon.pm,174893,8108,44;6440
Data/Sah/CoerceJS.pm,183030,3115,45;6708
Data/Sah/Compiler.pm,186174,20179,46;6827
Data/Sah/Compiler/Prog.pm,206387,23982,47;7523
Data/Sah/Compiler/Prog/TH.pm,230406,3108,48;8304
Data/Sah/Compiler/Prog/TH/all.pm,233555,534,49;8431
Data/Sah/Compiler/Prog/TH/any.pm,234130,534,50;8463
Data/Sah/Compiler/TH.pm,234696,1247,51;8495
Data/Sah/Compiler/TextResultRole.pm,235987,1190,52;8561
Data/Sah/Compiler/human.pm,237212,12247,53;8623
Data/Sah/Compiler/human/TH.pm,249497,1082,54;9067
Data/Sah/Compiler/human/TH/Comparable.pm,250628,688,55;9133
Data/Sah/Compiler/human/TH/HasElems.pm,251363,1964,56;9165
Data/Sah/Compiler/human/TH/Sortable.pm,253374,1543,57;9237
Data/Sah/Compiler/human/TH/all.pm,254959,1852,58;9304
Data/Sah/Compiler/human/TH/any.pm,256853,1801,59;9384
Data/Sah/Compiler/human/TH/array.pm,258698,2853,60;9463
Data/Sah/Compiler/human/TH/bool.pm,261594,1152,61;9574
Data/Sah/Compiler/human/TH/buf.pm,262788,472,62;9632
Data/Sah/Compiler/human/TH/cistr.pm,263304,266,63;9662
Data/Sah/Compiler/human/TH/code.pm,263613,470,64;9680
Data/Sah/Compiler/human/TH/date.pm,264126,564,65;9709
Data/Sah/Compiler/human/TH/duration.pm,264737,584,66;9739
Data/Sah/Compiler/human/TH/float.pm,265365,2136,67;9769
Data/Sah/Compiler/human/TH/hash.pm,267544,8935,68;9866
Data/Sah/Compiler/human/TH/int.pm,276521,1741,69;10207
Data/Sah/Compiler/human/TH/num.pm,278304,568,70;10286
Data/Sah/Compiler/human/TH/obj.pm,278914,901,71;10316
Data/Sah/Compiler/human/TH/re.pm,279856,516,72;10367
Data/Sah/Compiler/human/TH/str.pm,280414,2306,73;10398
Data/Sah/Compiler/human/TH/undef.pm,282764,528,74;10503
Data/Sah/Compiler/perl.pm,283326,9722,75;10534
Data/Sah/Compiler/perl/TH.pm,293085,1300,76;10935
Data/Sah/Compiler/perl/TH/all.pm,294426,316,77;10983
Data/Sah/Compiler/perl/TH/any.pm,294783,316,78;11005
Data/Sah/Compiler/perl/TH/array.pm,295142,4412,79;11027
Data/Sah/Compiler/perl/TH/bool.pm,299596,2360,80;11161
Data/Sah/Compiler/perl/TH/buf.pm,301997,292,81;11245
Data/Sah/Compiler/perl/TH/cistr.pm,302332,3621,82;11264
Data/Sah/Compiler/perl/TH/code.pm,305995,456,83;11397
Data/Sah/Compiler/perl/TH/date.pm,306493,5699,84;11424
Data/Sah/Compiler/perl/TH/duration.pm,312238,5788,85;11580
Data/Sah/Compiler/perl/TH/float.pm,318069,6295,86;11746
Data/Sah/Compiler/perl/TH/hash.pm,324406,15326,87;11930
Data/Sah/Compiler/perl/TH/int.pm,339773,1065,88;12399
Data/Sah/Compiler/perl/TH/num.pm,340879,2067,89;12450
Data/Sah/Compiler/perl/TH/obj.pm,342987,882,90;12526
Data/Sah/Compiler/perl/TH/re.pm,343909,523,91;12572
Data/Sah/Compiler/perl/TH/str.pm,344473,5218,92;12601
Data/Sah/Compiler/perl/TH/undef.pm,349734,453,93;12772
Data/Sah/Human.pm,350213,667,94;12799
Data/Sah/Lang.pm,350905,261,95;12834
Data/Sah/Lang/fr_FR.pm,351197,1563,96;12855
Data/Sah/Lang/id_ID.pm,352791,8191,97;12961
Data/Sah/Lang/zh_CN.pm,361013,1463,98;13357
Data/Sah/Normalize.pm,362506,6073,99;13464
Data/Sah/Resolve.pm,368607,3458,100;13645
Data/Sah/Type/BaseType.pm,372099,2720,101;13748
Data/Sah/Type/Comparable.pm,374855,735,102;13881
Data/Sah/Type/HasElems.pm,375624,3599,103;13914
Data/Sah/Type/Sortable.pm,379257,1980,104;14058
Data/Sah/Type/all.pm,381266,463,105;14141
Data/Sah/Type/any.pm,381758,463,106;14164
Data/Sah/Type/array.pm,382252,756,107;14187
Data/Sah/Type/bool.pm,383038,437,108;14220
Data/Sah/Type/buf.pm,383504,179,109;14244
Data/Sah/Type/cistr.pm,383714,181,110;14258
Data/Sah/Type/code.pm,383925,185,111;14272
Data/Sah/Type/date.pm,384140,300,112;14286
Data/Sah/Type/duration.pm,384474,304,113;14304
Data/Sah/Type/float.pm,384809,886,114;14322
Data/Sah/Type/hash.pm,385725,4580,115;14369
Data/Sah/Type/int.pm,390334,648,116;14557
Data/Sah/Type/num.pm,391011,256,117;14588
Data/Sah/Type/obj.pm,391296,509,118;14604
Data/Sah/Type/re.pm,391833,224,119;14632
Data/Sah/Type/str.pm,392086,775,120;14647
Data/Sah/Type/undef.pm,392892,167,121;14686
Data/Sah/Util/Func.pm,393089,329,122;14698
Data/Sah/Util/Role.pm,393448,3345,123;14721
Data/Sah/Util/Type.pm,396823,3405,124;14836
Data/Sah/Util/Type/Date.pm,400263,5074,125;14965
Data/Sah/Util/TypeX.pm,405368,337,126;15111
File/ShareDir.pm,405730,6309,127;15136
File/ShareDir/Tarball.pm,412072,1502,128;15441
File/Slurper.pm,413598,2550,129;15519
File/Which.pm,416170,2267,130;15618
File/chdir.pm,418459,3979,131;15733
Function/Fallback/CoreOrPP.pm,422476,1694,132;15921
Getopt/Long/Negate/EN.pm,424203,1797,133;16010
Getopt/Long/Util.pm,426028,7724,134;16062
IO/Pty.pm,433770,3553,135;16347
IO/Tty.pm,437341,2398,136;16494
IPC/Run.pm,439758,58501,137;16602
IPC/Run/Debug.pm,498284,5820,138;18706
IPC/Run/IO.pm,504126,9028,139;18947
IPC/Run/Timer.pm,513179,5982,140;19349
IPC/Run/Win32Helper.pm,519192,8528,141;19652
IPC/Run/Win32IO.pm,527747,10764,142;19942
IPC/Run/Win32Pump.pm,538540,2368,143;20389
IPC/System/Options.pm,540938,7037,144;20487
JSON.pm,547991,71912,145;20735
Lingua/EN/Numbers/Ordinate.pm,619941,724,146;23034
Lingua/EN/PluralToSingular.pm,620703,5931,147;23073
Log/Any.pm,626653,2421,148;23485
Log/Any/Adapter.pm,629101,367,149;23591
Log/Any/Adapter/Base.pm,629500,772,150;23620
Log/Any/Adapter/File.pm,630304,1925,151;23657
Log/Any/Adapter/Null.pm,632261,382,152;23724
Log/Any/Adapter/Stderr.pm,632677,1229,153;23747
Log/Any/Adapter/Stdout.pm,633940,1229,154;23797
Log/Any/Adapter/Test.pm,635201,4762,155;23847
Log/Any/Adapter/Util.pm,639995,3230,156;24044
Log/Any/IfLOG.pm,643250,1381,157;24201
Log/Any/Manager.pm,644658,5072,158;24266
Log/Any/Proxy.pm,649755,2436,159;24455
Log/Any/Proxy/Test.pm,652221,499,160;24541
Log/Any/Test.pm,652744,275,161;24572
Mo.pm,653033,563,162;24588
Mo/Golf.pm,653615,7517,163;24591
Mo/Inline.pm,661153,2045,164;24808
Mo/Moose.pm,663218,467,165;24894
Mo/Mouse.pm,663705,497,166;24897
Mo/build.pm,664222,215,167;24900
Mo/builder.pm,664459,303,168;24903
Mo/chain.pm,664782,183,169;24906
Mo/coerce.pm,664986,296,170;24909
Mo/default.pm,665304,400,171;24912
Mo/exporter.pm,665727,140,172;24915
Mo/import.pm,665888,151,173;24918
Mo/importer.pm,666062,171,174;24921
Mo/is.pm,666250,198,175;24924
Mo/nonlazy.pm,666470,94,176;24927
Mo/option.pm,666585,225,177;24930
Mo/required.pm,666833,304,178;24933
Mo/xs.pm,667154,226,179;24936
Module/Installed/Tiny.pm,667413,3030,180;24939
Nodejs/Util.pm,670466,4944,181;25056
PERLANCAR/Module/List.pm,675443,2921,182;25242
Perinci/Sub/Complete.pm,678396,37239,183;25324
Perinci/Sub/GetArgs/Argv.pm,715671,36868,184;26287
Perinci/Sub/GetArgs/Array.pm,752576,3345,185;27316
Perinci/Sub/Normalize.pm,755954,4885,186;27438
Perinci/Sub/Util.pm,760867,12303,187;27590
Perinci/Sub/Util/ResObj.pm,773205,243,188;28028
Perinci/Sub/Util/Sort.pm,773481,463,189;28043
Proc/ChildError.pm,773971,1012,190;28072
Regexp/Stringify.pm,775011,2471,191;28122
Role/Tiny.pm,777503,11133,192;28221
Role/Tiny/With.pm,788662,297,193;28628
Sah/Schema/rinci/function_meta.pm,789001,3591,194;28650
Sah/Schema/rinci/meta.pm,792625,683,195;28787
Sah/Schema/rinci/result_meta.pm,793348,611,196;28830
Sah/SchemaR/rinci/function_meta.pm,794002,7783,197;28865
Sah/SchemaR/rinci/meta.pm,801819,1990,198;29035
Sah/SchemaR/rinci/result_meta.pm,803850,960,199;29094
Sah/Schemas/Rinci.pm,804839,108,200;29135
Scalar/Util/Numeric/PP.pm,804981,1353,201;29144
String/ShellQuote.pm,806363,1822,202;29214
String/Wildcard/Bash.pm,808217,2159,203;29328
Test/Data/Sah.pm,810401,9810,204;29416
Test/Data/Sah/Human.pm,820242,934,205;29725
Test/Data/Sah/Perl.pm,821206,4123,206;29767
Text/sprintfn.pm,825354,3295,207;29892
Tie/IxHash.pm,828671,6075,208;30017

### Capture/Tiny.pm ###
#use 5.006;
#use strict;
#use warnings;
#package Capture::Tiny;
#our $VERSION = '0.36';
#use Carp ();
#use Exporter ();
#use IO::Handle ();
#use File::Spec ();
#use File::Temp qw/tempfile tmpnam/;
#use Scalar::Util qw/reftype blessed/;
#BEGIN {
#  local $@;
#  eval { require PerlIO; PerlIO->can('get_layers') }
#    or *PerlIO::get_layers = sub { return () };
#}
#
#
#my %api = (
#  capture         => [1,1,0,0],
#  capture_stdout  => [1,0,0,0],
#  capture_stderr  => [0,1,0,0],
#  capture_merged  => [1,1,1,0],
#  tee             => [1,1,0,1],
#  tee_stdout      => [1,0,0,1],
#  tee_stderr      => [0,1,0,1],
#  tee_merged      => [1,1,1,1],
#);
#
#for my $sub ( keys %api ) {
#  my $args = join q{, }, @{$api{$sub}};
#  eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; 
#}
#
#our @ISA = qw/Exporter/;
#our @EXPORT_OK = keys %api;
#our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
#
#
#my $IS_WIN32 = $^O eq 'MSWin32';
#
#
#our $TIMEOUT = 30;
#
#my @cmd = ($^X, '-C0', '-e', <<'HERE');
#use Fcntl;
#$SIG{HUP}=sub{exit};
#if ( my $fn=shift ) {
#    sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!;
#    print {$fh} $$;
#    close $fh;
#}
#my $buf; while (sysread(STDIN, $buf, 2048)) {
#    syswrite(STDOUT, $buf); syswrite(STDERR, $buf);
#}
#HERE
#
#
#sub _relayer {
#  my ($fh, $layers) = @_;
#
#  binmode( $fh, ":raw" );
#  while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
#      binmode( $fh, ":pop" );
#  }
#  my @to_apply = @$layers;
#  shift @to_apply; 
#  binmode($fh, ":" . join(":",@to_apply));
#}
#
#sub _name {
#  my $glob = shift;
#  no strict 'refs'; 
#  return *{$glob}{NAME};
#}
#
#sub _open {
#  open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
#}
#
#sub _close {
#  close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
#}
#
#my %dup; 
#my %proxy_count;
#sub _proxy_std {
#  my %proxies;
#  if ( ! defined fileno STDIN ) {
#    $proxy_count{stdin}++;
#    if (defined $dup{stdin}) {
#      _open \*STDIN, "<&=" . fileno($dup{stdin});
#    }
#    else {
#      _open \*STDIN, "<" . File::Spec->devnull;
#      _open $dup{stdin} = IO::Handle->new, "<&=STDIN";
#    }
#    $proxies{stdin} = \*STDIN;
#    binmode(STDIN, ':utf8') if $] >= 5.008; 
#  }
#  if ( ! defined fileno STDOUT ) {
#    $proxy_count{stdout}++;
#    if (defined $dup{stdout}) {
#      _open \*STDOUT, ">&=" . fileno($dup{stdout});
#    }
#    else {
#      _open \*STDOUT, ">" . File::Spec->devnull;
#      _open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
#    }
#    $proxies{stdout} = \*STDOUT;
#    binmode(STDOUT, ':utf8') if $] >= 5.008; 
#  }
#  if ( ! defined fileno STDERR ) {
#    $proxy_count{stderr}++;
#    if (defined $dup{stderr}) {
#      _open \*STDERR, ">&=" . fileno($dup{stderr});
#    }
#    else {
#      _open \*STDERR, ">" . File::Spec->devnull;
#      _open $dup{stderr} = IO::Handle->new, ">&=STDERR";
#    }
#    $proxies{stderr} = \*STDERR;
#    binmode(STDERR, ':utf8') if $] >= 5.008; 
#  }
#  return %proxies;
#}
#
#sub _unproxy {
#  my (%proxies) = @_;
#  for my $p ( keys %proxies ) {
#    $proxy_count{$p}--;
#    if ( ! $proxy_count{$p} ) {
#      _close $proxies{$p};
#      _close $dup{$p} unless $] < 5.008; 
#      delete $dup{$p};
#    }
#  }
#}
#
#sub _copy_std {
#  my %handles;
#  for my $h ( qw/stdout stderr stdin/ ) {
#    next if $h eq 'stdin' && ! $IS_WIN32; 
#    my $redir = $h eq 'stdin' ? "<&" : ">&";
#    _open $handles{$h} = IO::Handle->new(), $redir . uc($h); 
#  }
#  return \%handles;
#}
#
#sub _open_std {
#  my ($handles) = @_;
#  _open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin};
#  _open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout};
#  _open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr};
#}
#
#
#sub _start_tee {
#  my ($which, $stash) = @_; 
#  $stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
#  pipe $stash->{reader}{$which}, $stash->{tee}{$which};
#  select((select($stash->{tee}{$which}), $|=1)[0]); 
#  $stash->{new}{$which} = $stash->{tee}{$which};
#  $stash->{child}{$which} = {
#    stdin   => $stash->{reader}{$which},
#    stdout  => $stash->{old}{$which},
#    stderr  => $stash->{capture}{$which},
#  };
#  $stash->{flag_files}{$which} = scalar tmpnam();
#  if ( $IS_WIN32 ) {
#    my $old_eval_err=$@;
#    undef $@;
#
#    eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
#    my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
#    my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
#    _open_std( $stash->{child}{$which} );
#    $stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
#    $@=$old_eval_err;
#  }
#  else { 
#    _fork_exec( $which, $stash );
#  }
#}
#
#sub _fork_exec {
#  my ($which, $stash) = @_; 
#  my $pid = fork;
#  if ( not defined $pid ) {
#    Carp::confess "Couldn't fork(): $!";
#  }
#  elsif ($pid == 0) { 
#    untie *STDIN; untie *STDOUT; untie *STDERR;
#    _close $stash->{tee}{$which};
#    _open_std( $stash->{child}{$which} );
#    exec @cmd, $stash->{flag_files}{$which};
#  }
#  $stash->{pid}{$which} = $pid
#}
#
#my $have_usleep = eval "use Time::HiRes 'usleep'; 1";
#sub _files_exist {
#  return 1 if @_ == grep { -f } @_;
#  Time::HiRes::usleep(1000) if $have_usleep;
#  return 0;
#}
#
#sub _wait_for_tees {
#  my ($stash) = @_;
#  my $start = time;
#  my @files = values %{$stash->{flag_files}};
#  my $timeout = defined $ENV{PERL_CAPTURE_TINY_TIMEOUT}
#              ? $ENV{PERL_CAPTURE_TINY_TIMEOUT} : $TIMEOUT;
#  1 until _files_exist(@files) || ($timeout && (time - $start > $timeout));
#  Carp::confess "Timed out waiting for subprocesses to start" if ! _files_exist(@files);
#  unlink $_ for @files;
#}
#
#sub _kill_tees {
#  my ($stash) = @_;
#  if ( $IS_WIN32 ) {
#    close($_) for values %{ $stash->{tee} };
#    my $start = time;
#    1 until wait == -1 || (time - $start > 30);
#  }
#  else {
#    _close $_ for values %{ $stash->{tee} };
#    waitpid $_, 0 for values %{ $stash->{pid} };
#  }
#}
#
#sub _slurp {
#  my ($name, $stash) = @_;
#  my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
#  seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
#  my $text = do { local $/; scalar readline $fh };
#  return defined($text) ? $text : "";
#}
#
#
#sub _capture_tee {
#  my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
#  my %do = ($do_stdout ? (stdout => 1) : (),  $do_stderr ? (stderr => 1) : ());
#  Carp::confess("Custom capture options must be given as key/value pairs\n")
#    unless @opts % 2 == 0;
#  my $stash = { capture => { @opts } };
#  for ( keys %{$stash->{capture}} ) {
#    my $fh = $stash->{capture}{$_};
#    Carp::confess "Custom handle for $_ must be seekable\n"
#      unless ref($fh) eq 'GLOB' || (blessed($fh) && $fh->isa("IO::Seekable"));
#  }
#  local *CT_ORIG_STDIN  = *STDIN ;
#  local *CT_ORIG_STDOUT = *STDOUT;
#  local *CT_ORIG_STDERR = *STDERR;
#  my %layers = (
#    stdin   => [PerlIO::get_layers(\*STDIN) ],
#    stdout  => [PerlIO::get_layers(\*STDOUT, output => 1)],
#    stderr  => [PerlIO::get_layers(\*STDERR, output => 1)],
#  );
#  $layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
#    if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
#  $layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
#    if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
#  my %localize;
#  $localize{stdin}++,  local(*STDIN)
#    if grep { $_ eq 'scalar' } @{$layers{stdin}};
#  $localize{stdout}++, local(*STDOUT)
#    if $do_stdout && grep { $_ eq 'scalar' } @{$layers{stdout}};
#  $localize{stderr}++, local(*STDERR)
#    if ($do_stderr || $do_merge) && grep { $_ eq 'scalar' } @{$layers{stderr}};
#  $localize{stdin}++, local(*STDIN), _open( \*STDIN, "<&=0")
#    if tied *STDIN && $] >= 5.008;
#  $localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
#    if $do_stdout && tied *STDOUT && $] >= 5.008;
#  $localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
#    if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
#  my %proxy_std = _proxy_std();
#  $layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
#  $layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
#  $stash->{old} = _copy_std();
#  $stash->{new} = { %{$stash->{old}} }; 
#  for ( keys %do ) {
#    $stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
#    seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
#    $stash->{pos}{$_} = tell $stash->{capture}{$_};
#    _start_tee( $_ => $stash ) if $do_tee; 
#  }
#  _wait_for_tees( $stash ) if $do_tee;
#  $stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
#  _open_std( $stash->{new} );
#  my ($exit_code, $inner_error, $outer_error, $orig_pid, @result);
#  {
#    $orig_pid = $$;
#    local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; 
#    _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
#    _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
#    my $old_eval_err=$@;
#    undef $@;
#    eval { @result = $code->(); $inner_error = $@ };
#    $exit_code = $?; 
#    $outer_error = $@; 
#    STDOUT->flush if $do_stdout;
#    STDERR->flush if $do_stderr;
#    $@ = $old_eval_err;
#  }
#  _open_std( $stash->{old} );
#  _close( $_ ) for values %{$stash->{old}}; 
#  _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
#  _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
#  _unproxy( %proxy_std );
#  _kill_tees( $stash ) if $do_tee;
#  my %got;
#  if ( $orig_pid == $$ and ( defined wantarray or ($do_tee && keys %localize) ) ) {
#    for ( keys %do ) {
#      _relayer($stash->{capture}{$_}, $layers{$_});
#      $got{$_} = _slurp($_, $stash);
#    }
#    print CT_ORIG_STDOUT $got{stdout}
#      if $do_stdout && $do_tee && $localize{stdout};
#    print CT_ORIG_STDERR $got{stderr}
#      if $do_stderr && $do_tee && $localize{stderr};
#  }
#  $? = $exit_code;
#  $@ = $inner_error if $inner_error;
#  die $outer_error if $outer_error;
#  return unless defined wantarray;
#  my @return;
#  push @return, $got{stdout} if $do_stdout;
#  push @return, $got{stderr} if $do_stderr && ! $do_merge;
#  push @return, @result;
#  return wantarray ? @return : $return[0];
#}
#
#1;
#
#__END__
#
### Class/Inspector.pm ###
#package Class::Inspector;
#
#
#use 5.006;
#use strict qw{vars subs};
#use warnings;
#use File::Spec ();
#
#use vars qw{$VERSION $RE_IDENTIFIER $RE_CLASS $UNIX};
#BEGIN {
#	$VERSION = '1.28';
#
#	SCOPE: {
#		local $@;
#		eval "require utf8; utf8->import";
#	}
#
#	$RE_IDENTIFIER = qr/\A[^\W\d]\w*\z/s;
#	$RE_CLASS      = qr/\A[^\W\d]\w*(?:(?:\'|::)\w+)*\z/s;
#
#	$UNIX  = !! ( $File::Spec::ISA[0] eq 'File::Spec::Unix'  );
#}
#
#
#
#
#
#
#
#sub installed {
#	my $class = shift;
#	!! ($class->loaded_filename($_[0]) or $class->resolved_filename($_[0]));
#}
#
#
#sub loaded {
#	my $class = shift;
#	my $name  = $class->_class(shift) or return undef;
#	$class->_loaded($name);
#}
#
#sub _loaded {
#	my $class = shift;
#	my $name  = shift;
#
#	return 1 if defined ${"${name}::VERSION"};
#	return 1 if @{"${name}::ISA"};
#
#	foreach ( keys %{"${name}::"} ) {
#		next if substr($_, -2, 2) eq '::';
#		return 1 if defined &{"${name}::$_"};
#	}
#
#	my $filename = $class->_inc_filename($name);
#	return 1 if defined $INC{$filename};
#
#	'';
#}
#
#
#sub filename {
#	my $class = shift;
#	my $name  = $class->_class(shift) or return undef;
#	File::Spec->catfile( split /(?:\'|::)/, $name ) . '.pm';
#}
#
#
#sub resolved_filename {
#	my $class     = shift;
#	my $filename  = $class->_inc_filename(shift) or return undef;
#	my @try_first = @_;
#
#	foreach ( @try_first, @INC ) {
#		my $full = "$_/$filename";
#		next unless -e $full;
#		return $UNIX ? $full : $class->_inc_to_local($full);
#	}
#
#	'';
#}
#
#
#sub loaded_filename {
#	my $class    = shift;
#	my $filename = $class->_inc_filename(shift);
#	$UNIX ? $INC{$filename} : $class->_inc_to_local($INC{$filename});
#}
#
#
#
#
#
#
#
#sub functions {
#	my $class = shift;
#	my $name  = $class->_class(shift) or return undef;
#	return undef unless $class->loaded( $name );
#
#	my @functions = sort grep { /$RE_IDENTIFIER/o }
#		grep { defined &{"${name}::$_"} }
#		keys %{"${name}::"};
#	\@functions;
#}
#
#
#sub function_refs {
#	my $class = shift;
#	my $name  = $class->_class(shift) or return undef;
#	return undef unless $class->loaded( $name );
#
#	my @functions = map { \&{"${name}::$_"} }
#		sort grep { /$RE_IDENTIFIER/o }
#		grep { defined &{"${name}::$_"} }
#		keys %{"${name}::"};
#	\@functions;
#}
#
#
#sub function_exists {
#	my $class    = shift;
#	my $name     = $class->_class( shift ) or return undef;
#	my $function = shift or return undef;
#
#	return undef unless $class->loaded( $name );
#
#	defined &{"${name}::$function"};
#}
#
#
#sub methods {
#	my $class     = shift;
#	my $name      = $class->_class( shift ) or return undef;
#	my @arguments = map { lc $_ } @_;
#
#	my %options = ();
#	foreach ( @arguments ) {
#		if ( $_ eq 'public' ) {
#			return undef if $options{private};
#			$options{public} = 1;
#
#		} elsif ( $_ eq 'private' ) {
#			return undef if $options{public};
#			$options{private} = 1;
#
#		} elsif ( $_ eq 'full' ) {
#			return undef if $options{expanded};
#			$options{full} = 1;
#
#		} elsif ( $_ eq 'expanded' ) {
#			return undef if $options{full};
#			$options{expanded} = 1;
#
#		} else {
#			return undef;
#		}
#	}
#
#	return undef unless $class->loaded( $name );
#
#	my @path  = ();
#	my @queue = ( $name );
#	my %seen  = ( $name => 1 );
#	while ( my $cl = shift @queue ) {
#		push @path, $cl;
#		unshift @queue, grep { ! $seen{$_}++ }
#			map { s/^::/main::/; s/\'/::/g; $_ }
#			( @{"${cl}::ISA"} );
#	}
#
#	my %methods = ();
#	foreach my $namespace ( @path ) {
#		my @functions = grep { ! $methods{$_} }
#			grep { /$RE_IDENTIFIER/o }
#			grep { defined &{"${namespace}::$_"} } 
#			keys %{"${namespace}::"};
#		foreach ( @functions ) {
#			$methods{$_} = $namespace;
#		}
#	}
#
#	my @methodlist = sort keys %methods;
#	@methodlist = grep { ! /^\_/ } @methodlist if $options{public};
#	@methodlist = grep {   /^\_/ } @methodlist if $options{private};
#
#	@methodlist = map { "$methods{$_}::$_" } @methodlist if $options{full};
#	@methodlist = map { 
#		[ "$methods{$_}::$_", $methods{$_}, $_, \&{"$methods{$_}::$_"} ] 
#		} @methodlist if $options{expanded};
#
#	\@methodlist;
#}
#
#
#
#
#
#
#
#sub subclasses {
#	my $class = shift;
#	my $name  = $class->_class( shift ) or return undef;
#
#	my @found = ();
#	my @queue = grep { $_ ne 'main' } $class->_subnames('');
#	while ( @queue ) {
#		my $c = shift(@queue); 
#		if ( $class->_loaded($c) ) {
#			local $@;
#			eval {
#				if ( $c->isa($name) ) {
#					push @found, $c unless $c eq $name;
#				}
#			};
#		}
#
#		unshift @queue, map { "${c}::$_" } $class->_subnames($c);
#	}
#
#	@found ? \@found : '';
#}
#
#sub _subnames {
#	my ($class, $name) = @_;
#	return sort
#		grep {
#			substr($_, -2, 2, '') eq '::'
#			and
#			/$RE_IDENTIFIER/o
#		}
#		keys %{"${name}::"};
#}
#
#
#
#
#
#
#
#sub children {
#	my $class = shift;
#	my $name  = $class->_class(shift) or return ();
#
#	no strict 'refs';
#	map { "${name}::$_" } sort grep { s/::$// } keys %{"${name}::"};
#}
#
#sub recursive_children {
#	my $class    = shift;
#	my $name     = $class->_class(shift) or return ();
#	my @children = ( $name );
#
#	my $i = 0;
#	no strict 'refs';
#	while ( my $namespace = $children[$i++] ) {
#		push @children, map { "${namespace}::$_" }
#			grep { ! /^::/ } 
#			grep { s/::$// }
#			keys %{"${namespace}::"};
#	}
#
#	sort @children;
#}
#
#
#
#
#
#
#sub _class {
#	my $class = shift;
#	my $name  = shift or return '';
#
#	return 'main' if $name eq '::';
#	$name =~ s/\A::/main::/;
#
#	$name =~ /$RE_CLASS/o ? $name : '';
#}
#
#sub _inc_filename {
#	my $class = shift;
#	my $name  = $class->_class(shift) or return undef;
#	join( '/', split /(?:\'|::)/, $name ) . '.pm';
#}
#
#sub _inc_to_local {
#	return $_[1] if $UNIX;
#
#	my $class              = shift;
#	my $inc_name           = shift or return undef;
#	my ($vol, $dir, $file) = File::Spec->splitpath( $inc_name );
#	$dir = File::Spec->catdir( File::Spec->splitdir( $dir || "" ) );
#	File::Spec->catpath( $vol, $dir, $file || "" );
#}
#
#1;
#
### Class/Inspector/Functions.pm ###
#package Class::Inspector::Functions;
#
#use 5.006;
#use strict;
#use warnings;
#use Exporter         ();
#use Class::Inspector ();
#
#use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
#BEGIN {
#	$VERSION = '1.28';
#	@ISA     = 'Exporter';
#
#
#	@EXPORT = qw(
#		installed
#		loaded
#
#		filename
#		functions
#		methods
#
#		subclasses
#	);
#
#	@EXPORT_OK = qw(
#		resolved_filename
#		loaded_filename
#
#		function_refs
#		function_exists
#	);
#
#	%EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );
#
#	foreach my $meth (@EXPORT, @EXPORT_OK) {
#	    my $sub = Class::Inspector->can($meth);
#	    no strict 'refs';
#	    *{$meth} = sub {&$sub('Class::Inspector', @_)};
#	}
#
#}
#
#1;
#
#__END__
#
### 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-09-27'; 
#our $VERSION = '0.28'; 
#
#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 contain 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 = '2015-11-29'; 
#our $VERSION = '0.38'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_env
#               );
#
#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],
#        );
#    }
#}
#1;
#
#__END__
#
### Complete/File.pm ###
#package Complete::File;
#
#our $DATE = '2016-05-09'; 
#our $VERSION = '0.40'; 
#
#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_rels => {
#        choose_one => [qw/filter file_regex_filter/],
#    },
#    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*']}],
#        },
#        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*',
#        },
#        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 $filter = $args{filter};
#
#    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;
#    };
#
#    if ($filter && !ref($filter)) {
#        my @seqs = split /\s*\|\s*/, $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 (!$filter && $args{file_regex_filter}) {
#        $filter = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            return 1 if $name =~ $args{file_regex_filter};
#            0;
#        };
#    }
#
#    if ($args{_dir}) {
#        my $orig_filter = $filter;
#        $filter = sub {
#            my $name = shift;
#            return 0 if $orig_filter && !$orig_filter->($name);
#            return 0 unless (-d $name);
#            1;
#        };
#    }
#
#    Complete::Path::complete_path(
#        word => $word,
#        list_func => $list,
#        is_dir_func => sub { -d $_[0] },
#        filter_func => $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)';
#    delete $spec->{args}{file_regex_filter};
#
#    $spec;
#};
#sub complete_dir {
#    my %args = @_;
#
#    complete_file(%args, _dir=>1);
#}
#
#1;
#
#__END__
#
### Complete/Getopt/Long.pm ###
#package Complete::Getopt::Long;
#
#our $DATE = '2016-09-27'; 
#our $VERSION = '0.42'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#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;
#    $log->tracef('[comp][compgl] entering default completion routine');
#
#    if ($word =~ /\A\$/) {
#        $log->tracef('[comp][compgl] completing shell variable');
#        {
#            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!) {
#        $log->tracef("[comp][compgl] completing userdir, user=%s", $1);
#        {
#            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(~[^/]*)/!) {
#        $log->tracef("[comp][compgl] completing file, path=<%s>", $word);
#        $fres = {words=>Complete::File::complete_file(word=>$word),
#                 path_sep=>'/'};
#        goto RETURN_RES;
#    }
#
#    require String::Wildcard::Bash;
#    if (String::Wildcard::Bash::contains_wildcard($word)) {
#        $log->tracef("[comp][compgl] completing with wildcard glob, glob=<%s>", "$word*");
#        {
#            my $compres = [glob("$word*")];
#            last unless @$compres;
#            for (@$compres) {
#                $_ .= "/" if (-d $_);
#            }
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#    }
#    $log->tracef("[comp][compgl] completing with file, file=<%s>", $word);
#    $fres = {words=>Complete::File::complete_file(word=>$word),
#             path_sep=>'/'};
#  RETURN_RES:
#    $log->tracef("[comp][compgl] leaving default completion routine, result=%s", $fres);
#    $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;
#
#    $log->tracef('[comp][compgl] entering %s(), words=%s, cword=%d, word=<%s>',
#                 $fname, \@words, $cword, $words[$cword]);
#
#    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-/) {
#
#          SPLIT_BUNDLED:
#            {
#                last unless $bundling;
#                my $shorts = $word;
#                if ($shorts =~ s/\A-([^-])(.*)/$2/) {
#                    my $opt = "-$1";
#                    my $opthash = $opts{$opt};
#                    if (!$opthash || $opthash->{parsed}{max_vals}) {
#                        last SPLIT_BUNDLED;
#                    }
#                    $words[$i] = $word = "-$1";
#                    $expects[$i]{prefix} = $word;
#                    $expects[$i]{word} = '';
#                    $expects[$i]{short_only} = 1;
#                    my $len_before_split = @words;
#                    my $j = $i+1;
#                  SHORTOPT:
#                    while ($shorts =~ s/(.)//) {
#                        $opt = "-$1";
#                        $opthash = $opts{$opt};
#                        if (!$opthash || $opthash->{parsed}{max_vals}) {
#                            $expects[$i]{do_complete_optname} = 0;
#                            if (length $shorts) {
#                                splice @words, $j, 0, $opt, '=', $shorts;
#                                $j += 3;
#                            } else {
#                                splice @words, $j, 0, $opt;
#                                $j++;
#                            }
#                            last SHORTOPT;
#                        } else {
#                            splice @words, $j, 0, $opt;
#                            $j++;
#                        }
#                    }
#                    $cword += @words-$len_before_split if $cword > $i;
#                }
#            }
#
#          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 }
#                }
#
#                push @{ $parsed_opts{$opt} }, $words[$i+1];
#                for (1 .. $min_vals) {
#                    $i++;
#                    last WORD if $i >= @words;
#                    $expects[$i]{optval} = $opt;
#                    $expects[$i]{nth} = $nth;
#                }
#                for (1 .. $max_vals-$min_vals) {
#                    last if $i+$_ >= @words;
#                    last if $words[$i+$_] =~ /\A-/; 
#                    $expects[$i+$_]{optval} = $opt; 
#                    $expects[$i]{nth} = $nth;
#                }
#            } 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};
#        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);
#        $log->tracef('[comp][compgl] adding result from option names, '.
#                         'matching options=%s', $compres);
#        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) {
#            $log->tracef("[comp][compgl] invoking routine supplied from 'completion' argument to complete option value, option=<%s>", $opt);
#            $compres = $comp->(%compargs);
#            $log->tracef('[comp][compgl] adding result from routine: %s', $compres);
#        }
#        if (!$compres || !$comp) {
#            $compres = _default_completion(%compargs);
#            $log->tracef('[comp][compgl] adding result from default '.
#                             'completion routine');
#        }
#        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,
#        );
#        $log->tracef('[comp][compgl] invoking \'completion\' routine '.
#                         'to complete argument');
#        my $compres = $comp->(%compargs) if $comp;
#        if (!defined $compres) {
#            $compres = _default_completion(%compargs);
#            $log->tracef('[comp][compgl] adding result from default '.
#                             'completion routine: %s', $compres);
#        }
#        push @answers, $compres;
#    }
#
#    $log->tracef("[comp][compgl] combining result from %d source(s)", ~~@answers);
#    $fres = Complete::Util::combine_answers(@answers) // [];
#
#  RETURN_RES:
#    $log->tracef("[comp][compgl] leaving %s(), result=%s", $fname, $fres);
#    $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-09-27'; 
#our $VERSION = '0.49'; 
#
#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
#                       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',
#};
#
#$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;
#
#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,
#    },
#    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;
#
#    return [] unless @$array0;
#
#    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 {
#            if (($ENV{COMPLETE_UTIL_LEVENSHTEIN} // '') eq 'xs') {
#                require Text::Levenshtein::XS;
#                \&Text::Levenshtein::XS::distance;
#            } elsif (($ENV{COMPLETE_UTIL_LEVENSHTEIN} // '') eq 'pp') {
#                \&__editdist;
#            } elsif (eval { require Text::Levenshtein::XS; 1 }) {
#                \&Text::Levenshtein::XS::distance;
#            } else {
#                \&__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 $d;
#                unless (defined $editdists{$chopped}) {
#                    $d = $code_editdist->($wordn, $chopped);
#                    $editdists{$chopped} = $d;
#                } else {
#                    $d = $editdists{$chopped};
#                }
#                my $maxd = __min(
#                    __min(length($chopped), length($word))/$factor,
#                    $fuzzy,
#                );
#                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;
#            }
#        }
#    }
#
#    return $ci ? [sort {lc($a) cmp lc($b)} @words] : [sort @words];
#}
#
#$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 contains unique elements',
#        schema => ['str*', is=>1],
#    },
#);
#$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 $ci = $Complete::Common::OPT_CI;
#
#    my @mentioned_elems = split /\Q$sep\E/, $word, -1;
#    my $cae_word = @mentioned_elems ? pop(@mentioned_elems) : '';
#
#    my @unmentioned_elems;
#    {
#        last unless $uniq;
#        my %mem;
#        for (@mentioned_elems) {
#            if ($ci) { $mem{lc $_}++ } else { $mem{$_}++ }
#        }
#        for (@$elems) {
#            push @unmentioned_elems, $_ unless ($ci ? $mem{lc $_} : $mem{$_});
#        }
#    }
#
#    my $cae_res = complete_array_elem(
#        %args,
#        word  => $cae_word,
#        array => ($uniq ? \@unmentioned_elems : $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 $uniq && @unmentioned_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};
#}
#
#1;
#
#__END__
#
### Data/Dmp.pm ###
#package Data::Dmp;
#
#our $DATE = '2016-06-03'; 
#our $VERSION = '0.20'; 
#
#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;
#
#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 _dump {
#    my ($val, $subscript) = @_;
#
#    my $ref = ref($val);
#    if ($ref eq '') {
#        if (!defined($val)) {
#            return "undef";
#        } elsif (looks_like_number($val) &&
#                     $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 =
#                /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ ||
#                /\A-?[1-9][0-9]{0,8}\z/ ? $_ : _double_quote($_);
#            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 = _dump_code($val);
#    } 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/Dump.pm ###
#package Data::Dump;
#
#use strict;
#use vars qw(@EXPORT @EXPORT_OK $VERSION $DEBUG);
#use subs qq(dump);
#
#require Exporter;
#*import = \&Exporter::import;
#@EXPORT = qw(dd ddx);
#@EXPORT_OK = qw(dump pp dumpf quote);
#
#$VERSION = "1.23";
#$DEBUG = 0;
#
#use overload ();
#use vars qw(%seen %refcnt @dump @fixup %require $TRY_BASE64 @FILTERS $INDENT);
#
#$TRY_BASE64 = 50 unless defined $TRY_BASE64;
#$INDENT = "  " unless defined $INDENT;
#
#sub dump
#{
#    local %seen;
#    local %refcnt;
#    local %require;
#    local @fixup;
#
#    require Data::Dump::FilterContext if @FILTERS;
#
#    my $name = "a";
#    my @dump;
#
#    for my $v (@_) {
#	my $val = _dump($v, $name, [], tied($v));
#	push(@dump, [$name, $val]);
#    } continue {
#	$name++;
#    }
#
#    my $out = "";
#    if (%require) {
#	for (sort keys %require) {
#	    $out .= "require $_;\n";
#	}
#    }
#    if (%refcnt) {
#	for (@dump) {
#	    my $name = $_->[0];
#	    if ($refcnt{$name}) {
#		$out .= "my \$$name = $_->[1];\n";
#		undef $_->[1];
#	    }
#	}
#	for (@fixup) {
#	    $out .= "$_;\n";
#	}
#    }
#
#    my $paren = (@dump != 1);
#    $out .= "(" if $paren;
#    $out .= format_list($paren, undef,
#			map {defined($_->[1]) ? $_->[1] : "\$".$_->[0]}
#			    @dump
#		       );
#    $out .= ")" if $paren;
#
#    if (%refcnt || %require) {
#	$out .= ";\n";
#	$out =~ s/^/$INDENT/gm;
#	$out = "do {\n$out}";
#    }
#
#    print STDERR "$out\n" unless defined wantarray;
#    $out;
#}
#
#*pp = \&dump;
#
#sub dd {
#    print dump(@_), "\n";
#}
#
#sub ddx {
#    my(undef, $file, $line) = caller;
#    $file =~ s,.*[\\/],,;
#    my $out = "$file:$line: " . dump(@_) . "\n";
#    $out =~ s/^/# /gm;
#    print $out;
#}
#
#sub dumpf {
#    require Data::Dump::Filtered;
#    goto &Data::Dump::Filtered::dump_filtered;
#}
#
#sub _dump
#{
#    my $ref  = ref $_[0];
#    my $rval = $ref ? $_[0] : \$_[0];
#    shift;
#
#    my($name, $idx, $dont_remember, $pclass, $pidx) = @_;
#
#    my($class, $type, $id);
#    my $strval = overload::StrVal($rval);
#    if ((my $i = rindex($strval, "=")) >= 0) {
#	$class = substr($strval, 0, $i);
#	$strval = substr($strval, $i+1);
#    }
#    if ((my $i = index($strval, "(0x")) >= 0) {
#	$type = substr($strval, 0, $i);
#	$id = substr($strval, $i + 2, -1);
#    }
#    else {
#	die "Can't parse " . overload::StrVal($rval);
#    }
#    if ($] < 5.008 && $type eq "SCALAR") {
#	$type = "REF" if $ref eq "REF";
#    }
#    warn "\$$name(@$idx) $class $type $id ($ref)" if $DEBUG;
#
#    my $out;
#    my $comment;
#    my $hide_keys;
#    if (@FILTERS) {
#	my $pself = "";
#	$pself = fullname("self", [@$idx[$pidx..(@$idx - 1)]]) if $pclass;
#	my $ctx = Data::Dump::FilterContext->new($rval, $class, $type, $ref, $pclass, $pidx, $idx);
#	my @bless;
#	for my $filter (@FILTERS) {
#	    if (my $f = $filter->($ctx, $rval)) {
#		if (my $v = $f->{object}) {
#		    local @FILTERS;
#		    $out = _dump($v, $name, $idx, 1);
#		    $dont_remember++;
#		}
#		if (defined(my $c = $f->{bless})) {
#		    push(@bless, $c);
#		}
#		if (my $c = $f->{comment}) {
#		    $comment = $c;
#		}
#		if (defined(my $c = $f->{dump})) {
#		    $out = $c;
#		    $dont_remember++;
#		}
#		if (my $h = $f->{hide_keys}) {
#		    if (ref($h) eq "ARRAY") {
#			$hide_keys = sub {
#			    for my $k (@$h) {
#				return 1 if $k eq $_[0];
#			    }
#			    return 0;
#			};
#		    }
#		}
#	    }
#	}
#	push(@bless, "") if defined($out) && !@bless;
#	if (@bless) {
#	    $class = shift(@bless);
#	    warn "More than one filter callback tried to bless object" if @bless;
#	}
#    }
#
#    unless ($dont_remember) {
#	if (my $s = $seen{$id}) {
#	    my($sname, $sidx) = @$s;
#	    $refcnt{$sname}++;
#	    my $sref = fullname($sname, $sidx,
#				($ref && $type eq "SCALAR"));
#	    warn "SEEN: [\$$name(@$idx)] => [\$$sname(@$sidx)] ($ref,$sref)" if $DEBUG;
#	    return $sref unless $sname eq $name;
#	    $refcnt{$name}++;
#	    push(@fixup, fullname($name,$idx)." = $sref");
#	    return "do{my \$fix}" if @$idx && $idx->[-1] eq '$';
#	    return "'fix'";
#	}
#	$seen{$id} = [$name, $idx];
#    }
#
#    if ($class) {
#	$pclass = $class;
#	$pidx = @$idx;
#    }
#
#    if (defined $out) {
#    }
#    elsif ($type eq "SCALAR" || $type eq "REF" || $type eq "REGEXP") {
#	if ($ref) {
#	    if ($class && $class eq "Regexp") {
#		my $v = "$rval";
#
#		my $mod = "";
#		if ($v =~ /^\(\?\^?([msix-]*):([\x00-\xFF]*)\)\z/) {
#		    $mod = $1;
#		    $v = $2;
#		    $mod =~ s/-.*//;
#		}
#
#		my $sep = '/';
#		my $sep_count = ($v =~ tr/\///);
#		if ($sep_count) {
#		    for ('|', ',', ':', '#') {
#			my $c = eval "\$v =~ tr/\Q$_\E//";
#			if ($c < $sep_count) {
#			    $sep = $_;
#			    $sep_count = $c;
#			    last if $sep_count == 0;
#			}
#		    }
#		}
#		$v =~ s/\Q$sep\E/\\$sep/g;
#
#		$out = "qr$sep$v$sep$mod";
#		undef($class);
#	    }
#	    else {
#		delete $seen{$id} if $type eq "SCALAR";  
#		my $val = _dump($$rval, $name, [@$idx, "\$"], 0, $pclass, $pidx);
#		$out = $class ? "do{\\(my \$o = $val)}" : "\\$val";
#	    }
#	} else {
#	    if (!defined $$rval) {
#		$out = "undef";
#	    }
#	    elsif (do {no warnings 'numeric'; $$rval + 0 eq $$rval}) {
#		$out = $$rval;
#	    }
#	    else {
#		$out = str($$rval);
#	    }
#	    if ($class && !@$idx) {
#		$refcnt{$name}++;
#		my $obj = fullname($name, $idx);
#		my $cl  = quote($class);
#		push(@fixup, "bless \\$obj, $cl");
#	    }
#	}
#    }
#    elsif ($type eq "GLOB") {
#	if ($ref) {
#	    delete $seen{$id};
#	    my $val = _dump($$rval, $name, [@$idx, "*"], 0, $pclass, $pidx);
#	    $out = "\\$val";
#	    if ($out =~ /^\\\*Symbol::/) {
#		$require{Symbol}++;
#		$out = "Symbol::gensym()";
#	    }
#	} else {
#	    my $val = "$$rval";
#	    $out = "$$rval";
#
#	    for my $k (qw(SCALAR ARRAY HASH)) {
#		my $gval = *$$rval{$k};
#		next unless defined $gval;
#		next if $k eq "SCALAR" && ! defined $$gval;  
#		my $f = scalar @fixup;
#		push(@fixup, "RESERVED");  
#		$gval = _dump($gval, $name, [@$idx, "*{$k}"], 0, $pclass, $pidx);
#		$refcnt{$name}++;
#		my $gname = fullname($name, $idx);
#		$fixup[$f] = "$gname = $gval";  
#	    }
#	}
#    }
#    elsif ($type eq "ARRAY") {
#	my @vals;
#	my $tied = tied_str(tied(@$rval));
#	my $i = 0;
#	for my $v (@$rval) {
#	    push(@vals, _dump($v, $name, [@$idx, "[$i]"], $tied, $pclass, $pidx));
#	    $i++;
#	}
#	$out = "[" . format_list(1, $tied, @vals) . "]";
#    }
#    elsif ($type eq "HASH") {
#	my(@keys, @vals);
#	my $tied = tied_str(tied(%$rval));
#
#	my $kstat_max = 0;
#	my $kstat_sum = 0;
#	my $kstat_sum2 = 0;
#
#	my @orig_keys = keys %$rval;
#	if ($hide_keys) {
#	    @orig_keys = grep !$hide_keys->($_), @orig_keys;
#	}
#	my $text_keys = 0;
#	for (@orig_keys) {
#	    $text_keys++, last unless /^[-+]?(?:0|[1-9]\d*)(?:\.\d+)?\z/;
#	}
#
#	if ($text_keys) {
#	    @orig_keys = sort { lc($a) cmp lc($b) } @orig_keys;
#	}
#	else {
#	    @orig_keys = sort { $a <=> $b } @orig_keys;
#	}
#
#	my $quote;
#	for my $key (@orig_keys) {
#	    next if $key =~ /^-?[a-zA-Z_]\w*\z/;
#	    next if $key =~ /^-?[1-9]\d{0,8}\z/;
#	    $quote++;
#	    last;
#	}
#
#	for my $key (@orig_keys) {
#	    my $val = \$rval->{$key};  
#	    $key = quote($key) if $quote;
#	    $kstat_max = length($key) if length($key) > $kstat_max;
#	    $kstat_sum += length($key);
#	    $kstat_sum2 += length($key)*length($key);
#
#	    push(@keys, $key);
#	    push(@vals, _dump($$val, $name, [@$idx, "{$key}"], $tied, $pclass, $pidx));
#	}
#	my $nl = "";
#	my $klen_pad = 0;
#	my $tmp = "@keys @vals";
#	if (length($tmp) > 60 || $tmp =~ /\n/ || $tied) {
#	    $nl = "\n";
#
#	    if ($kstat_max < 4) {
#		$klen_pad = $kstat_max;
#	    }
#	    elsif (@keys >= 2) {
#		my $n = @keys;
#		my $avg = $kstat_sum/$n;
#		my $stddev = sqrt(($kstat_sum2 - $n * $avg * $avg) / ($n - 1));
#
#		if ($stddev / $kstat_max < 0.25) {
#		    $klen_pad = $kstat_max;
#		}
#		if ($DEBUG) {
#		    push(@keys, "__S");
#		    push(@vals, sprintf("%.2f (%d/%.1f/%.1f)",
#					$stddev / $kstat_max,
#					$kstat_max, $avg, $stddev));
#		}
#	    }
#	}
#	$out = "{$nl";
#	$out .= "$INDENT# $tied$nl" if $tied;
#	while (@keys) {
#	    my $key = shift @keys;
#	    my $val = shift @vals;
#	    my $vpad = $INDENT . (" " x ($klen_pad ? $klen_pad + 4 : 0));
#	    $val =~ s/\n/\n$vpad/gm;
#	    my $kpad = $nl ? $INDENT : " ";
#	    $key .= " " x ($klen_pad - length($key)) if $nl && $klen_pad > length($key);
#	    $out .= "$kpad$key => $val,$nl";
#	}
#	$out =~ s/,$/ / unless $nl;
#	$out .= "}";
#    }
#    elsif ($type eq "CODE") {
#	$out = 'sub { ... }';
#    }
#    elsif ($type eq "VSTRING") {
#        $out = sprintf +($ref ? '\v%vd' : 'v%vd'), $$rval;
#    }
#    else {
#	warn "Can't handle $type data";
#	$out = "'#$type#'";
#    }
#
#    if ($class && $ref) {
#	$out = "bless($out, " . quote($class) . ")";
#    }
#    if ($comment) {
#	$comment =~ s/^/# /gm;
#	$comment .= "\n" unless $comment =~ /\n\z/;
#	$comment =~ s/^#[ \t]+\n/\n/;
#	$out = "$comment$out";
#    }
#    return $out;
#}
#
#sub tied_str {
#    my $tied = shift;
#    if ($tied) {
#	if (my $tied_ref = ref($tied)) {
#	    $tied = "tied $tied_ref";
#	}
#	else {
#	    $tied = "tied";
#	}
#    }
#    return $tied;
#}
#
#sub fullname
#{
#    my($name, $idx, $ref) = @_;
#    substr($name, 0, 0) = "\$";
#
#    my @i = @$idx;  
#    if ($ref && @i && $i[0] eq "\$") {
#	shift(@i);  
#	$ref = 0;
#    }
#    while (@i && $i[0] eq "\$") {
#	shift @i;
#	$name = "\$$name";
#    }
#
#    my $last_was_index;
#    for my $i (@i) {
#	if ($i eq "*" || $i eq "\$") {
#	    $last_was_index = 0;
#	    $name = "$i\{$name}";
#	} elsif ($i =~ s/^\*//) {
#	    $name .= $i;
#	    $last_was_index++;
#	} else {
#	    $name .= "->" unless $last_was_index++;
#	    $name .= $i;
#	}
#    }
#    $name = "\\$name" if $ref;
#    $name;
#}
#
#sub format_list
#{
#    my $paren = shift;
#    my $comment = shift;
#    my $indent_lim = $paren ? 0 : 1;
#    if (@_ > 3) {
#	my $i = 0;
#	while ($i < @_) {
#	    my $j = $i + 1;
#	    my $v = $_[$i];
#	    while ($j < @_) {
#		if ($v eq "0" || $v =~ /^-?[1-9]\d{0,9}\z/) {
#		    $v++;
#		}
#		elsif ($v =~ /^"([A-Za-z]{1,3}\d*)"\z/) {
#		    $v = $1;
#		    $v++;
#		    $v = qq("$v");
#		}
#		else {
#		    last;
#		}
#		last if $_[$j] ne $v;
#		$j++;
#	    }
#	    if ($j - $i > 3) {
#		splice(@_, $i, $j - $i, "$_[$i] .. $_[$j-1]");
#	    }
#	    $i++;
#	}
#    }
#    my $tmp = "@_";
#    if ($comment || (@_ > $indent_lim && (length($tmp) > 60 || $tmp =~ /\n/))) {
#	my @elem = @_;
#	for (@elem) { s/^/$INDENT/gm; }
#	return "\n" . ($comment ? "$INDENT# $comment\n" : "") .
#               join(",\n", @elem, "");
#    } else {
#	return join(", ", @_);
#    }
#}
#
#sub str {
#  if (length($_[0]) > 20) {
#      for ($_[0]) {
#      if (/^(.)\1\1\1/s) {
#          unless (/[^\Q$1\E]/) {
#              my $base = quote($1);
#              my $repeat = length;
#              return "($base x $repeat)"
#          }
#      }
#      if (length($_) < 16 * 1024 && /^(.{2,5}?)\1*\z/s) {
#	  my $base   = quote($1);
#	  my $repeat = length($_)/length($1);
#	  return "($base x $repeat)";
#      }
#      }
#  }
#
#  local $_ = &quote;
#
#  if (length($_) > 40  && !/\\x\{/ && length($_) > (length($_[0]) * 2)) {
#
#      if ($TRY_BASE64 && length($_[0]) > $TRY_BASE64 &&
#	  (defined &utf8::is_utf8 && !utf8::is_utf8($_[0])) &&
#	  eval { require MIME::Base64 })
#      {
#	  $require{"MIME::Base64"}++;
#	  return "MIME::Base64::decode(\"" .
#	             MIME::Base64::encode($_[0],"") .
#		 "\")";
#      }
#      return "pack(\"H*\",\"" . unpack("H*", $_[0]) . "\")";
#  }
#
#  return $_;
#}
#
#my %esc = (
#    "\a" => "\\a",
#    "\b" => "\\b",
#    "\t" => "\\t",
#    "\n" => "\\n",
#    "\f" => "\\f",
#    "\r" => "\\r",
#    "\e" => "\\e",
#);
#
#sub 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("$_");
#}
#
#1;
#
#__END__
#
### Data/Dump/FilterContext.pm ###
#package Data::Dump::FilterContext;
#
#sub new {
#    my($class, $obj, $oclass, $type, $ref, $pclass, $pidx, $idx) = @_;
#    return bless {
#	object => $obj,
#	class => $ref && $oclass,
#	reftype => $type,
#	is_ref => $ref,
#	pclass => $pclass,
#	pidx => $pidx,
#	idx => $idx,
#    }, $class;
#}
#
#sub object_ref {
#    my $self = shift;
#    return $self->{object};
#}
#
#sub class {
#    my $self = shift;
#    return $self->{class} || "";
#}
#
#*is_blessed = \&class;
#
#sub reftype {
#    my $self = shift;
#    return $self->{reftype};
#}
#
#sub is_scalar {
#    my $self = shift;
#    return $self->{reftype} eq "SCALAR";
#}
#
#sub is_array {
#    my $self = shift;
#    return $self->{reftype} eq "ARRAY";
#}
#
#sub is_hash {
#    my $self = shift;
#    return $self->{reftype} eq "HASH";
#}
#
#sub is_code {
#    my $self = shift;
#    return $self->{reftype} eq "CODE";
#}
#
#sub is_ref {
#    my $self = shift;
#    return $self->{is_ref};
#}
#
#sub container_class {
#    my $self = shift;
#    return $self->{pclass} || "";
#}
#
#sub container_self {
#    my $self = shift;
#    return "" unless $self->{pclass};
#    my $idx = $self->{idx};
#    my $pidx = $self->{pidx};
#    return Data::Dump::fullname("self", [@$idx[$pidx..(@$idx - 1)]]);
#}
#
#sub expr {
#    my $self = shift;
#    my $top = shift || "var";
#    $top =~ s/^\$//; 
#    my $idx = $self->{idx};
#    return Data::Dump::fullname($top, $idx);
#}
#
#sub object_isa {
#    my($self, $class) = @_;
#    return $self->{class} && $self->{class}->isa($class);
#}
#
#sub container_isa {
#    my($self, $class) = @_;
#    return $self->{pclass} && $self->{pclass}->isa($class);
#}
#
#sub depth {
#    my $self = shift;
#    return scalar @{$self->{idx}};
#}
#
#1;
### Data/Dump/Filtered.pm ###
#package Data::Dump::Filtered;
#
#use Data::Dump ();
#use Carp ();
#
#use base 'Exporter';
#our @EXPORT_OK = qw(add_dump_filter remove_dump_filter dump_filtered);
#
#sub add_dump_filter {
#    my $filter = shift;
#    unless (ref($filter) eq "CODE") {
#	Carp::croak("add_dump_filter argument must be a code reference");
#    }
#    push(@Data::Dump::FILTERS, $filter);
#    return $filter;
#}
#
#sub remove_dump_filter {
#    my $filter = shift;
#    @Data::Dump::FILTERS = grep $_ ne $filter, @Data::Dump::FILTERS;
#}
#
#sub dump_filtered {
#    my $filter = pop;
#    if (defined($filter) && ref($filter) ne "CODE") {
#	Carp::croak("Last argument to dump_filtered must be undef or a code reference");
#    }
#    local @Data::Dump::FILTERS = ($filter ? $filter : ());
#    return &Data::Dump::dump;
#}
#
#1;
#
### Data/Dump/Trace.pm ###
#package Data::Dump::Trace;
#
#$VERSION = "0.02";
#
#
#use strict;
#
#use base 'Exporter';
#our @EXPORT_OK = qw(call mcall wrap autowrap trace);
#
#use Carp qw(croak);
#use overload ();
#
#my %obj_name;
#my %autowrap_class;
#my %name_count;
#
#sub autowrap {
#    while (@_) {
#        my $class = shift;
#        my $info = shift;
#        $info = { prefix => $info } unless ref($info);
#        for ($info->{prefix}) {
#            unless ($_) {
#                $_ = lc($class);
#                s/.*:://;
#            }
#            $_ = '$' . $_ unless /^\$/;
#        }
#        $autowrap_class{$class} = $info;
#    }
#}
#
#sub wrap {
#    my %arg = @_;
#    my $name = $arg{name} || "func";
#    my $func = $arg{func};
#    my $proto = $arg{proto};
#
#    return sub {
#        call($name, $func, $proto, @_);
#    } if $func;
#
#    if (my $obj = $arg{obj}) {
#        $name = '$' . $name unless $name =~ /^\$/;
#        $obj_name{overload::StrVal($obj)} = $name;
#        return bless {
#            name => $name,
#            obj => $obj,
#            proto => $arg{proto},
#        }, "Data::Dump::Trace::Wrapper";
#    }
#
#    croak("Either the 'func' or 'obj' option must be given");
#}
#
#sub trace {
#    my($symbol, $prototype) = @_;
#    no strict 'refs';
#    no warnings 'redefine';
#    *{$symbol} = wrap(name => $symbol, func => \&{$symbol}, proto => $prototype);
#}
#
#sub call {
#    my $name = shift;
#    my $func = shift;
#    my $proto = shift;
#    my $fmt = Data::Dump::Trace::Call->new($name, $proto, \@_);
#    if (!defined wantarray) {
#        $func->(@_);
#        return $fmt->return_void(\@_);
#    }
#    elsif (wantarray) {
#        return $fmt->return_list(\@_, $func->(@_));
#    }
#    else {
#        return $fmt->return_scalar(\@_, scalar $func->(@_));
#    }
#}
#
#sub mcall {
#    my $o = shift;
#    my $method = shift;
#    my $proto = shift;
#    return if $method eq "DESTROY" && !$o->can("DESTROY");
#    my $oname = ref($o) ? $obj_name{overload::StrVal($o)} || "\$o" : $o;
#    my $fmt = Data::Dump::Trace::Call->new("$oname->$method", $proto, \@_);
#    if (!defined wantarray) {
#        $o->$method(@_);
#        return $fmt->return_void(\@_);
#    }
#    elsif (wantarray) {
#        return $fmt->return_list(\@_, $o->$method(@_));
#    }
#    else {
#        return $fmt->return_scalar(\@_, scalar $o->$method(@_));
#    }
#}
#
#package Data::Dump::Trace::Wrapper;
#
#sub AUTOLOAD {
#    my $self = shift;
#    our $AUTOLOAD;
#    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
#    Data::Dump::Trace::mcall($self->{obj}, $method, $self->{proto}{$method}, @_);
#}
#
#package Data::Dump::Trace::Call;
#
#use Term::ANSIColor ();
#use Data::Dump ();
#
#*_dump = \&Data::Dump::dump;
#
#our %COLOR = (
#    name => "yellow",
#    output => "cyan",
#    error => "red",
#    debug => "red",
#);
#
#%COLOR = () unless -t STDOUT;
#
#sub _dumpav {
#    return "(" . _dump(@_) . ")" if @_ == 1;
#    return _dump(@_);
#}
#
#sub _dumpkv {
#    return _dumpav(@_) if @_ % 2;
#    my %h = @_;
#    my $str = _dump(\%h);
#    $str =~ s/^\{/(/ && $str =~ s/\}\z/)/;
#    return $str;
#}
#
#sub new {
#    my($class, $name, $proto, $input_args) = @_;
#    my $self = bless {
#        name => $name,
#        proto => $proto,
#    }, $class;
#    my $proto_arg = $self->proto_arg;
#    if ($proto_arg =~ /o/) {
#        for (@$input_args) {
#            push(@{$self->{input_av}}, _dump($_));
#        }
#    }
#    else {
#        $self->{input} = $proto_arg eq "%" ? _dumpkv(@$input_args) : _dumpav(@$input_args);
#    }
#    return $self;
#}
#
#sub proto_arg {
#    my $self = shift;
#    my($arg, $ret) = split(/\s*=\s*/, $self->{proto} || "");
#    $arg ||= '@';
#    return $arg;
#}
#
#sub proto_ret {
#    my $self = shift;
#    my($arg, $ret) = split(/\s*=\s*/, $self->{proto} || "");
#    $ret ||= '@';
#    return $ret;
#}
#
#sub color {
#    my($self, $category, $text) = @_;
#    return $text unless $COLOR{$category};
#    return Term::ANSIColor::colored($text, $COLOR{$category});
#}
#
#sub print_call {
#    my $self = shift;
#    my $outarg = shift;
#    print $self->color("name", "$self->{name}");
#    if (my $input = $self->{input}) {
#        $input = "" if $input eq "()" && $self->{name} =~ /->/;
#        print $self->color("input", $input);
#    }
#    else {
#        my $proto_arg = $self->proto_arg;
#        print "(";
#        my $i = 0;
#        for (@{$self->{input_av}}) {
#            print ", " if $i;
#            my $proto = substr($proto_arg, 0, 1, "");
#            if ($proto ne "o") {
#                print $self->color("input", $_);
#            }
#            if ($proto eq "o" || $proto eq "O") {
#                print " = " if $proto eq "O";
#                print $self->color("output", _dump($outarg->[$i]));
#            }
#        }
#        continue {
#            $i++;
#        }
#        print ")";
#    }
#}
#
#sub return_void {
#    my $self = shift;
#    my $arg = shift;
#    $self->print_call($arg);
#    print "\n";
#    return;
#}
#
#sub return_scalar {
#    my $self = shift;
#    my $arg = shift;
#    $self->print_call($arg);
#    my $s = shift;
#    my $name;
#    my $proto_ret = $self->proto_ret;
#    my $wrap = $autowrap_class{ref($s)};
#    if ($proto_ret =~ /^\$\w+\z/ && ref($s) && ref($s) !~ /^(?:ARRAY|HASH|CODE|GLOB)\z/) {
#        $name = $proto_ret;
#    }
#    else {
#        $name = $wrap->{prefix} if $wrap;
#    }
#    if ($name) {
#        $name .= $name_count{$name} if $name_count{$name}++;
#        print " = ", $self->color("output", $name), "\n";
#        $s = Data::Dump::Trace::wrap(name => $name, obj => $s, proto => $wrap->{proto});
#    }
#    else {
#        print " = ", $self->color("output", _dump($s));
#        if (!$s && $proto_ret =~ /!/ && $!) {
#            print " ", $self->color("error", errno($!));
#        }
#        print "\n";
#    }
#    return $s;
#}
#
#sub return_list {
#    my $self = shift;
#    my $arg = shift;
#    $self->print_call($arg);
#    print " = ", $self->color("output", $self->proto_ret eq "%" ? _dumpkv(@_) : _dumpav(@_)), "\n";
#    return @_;
#}
#
#sub errno {
#    my $t = "";
#    for (keys %!) {
#        if ($!{$_}) {
#            $t = $_;
#            last;
#        }
#    }
#    my $n = int($!);
#    return "$t($n) $!";
#}
#
#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.pm ###
#package Data::Sah;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#
#our $Log_Validator_Code = $ENV{LOG_SAH_VALIDATOR_CODE} // 0;
#
#use Data::Sah::Normalize qw(
#                       $type_re
#                       $clause_name_re
#                       $clause_re
#                       $attr_re
#                       $funcset_re
#                       $compiler_re
#                       );
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(normalize_schema gen_validator);
#
#has compilers    => (is => 'rw', default => sub { {} });
#
#has _var_enumer  => (
#    is      => 'rw',
#    lazy    => 1,
#    default => sub {
#        require Language::Expr::Interpreter::VarEnumer;
#        Language::Expr::Interpreter::VarEnumer->new;
#    },
#);
#
#sub normalize_clset {
#    require Scalar::Util;
#
#    my $self;
#    if (Scalar::Util::blessed($_[0])) {
#        $self = shift;
#    } else {
#        $self = __PACKAGE__->new;
#    }
#
#    Data::Sah::Normalize::normalize_clset($_[0]);
#}
#
#sub normalize_schema {
#    require Scalar::Util;
#
#    my $self;
#    if (Scalar::Util::blessed($_[0])) {
#        $self = shift;
#    } else {
#        $self = __PACKAGE__->new;
#    }
#    my ($s) = @_;
#
#    Data::Sah::Normalize::normalize_schema($_[0]);
#}
#
#sub gen_validator {
#    require Scalar::Util;
#
#    my $self;
#    if (Scalar::Util::blessed($_[0])) {
#        $self = shift;
#    } else {
#        $self = __PACKAGE__->new;
#    }
#    my ($schema, $opts) = @_;
#    my %args = (schema => $schema, %{$opts // {}});
#    my $opt_source = delete $args{source};
#
#    $args{log_result} = 1 if $Log_Validator_Code;
#
#    my $pl = $self->get_compiler("perl");
#    my $code = $pl->expr_validator_sub(%args);
#    return $code if $opt_source;
#
#    my $res = eval $code;
#    die "Can't compile validator: $@" if $@;
#    $res;
#}
#
#sub get_compiler {
#    my ($self, $name) = @_;
#    return $self->compilers->{$name} if $self->compilers->{$name};
#
#    die "Invalid compiler name `$name`" unless $name =~ $compiler_re;
#    my $module = "Data::Sah::Compiler::$name";
#    if (!eval "require $module; 1") {
#        die "Can't load compiler module $module".($@ ? ": $@" : "");
#    }
#
#    my $obj = $module->new(main => $self);
#    $self->compilers->{$name} = $obj;
#
#    return $obj;
#}
#
#sub normalize_var {
#    my ($self, $var, $curpath) = @_;
#    die "Not yet implemented";
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce.pm ###
#package Data::Sah::Coerce;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#use Data::Sah::CoerceCommon;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(gen_coercer);
#
#our %SPEC;
#
#our $Log_Coercer_Code = $ENV{LOG_SAH_COERCER_CODE} // 0;
#
#$SPEC{gen_coercer} = {
#    v => 1.1,
#    summary => 'Generate coercer code',
#    description => <<'_',
#
#This is mostly for testing. Normally the coercion rules will be used from
#<pm:Data::Sah>.
#
#_
#    args => {
#        %Data::Sah::CoerceCommon::gen_coercer_args,
#    },
#    result_naked => 1,
#};
#sub gen_coercer {
#    my %args = @_;
#
#    my $rt = $args{return_type} // 'val';
#    my $rt_sv = $rt eq 'str+val';
#
#    my $rules = Data::Sah::CoerceCommon::get_coerce_rules(
#        %args,
#        compiler=>'perl',
#        data_term=>'$data',
#    );
#
#    my $code;
#    if (@$rules) {
#        my $code_require = '';
#        my %mem;
#        for my $rule (@$rules) {
#            next unless $rule->{modules};
#            for my $mod (keys %{$rule->{modules}}) {
#                next if $mem{$mod}++;
#                $code_require .= "require $mod;\n";
#            }
#        }
#
#        my $expr;
#        for my $i (reverse 0..$#{$rules}) {
#            my $rule = $rules->[$i];
#            if ($i == $#{$rules}) {
#                if ($rt_sv) {
#                    $expr = "($rule->{expr_match}) ? ['$rule->{name}', $rule->{expr_coerce}] : [undef, \$data]";
#                } else {
#                    $expr = "($rule->{expr_match}) ? ($rule->{expr_coerce}) : \$data";
#                }
#            } else {
#                if ($rt_sv) {
#                    $expr = "($rule->{expr_match}) ? ['$rule->{name}', $rule->{expr_coerce}] : ($expr)";
#                } else {
#                    $expr = "($rule->{expr_match}) ? ($rule->{expr_coerce}) : ($expr)";
#                }
#            }
#        }
#
#        $code = join(
#            "",
#            $code_require,
#            "sub {\n",
#            "    my \$data = shift;\n",
#            ($rt_sv ?
#                 "    return [undef, undef] unless defined(\$data);\n" :
#                 "    return undef unless defined(\$data);\n"
#             ),
#            "    $expr;\n",
#            "}",
#        );
#    } else {
#        if ($rt_sv) {
#            $code = 'sub { [undef, $_[0]] }';
#        } else {
#            $code = 'sub { $_[0] }';
#        }
#    }
#
#    if ($Log_Coercer_Code) {
#        $log->tracef("Coercer code (gen args: %s): %s", \%args, $code);
#    }
#
#    return $code if $args{source};
#
#    my $coercer = eval $code;
#    die if $@;
#    $coercer;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/js/bool/float.pm ###
#package Data::Sah::Coerce::js::bool::float;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "typeof($dt)=='number'",
#        "$dt == 0 || $dt == 1",
#    );
#
#
#    $res->{expr_coerce} = "$dt == 1 ? true : false";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/js/bool/str.pm ###
#package Data::Sah::Coerce::js::bool::str;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#
#    my $res = {};
#
#    my $re      = '/^(yes|no|true|false|on|off|1|0)$/i';
#    my $re_true = '/^(yes|true|on|1)$/i';
#
#    $res->{expr_match} = join(
#        " && ",
#        "typeof($dt)=='string'",
#        "$dt.match($re)",
#    );
#
#
#    $res->{expr_coerce} = "(function(_m) { _m = $dt.match($re); return _m[1].match($re_true) ? true : false })()";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/js/date/float_epoch.pm ###
#package Data::Sah::Coerce::js::date::float_epoch;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "typeof($dt)=='number'",
#        "$dt >= " . (10**8),
#        "$dt <= " . (2**31),
#    );
#
#    $res->{expr_coerce} = "(new Date($dt * 1000))";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/js/date/obj_Date.pm ###
#package Data::Sah::Coerce::js::date::obj_Date;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        might_die => 1, 
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "($dt instanceof Date)",
#    );
#
#    $res->{expr_coerce} = "isNaN($dt) ? (function(){throw new Error('Invalid date')})() : $dt";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/js/date/str.pm ###
#package Data::Sah::Coerce::js::date::str;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        might_die => 1, 
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "typeof($dt)=='string'",
#    );
#
#    $res->{expr_coerce} = "(function (_m) { _m = new Date($dt); if (isNaN(_m)) throw new Error('Invalid date'); return _m })()";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/js/duration/float_secs.pm ###
#package Data::Sah::Coerce::js::duration::float_secs;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to};
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "(typeof($dt)=='number' || typeof($dt)=='string' && $dt.match(/^[0-9]+(?:\\.[0-9]+)?\$/))",
#        "parseFloat($dt) >= 0", 
#        "!isNaN(parseFloat($dt))",
#        "isFinite(parseFloat($dt))", 
#    );
#
#    $res->{expr_coerce} = "parseFloat($dt)";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/js/duration/str_iso8601.pm ###
#package Data::Sah::Coerce::js::duration::str_iso8601;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to};
#
#    my $res = {};
#
#    my $re_num = '[0-9]+(?:\\.[0-9]+)?';
#    my $expr_re_match = "$dt.match(/^P(?:($re_num)Y)?(?:($re_num)M)?(?:($re_num)W)?(?:($re_num)D)?(?:T(?:($re_num)H)?(?:($re_num)M)?(?:($re_num)S)?)?\$/)";
#    $res->{expr_match} = join(
#        " && ",
#        "typeof($dt)=='string'",
#        $expr_re_match,
#    );
#
#
#    $res->{expr_coerce} = "(function(_m) { _m = $expr_re_match; return ((_m[1]||0)*365.25*86400 + (_m[2]||0)*30.4375*86400 + (_m[3]||0)*7*86400 + (_m[4]||0)*86400 + (_m[5]||0)*3600 + (_m[6]||0)*60 + (_m[7]||0)*1) })()";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/bool/str.pm ###
#package Data::Sah::Coerce::perl::bool::str;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 0,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "1",
#    );
#
#    $res->{expr_coerce} = "$dt =~ /\\A(yes|true|on)\\z/i ? 1 : $dt =~ /\\A(no|false|off|0)\\z/i ? '' : $dt";
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/date/float_epoch.pm ###
#package Data::Sah::Coerce::perl::date::float_epoch;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(epoch)';
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "!ref($dt)",
#        "$dt =~ /\\A[0-9]{8,10}(?:\.[0-9]+)?\\z/",
#        "$dt >= 10**8",
#        "$dt <= 2**31",
#    );
#
#    if ($coerce_to eq 'float(epoch)') {
#        $res->{expr_coerce} = $dt;
#    } elsif ($coerce_to eq 'DateTime') {
#        $res->{modules}{DateTime} //= 0;
#        $res->{expr_coerce} = "DateTime->from_epoch(epoch => $dt)";
#    } elsif ($coerce_to eq 'Time::Moment') {
#        $res->{modules}{'Time::Moment'} //= 0;
#        $res->{expr_coerce} = "Time::Moment->from_epoch($dt)";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(epoch), DateTime, or Time::Moment";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/date/obj_DateTime.pm ###
#package Data::Sah::Coerce::perl::date::obj_DateTime;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(epoch)';
#
#    my $res = {};
#
#    $res->{modules}{'Scalar::Util'} //= 0;
#
#    $res->{expr_match} = join(
#        " && ",
#        "Scalar::Util::blessed($dt)",
#        "$dt\->isa('DateTime')",
#    );
#
#    if ($coerce_to eq 'float(epoch)') {
#        $res->{expr_coerce} = "$dt\->epoch";
#    } elsif ($coerce_to eq 'DateTime') {
#        $res->{expr_coerce} = $dt;
#    } elsif ($coerce_to eq 'Time::Moment') {
#        $res->{modules}{'Time::Moment'} //= 0;
#        $res->{expr_coerce} = "Time::Moment->from_object($dt)";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(epoch), DateTime, or Time::Moment";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/date/obj_TimeMoment.pm ###
#package Data::Sah::Coerce::perl::date::obj_TimeMoment;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(epoch)';
#
#    my $res = {};
#
#    $res->{modules}{'Scalar::Util'} //= 0;
#
#    $res->{expr_match} = join(
#        " && ",
#        "Scalar::Util::blessed($dt)",
#        "$dt\->isa('Time::Moment')",
#    );
#
#    if ($coerce_to eq 'float(epoch)') {
#        $res->{expr_coerce} = "$dt\->epoch";
#    } elsif ($coerce_to eq 'DateTime') {
#        $res->{modules}{'DateTime'} //= 0;
#        $res->{expr_coerce} = "DateTime->from_epoch(epoch => $dt\->epoch, time_zone => sprintf('%s%04d', $dt\->offset >= 0 ? '+':'-', abs(int($dt\->offset / 60)*100) + abs(int($dt\->offset % 60))))";
#    } elsif ($coerce_to eq 'Time::Moment') {
#        $res->{expr_coerce} = $dt;
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(epoch), DateTime, or Time::Moment";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/date/str_iso8601.pm ###
#package Data::Sah::Coerce::perl::date::str_iso8601;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        might_die => 1, 
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(epoch)';
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "!ref($dt)",
#        "$dt =~ /\\A([0-9]{4})-([0-9]{2})-([0-9]{2})(?:(T)([0-9]{2}):([0-9]{2}):([0-9]{2})(Z?))?\\z/",
#    );
#
#    $res->{modules}{"Time::Local"} //= 0;
#
#    my $code_epoch = '$4 ? ($8 ? Time::Local::timegm($7, $6, $5, $3, $2-1, $1-1900) : Time::Local::timelocal($7, $6, $5, $3, $2-1, $1-1900)) : Time::Local::timelocal(0, 0, 0, $3, $2-1, $1-1900)';
#    if ($coerce_to eq 'float(epoch)') {
#        $res->{expr_coerce} = $code_epoch;
#    } elsif ($coerce_to eq 'DateTime') {
#        $res->{modules}{"DateTime"} //= 0;
#        $res->{expr_coerce} = "DateTime->from_epoch(epoch => $code_epoch, time_zone => \$8 ? 'UTC' : 'local')";
#    } elsif ($coerce_to eq 'Time::Moment') {
#        $res->{modules}{"Time::Moment"} //= 0;
#        $res->{expr_coerce} = "Time::Moment->from_epoch($code_epoch)";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(epoch), DateTime, or Time::Moment";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/duration/float_secs.pm ###
#package Data::Sah::Coerce::perl::duration::float_secs;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(secs)';
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "!ref($dt)",
#        "$dt =~ /\\A[0-9]+(?:\.[0-9]+)\\z/",
#    );
#
#    if ($coerce_to eq 'float(secs)') {
#        $res->{expr_coerce} = $dt;
#    } elsif ($coerce_to eq 'DateTime::Duration') {
#        $res->{modules}{'DateTime::Duration'} //= 0;
#        $res->{expr_coerce} = "DateTime::Duration->new(seconds => $dt)";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(secs) or DateTime::Duration";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/duration/obj_DateTimeDuration.pm ###
#package Data::Sah::Coerce::perl::duration::obj_DateTimeDuration;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(secs)';
#
#    my $res = {};
#
#    $res->{modules}{'Scalar::Util'} //= 0;
#
#    $res->{expr_match} = join(
#        " && ",
#        "Scalar::Util::blessed($dt)",
#        "$dt\->isa('DateTime::Duration')",
#    );
#
#    if ($coerce_to eq 'float(secs)') {
#        $res->{expr_coerce} = "($dt\->years * 365.25*86400 + $dt\->months * 30.4375*86400 + $dt\->weeks * 7*86400 + $dt\->days * 86400 + $dt\->hours * 3600 + $dt\->minutes * 60 + $dt\->seconds + $dt\->nanoseconds * 1e-9)";
#    } elsif ($coerce_to eq 'DateTime::Duration') {
#        $res->{expr_coerce} = $dt;
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(secs) or DateTime::Duration";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/duration/str_human.pm ###
#package Data::Sah::Coerce::perl::duration::str_human;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        might_die => 1, 
#        prio => 60,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(secs)';
#
#    my $res = {};
#
#    $res->{expr_match} = join(
#        " && ",
#        "!ref($dt)",
#        "$dt =~ /\\d.*[a-z]/",
#    );
#
#    $res->{modules}{"Time::Duration::Parse::AsHash"} //= 0;
#    if ($coerce_to eq 'float(secs)') {
#        $res->{expr_coerce} = "do { my \$p = Time::Duration::Parse::AsHash::parse_duration($dt); (\$p->{years}||0) * 365.25*86400 + (\$p->{months}||0) * 30.4375*86400 + (\$p->{weeks}||0) * 7*86400 + (\$p->{days}||0) * 86400 + (\$p->{hours}||0) * 3600 + (\$p->{minutes}||0) * 60 + (\$p->{seconds}||0) }";
#    } elsif ($coerce_to eq 'DateTime::Duration') {
#        $res->{modules}{"DateTime::Duration"} //= 0;
#        $res->{expr_coerce} = "do { my \$p = Time::Duration::Parse::AsHash::parse_duration($dt); DateTime::Duration->new( (years=>\$p->{years}) x !!defined(\$p->{years}), (months=>\$p->{months}) x !!defined(\$p->{months}), (weeks=>\$p->{weeks}) x !!defined(\$p->{weeks}), (days=>\$p->{days}) x !!defined(\$p->{days}), (hours=>\$p->{hours}) x !!defined(\$p->{hours}), (minutes=>\$p->{minutes}) x !!defined(\$p->{minutes}), (seconds=>\$p->{seconds}) x !!defined(\$p->{seconds})) }";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(secs) or DateTime::Duration";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/duration/str_iso8601.pm ###
#package Data::Sah::Coerce::perl::duration::str_iso8601;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#sub meta {
#    +{
#        v => 2,
#        enable_by_default => 1,
#        prio => 50,
#    };
#}
#
#sub coerce {
#    my %args = @_;
#
#    my $dt = $args{data_term};
#    my $coerce_to = $args{coerce_to} // 'float(secs)';
#
#    my $res = {};
#
#    my $re_num = '[0-9]+(?:\\.[0-9]+)?';
#    $res->{expr_match} = join(
#        " && ",
#        "!ref($dt)",
#        "$dt =~ /\\AP(?:($re_num)Y)? (?:($re_num)M)? (?:($re_num)W)? (?:($re_num)D)? (?: T (?:($re_num)H)? (?:($re_num)M)? (?:($re_num)S)? )?\\z/x",
#    );
#
#    if ($coerce_to eq 'float(secs)') {
#        $res->{expr_coerce} = "((\$1||0)*365.25*86400 + (\$2||0)*30.4375*86400 + (\$3||0)*7*86400 + (\$4||0)*86400 + (\$5||0)*3600 + (\$6||0)*60 + (\$7||0))";
#    } elsif ($coerce_to eq 'DateTime::Duration') {
#        $res->{modules}{"DateTime::Duration"} //= 0;
#        $res->{expr_coerce} = "DateTime::Duration->new( (years=>\$1) x !!defined(\$1), (months=>\$2) x !!defined(\$2), (weeks=>\$3) x !!defined(\$3), (days=>\$4) x !!defined(\$4), (hours=>\$5) x !!defined(\$5), (minutes=>\$6) x !!defined(\$6), (seconds=>\$7) x !!defined(\$7))";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', ".
#            "please use float(secs) or DateTime::Duration";
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/CoerceCommon.pm ###
#package Data::Sah::CoerceCommon;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict 'subs', 'vars';
#
#my %common_args = (
#    type => {
#        schema => 'str*', 
#            req => 1,
#        pos => 0,
#    },
#    coerce_to => {
#        schema => 'str*',
#        description => <<'_',
#
#Some Sah types, like `date`, can be represented in a choice of types in the
#target language. For example, in Perl you can store it as a floating number
#a.k.a. `float(epoch)`, or as a <pm:DateTime> object, or <pm:Time::Moment>
#object. Storing in DateTime can be convenient for date manipulation but requires
#an overhead of loading the module and storing in a bulky format. The choice is
#yours to make, via this setting.
#
#_
#    },
#    coerce_rules => {
#        summary => 'A specification of coercion rules to use (or avoid)',
#        schema => ['array*', of=>'str*'],
#        description => <<'_',
#
#This setting is used to specify which coercion rules to use (or avoid) in a
#flexible way. Each element is a string, in the form of either `NAME` to mean
#specifically include a rule, or `!NAME` to exclude a rule, or `REGEX` or
#`!REGEX` to include or exclude a pattern. All NAME's that contains a
#non-alphanumeric, non-underscore character are assumed to be a REGEX pattern.
#
#Without this setting, the default is to use all available coercion
#rules that have `enabled_by_default` set to 1 in their metadata.
#
#To use all rules (even those that are not enabled by default):
#
#    ['.']
#
#To not use any rules:
#
#    ['!.']
#
#To use only rules named R1 and R2 and not any other rules (even
#enabled-by-default ones):
#
#    ['!.', 'R1', 'R2']
#
#To use only rules matching /^R/ and not any other rules (even
#enabled-by-default ones):
#
#    ['!.', '^R']
#
#To use the default rules plus R1 and R2:
#
#    ['R1', 'R2']
#
#To use the default rules plus rules matching /^R/:
#
#    ['^R']
#
#To use the default rules but not R1 and R2:
#
#    ['!R1', '!R2']
#
#To use the default rules but not rules matching /^R/:
#
#    ['!^R']
#
#_
#    },
#);
#
#my %gen_coercer_args = (
#    %common_args,
#    return_type => {
#        schema => ['str*', in=>[qw/val str+val/]],
#        default => 'val',
#        description => <<'_',
#
#`val` returns the value (possibly) coerced. `str+val` returns a 2-element array
#where the first element is a bool value of whether the value has been coerced,
#and the second element is the (possibly) coerced value.
#
#_
#    },
#    source => {
#        summary => 'If set to true, will return coercer source code string'.
#            ' instead of compiled code',
#        schema => 'bool',
#    },
#);
#
#my %rule_modules_cache; 
#sub _list_rule_modules {
#    my $compiler = shift;
#    return $rule_modules_cache{$compiler} if $rule_modules_cache{$compiler};
#    require PERLANCAR::Module::List;
#    my $prefix = "Data::Sah::Coerce::$compiler\::";
#    my $mods = PERLANCAR::Module::List::list_modules(
#        $prefix, {list_modules=>1, recurse=>1},
#    );
#    $rule_modules_cache{$compiler} = $mods;
#    $mods;
#}
#
#our %SPEC;
#
#$SPEC{get_coerce_rules} = {
#    v => 1.1,
#    summary => 'Get coerce rules',
#    description => <<'_',
#
#This routine lists coerce rule modules, filters out unwanted ones, loads the
#rest, filters out old (version < current) modules or ones that are not enabled
#by default. Finally the routine gets the rules out.
#
#This common routine is used by <pm:Data::Sah> compilers, as well as
#<pm:Data::Sah::Coerce> and <pm:Data::Sah::CoerceJS>.
#
#_
#    args => {
#        %common_args,
#        compiler => {
#            schema => 'str*',
#            req => 1,
#        },
#        data_term => {
#            schema => 'str*',
#            req => 1,
#        },
#    },
#};
#sub get_coerce_rules {
#    my %args = @_;
#
#    my $type     = $args{type};
#    my $compiler = $args{compiler};
#    my $dt       = $args{data_term};
#
#    my $all_mods = _list_rule_modules($compiler);
#
#    my $typen = $type; $typen =~ s/::/__/g;
#    my $prefix = "Data::Sah::Coerce::$compiler\::$typen\::";
#
#    my @available_rule_names;
#    for my $mod (keys %$all_mods) {
#        next unless $mod =~ /\A\Q$prefix\E(.+)/;
#        push @available_rule_names, $1;
#    }
#
#    my @used_rule_names = @available_rule_names;
#    my %explicitly_used_rule_names;
#    for my $item (@{ $args{coerce_rules} // [] }) {
#        my $is_exclude = $item =~ s/\A!//;
#        my $is_re;
#        if ($item =~ /\A[A-Za-z0-9_]+\z/) {
#            $is_re = 0;
#        } else {
#            $is_re = 1;
#            eval { $item = qr/$item/ };
#            die "Invalid regex in coerce_rules item '$item': $@" if $@;
#        }
#        if ($is_exclude) {
#            if ($is_re) {
#                my @r;
#                for my $r (@available_rule_names) {
#                    next if $r =~ $item;
#                    push @r, $r;
#                }
#                @used_rule_names = @r;
#            } else {
#                my @r;
#                for my $r (@available_rule_names) {
#                    next if $r eq $item;
#                    push @r, $r;
#                }
#                @used_rule_names = @r;
#            }
#        } else {
#            if ($is_re) {
#                for my $r (@available_rule_names) {
#                    next unless $r =~ $item;
#                    $explicitly_used_rule_names{$r}++;
#                    unless (grep { $_ eq $r } @used_rule_names) {
#                        push @used_rule_names, $r;
#                    }
#                }
#            } else {
#                die "Unknown coercion rule '$item', make sure the coercion ".
#                    "rule module (Data::Sah::Coerce::$compiler\::$type\::$item".
#                    " has been installed"
#                    unless grep { $_ eq $item } @available_rule_names;
#                push @used_rule_names, $item
#                    unless grep { $_ eq $item } @used_rule_names;
#                $explicitly_used_rule_names{$item}++;
#            }
#        }
#    }
#
#    my @rules;
#    for my $rule_name (@used_rule_names) {
#        my $mod = "$prefix$rule_name";
#        my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#        require $mod_pm;
#        my $rule_meta = &{"$mod\::meta"};
#        my $rule_v = ($rule_meta->{v} // 1);
#        if ($rule_v != 2) {
#            warn "Coercion rule module '$mod' is still at ".
#                "metadata version $rule_v, will not be used";
#            next;
#        }
#        next unless $explicitly_used_rule_names{$rule_name} ||
#            $rule_meta->{enable_by_default};
#        my $rule = &{"$mod\::coerce"}(
#            data_term => $dt,
#            coerce_to => $args{coerce_to},
#        );
#        $rule->{name} = $rule_name;
#        $rule->{meta} = $rule_meta;
#        $rule->{explicitly_used} =
#            $explicitly_used_rule_names{$rule_name} ? 1:0;
#        push @rules, $rule;
#    }
#
#    @rules = sort {
#        ($a->{meta}{prio}//50) <=> ($b->{meta}{prio}//50) ||
#            $a cmp $b
#        } @rules;
#
#    {
#        my $i = 0;
#        while ($i < @rules) {
#            my $rule = $rules[$i];
#            if ($rule->{meta}{precludes}) {
#                for my $j (reverse 0 .. $#rules) {
#                    next if $j == $i;
#                    my $match;
#                    for my $p (@{ $rule->{meta}{precludes} }) {
#                        if (ref($p) eq 'Regexp' && $rules[$j]{name} =~ $p ||
#                                $rules[$j]{name} eq $p) {
#                            $match = 1;
#                            last;
#                        }
#                    }
#                    next unless $match;
#                    warn "Coercion rule $rules[$j]{name} is precluded by rule $rule->{name}"
#                        if $rule->{explicitly_used} && $rules[$j]{explicitly_used};
#                    splice @rules, $j, 1;
#                }
#            }
#            $i++;
#        }
#    }
#
#    \@rules;
#}
#
#1;
#
#__END__
#
### Data/Sah/CoerceJS.pm ###
#package Data::Sah::CoerceJS;
#
#our $DATE = '2016-09-29'; 
#our $VERSION = '0.020'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#use Data::Sah::CoerceCommon;
#use IPC::System::Options;
#use Nodejs::Util qw(get_nodejs_path);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(gen_coercer);
#
#our %SPEC;
#
#our $Log_Coercer_Code = $ENV{LOG_SAH_COERCER_CODE} // 0;
#
#$SPEC{gen_coercer} = {
#    v => 1.1,
#    summary => 'Generate coercer code',
#    description => <<'_',
#
#This is mostly for testing. Normally the coercion rules will be used from
#<pm:Data::Sah>.
#
#_
#    args => {
#        %Data::Sah::CoerceCommon::gen_coercer_args,
#    },
#    result_naked => 1,
#};
#sub gen_coercer {
#    my %args = @_;
#
#    my $rt = $args{return_type} // 'val';
#    my $rt_sv = $rt eq 'str+val';
#
#    my $rules = Data::Sah::CoerceCommon::get_coerce_rules(
#        %args,
#        compiler=>'js',
#        data_term=>'data',
#    );
#
#    my $code;
#    if (@$rules) {
#        my $expr;
#        for my $i (reverse 0..$#{$rules}) {
#            my $rule = $rules->[$i];
#            if ($i == $#{$rules}) {
#                if ($rt_sv) {
#                    $expr = "($rule->{expr_match}) ? [\"$rule->{name}\", $rule->{expr_coerce}] : [null, data]";
#                } else {
#                    $expr = "($rule->{expr_match}) ? ($rule->{expr_coerce}) : data";
#                }
#            } else {
#                if ($rt_sv) {
#                    $expr = "($rule->{expr_match}) ? [\"$rule->{name}\", $rule->{expr_coerce}] : ($expr)";
#                } else {
#                    $expr = "($rule->{expr_match}) ? ($rule->{expr_coerce}) : ($expr)";
#                }
#            }
#        }
#
#        $code = join(
#            "",
#            "function (data) {\n",
#            ($rt_sv ?
#                 "    if (data === undefined || data === null) return [null, null];\n" :
#                 "    if (data === undefined || data === null) return null;\n"
#             ),
#            "    return ($expr);\n",
#            "}",
#        );
#    } else {
#        if ($rt_sv) {
#            $code = 'function (data) { return [null, data] }';
#        } else {
#            $code = 'function (data) { return data }';
#        }
#    }
#
#    if ($Log_Coercer_Code) {
#        $log->tracef("Coercer code (gen args: %s): %s", \%args, $code);
#    }
#
#    return $code if $args{source};
#
#    state $nodejs_path = get_nodejs_path();
#    die "Can't find node.js in PATH" unless $nodejs_path;
#
#    sub {
#        require File::Temp;
#        require JSON;
#
#        my $data = shift;
#
#        state $json = JSON->new->allow_nonref;
#
#        my $src = "var coercer = $code;\n\n".
#            "console.log(JSON.stringify(coercer(".
#                $json->encode($data).")))";
#
#        my ($jsh, $jsfn) = File::Temp::tempfile();
#        print $jsh $src;
#        close($jsh) or die "Can't write JS code to file $jsfn: $!";
#
#        my $out = IPC::System::Options::readpipe($nodejs_path, $jsfn);
#        $json->decode($out);
#    };
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler.pm ###
#package Data::Sah::Compiler;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(default);
#use Role::Tiny::With;
#use Log::Any::IfLOG qw($log);
#use Scalar::Util qw(blessed);
#
#our %coercer_cache; 
#
#with 'Data::Sah::Compiler::TextResultRole';
#
#has main => (is => 'rw');
#
#has expr_compiler => (
#    is => 'rw',
#    lazy => 1,
#    default => sub {
#        require Language::Expr;
#        Language::Expr->new;
#    },
#);
#
#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;
#}
#
#sub name {
#    die "BUG: Please override name()";
#}
#
#sub literal {
#    die "BUG: Please override literal()";
#}
#
#sub expr {
#    die "BUG: Please override expr()";
#}
#
#sub _die {
#    my ($self, $cd, $msg) = @_;
#    die join(
#        "",
#        "Sah ". $self->name . " compiler: ",
#        "at schema:/", join("/", @{$cd->{spath} // []}), ": ",
#        $msg,
#    );
#}
#
#sub _form_deps {
#    require Language::Expr::Interpreter::VarEnumer;
#
#    my ($self, $cd, $ctbl) = @_;
#    my $main = $self->main;
#
#    my %depends;
#    for my $crec (values %$ctbl) {
#        my $cn = $crec->{name};
#        my $expr = defined($crec->{expr}) ? $crec->{value} :
#            $crec->{attrs}{expr};
#        if (defined $expr) {
#            my $vars = $main->_var_enumer->eval($expr);
#            for (@$vars) {
#                /^\w+$/ or $self->_die($cd,
#                    "Invalid variable syntax '$_', ".
#                        "currently only the form \$abc is supported");
#                $ctbl->{$_} or $self->_die($cd,
#                    "Unhandled clause specified in variable '$_'");
#            }
#            $depends{$cn} = $vars;
#            for (@$vars) {
#                push @{ $ctbl->{$_}{depended_by} }, $cn;
#            }
#        } else {
#            $depends{$cn} = [];
#        }
#    }
#    my %rsched = 
#        (); 
#    \%rsched;
#}
#
#sub _get_clauses_from_clsets {
#    my ($self, $cd, $clsets) = @_;
#    my $tn = $cd->{type};
#    my $th = $cd->{th};
#
#    my $deps;
#
#    my $sorter = sub {
#        my ($ia, $ca, $metaa) = @$a;
#        my ($ib, $cb, $metab) = @$b;
#        my $res;
#
#
#        {
#            $res = $metaa->{prio} <=> $metab->{prio};
#            last if $res;
#
#            my $sprioa = $clsets->[$ia]{"$ca.prio"} // 50;
#            my $spriob = $clsets->[$ib]{"$cb.prio"} // 50;
#            $res = $sprioa <=> $spriob;
#            last if $res;
#
#            $res = $ca cmp $cb;
#            last if $res;
#
#            $res = $ia <=> $ib;
#            last if $res;
#
#            $res = 0;
#        }
#
#        $res;
#    };
#
#    my @clauses;
#    for my $i (0..@$clsets-1) {
#        for my $k (grep {!/\A_/ && !/\./} keys %{$clsets->[$i]}) {
#            my $meta;
#            eval {
#                $meta = "Data::Sah::Type::$tn"->${\("clausemeta_$k")};
#            };
#            if ($@) {
#                for ($cd->{args}{on_unhandled_clause}) {
#                    my $msg = "Unhandled clause for type $tn: $k ($@)";
#                    next if $_ eq 'ignore';
#                    next if $_ eq 'warn'; 
#                    $self->_die($cd, $msg);
#                }
#            }
#            $meta //= {prio=>50};
#            push @clauses, [$i, $k, $meta];
#        }
#    }
#
#    my $res = [sort $sorter @clauses];
#    $res;
#}
#
#sub get_th {
#    my ($self, %args) = @_;
#    my $cd    = $args{cd};
#    my $name  = $args{name};
#
#    my $th_map = $cd->{th_map};
#    return $th_map->{$name} if $th_map->{$name};
#
#    if ($args{load} // 1) {
#        no warnings;
#        $self->_die($cd, "Invalid syntax for type name '$name', please use ".
#                        "letters/numbers/underscores only")
#            unless $name =~ $Data::Sah::type_re;
#        my $main = $self->main;
#        my $module = ref($self) . "::TH::$name";
#        if (!eval "require $module; 1") {
#            $self->_die($cd, "Can't load type handler $module".
#                            ($@ ? ": $@" : ""));
#        }
#        $self->add_compile_module($cd, $module, {category=>'type_handler'});
#
#        my $obj = $module->new(compiler=>$self);
#        $th_map->{$name} = $obj;
#    }
#    use experimental 'smartmatch';
#
#    return $th_map->{$name};
#}
#
#sub get_fsh {
#    my ($self, %args) = @_;
#    my $cd    = $args{cd};
#    my $name  = $args{name};
#
#    my $fsh_table = $cd->{fsh_table};
#    return $fsh_table->{$name} if $fsh_table->{$name};
#
#    if ($args{load} // 1) {
#        no warnings;
#        $self->_die($cd, "Invalid syntax for func set name '$name', ".
#                        "please use letters/numbers/underscores")
#            unless $name =~ $Data::Sah::funcset_re;
#        my $module = ref($self) . "::FSH::$name";
#        if (!eval "require $module; 1") {
#            $self->_die($cd, "Can't load func set handler $module".
#                            ($@ ? ": $@" : ""));
#        }
#
#        my $obj = $module->new();
#        $fsh_table->{$name} = $obj;
#    }
#    use experimental 'smartmatch';
#
#    return $fsh_table->{$name};
#}
#
#sub init_cd {
#    require Time::HiRes;
#
#    my ($self, %args) = @_;
#
#    my $cd = {};
#    $cd->{v} = 2;
#    $cd->{args} = \%args;
#    $cd->{compiler} = $self;
#    $cd->{compiler_name} = $self->name;
#
#    if (my $ocd = $args{outer_cd}) {
#        $cd->{is_inner}       = 1;
#
#        $cd->{outer_cd}     = $ocd;
#        $cd->{indent_level} = $ocd->{indent_level};
#        $cd->{th_map}       = { %{ $ocd->{th_map}  } };
#        $cd->{fsh_map}      = { %{ $ocd->{fsh_map} } };
#        $cd->{default_lang} = $ocd->{default_lang};
#        $cd->{spath}        = [@{ $ocd->{spath} }];
#    } else {
#        $cd->{indent_level} = $cd->{args}{indent_level} // 0;
#        $cd->{th_map}       = {};
#        $cd->{fsh_map}      = {};
#        $cd->{default_lang} = $ENV{LANG} || "en_US";
#        $cd->{default_lang} =~ s/\..+//; 
#        $cd->{spath}        = [];
#    }
#    $cd->{_id} = Time::HiRes::gettimeofday(); 
#    $cd->{ccls} = [];
#
#    $cd;
#}
#
#sub check_compile_args {
#    my ($self, $args) = @_;
#
#    return if $args->{_args_checked}++;
#
#    $args->{data_name} //= 'data';
#    $args->{data_name} =~ /\A[A-Za-z_]\w*\z/ or $self->_die(
#        {}, "Invalid syntax in data_name '$args->{data_name}', ".
#            "please use letters/nums only");
#    $args->{allow_expr} //= 1;
#    $args->{on_unhandled_attr}   //= 'die';
#    $args->{on_unhandled_clause} //= 'die';
#    $args->{skip_clause}         //= [];
#    $args->{mark_missing_translation} //= 1;
#    for ($args->{lang}) {
#        $_ //= $ENV{LANG} || $ENV{LANGUAGE} || "en_US";
#        s/\W.*//; 
#    }
#}
#
#sub _process_clause {
#    use experimental 'smartmatch';
#
#    my ($self, $cd, $clset_num, $clause) = @_;
#
#    my $th = $cd->{th};
#    my $tn = $cd->{type};
#    my $clsets = $cd->{clsets};
#
#    my $clset = $clsets->[$clset_num];
#    local $cd->{spath}       = [@{$cd->{spath}}, $clause];
#    local $cd->{clset}       = $clset;
#    local $cd->{clset_num}   = $clset_num;
#    local $cd->{uclset}      = $cd->{uclsets}[$clset_num];
#    local $cd->{clset_dlang} = $cd->{_clset_dlangs}[$clset_num];
#
#    delete $cd->{uclset}{$clause};
#    delete $cd->{uclset}{"$clause.prio"};
#
#    if ($clause ~~ @{ $cd->{args}{skip_clause} }) {
#        delete $cd->{uclset}{$_}
#            for grep /^\Q$clause\E(\.|\z)/, keys(%{$cd->{uclset}});
#        return;
#    }
#
#    my $meth  = "clause_$clause";
#    my $mmeth = "clausemeta_$clause";
#    unless ($th->can($meth)) {
#        for ($cd->{args}{on_unhandled_clause}) {
#            next if $_ eq 'ignore';
#            do { warn "Can't handle clause $clause"; next }
#                if $_ eq 'warn';
#            $self->_die($cd, "Can't handle clause $clause");
#        }
#    }
#
#
#    my $meta;
#    if ($th->can($mmeth)) {
#        $meta = $th->$mmeth;
#    } else {
#        $meta = {};
#    }
#    local $cd->{cl_meta} = $meta;
#    $self->_die($cd, "Clause $clause doesn't allow expression")
#        if $clset->{"$clause.is_expr"} && !$meta->{allow_expr};
#    for my $a (keys %{ $meta->{attrs} }) {
#        my $av = $meta->{attrs}{$a};
#        $self->_die($cd, "Attribute $clause.$a doesn't allow ".
#                        "expression")
#            if $clset->{"$clause.$a.is_expr"} && !$av->{allow_expr};
#    }
#    local $cd->{clause} = $clause;
#    my $cv = $clset->{$clause};
#    my $ie = $clset->{"$clause.is_expr"};
#    my $op = $clset->{"$clause.op"};
#
#    local $cd->{cl_raw_value}   = $cv;
#
#    local $cd->{cl_value_coerced_from};
#    {
#        last if $ie;
#        my $coerce_type = $meta->{schema}[0] or last;
#        my $value_is_array;
#        if ($coerce_type eq '_same') {
#            $coerce_type = $cd->{type};
#        } elsif ($coerce_type eq '_same_elem') {
#            $coerce_type = $cd->{nschema}[1]{of} //
#                $cd->{nschema}[1]{each_elem} // 'any';
#        } elsif ($clause eq 'between' || $clause eq 'xbetween') { 
#            $coerce_type = $cd->{type};
#            $value_is_array = 1;
#        }
#        my $coercer = $coercer_cache{$coerce_type};
#        if (!$coercer) {
#            require Data::Sah::Coerce;
#            $coercer = Data::Sah::Coerce::gen_coercer(
#                type => $coerce_type,
#                return_type=>'str+val',
#                (coerce_to => $cd->{coerce_to}) x !!$cd->{coerce_to},
#            );
#            $coercer_cache{$coerce_type} = $coercer;
#        }
#        if ($op && ($op eq 'or' || $op eq 'and')) {
#            for my $cv2 (@$cv) {
#                my $cf;
#                if ($value_is_array) {
#                    $cv2 = [@$cv2]; 
#                    for (@$cv2) {
#                        ($cf, $_) = @{ $coercer->($_) };
#                        $cd->{cl_value_coerced_from} //= $cf;
#                    }
#                } else {
#                    ($cf, $cv) = @{ $coercer->($cv) };
#                    $cd->{cl_value_coerced_from} //= $cf;
#                }
#            }
#        } else {
#            if ($value_is_array) {
#                $cv = [@$cv]; 
#                for (@$cv) {
#                    my $cf;
#                    ($cf, $_) = @{ $coercer->($_) };
#                    $cd->{cl_value_coerced_from} //= $cf;
#                }
#            } else {
#                ($cd->{cl_value_coerced_from}, $cv) = @{ $coercer->($cv) };
#            }
#        }
#    }
#
#    local $cd->{cl_value}   = $cv;
#    local $cd->{cl_term}    = $ie ? $self->expr($cv) : $self->literal($cv);
#    local $cd->{cl_is_expr} = $ie;
#    local $cd->{cl_op}      = $op;
#    delete $cd->{uclset}{"$clause.is_expr"};
#    delete $cd->{uclset}{"$clause.op"};
#
#    if ($self->can("before_clause")) {
#        $self->before_clause($cd);
#    }
#    if ($th->can("before_clause")) {
#        $th->before_clause($cd);
#    }
#    my $tmpnam = "before_clause_$clause";
#    if ($th->can($tmpnam)) {
#        $th->$tmpnam($cd);
#    }
#
#    my $is_multi;
#    if (defined($op) && !$ie) {
#        if ($op =~ /\A(and|or|none)\z/) {
#            $is_multi = 1;
#        } elsif ($op eq 'not') {
#            $is_multi = 0;
#        } else {
#            $self->_die($cd, "Invalid value for $clause.op, ".
#                            "must be one of and/or/not/none");
#        }
#    }
#    $self->_die($cd, "'$clause.op' attribute set to $op, ".
#                    "but value of '$clause' clause not an array")
#        if $is_multi && ref($cv) ne 'ARRAY';
#    if (!$th->can($meth)) {
#    } elsif ($cd->{CLAUSE_DO_MULTI} || !$is_multi) {
#        local $cd->{cl_is_multi} = 1 if $is_multi;
#        $th->$meth($cd);
#    } else {
#        my $i = 0;
#        for my $cv2 (@$cv) {
#            local $cd->{spath} = [@{ $cd->{spath} }, $i];
#            local $cd->{cl_value} = $cv2;
#            local $cd->{cl_term}  = $self->literal($cv2);
#            local $cd->{_debug_ccl_note} = "" if $i;
#            $i++;
#            $th->$meth($cd);
#        }
#    }
#
#    $tmpnam = "after_clause_$clause";
#    if ($th->can($tmpnam)) {
#        $th->$tmpnam($cd);
#    }
#    if ($th->can("after_clause")) {
#        $th->after_clause($cd);
#    }
#    if ($self->can("after_clause")) {
#        $self->after_clause($cd);
#    }
#
#    delete $cd->{uclset}{"$clause.err_msg"};
#    delete $cd->{uclset}{"$clause.err_level"};
#    delete $cd->{uclset}{$_} for
#        grep /\A\Q$clause\E\.human(\..+)?\z/, keys(%{$cd->{uclset}});
#}
#
#sub _process_clsets {
#    my ($self, $cd, $which) = @_;
#
#
#    my $th = $cd->{th};
#    my $tn = $cd->{type};
#    my $clsets = $cd->{clsets};
#
#    my $cname = $self->name;
#    local $cd->{uclsets} = [];
#    $cd->{_clset_dlangs} = []; 
#    for my $clset (@$clsets) {
#        for (keys %$clset) {
#            if (!$cd->{args}{allow_expr} && /\.is_expr\z/ && $clset->{$_}) {
#                $self->_die($cd, "Expression not allowed: $_");
#            }
#        }
#        $cd->{coerce_to} //= $clset->{'x.perl.coerce_to'} if $clset->{'x.perl.coerce_to'};
#        push @{ $cd->{uclsets} }, {
#            map {$_=>$clset->{$_}}
#                grep {
#                    !/\A_|\._|\Ax\./ && (!/\Ac\./ || /\Ac\.\Q$cname\E\./)
#                } keys %$clset
#        };
#        my $dl = $clset->{default_lang} //
#            ($cd->{outer_cd} ? $cd->{outer_cd}{clset_dlang} : undef) //
#                "en_US";
#        push @{ $cd->{_clset_dlangs} }, $dl;
#    }
#
#    my $clauses = $self->_get_clauses_from_clsets($cd, $clsets);
#    $cd->{has_constraint_clause} = 0;
#    $cd->{has_subschema} = 0;
#    for my $cl (@$clauses) {
#        next if $cl->[1] =~ /\A(req|forbidden)\z/;
#        $cd->{has_subschema} = 1 if $cl->[2]{subschema};
#        if ($cl->[2]{tags} && grep {$_ eq 'constraint'} @{ $cl->[2]{tags} }) {
#            $cd->{has_constraint_clause} = 1;
#        }
#    }
#
#    if ($which) {
#        if ($self->can("before_clause_sets")) {
#            $self->before_clause_sets($cd);
#        }
#        if ($th->can("before_clause_sets")) {
#            $th->before_clause_sets($cd);
#        }
#    } else {
#        if ($self->can("before_handle_type")) {
#            $self->before_handle_type($cd);
#        }
#
#        $th->handle_type($cd);
#
#        if ($self->can("before_all_clauses")) {
#            $self->before_all_clauses($cd);
#        }
#        if ($th->can("before_all_clauses")) {
#            $th->before_all_clauses($cd);
#        }
#    }
#
#    for my $clause0 (@$clauses) {
#        my ($clset_num, $clause) = @$clause0;
#        $self->_process_clause($cd, $clset_num, $clause);
#    } 
#
#    for my $uclset (@{ $cd->{uclsets} }) {
#        if (keys %$uclset) {
#            for ($cd->{args}{on_unhandled_attr}) {
#                my $msg = "Unhandled attribute(s) for type $tn: ".
#                    join(", ", keys %$uclset);
#                next if $_ eq 'ignore';
#                do { warn $msg; next } if $_ eq 'warn';
#                $self->_die($cd, $msg);
#            }
#        }
#    }
#
#    if ($which) {
#        if ($th->can("after_clause_sets")) {
#            $th->after_clause_sets($cd);
#        }
#        if ($self->can("after_clause_sets")) {
#            $self->after_clause_sets($cd);
#        }
#    } else {
#        if ($th->can("after_all_clauses")) {
#            $th->after_all_clauses($cd);
#        }
#        if ($self->can("after_all_clauses")) {
#            $self->after_all_clauses($cd);
#        }
#    }
#}
#
#sub compile {
#    my ($self, %args) = @_;
#
#    $self->check_compile_args(\%args);
#
#    my $main   = $self->main;
#    my $cd     = $self->init_cd(%args);
#
#    if ($self->can("before_compile")) {
#        $self->before_compile($cd);
#    }
#
#    my $schema0 = $args{schema} or $self->_die($cd, "No schema");
#    my $nschema;
#    if ($args{schema_is_normalized}) {
#        $nschema = $schema0;
#    } else {
#        $nschema = $main->normalize_schema($schema0);
#    }
#    $cd->{nschema} = $nschema;
#    local $cd->{schema} = $nschema;
#
#    {
#        my $defs = $nschema->[2]{def};
#        if ($defs) {
#            for my $name (sort keys %$defs) {
#                my $def = $defs->{$name};
#                my $opt = $name =~ s/[?]\z//;
#                local $cd->{def_optional} = $opt;
#                local $cd->{def_name}     = $name;
#                $self->_die($cd, "Invalid name syntax in def: '$name'")
#                    unless $name =~ $Data::Sah::type_re;
#                local $cd->{def_def}      = $def;
#                $self->def($cd);
#            }
#        }
#    }
#
#    require Data::Sah::Resolve;
#    my $res       = Data::Sah::Resolve::resolve_schema(
#        {
#            schema_is_normalized => 1,
#        }, $nschema);
#    my $tn        = $res->[0];
#    $cd->{th}     = $self->get_th(name=>$tn, cd=>$cd);
#    $cd->{type}   = $tn;
#    $cd->{clsets} = $res->[1];
#    if ($nschema->[0] ne $tn) {
#        $self->add_compile_module($cd, "Sah::Schema::$nschema->[0]");
#    }
#
#    $self->_process_clsets($cd);
#
#    if ($self->can("after_compile")) {
#        $self->after_compile($cd);
#    }
#
#    if ($args{log_result}) {
#        $log->tracef(
#            "Schema compilation result:\n%s",
#            !ref($cd->{result}) && ($ENV{LINENUM} // 1) ?
#                __linenum($cd->{result}) :
#                $cd->{result}
#            );
#    }
#    return $cd;
#}
#
#sub def {
#    my ($self, $cd) = @_;
#    my $name = $cd->{def_name};
#    my $def  = $cd->{def_def};
#    my $opt  = $cd->{def_optional};
#
#    my $th = $self->get_th(cd=>$cd, name=>$name, load=>0);
#    if ($th) {
#        if ($opt) {
#            return;
#        }
#        $self->_die($cd, "Redefining existing type ($name) not allowed");
#    }
#
#    my $nschema = $self->main->normalize_schema($def);
#    $cd->{th_map}{$name} = $nschema;
#}
#
#sub _ignore_clause {
#    my ($self, $cd) = @_;
#    my $cl = $cd->{clause};
#    delete $cd->{uclset}{$cl};
#}
#
#sub _ignore_clause_and_attrs {
#    my ($self, $cd) = @_;
#    my $cl = $cd->{clause};
#    delete $cd->{uclset}{$cl};
#    delete $cd->{uclset}{$_} for grep /\A\Q$cl\E\./, keys %{$cd->{uclset}};
#}
#
#sub _die_unimplemented_clause {
#    my ($self, $cd, $note) = @_;
#
#    $self->_die($cd, "Clause '$cd->{clause}' for type '$cd->{type}' ".
#                    ($note ? "($note) " : "") .
#                        "is currently unimplemented");
#}
#
#sub add_module {
#    my ($self, $cd, $name, $extra_keys, $allow_duplicate) = @_;
#
#    my $found;
#    for (@{ $cd->{modules} }) {
#        if ($_->{name} eq $name && $_->{phase} eq $extra_keys->{phase}) {
#            $found++;
#            last;
#        }
#    }
#    return if $found && !$allow_duplicate;
#    push @{ $cd->{modules} }, {
#        name => $name,
#        %{ $extra_keys // {} },
#    };
#}
#
#sub add_runtime_module {
#    my ($self, $cd, $name, $extra_keys, $allow_duplicate) = @_;
#
#    if ($extra_keys) {
#        $extra_keys = { %$extra_keys, phase => 'runtime' };
#    } else {
#        $extra_keys = { phase => 'runtime' };
#    }
#    $self->add_module($cd, $name, $extra_keys, $allow_duplicate);
#}
#
#sub add_compile_module {
#    my ($self, $cd, $name, $extra_keys, $allow_duplicate) = @_;
#
#    if ($extra_keys) {
#        $extra_keys = { %$extra_keys, phase => 'compile' };
#    } else {
#        $extra_keys = { phase => 'compile' };
#    }
#    $self->add_module($cd, $name, $extra_keys, $allow_duplicate);
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/Prog.pm ###
#package Data::Sah::Compiler::Prog;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#use Log::Any::IfLOG qw($log);
#
#use Mo qw(build default);
#extends 'Data::Sah::Compiler';
#
#
#has hc => (is => 'rw');
#
#has comment_style => (is => 'rw');
#
#has var_sigil => (is => 'rw');
#
#has concat_op => (is => 'rw');
#
#has logical_and_op => (is => 'rw', default => sub {'&&'});
#
#has logical_not_op => (is => 'rw', default => sub {'!'});
#
#
#sub init_cd {
#    my ($self, %args) = @_;
#
#    my $cd = $self->SUPER::init_cd(%args);
#    $cd->{vars} = {};
#
#    my $hc = $self->hc;
#    if (!$hc) {
#        $hc = $self->main->get_compiler("human");
#        $self->hc($hc);
#    }
#
#    if (my $ocd = $cd->{outer_cd}) {
#        $cd->{vars}    = $ocd->{vars};
#        $cd->{modules} = $ocd->{modules};
#        $cd->{_hc}     = $ocd->{_hc};
#        $cd->{_hcd}    = $ocd->{_hcd};
#        $cd->{_subdata_level} = $ocd->{_subdata_level};
#        $cd->{use_dpath} = 1 if $ocd->{use_dpath};
#    } else {
#        $cd->{vars}    = {};
#        $cd->{modules} = [];
#        $cd->{_hc}     = $hc;
#        $cd->{_subdata_level} = 0;
#    }
#
#    $cd;
#}
#
#sub check_compile_args {
#    my ($self, $args) = @_;
#
#    return if $args->{_args_checked_Prog}++;
#
#    $self->SUPER::check_compile_args($args);
#
#    my $ct = ($args->{code_type} //= 'validator');
#    if ($ct ne 'validator') {
#        $self->_die({}, "code_type currently can only be 'validator'");
#    }
#    my $rt = ($args->{return_type} //= 'bool');
#    if ($rt !~ /\A(bool\+val|bool|str\+val|str|full)\z/) {
#        $self->_die({}, "Invalid value for return_type, ".
#                        "use bool|bool+val|str|str+val|full");
#    }
#    $args->{var_prefix} //= "_sahv_";
#    $args->{sub_prefix} //= "_sahs_";
#    $args->{data_term}  //= $self->var_sigil . $args->{data_name};
#    $args->{data_term_is_lvalue} //= 1;
#    $args->{tmp_data_name} //= "tmp_$args->{data_name}";
#    $args->{tmp_data_term} //= $self->var_sigil . $args->{tmp_data_name};
#    $args->{comment}    //= 1;
#    $args->{err_term}   //= $self->var_sigil . "err_$args->{data_name}";
#    $args->{coerce}     //= 1;
#}
#
#sub comment {
#    my ($self, $cd, @args) = @_;
#    return '' unless $cd->{args}{comment};
#
#    my $content = join("", @args);
#    $content =~ s/\n+/ /g;
#
#    my $style = $self->comment_style;
#    if ($style eq 'shell') {
#        return join("", "# ", $content, "\n");
#    } elsif ($style eq 'shell2') {
#        return join("", "## ", $content, "\n");
#    } elsif ($style eq 'cpp') {
#        return join("", "// ", $content, "\n");
#    } elsif ($style eq 'c') {
#        return join("", "/* ", $content, '*/');
#    } elsif ($style eq 'ini') {
#        return join("", "; ", $content, "\n");
#    } else {
#        $self->_die($cd, "BUG: Unknown comment style: $style");
#    }
#}
#
#sub enclose_paren {
#    my ($self, $expr, $force) = @_;
#    if ($expr =~ /\A(\s*)(\(.+\)\s*)\z/os) {
#        return $expr if !$force;
#        return "$1($2)";
#    } else {
#        $expr =~ /\A(\s*)(.*)/os;
#        return "$1($2)";
#    }
#}
#
#sub add_var {
#    my ($self, $cd, $name, $value) = @_;
#
#    return if exists $cd->{vars}{$name};
#    $cd->{vars}{$name} = $value;
#}
#
#
#sub expr_assign {
#    my ($self, $v, $t) = @_;
#    "$v = $t";
#}
#
#sub _xlt {
#    my ($self, $cd, $text) = @_;
#
#    my $hc  = $cd->{_hc};
#    my $hcd = $cd->{_hcd};
#    $hc->_xlt($hcd, $text);
#}
#
#sub expr_concat {
#    my ($self, @t) = @_;
#    join(" " . $self->concat_op . " ", @t);
#}
#
#sub expr_var {
#    my ($self, $v) = @_;
#    $self->var_sigil. $v;
#}
#
#sub expr_preinc {
#    my ($self, $t) = @_;
#    "++$t";
#}
#
#sub expr_preinc_var {
#    my ($self, $v) = @_;
#    "++" . $self->var_sigil. $v;
#}
#
#
#sub expr_validator_sub {
#    my ($self, %args) = @_;
#
#    my $log_result = delete $args{log_result};
#    my $dt         = $args{data_term};
#    my $vt         = delete($args{var_term}) // $dt;
#    my $do_log     = $args{debug_log} // $args{debug};
#    my $rt         = $args{return_type} // 'bool';
#
#    $args{indent_level} = 1;
#
#    my $cd = $self->compile(%args);
#    my $et = $cd->{args}{err_term};
#
#    if ($rt !~ /\Abool/) {
#        my ($ev) = $et =~ /(\w+)/; 
#        $self->add_var($cd, $ev, $rt =~ /\Astr/ ? undef : {});
#    }
#    my $resv = '_sahv_res';
#    my $rest = $self->var_sigil . $resv;
#
#    my $needs_expr_block = (grep {$_->{phase} eq 'runtime'} @{ $cd->{modules} })
#                                || $do_log;
#
#    my $code = join(
#        "",
#        ($self->stmt_require_log_module."\n") x !!$do_log,
#        (map { $self->stmt_require_module($_)."\n" }
#             grep { $_->{phase} eq 'runtime' } @{ $cd->{modules} }),
#        $self->expr_anon_sub(
#            [$vt],
#            join(
#                "",
#                (map {$self->stmt_declare_local_var(
#                    $_, $self->literal($cd->{vars}{$_}))."\n"}
#                     sort keys %{ $cd->{vars} }),
#                $self->stmt_declare_local_var($resv, "\n\n" . $cd->{result})."\n\n",
#
#                ($self->stmt_return($rest)."\n")
#                    x !!($rt eq 'bool'),
#
#                ($self->expr_set_err_str($et, $self->literal('')).";",
#                 "\n\n".$self->stmt_return($et)."\n")
#                    x !!($rt eq 'str'),
#
#                ($self->stmt_return($self->expr_array($rest, $dt))."\n")
#                    x !!($rt eq 'bool+val'),
#
#                ($self->expr_set_err_str($et, $self->literal('')).";",
#                 "\n\n".$self->stmt_return($self->expr_array($et, $dt))."\n")
#                    x !!($rt eq 'str+val'),
#
#                ($self->stmt_assign_hash_value($et, $self->literal('value'), $dt),
#                 "\n".$self->stmt_return($et)."\n")
#                    x !!($rt eq 'full'),
#            )
#        ),
#    );
#
#    if ($needs_expr_block) {
#        $code = $self->expr_block($code);
#    }
#
#    if ($log_result && $log->is_trace) {
#        $log->tracef("validator code:\n%s",
#                     ($ENV{LINENUM} // 1) ?
#                         Data::Sah::Compiler::__linenum($code) :
#                           $code);
#    }
#
#    $code;
#}
#
#sub add_ccl {
#    my ($self, $cd, $ccl, $opts) = @_;
#    $opts //= {};
#    my $clause = $cd->{clause} // "";
#    my $op     = $cd->{cl_op} // "";
#
#    my $el = $opts->{err_level} // $cd->{clset}{"$clause.err_level"} // "error";
#    my $err_expr = $opts->{err_expr};
#    my $err_msg  = $opts->{err_msg};
#
#    if (defined $err_expr) {
#        $self->add_var($cd, '_sahv_dpath', []) if $cd->{use_dpath};
#        $err_expr = $self->expr_prefix_dpath($err_expr) if $cd->{use_dpath};
#    } else {
#        unless (defined $err_msg) { $err_msg = $cd->{clset}{"$clause.err_msg"} }
#        unless (defined $err_msg) {
#
#            my @msgpath = @{$cd->{spath}};
#            my $msgpath;
#            my $hc  = $cd->{_hc};
#            my $hcd = $cd->{_hcd};
#            while (1) {
#                last unless @msgpath;
#                $msgpath = join("/", @msgpath);
#                my $ccls = $hcd->{result}{$msgpath};
#                pop @msgpath;
#                if ($ccls) {
#                    local $hcd->{args}{format} = 'inline_err_text';
#                    $err_msg = $hc->format_ccls($hcd, $ccls);
#                    $err_msg = "(msgpath=$msgpath) $err_msg"
#                        if $cd->{args}{debug};
#                    last;
#                }
#            }
#            if (!$err_msg) {
#                $err_msg = "ERR (clause=".($cd->{clause} // "").")";
#            } else {
#                $err_msg = ucfirst($err_msg);
#            }
#        }
#        if ($err_msg) {
#            $self->add_var($cd, '_sahv_dpath', []) if $cd->{use_dpath};
#            $err_expr = $self->literal($err_msg);
#            $err_expr = $self->expr_prefix_dpath($err_expr) if $cd->{use_dpath};
#        }
#    }
#
#    my $rt = $cd->{args}{return_type};
#    my $et = $cd->{args}{err_term};
#    my $err_code;
#    if ($rt eq 'full') {
#        $self->add_var($cd, '_sahv_dpath', []) if $cd->{use_dpath};
#        my $k = $el eq 'warn' ? 'warnings' : 'errors';
#        $err_code = $self->expr_set_err_full($et, $k, $err_expr) if $err_expr;
#    } elsif ($rt =~ /\Astr/) {
#        if ($el ne 'warn') {
#            $err_code = $self->expr_set_err_str($et, $err_expr) if $err_expr;
#        }
#    }
#
#    my $res = {
#        ccl             => $ccl,
#        err_level       => $el,
#        err_code        => $err_code,
#        (_debug_ccl_note => $cd->{_debug_ccl_note}) x !!$cd->{_debug_ccl_note},
#        subdata         => $opts->{subdata},
#    };
#    push @{ $cd->{ccls} }, $res;
#    delete $cd->{uclset}{"$clause.err_level"};
#    delete $cd->{uclset}{"$clause.err_msg"};
#}
#
#sub join_ccls {
#    my ($self, $cd, $ccls, $opts) = @_;
#    $opts //= {};
#    my $op = $opts->{op} // "and";
#
#    my ($min_ok, $max_ok, $min_nok, $max_nok);
#    if ($op eq 'and') {
#        $max_nok = 0;
#    } elsif ($op eq 'or') {
#        $min_ok = 1;
#    } elsif ($op eq 'none') {
#        $max_ok = 0;
#    } elsif ($op eq 'not') {
#
#    }
#    my $dmin_ok  = defined($min_ok);
#    my $dmax_ok  = defined($max_ok);
#    my $dmin_nok = defined($min_nok);
#    my $dmax_nok = defined($max_nok);
#
#    return "" unless @$ccls;
#
#    my $rt      = $cd->{args}{return_type};
#    my $vp      = $cd->{args}{var_prefix};
#
#    my $aop = $self->logical_and_op;
#    my $nop = $self->logical_not_op;
#
#    my $true = $self->true;
#
#    my $_ice = sub {
#        my ($ccl, $which) = @_;
#
#        return $self->enclose_paren($ccl->{ccl}) if $ccl->{assert};
#
#        my $res = "";
#
#        if ($ccl->{_debug_ccl_note}) {
#            if ($cd->{args}{debug_log} // $cd->{args}{debug}) {
#                $res .= $self->expr_log(
#                    $cd, $self->literal($ccl->{_debug_ccl_note})) . " $aop\n";
#            } else {
#                $res .= $self->comment($cd, $ccl->{_debug_ccl_note});
#            }
#        }
#
#        $which //= 0;
#        my $cc = ($which == 1 ? $nop:"") . $self->enclose_paren($ccl->{ccl});
#        my ($ec, $oec);
#        my ($ret, $oret);
#        if ($which >= 2) {
#            my @chk;
#            if ($ccl->{err_level} eq 'warn') {
#                $oret = 1;
#                $ret  = 1;
#            } elsif ($ccl->{err_level} eq 'fatal') {
#                $oret = 1;
#                $ret  = 0;
#            } else {
#                $oret = $self->expr_preinc_var("${vp}ok");
#                $ret  = $self->expr_preinc_var("${vp}nok");
#                push @chk, $self->expr_var("${vp}ok"). " <= $max_ok"
#                    if $dmax_ok;
#                push @chk, $self->expr_var("${vp}nok")." <= $max_nok"
#                    if $dmax_nok;
#                if ($which == 3) {
#                    push @chk, $self->expr_var("${vp}ok"). " >= $min_ok"
#                        if $dmin_ok;
#                    push @chk, $self->expr_var("${vp}nok")." >= $min_nok"
#                        if $dmin_nok;
#
#                    if ($rt !~ /\Abool/) {
#                        my $et = $cd->{args}{err_term};
#                        my $clerrc;
#                        if ($rt eq 'full') {
#                            $clerrc = $self->expr_reset_err_full($et);
#                        } else {
#                            $clerrc = $self->expr_reset_err_str($et);
#                        }
#                        push @chk, $clerrc;
#                    }
#                }
#            }
#            $res .= "($cc ? $oret : $ret)";
#            $res .= " $aop " . join(" $aop ", @chk) if @chk;
#        } else {
#            $ec = $ccl->{err_code};
#            $ret =
#                $ccl->{err_level} eq 'fatal' ? 0 :
#                        $ccl->{err_level} eq 'warn' ? 1 : 0;
#            if ($rt =~ /\Abool/ && $ret) {
#                $res .= $true;
#            } elsif ($rt =~ /\Abool/ || !$ec) {
#                $res .= $self->enclose_paren($cc);
#            } else {
#                $res .= $self->enclose_paren(
#                    $self->enclose_paren($cc). " ? $true : ($ec,$ret)",
#                    "force");
#            }
#        }
#
#        $res = $self->expr_push_and_pop_dpath_between_expr($res)
#            if $cd->{use_dpath} && $ccl->{subdata};
#        $res;
#
#    };
#
#    my $j = "\n\n$aop\n\n";
#    if ($op eq 'not') {
#        return $_ice->($ccls->[0], 1);
#    } elsif ($op eq 'and') {
#        return join $j, map { $_ice->($_) } @$ccls;
#    } elsif ($op eq 'none') {
#        return join $j, map { $_ice->($_, 1) } @$ccls;
#    } else {
#        my $jccl = join $j, map {$_ice->($ccls->[$_], $_ == @$ccls-1 ? 3:2)}
#            0..@$ccls-1;
#        {
#            local $cd->{ccls} = [];
#            local $cd->{_debug_ccl_note} = "op=$op";
#            $self->add_ccl(
#                $cd,
#                $self->expr_block(
#                    join(
#                        "",
#                        $self->stmt_declare_local_var("${vp}ok" , "0"), "\n",
#                        $self->stmt_declare_local_var("${vp}nok", "0"), "\n",
#                        "\n",
#                        $self->block_uses_sub ?
#                            $self->stmt_return($jccl) : $jccl,
#                    )
#                ),
#            );
#            $_ice->($cd->{ccls}[0]);
#        }
#    }
#}
#
#sub before_compile {
#    my ($self, $cd) = @_;
#
#    if ($cd->{args}{data_term_is_lvalue}) {
#        $cd->{data_term} = $cd->{args}{data_term};
#    } else {
#        my $v = $cd->{args}{var_prefix} . $cd->{args}{data_name};
#        push @{ $cd->{vars} }, $v; 
#        $cd->{data_term} = $self->var_sigil . $v;
#        die "BUG: support for non-perl compiler not yet added here"
#            unless $cd->{compiler_name} eq 'perl';
#        push @{ $cd->{ccls} }, ["(local($cd->{data_term} = $cd->{args}{data_term}), 1)"];
#    }
#}
#
#sub before_handle_type {
#    my ($self, $cd) = @_;
#
#
#    unless ($cd->{is_inner}) {
#        my $hc = $cd->{_hc};
#        my %hargs = %{$cd->{args}};
#        $hargs{format}               = 'msg_catalog';
#        $hargs{schema_is_normalized} = 1;
#        $hargs{schema}               = $cd->{nschema};
#        $hargs{on_unhandled_clause}  = 'ignore';
#        $hargs{on_unhandled_attr}    = 'ignore';
#        $hargs{hash_values}          = $cd->{args}{human_hash_values};
#        $cd->{_hcd} = $hc->compile(%hargs);
#    }
#}
#
#sub before_all_clauses {
#    my ($self, $cd) = @_;
#
#    $cd->{use_dpath} //= (
#        $cd->{args}{return_type} =~ /\Afull/ ||
#        ($cd->{args}{return_type} =~ /\Astr/ && $cd->{has_subschema})
#    );
#
#
#    my $c      = $cd->{compiler};
#    my $cname  = $c->name;
#    my $dt     = $cd->{data_term};
#    my $clsets = $cd->{clsets};
#
#    for my $i (0..@$clsets-1) {
#        my $clset  = $clsets->[$i];
#        next unless exists $clset->{ok};
#        my $op = $clset->{"ok.op"} // "";
#        if ($op && $op ne 'not') {
#            $self->_die($cd, "ok can only be combined with .op=not");
#        }
#        if ($op eq 'not') {
#            local $cd->{_debug_ccl_note} = "!ok #$i";
#            $self->add_ccl($cd, $self->false);
#        } else {
#            local $cd->{_debug_ccl_note} = "ok #$i";
#            $self->add_ccl($cd, $self->true);
#        }
#        delete $cd->{uclsets}[$i]{"ok"};
#        delete $cd->{uclsets}[$i]{"ok.is_expr"};
#    }
#
#    for my $i (0..@$clsets-1) {
#        my $clset  = $clsets->[$i];
#        my $def    = $clset->{default};
#        my $defie  = $clset->{"default.is_expr"};
#        if (defined $def) {
#            local $cd->{_debug_ccl_note} = "default #$i";
#            my $ct = $defie ?
#                $self->expr($def) : $self->literal($def);
#            $self->add_ccl(
#                $cd,
#                "(".$self->expr_setif($dt, $ct).", ".$self->true.")",
#                {err_msg => ""},
#            );
#        }
#        delete $cd->{uclsets}[$i]{"default"};
#        delete $cd->{uclsets}[$i]{"default.is_expr"};
#    }
#
#    my $has_req;
#    for my $i (0..@$clsets-1) {
#        my $clset  = $clsets->[$i];
#        my $req    = $clset->{req};
#        my $reqie  = $clset->{"req.is_expr"};
#        my $req_err_msg = $self->_xlt($cd, "Required but not specified");
#        local $cd->{_debug_ccl_note} = "req #$i";
#        if ($req && !$reqie) {
#            $has_req++;
#            $self->add_ccl(
#                $cd, $self->expr_defined($dt),
#                {
#                    err_msg   => $req_err_msg,
#                    err_level => 'fatal',
#                },
#            );
#        } elsif ($reqie) {
#            $has_req++;
#            my $ct = $self->expr($req);
#            $self->add_ccl(
#                $cd, "!($ct) || ".$self->expr_defined($dt),
#                {
#                    err_msg   => $req_err_msg,
#                    err_level => 'fatal',
#                },
#            );
#        }
#        delete $cd->{uclsets}[$i]{"req"};
#        delete $cd->{uclsets}[$i]{"req.is_expr"};
#    }
#
#    my $has_fbd;
#    for my $i (0..@$clsets-1) {
#        my $clset  = $clsets->[$i];
#        my $fbd    = $clset->{forbidden};
#        my $fbdie  = $clset->{"forbidden.is_expr"};
#        my $fbd_err_msg = $self->_xlt($cd, "Forbidden but specified");
#        local $cd->{_debug_ccl_note} = "forbidden #$i";
#        if ($fbd && !$fbdie) {
#            $has_fbd++;
#            $self->add_ccl(
#                $cd, "!".$self->expr_defined($dt),
#                {
#                    err_msg   => $fbd_err_msg,
#                    err_level => 'fatal',
#                },
#            );
#        } elsif ($fbdie) {
#            $has_fbd++;
#            my $ct = $self->expr($fbd);
#            $self->add_ccl(
#                $cd, "!($ct) || !".$self->expr_defined($dt),
#                {
#                    err_msg   => $fbd_err_msg,
#                    err_level => 'fatal',
#                },
#            );
#        }
#        delete $cd->{uclsets}[$i]{"forbidden"};
#        delete $cd->{uclsets}[$i]{"forbidden.is_expr"};
#    }
#
#    if (!$has_req && !$has_fbd) {
#        $cd->{_skip_undef} = 1;
#        $cd->{_ccls_idx1} = @{$cd->{ccls}};
#    }
#
#    my $coerce_expr;
#    my $coerce_might_die;
#    my $coerce_ccl_note;
#  GEN_COERCE_EXPR:
#    {
#        last unless $cd->{args}{coerce};
#
#        use experimental 'smartmatch';
#        require Data::Sah::CoerceCommon;
#
#        my @coerce_rules;
#        for my $i (0..@$clsets-1) {
#            my $clset = $clsets->[$i];
#            push @coerce_rules,
#                @{ $clset->{"x.$cname.coerce_rules"} // [] },
#                @{ $clset->{'x.coerce_rules'} // [] };
#        }
#
#        my $rules = Data::Sah::CoerceCommon::get_coerce_rules(
#            compiler => $self->name,
#            type => $cd->{type},
#            data_term => $dt,
#            coerce_to => $cd->{coerce_to},
#            coerce_rules => \@coerce_rules,
#        );
#        last unless @$rules;
#
#        for my $i (reverse 0..$#{$rules}) {
#            my $rule = $rules->[$i];
#
#            $self->add_compile_module(
#                $cd, "Data::Sah::Coerce::$cname\::$cd->{type}::$rule->{name}",
#                {category => 'coerce'},
#            );
#
#            if ($rule->{modules}) {
#                for (keys %{ $rule->{modules} }) {
#                    $self->add_runtime_module($cd, $_, {category=>'coerce'});
#                }
#            }
#
#            if ($i == $#{$rules}) {
#                $coerce_expr = $self->expr_ternary(
#                    "($rule->{expr_match})",
#                    "($rule->{expr_coerce})",
#                    $dt,
#                );
#            } else {
#                $coerce_expr = $self->expr_ternary(
#                    "($rule->{expr_match})",
#                    "($rule->{expr_coerce})",
#                    "($coerce_expr)",
#                );
#            }
#            $coerce_might_die = 1 if $rule->{meta}{might_die};
#        }
#        $coerce_ccl_note = "coerce from: ".
#            join(", ", map {$_->{name}} @$rules) .
#            ($cd->{coerce_to} ? " # coerce to: $cd->{coerce_to}" : "");
#    } 
#
#  HANDLE_TYPE_CHECK:
#    {
#        $self->_die($cd, "BUG: type handler did not produce _ccl_check_type")
#            unless defined($cd->{_ccl_check_type});
#        local $cd->{_debug_ccl_note};
#
#
#        if ($coerce_expr) {
#            $cd->{_debug_ccl_note} = $coerce_ccl_note;
#            if ($coerce_might_die) {
#                $self->add_ccl(
#                    $cd,
#                    $self->expr_eval($self->expr_set($dt, $coerce_expr)),
#                    {
#                        err_msg => "Cannot coerce data to $cd->{type}", 
#                    },
#                );
#            } else {
#                $self->add_ccl(
#                    $cd,
#                    "(".$self->expr_set($dt, $coerce_expr).", ".$self->true.")",
#                    {
#                        err_msg => "",
#                    },
#                );
#            }
#        }
#
#        $cd->{_debug_ccl_note} = "check type '$cd->{type}'";
#        $self->add_ccl(
#            $cd, $cd->{_ccl_check_type},
#            {
#                err_msg   => sprintf(
#                    $self->_xlt($cd, "Not of type %s"),
#                    $self->_xlt(
#                        $cd,
#                        $cd->{_hc}->get_th(name=>$cd->{type})->name //
#                            $cd->{type}
#                        ),
#                ),
#                err_level => 'fatal',
#            },
#        );
#    }
#}
#
#sub before_clause {
#    my ($self, $cd) = @_;
#
#    $self->_die($cd, "Sorry, .op + .is_expr not yet supported ".
#                    "(found in clause $cd->{clause})")
#        if $cd->{cl_is_expr} && $cd->{cl_op};
#
#    if ($cd->{args}{debug}) {
#        state $json = do {
#            require JSON;
#            JSON->new->allow_nonref;
#        };
#        my $clset = $cd->{clset};
#        my $cl    = $cd->{clause};
#        my $res   = $json->encode({
#            map { $_ => $clset->{$_}}
#                grep {/\A\Q$cl\E(?:\.|\z)/}
#                    keys %$clset });
#        $res =~ s/\n+/ /g;
#        $cd->{_debug_ccl_note} = "clause: $res";
#    } else {
#        $cd->{_debug_ccl_note} = "clause: $cd->{clause}";
#    }
#
#
#    push @{ $cd->{_save_ccls} }, $cd->{ccls};
#    $cd->{ccls} = [];
#}
#
#sub after_clause {
#    my ($self, $cd) = @_;
#
#    if ($cd->{args}{debug}) {
#        delete $cd->{_debug_ccl_note};
#    }
#
#    my $save = pop @{ $cd->{_save_ccls} };
#    if (@{ $cd->{ccls} }) {
#        push @$save, {
#            ccl       => $self->join_ccls($cd, $cd->{ccls}, {op=>$cd->{cl_op}}),
#            err_level => $cd->{clset}{"$cd->{clause}.err_level"} // "error",
#        }
#    }
#    $cd->{ccls} = $save;
#}
#
#sub after_clause_sets {
#    my ($self, $cd) = @_;
#
#    $cd->{result} = $self->indent(
#        $cd,
#        $self->join_ccls($cd, $cd->{ccls}, {err_msg => ''}),
#    );
#}
#
#sub after_all_clauses {
#    my ($self, $cd) = @_;
#
#
#    if (delete $cd->{_skip_undef}) {
#        my $jccl = $self->join_ccls(
#            $cd,
#            [splice(@{ $cd->{ccls} }, $cd->{_ccls_idx1})],
#        );
#        local $cd->{_debug_ccl_note} = "skip if undef";
#        $self->add_ccl(
#            $cd,
#            "!".$self->expr_defined($cd->{data_term})." ? ".$self->true." : \n\n".
#                $self->enclose_paren($jccl),
#            {err_msg => ''},
#        );
#    }
#
#    $cd->{result} = $self->indent(
#        $cd,
#        $self->join_ccls($cd, $cd->{ccls}, {err_msg => ''}),
#    );
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/Prog/TH.pm ###
#package Data::Sah::Compiler::Prog::TH;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#
#extends 'Data::Sah::Compiler::TH';
#
#
#sub clause_default {}
#sub clause_ok {}
#sub clause_req {}
#sub clause_forbidden {}
#sub clause_prefilters {}
#
#
#
#sub clause_name {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause_and_attrs($cd);
#}
#
#sub clause_summary {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause_and_attrs($cd);
#}
#
#sub clause_description {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause_and_attrs($cd);
#}
#
#sub clause_comment {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_tags {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_defhash_v {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_v {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub set_tmp_data_term {
#    my ($self, $cd, $expr) = @_;
#    my $c = $self->compiler;
#
#    $expr //= $cd->{data_term};
#
#    my $tdn = $cd->{args}{tmp_data_name};
#    my $tdt = $cd->{args}{tmp_data_term};
#    my $t = $c->expr_array_subscript($tdt, $cd->{_subdata_level});
#    unless ($cd->{_save_data_term}) {
#        $c->add_var($cd, $tdn, []);
#        $cd->{_save_data_term} = $cd->{data_term};
#        $cd->{data_term} = $t;
#    }
#    local $cd->{_debug_ccl_note} = 'set temporary data term';
#    $c->add_ccl($cd, "(".$c->expr_assign($t, $expr). ", ".$c->true.")",
#                {err_msg => ''});
#}
#
#sub restore_data_term {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $tdt = $cd->{args}{tmp_data_term};
#    if ($cd->{_save_data_term}) {
#        $cd->{data_term} = delete($cd->{_save_data_term});
#        local $cd->{_debug_ccl_note} = 'restore original data term';
#        $c->add_ccl($cd, "(".$c->expr_pop($tdt). ", ".$c->true.")",
#                    {err_msg => ''});
#    }
#}
#
#sub gen_any_or_all_of {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $dt = $cd->{data_term};
#
#    my $jccl;
#    {
#        local $cd->{ccls} = [];
#        for my $i (0..@$cv-1) {
#            local $cd->{spath} = [@{ $cd->{spath} }, $i];
#            my $sch  = $cv->[$i];
#            my %iargs = %{$cd->{args}};
#            $iargs{outer_cd}             = $cd;
#            $iargs{schema}               = $sch;
#            $iargs{schema_is_normalized} = 0;
#            $iargs{indent_level}++;
#            my $icd  = $c->compile(%iargs);
#            my @code = (
#                $icd->{result},
#            );
#            $c->add_ccl($cd, join("", @code));
#        }
#        if ($which eq 'all') {
#            $jccl = $c->join_ccls(
#                $cd, $cd->{ccls}, {err_msg=>''});
#        } else {
#            $jccl = $c->join_ccls(
#                $cd, $cd->{ccls}, {err_msg=>'', op=>'or'});
#        }
#    }
#    $c->add_ccl($cd, $jccl);
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/Prog/TH/all.pm ###
#package Data::Sah::Compiler::Prog::TH::all;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::Prog::TH';
#with 'Data::Sah::Type::all';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = $c->true;
#}
#
#sub clause_of {
#    my ($self, $cd) = @_;
#    $self->gen_any_or_all_of("all", $cd);
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/Prog/TH/any.pm ###
#package Data::Sah::Compiler::Prog::TH::any;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::Prog::TH';
#with 'Data::Sah::Type::any';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = $c->true;
#}
#
#sub clause_of {
#    my ($self, $cd) = @_;
#    $self->gen_any_or_all_of("any", $cd);
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/TH.pm ###
#package Data::Sah::Compiler::TH;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#use Mo qw(build default);
#
#has compiler => (is => 'rw');
#
#sub clause_v {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_defhash_v {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_schema_v {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_base_v {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_default_lang {
#    my ($self, $cd) = @_;
#    $self->compiler->_ignore_clause($cd);
#}
#
#sub clause_clause {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my ($clause, $clv) = @$cv;
#    my $meth   = "clause_$clause";
#    my $mmeth  = "clausemeta_$clause";
#
#    my $clsets = [{$clause => $clv}];
#    local $cd->{clsets} = $clsets;
#
#    $c->_process_clause($cd, 0, $clause);
#}
#
#
#sub clause_clset {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    local $cd->{clsets} = [$cv];
#    $c->_process_clsets($cd, 'from clause_clset');
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/TextResultRole.pm ###
#package Data::Sah::Compiler::TextResultRole;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(default);
#use Role::Tiny;
#
#has indent_character => (is => 'rw', default => sub {''});
#
#sub add_result {
#    my ($self, $cd, @args) = @_;
#
#    $cd->{result} //= [];
#    push @{ $cd->{result} }, $self->indent($cd, join("", @args));
#    $self;
#}
#
#sub _indent {
#    my ($indent, $str, $opts) = @_;
#    $opts //= {};
#
#    my $ibl = $opts->{indent_blank_lines} // 1;
#    my $fli = $opts->{first_line_indent} // $indent;
#    my $sli = $opts->{subsequent_lines_indent} // $indent;
#
#    my $i = 0;
#    $str =~ s/^([^\r\n]?)/$i++; !$ibl && !$1 ? "$1" : $i==1 ? "$fli$1" : "$sli$1"/egm;
#    $str;
#}
#
#sub indent {
#    my ($self, $cd, $str) = @_;
#    _indent(
#        $self->indent_character x $cd->{indent_level},
#        $str,
#    );
#}
#
#sub inc_indent {
#    my ($self, $cd) = @_;
#    $cd->{indent_level}++;
#}
#
#sub dec_indent {
#    my ($self, $cd) = @_;
#    $cd->{indent_level}--;
#}
#
#sub indent_str {
#    my ($self, $cd) = @_;
#    $self->indent_character x $cd->{indent_level};
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human.pm ###
#package Data::Sah::Compiler::human;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Data::Dmp qw(dmp);
#use Mo qw(build default);
#use POSIX qw(locale_h);
#use Text::sprintfn;
#
#extends 'Data::Sah::Compiler';
#
#our %typex; 
#
#sub name { "human" }
#
#sub _add_msg_catalog {
#    my ($self, $cd, $msg) = @_;
#    return unless $cd->{args}{format} eq 'msg_catalog';
#
#    my $spath = join("/", @{ $cd->{spath} });
#    $cd->{_msg_catalog}{$spath} = $msg;
#}
#
#sub check_compile_args {
#    use experimental 'smartmatch';
#
#    my ($self, $args) = @_;
#
#    $self->SUPER::check_compile_args($args);
#
#    my @fmts = ('inline_text', 'inline_err_text', 'markdown', 'msg_catalog');
#    $args->{format} //= $fmts[0];
#    unless ($args->{format} ~~ @fmts) {
#        $self->_die({}, "Unsupported format, use one of: ".join(", ", @fmts));
#    }
#}
#
#sub init_cd {
#    my ($self, %args) = @_;
#
#    my $cd = $self->SUPER::init_cd(%args);
#    if (($cd->{args}{format} // '') eq 'msg_catalog') {
#        $cd->{_msg_catalog} //= $cd->{outer_cd}{_msg_catalog};
#        $cd->{_msg_catalog} //= {};
#    }
#    $cd;
#}
#
#sub expr {
#    my ($self, $cd, $expr) = @_;
#
#
#    $expr;
#}
#
#sub literal {
#    my ($self, $val) = @_;
#
#    return $val unless ref($val);
#    dmp($val);
#}
#
#sub _xlt {
#    my ($self, $cd, $text) = @_;
#
#    my $lang = $cd->{args}{lang};
#
#
#    return $text if $lang eq 'en_US';
#    my $translations;
#    {
#        no strict 'refs';
#        $translations = \%{"Data::Sah::Lang::$lang\::translations"};
#    }
#    return $translations->{$text} if defined($translations->{$text});
#    if ($cd->{args}{mark_missing_translation}) {
#        return "(no $lang text:$text)";
#    } else {
#        return $text;
#    }
#}
#
#sub _ordinate {
#    my ($self, $cd, $n, $noun) = @_;
#
#    my $lang = $cd->{args}{lang};
#
#
#    if ($lang eq 'en_US') {
#        require Lingua::EN::Numbers::Ordinate;
#        return Lingua::EN::Numbers::Ordinate::ordinate($n) . " $noun";
#    } else {
#        no strict 'refs';
#        return "Data::Sah::Lang::$lang\::ordinate"->($n, $noun);
#    }
#}
#
#sub _add_ccl {
#    use experimental 'smartmatch';
#
#    my ($self, $cd, $ccl) = @_;
#
#    $ccl->{xlt} //= 1;
#
#    my $clause = $cd->{clause} // "";
#    $ccl->{type} //= "clause";
#
#    my $do_xlt = 1;
#
#    my $hvals = {
#        modal_verb     => $self->_xlt($cd, "must"),
#        modal_verb_neg => $self->_xlt($cd, "must not"),
#
#        field          => $self->_xlt($cd, "field"),
#        fields         => $self->_xlt($cd, "fields"),
#
#        %{ $cd->{args}{hash_values} // {} },
#    };
#    my $mod="";
#
#
#    {
#        my $lang   = $cd->{args}{lang};
#        my $dlang  = $cd->{clset_dlang} // "en_US"; 
#        my $suffix = $lang eq $dlang ? "" : ".alt.lang.$lang";
#        if ($clause) {
#            delete $cd->{uclset}{$_} for
#                grep /\A\Q$clause.human\E(\.|\z)/, keys %{$cd->{uclset}};
#            if (defined $cd->{clset}{"$clause.human$suffix"}) {
#                $ccl->{type} = 'clause';
#                $ccl->{fmt}  = $cd->{clset}{"$clause.human$suffix"};
#                goto FILL_FORMAT;
#            }
#        } else {
#            delete $cd->{uclset}{$_} for
#                grep /\A\.name(\.|\z)/, keys %{$cd->{uclset}};
#            if (defined $cd->{clset}{".name$suffix"}) {
#                $ccl->{type} = 'noun';
#                $ccl->{fmt}  = $cd->{clset}{".name$suffix"};
#                $ccl->{vals} = undef;
#                goto FILL_FORMAT;
#            }
#        }
#    }
#
#    goto TRANSLATE unless $clause;
#
#    my $ie    = $cd->{cl_is_expr};
#    my $im    = $cd->{cl_is_multi};
#    my $op    = $cd->{cl_op} // "";
#    my $cv    = $cd->{clset}{$clause};
#    my $vals  = $ccl->{vals} // [$cv];
#
#
#    if ($ie) {
#        if (!$ccl->{expr}) {
#            $ccl->{fmt} = "($clause -> %s" . ($op ? " op=$op" : "") . ")";
#            $do_xlt = 0;
#            $vals = [$self->expr($cd, $vals)];
#        }
#        goto ERR_LEVEL;
#    }
#
#
#    if ($op eq 'not') {
#        ($hvals->{modal_verb}, $hvals->{modal_verb_neg}) =
#            ($hvals->{modal_verb_neg}, $hvals->{modal_verb});
#        $vals = [map {$self->literal($_)} @$vals];
#    } elsif ($im && $op eq 'and') {
#        if (@$cv == 2) {
#            $vals = [sprintf($self->_xlt($cd, "%s and %s"),
#                             $self->literal($cv->[0]),
#                             $self->literal($cv->[1]))];
#        } else {
#            $vals = [sprintf($self->_xlt($cd, "all of %s"),
#                             $self->literal($cv))];
#        }
#    } elsif ($im && $op eq 'or') {
#        if (@$cv == 2) {
#            $vals = [sprintf($self->_xlt($cd, "%s or %s"),
#                             $self->literal($cv->[0]),
#                             $self->literal($cv->[1]))];
#        } else {
#            $vals = [sprintf($self->_xlt($cd, "one of %s"),
#                             $self->literal($cv))];
#        }
#    } elsif ($im && $op eq 'none') {
#        ($hvals->{modal_verb}, $hvals->{modal_verbneg}) =
#            ($hvals->{modal_verb_neg}, $hvals->{modal_verb});
#        if (@$cv == 2) {
#            $vals = [sprintf($self->_xlt($cd, "%s nor %s"),
#                             $self->literal($cv->[0]),
#                             $self->literal($cv->[1]))];
#        } else {
#            $vals = [sprintf($self->_xlt($cd, "any of %s"),
#                             $self->literal($cv))];
#        }
#    } else {
#        $vals = [map {$self->literal($_)} @$vals];
#    }
#
#  ERR_LEVEL:
#
#    if ($ccl->{type} eq 'clause' && 'constraint' ~~ $cd->{cl_meta}{tags}) {
#        if (($cd->{clset}{"$clause.err_level"}//'error') eq 'warn') {
#            if ($op eq 'not') {
#                $hvals->{modal_verb}     = $self->_xlt($cd, "should not");
#                $hvals->{modal_verb_neg} = $self->_xlt($cd, "should");
#            } else {
#                $hvals->{modal_verb}     = $self->_xlt($cd, "should");
#                $hvals->{modal_verb_neg} = $self->_xlt($cd, "should not");
#            }
#        }
#    }
#    delete $cd->{uclset}{"$clause.err_level"};
#
#  TRANSLATE:
#
#    if ($ccl->{xlt}) {
#        if (ref($ccl->{fmt}) eq 'ARRAY') {
#            $ccl->{fmt}  = [map {$self->_xlt($cd, $_)} @{$ccl->{fmt}}];
#        } elsif (!ref($ccl->{fmt})) {
#            $ccl->{fmt}  = $self->_xlt($cd, $ccl->{fmt});
#        }
#    }
#
#  FILL_FORMAT:
#
#    if (ref($ccl->{fmt}) eq 'ARRAY') {
#        $ccl->{text} = [map {sprintfn($_, (map {$_//""} ($hvals, @$vals)))}
#                            @{$ccl->{fmt}}];
#    } elsif (!ref($ccl->{fmt})) {
#        $ccl->{text} = sprintfn($ccl->{fmt}, (map {$_//""} ($hvals, @$vals)));
#    }
#    delete $ccl->{fmt} unless $cd->{args}{debug};
#
#  PUSH:
#    push @{$cd->{ccls}}, $ccl;
#
#    $self->_add_msg_catalog($cd, $ccl);
#}
#
#sub add_ccl {
#    my ($self, $cd, @ccls) = @_;
#
#    my $op     = $cd->{cl_op} // '';
#
#    my $ccl;
#    if (@ccls == 1) {
#        $self->_add_ccl($cd, $ccls[0]);
#    } else {
#        my $inner_cd = $self->init_cd(outer_cd => $cd);
#        $inner_cd->{args} = $cd->{args};
#        $inner_cd->{clause} = $cd->{clause};
#        for (@ccls) {
#            $self->_add_ccl($inner_cd, $_);
#        }
#
#        $ccl = {
#            type  => 'list',
#            vals  => [],
#            items => $inner_cd->{ccls},
#            multi => 0,
#        };
#        if ($op eq 'or') {
#            $ccl->{fmt} = 'any of the following %(modal_verb)s be true';
#        } elsif ($op eq 'and') {
#            $ccl->{fmt} = 'all of the following %(modal_verb)s be true';
#        } elsif ($op eq 'none') {
#            $ccl->{fmt} = 'none of the following %(modal_verb)s be true';
#        }
#        $self->_add_ccl($cd, $ccl);
#    }
#}
#
#sub format_ccls {
#    my ($self, $cd, $ccls) = @_;
#
#    local $cd->{_fmt_noun_count} = 0;
#    local $cd->{_fmt_etc_count} = 0;
#
#    my $f = $cd->{args}{format};
#    my $res;
#    if ($f eq 'inline_text' || $f eq 'inline_err_text' || $f eq 'msg_catalog') {
#        $res = $self->_format_ccls_itext($cd, $ccls);
#        if ($f eq 'inline_err_text') {
#            if ($cd->{_fmt_noun_count} == 1 && $cd->{_fmt_etc_count} == 0) {
#                $res = sprintf(
#                    $self->_xlt($cd, "Not of type %s"),
#                    $res
#                );
#            } elsif (!$cd->{_fmt_noun_count}) {
#            } else {
#                $res = sprintf(
#                    $self->_xlt(
#                        $cd, "Does not satisfy the following schema: %s"),
#                    $res
#                );
#            }
#        }
#    } else {
#        $res = $self->_format_ccls_markdown($cd, $ccls);
#    }
#    $res;
#}
#
#sub _format_ccls_itext {
#    my ($self, $cd, $ccls) = @_;
#
#    local $cd->{args}{mark_missing_translation} = 0;
#    my $c_comma = $self->_xlt($cd, ", ");
#
#    if (ref($ccls) eq 'HASH' && $ccls->{type} =~ /^(noun|clause)$/) {
#        if ($ccls->{type} eq 'noun') {
#            $cd->{_fmt_noun_count}++;
#        } else {
#            $cd->{_fmt_etc_count}++;
#        }
#        my $ccl = $ccls;
#        return ref($ccl->{text}) eq 'ARRAY' ? $ccl->{text}[0] : $ccl->{text};
#    } elsif (ref($ccls) eq 'HASH' && $ccls->{type} eq 'list') {
#        my $c_openpar  = $self->_xlt($cd, "(");
#        my $c_closepar = $self->_xlt($cd, ")");
#        my $c_colon    = $self->_xlt($cd, ": ");
#        my $ccl = $ccls;
#
#        my $txt = $ccl->{text}; $txt =~ s/\s+$//;
#        my @t = ($txt, $c_colon);
#        my $i = 0;
#        for (@{ $ccl->{items} }) {
#            push @t, $c_comma if $i;
#            my $it = $self->_format_ccls_itext($cd, $_);
#            if ($it =~ /\Q$c_comma/) {
#                push @t, $c_openpar, $it, $c_closepar;
#            } else {
#                push @t, $it;
#            }
#            $i++;
#        }
#        return join("", @t);
#    } elsif (ref($ccls) eq 'ARRAY') {
#        return join($c_comma, map {$self->_format_ccls_itext($cd, $_)} @$ccls);
#    } else {
#        $self->_die($cd, "Can't format $ccls");
#    }
#}
#
#sub _format_ccls_markdown {
#    my ($self, $cd, $ccls) = @_;
#
#    $self->_die($cd, "Sorry, markdown not yet implemented");
#}
#
#sub _load_lang_modules {
#    my ($self, $cd) = @_;
#
#    my $lang = $cd->{args}{lang};
#    die "Invalid language '$lang', please use letters only"
#        unless $lang =~ /\A\w+\z/;
#
#    my @modp;
#    unless ($lang eq 'en_US') {
#        push @modp, "Data/Sah/Lang/$lang.pm";
#        for my $cl (@{ $typex{$cd->{type}} // []}) {
#            my $modp = "Data/Sah/Lang/$lang/TypeX/$cd->{type}/$cl.pm";
#            $modp =~ s!::!/!g; 
#            push @modp, $modp;
#        }
#    }
#    my $i;
#    for my $modp (@modp) {
#        $i++;
#        unless (exists $INC{$modp}) {
#            if ($i == 1) {
#                require Module::Installed::Tiny;
#                if (!Module::Installed::Tiny::module_installed($modp)) {
#                    $cd->{args}{lang} = 'en_US';
#                    last;
#                }
#            }
#            require $modp;
#
#            $INC{$modp} = undef;
#        }
#    }
#}
#
#sub before_compile {
#    my ($self, $cd) = @_;
#
#    $cd->{_orig_locale} = setlocale(LC_ALL);
#
#    my $res = setlocale(LC_ALL, $cd->{args}{locale} // $cd->{args}{lang});
#    warn "Unsupported locale $cd->{args}{lang}"
#        if $cd->{args}{debug} && !defined($res);
#}
#
#sub before_handle_type {
#    my ($self, $cd) = @_;
#
#    $self->_load_lang_modules($cd);
#}
#
#sub before_clause {
#    my ($self, $cd) = @_;
#
#    $cd->{CLAUSE_DO_MULTI} = 1;
#}
#
#sub after_clause {
#    my ($self, $cd) = @_;
#
#    delete $cd->{CLAUSE_DO_MULTI};
#}
#
#sub after_all_clauses {
#    use experimental 'smartmatch';
#
#    my ($self, $cd) = @_;
#
#
#
#    $cd->{result} = $self->format_ccls($cd, $cd->{ccls});
#}
#
#sub after_compile {
#    my ($self, $cd) = @_;
#
#    setlocale(LC_ALL, $cd->{_orig_locale});
#
#    if ($cd->{args}{format} eq 'msg_catalog') {
#        $cd->{result} = $cd->{_msg_catalog};
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH.pm ###
#package Data::Sah::Compiler::human::TH;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::TH';
#
#sub name { undef }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $pkg = ref($self);
#    $pkg =~ s/^Data::Sah::Compiler::human::TH:://;
#
#    $c->add_ccl($cd, {type=>'noun', fmt=>$pkg});
#}
#
#
#sub clause_name {}
#sub clause_summary {}
#sub clause_description {}
#sub clause_comment {}
#sub clause_tags {}
#
#sub clause_prefilters {}
#sub clause_postfilters {}
#
#
#sub clause_ok {}
#
#
#sub clause_req {}
#sub clause_forbidden {}
#
#
#sub clause_default {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {expr=>1,
#                      fmt => 'default value %s'});
#}
#
#sub before_clause_clause {
#    my ($self, $cd) = @_;
#    $cd->{CLAUSE_DO_MULTI} = 0;
#}
#
#sub before_clause_clset {
#    my ($self, $cd) = @_;
#    $cd->{CLAUSE_DO_MULTI} = 0;
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/Comparable.pm ###
#package Data::Sah::Compiler::human::TH::Comparable;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::Comparable';
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $fmt;
#    if ($which eq 'is') {
#        $c->add_ccl($cd, {expr=>1, multi=>1,
#                          fmt => '%(modal_verb)s have the value %s'});
#    } elsif ($which eq 'in') {
#        $c->add_ccl($cd, {expr=>1, multi=>1,
#                          fmt => '%(modal_verb)s be one of %s'});
#    }
#}
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/HasElems.pm ###
#package Data::Sah::Compiler::human::TH::HasElems;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::HasElems';
#
#sub before_clause {
#    my ($self_th, $which, $cd) = @_;
#}
#
#sub before_clause_len_between {
#    my ($self, $cd) = @_;
#    $cd->{CLAUSE_DO_MULTI} = 0;
#}
#
#sub superclause_has_elems {
#    my ($self_th, $which, $cd) = @_;
#    my $c  = $self_th->compiler;
#    my $cv = $cd->{cl_value};
#
#    if ($which eq 'len') {
#        $c->add_ccl($cd, {
#            expr  => 1,
#            fmt   => q[length %(modal_verb)s be %s],
#        });
#    } elsif ($which eq 'min_len') {
#        $c->add_ccl($cd, {
#            expr  => 1,
#            fmt   => q[length %(modal_verb)s be at least %s],
#        });
#    } elsif ($which eq 'max_len') {
#        $c->add_ccl($cd, {
#            expr  => 1,
#            fmt   => q[length %(modal_verb)s be at most %s],
#        });
#    } elsif ($which eq 'len_between') {
#        $c->add_ccl($cd, {
#            fmt   => q[length %(modal_verb)s be between %s and %s],
#            vals  => $cv,
#        });
#    } elsif ($which eq 'has') {
#        $c->add_ccl($cd, {
#            expr=>1, multi=>1,
#            fmt => "%(modal_verb)s have %s in its elements"});
#    } elsif ($which eq 'each_index') {
#        $self_th->clause_each_index($cd);
#    } elsif ($which eq 'each_elem') {
#        $self_th->clause_each_elem($cd);
#    } elsif ($which eq 'check_each_index') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'check_each_elem') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'uniq') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'exists') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/Sortable.pm ###
#package Data::Sah::Compiler::human::TH::Sortable;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::Sortable';
#
#sub before_clause_between {
#    my ($self, $cd) = @_;
#    $cd->{CLAUSE_DO_MULTI} = 0;
#}
#
#sub before_clause_xbetween {
#    my ($self, $cd) = @_;
#    $cd->{CLAUSE_DO_MULTI} = 0;
#}
#
#sub superclause_sortable {
#    my ($self, $which, $cd) = @_;
#    my $c = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    if ($which eq 'min') {
#        $c->add_ccl($cd, {
#            expr=>1,
#            fmt => '%(modal_verb)s be at least %s',
#        });
#    } elsif ($which eq 'xmin') {
#        $c->add_ccl($cd, {
#            expr=>1,
#            fmt => '%(modal_verb)s be larger than %s',
#        });
#    } elsif ($which eq 'max') {
#        $c->add_ccl($cd, {
#            expr=>1,
#            fmt => '%(modal_verb)s be at most %s',
#        });
#    } elsif ($which eq 'xmax') {
#        $c->add_ccl($cd, {
#            expr=>1,
#            fmt => '%(modal_verb)s be smaller than %s',
#        });
#    } elsif ($which eq 'between') {
#        $c->add_ccl($cd, {
#            fmt => '%(modal_verb)s be between %s and %s',
#            vals => $cv,
#        });
#    } elsif ($which eq 'xbetween') {
#        $c->add_ccl($cd, {
#            fmt => '%(modal_verb)s be larger than %s and smaller than %s',
#            vals => $cv,
#        });
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/all.pm ###
#package Data::Sah::Compiler::human::TH::all;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Type::all';
#
#sub handle_type {
#}
#
#sub clause_of {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my @result;
#    my $i = 0;
#    for my $cv2 (@$cv) {
#        local $cd->{spath} = [@{$cd->{spath}}, $i];
#        my %iargs = %{$cd->{args}};
#        $iargs{outer_cd}             = $cd;
#        $iargs{schema}               = $cv2;
#        $iargs{schema_is_normalized} = 0;
#        my $icd = $c->compile(%iargs);
#        push @result, $icd->{ccls};
#        $c->_add_msg_catalog($cd, $icd->{ccls});
#        $i++;
#    }
#
#    my $can = 1;
#    for my $r (@result) {
#        unless (@$r == 1 && $r->[0]{type} eq 'noun') {
#            $can = 0;
#            last;
#        }
#    }
#
#    my $vals;
#    if ($can) {
#        my $c0  = $c->_xlt($cd, '%(modal_verb)s be %s');
#        my $awa = $c->_xlt($cd, 'as well as %s');
#        my $wb  = $c->_xlt($cd, ' ');
#        my $fmt;
#        my $i = 0;
#        for my $r (@result) {
#            $fmt .= $i ? $wb . $awa : $c0;
#            push @$vals, ref($r->[0]{text}) eq 'ARRAY' ?
#                $r->[0]{text}[0] : $r->[0]{text};
#            $i++;
#        }
#        $c->add_ccl($cd, {
#            fmt  => $fmt,
#            vals => $vals,
#            xlt  => 0,
#            type => 'noun',
#        });
#    } else {
#        $c->add_ccl($cd, {
#            type  => 'list',
#            fmt   => '%(modal_verb)s be all of the following',
#            items => [
#                @result,
#            ],
#            vals  => [],
#        });
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/any.pm ###
#package Data::Sah::Compiler::human::TH::any;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Type::any';
#
#sub handle_type {
#}
#
#sub clause_of {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my @result;
#    my $i = 0;
#    for my $cv2 (@$cv) {
#        local $cd->{spath} = [@{$cd->{spath}}, $i];
#        my %iargs = %{$cd->{args}};
#        $iargs{outer_cd}             = $cd;
#        $iargs{schema}               = $cv2;
#        $iargs{schema_is_normalized} = 0;
#        my $icd = $c->compile(%iargs);
#        push @result, $icd->{ccls};
#        $i++;
#    }
#
#    my $can = 1;
#    for my $r (@result) {
#        unless (@$r == 1 && $r->[0]{type} eq 'noun') {
#            $can = 0;
#            last;
#        }
#    }
#
#    my $vals;
#    if ($can) {
#        my $c0  = $c->_xlt($cd, '%(modal_verb)s be either %s');
#        my $awa = $c->_xlt($cd, 'or %s');
#        my $wb  = $c->_xlt($cd, ' ');
#        my $fmt;
#        my $i = 0;
#        for my $r (@result) {
#            $fmt .= $i ? $wb . $awa : $c0;
#            push @$vals, ref($r->[0]{text}) eq 'ARRAY' ?
#                $r->[0]{text}[0] : $r->[0]{text};
#            $i++;
#        }
#        $c->add_ccl($cd, {
#            fmt  => $fmt,
#            vals => $vals,
#            xlt  => 0,
#            type => 'noun',
#        });
#    } else {
#        $c->add_ccl($cd, {
#            type  => 'list',
#            fmt   => '%(modal_verb)s be one of the following',
#            items => [
#                @result,
#            ],
#            vals  => [],
#        });
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/array.pm ###
#package Data::Sah::Compiler::human::TH::array;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::HasElems';
#with 'Data::Sah::Type::array';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["array", "arrays"],
#        type  => 'noun',
#    });
#}
#
#sub clause_each_index {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my %iargs = %{$cd->{args}};
#    $iargs{outer_cd}             = $cd;
#    $iargs{schema}               = $cv;
#    $iargs{schema_is_normalized} = 0;
#    my $icd = $c->compile(%iargs);
#
#    $c->add_ccl($cd, {
#        type  => 'list',
#        fmt   => 'each array subscript %(modal_verb)s be',
#        items => [
#            $icd->{ccls},
#        ],
#        vals  => [],
#    });
#}
#
#sub clause_each_elem {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my %iargs = %{$cd->{args}};
#    $iargs{outer_cd}             = $cd;
#    $iargs{schema}               = $cv;
#    $iargs{schema_is_normalized} = 0;
#    my $icd = $c->compile(%iargs);
#
#    if (@{$icd->{ccls}} == 1) {
#        my $c0 = $icd->{ccls}[0];
#        if ($c0->{type} eq 'noun' && ref($c0->{text}) eq 'ARRAY' &&
#                @{$c0->{text}} > 1 && @{$cd->{ccls}} &&
#                    $cd->{ccls}[0]{type} eq 'noun') {
#            for (ref($cd->{ccls}[0]{text}) eq 'ARRAY' ?
#                     @{$cd->{ccls}[0]{text}} : ($cd->{ccls}[0]{text})) {
#                my $fmt = $c->_xlt($cd, '%s of %s');
#                $_ = sprintf $fmt, $_, $c0->{text}[1];
#            }
#            return;
#        }
#    }
#
#    $c->add_ccl($cd, {
#        type  => 'list',
#        fmt   => 'each array element %(modal_verb)s be',
#        items => [
#            $icd->{ccls},
#        ],
#        vals  => [],
#    });
#}
#
#sub clause_elems {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    for my $i (0..@$cv-1) {
#        local $cd->{spath} = [@{$cd->{spath}}, $i];
#        my $v = $cv->[$i];
#        my %iargs = %{$cd->{args}};
#        $iargs{outer_cd}             = $cd;
#        $iargs{schema}               = $v;
#        $iargs{schema_is_normalized} = 0;
#        my $icd = $c->compile(%iargs);
#        $c->add_ccl($cd, {
#            type  => 'list',
#            fmt   => '%s %(modal_verb)s be',
#            vals  => [
#                $c->_ordinate($cd, $i+1, $c->_xlt($cd, "element")),
#            ],
#            items => [ $icd->{ccls} ],
#        });
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/bool.pm ###
#package Data::Sah::Compiler::human::TH::bool;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::Sortable';
#with 'Data::Sah::Type::bool';
#
#sub name { "boolean value" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["boolean value", "boolean values"],
#        type  => 'noun',
#    });
#}
#
#sub before_clause_is_true {
#    my ($self, $cd) = @_;
#    $cd->{CLAUSE_DO_MULTI} = 0;
#}
#
#sub clause_is_true {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    $c->add_ccl($cd, {
#        fmt   => $cv ? q[%(modal_verb)s be true] : q[%(modal_verb)s be false],
#    });
#}
#
#sub clause_is_re {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s be a regex pattern],
#    });
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/buf.pm ###
#package Data::Sah::Compiler::human::TH::buf;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH::str';
#
#sub name { "buffer" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["buffer", "buffers"],
#        type  => 'noun',
#    });
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/cistr.pm ###
#package Data::Sah::Compiler::human::TH::cistr;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH::str';
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/code.pm ###
#package Data::Sah::Compiler::human::TH::code;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Type::code';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["code", "codes"],
#        type  => 'noun',
#    });
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/date.pm ###
#package Data::Sah::Compiler::human::TH::date;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::Sortable';
#with 'Data::Sah::Type::date';
#
#sub name { "date" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {type=>'noun', fmt => ["date", "dates"]});
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/duration.pm ###
#package Data::Sah::Compiler::human::TH::duration;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::Sortable';
#with 'Data::Sah::Type::duration';
#
#sub name { "duration" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {type=>'noun', fmt => ["duration", "durations"]});
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/float.pm ###
#package Data::Sah::Compiler::human::TH::float;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::Sortable';
#with 'Data::Sah::Type::float';
#
#sub name { "decimal number" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        type=>'noun',
#        fmt => ["decimal number", "decimal numbers"],
#    });
#}
#
#sub clause_is_nan {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $cv = $cd->{cl_value};
#    if ($cd->{cl_is_expr}) {
#        $c->add_ccl($cd, {});
#    } else {
#        $c->add_ccl($cd, {
#            fmt => $cv ?
#                q[%(modal_verb)s be a NaN] :
#                    q[%(modal_verb_neg)s be a NaN],
#        });
#    }
#}
#
#sub clause_is_inf {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $cv = $cd->{cl_value};
#    if ($cd->{cl_is_expr}) {
#        $c->add_ccl($cd, {});
#    } else {
#        $c->add_ccl($cd, {
#            fmt => $cv ?
#                q[%(modal_verb)s an infinity] :
#                    q[%(modal_verb_neg)s an infinity],
#        });
#    }
#}
#
#sub clause_is_pos_inf {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $cv = $cd->{cl_value};
#    if ($cd->{cl_is_expr}) {
#        $c->add_ccl($cd, {});
#    } else {
#        $c->add_ccl($cd, {
#            fmt => $cv ?
#                q[%(modal_verb)s a positive infinity] :
#                    q[%(modal_verb_neg)s a positive infinity],
#        });
#    }
#}
#
#sub clause_is_neg_inf {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $cv = $cd->{cl_value};
#    if ($cd->{cl_is_expr}) {
#        $c->add_ccl($cd, {});
#    } else {
#        $c->add_ccl($cd, {
#            fmt => $cv ?
#                q[%(modal_verb)s a negative infinity] :
#                    q[%(modal_verb_neg)s a negative infinity],
#        });
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/hash.pm ###
#package Data::Sah::Compiler::human::TH::hash;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::HasElems';
#with 'Data::Sah::Type::hash';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["hash", "hashes"],
#        type  => 'noun',
#    });
#}
#
#sub clause_has {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    $c->add_ccl($cd, {
#        expr=>1, multi=>1,
#        fmt => "%(modal_verb)s have %s in its %(field)s values"});
#}
#
#sub clause_each_index {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my %iargs = %{$cd->{args}};
#    $iargs{outer_cd}             = $cd;
#    $iargs{schema}               = $cv;
#    $iargs{schema_is_normalized} = 0;
#    my $icd = $c->compile(%iargs);
#
#    $c->add_ccl($cd, {
#        type  => 'list',
#        fmt   => '%(field)s name %(modal_verb)s be',
#        items => [
#            $icd->{ccls},
#        ],
#        vals  => [],
#    });
#}
#
#sub clause_each_elem {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my %iargs = %{$cd->{args}};
#    $iargs{outer_cd}             = $cd;
#    $iargs{schema}               = $cv;
#    $iargs{schema_is_normalized} = 0;
#    my $icd = $c->compile(%iargs);
#
#    $c->add_ccl($cd, {
#        type  => 'list',
#        fmt   => 'each %(field)s %(modal_verb)s be',
#        items => [
#            $icd->{ccls},
#        ],
#        vals  => [],
#    });
#}
#
#sub clause_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    for my $k (sort keys %$cv) {
#        local $cd->{spath} = [@{$cd->{spath}}, $k];
#        my $v = $cv->{$k};
#        my %iargs = %{$cd->{args}};
#        $iargs{outer_cd}             = $cd;
#        $iargs{schema}               = $v;
#        $iargs{schema_is_normalized} = 0;
#        my $icd = $c->compile(%iargs);
#        $c->add_ccl($cd, {
#            type  => 'list',
#            fmt   => '%(field)s %s %(modal_verb)s be',
#            vals  => [$k],
#            items => [ $icd->{ccls} ],
#        });
#    }
#}
#
#sub clause_re_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    for my $k (sort keys %$cv) {
#        local $cd->{spath} = [@{$cd->{spath}}, $k];
#        my $v = $cv->{$k};
#        my %iargs = %{$cd->{args}};
#        $iargs{outer_cd}             = $cd;
#        $iargs{schema}               = $v;
#        $iargs{schema_is_normalized} = 0;
#        my $icd = $c->compile(%iargs);
#        $c->add_ccl($cd, {
#            type  => 'list',
#            fmt   => '%(fields)s whose names match regex pattern %s %(modal_verb)s be',
#            vals  => [$k],
#            items => [ $icd->{ccls} ],
#        });
#    }
#}
#
#sub clause_req_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s have required %(fields)s %s],
#        expr  => 1,
#    });
#}
#
#sub clause_allowed_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s only have these allowed %(fields)s %s],
#        expr  => 1,
#    });
#}
#
#sub clause_allowed_keys_re {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s only have %(fields)s matching regex pattern %s],
#        expr  => 1,
#    });
#}
#
#sub clause_forbidden_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb_neg)s have these forbidden %(fields)s %s],
#        expr  => 1,
#    });
#}
#
#sub clause_forbidden_keys_re {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb_neg)s have %(fields)s matching regex pattern %s],
#        expr  => 1,
#    });
#}
#
#sub clause_choose_one_key {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        push @ccls, {
#            fmt   => q[%(modal_verb)s contain at most one of these %(fields)s %s],
#            vals  => [$cv],
#        };
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#sub clause_choose_all_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        push @ccls, {
#            fmt   => q[%(modal_verb)s contain either none or all of these %(fields)s %s],
#            vals  => [$cv],
#        };
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#sub clause_req_one_key {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        push @ccls, {
#            fmt   => q[%(modal_verb)s contain exactly one of these %(fields)s %s],
#            vals  => [$cv],
#        };
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#sub clause_req_some_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        push @ccls, {
#            fmt   => q[%(modal_verb)s contain between %d and %d of these %(fields)s %s],
#            vals  => [$cv->[0], $cv->[1], $cv->[2]],
#        };
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#sub clause_dep_any {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        if (@{ $cv->[1] } == 1) {
#            push @ccls, {
#                fmt   => q[%(field)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
#                vals  => [$cv->[0], $cv->[1][0]],
#            };
#        } else {
#            push @ccls, {
#                fmt   => q[one of %(fields)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
#                vals  => $cv,
#                multi => 0,
#            };
#        }
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#sub clause_dep_all {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        if (@{ $cv->[1] } == 1) {
#            push @ccls, {
#                fmt   => q[%(field)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
#                vals  => [$cv->[0], $cv->[1][0]],
#            };
#        } else {
#            push @ccls, {
#                fmt   => q[all of %(fields)s %2$s %(modal_verb)s be present before %(field)s %1$s can be present],
#                vals  => $cv,
#            };
#        }
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#sub clause_req_dep_any {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        if (@{ $cv->[1] } == 1) {
#            push @ccls, {
#                fmt   => q[%(field)s %1$s %(modal_verb)s be present when %(field)s %2$s is present],
#                vals  => [$cv->[0], $cv->[1][0]],
#            };
#        } else {
#            push @ccls, {
#                fmt   => q[%(field)s %1$s %(modal_verb)s be present when one of %(fields)s %2$s is present],
#                vals  => $cv,
#            };
#        }
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#sub clause_req_dep_all {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#
#    my $multi = $cd->{cl_is_multi};
#    $cd->{cl_is_multi} = 0;
#
#    my @ccls;
#    for my $cv ($multi ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        if (@{ $cv->[1] } == 1) {
#            push @ccls, {
#                fmt   => q[%(field)s %1$s %(modal_verb)s be present when %(field)s %2$s is present],
#                vals  => [$cv->[0], $cv->[1][0]],
#            };
#        } else {
#            push @ccls, {
#                fmt   => q[%(field)s %1$s %(modal_verb)s be present when all of %(fields)s %2$s are present],
#                vals  => $cv,
#            };
#        }
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/int.pm ###
#package Data::Sah::Compiler::human::TH::int;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH::num';
#with 'Data::Sah::Type::int';
#
#sub name { "integer" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        type  => 'noun',
#        fmt   => ["integer", "integers"],
#    });
#}
#
#sub clause_div_by {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    if (!$cd->{cl_is_multi} && !$cd->{cl_is_expr} &&
#            $cv == 2) {
#        $c->add_ccl($cd, {
#            fmt   => q[%(modal_verb)s be even],
#        });
#        return;
#    }
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s be divisible by %s],
#        expr  => 1,
#    });
#}
#
#sub clause_mod {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    if (!$cd->{cl_is_multi} && !$cd->{cl_is_expr}) {
#        if ($cv->[0] == 2 && $cv->[1] == 0) {
#            $c->add_ccl($cd, {
#                fmt   => q[%(modal_verb)s be even],
#            });
#            return;
#        } elsif ($cv->[0] == 2 && $cv->[1] == 1) {
#            $c->add_ccl($cd, {
#                fmt   => q[%(modal_verb)s be odd],
#            });
#            return;
#        }
#    }
#
#    my @ccls;
#    for my $cv ($cd->{cl_is_multi} ? @{ $cd->{cl_value} } : ($cd->{cl_value})) {
#        push @ccls, {
#            fmt  => q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
#            vals => $cv,
#        };
#    }
#    $c->add_ccl($cd, @ccls);
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/num.pm ###
#package Data::Sah::Compiler::human::TH::num;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::Sortable';
#with 'Data::Sah::Type::num';
#
#sub name { "number" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {type=>'noun', fmt => ["number", "numbers"]});
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/obj.pm ###
#package Data::Sah::Compiler::human::TH::obj;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Type::obj';
#
#sub name { "object" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["object", "objects"],
#        type  => 'noun',
#    });
#}
#
#sub clause_can {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s have method(s) %s],
#    });
#}
#
#sub clause_isa {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s be subclass of %s],
#    });
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/re.pm ###
#package Data::Sah::Compiler::human::TH::re;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Type::re';
#
#sub name { "regex pattern" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["regex pattern", "regex patterns"],
#        type  => 'noun',
#    });
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/str.pm ###
#package Data::Sah::Compiler::human::TH::str;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Compiler::human::TH::Sortable';
#with 'Data::Sah::Compiler::human::TH::Comparable';
#with 'Data::Sah::Compiler::human::TH::HasElems';
#with 'Data::Sah::Type::str';
#
#sub name { "text" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["text", "texts"],
#        type  => 'noun',
#    });
#}
#
#sub clause_each_index {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my %iargs = %{$cd->{args}};
#    $iargs{outer_cd}             = $cd;
#    $iargs{schema}               = $cv;
#    $iargs{schema_is_normalized} = 0;
#    my $icd = $c->compile(%iargs);
#
#    $c->add_ccl($cd, {
#        type  => 'list',
#        fmt   => 'each subscript of text %(modal_verb)s be',
#        items => [
#            $icd->{ccls},
#        ],
#        vals  => [],
#    });
#}
#
#sub clause_each_elem {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    my %iargs = %{$cd->{args}};
#    $iargs{outer_cd}             = $cd;
#    $iargs{schema}               = $cv;
#    $iargs{schema_is_normalized} = 0;
#    my $icd = $c->compile(%iargs);
#
#    $c->add_ccl($cd, {
#        type  => 'list',
#        fmt   => 'each character of the text %(modal_verb)s be',
#        items => [
#            $icd->{ccls},
#        ],
#        vals  => [],
#    });
#}
#
#sub clause_encoding {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    $c->_die($cd, "Only 'utf8' encoding is currently supported")
#        unless $cv eq 'utf8';
#}
#
#sub clause_match {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s match regex pattern %s],
#    });
#}
#
#sub clause_is_re {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#
#    $c->add_ccl($cd, {
#        fmt   => q[%(modal_verb)s be a regex pattern],
#    });
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/human/TH/undef.pm ###
#package Data::Sah::Compiler::human::TH::undef;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::human::TH';
#with 'Data::Sah::Type::undef';
#
#sub name { "undefined value" }
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    $c->add_ccl($cd, {
#        fmt   => ["undefined value", "undefined values"],
#        type  => 'noun',
#    });
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl.pm ###
#package Data::Sah::Compiler::perl;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Data::Dmp qw(dmp);
#use Mo qw(build default);
#
#extends 'Data::Sah::Compiler::Prog';
#
#our $PP;
#our $CORE;
#our $CORE_OR_PP;
#our $NO_MODULES;
#
#sub __indent {
#    my ($indent, $str, $opts) = @_;
#    $opts //= {};
#
#    my $ibl = $opts->{indent_blank_lines} // 1;
#    my $fli = $opts->{first_line_indent} // $indent;
#    my $sli = $opts->{subsequent_lines_indent} // $indent;
#
#    my $i = 0;
#    $str =~ s/^([^\r\n]?)/$i++; !$ibl && !$1 ? "$1" : $i==1 ? "$fli$1" : "$sli$1"/egm;
#    $str;
#}
#
#sub BUILD {
#    my ($self, $args) = @_;
#
#    $self->comment_style('shell');
#    $self->indent_character(" " x 4);
#    $self->var_sigil('$');
#    $self->concat_op(".");
#}
#
#sub name { "perl" }
#
#sub literal {
#    dmp($_[1]);
#}
#
#sub expr {
#    my ($self, $expr) = @_;
#    $self->expr_compiler->perl($expr);
#}
#
#sub compile {
#    my ($self, %args) = @_;
#
#
#
#    $args{pp} //= $PP // $ENV{DATA_SAH_PP} // 0;
#    $args{core} //= $CORE // $ENV{DATA_SAH_CORE} // 0;
#    $args{core_or_pp} //= $CORE_OR_PP // $ENV{DATA_SAH_CORE_OR_PP} // 0;
#    $args{no_modules} //= $NO_MODULES // $ENV{DATA_SAH_NO_MODULES} // 0;
#
#    $self->SUPER::compile(%args);
#}
#
#sub init_cd {
#    my ($self, %args) = @_;
#
#    my $cd = $self->SUPER::init_cd(%args);
#
#    $self->add_runtime_no($cd, 'warnings', ["'void'"]) unless $cd->{args}{no_modules};
#
#    $cd;
#}
#
#sub true { "1" }
#
#sub false { "''" }
#
#our %known_modules = (
#    'DateTime::Duration'        => {pp=>1, core=>0},
#    'DateTime'                  => {pp=>0, core=>0},
#    'DateTime::Format::Alami'     => {pp=>1, core=>0},
#    'DateTime::Format::Alami::EN' => {pp=>1, core=>0},
#    'DateTime::Format::Alami::ID' => {pp=>1, core=>0},
#    'DateTime::Format::Natural'   => {pp=>1, core=>0},
#    'experimental'              => {pp=>1, core=>0}, 
#    'List::Util'                => {pp=>0, core=>1},
#    'Scalar::Util::Numeric'     => {pp=>0, core=>0},
#    'Scalar::Util::Numeric::PP' => {pp=>1, core=>0},
#    'Scalar::Util'              => {pp=>0, core=>1},
#    'Storable'                  => {pp=>0, core=>1},
#    'Time::Duration::Parse::AsHash' => {pp=>1, core=>0},
#    'Time::Local'               => {pp=>1, core=>1},
#    'Time::Moment'              => {pp=>0, core=>0},
#    'Time::Piece'               => {pp=>0, core=>1},
#    'warnings'                  => {pp=>1, core=>1},
#);
#
#sub add_module {
#    my ($self, $cd, $name, $extra_keys, $allow_duplicate) = @_;
#
#    if ($extra_keys->{phase} eq 'runtime') {
#        if ($cd->{args}{no_modules}) {
#            die "BUG: Use of module '$name' when compile option no_modules=1";
#        }
#
#        if ($cd->{args}{whitelist_modules} && grep { $_ eq $name } @{ $cd->{args}{whitelist_modules} }) {
#            goto PASS;
#        }
#
#        if ($cd->{args}{pp}) {
#            if (!$known_modules{$name}) {
#                die "BUG: Haven't noted about Perl module '$name' as being pp/xs";
#            } elsif (!$known_modules{$name}{pp}) {
#                die "Use of XS module '$name' when compile option pp=1";
#            }
#        }
#
#        if ($cd->{args}{core}) {
#            if (!$known_modules{$name}) {
#                die "BUG: Haven't noted about Perl module '$name' as being core/non-core";
#            } elsif (!$known_modules{$name}{core}) {
#                die "Use of non-core module '$name' when compile option core=1";
#            }
#        }
#
#        if ($cd->{args}{core_or_pp}) {
#            if (!$known_modules{$name}) {
#                die "BUG: Haven't noted about Perl module '$name' as being core/non-core or pp/xs";
#            } elsif (!$known_modules{$name}{pp} && !$known_modules{$name}{core}) {
#                die "Use of non-core XS module '$name' when compile option core_or_pp=1";
#            }
#        }
#    }
#  PASS:
#    $self->SUPER::add_module($cd, $name, $extra_keys, $allow_duplicate);
#}
#
#sub add_runtime_use {
#    my ($self, $cd, $name, $import_terms) = @_;
#    my $use_statement = "use $name".
#        ($import_terms && @$import_terms ? " (".(join ",", @$import_terms).")" : "");
#
#    for my $mod (@{ $cd->{modules} }) {
#        next unless $mod->{phase} eq 'runtime';
#        return if $mod->{use_statement} &&
#            $mod->{use_statement} eq $use_statement;
#    }
#
#    $self->add_runtime_module(
#        $cd,
#        $name,
#        {
#            use_statement => $use_statement,
#        },
#        1, 
#    );
#}
#
#sub add_runtime_no {
#    my ($self, $cd, $name, $import_terms) = @_;
#
#    my $use_statement = "no $name".
#        ($import_terms && @$import_terms ? " (".(join ",", @$import_terms).")" : "");
#
#    for my $mod (@{ $cd->{modules} }) {
#        next unless $mod->{phase} eq 'runtime';
#        return if $mod->{use_statement} &&
#            $mod->{use_statement} eq $use_statement;
#    }
#
#    $self->add_runtime_module(
#        $cd,
#        $name,
#        {
#            use_statement => $use_statement,
#        },
#        1, 
#    );
#}
#
#sub add_runtime_smartmatch_pragma {
#    my ($self, $cd) = @_;
#    $self->add_runtime_use($cd, 'experimental', ['"smartmatch"']);
#}
#
#sub add_sun_module {
#    my ($self, $cd) = @_;
#    if ($cd->{args}{pp} || $cd->{args}{core_or_pp} ||
#            !eval { require Scalar::Util::Numeric; 1 }) {
#        $cd->{_sun_module} = 'Scalar::Util::Numeric::PP';
#    } elsif ($cd->{args}{core}) {
#        $cd->{_sun_module} = 'Foo';
#    } else {
#        $cd->{_sun_module} = 'Scalar::Util::Numeric';
#    }
#    $self->add_runtime_module($cd, $cd->{_sun_module});
#}
#
#sub expr_defined {
#    my ($self, $t) = @_;
#    "defined($t)";
#}
#
#sub expr_array {
#    my ($self, @t) = @_;
#    "[".join(",", @t)."]";
#}
#
#sub expr_array_subscript {
#    my ($self, $at, $idxt) = @_;
#    "$at->\[$idxt]";
#}
#
#sub expr_last_elem {
#    my ($self, $at, $idxt) = @_;
#    "$at->\[-1]";
#}
#
#sub expr_push {
#    my ($self, $at, $elt) = @_;
#    "push(\@{$at}, $elt)";
#}
#
#sub expr_pop {
#    my ($self, $at, $elt) = @_;
#    "pop(\@{$at})";
#}
#
#sub expr_push_and_pop_dpath_between_expr {
#    my ($self, $et) = @_;
#    join(
#        "",
#        "[",
#        $self->expr_push('$_sahv_dpath', $self->literal(undef)), ", ", 
#        "~~", $self->enclose_paren($et), ", ", 
#        $self->expr_pop('$_sahv_dpath'), 
#        "]->[1]",
#    );
#}
#
#sub expr_prefix_dpath {
#    my ($self, $t) = @_;
#    '(@$_sahv_dpath ? \'@\'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . ' . $t;
#}
#
#sub expr_set {
#    my ($self, $l, $r) = @_;
#    "($l = $r)";
#}
#
#sub expr_setif {
#    my ($self, $l, $r) = @_;
#    "($l //= $r)";
#}
#
#sub expr_set_err_str {
#    my ($self, $et, $err_expr) = @_;
#    "($et //= $err_expr)";
#}
#
#sub expr_set_err_full {
#    my ($self, $et, $k, $err_expr) = @_;
#    "($et\->{$k}{join('/',\@\$_sahv_dpath)} //= $err_expr)";
#}
#
#sub expr_reset_err_str {
#    my ($self, $et, $err_expr) = @_;
#    "($et = undef, 1)";
#}
#
#sub expr_reset_err_full {
#    my ($self, $et) = @_;
#    "(delete($et\->{errors}{join('/',\@\$_sahv_dpath)}), 1)";
#}
#
#sub expr_ternary {
#    my ($self, $cond_term, $true_term, $false_term) = @_;
#    "$cond_term ? $true_term : $false_term";
#}
#
#sub expr_log {
#    my ($self, $cd, @expr) = @_;
#
#    "\$log->tracef('[sah validator](spath=%s) %s', " .
#        $self->literal($cd->{spath}).", " . join(", ", @expr) . ")";
#}
#
#sub expr_block {
#    my ($self, $code) = @_;
#    join(
#        "",
#        "do {\n",
#        __indent(
#            $self->indent_character,
#            $code,
#        ),
#        "}",
#    );
#}
#
#sub block_uses_sub { 0 }
#
#sub stmt_declare_local_var {
#    my ($self, $v, $vt) = @_;
#    if ($vt eq 'undef') {
#        "my \$$v;";
#    } else {
#        "my \$$v = $vt;";
#    }
#}
#
#sub expr_anon_sub {
#    my ($self, $args, $code) = @_;
#    join(
#        "",
#        "sub {\n",
#        __indent(
#            $self->indent_character,
#            join(
#                "",
#                ("my (".join(", ", @$args).") = \@_;\n") x !!@$args,
#                $code,
#            ),
#        ),
#        "}"
#    );
#}
#
#sub expr_eval {
#    my ($self, $stmt) = @_;
#    "(eval { $stmt }, !\$@)";
#}
#
#sub stmt_require_module {
#    my ($self, $mod_record) = @_;
#
#    if ($mod_record->{use_statement}) {
#        return "$mod_record->{use_statement};";
#    } else {
#        "require $mod_record->{name};";
#    }
#}
#
#sub stmt_require_log_module {
#    my ($self) = @_;
#    'use Log::Any qw($log);';
#}
#
#sub stmt_assign_hash_value {
#    my ($self, $ht, $kt, $vt) = @_;
#    "$ht\->{$kt} = $vt;";
#}
#
#sub stmt_return {
#    my $self = shift;
#    if (@_) {
#        "return($_[0]);";
#    } else {
#        'return;';
#    }
#}
#
#sub expr_validator_sub {
#    my ($self, %args) = @_;
#
#    $self->check_compile_args(\%args);
#
#    my $aref = delete $args{accept_ref};
#    if ($aref) {
#        $args{var_term}  = '$ref_'.$args{data_name};
#        $args{data_term} = '$$ref_'.$args{data_name};
#    } else {
#        $args{var_term}  = '$'.$args{data_name};
#        $args{data_term} = '$'.$args{data_name};
#    }
#
#    $self->SUPER::expr_validator_sub(%args);
#}
#
#sub _str2reliteral {
#    require Regexp::Stringify;
#
#    my ($self, $cd, $str) = @_;
#
#    my $re;
#    if (ref($str) eq 'Regexp') {
#        $re = $str;
#    } else {
#        eval { $re = qr/$str/ };
#        $self->_die($cd, "Invalid regex $str: $@") if $@;
#    }
#
#    Regexp::Stringify::stringify_regexp(regexp=>$re, plver=>5.010);
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH.pm ###
#package Data::Sah::Compiler::perl::TH;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::Prog::TH';
#
#sub gen_each {
#    my ($self, $cd, $indices_expr, $data_name, $data_term, $code_at_sub_begin) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $dt = $cd->{data_term};
#
#    local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
#
#    $c->add_runtime_module($cd, 'List::Util');
#    my %iargs = %{$cd->{args}};
#    $iargs{outer_cd}             = $cd;
#    $iargs{data_name}            = $data_name;
#    $iargs{data_term}            = $data_term;
#    $iargs{schema}               = $cv;
#    $iargs{schema_is_normalized} = 0;
#    $iargs{indent_level}++;
#    $iargs{data_term_includes_topic_var} = 1;
#    my $icd = $c->compile(%iargs);
#    my @code = (
#        "!defined(List::Util::first(sub {", ($code_at_sub_begin // ''), "!(\n",
#        ($c->indent_str($cd),
#         "(\$_sahv_dpath->[-1] = \$_),\n") x !!$cd->{use_dpath},
#         $icd->{result}, "\n",
#         $c->indent_str($icd), ")}, ",
#         $indices_expr,
#         "))",
#    );
#    $c->add_ccl($cd, join("", @code), {subdata=>1});
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/all.pm ###
#package Data::Sah::Compiler::perl::TH::all;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#
#use parent (
#    'Data::Sah::Compiler::perl::TH',
#    'Data::Sah::Compiler::Prog::TH::all',
#);
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/any.pm ###
#package Data::Sah::Compiler::perl::TH::any;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#
#use parent (
#    'Data::Sah::Compiler::perl::TH',
#    'Data::Sah::Compiler::Prog::TH::any',
#);
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/array.pm ###
#package Data::Sah::Compiler::perl::TH::array;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::array';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = "ref($dt) eq 'ARRAY'";
#}
#
#my $FRZ = "Storable::freeze";
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_runtime_module($cd, 'Storable');
#
#    if ($which eq 'is') {
#        $c->add_ccl($cd, "$FRZ($dt) eq $FRZ($ct)");
#    } elsif ($which eq 'in') {
#        $c->add_runtime_smartmatch_pragma($cd);
#        $c->add_ccl($cd, "$FRZ($dt) ~~ [map {$FRZ(\$_)} \@{ $ct }]");
#    }
#}
#
#sub superclause_has_elems {
#    my ($self_th, $which, $cd) = @_;
#    my $c  = $self_th->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'len') {
#        $c->add_ccl($cd, "\@{$dt} == $ct");
#    } elsif ($which eq 'min_len') {
#        $c->add_ccl($cd, "\@{$dt} >= $ct");
#    } elsif ($which eq 'max_len') {
#        $c->add_ccl($cd, "\@{$dt} <= $ct");
#    } elsif ($which eq 'len_between') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl(
#                $cd, "\@{$dt} >= $ct\->[0] && \@{$dt} >= $ct\->[1]");
#        } else {
#            $c->add_ccl(
#                $cd, "\@{$dt} >= $cv->[0] && \@{$dt} <= $cv->[1]");
#        }
#    } elsif ($which eq 'has') {
#        $c->add_runtime_smartmatch_pragma($cd);
#
#        $c->add_ccl($cd, "$ct ~~ $dt");
#    } elsif ($which eq 'each_index') {
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#        $self_th->gen_each($cd, "0..\@{$cd->{data_term}}-1", '_', '$_');
#        $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#    } elsif ($which eq 'each_elem') {
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#        $self_th->gen_each($cd, "0..\@{$cd->{data_term}}-1", '_', "$cd->{data_term}\->[\$_]");
#        $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#    } elsif ($which eq 'check_each_index') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'check_each_elem') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'uniq') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'exists') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    }
#}
#
#sub clause_elems {
#    my ($self_th, $cd) = @_;
#    my $c  = $self_th->compiler;
#    my $cv = $cd->{cl_value};
#    my $dt = $cd->{data_term};
#
#    local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
#
#    my $jccl;
#    {
#        local $cd->{ccls} = [];
#
#        my $cdef = $cd->{clset}{"elems.create_default"} // 1;
#        delete $cd->{uclset}{"elems.create_default"};
#
#        for my $i (0..@$cv-1) {
#            local $cd->{spath} = [@{$cd->{spath}}, $i];
#            my $sch = $c->main->normalize_schema($cv->[$i]);
#            my $edt = "$dt\->[$i]";
#            my %iargs = %{$cd->{args}};
#            $iargs{outer_cd}             = $cd;
#            $iargs{data_name}            = "$cd->{args}{data_name}_$i";
#            $iargs{data_term}            = $edt;
#            $iargs{schema}               = $sch;
#            $iargs{schema_is_normalized} = 1;
#            $iargs{indent_level}++;
#            my $icd = $c->compile(%iargs);
#            my @code = (
#                ($c->indent_str($cd), "(\$_sahv_dpath->[-1] = $i),\n") x !!$cd->{use_dpath},
#                $icd->{result}, "\n",
#            );
#            my $ires = join("", @code);
#            local $cd->{_debug_ccl_note} = "elem: $i";
#            if ($cdef && defined($sch->[1]{default})) {
#                $c->add_ccl($cd, $ires);
#            } else {
#                $c->add_ccl($cd, "\@{$dt} < ".($i+1)." || ($ires)");
#            }
#        }
#        $jccl = $c->join_ccls(
#            $cd, $cd->{ccls}, {err_msg => ''});
#    }
#    $c->add_ccl($cd, $jccl, {subdata=>1});
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/bool.pm ###
#package Data::Sah::Compiler::perl::TH::bool;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::bool';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = "!ref($dt)";
#}
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'is') {
#        $c->add_ccl($cd, "($dt ? 1:0) == ($ct ? 1:0)");
#    } elsif ($which eq 'in') {
#        $c->add_runtime_smartmatch_pragma($cd);
#        $c->add_ccl($cd, "($dt ? 1:0) ~~ [map {\$_?1:0} \@{$ct}]");
#    }
#}
#
#sub superclause_sortable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'min') {
#        $c->add_ccl($cd, "($dt ? 1:0) >= ($ct ? 1:0)");
#    } elsif ($which eq 'xmin') {
#        $c->add_ccl($cd, "($dt ? 1:0) > ($ct ? 1:0)");
#    } elsif ($which eq 'max') {
#        $c->add_ccl($cd, "($dt ? 1:0) <= ($ct ? 1:0)");
#    } elsif ($which eq 'xmax') {
#        $c->add_ccl($cd, "($dt ? 1:0) < ($ct ? 1:0)");
#    } elsif ($which eq 'between') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "($dt ? 1:0) >= ($ct\->[0] ? 1:0) && ".
#                            "($dt ? 1:0) <= ($ct\->[1] ? 1:0)");
#        } else {
#            $c->add_ccl($cd, "($dt ? 1:0) >= ($cv->[0] ? 1:0) && ".
#                            "($dt ? 1:0) <= ($cv->[1] ? 1:0)");
#        }
#    } elsif ($which eq 'xbetween') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "($dt ? 1:0) > ($ct\->[0] ? 1:0) && ".
#                            "($dt ? 1:0) < ($ct\->[1] ? 1:0)");
#        } else {
#            $c->add_ccl($cd, "($dt ? 1:0) > ($cv->[0] ? 1:0) && ".
#                            "($dt ? 1:0) < ($cv->[1] ? 1:0)");
#        }
#    }
#}
#
#sub clause_is_true {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_ccl($cd, "($ct) ? $dt : !defined($ct) ? 1 : !$dt");
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/buf.pm ###
#package Data::Sah::Compiler::perl::TH::buf;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH::str';
#with 'Data::Sah::Type::buf';
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/cistr.pm ###
#package Data::Sah::Compiler::perl::TH::cistr;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH::str';
#with 'Data::Sah::Type::cistr';
#
#sub before_all_clauses {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#    my $dt = $cd->{data_term};
#
#
#    $self->set_tmp_data_term($cd, "lc($dt)");
#}
#
#sub after_all_clauses {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#    my $dt = $cd->{data_term};
#
#    $self->restore_data_term($cd);
#}
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'is') {
#        $c->add_ccl($cd, "$dt eq lc($ct)");
#    } elsif ($which eq 'in') {
#        $c->add_runtime_smartmatch_pragma($cd);
#        $c->add_ccl($cd, "$dt ~~ [map {lc} \@{ $ct }]");
#    }
#}
#
#sub superclause_sortable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'min') {
#        $c->add_ccl($cd, "$dt ge lc($ct)");
#    } elsif ($which eq 'xmin') {
#        $c->add_ccl($cd, "$dt gt lc($ct)");
#    } elsif ($which eq 'max') {
#        $c->add_ccl($cd, "$dt le lc($ct)");
#    } elsif ($which eq 'xmax') {
#        $c->add_ccl($cd, "$dt lt lc($ct)");
#    } elsif ($which eq 'between') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "$dt ge lc($ct\->[0]) && ".
#                            "$dt le lc($ct\->[1])");
#        } else {
#            $c->add_ccl($cd, "$dt ge ".$c->literal(lc $cv->[0]).
#                            " && $dt le ".$c->literal(lc $cv->[1]));
#        }
#    } elsif ($which eq 'xbetween') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "$dt gt lc($ct\->[0]) && ".
#                            "$dt lt lc($ct\->[1])");
#        } else {
#            $c->add_ccl($cd, "$dt gt ".$c->literal(lc $cv->[0]).
#                            " && $dt lt ".$c->literal(lc $cv->[1]));
#        }
#    }
#}
#
#sub superclause_has_elems {
#    my ($self_th, $which, $cd) = @_;
#    my $c  = $self_th->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'has') {
#        $c->add_ccl($cd, "index($dt, lc($ct)) > -1");
#    } else {
#        $self_th->SUPER::superclause_has_elems($which, $cd);
#    }
#}
#
#sub __change_re_str_switch {
#    my $re = shift;
#
#    if ($^V ge v5.14.0) {
#        state $sub = sub { my $s = shift; $s =~ /i/ ? $s : "i$s" };
#        $re =~ s/\A\(\?\^(\w*):/"(?".$sub->($1).":"/e;
#    } else {
#        state $subl = sub { my $s = shift; $s =~ /i/ ? $s : "i$s" };
#        state $subr = sub { my $s = shift; $s =~ s/i//; $s };
#        $re =~ s/\A\(\?(\w*)-(\w*):/"(?".$subl->($1)."-".$subr->($2).":"/e;
#    }
#    return $re;
#}
#
#sub clause_match {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->add_ccl($cd, join(
#            "",
#            "ref($ct) eq 'Regexp' ? $dt =~ qr/$ct/i : ",
#            "do { my \$re = $ct; eval { \$re = /\$re/i; 1 } && ",
#            "$dt =~ \$re }",
#        ));
#    } else {
#        my $re = $c->_str2reliteral($cd, $cv);
#        $re = __change_re_str_switch($re);
#        $c->add_ccl($cd, "$dt =~ /$re/i");
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/code.pm ###
#package Data::Sah::Compiler::perl::TH::code;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::code';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = "ref($dt) eq 'CODE'";
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/date.pm ###
#package Data::Sah::Compiler::perl::TH::date;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#use Scalar::Util qw(blessed looks_like_number);
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::date';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $dt = $cd->{data_term};
#
#    $cd->{coerce_to} = $cd->{nschema}[1]{"x.perl.coerce_to"} // 'float(epoch)';
#
#    my $coerce_to = $cd->{coerce_to};
#
#    if ($coerce_to eq 'float(epoch)') {
#        $cd->{_ccl_check_type} = "!ref($dt) && $dt =~ /\\A[0-9]+\\z/";
#    } elsif ($coerce_to eq 'DateTime') {
#        $c->add_runtime_module($cd, 'Scalar::Util');
#        $cd->{_ccl_check_type} = "Scalar::Util::blessed($dt) && $dt\->isa('DateTime')";
#    } elsif ($coerce_to eq 'Time::Moment') {
#        $c->add_runtime_module($cd, 'Scalar::Util');
#        $cd->{_ccl_check_type} = "Scalar::Util::blessed($dt) && $dt\->isa('Time::Moment')";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', use either ".
#            "float(epoch), DateTime, or Time::Moment";
#    }
#}
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->_die($cd, "date's comparison with expression not yet supported");
#    }
#
#    my $coerce_to = $cd->{coerce_to};
#    if ($coerce_to eq 'float(epoch)') {
#        if ($which eq 'is') {
#            $c->add_ccl($cd, "$dt == $ct");
#        } elsif ($which eq 'in') {
#            $c->add_runtime_module($cd, 'List::Util');
#            $c->add_ccl($cd, "List::Util::first(sub{$dt == \$_}, $ct)");
#        }
#    } elsif ($coerce_to eq 'DateTime') {
#        my $ect = "DateTime->from_epoch(epoch=>".$cv->epoch.")";
#
#        if ($which eq 'is') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect)==0");
#        } elsif ($which eq 'in') {
#            $c->add_runtime_module($cd, 'List::Util');
#            $c->add_ccl($cd, "List::Util::first(sub{DateTime->compare($dt, \$_)==0}, $ect)");
#        }
#    } elsif ($coerce_to eq 'Time::Moment') {
#        my $ect = "Time::Moment->from_epoch(".$cv->epoch.")";
#
#        if ($which eq 'is') {
#            $c->add_ccl($cd, "$dt\->compare($ect)==0");
#        } elsif ($which eq 'in') {
#            $c->add_runtime_module($cd, 'List::Util');
#            $c->add_ccl($cd, "List::Util::first(sub{$dt\->compare(\$_)==0}, $ect)");
#        }
#    }
#}
#
#sub superclause_sortable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->_die($cd, "date's comparison with expression not yet supported");
#    }
#
#    my $coerce_to = $cd->{coerce_to};
#    if ($coerce_to eq 'float(epoch)') {
#        if ($which eq 'min') {
#            $c->add_ccl($cd, "$dt >= $cv");
#        } elsif ($which eq 'xmin') {
#            $c->add_ccl($cd, "$dt > $cv");
#        } elsif ($which eq 'max') {
#            $c->add_ccl($cd, "$dt <= $cv");
#        } elsif ($which eq 'xmax') {
#            $c->add_ccl($cd, "$dt < $cv");
#        } elsif ($which eq 'between') {
#            $c->add_ccl($cd, "$dt >= $cv->[0] && $dt <= $cv->[1]");
#        } elsif ($which eq 'xbetween') {
#            $c->add_ccl($cd, "$dt >  $cv->[0] && $dt <  $cv->[1]");
#        }
#    } elsif ($coerce_to eq 'DateTime') {
#        my ($ect, $ect0, $ect1);
#        if (ref($cv) eq 'ARRAY') {
#            $ect0 = "DateTime->from_epoch(epoch=>".$cv->[0]->epoch.")";
#            $ect1 = "DateTime->from_epoch(epoch=>".$cv->[1]->epoch.")";
#        } else {
#            $ect = "DateTime->from_epoch(epoch=>".$cv->epoch.")";
#        }
#
#        if ($which eq 'min') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) >= 0");
#        } elsif ($which eq 'xmin') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) > 0");
#        } elsif ($which eq 'max') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) <= 0");
#        } elsif ($which eq 'xmax') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) < 0");
#        } elsif ($which eq 'between') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect0) >= 0 && DateTime->compare($dt, $ect1) <= 0");
#        } elsif ($which eq 'xbetween') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect0) >  0 && DateTime->compare($dt, $ect1) <  0");
#        }
#    } elsif ($coerce_to eq 'Time::Moment') {
#        my ($ect, $ect0, $ect1);
#        if (ref($cv) eq 'ARRAY') {
#            $ect0 = "Time::Moment->from_epoch(".$cv->[0]->epoch.")";
#            $ect1 = "Time::Moment->from_epoch(".$cv->[1]->epoch.")";
#        } else {
#            $ect = "Time::Moment->from_epoch(".$cv->epoch.")";
#        }
#
#        if ($which eq 'min') {
#            $c->add_ccl($cd, "$dt\->compare($ect) >= 0");
#        } elsif ($which eq 'xmin') {
#            $c->add_ccl($cd, "$dt\->compare($ect) > 0");
#        } elsif ($which eq 'max') {
#            $c->add_ccl($cd, "$dt\->compare($ect) <= 0");
#        } elsif ($which eq 'xmax') {
#            $c->add_ccl($cd, "$dt\->compare($ect) < 0");
#        } elsif ($which eq 'between') {
#            $c->add_ccl($cd, "$dt\->compare($ect0) >= 0 && $dt\->compare($ect1) <= 0");
#        } elsif ($which eq 'xbetween') {
#            $c->add_ccl($cd, "$dt\->compare($ect0) >  0 && $dt\->compare($ect1) <  0");
#        }
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/duration.pm ###
#package Data::Sah::Compiler::perl::TH::duration;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#use Scalar::Util qw(blessed looks_like_number);
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::duration';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $dt = $cd->{data_term};
#
#    $cd->{coerce_to} = $cd->{nschema}[1]{"x.perl.coerce_to"} // 'float(secs)';
#
#    my $coerce_to = $cd->{coerce_to};
#
#    if ($coerce_to eq 'float(secs)') {
#        $cd->{_ccl_check_type} = "!ref($dt) && $dt =~ /\\A[0-9]+(?:\.[0-9]+)?\\z/"; 
#    } elsif ($coerce_to eq 'DateTime::Duration') {
#        $c->add_runtime_module($cd, 'Scalar::Util');
#        $cd->{_ccl_check_type} = "Scalar::Util::blessed($dt) && $dt\->isa('DateTime::Duration')";
#    } else {
#        die "BUG: Unknown coerce_to value '$coerce_to', use either ".
#            "float(secs) or DateTime::Duration";
#    }
#}
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->_die($cd, "duration's comparison with expression not yet supported");
#    }
#
#    my $coerce_to = $cd->{coerce_to};
#    if ($coerce_to eq 'float(secs)') {
#        if ($which eq 'is') {
#            $c->add_ccl($cd, "$dt == $ct"); 
#        } elsif ($which eq 'in') {
#            $c->add_runtime_module('List::Util');
#            $c->add_ccl($cd, "List::Util::first(sub{$dt == \$_}, $ct)"); 
#        }
#    } elsif ($coerce_to eq 'DateTime::Duration') {
#        my $ect = join(
#            "",
#            "DateTime::Duration->new(",
#            "years => "  .$cv->years.",",
#            "months => " .$cv->months.",",
#            "weeks => "  .$cv->weeks.",",
#            "days => "   .$cv->days.",",
#            "hours => "  .$cv->hours.",",
#            "minutes => ".$cv->minutes.",",
#            "seconds => ".$cv->seconds.",",
#            ")",
#        );
#
#        if ($which eq 'is') {
#            $c->add_ccl($cd, "DateTime::Duration->compare($dt, $ect)==0");
#        } elsif ($which eq 'in') {
#            $c->add_runtime_module('List::Util');
#            $c->add_ccl($cd, "List::Util::first(sub{DateTime::Duration->compare($dt, \$_)==0}, $ect)");
#        }
#    }
#}
#
#sub superclause_sortable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->_die($cd, "duration's comparison with expression not yet supported");
#    }
#
#    my $coerce_to = $cd->{coerce_to};
#    if ($coerce_to eq 'float(secs)') {
#        if ($which eq 'min') {
#            $c->add_ccl($cd, "$dt >= $cv");
#        } elsif ($which eq 'xmin') {
#            $c->add_ccl($cd, "$dt > $cv");
#        } elsif ($which eq 'max') {
#            $c->add_ccl($cd, "$dt <= $cv");
#        } elsif ($which eq 'xmax') {
#            $c->add_ccl($cd, "$dt < $cv");
#        } elsif ($which eq 'between') {
#            $c->add_ccl($cd, "$dt >= $cv->[0] && $dt <= $cv->[1]");
#        } elsif ($which eq 'xbetween') {
#            $c->add_ccl($cd, "$dt >  $cv->[0] && $dt <  $cv->[1]");
#        }
#    } elsif ($coerce_to eq 'DateTime::Duration') {
#        my ($ect, $ect0, $ect1);
#        if (ref($cv) eq 'ARRAY') {
#            $ect0 = join(
#                "",
#                "DateTime::Duration->new(",
#                "years => "  .$cv->[0]->years.",",
#                "months => " .$cv->[0]->months.",",
#                "weeks => "  .$cv->[0]->weeks.",",
#                "days => "   .$cv->[0]->days.",",
#                "hours => "  .$cv->[0]->hours.",",
#                "minutes => ".$cv->[0]->minutes.",",
#                "seconds => ".$cv->[0]->seconds.",",
#                ")",
#            );
#            $ect1 = join(
#                "",
#                "DateTime::Duration->new(",
#                "years => "  .$cv->[1]->years.",",
#                "months => " .$cv->[1]->months.",",
#                "weeks => "  .$cv->[1]->weeks.",",
#                "days => "   .$cv->[1]->days.",",
#                "hours => "  .$cv->[1]->hours.",",
#                "minutes => ".$cv->[1]->minutes.",",
#                "seconds => ".$cv->[1]->seconds.",",
#                ")",
#            );
#        } else {
#            $ect = join(
#                "",
#                "DateTime::Duration->new(",
#                "years => "  .$cv->years.",",
#                "months => " .$cv->months.",",
#                "weeks => "  .$cv->weeks.",",
#                "days => "   .$cv->days.",",
#                "hours => "  .$cv->hours.",",
#                "minutes => ".$cv->minutes.",",
#                "seconds => ".$cv->seconds.",",
#                ")",
#            );
#        }
#
#        if ($which eq 'min') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) >= 0");
#        } elsif ($which eq 'xmin') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) > 0");
#        } elsif ($which eq 'max') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) <= 0");
#        } elsif ($which eq 'xmax') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect) < 0");
#        } elsif ($which eq 'between') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect0) >= 0 && DateTime->compare($dt, $ect1) <= 0");
#        } elsif ($which eq 'xbetween') {
#            $c->add_ccl($cd, "DateTime->compare($dt, $ect0) >  0 && DateTime->compare($dt, $ect1) <  0");
#        }
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/float.pm ###
#package Data::Sah::Compiler::perl::TH::float;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH::num';
#with 'Data::Sah::Type::float';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#        $cd->{_ccl_check_type} = "$dt =~ ".'/\A(?:[+-]?(?:0|[1-9][0-9]*)(\.[0-9]+)?([eE][+-]?[0-9]+)?|((?i)\s*nan\s*)|((?i)\s*[+-]?inf(inity)?)\s*)\z/';
#    } else {
#        $c->add_sun_module($cd);
#        $cd->{_ccl_check_type} = "$cd->{_sun_module}::isnum($dt)";
#    }
#}
#
#sub clause_is_nan {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#            $c->add_ccl(
#                $cd,
#                qq[$ct ? lc($dt+0) eq "nan" : defined($ct) ? lc($dt+0) ne "nan" : 1],
#            );
#        } else {
#            $c->add_ccl(
#                $cd,
#                join(
#                    "",
#                    "$ct ? $cd->{_sun_module}::isnan($dt) : ",
#                    "defined($ct) ? !$cd->{_sun_module}::isnan($dt) : 1",
#                )
#            );
#        }
#    } else {
#        if ($cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[lc($dt+0) eq "nan"]);
#            } else {
#                $c->add_ccl($cd, "$cd->{_sun_module}::isnan($dt)");
#            }
#        } elsif (defined $cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[lc($dt+0) ne "nan"]);
#            } else {
#                $c->add_ccl($cd, "!$cd->{_sun_module}::isnan($dt)");
#            }
#        }
#    }
#}
#
#sub clause_is_neg_inf {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#            $c->add_ccl(
#                $cd, join(
#                    '',
#                    qq[$ct ? $dt =~ /\\A\\s*-inf(inity)?\\s*\\z/i : ],
#                    qq[defined($ct) ? $dt !~ /\\A\\s*inf(inity)?\\s*\\z/i : 1]
#                ));
#        } else {
#            $c->add_ccl(
#                $cd, join(
#                    '',
#                    "$ct ? $cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt) : ",
#                    "defined($ct) ? !($cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt)) : 1",
#                ));
#        }
#    } else {
#        if ($cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[$dt =~ /\\A\\s*-inf(inity)?\\s*\\z/i]);
#            } else {
#                $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt)");
#            }
#        } elsif (defined $cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[$dt !~ /\\A\\s*-inf(inity)?\\s*\\z/i]);
#            } else {
#                $c->add_ccl($cd, "!($cd->{_sun_module}::isinf($dt) && $cd->{_sun_module}::isneg($dt))");
#            }
#        }
#    }
#}
#
#sub clause_is_pos_inf {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#            $c->add_ccl(
#                $cd, join(
#                    '',
#                    qq[$ct ? $dt =~ /\\A\\s*inf(inity)?\\s*\\z/i : ],
#                    qq[defined($ct) ? $dt !~ /\\A\\s*inf(inity)?\\s*\\z/i : 1]
#                ));
#        } else {
#            $c->add_ccl(
#                $cd, join(
#                    '',
#                    "$ct ? $cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt) : ",
#                    "defined($ct) ? !($cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt)) : 1",
#                ));
#        }
#    } else {
#        if ($cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[$dt =~ /\\A\\s*inf(inity)?\\s*\\z/i]);
#            } else {
#                $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt)");
#            }
#        } elsif (defined $cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[$dt !~ /\\A\\s*inf(inity)?\\s*\\z/i]);
#            } else {
#                $c->add_ccl($cd, "!($cd->{_sun_module}::isinf($dt) && !$cd->{_sun_module}::isneg($dt))");
#            }
#        }
#    }
#}
#
#sub clause_is_inf {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#            $c->add_ccl(
#                $cd, join(
#                    '',
#                    qq[$ct ? $dt =~ /\\A\\s*-?inf(inity)?\\s*\\z/i : ],
#                    qq[defined($ct) ? $dt+0 !~ /\\A-?inf\\z/ : 1]
#                ));
#        } else {
#            $c->add_ccl($cd, "$ct ? $cd->{_sun_module}::isinf($dt) : ".
#                            "defined($ct) ? $cd->{_sun_module}::isinf($dt) : 1");
#        }
#    } else {
#        if ($cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[$dt =~ /\\A\\s*-?inf(inity)?\\s*\\z/i]);
#            } else {
#                $c->add_ccl($cd, "$cd->{_sun_module}::isinf($dt)");
#            }
#        } elsif (defined $cd->{cl_value}) {
#            if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#                $c->add_ccl($cd, qq[$dt !~ /\\A\\s*-?inf(inity)?\\s*\\z/i]);
#            } else {
#                $c->add_ccl($cd, "!$cd->{_sun_module}::isinf($dt)");
#            }
#        }
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/hash.pm ###
#package Data::Sah::Compiler::perl::TH::hash;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Data::Dmp;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::hash';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = "ref($dt) eq 'HASH'";
#}
#
#my $FRZ = "Storable::freeze";
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_runtime_module($cd, 'Storable');
#
#    if ($which eq 'is') {
#        $c->add_ccl($cd, "$FRZ($dt) eq $FRZ($ct)");
#    } elsif ($which eq 'in') {
#        $c->add_runtime_smartmatch_pragma($cd);
#        $c->add_ccl($cd, "$FRZ($dt) ~~ [map {$FRZ(\$_)} \@{ $ct }]");
#    }
#}
#
#sub superclause_has_elems {
#    my ($self_th, $which, $cd) = @_;
#    my $c  = $self_th->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'len') {
#        $c->add_ccl($cd, "keys(\%{$dt}) == $ct");
#    } elsif ($which eq 'min_len') {
#        $c->add_ccl($cd, "keys(\%{$dt}) >= $ct");
#    } elsif ($which eq 'max_len') {
#        $c->add_ccl($cd, "keys(\%{$dt}) <= $ct");
#    } elsif ($which eq 'len_between') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl(
#                $cd, "keys(\%{$dt}) >= $ct\->[0] && ".
#                    "keys(\%{$dt}) >= $ct\->[1]");
#        } else {
#            $c->add_ccl(
#                $cd, "keys(\%{$dt}) >= $cv->[0] && ".
#                    "keys(\%{$dt}) <= $cv->[1]");
#        }
#    } elsif ($which eq 'has') {
#        $c->add_runtime_smartmatch_pragma($cd);
#
#        $c->add_ccl($cd, "$ct ~~ [values \%{ $dt }]");
#    } elsif ($which eq 'each_index') {
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#        $self_th->gen_each($cd, "sort keys(\%{$cd->{data_term}})", '', '$_');
#        $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#    } elsif ($which eq 'each_elem') {
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#        $self_th->gen_each($cd, "sort keys(\%{$cd->{data_term}})", '_', "$cd->{data_term}\->{\$_}");
#        $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#    } elsif ($which eq 'check_each_index') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'check_each_elem') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'uniq') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'exists') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    }
#}
#
#sub _clause_keys_or_re_keys {
#    my ($self_th, $which, $cd) = @_;
#    my $c  = $self_th->compiler;
#    my $cv = $cd->{cl_value};
#    my $dt = $cd->{data_term};
#
#    local $cd->{_subdata_level} = $cd->{_subdata_level} + 1;
#
#
#    my $jccl;
#    {
#        local $cd->{ccls} = [];
#
#        my $lit_valid_keys;
#        if ($which eq 'keys') {
#            $lit_valid_keys = $c->literal([sort keys %$cv]);
#        } else {
#            $lit_valid_keys = "[".
#                join(",", map { "qr/".$c->_str2reliteral($cd, $_)."/" }
#                         sort keys %$cv)."]";
#        }
#
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#
#        if ($cd->{clset}{"$which.restrict"} // 1) {
#            local $cd->{_debug_ccl_note} = "$which.restrict";
#            $c->add_runtime_module($cd, "List::Util");
#            $c->add_runtime_smartmatch_pragma($cd);
#            $c->add_ccl(
#                $cd,
#                "!defined(List::Util::first(sub {!(\$_ ~~ $lit_valid_keys)}, ".
#                    "keys %{$cd->{data_term}}))",
#                {
#                    err_msg => 'TMP1',
#                    err_expr => join(
#                        "",
#                        'sprintf(',
#                        $c->literal($c->_xlt(
#                            $cd, "hash contains ".
#                                "unknown field(s) (%s)")),
#                        ',',
#                        "join(', ', sort grep {!(\$_ ~~ $lit_valid_keys)} ",
#                        "keys %{$cd->{data_term}})",
#                        ')',
#                    ),
#                },
#            );
#            $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#        }
#        delete $cd->{uclset}{"$which.restrict"};
#
#        my $cdef;
#        if ($which eq 'keys') {
#            $cdef = $cd->{clset}{"keys.create_default"} // 1;
#            delete $cd->{uclset}{"keys.create_default"};
#        }
#
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#
#        my $nkeys = scalar(keys %$cv);
#        my $i = 0;
#        for my $k (sort keys %$cv) {
#            my $kre = $c->_str2reliteral($cd, $k);
#            local $cd->{spath} = [@{ $cd->{spath} }, $k];
#            ++$i;
#            my $sch = $c->main->normalize_schema($cv->{$k});
#            my $kdn = $k; $kdn =~ s/\W+/_/g;
#            my $klit = $which eq 're_keys' ? '$_' : $c->literal($k);
#            my $kdt = "$cd->{data_term}\->{$klit}";
#            my %iargs = %{$cd->{args}};
#            $iargs{outer_cd}             = $cd;
#            $iargs{data_name}            = $kdn;
#            $iargs{data_term}            = $kdt;
#            $iargs{schema}               = $sch;
#            $iargs{schema_is_normalized} = 1;
#            $iargs{indent_level}++;
#            $iargs{data_term_includes_topic_var} = 1 if $which eq 're_keys';
#            my $icd = $c->compile(%iargs);
#
#            my $sdef = $cdef && defined($sch->[1]{default});
#
#            $c->add_var($cd, '_sahv_stack', []) if $cd->{use_dpath};
#
#            my @code = (
#                ($c->indent_str($cd), "(push(@\$_sahv_dpath, undef), push(\@\$_sahv_stack, undef), \$_sahv_stack->[-1] = \n")
#                    x !!($cd->{use_dpath} && $i == 1),
#
#                ('(!defined(List::Util::first(sub {!(')
#                    x !!($which eq 're_keys'),
#
#                $which eq 're_keys' ? "\$_ !~ /$kre/ || (" :
#                    ($sdef ? "" : "!exists($kdt) || ("),
#
#                ($c->indent_str($cd), "(\$_sahv_dpath->[-1] = ".
#                     ($which eq 're_keys' ? '$_' : $klit)."),\n")
#                         x !!$cd->{use_dpath},
#                $icd->{result}, "\n",
#
#                $which eq 're_keys' || !$sdef ? ")" : "",
#
#                (")}, sort keys %{ $cd->{data_term} })))")
#                    x !!($which eq 're_keys'),
#
#                ($c->indent_str($cd), "), pop(\@\$_sahv_dpath), pop(\@\$_sahv_stack)\n")
#                    x !!($cd->{use_dpath} && $i == $nkeys),
#            );
#            my $ires = join("", @code);
#            local $cd->{_debug_ccl_note} = "$which: ".$c->literal($k);
#            $c->add_ccl($cd, $ires);
#        }
#
#        $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#
#        $jccl = $c->join_ccls(
#            $cd, $cd->{ccls}, {err_msg => ''});
#    }
#    $c->add_ccl($cd, $jccl, {});
#}
#
#sub clause_keys {
#    my ($self, $cd) = @_;
#    $self->_clause_keys_or_re_keys('keys', $cd);
#}
#
#sub clause_re_keys {
#    my ($self, $cd) = @_;
#    $self->_clause_keys_or_re_keys('re_keys', $cd);
#}
#
#sub clause_req_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; !defined(List::Util::first(sub {!exists(\$_sahv_h\->{\$_})}, \@{ $ct })) }",
#      {
#        err_msg => 'TMP',
#        err_expr =>
#          "sprintf(".
#          $c->literal($c->_xlt($cd, "hash has missing required field(s) (%s)")).
#          ",join(', ', do { my \$_sahv_h = $dt; grep { !exists(\$_sahv_h\->{\$_}) } \@{ $ct } }))"
#      }
#    );
#}
#
#sub clause_allowed_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_runtime_smartmatch_pragma($cd);
#    $c->add_ccl(
#      $cd,
#      "!defined(List::Util::first(sub {!(\$_ ~~ $ct)}, keys \%{ $dt }))",
#      {
#        err_msg => 'TMP',
#        err_expr =>
#          "sprintf(".
#          $c->literal($c->_xlt($cd, "hash contains non-allowed field(s) (%s)")).
#          ",join(', ', sort grep { !(\$_ ~~ $ct) } keys \%{ $dt }))"
#      }
#    );
#}
#
#sub clause_allowed_keys_re {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->_die_unimplemented_clause($cd, "with expr");
#    }
#
#    my $re = $c->_str2reliteral($cd, $cv);
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_runtime_smartmatch_pragma($cd);
#    $c->add_ccl(
#        $cd,
#        "!defined(List::Util::first(sub {\$_ !~ /$re/}, keys \%{ $dt }))",
#        {
#          err_msg => 'TMP',
#          err_expr =>
#          "sprintf(".
#          $c->literal($c->_xlt($cd, "hash contains non-allowed field(s) (%s)")).
#          ",join(', ', sort grep { \$_ !~ /$re/ } keys \%{ $dt }))"
#      }
#    );
#}
#
#sub clause_forbidden_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_runtime_smartmatch_pragma($cd);
#    $c->add_ccl(
#      $cd,
#      "!defined(List::Util::first(sub {\$_ ~~ $ct}, keys \%{ $dt }))",
#      {
#        err_msg => 'TMP',
#        err_expr =>
#          "sprintf(".
#          $c->literal($c->_xlt($cd, "hash contains forbidden field(s) (%s)")).
#          ",join(', ', sort grep { \$_ ~~ $ct } keys \%{ $dt }))"
#      }
#    );
#}
#
#sub clause_forbidden_keys_re {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->_die_unimplemented_clause($cd, "with expr");
#    }
#
#    my $re = $c->_str2reliteral($cd, $cv);
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_runtime_smartmatch_pragma($cd);
#    $c->add_ccl(
#        $cd,
#        "!defined(List::Util::first(sub {\$_ =~ /$re/}, keys \%{ $dt }))",
#        {
#          err_msg => 'TMP',
#          err_expr =>
#          "sprintf(".
#          $c->literal($c->_xlt($cd, "hash contains forbidden field(s) (%s)")).
#          ",join(', ', sort grep { \$_ =~ /$re/ } keys \%{ $dt }))"
#      }
#    );
#}
#
#sub clause_choose_one_key {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ $ct }) <= 1 }",
#      {},
#    );
#}
#
#sub clause_choose_all_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; my \$_sahv_keys = $ct; my \$_sahv_tot = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@\$_sahv_keys); \$_sahv_tot==0 || \$_sahv_tot==\@\$_sahv_keys }",
#      {},
#    );
#}
#
#sub clause_req_one_key {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ $ct }) == 1 }",
#      {},
#    );
#}
#
#sub clause_req_some_keys {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; my \$_sahv_n = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ ".$c->literal($cv->[2])." }); \$_sahv_n >= $cv->[0] && \$_sahv_n <= $cv->[1] }",
#      {},
#    );
#}
#
#sub clause_dep_any {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
#          "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) ? 1:0; ".
#          "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
#          "!\$_sahv_has_dep || \$_sahv_has_prereq }",
#      {},
#    );
#}
#
#sub clause_dep_all {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
#          "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) == \@{ \$_sahv_ct->[1] } ? 1:0; ".
#          "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
#          "!\$_sahv_has_dep || \$_sahv_has_prereq }",
#      {},
#    );
#}
#
#sub clause_req_dep_any {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
#          "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) ? 1:0; ".
#          "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
#          "\$_sahv_has_dep || !\$_sahv_has_prereq }",
#      {},
#    );
#}
#
#sub clause_req_dep_all {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#
#    $c->add_runtime_module($cd, "List::Util");
#    $c->add_ccl(
#      $cd,
#      "do { my \$_sahv_h = $dt; my \$_sahv_ct = $ct; ".
#          "my \$_sahv_has_prereq = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} \@{ \$_sahv_ct->[1] }) == \@{ \$_sahv_ct->[1] } ? 1:0; ".
#          "my \$_sahv_has_dep    = List::Util::sum(map {exists(\$_sahv_h\->{\$_}) ? 1:0} (ref(\$_sahv_ct->[0]) eq 'ARRAY' ? \@{ \$_sahv_ct->[0] } : (\$_sahv_ct->[0]))) ? 1:0; ".
#          "\$_sahv_has_dep || !\$_sahv_has_prereq }",
#      {},
#    );
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/int.pm ###
#package Data::Sah::Compiler::perl::TH::int;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH::num';
#with 'Data::Sah::Type::int';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#        $cd->{_ccl_check_type} = "$dt =~ ".'/\A[+-]?(?:0|[1-9][0-9]*)\z/';
#    } else {
#        $c->add_sun_module($cd);
#        $cd->{_ccl_check_type} =
#            "$cd->{_sun_module}::isint($dt)";
#    }
#}
#
#sub clause_div_by {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_ccl($cd, "$dt % $ct == 0");
#}
#
#sub clause_mod {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_ccl($cd, "$dt % $ct\->[0] == $ct\->[1]");
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/num.pm ###
#package Data::Sah::Compiler::perl::TH::num;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::num';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#    my $dt = $cd->{data_term};
#
#    if ($cd->{args}{core} || $cd->{args}{no_modules}) {
#        $cd->{_ccl_check_type} = "$dt =~ ".'/\A(?:[+-]?(?:0|[1-9][0-9]*)(\.[0-9]+)?([eE][+-]?[0-9]+)?|((?i)\s*nan\s*)|((?i)\s*[+-]?inf(inity)?)\s*)\z/';
#    } else {
#        $c->add_sun_module($cd);
#        $cd->{_ccl_check_type} = "$cd->{_sun_module}::isnum($dt)";
#    }
#}
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'is') {
#        $c->add_ccl($cd, "$dt == $ct");
#    } elsif ($which eq 'in') {
#        $c->add_runtime_smartmatch_pragma($cd);
#        $c->add_ccl($cd, "$dt ~~ $ct");
#    }
#}
#
#sub superclause_sortable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'min') {
#        $c->add_ccl($cd, "$dt >= $ct");
#    } elsif ($which eq 'xmin') {
#        $c->add_ccl($cd, "$dt > $ct");
#    } elsif ($which eq 'max') {
#        $c->add_ccl($cd, "$dt <= $ct");
#    } elsif ($which eq 'xmax') {
#        $c->add_ccl($cd, "$dt < $ct");
#    } elsif ($which eq 'between') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "$dt >= $ct\->[0] && $dt <= $ct\->[1]");
#        } else {
#            $c->add_ccl($cd, "$dt >= $cv->[0] && $dt <= $cv->[1]");
#        }
#    } elsif ($which eq 'xbetween') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "$dt > $ct\->[0] && $dt < $ct\->[1]");
#        } else {
#            $c->add_ccl($cd, "$dt > $cv->[0] && $dt < $cv->[1]");
#        }
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/obj.pm ###
#package Data::Sah::Compiler::perl::TH::obj;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::obj';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $c->add_runtime_module($cd, 'Scalar::Util');
#    $cd->{_ccl_check_type} = "Scalar::Util::blessed($dt)";
#}
#
#sub clause_can {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_ccl($cd, "$dt->can($ct)");
#}
#
#sub clause_isa {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->add_ccl($cd, "$dt->isa($ct)");
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/re.pm ###
#package Data::Sah::Compiler::perl::TH::re;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::re';
#
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = "ref($dt) eq 'Regexp' || !ref($dt) && ".
#        "eval { my \$tmp = $dt; qr/\$tmp/; 1 }";
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/str.pm ###
#package Data::Sah::Compiler::perl::TH::str;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::str';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = "!ref($dt)";
#}
#
#sub superclause_comparable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'is') {
#        $c->add_ccl($cd, "$dt eq $ct");
#    } elsif ($which eq 'in') {
#        $c->add_runtime_smartmatch_pragma($cd);
#        $c->add_ccl($cd, "$dt ~~ $ct");
#    }
#}
#
#sub superclause_sortable {
#    my ($self, $which, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'min') {
#        $c->add_ccl($cd, "$dt ge $ct");
#    } elsif ($which eq 'xmin') {
#        $c->add_ccl($cd, "$dt gt $ct");
#    } elsif ($which eq 'max') {
#        $c->add_ccl($cd, "$dt le $ct");
#    } elsif ($which eq 'xmax') {
#        $c->add_ccl($cd, "$dt lt $ct");
#    } elsif ($which eq 'between') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "$dt ge $ct\->[0] && $dt le $ct\->[1]");
#        } else {
#            $c->add_ccl($cd, "$dt ge ".$c->literal($cv->[0]).
#                            " && $dt le ".$c->literal($cv->[1]));
#        }
#    } elsif ($which eq 'xbetween') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl($cd, "$dt gt $ct\->[0] && $dt lt $ct\->[1]");
#        } else {
#            $c->add_ccl($cd, "$dt gt ".$c->literal($cv->[0]).
#                            " && $dt lt ".$c->literal($cv->[1]));
#        }
#    }
#}
#
#sub superclause_has_elems {
#    my ($self_th, $which, $cd) = @_;
#    my $c  = $self_th->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($which eq 'len') {
#        $c->add_ccl($cd, "length($dt) == $ct");
#    } elsif ($which eq 'min_len') {
#        $c->add_ccl($cd, "length($dt) >= $ct");
#    } elsif ($which eq 'max_len') {
#        $c->add_ccl($cd, "length($dt) <= $ct");
#    } elsif ($which eq 'len_between') {
#        if ($cd->{cl_is_expr}) {
#            $c->add_ccl(
#                $cd, "length($dt) >= $ct\->[0] && ".
#                    "length($dt) >= $ct\->[1]");
#        } else {
#            $c->add_ccl(
#                $cd, "length($dt) >= $cv->[0] && ".
#                    "length($dt) <= $cv->[1]");
#        }
#    } elsif ($which eq 'has') {
#        $c->add_ccl($cd, "index($dt, $ct) >= 0");
#    } elsif ($which eq 'each_index') {
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#        $self_th->gen_each($cd, "0..length($cd->{data_term})-1", '_', '$_');
#        $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#    } elsif ($which eq 'each_elem') {
#        $self_th->set_tmp_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#        $self_th->gen_each($cd, "0..length($cd->{data_term})-1", '_', "substr($cd->{data_term}, \$_, 1)");
#        $self_th->restore_data_term($cd) if $cd->{args}{data_term_includes_topic_var};
#    } elsif ($which eq 'check_each_index') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'check_each_elem') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'uniq') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    } elsif ($which eq 'exists') {
#        $self_th->compiler->_die_unimplemented_clause($cd);
#    }
#}
#
#sub clause_encoding {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    $c->_die($cd, "Only 'utf8' encoding is currently supported")
#        unless $cv eq 'utf8';
#}
#
#sub clause_match {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->add_ccl($cd, join(
#            "",
#            "ref($ct) eq 'Regexp' ? $dt =~ $ct : ",
#            "do { my \$re = $ct; eval { \$re = /\$re/; 1 } && ",
#            "$dt =~ \$re }",
#        ));
#    } else {
#        my $re = $c->_str2reliteral($cd, $cv);
#        $c->add_ccl($cd, "$dt =~ qr($re)");
#    }
#}
#
#sub clause_is_re {
#    my ($self, $cd) = @_;
#    my $c  = $self->compiler;
#    my $cv = $cd->{cl_value};
#    my $ct = $cd->{cl_term};
#    my $dt = $cd->{data_term};
#
#    if ($cd->{cl_is_expr}) {
#        $c->add_ccl($cd, join(
#            "",
#            "do { my \$re = $dt; ",
#            "(eval { \$re = qr/\$re/; 1 } ? 1:0) == ($ct ? 1:0) }",
#        ));
#    } else {
#        $c->add_ccl($cd, join(
#            "",
#            "do { my \$re = $dt; ",
#            ($cv ? "" : "!"), "(eval { \$re = qr/\$re/; 1 })",
#            "}",
#        ));
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Compiler/perl/TH/undef.pm ###
#package Data::Sah::Compiler::perl::TH::undef;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#use Role::Tiny::With;
#
#extends 'Data::Sah::Compiler::perl::TH';
#with 'Data::Sah::Type::undef';
#
#sub handle_type {
#    my ($self, $cd) = @_;
#    my $c = $self->compiler;
#
#    my $dt = $cd->{data_term};
#    $cd->{_ccl_check_type} = "!defined($dt)";
#}
#
#1;
#
#__END__
#
### Data/Sah/Human.pm ###
#package Data::Sah::Human;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#our $Log_Validator_Code = $ENV{LOG_SAH_VALIDATOR_CODE} // 0;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(gen_human_msg);
#
#sub gen_human_msg {
#    require Data::Sah;
#
#    my ($schema, $opts) = @_;
#
#    state $hc = Data::Sah->new->get_compiler("human");
#
#    my %args = (schema => $schema, %{$opts // {}});
#    my $opt_source = delete $args{source};
#
#    $args{log_result} = 1 if $Log_Validator_Code;
#
#    my $cd = $hc->compile(%args);
#    $opt_source ? $cd : $cd->{result};
#}
#
#1;
#
#__END__
#
### Data/Sah/Lang.pm ###
#package Data::Sah::Lang;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#our @ISA    = qw(Exporter);
#our @EXPORT = qw(add_translations);
#
#sub add_translations {
#    my %args = @_;
#
#}
#
#1;
#
#__END__
#
### Data/Sah/Lang/fr_FR.pm ###
#package Data::Sah::Lang::fr_FR;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Tie::IxHash;
#
#
#our %translations;
#tie %translations, 'Tie::IxHash', (
#
#
#    q[ ], 
#    q[ ],
#
#    q[, ],
#    q[, ],
#
#    q[: ],
#    q[: ],
#
#    q[. ],
#    q[. ],
#
#    q[(],
#    q[(],
#
#    q[)],
#    q[)],
#
#
#    q[must],
#    q[doit],
#
#    q[must not],
#    q[ne doit pas],
#
#    q[should],
#    q[devrait],
#
#    q[should not],
#    q[ne devrait pas],
#
#
#    q[field],
#    q[champ],
#
#    q[fields],
#    q[champs],
#
#    q[argument],
#    q[argument],
#
#    q[arguments],
#    q[arguments],
#
#
#    q[%s and %s],
#    q[%s et %s],
#
#    q[%s or %s],
#    q[%s ou %s],
#
#    q[one of %s],
#    q[une des %s],
#
#    q[all of %s],
#    q[toutes les valeurs %s],
#
#    q[%(modal_verb)s satisfy all of the following],
#    q[%(modal_verb)s satisfaire à toutes les conditions suivantes],
#
#    q[%(modal_verb)s satisfy one of the following],
#    q[%(modal_verb)s satisfaire l'une des conditions suivantes],
#
#    q[%(modal_verb)s satisfy none of the following],
#    q[%(modal_verb)s satisfaire à aucune des conditions suivantes],
#
#
#
#
#
#
#
#    q[integer],
#    q[nombre entier],
#
#    q[integers],
#    q[nombres entiers],
#
#    q[%(modal_verb)s be divisible by %s],
#    q[%(modal_verb)s être divisible par %s],
#
#    q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
#    q[%(modal_verb)s laisser un reste %2$s si divisé par %1$s],
#
#);
#
#1;
#
#__END__
#
### Data/Sah/Lang/id_ID.pm ###
#package Data::Sah::Lang::id_ID;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Tie::IxHash;
#
#sub ordinate {
#    my ($n, $noun) = @_;
#    "$noun ke-$n";
#}
#
#our %translations;
#tie %translations, 'Tie::IxHash', (
#
#
#    q[ ], 
#    q[ ],
#
#    q[, ],
#    q[, ],
#
#    q[: ],
#    q[: ],
#
#    q[. ],
#    q[. ],
#
#    q[(],
#    q[(],
#
#    q[)],
#    q[)],
#
#
#    q[must],
#    q[harus],
#
#    q[must not],
#    q[tidak boleh],
#
#    q[should],
#    q[sebaiknya],
#
#    q[should not],
#    q[sebaiknya tidak],
#
#
#    q[field],
#    q[field],
#
#    q[fields],
#    q[field],
#
#    q[argument],
#    q[argumen],
#
#    q[arguments],
#    q[argumen],
#
#
#    q[%s and %s],
#    q[%s dan %s],
#
#    q[%s or %s],
#    q[%s atau %s],
#
#    q[%s nor %s],
#    q[%s maupun %s],
#
#    q[one of %s],
#    q[salah satu dari %s],
#
#    q[all of %s],
#    q[semua dari nilai-nilai %s],
#
#    q[any of %s],
#    q[satupun dari %s],
#
#    q[none of %s],
#    q[tak satupun dari %s],
#
#    q[%(modal_verb)s satisfy all of the following],
#    q[%(modal_verb)s memenuhi semua ketentuan ini],
#
#    q[%(modal_verb)s satisfy none all of the following],
#    q[%(modal_verb)s melanggar semua ketentuan ini],
#
#    q[%(modal_verb)s satisfy one of the following],
#    q[%(modal_verb)s memenuhi salah satu ketentuan ini],
#
#
#    q[default value is %s],
#    q[jika tidak diisi diset ke %s],
#
#    q[required %s],
#    q[%s wajib diisi],
#
#    q[optional %s],
#    q[%s opsional],
#
#    q[forbidden %s],
#    q[%s tidak boleh diisi],
#
#
#    q[%(modal_verb)s have the value %s],
#    q[%(modal_verb)s bernilai %s],
#
#    q[%(modal_verb)s be one of %s],
#    q[%(modal_verb)s salah satu dari %s],
#
#
#    q[length %(modal_verb)s be %s],
#    q[panjang %(modal_verb)s %s],
#
#    q[length %(modal_verb)s be at least %s],
#    q[panjang %(modal_verb)s minimal %s],
#
#    q[length %(modal_verb)s be at most %s],
#    q[panjang %(modal_verb)s maksimal %s],
#
#    q[length %(modal_verb)s be between %s and %s],
#    q[panjang %(modal_verb)s antara %s dan %s],
#
#    q[%(modal_verb)s have %s in its elements],
#    q[%(modal_verb)s mengandung %s di elemennya],
#
#
#    q[%(modal_verb)s be at least %s],
#    q[%(modal_verb)s minimal %s],
#
#    q[%(modal_verb)s be larger than %s],
#    q[%(modal_verb)s lebih besar dari %s],
#
#    q[%(modal_verb)s be at most %s],
#    q[%(modal_verb)s maksimal %s],
#
#    q[%(modal_verb)s be smaller than %s],
#    q[%(modal_verb)s lebih kecil dari %s],
#
#    q[%(modal_verb)s be between %s and %s],
#    q[%(modal_verb)s antara %s dan %s],
#
#    q[%(modal_verb)s be larger than %s and smaller than %s],
#    q[%(modal_verb)s lebih besar dari %s dan lebih kecil dari %s],
#
#
#    q[undefined value],
#    q[nilai tak terdefinisi],
#
#    q[undefined values],
#    q[nilai tak terdefinisi],
#
#
#    q[%(modal_verb)s be %s],
#    q[%(modal_verb)s %s],
#
#    q[as well as %s],
#    q[juga %s],
#
#    q[%(modal_verb)s be all of the following],
#    q[%(modal_verb)s merupakan semua ini],
#
#
#    q[%(modal_verb)s be either %s],
#    q[%s],
#
#    q[or %s],
#    q[atau %s],
#
#    q[%(modal_verb)s be one of the following],
#    q[%(modal_verb)s merupakan salah satu dari],
#
#
#    q[array],
#    q[larik],
#
#    q[arrays],
#    q[larik],
#
#    q[%s of %s],
#    q[%s %s],
#
#    q[each array element %(modal_verb)s be],
#    q[setiap elemen larik %(modal_verb)s],
#
#    q[%s %(modal_verb)s be],
#    q[%s %(modal_verb)s],
#
#    q[element],
#    q[elemen],
#
#    q[each array subscript %(modal_verb)s be],
#    q[setiap subskrip larik %(modal_verb)s],
#
#
#    q[boolean value],
#    q[nilai boolean],
#
#    q[boolean values],
#    q[nilai boolean],
#
#    q[%(modal_verb)s be true],
#    q[%(modal_verb)s bernilai benar],
#
#    q[%(modal_verb)s be false],
#    q[%(modal_verb)s bernilai salah],
#
#
#    q[code],
#    q[kode],
#
#    q[codes],
#    q[kode],
#
#
#    q[decimal number],
#    q[bilangan desimal],
#
#    q[decimal numbers],
#    q[bilangan desimal],
#
#    q[%(modal_verb)s be a NaN],
#    q[%(modal_verb)s NaN],
#
#    q[%(modal_verb_neg)s be a NaN],
#    q[%(modal_verb_neg)s NaN],
#
#    q[%(modal_verb)s be an infinity],
#    q[%(modal_verb)s tak hingga],
#
#    q[%(modal_verb_neg)s be an infinity],
#    q[%(modal_verb_neg)s tak hingga],
#
#    q[%(modal_verb)s be a positive infinity],
#    q[%(modal_verb)s positif tak hingga],
#
#    q[%(modal_verb_neg)s be a positive infinity],
#    q[%(modal_verb_neg)s positif tak hingga],
#
#    q[%(modal_verb)s be a negative infinity],
#    q[%(modal_verb)s negatif tak hingga],
#
#    q[%(modal_verb)s be a negative infinity],
#    q[%(modal_verb)s negatif tak hingga],
#
#
#    q[hash],
#    q[hash],
#
#    q[hashes],
#    q[hash],
#
#    q[field %s %(modal_verb)s be],
#    q[field %s %(modal_verb)s],
#
#    q[field name %(modal_verb)s be],
#    q[nama field %(modal_verb)s],
#
#    q[each field %(modal_verb)s be],
#    q[setiap field %(modal_verb)s],
#
#    q[hash contains unknown field(s) (%s)],
#    q[hash mengandung field yang tidak dikenali (%s)],
#
#    q[hash contains unknown field(s) (%s)],
#    q[hash mengandung field yang tidak dikenali (%s)],
#
#    q[%(modal_verb)s have required fields %s],
#    q[%(modal_verb)s mengandung field wajib %s],
#
#    q[hash has missing required field(s) (%s)],
#    q[hash kekurangan field wajib (%s)],
#
#    q[%(modal_verb)s have %s in its field values],
#    q[%(modal_verb)s mengandung %s di nilai field],
#
#    q[%(modal_verb)s only have these allowed fields %s],
#    q[%(modal_verb)s hanya mengandung field yang diizinkan %s],
#
#    q[%(modal_verb)s only have fields matching regex pattern %s],
#    q[%(modal_verb)s hanya mengandung field yang namanya mengikuti pola regex %s],
#
#    q[%(modal_verb_neg)s have these forbidden fields %s],
#    q[%(modal_verb_neg)s mengandung field yang dilarang %s],
#
#    q[%(modal_verb_neg)s have fields matching regex pattern %s],
#    q[%(modal_verb_neg)s mengandung field yang namanya mengikuti pola regex %s],
#
#    q[hash contains non-allowed field(s) (%s)],
#    q[hash mengandung field yang tidak diizinkan (%s)],
#
#    q[hash contains forbidden field(s) (%s)],
#    q[hash mengandung field yang dilarang (%s)],
#
#    q[fields whose names match regex pattern %s %(modal_verb)s be],
#    q[field yang namanya cocok dengan pola regex %s %(modal_verb)s],
#
#
#    q[integer],
#    q[bilangan bulat],
#
#    q[integers],
#    q[bilangan bulat],
#
#    q[%(modal_verb)s be divisible by %s],
#    q[%(modal_verb)s dapat dibagi oleh %s],
#
#    q[%(modal_verb)s be odd],
#    q[%(modal_verb)s ganjil],
#
#    q[%(modal_verb)s be even],
#    q[%(modal_verb)s genap],
#
#    q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
#    q[jika dibagi %1$s %(modal_verb)s menyisakan %2$s],
#
#
#    q[number],
#    q[bilangan],
#
#    q[numbers],
#    q[bilangan],
#
#
#    q[object],
#    q[objek],
#
#    q[objects],
#    q[objek],
#
#
#    q[regex pattern],
#    q[pola regex],
#
#    q[regex patterns],
#    q[pola regex],
#
#
#    q[text],
#    q[teks],
#
#    q[texts],
#    q[teks],
#
#    q[%(modal_verb)s match regex pattern %s],
#    q[%(modal_verb)s cocok dengan pola regex %s],
#
#    q[%(modal_verb)s be a regex pattern],
#    q[%(modal_verb)s pola regex],
#
#    q[each subscript of text %(modal_verb)s be],
#    q[setiap subskrip dari teks %(modal_verb)s],
#
#    q[each character of the text %(modal_verb)s be],
#    q[setiap karakter dari teks %(modal_verb)s],
#
#    q[character],
#    q[karakter],
#
#
#
#    q[buffer],
#    q[buffer],
#
#    q[buffers],
#    q[buffer],
#
#
#    q[Does not satisfy the following schema: %s],
#    q[Tidak memenuhi skema ini: %s],
#
#    q[Not of type %s],
#    q[Tidak bertipe %s],
#
#    q[Required but not specified],
#    q[Wajib tapi belum diisi],
#
#    q[Forbidden but specified],
#    q[Dilarang tapi diisi],
#
#    q[Structure contains unknown field(s) [%%s]],
#    q[Struktur mengandung field yang tidak dikenal [%%s]],
#
#    q[Cannot coerce data to %s [%s]],
#    q[Data tidak dapat dikonversi ke %s [%%s]],
#);
#
#1;
#
#__END__
#
### Data/Sah/Lang/zh_CN.pm ###
#package Data::Sah::Lang::zh_CN;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use utf8;
#use warnings;
#
#use Tie::IxHash;
#
#
#our %translations;
#tie %translations, 'Tie::IxHash', (
#
#
#    q[ ], 
#    q[],
#
#    q[, ],
#    q[，],
#
#    q[: ],
#    q[：],
#
#    q[. ],
#    q[。],
#
#    q[(],
#    q[（],
#
#    q[)],
#    q[）],
#
#
#    q[must],
#    q[必须],
#
#    q[must not],
#    q[必须不],
#
#    q[should],
#    q[应],
#
#    q[should not],
#    q[应不],
#
#
#    q[field],
#    q[字段],
#
#    q[fields],
#    q[字段],
#
#    q[argument],
#    q[参数],
#
#    q[arguments],
#    q[参数],
#
#
#    q[%s and %s],
#    q[%s和%s],
#
#    q[%s or %s],
#    q[%s或%s],
#
#    q[one of %s],
#    q[这些值%s之一],
#
#    q[all of %s],
#    q[所有这些值%s],
#
#    q[%(modal_verb)s satisfy all of the following],
#    q[%(modal_verb)s满足所有这些条件],
#
#    q[%(modal_verb)s satisfy one of the following],
#    q[%(modal_verb)s满足这些条件之一],
#
#    q[%(modal_verb)s satisfy none of the following],
#    q[%(modal_verb_neg)s满足所有这些条件],
#
#
#
#
#
#
#
#    q[integer],
#    q[整数],
#
#    q[integers],
#    q[整数],
#
#    q[%(modal_verb)s be divisible by %s],
#    q[%(modal_verb)s被%s整除],
#
#    q[%(modal_verb)s leave a remainder of %2$s when divided by %1$s],
#    q[除以%1$s时余数%(modal_verb)s为%2$s],
#
#);
#
#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 = '2016-07-26'; 
#our $VERSION = '0.004'; 
#
#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 };
#    return [$type, $clsets] unless $@;
#
#    my $schmod = "Sah::Schema::$type";
#    (my $schmod_pm = "$schmod.pm") =~ s!::!/!g;
#    eval { require $schmod_pm; 1 };
#    die "Not a known type/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/Type/BaseType.pm ###
#package Data::Sah::Type::BaseType;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#
#use 5.010;
#use strict;
#use warnings;
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#
#requires 'handle_type';
#
#has_clause 'v',
#    v => 2,
#    prio   => 0,
#    tags   => ['meta', 'defhash'],
#    schema => ['float'=>{req=>1, is=>1}, {}],
#    ;
#
#has_clause 'defhash_v',
#    v => 2,
#    prio   => 0,
#    tags   => ['meta', 'defhash'],
#    schema => ['float'=>{req=>1, is=>1}, {}],
#    ;
#
#has_clause 'schema_v',
#    v => 2,
#    prio   => 0,
#    tags   => ['meta'],
#    schema => ['float'=>{req=>1}, {}],
#    ;
#
#has_clause 'base_v',
#    v => 2,
#    prio   => 0,
#    tags   => ['meta'],
#    schema => ['float'=>{req=>1}, {}],
#    ;
#
#has_clause 'ok',
#    v => 2,
#    tags       => ['constraint'],
#    prio       => 1,
#    schema     => ['any', {}, {}],
#    allow_expr => 1,
#    ;
#has_clause 'default',
#    v => 2,
#    prio       => 1,
#    tags       => ['default'],
#    schema     => ['any', {}, {}],
#    allow_expr => 1,
#    attrs      => {
#        temp => {
#            schema     => [bool => {default=>0}, {}],
#            allow_expr => 0,
#        },
#    },
#    ;
#has_clause 'default_lang',
#    v => 2,
#    tags       => ['meta', 'defhash'],
#    prio       => 2,
#    schema     => ['str'=>{req=>1, default=>'en_US'}, {}],
#    ;
#has_clause 'name',
#    v => 2,
#    tags       => ['meta', 'defhash'],
#    prio       => 2,
#    schema     => ['str', {req=>1}, {}],
#    ;
#has_clause 'summary',
#    v => 2,
#    prio       => 2,
#    tags       => ['meta', 'defhash'],
#    schema     => ['str', {req=>1}, {}],
#    ;
#has_clause 'description',
#    v => 2,
#    tags       => ['meta', 'defhash'],
#    prio       => 2,
#    schema     => ['str', {req=>1}, {}],
#    ;
#has_clause 'tags',
#    v => 2,
#    tags       => ['meta', 'defhash'],
#    prio       => 2,
#    schema     => ['array', {of=>['str', {req=>1}, {}]}, {}],
#    ;
#has_clause 'req',
#    v => 2,
#    tags       => ['constraint'],
#    prio       => 3,
#    schema     => ['bool', {}, {}],
#    allow_expr => 1,
#    ;
#has_clause 'forbidden',
#    v => 2,
#    tags       => ['constraint'],
#    prio       => 3,
#    schema     => ['bool', {}, {}],
#    allow_expr => 1,
#    ;
#
#
#
#
#
#
#has_clause 'clause',
#    v => 2,
#    tags       => ['constraint'],
#    prio       => 50,
#    schema     => ['array' => {req=>1, len=>2, elems => [
#        ['sah::clname', {req=>1}, {}],
#        ['any', {}, {}],
#    ]}, {}],
#    ;
#has_clause 'clset',
#    v => 2,
#    prio   => 50,
#    tags   => ['constraint'],
#    schema => ['sah::clset', {req=>1}, {}],
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/Comparable.pm ###
#package Data::Sah::Type::Comparable;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#
#requires 'superclause_comparable';
#
#has_clause 'in',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, of=>['_same', {req=>1}, {}]}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_comparable('in', $cd);
#    };
#has_clause 'is',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['_same', {req=>1}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_comparable('is', $cd);
#    };
#
#1;
#
#__END__
#
### Data/Sah/Type/HasElems.pm ###
#package Data::Sah::Type::HasElems;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#
#requires 'superclause_has_elems';
#
#has_clause 'max_len',
#    v => 2,
#    prio       => 51,
#    tags       => ['constraint'],
#    schema     => ['int', {min=>0}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('max_len', $cd);
#    };
#
#has_clause 'min_len',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['int', {min=>0}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('min_len', $cd);
#    };
#
#has_clause 'len_between',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array' => {req=>1, len=>2, elems => [
#        [int => {req=>1}, {}],
#        [int => {req=>1}, {}],
#    ]}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('len_between', $cd);
#    };
#
#has_clause 'len',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['int', {min=>0}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('len', $cd);
#    };
#
#has_clause 'has',
#    v => 2,
#    tags       => ['constraint'],
#    schema       => ['_same_elem', {req=>1}, {}],
#    inspect_elem => 1,
#    prio         => 55, 
#    allow_expr   => 1,
#    code         => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('has', $cd);
#    };
#
#has_clause 'each_index',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['sah::schema', {req=>1}, {}],
#    subschema  => sub { $_[0] },
#    allow_expr => 0,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('each_index', $cd);
#    };
#
#has_clause 'each_elem',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['sah::schema', {req=>1}, {}],
#    inspect_elem => 1,
#    subschema  => sub { $_[0] },
#    allow_expr => 0,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('each_elem', $cd);
#    };
#
#has_clause 'check_each_index',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['sah::schema', {req=>1}, {}],
#    subschema  => sub { $_[0] },
#    allow_expr => 0,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('check_each_index', $cd);
#    };
#
#has_clause 'check_each_elem',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['sah::schema', {req=>1}, {}],
#    inspect_elem => 1,
#    subschema  => sub { $_[0] },
#    allow_expr => 0,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('check_each_elem', $cd);
#    };
#
#has_clause 'uniq',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['bool', {}, {}],
#    inspect_elem => 1,
#    prio         => 55, 
#    subschema  => sub { $_[0] },
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('uniq', $cd);
#    };
#
#has_clause 'exists',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['sah::schema', {req=>1}, {}],
#    inspect_elem => 1,
#    subschema  => sub { $_[0] },
#    allow_expr => 0,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_has_elems('exists', $cd);
#    };
#
#
#
#
#1;
#
#__END__
#
### Data/Sah/Type/Sortable.pm ###
#package Data::Sah::Type::Sortable;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#
#requires 'superclause_sortable';
#
#has_clause 'min',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['_same', {req=>1}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_sortable('min', $cd);
#    },
#    ;
#has_clause 'xmin',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['_same', {req=>1}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_sortable('xmin', $cd);
#    },
#    ;
#has_clause 'max',
#    v => 2,
#    prio       => 51,
#    tags       => ['constraint'],
#    schema     => ['_same', {req=>1}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_sortable('max', $cd);
#    },
#    ;
#has_clause 'xmax',
#    v => 2,
#    prio       => 51,
#    tags       => ['constraint'],
#    schema     => ['_same', {req=>1}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_sortable('xmax', $cd);
#    },
#    ;
#has_clause 'between',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, len=>2, elems=>[
#        ['_same', {req=>1}, {}],
#        ['_same', {req=>1}, {}],
#    ]}, {}],
#    allow_expr => 1,
#    code       => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_sortable('between', $cd);
#    },
#    ;
#has_clause 'xbetween',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, len=>2, elems=>[
#        ['_same', {req=>1}, {}],
#        ['_same', {req=>1}, {}],
#    ]}, {}],
#    allow_expr => 1,
#    code => sub {
#        my ($self, $cd) = @_;
#        $self->superclause_sortable('xbetween', $cd);
#    },
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/all.pm ###
#package Data::Sah::Type::all;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#
#has_clause 'of',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array' => {req=>1, min_len=>1, each_elem => ['sah::schema', {req=>1}, {}]}, {}],
#    subschema  => sub { @{ $_[0] } },
#    allow_expr => 0,
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/any.pm ###
#package Data::Sah::Type::any;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#
#has_clause 'of',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array' => {req=>1, min_len=>1, each_elem => ['sah::schema', {req=>1}, {}]}, {}],
#    subschema  => sub { @{ $_[0] } },
#    allow_expr => 0,
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/array.pm ###
#package Data::Sah::Type::array;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause', 'has_clause_alias';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#with 'Data::Sah::Type::Comparable';
#with 'Data::Sah::Type::HasElems';
#
#has_clause 'elems',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array' => {req=>1, of=>['sah::schema', {req=>1}, {}]}, {}],
#    inspect_elem => 1,
#    allow_expr => 0,
#    subschema  => sub { @{ $_[0] } },
#    attrs      => {
#        create_default => {
#            schema     => [bool => {default=>1}, {}],
#            allow_expr => 0, 
#        },
#    },
#    ;
#has_clause_alias each_elem => 'of';
#
#1;
#
#__END__
#
### Data/Sah/Type/bool.pm ###
#package Data::Sah::Type::bool;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#with 'Data::Sah::Type::Comparable';
#with 'Data::Sah::Type::Sortable';
#
#has_clause 'is_true',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['bool', {}, {}],
#    allow_expr => 1,
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/buf.pm ###
#package Data::Sah::Type::buf;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::str';
#
#1;
#
#__END__
#
### Data/Sah/Type/cistr.pm ###
#package Data::Sah::Type::cistr;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::str';
#
#1;
#
#__END__
#
### Data/Sah/Type/code.pm ###
#package Data::Sah::Type::code;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#
#1;
#
#__END__
#
### Data/Sah/Type/date.pm ###
#package Data::Sah::Type::date;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#with 'Data::Sah::Type::Comparable';
#with 'Data::Sah::Type::Sortable';
#
#
#1;
#
#__END__
#
### Data/Sah/Type/duration.pm ###
#package Data::Sah::Type::duration;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#with 'Data::Sah::Type::Comparable';
#with 'Data::Sah::Type::Sortable';
#
#
#1;
#
#__END__
#
### Data/Sah/Type/float.pm ###
#package Data::Sah::Type::float;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::num';
#
#has_clause 'is_nan',
#    v => 2,
#    tags        => ['constraint'],
#    schema      => ['bool', {}, {}],
#    allow_expr  => 1,
#    allow_multi => 0,
#    ;
#
#has_clause 'is_inf',
#    v => 2,
#    tags        => ['constraint'],
#    schema      => ['bool', {}, {}],
#    allow_expr  => 1,
#    allow_multi => 1,
#    ;
#
#has_clause 'is_pos_inf',
#    v => 2,
#    tags        => ['constraint'],
#    schema      => ['bool', {}, {}],
#    allow_expr  => 1,
#    allow_multi => 1,
#    ;
#
#has_clause 'is_neg_inf',
#    v => 2,
#    tags        => ['constraint'],
#    schema      => ['bool', {}, {}],
#    allow_expr  => 1,
#    allow_multi => 1,
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/hash.pm ###
#package Data::Sah::Type::hash;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause', 'has_clause_alias';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#with 'Data::Sah::Type::Comparable';
#with 'Data::Sah::Type::HasElems';
#
#has_clause_alias each_elem => 'of';
#
#has_clause_alias each_index => 'each_key';
#has_clause_alias each_elem => 'each_value';
#has_clause_alias check_each_index => 'check_each_key';
#has_clause_alias check_each_elem => 'check_each_value';
#
#has_clause "keys",
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['hash' => {req=>1, values => ['sah::schema', {req=>1}, {}]}, {}],
#    inspect_elem => 1,
#    subschema  => sub { values %{ $_[0] } },
#    allow_expr => 0,
#    attrs      => {
#        restrict => {
#            schema     => [bool => default=>1],
#            allow_expr => 0, 
#        },
#        create_default => {
#            schema     => [bool => default=>1],
#            allow_expr => 0, 
#        },
#    },
#    ;
#
#has_clause "re_keys",
#    v => 2,
#    prio       => 51,
#    tags       => ['constraint'],
#    schema     => ['hash' => {
#        req=>1,
#        keys   => ['re', {req=>1}, {}],
#        values => ['sah::schema', {req=>1}, {}],
#    }, {}],
#    inspect_elem => 1,
#    subschema  => sub { values %{ $_[0] } },
#    allow_expr => 0,
#    attrs      => {
#        restrict => {
#            schema     => [bool => default=>1],
#            allow_expr => 0, 
#        },
#    },
#    ;
#
#has_clause "req_keys",
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, of=>['str', {req=>1}, {}]}, {}],
#    allow_expr => 1,
#    ;
#has_clause_alias req_keys => 'req_all_keys';
#has_clause_alias req_keys => 'req_all';
#
#has_clause "allowed_keys",
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, of=>['str', {req=>1}, {}]}, {}],
#    allow_expr => 1,
#    ;
#
#has_clause "allowed_keys_re",
#    v => 2,
#    prio       => 51,
#    tags       => ['constraint'],
#    schema     => ['re', {req=>1}, {}],
#    allow_expr => 1,
#    ;
#
#has_clause "forbidden_keys",
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, of=>['str', {req=>1}, {}]}, {}],
#    allow_expr => 1,
#    ;
#
#has_clause "forbidden_keys_re",
#    v => 2,
#    prio       => 51,
#    tags       => ['constraint'],
#    schema     => ['re', {req=>1}, {}],
#    allow_expr => 1,
#    ;
#
#has_clause "choose_one_key",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, of=>['str', {req=>1}, {}], min_len=>1}, {}],
#    allow_expr => 0, 
#    ;
#has_clause_alias choose_one_key => 'choose_one';
#
#has_clause "choose_all_keys",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, of=>['str', {req=>1}, {}], min_len=>1}, {}],
#    allow_expr => 0, 
#    ;
#has_clause_alias choose_all_keys => 'choose_all';
#
#has_clause "req_one_key",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => ['array', {req=>1, of=>['str', {req=>1}, {}], min_len=>1}, {}],
#    allow_expr => 0, 
#    ;
#has_clause_alias req_one_key => 'req_one';
#
#has_clause "req_some_keys",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => ['array', {
#        req => 1,
#        len => 3,
#        elems => [
#            [int => {req=>1, min=>0}], 
#            [int => {req=>1, min=>0}], 
#            [array => {req=>1, of=>['str', {req=>1}, {}], min_len=>1}, {}], 
#        ],
#    }, {}],
#    allow_expr => 0, 
#    ;
#has_clause_alias req_some_keys => 'req_some';
#
#my $sch_dep = ['array', {
#    req => 1,
#    elems => [
#        ['str', {req=>1}, {}],
#        ['array', {of=>['str', {req=>1}, {}]}, {}],
#    ],
#}, {}];
#
#has_clause "dep_any",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => $sch_dep,
#    allow_expr => 0, 
#    ;
#
#has_clause "dep_all",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => $sch_dep,
#    allow_expr => 0, 
#    ;
#
#has_clause "req_dep_any",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => $sch_dep,
#    allow_expr => 0, 
#    ;
#
#has_clause "req_dep_all",
#    v => 2,
#    prio       => 50,
#    tags       => ['constraint'],
#    schema     => $sch_dep,
#    allow_expr => 0, 
#    ;
#
#
#
#1;
#
#__END__
#
### Data/Sah/Type/int.pm ###
#package Data::Sah::Type::int;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::num';
#
#has_clause 'mod',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['array' => {req=>1, len=>2, elems => [
#        ['int' => {req=>1, is=>0, 'is.op'=>'not'}, {}],
#        ['int' => {req=>1}, {}],
#    ]}, {}],
#    allow_expr => 1,
#    ;
#has_clause 'div_by',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['int' => {req=>1, is=>0, 'is.op'=>'not'}, {}],
#    allow_expr => 1,
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/num.pm ###
#package Data::Sah::Type::num;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#with 'Data::Sah::Type::Comparable';
#with 'Data::Sah::Type::Sortable';
#
#1;
#
#__END__
#
### Data/Sah/Type/obj.pm ###
#package Data::Sah::Type::obj;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#
#has_clause 'can',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['str', {req => 1}, {}], 
#    allow_expr => 1,
#    ;
#has_clause 'isa',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['str', {req => 1}, {}], 
#    allow_expr => 1,
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/re.pm ###
#package Data::Sah::Type::re;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#
#1;
#
#__END__
#
### Data/Sah/Type/str.pm ###
#package Data::Sah::Type::str;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Data::Sah::Util::Role 'has_clause';
#use Role::Tiny;
#use Role::Tiny::With;
#
#with 'Data::Sah::Type::BaseType';
#with 'Data::Sah::Type::Comparable';
#with 'Data::Sah::Type::Sortable';
#with 'Data::Sah::Type::HasElems';
#
#my $t_re = ['regex', {req=>1}, {}];
#
#has_clause 'encoding',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['str', {req=>1}, {}],
#    allow_expr => 0,
#    ;
#has_clause 'match',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => $t_re,
#    allow_expr => 1,
#    ;
#has_clause 'is_re',
#    v => 2,
#    tags       => ['constraint'],
#    schema     => ['bool', {}, {}],
#    allow_expr => 1,
#    ;
#
#1;
#
#__END__
#
### Data/Sah/Type/undef.pm ###
#package Data::Sah::Type::undef;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use Role::Tiny;
#use Data::Sah::Util::Role 'has_clause';
#
#1;
#
#__END__
#
### Data/Sah/Util/Func.pm ###
#package Data::Sah::Util::Func;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       add_func
#               );
#
#sub add_func {
#    my ($funcset, $func, %opts) = @_;
#}
#
#1;
#
#__END__
#
### Data/Sah/Util/Role.pm ###
#package Data::Sah::Util::Role;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict 'subs', 'vars';
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       has_clause has_clause_alias
#                       has_func   has_func_alias
#               );
#
#sub has_clause {
#    my ($name, %args) = @_;
#    my $caller = caller;
#    my $into   = $args{into} // $caller;
#
#    my $v = $args{v} // 1;
#    if ($v != 2) {
#        die "Declaration of clause '$name' still follows version $v ".
#            "(2 expected), please make sure $caller is the latest version";
#    }
#
#    if ($args{code}) {
#        *{"$into\::clause_$name"} = $args{code};
#    } else {
#        eval "package $into; use Role::Tiny; ".
#            "requires 'clause_$name';";
#    }
#    *{"$into\::clausemeta_$name"} = sub {
#        state $meta = {
#            names        => [$name],
#            tags         => $args{tags},
#            prio         => $args{prio} // 50,
#            schema       => $args{schema},
#            allow_expr   => $args{allow_expr},
#            attrs        => $args{attrs} // {},
#            inspect_elem => $args{inspect_elem},
#            subschema    => $args{subschema},
#        };
#        $meta;
#    };
#    has_clause_alias($name, $args{alias}  , $into);
#    has_clause_alias($name, $args{aliases}, $into);
#}
#
#sub has_clause_alias {
#    my ($name, $aliases, $into) = @_;
#    my $caller   = caller;
#    $into      //= $caller;
#    my @aliases = !$aliases ? () :
#        ref($aliases) eq 'ARRAY' ? @$aliases : $aliases;
#    my $meta = $into->${\("clausemeta_$name")};
#
#    for my $alias (@aliases) {
#        push @{ $meta->{names} }, $alias;
#        eval
#            "package $into;".
#            "sub clause_$alias { shift->clause_$name(\@_) } ".
#            "sub clausemeta_$alias { shift->clausemeta_$name(\@_) } ";
#        $@ and die "Can't make clause alias $alias -> $name: $@";
#    }
#}
#
#sub has_func {
#    my ($name, %args) = @_;
#    my $caller = caller;
#    my $into   = $args{into} // $caller;
#
#    if ($args{code}) {
#        *{"$into\::func_$name"} = $args{code};
#    } else {
#        eval "package $into; use Role::Tiny; requires 'func_$name';";
#    }
#    *{"$into\::funcmeta_$name"} = sub {
#        state $meta = {
#            names => [$name],
#            args  => $args{args},
#        };
#        $meta;
#    };
#    my @aliases =
#        map { (!$args{$_} ? () :
#                   ref($args{$_}) eq 'ARRAY' ? @{ $args{$_} } : $args{$_}) }
#            qw/alias aliases/;
#    has_func_alias($name, $args{alias}  , $into);
#    has_func_alias($name, $args{aliases}, $into);
#}
#
#sub has_func_alias {
#    my ($name, $aliases, $into) = @_;
#    my $caller   = caller;
#    $into      //= $caller;
#    my @aliases = !$aliases ? () :
#        ref($aliases) eq 'ARRAY' ? @$aliases : $aliases;
#    my $meta = $into->${\("funcmeta_$name")};
#
#    for my $alias (@aliases) {
#        push @{ $meta->{names} }, $alias;
#        eval
#            "package $into;".
#            "sub func_$alias { shift->func_$name(\@_) } ".
#            "sub funcmeta_$alias { shift->funcmeta_$name(\@_) } ";
#        $@ and die "Can't make func alias $alias -> $name: $@";
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Util/Type.pm ###
#package Data::Sah::Util::Type;
#
#our $DATE = '2016-07-19'; 
#our $VERSION = '0.45'; 
#
#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);
#
#my $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__
#
### Data/Sah/Util/Type/Date.pm ###
#package Data::Sah::Util::Type::Date;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Scalar::Util qw(blessed looks_like_number);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       coerce_date
#                       coerce_duration
#               );
#
#our $DATE_MODULE = $ENV{DATA_SAH_DATE_MODULE} // $ENV{PERL_DATE_MODULE} //
#    "DateTime"; 
#
#my $re_ymd = qr/\A([0-9]{4})-([0-9]{2})-([0-9]{2})\z/;
#my $re_ymdThmsZ = qr/\A([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z\z/;
#
#sub coerce_date {
#    my $val = shift;
#    if (!defined($val)) {
#        return undef;
#    }
#
#    if ($DATE_MODULE eq 'DateTime') {
#        require DateTime;
#        if (blessed($val) && $val->isa('DateTime')) {
#            return $val;
#        } elsif (looks_like_number($val) && $val >= 10**8 && $val <= 2**31) {
#            return DateTime->from_epoch(epoch => $val);
#        } elsif ($val =~ $re_ymd) {
#            my $d;
#            eval { $d = DateTime->new(year=>$1, month=>$2, day=>$3, time_zone=>'UTC') };
#            return undef if $@;
#            return $d;
#        } elsif ($val =~ $re_ymdThmsZ) {
#            my $d;
#            eval { $d = DateTime->new(year=>$1, month=>$2, day=>$3, hour=>$4, minute=>$5, second=>$6, time_zone=>'UTC') };
#            return undef if $@;
#            return $d;
#        } elsif (blessed($val) && $val->isa('Time::Moment')) {
#            return DateTime->from_epoch(epoch => $val->epoch);
#        } elsif (blessed($val) && $val->isa('Time::Piece')) {
#            return DateTime->from_epoch(epoch => $val->epoch);
#        } else {
#            return undef;
#        }
#    } elsif ($DATE_MODULE eq 'Time::Moment') {
#        require Time::Moment;
#        if (blessed($val) && $val->isa('Time::Moment')) {
#            return $val;
#        } elsif (looks_like_number($val) && $val >= 10**8 && $val <= 2**31) {
#            return Time::Moment->from_epoch(int($val), $val-int($val));
#        } elsif ($val =~ $re_ymd) {
#            my $d;
#            eval { $d = Time::Moment->new(year=>$1, month=>$2, day=>$3) };
#            return undef if $@;
#            return $d;
#        } elsif ($val =~ $re_ymdThmsZ) {
#            my $d;
#            eval { $d = Time::Moment->new(year=>$1, month=>$2, day=>$3, hour=>$4, minute=>$5, second=>$6) };
#            return undef if $@;
#            return $d;
#        } elsif (blessed($val) && $val->isa('DateTime')) {
#            return Time::Moment->from_epoch($val->epoch);
#        } elsif (blessed($val) && $val->isa('Time::Piece')) {
#            return Time::Moment->from_epoch($val->epoch);
#        } else {
#            return undef;
#        }
#    } elsif ($DATE_MODULE eq 'Time::Piece') {
#        require Time::Piece;
#        if (blessed($val) && $val->isa('Time::Piece')) {
#            return $val;
#        } elsif (looks_like_number($val) && $val >= 10**8 && $val <= 2**31) {
#            return scalar Time::Piece->gmtime($val);
#        } elsif ($val =~ $re_ymd) {
#            my $d;
#            eval { $d = Time::Piece->strptime($val, "%Y-%m-%d") };
#            return undef if $@;
#            return $d;
#        } elsif ($val =~ $re_ymdThmsZ) {
#            my $d;
#            eval { $d = Time::Piece->strptime($val, "%Y-%m-%dT%H:%M:%SZ") };
#            return undef if $@;
#            return $d;
#        } elsif (blessed($val) && $val->isa('DateTime')) {
#            return scalar Time::Piece->gmtime(epoch => $val->epoch);
#        } elsif (blessed($val) && $val->isa('Time::Moment')) {
#            return scalar Time::Piece->gmtime(epoch => $val->epoch);
#        } else {
#            return undef;
#        }
#    } else {
#        die "BUG: Unknown Perl date module '$DATE_MODULE'";
#    }
#}
#
#sub coerce_duration {
#    my $val = shift;
#    if (!defined($val)) {
#        return undef;
#    } elsif (blessed($val) && $val->isa('DateTime::Duration')) {
#        return $val;
#    } elsif ($val =~ /\AP
#                      (?: ([0-9]+(?:\.[0-9]+)?)Y )?
#                      (?: ([0-9]+(?:\.[0-9]+)?)M )?
#                      (?: ([0-9]+(?:\.[0-9]+)?)W )?
#                      (?: ([0-9]+(?:\.[0-9]+)?)D )?
#                      (?:
#                          T
#                          (?: ([0-9]+(?:\.[0-9]+)?)H )?
#                          (?: ([0-9]+(?:\.[0-9]+)?)M )?
#                          (?: ([0-9]+(?:\.[0-9]+)?)S )?
#                      )?
#                      \z/x) {
#        require DateTime::Duration;
#        my $d;
#        eval {
#            $d = DateTime::Duration->new(
#                years   => $1 // 0,
#                months  => $2 // 0,
#                weeks   => $3 // 0,
#                days    => $4 // 0,
#                hours   => $5 // 0,
#                minutes => $6 // 0,
#                seconds => $7 // 0,
#            );
#        };
#        return undef if $@;
#        return $d;
#    } else {
#        return undef;
#    }
#}
#
#1;
#
#__END__
#
### Data/Sah/Util/TypeX.pm ###
#package Data::Sah::Util::TypeX;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       add_clause
#               );
#
#sub add_clause {
#    my ($type, $clause, %opts) = @_;
#
#
#}
#
#1;
#
#__END__
#
### File/ShareDir.pm ###
#package File::ShareDir;
#
#
#use 5.005;
#use strict;
#use warnings;
#
#use Carp             ();
#use Config           ();
#use Exporter         ();
#use File::Spec       ();
#use Class::Inspector ();
#
#use vars qw{ $VERSION @ISA @EXPORT_OK %EXPORT_TAGS };
#BEGIN {
#	$VERSION     = '1.102';
#	@ISA         = qw{ Exporter };
#	@EXPORT_OK   = qw{
#		dist_dir
#		dist_file
#		module_dir
#		module_file
#		class_dir
#		class_file
#	};
#	%EXPORT_TAGS = (
#		ALL => [ @EXPORT_OK ],
#	);
#}
#
#use constant IS_MACOS => !! ($^O eq 'MacOS');
#
#
#
#
#
#
#
#sub dist_dir {
#	my $dist = _DIST(shift);
#	my $dir;
#
#	$dir = _dist_dir_new( $dist );
#	return $dir if defined $dir;
#
#	$dir = _dist_dir_old( $dist );
#	return $dir if defined $dir;
#
#	Carp::croak("Failed to find share dir for dist '$dist'");
#}
#
#sub _dist_dir_new {
#	my $dist = shift;
#
#	my $path = File::Spec->catdir(
#		'auto', 'share', 'dist', $dist,
#	);
#
#	foreach my $inc ( @INC ) {
#		next unless defined $inc and ! ref $inc;
#		my $dir = File::Spec->catdir( $inc, $path );
#		next unless -d $dir;
#		unless ( -r $dir ) {
#			Carp::croak("Found directory '$dir', but no read permissions");
#		}
#		return $dir;
#	}
#
#	return undef;
#}
#
#sub _dist_dir_old {
#	my $dist = shift;
#
#	my $path = File::Spec->catdir(
#		'auto', split( /-/, $dist ),
#	);
#
#	foreach my $inc ( @INC ) {
#		next unless defined $inc and ! ref $inc;
#		my $dir = File::Spec->catdir( $inc, $path );
#		next unless -d $dir;
#		unless ( -r $dir ) {
#			Carp::croak("Found directory '$dir', but no read permissions");
#		}
#		return $dir;
#	}
#
#	return undef;
#}
#
#
#sub module_dir {
#	my $module = _MODULE(shift);
#	my $dir;
#
#	$dir = _module_dir_new( $module );
#	return $dir if defined $dir;
#
#	return _module_dir_old( $module );
#}
#
#sub _module_dir_new {
#	my $module = shift;
#
#	my $path = File::Spec->catdir(
#		'auto', 'share', 'module',
#		_module_subdir( $module ),
#	);
#
#	foreach my $inc ( @INC ) {
#		next unless defined $inc and ! ref $inc;
#		my $dir = File::Spec->catdir( $inc, $path );
#		next unless -d $dir;
#		unless ( -r $dir ) {
#			Carp::croak("Found directory '$dir', but no read permissions");
#		}
#		return $dir;
#	}
#
#	return undef;
#}
#	
#sub _module_dir_old {
#	my $module = shift;
#	my $short  = Class::Inspector->filename($module);
#	my $long   = Class::Inspector->loaded_filename($module);
#	$short =~ tr{/}{:} if IS_MACOS;
#	substr( $short, -3, 3, '' );
#	$long  =~ m/^(.*)\Q$short\E\.pm\z/s or die("Failed to find base dir");
#	my $dir = File::Spec->catdir( "$1", 'auto', $short );
#	unless ( -d $dir ) {
#		Carp::croak("Directory '$dir', does not exist");
#	}
#	unless ( -r $dir ) {
#		Carp::croak("Directory '$dir', no read permissions");
#	}
#	return $dir;
#}
#
#
#sub dist_file {
#	my $dist = _DIST(shift);
#	my $file = _FILE(shift);
#
#	my $path = _dist_file_new( $dist, $file );
#	return $path if defined $path;
#
#	return _dist_file_old( $dist, $file );;
#}
#
#sub _dist_file_new {
#	my $dist = shift;
#	my $file = shift;
#
#	my $dir  = _dist_dir_new( $dist );
#	my $path = File::Spec->catfile( $dir, $file );
#
#	return undef unless -e $path;
#	unless ( -f $path ) {
#		Carp::croak("Found dist_file '$path', but not a file");
#	}
#	unless ( -r $path ) {
#		Carp::croak("File '$path', no read permissions");
#	}
#
#	return $path;
#}
#
#sub _dist_file_old {
#	my $dist = shift;
#	my $file = shift;
#
#	my $path = File::Spec->catfile(
#		'auto', split( /-/, $dist ), $file,
#	);
#
#	foreach my $inc ( @INC ) {
#		next unless defined $inc and ! ref $inc;
#		my $full = File::Spec->catdir( $inc, $path );
#		next unless -e $full;
#		unless ( -r $full ) {
#			Carp::croak("Directory '$full', no read permissions");
#		}
#		return $full;
#	}
#
#	Carp::croak("Failed to find shared file '$file' for dist '$dist'");
#}
#
#
#sub module_file {
#	my $module = _MODULE(shift);
#	my $file   = _FILE(shift);
#	my $dir    = module_dir($module);
#	my $path   = File::Spec->catfile($dir, $file);
#	unless ( -e $path ) {
#		Carp::croak("File '$file' does not exist in module dir");
#	}
#	unless ( -r $path ) {
#		Carp::croak("File '$file' cannot be read, no read permissions");
#	}
#	$path;
#}
#
#
#sub class_file {
#	my $module = _MODULE(shift);
#	my $file   = _FILE(shift);
#
#	my @path  = ();
#	my @queue = ( $module );
#	my %seen  = ( $module => 1 );
#	while ( my $cl = shift @queue ) {
#		push @path, $cl;
#		no strict 'refs';
#		unshift @queue, grep { ! $seen{$_}++ }
#			map { s/^::/main::/; s/\'/::/g; $_ }
#			( @{"${cl}::ISA"} );
#	}
#
#	foreach my $class ( @path ) {
#		local $@;
#		my $dir = eval {
#		 	module_dir($class);
#		};
#		next if $@;
#		my $path = File::Spec->catfile($dir, $file);
#		unless ( -e $path ) {
#			next;
#		}
#		unless ( -r $path ) {
#			Carp::croak("File '$file' cannot be read, no read permissions");
#		}
#		return $path;
#	}
#	Carp::croak("File '$file' does not exist in class or parent shared files");
#}
#
#
#
#
#
#sub _module_subdir {
#	my $module = shift;
#	$module =~ s/::/-/g;
#	return $module;
#}
#
#sub _dist_packfile {
#	my $module = shift;
#	my @dirs   = grep { -e } ( $Config::Config{archlibexp}, $Config::Config{sitearchexp} );
#	my $file   = File::Spec->catfile(
#		'auto', split( /::/, $module), '.packlist',
#	);
#
#	foreach my $dir ( @dirs ) {
#		my $path = File::Spec->catfile( $dir, $file );
#		next unless -f $path;
#
#		my $packlist = ExtUtils::Packlist->new($path);
#		unless ( $packlist ) {
#			die "Failed to load .packlist file for $module";
#		}
#
#		die "CODE INCOMPLETE";
#	}
#
#	die "CODE INCOMPLETE";
#}
#
#sub _CLASS {
#    (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
#}
#
#
#
#sub _DIST {
#	if ( defined $_[0] and ! ref $_[0] and $_[0] =~ /^[a-z0-9+_-]+$/is ) {
#		return shift;
#	}
#	Carp::croak("Not a valid distribution name");
#}
#
#sub _MODULE {
#	my $module = _CLASS(shift) or Carp::croak("Not a valid module name");
#	if ( Class::Inspector->loaded($module) ) {
#		return $module;
#	}
#	Carp::croak("Module '$module' is not loaded");
#}
#
#sub _FILE {
#	my $file = shift;
#	unless ( defined $file and ! ref $file and length $file ) {
#		Carp::croak("Did not pass a file name");
#	}
#	if ( File::Spec->file_name_is_absolute($file) ) {
#		Carp::croak("Cannot use absolute file name '$file'");
#	}
#	$file;
#}
#
#1;
#
### File/ShareDir/Tarball.pm ###
#package File::ShareDir::Tarball;
#BEGIN {
#  $File::ShareDir::Tarball::AUTHORITY = 'cpan:YANICK';
#}
#{
#  $File::ShareDir::Tarball::VERSION = '0.2.2';
#}
#
#
#use strict;
#use warnings;
#
#use parent qw/ Exporter /;
#
#use Carp;
#
#use File::ShareDir;
#use Archive::Tar;
#use File::Temp qw/ tempdir /;
#use File::chdir;
#
#our @EXPORT_OK   = qw{
#    dist_dir dist_file
#};
#our %EXPORT_TAGS = (
#    all => [ @EXPORT_OK ],
#);
#
#my $shared_files_tarball = 'shared-files.tar.gz';
#
#my %DIR_CACHE;
#
#sub dist_dir {
#    my $dist = shift;
#
#    return $DIR_CACHE{$dist} if $DIR_CACHE{$dist};
#
#    my $dir = File::ShareDir::dist_dir($dist);
#
#    return $DIR_CACHE{$dist} = $dir 
#        unless -f "$dir/$shared_files_tarball";
#
#    my $archive = Archive::Tar->new;
#    $archive->read("$dir/$shared_files_tarball");
#
#    croak "archive '$shared_files_tarball' contains files with absolute path, aborting"
#        if grep { m#^/# } $archive->list_files;
#
#    my $tmpdir = tempdir( CLEANUP => 1 );
#    local $CWD = $tmpdir;
#
#    $archive->extract;
#
#    return $DIR_CACHE{$dist} = $tmpdir;
#}
#
#sub dist_file {
#    my $dist = File::ShareDir::_DIST(shift);
#    my $file = File::ShareDir::_FILE(shift);
#
#    my $path = dist_dir($dist).'/'.$file;
#
#	return undef unless -e $path;
#
#    croak("Found dist_file '$path', but not a file") 
#        unless -f $path;
#
#    croak("File '$path', no read permissions") 
#        unless -r $path;
#
#	return $path;
#}
#
#
#1;
#
#__END__
#
### File/Slurper.pm ###
#package File::Slurper;
#$File::Slurper::VERSION = '0.008';
#use strict;
#use warnings;
#
#use Carp 'croak';
#use Exporter 5.57 'import';
#our @EXPORT_OK = qw/read_binary read_text read_lines write_binary write_text read_dir/;
#
#sub read_binary {
#	my $filename = shift;
#
#	open my $fh, '<:unix', $filename or croak "Couldn't open $filename: $!";
#	if (my $size = -s $fh) {
#		my $buf;
#		my ($pos, $read) = 0;
#		do {
#			defined($read = read $fh, ${$buf}, $size - $pos, $pos) or croak "Couldn't read $filename: $!";
#			$pos += $read;
#		} while ($read && $pos < $size);
#		return ${$buf};
#	}
#	else {
#		return do { local $/; <$fh> };
#	}
#}
#
#use constant {
#	CRLF_DEFAULT => $^O eq 'MSWin32',
#	HAS_UTF8_STRICT => scalar do { local $@; eval { require PerlIO::utf8_strict } },
#};
#
#sub _text_layers {
#	my ($encoding, $crlf) = @_;
#	$crlf = CRLF_DEFAULT if $crlf && $crlf eq 'auto';
#
#	if ($encoding =~ /^(latin|iso-8859-)1$/i) {
#		return $crlf ? ':unix:crlf' : ':raw';
#	}
#	elsif (HAS_UTF8_STRICT && $encoding =~ /^utf-?8\b/i) {
#		return $crlf ? ':unix:utf8_strict:crlf' : ':unix:utf8_strict';
#	}
#	else {
#		return $crlf ? ":raw:encoding($encoding):crlf" : ":raw:encoding($encoding)";
#	}
#}
#
#sub read_text {
#	my ($filename, $encoding, $crlf) = @_;
#	$encoding ||= 'utf-8';
#	my $layer = _text_layers($encoding, $crlf);
#	return read_binary($filename) if $layer eq ':raw';
#
#	local $PerlIO::encoding::fallback = 1;
#	open my $fh, "<$layer", $filename or croak "Couldn't open $filename: $!";
#	return do { local $/; <$fh> };
#}
#
#sub write_text {
#	my ($filename, undef, $encoding, $crlf) = @_;
#	$encoding ||= 'utf-8';
#	my $layer = _text_layers($encoding, $crlf);
#
#	local $PerlIO::encoding::fallback = 1;
#	open my $fh, ">$layer", $filename or croak "Couldn't open $filename: $!";
#	print $fh $_[1] or croak "Couldn't write to $filename: $!";
#	close $fh or croak "Couldn't write to $filename: $!";
#	return;
#}
#
#sub write_binary {
#	return write_text(@_[0,1], 'latin-1');
#}
#
#sub read_lines {
#	my ($filename, $encoding, $crlf, $skip_chomp) = @_;
#	$encoding ||= 'utf-8';
#	my $layer = _text_layers($encoding, $crlf);
#
#	local $PerlIO::encoding::fallback = 1;
#	open my $fh, "<$layer", $filename or croak "Couldn't open $filename: $!";
#	return <$fh> if $skip_chomp;
#	my @buf = <$fh>;
#	close $fh;
#	chomp @buf;
#	return @buf;
#}
#
#sub read_dir {
#	my ($dirname) = @_;
#	opendir my ($dir), $dirname or croak "Could not open $dirname: $!";
#	return grep { not m/ \A \.\.? \z /x } readdir $dir;
#}
#
#1;
#
#
#__END__
#
### File/Which.pm ###
#package File::Which;
#
#use strict;
#use warnings;
#use Exporter   ();
#use File::Spec ();
#
#our $VERSION = '1.21'; 
#
#
#our @ISA       = 'Exporter';
#our @EXPORT    = 'which';
#our @EXPORT_OK = 'where';
#
#use constant IS_VMS => ($^O eq 'VMS');
#use constant IS_MAC => ($^O eq 'MacOS');
#use constant IS_DOS => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');
#use constant IS_CYG => ($^O eq 'cygwin');
#
#my @PATHEXT = ('');
#if ( IS_DOS ) {
#  if ( $ENV{PATHEXT} ) {
#    push @PATHEXT, split ';', $ENV{PATHEXT};
#  } else {
#    push @PATHEXT, qw{.com .exe .bat};
#  }
#} elsif ( IS_VMS ) {
#  push @PATHEXT, qw{.exe .com};
#} elsif ( IS_CYG ) {
#  push @PATHEXT, qw{.exe .com};
#}
#
#
#sub which {
#  my ($exec) = @_;
#
#  return undef unless defined $exec;
#  return undef if $exec eq '';
#
#  my $all = wantarray;
#  my @results = ();
#
#  if ( IS_VMS ) {
#    my $symbol = `SHOW SYMBOL $exec`;
#    chomp($symbol);
#    unless ( $? ) {
#      return $symbol unless $all;
#      push @results, $symbol;
#    }
#  }
#  if ( IS_MAC ) {
#    my @aliases = split /\,/, $ENV{Aliases};
#    foreach my $alias ( @aliases ) {
#      if ( lc($alias) eq lc($exec) ) {
#        chomp(my $file = `Alias $alias`);
#        last unless $file;  
#        return $file unless $all;
#        push @results, $file;
#        last;
#      }
#    }
#  }
#
#  return $exec
#          if !IS_VMS and !IS_MAC and !IS_DOS and $exec =~ /\// and -f $exec and -x $exec;
#
#  my @path = File::Spec->path;
#  if ( IS_DOS or IS_VMS or IS_MAC ) {
#    unshift @path, File::Spec->curdir;
#  }
#
#  foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
#    for my $ext ( @PATHEXT ) {
#      my $file = $base.$ext;
#
#      next if -d $file;
#
#      if (
#        -x _
#        or (
#          IS_MAC
#          ||
#          (
#            ( IS_DOS or IS_CYG )
#            and
#            grep {
#              $file =~ /$_\z/i
#            } @PATHEXT[1..$#PATHEXT]
#          )
#          and -e _
#        )
#      ) {
#        return $file unless $all;
#        push @results, $file;
#      }
#    }
#  }
#
#  if ( $all ) {
#    return @results;
#  } else {
#    return undef;
#  }
#}
#
#
#sub where {
#  my @res = which($_[0]);
#  return @res;
#}
#
#1;
#
#__END__
#
### File/chdir.pm ###
#package File::chdir;
#use 5.004;
#use strict;
#use vars qw($VERSION @ISA @EXPORT $CWD @CWD);
#
#our $VERSION = '0.1010';
#
#require Exporter;
#@ISA = qw(Exporter);
#@EXPORT = qw(*CWD);
#
#use Carp;
#use Cwd 3.16;
#use File::Spec::Functions 3.27 qw/canonpath splitpath catpath splitdir catdir/;
#
#tie $CWD, 'File::chdir::SCALAR' or die "Can't tie \$CWD";
#tie @CWD, 'File::chdir::ARRAY'  or die "Can't tie \@CWD";
#
#sub _abs_path {
#    my($cwd) = Cwd::getcwd =~ /(.*)/s;
#    return canonpath($cwd);
#}
#
#sub _split_cwd {
#    my ($vol, $dir) = splitpath(_abs_path, 1);
#    my @dirs = splitdir( $dir );
#    shift @dirs; 
#    return ($vol, @dirs);
#}
#
#sub _catpath {
#    my ($vol, @dirs) = @_;
#    return catpath($vol, catdir(q{}, @dirs), q{});
#}
#
#sub _chdir {
#    my ($new_dir) = $_[0] =~ /(.*)/s;
#
#    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
#    if ( ! CORE::chdir($new_dir) ) {
#        croak "Failed to change directory to '$new_dir': $!";
#    };
#    return 1;
#}
#
#{
#    package File::chdir::SCALAR;
#    use Carp;
#
#    BEGIN {
#        *_abs_path = \&File::chdir::_abs_path;
#        *_chdir = \&File::chdir::_chdir;
#        *_split_cwd = \&File::chdir::_split_cwd;
#        *_catpath = \&File::chdir::_catpath;
#    }
#
#    sub TIESCALAR {
#        bless [], $_[0];
#    }
#
#    sub FETCH {
#        return _abs_path;
#    }
#
#    sub STORE {
#        return unless defined $_[1];
#        _chdir($_[1]);
#    }
#}
#
#
#{
#    package File::chdir::ARRAY;
#    use Carp;
#
#    BEGIN {
#        *_abs_path = \&File::chdir::_abs_path;
#        *_chdir = \&File::chdir::_chdir;
#        *_split_cwd = \&File::chdir::_split_cwd;
#        *_catpath = \&File::chdir::_catpath;
#    }
#
#    sub TIEARRAY {
#        bless {}, $_[0];
#    }
#
#    sub FETCH {
#        my($self, $idx) = @_;
#        my ($vol, @cwd) = _split_cwd;
#        return $cwd[$idx];
#    }
#
#    sub STORE {
#        my($self, $idx, $val) = @_;
#
#        my ($vol, @cwd) = _split_cwd;
#        if( $self->{Cleared} ) {
#            @cwd = ();
#            $self->{Cleared} = 0;
#        }
#
#        $cwd[$idx] = $val;
#        my $dir = _catpath($vol,@cwd);
#
#        _chdir($dir);
#        return $cwd[$idx];
#    }
#
#    sub FETCHSIZE {
#        my ($vol, @cwd) = _split_cwd;
#        return scalar @cwd;
#    }
#    sub STORESIZE {}
#
#    sub PUSH {
#        my($self) = shift;
#
#        my $dir = _catpath(_split_cwd, @_);
#        _chdir($dir);
#        return $self->FETCHSIZE;
#    }
#
#    sub POP {
#        my($self) = shift;
#
#        my ($vol, @cwd) = _split_cwd;
#        my $popped = pop @cwd;
#        my $dir = _catpath($vol,@cwd);
#        _chdir($dir);
#        return $popped;
#    }
#
#    sub SHIFT {
#        my($self) = shift;
#
#        my ($vol, @cwd) = _split_cwd;
#        my $shifted = shift @cwd;
#        my $dir = _catpath($vol,@cwd);
#        _chdir($dir);
#        return $shifted;
#    }
#
#    sub UNSHIFT {
#        my($self) = shift;
#
#        my ($vol, @cwd) = _split_cwd;
#        my $dir = _catpath($vol, @_, @cwd);
#        _chdir($dir);
#        return $self->FETCHSIZE;
#    }
#
#    sub CLEAR  {
#        my($self) = shift;
#        $self->{Cleared} = 1;
#    }
#
#    sub SPLICE {
#        my $self = shift;
#        my $offset = shift || 0;
#        my $len = shift || $self->FETCHSIZE - $offset;
#        my @new_dirs = @_;
#
#        my ($vol, @cwd) = _split_cwd;
#        my @orig_dirs = splice @cwd, $offset, $len, @new_dirs;
#        my $dir = _catpath($vol, @cwd);
#        _chdir($dir);
#        return @orig_dirs;
#    }
#
#    sub EXTEND { }
#    sub EXISTS {
#        my($self, $idx) = @_;
#        return $self->FETCHSIZE >= $idx ? 1 : 0;
#    }
#
#    sub DELETE {
#        my($self, $idx) = @_;
#        croak "Can't delete except at the end of \@CWD"
#            if $idx < $self->FETCHSIZE - 1;
#        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
#        $self->POP;
#    }
#}
#
#1;
#
#__END__
#
### Function/Fallback/CoreOrPP.pm ###
#package Function::Fallback::CoreOrPP;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $VERSION = '0.07'; 
#
#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} );
#    } 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-01-08'; 
#our $VERSION = '0.84'; 
#
#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
#               );
#
#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 `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*',
#            description => <<'_',
#
#Either `filename` or `string` must be specified.
#
#_
#        },
#        string => {
#            summary => 'Path to file to be checked',
#            schema => 'buf*',
#            description => <<'_',
#
#Either `file` or `string` must be specified.
#
#_
#        },
#        include_noexec => {
#            summary => 'Include scripts that do not have +x mode bit set',
#            schema  => 'bool*',
#            default => 1,
#        },
#    },
#};
#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 $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;
#        }
#        if ($str =~ /^\s*(use|require)\s+Getopt::Long(\s|;)/m) {
#            $yesno = 1;
#            last DETECT;
#        }
#        $reason = "Can't find any statement requiring Getopt::Long module";
#    } 
#
#    [200, "OK", $yesno, {"func.reason"=>$reason}];
#}
#
#
#__END__
#
### IO/Pty.pm ###
#
#package IO::Pty;
#
#use strict;
#use Carp;
#use IO::Tty qw(TIOCSCTTY TCSETCTTY TIOCNOTTY);
#use IO::File;
#require POSIX;
#
#use vars qw(@ISA $VERSION);
#
#$VERSION = '1.12'; 
#
#@ISA = qw(IO::Handle);
#eval { local $^W = 0; undef local $SIG{__DIE__}; require IO::Stty };
#push @ISA, "IO::Stty" if (not $@);  
#
#sub new {
#  my ($class) = $_[0] || "IO::Pty";
#  $class = ref($class) if ref($class);
#  @_ <= 1 or croak 'usage: new $class';
#
#  my ($ptyfd, $ttyfd, $ttyname) = pty_allocate();
#
#  croak "Cannot open a pty" if not defined $ptyfd;
#
#  my $pty = $class->SUPER::new_from_fd($ptyfd, "r+");
#  croak "Cannot create a new $class from fd $ptyfd: $!" if not $pty;
#  $pty->autoflush(1);
#  bless $pty => $class;
#
#  my $slave = IO::Tty->new_from_fd($ttyfd, "r+");
#  croak "Cannot create a new IO::Tty from fd $ttyfd: $!" if not $slave;
#  $slave->autoflush(1);
#
#  ${*$pty}{'io_pty_slave'} = $slave;
#  ${*$pty}{'io_pty_ttyname'} = $ttyname;
#  ${*$slave}{'io_tty_ttyname'} = $ttyname;
#
#  return $pty;
#}
#
#sub ttyname {
#  @_ == 1 or croak 'usage: $pty->ttyname();';
#  my $pty = shift;
#  ${*$pty}{'io_pty_ttyname'};
#}
#
#
#sub close_slave {
#  @_ == 1 or croak 'usage: $pty->close_slave();';
#
#  my $master = shift;
#
#  if (exists ${*$master}{'io_pty_slave'}) {
#    close ${*$master}{'io_pty_slave'};
#    delete ${*$master}{'io_pty_slave'};
#  }
#}
#
#sub slave {
#  @_ == 1 or croak 'usage: $pty->slave();';
#
#  my $master = shift;
#
#  if (exists ${*$master}{'io_pty_slave'}) {
#    return ${*$master}{'io_pty_slave'};
#  }
#
#  my $tty = ${*$master}{'io_pty_ttyname'};
#
#  my $slave = new IO::Tty;
#
#  $slave->open($tty, O_RDWR | O_NOCTTY) ||
#    croak "Cannot open slave $tty: $!";
#
#  return $slave;
#}
#
#sub make_slave_controlling_terminal {
#  @_ == 1 or croak 'usage: $pty->make_slave_controlling_terminal();';
#
#  my $self = shift;
#  local(*DEVTTY);
#
#  if (defined TIOCNOTTY) {
#    if (open (\*DEVTTY, "/dev/tty")) {
#      ioctl( \*DEVTTY, TIOCNOTTY, 0 );
#      close \*DEVTTY;
#    }
#  }
#
#  if (not POSIX::setsid()) {
#    warn "setsid() failed, strange behavior may result: $!\r\n" if $^W;
#  }
#
#  if (open(\*DEVTTY, "/dev/tty")) {
#    warn "Could not disconnect from controlling terminal?!\n" if $^W;
#    close \*DEVTTY;
#  }
#
#  my $ttyname = ${*$self}{'io_pty_ttyname'};
#  my $slv = new IO::Tty;
#  $slv->open($ttyname, O_RDWR)
#    or croak "Cannot open slave $ttyname: $!";
#
#  if (not exists ${*$self}{'io_pty_slave'}) {
#    ${*$self}{'io_pty_slave'} = $slv;
#  } else {
#    $slv->close;
#  }
#
#  if (not open(\*DEVTTY, "/dev/tty")) {
#    if (defined TIOCSCTTY) {
#      if (not defined ioctl( ${*$self}{'io_pty_slave'}, TIOCSCTTY, 0 )) {
#        warn "warning: TIOCSCTTY failed, slave might not be set as controlling terminal: $!" if $^W;
#      }
#    } elsif (defined TCSETCTTY) {
#      if (not defined ioctl( ${*$self}{'io_pty_slave'}, TCSETCTTY, 0 )) {
#        warn "warning: TCSETCTTY failed, slave might not be set as controlling terminal: $!" if $^W;
#      }
#    } else {
#      warn "warning: You have neither TIOCSCTTY nor TCSETCTTY on your system\n" if $^W;
#      return 0;
#    }
#  }
#
#  if (not open(\*DEVTTY, "/dev/tty")) {
#    warn "Error: could not connect pty as controlling terminal!\n";
#    return undef;
#  } else {
#    close \*DEVTTY;
#  }
#  
#  return 1;
#}
#
#*clone_winsize_from = \&IO::Tty::clone_winsize_from;
#*get_winsize = \&IO::Tty::get_winsize;
#*set_winsize = \&IO::Tty::set_winsize;
#*set_raw = \&IO::Tty::set_raw;
#
#1;
#
#__END__
#
#
### IO/Tty.pm ###
#
#package IO::Tty;
#
#use IO::Handle;
#use IO::File;
#use IO::Tty::Constant;
#use Carp;
#
#require POSIX;
#require DynaLoader;
#
#use vars qw(@ISA $VERSION $XS_VERSION $CONFIG $DEBUG);
#
#$VERSION = '1.12';
#$XS_VERSION = "1.12";
#@ISA = qw(IO::Handle);
#
#eval { local $^W = 0; undef local $SIG{__DIE__}; require IO::Stty };
#push @ISA, "IO::Stty" if (not $@);  
#
#BOOT_XS: {
#    require DynaLoader;
#
#    *dl_load_flags = DynaLoader->can('dl_load_flags');
#
#    do {
#	defined(&bootstrap)
#		? \&bootstrap
#		: \&DynaLoader::bootstrap
#    }->(__PACKAGE__);
#}
#
#sub import {
#    IO::Tty::Constant->export_to_level(1, @_);
#}
#
#sub open {
#    my($tty,$dev,$mode) = @_;
#
#    IO::File::open($tty,$dev,$mode) or
#	return undef;
#
#    $tty->autoflush;
#
#    1;
#}
#
#sub clone_winsize_from {
#  my ($self, $fh) = @_;
#  croak "Given filehandle is not a tty in clone_winsize_from, called"
#    if not POSIX::isatty($fh);  
#  return 1 if not POSIX::isatty($self);  
#  my $winsize = " "x1024; 
#  ioctl($fh, &IO::Tty::Constant::TIOCGWINSZ, $winsize)
#    and ioctl($self, &IO::Tty::Constant::TIOCSWINSZ, $winsize)
#      and return 1;
#  warn "clone_winsize_from: error: $!" if $^W;
#  return undef;
#}
#
#my $SIZEOF_WINSIZE = length IO::Tty::pack_winsize(0,0,0,0);
#
#sub get_winsize {
#  my $self = shift;
#  ioctl($self, IO::Tty::Constant::TIOCGWINSZ(), my $winsize)
#    or croak "Cannot TIOCGWINSZ - $!";
#  substr($winsize, $SIZEOF_WINSIZE) = "";
#  return IO::Tty::unpack_winsize($winsize);
#}
#
#sub set_winsize {
#  my $self = shift;
#  my $winsize = IO::Tty::pack_winsize(@_);
#  ioctl($self, IO::Tty::Constant::TIOCSWINSZ(), $winsize)
#    or croak "Cannot TIOCSWINSZ - $!";
#}
#
#sub set_raw($) {
#  require POSIX;
#  my $self = shift;
#  return 1 if not POSIX::isatty($self);
#  my $ttyno = fileno($self);
#  my $termios = new POSIX::Termios;
#  unless ($termios) {
#    warn "set_raw: new POSIX::Termios failed: $!";
#    return undef;
#  }
#  unless ($termios->getattr($ttyno)) {
#    warn "set_raw: getattr($ttyno) failed: $!";
#    return undef;
#  }
#  $termios->setiflag(0);
#  $termios->setoflag(0);
#  $termios->setlflag(0);
#  $termios->setcc(&POSIX::VMIN, 1);
#  $termios->setcc(&POSIX::VTIME, 0);
#  unless ($termios->setattr($ttyno, &POSIX::TCSANOW)) {
#    warn "set_raw: setattr($ttyno) failed: $!";
#    return undef;
#  }
#  return 1;
#}
#
#
#1;
#
#__END__
#
### IPC/Run.pm ###
#package IPC::Run;
#use bytes;
#
#
#use strict;
#use Exporter ();
#use vars qw{$VERSION @ISA @FILTER_IMP @FILTERS @API @EXPORT_OK %EXPORT_TAGS};
#BEGIN {
#	$VERSION = '0.94';
#	@ISA     = qw{ Exporter };
#
#	@FILTER_IMP = qw( input_avail get_more_input );
#	@FILTERS    = qw(
#		new_appender
#		new_chunker
#		new_string_source
#		new_string_sink
#	);
#	@API        = qw(
#		run
#		harness start pump pumpable finish
#		signal kill_kill reap_nb
#		io timer timeout
#		close_terminal
#		binary
#	);
#	@EXPORT_OK = ( @API, @FILTER_IMP, @FILTERS, qw( Win32_MODE ) );
#	%EXPORT_TAGS = (
#		'filter_imp' => \@FILTER_IMP,
#		'all'        => \@EXPORT_OK,
#		'filters'    => \@FILTERS,
#		'api'        => \@API,
#	);
#
#}
#
#use strict;
#use IPC::Run::Debug;
#use Exporter;
#use Fcntl;
#use POSIX ();
#BEGIN { if ($] < 5.008) { require Symbol; } }
#use Carp;
#use File::Spec ();
#use IO::Handle;
#require IPC::Run::IO;
#require IPC::Run::Timer;
#use UNIVERSAL ();
#
#use constant Win32_MODE => $^O =~ /os2|Win32/i;
#
#BEGIN {
#   if ( Win32_MODE ) {
#      eval "use IPC::Run::Win32Helper; 1;"
#         or ( $@ && die ) or die "$!";
#   }
#   else {
#      eval "use File::Basename; 1;" or die $!;
#   }
#}
#
#sub input_avail();
#sub get_more_input();
#
#
#use vars  qw( $_EIO $_EAGAIN );
#use Errno qw(   EIO   EAGAIN );
#BEGIN {
#  local $!;
#  $! = EIO;    $_EIO    = qr/^$!/;
#  $! = EAGAIN; $_EAGAIN = qr/^$!/;
#}
#
#sub _newed()    {0}
#sub _harnessed(){1}
#sub _finished() {2}   
#sub _started()  {3}
#
#my %fds;
#
#
#use vars qw( $cur_self );
#
#sub _debug_fd {
#   return fileno STDERR unless defined $cur_self;
#
#   if ( _debugging && ! defined $cur_self->{DEBUG_FD} ) {
#      my $fd = select STDERR; $| = 1; select $fd;
#      $cur_self->{DEBUG_FD} = POSIX::dup fileno STDERR;
#      _debug( "debugging fd is $cur_self->{DEBUG_FD}\n" )
#         if _debugging_details;
#   }
#
#   return fileno STDERR unless defined $cur_self->{DEBUG_FD};
#
#   return $cur_self->{DEBUG_FD}
#}
#
#sub DESTROY {
#   my IPC::Run $self = shift;
#   POSIX::close $self->{DEBUG_FD} if defined $self->{DEBUG_FD};
#   $self->{DEBUG_FD} = undef;
#}
#
#my %cmd_cache;
#
#sub _search_path {
#   my ( $cmd_name ) = @_;
#   if ( File::Spec->file_name_is_absolute( $cmd_name ) && -x $cmd_name) {
#      _debug "'", $cmd_name, "' is absolute"
#         if _debugging_details;
#      return $cmd_name;
#   }
#
#   my $dirsep =
#      ( Win32_MODE
#         ? '[/\\\\]'
#      : $^O =~ /MacOS/
#         ? ':'
#      : $^O =~ /VMS/
#         ? '[\[\]]'
#      : '/'
#      );
#
#   if ( Win32_MODE
#      && ( $cmd_name =~ /$dirsep/ )
#      && ( $cmd_name !~ m!\.[^\\/\.]+$! )
#    ) {
#
#      _debug "no extension(.exe), checking ENV{PATHEXT}"  if _debugging;
#      for ( split /;/, $ENV{PATHEXT} || ".COM;.BAT;.EXE" ) {
#         my $name = "$cmd_name$_";
#         $cmd_name = $name, last if -f $name && -x _;
#      }
#      _debug "cmd_name is now '$cmd_name'"  if _debugging;
#   }
#
#   if ( $cmd_name =~ /($dirsep)/ ) {
#      _debug "'$cmd_name' contains '$1'"  if _debugging;
#      croak "file not found: $cmd_name"    unless -e $cmd_name;
#      croak "not a file: $cmd_name"        unless -f $cmd_name;
#      croak "permission denied: $cmd_name" unless -x $cmd_name;
#      return $cmd_name;
#   }
#
#   if ( exists $cmd_cache{$cmd_name} ) {
#      _debug "'$cmd_name' found in cache: '$cmd_cache{$cmd_name}'"
#         if _debugging;
#      return $cmd_cache{$cmd_name} if -x $cmd_cache{$cmd_name};
#      _debug "'$cmd_cache{$cmd_name}' no longer executable, searching..."
#         if _debugging;
#      delete $cmd_cache{$cmd_name};
#   }
#
#   my @searched_in;
#
#      my $re = Win32_MODE ? qr/;/ : qr/:/;
#
#LOOP:
#   for ( split( $re, $ENV{PATH} || '', -1 ) ) {
#      $_ = "." unless length $_;
#      push @searched_in, $_;
#
#      my $prospect = File::Spec->catfile( $_, $cmd_name );
#      my @prospects;
#
#      @prospects =
#         ( Win32_MODE && ! ( -f $prospect && -x _ ) )
#            ? map "$prospect$_", split /;/, $ENV{PATHEXT} || ".COM;.BAT;.EXE"
#            : ( $prospect );
#
#      for my $found ( @prospects ) {
#         if ( -f $found && -x _ ) {
#            $cmd_cache{$cmd_name} = $found;
#            last LOOP;
#         }
#      }
#   }
#
#   if ( exists $cmd_cache{$cmd_name} ) {
#      _debug "'", $cmd_name, "' added to cache: '", $cmd_cache{$cmd_name}, "'"
#         if _debugging_details;
#      return $cmd_cache{$cmd_name};
#   }
#
#   croak "Command '$cmd_name' not found in " . join( ", ", @searched_in );
#}
#
#
#sub _empty($) { ! ( defined $_[0] && length $_[0] ) }
#
#sub _close {
#   confess 'undef' unless defined $_[0];
#   my $fd = $_[0] =~ /^\d+$/ ? $_[0] : fileno $_[0];
#   my $r = POSIX::close $fd;
#   $r = $r ? '' : " ERROR $!";
#   delete $fds{$fd};
#   _debug "close( $fd ) = " . ( $r || 0 ) if _debugging_details;
#}
#
#sub _dup {
#   confess 'undef' unless defined $_[0];
#   my $r = POSIX::dup( $_[0] );
#   croak "$!: dup( $_[0] )" unless defined $r;
#   $r = 0 if $r eq '0 but true';
#   _debug "dup( $_[0] ) = $r" if _debugging_details;
#   $fds{$r} = 1;
#   return $r;
#}
#
#
#sub _dup2_rudely {
#   confess 'undef' unless defined $_[0] && defined $_[1];
#   my $r = POSIX::dup2( $_[0], $_[1] );
#   croak "$!: dup2( $_[0], $_[1] )" unless defined $r;
#   $r = 0 if $r eq '0 but true';
#   _debug "dup2( $_[0], $_[1] ) = $r" if _debugging_details;
#   $fds{$r} = 1;
#   return $r;
#}
#
#sub _exec {
#   confess 'undef passed' if grep !defined, @_;
#   _debug 'exec()ing ', join " ", map "'$_'", @_ if _debugging_details;
#
#      exec { $_[0] } @_;
#}
#
#
#sub _sysopen {
#   confess 'undef' unless defined $_[0] && defined $_[1];
#_debug sprintf( "O_RDONLY=0x%02x ", O_RDONLY ),
#sprintf( "O_WRONLY=0x%02x ", O_WRONLY ),
#sprintf( "O_RDWR=0x%02x ", O_RDWR ),
#sprintf( "O_TRUNC=0x%02x ", O_TRUNC),
#sprintf( "O_CREAT=0x%02x ", O_CREAT),
#sprintf( "O_APPEND=0x%02x ", O_APPEND),
#if _debugging_details;
#   my $r = POSIX::open( $_[0], $_[1], 0644 );
#   croak "$!: open( $_[0], ", sprintf( "0x%03x", $_[1] ), " )" unless defined $r;
#   _debug "open( $_[0], ", sprintf( "0x%03x", $_[1] ), " ) = $r"
#      if _debugging_data;
#   $fds{$r} = 1;
#   return $r;
#}
#
#sub _pipe {
#   my ( $r, $w ) = POSIX::pipe;
#   croak "$!: pipe()" unless defined $r;
#   _debug "pipe() = ( $r, $w ) " if _debugging_details;
#   $fds{$r} = $fds{$w} = 1;
#   return ( $r, $w );
#}
#
#sub _pipe_nb {
#   local ( *R, *W );
#   my $f = pipe( R, W );
#   croak "$!: pipe()" unless defined $f;
#   my ( $r, $w ) = ( fileno R, fileno W );
#   _debug "pipe_nb pipe() = ( $r, $w )" if _debugging_details;
#   unless ( Win32_MODE ) {
#      my $fres = fcntl( W, &F_SETFL, O_WRONLY | O_NONBLOCK );
#      croak "$!: fcntl( $w, F_SETFL, O_NONBLOCK )" unless $fres;
#      _debug "fcntl( $w, F_SETFL, O_NONBLOCK )" if _debugging_details;
#   }
#   ( $r, $w ) = ( _dup( $r ), _dup( $w ) );
#   _debug "pipe_nb() = ( $r, $w )" if _debugging_details;
#   return ( $r, $w );
#}
#
#sub _pty {
#   require IO::Pty;
#   my $pty = IO::Pty->new();
#   croak "$!: pty ()" unless $pty;
#   $pty->autoflush();
#   $pty->blocking( 0 ) or croak "$!: pty->blocking ( 0 )";
#   _debug "pty() = ( ", $pty->fileno, ", ", $pty->slave->fileno, " )"
#      if _debugging_details;
#   $fds{$pty->fileno} = $fds{$pty->slave->fileno} = 1;
#   return $pty;
#}
#
#
#sub _read {
#   confess 'undef' unless defined $_[0];
#   my $s  = '';
#   my $r = POSIX::read( $_[0], $s, 10_000 );
#   croak "$!: read( $_[0] )" if not($r) and $! != POSIX::EINTR;
#   $r ||= 0;
#   _debug "read( $_[0] ) = $r chars '$s'" if _debugging_data;
#   return $s;
#}
#
#
#sub _spawn {
#   my IPC::Run $self = shift;
#   my ( $kid ) = @_;
#
#   _debug "opening sync pipe ", $kid->{PID} if _debugging_details;
#   my $sync_reader_fd;
#   ( $sync_reader_fd, $self->{SYNC_WRITER_FD} ) = _pipe;
#   $kid->{PID} = fork();
#   croak "$! during fork" unless defined $kid->{PID};
#
#   unless ( $kid->{PID} ) {
#      $self->_do_kid_and_exit( $kid );
#   }
#   _debug "fork() = ", $kid->{PID} if _debugging_details;
#
#   _close $self->{SYNC_WRITER_FD};
#   my $sync_pulse = _read $sync_reader_fd;
#   _close $sync_reader_fd;
#
#   if ( ! defined $sync_pulse || length $sync_pulse ) {
#      if ( waitpid( $kid->{PID}, 0 ) >= 0 ) {
#	 $kid->{RESULT} = $?;
#      }
#      else {
#	 $kid->{RESULT} = -1;
#      }
#      $sync_pulse =
#         "error reading synchronization pipe for $kid->{NUM}, pid $kid->{PID}"
#	 unless length $sync_pulse;
#      croak $sync_pulse;
#   }
#   return $kid->{PID};
#
#if ( keys %{$self->{PTYS}} && $IO::Pty::VERSION < 0.9 ) {
#_debug "sleeping to give pty a chance to init, will fix when newer IO::Pty arrives.";
#sleep 1;
#}
#}
#
#
#sub _write {
#   confess 'undef' unless defined $_[0] && defined $_[1];
#   my $r = POSIX::write( $_[0], $_[1], length $_[1] );
#   croak "$!: write( $_[0], '$_[1]' )" unless $r;
#   _debug "write( $_[0], '$_[1]' ) = $r" if _debugging_data;
#   return $r;
#}
#
#
#use vars qw( $in_run );  
#
#sub run {
#   local $in_run = 1;  
#   my IPC::Run $self = start( @_ );
#   my $r = eval {
#      $self->{clear_ins} = 0;
#      $self->finish;
#   };
#   if ( $@ ) {
#      my $x = $@;
#      $self->kill_kill;
#      die $x;
#   }
#   return $r;
#}
#
#
#sub signal {
#   my IPC::Run $self = shift;
#
#   local $cur_self = $self;
#
#   $self->_kill_kill_kill_pussycat_kill unless @_;
#
#   Carp::cluck "Ignoring extra parameters passed to kill()" if @_ > 1;
#
#   my ( $signal ) = @_;
#   croak "Undefined signal passed to signal" unless defined $signal;
#   for ( grep $_->{PID} && ! defined $_->{RESULT}, @{$self->{KIDS}} ) {
#      _debug "sending $signal to $_->{PID}"
#         if _debugging;
#      kill $signal, $_->{PID}
#         or _debugging && _debug "$! sending $signal to $_->{PID}";
#   }
#   
#   return;
#}
#
#
#sub kill_kill {
#   my IPC::Run $self = shift;
#
#   my %options = @_;
#   my $grace = $options{grace};
#   $grace = 30 unless defined $grace;
#   ++$grace; 
#
#   my $coup_d_grace = $options{coup_d_grace};
#   $coup_d_grace = "KILL" unless defined $coup_d_grace;
#
#   delete $options{$_} for qw( grace coup_d_grace );
#   Carp::cluck "Ignoring unknown options for kill_kill: ",
#       join " ",keys %options
#       if keys %options;
#
#   $self->signal( "TERM" );
#
#   my $quitting_time = time + $grace;
#   my $delay = 0.01;
#   my $accum_delay;
#
#   my $have_killed_before;
#
#   while () {
#      select undef, undef, undef, $delay;
#      $accum_delay += $delay;
#
#      $self->reap_nb;
#      last unless $self->_running_kids;
#
#      if ( $accum_delay >= $grace*0.8 ) {
#         if ( time >= $quitting_time ) {
#            if ( ! $have_killed_before ) {
#               $self->signal( $coup_d_grace );
#               $have_killed_before = 1;
#               $quitting_time += $grace;
#               $delay = 0.01;
#               $accum_delay = 0;
#               next;
#            }
#            croak "Unable to reap all children, even after KILLing them"
#         }
#      }
#
#      $delay *= 2;
#      $delay = 0.5 if $delay >= 0.5;
#   }
#
#   $self->_cleanup;
#   return $have_killed_before;
#}
#
#
#my $harness_id = 0;
#sub harness {
#   my $options;
#   if ( @_ && ref $_[-1] eq 'HASH' ) {
#      $options = pop;
#      require Data::Dumper;
#      carp "Passing in options as a hash is deprecated:\n", Data::Dumper::Dumper( $options );
#   }
#
#
#   my @args;
#   if ( @_ == 1 && ! ref $_[0] ) {
#      if ( Win32_MODE ) {
#         my $command = $ENV{ComSpec} || 'cmd';
#         @args = ( [ $command, '/c', win32_parse_cmd_line $_[0] ] );
#      }
#      else {
#         @args = ( [ qw( sh -c ), @_ ] );
#      }
#   }
#   elsif ( @_ > 1 && ! grep ref $_, @_ ) {
#      @args = ( [ @_ ] );
#   }
#   else {
#      @args = @_;
#   }
#
#   my @errs;               
#
#   my $succinct;           
#
#   my $cur_kid;            
#
#   my $assumed_fd    = 0;  
#   my $handle_num    = 0;  
#
#   my IPC::Run $self = bless {}, __PACKAGE__;
#
#   local $cur_self = $self;
#
#   $self->{ID}    = ++$harness_id;
#   $self->{IOS}   = [];
#   $self->{KIDS}  = [];
#   $self->{PIPES} = [];
#   $self->{PTYS}  = {};
#   $self->{STATE} = _newed;
#
#   if ( $options ) {
#      $self->{$_} = $options->{$_}
#         for keys %$options;
#   }
#
#   _debug "****** harnessing *****" if _debugging;
#
#   my $first_parse;
#   local $_;
#   my $arg_count = @args;
#   while ( @args ) { for ( shift @args ) {
#      eval {
#         $first_parse = 1;
#         _debug(
#            "parsing ",
#            defined $_
#               ? ref $_ eq 'ARRAY'
#                  ? ( '[ ', join( ', ', map "'$_'", @$_ ), ' ]' )
#                  : ( ref $_
#                     || ( length $_ < 50
#                           ? "'$_'"
#                           : join( '', "'", substr( $_, 0, 10 ), "...'" )
#                        )
#                  )
#               : '<undef>'
#         ) if _debugging;
#
#      REPARSE:
#         if ( ref eq 'ARRAY' || ( ! $cur_kid && ref eq 'CODE' ) ) {
#            croak "Process control symbol ('|', '&') missing" if $cur_kid;
#            croak "Can't spawn a subroutine on Win32"
#	       if Win32_MODE && ref eq "CODE";
#            $cur_kid = {
#               TYPE   => 'cmd',
#               VAL    => $_,
#               NUM    => @{$self->{KIDS}} + 1,
#               OPS    => [],
#               PID    => '',
#               RESULT => undef,
#            };
#            push @{$self->{KIDS}}, $cur_kid;
#            $succinct = 1;
#         }
#
#         elsif ( UNIVERSAL::isa( $_, 'IPC::Run::IO' ) ) {
#            push @{$self->{IOS}}, $_;
#            $cur_kid = undef;
#            $succinct = 1;
#         }
#         
#         elsif ( UNIVERSAL::isa( $_, 'IPC::Run::Timer' ) ) {
#            push @{$self->{TIMERS}}, $_;
#            $cur_kid = undef;
#            $succinct = 1;
#         }
#         
#         elsif ( /^(\d*)>&(\d+)$/ ) {
#            croak "No command before '$_'" unless $cur_kid;
#            push @{$cur_kid->{OPS}}, {
#               TYPE => 'dup',
#               KFD1 => $2,
#               KFD2 => length $1 ? $1 : 1,
#            };
#            _debug "redirect operators now required" if _debugging_details;
#            $succinct = ! $first_parse;
#         }
#
#         elsif ( /^(\d*)<&(\d+)$/ ) {
#            croak "No command before '$_'" unless $cur_kid;
#            push @{$cur_kid->{OPS}}, {
#               TYPE => 'dup',
#               KFD1 => $2,
#               KFD2 => length $1 ? $1 : 0,
#            };
#            $succinct = ! $first_parse;
#         }
#
#         elsif ( /^(\d*)<&-$/ ) {
#            croak "No command before '$_'" unless $cur_kid;
#            push @{$cur_kid->{OPS}}, {
#               TYPE => 'close',
#               KFD  => length $1 ? $1 : 0,
#            };
#            $succinct = ! $first_parse;
#         }
#
#         elsif (
#               /^(\d*) (<pipe)()            ()  ()  $/x
#            || /^(\d*) (<pty) ((?:\s+\S+)?) (<) ()  $/x
#            || /^(\d*) (<)    ()            ()  (.*)$/x
#         ) {
#            croak "No command before '$_'" unless $cur_kid;
#
#            $succinct = ! $first_parse;
#
#            my $type = $2 . $4;
#
#            my $kfd = length $1 ? $1 : 0;
#
#            my $pty_id;
#            if ( $type eq '<pty<' ) {
#               $pty_id = length $3 ? $3 : '0';
#               require IO::Pty;
#               $self->{PTYS}->{$pty_id} = undef;
#            }
#
#            my $source = $5;
#
#            my @filters;
#            my $binmode;
#
#            unless ( length $source ) {
#               if ( ! $succinct ) {
#                  while ( @args > 1
#                      && (
#                         ( ref $args[1] && ! UNIVERSAL::isa $args[1], "IPC::Run::Timer" )
#                         || UNIVERSAL::isa $args[0], "IPC::Run::binmode_pseudo_filter"
#                      )
#                  ) {
#                     if ( UNIVERSAL::isa $args[0], "IPC::Run::binmode_pseudo_filter" ) {
#                        $binmode = shift( @args )->();
#                     }
#                     else {
#                        push @filters, shift @args
#                     }
#                  }
#               }
#               $source = shift @args;
#               croak "'$_' missing a source" if _empty $source;
#
#               _debug(
#                  'Kid ', $cur_kid->{NUM}, "'s input fd ", $kfd,
#                  ' has ', scalar( @filters ), ' filters.'
#               ) if _debugging_details && @filters;
#            };
#
#            my IPC::Run::IO $pipe = IPC::Run::IO->_new_internal(
#               $type, $kfd, $pty_id, $source, $binmode, @filters
#            );
#
#            if ( ( ref $source eq 'GLOB' || UNIVERSAL::isa $source, 'IO::Handle' )
#               && $type !~ /^<p(ty<|ipe)$/
#            ) {
#	       _debug "setting DONT_CLOSE" if _debugging_details;
#               $pipe->{DONT_CLOSE} = 1; 
#	       _dont_inherit( $source ) if Win32_MODE;
#            }
#
#            push @{$cur_kid->{OPS}}, $pipe;
#      }
#
#         elsif ( /^()   (>>?)  (&)     ()      (.*)$/x
#            ||   /^()   (&)    (>pipe) ()      ()  $/x 
#            ||   /^()   (>pipe)(&)     ()      ()  $/x 
#            ||   /^(\d*)()     (>pipe) ()      ()  $/x
#            ||   /^()   (&)    (>pty)  ( \w*)> ()  $/x 
#            ||   /^(\d*)()     (>pty)  ( \w*)> ()  $/x
#            ||   /^()   (&)    (>>?)   ()      (.*)$/x 
#            ||   /^(\d*)()     (>>?)   ()      (.*)$/x
#         ) {
#            croak "No command before '$_'" unless $cur_kid;
#
#            $succinct = ! $first_parse;
#
#            my $type = (
#               $2 eq '>pipe' || $3 eq '>pipe'
#                  ? '>pipe'
#                  : $2 eq '>pty' || $3 eq '>pty'
#                     ? '>pty>'
#                     : '>'
#            );
#            my $kfd = length $1 ? $1 : 1;
#            my $trunc = ! ( $2 eq '>>' || $3 eq '>>' );
#            my $pty_id = (
#               $2 eq '>pty' || $3 eq '>pty'
#                  ? length $4 ? $4 : 0
#                  : undef
#            );
#
#            my $stderr_too =
#                  $2 eq '&'
#               || $3 eq '&'
#               || ( ! length $1 && substr( $type, 0, 4 ) eq '>pty' );
#
#            my $dest = $5;
#            my @filters;
#            my $binmode = 0;
#            unless ( length $dest ) {
#               if ( ! $succinct ) {
#                  while ( @args > 1
#                     && ( 
#                        ( ref $args[1] && !  UNIVERSAL::isa $args[1], "IPC::Run::Timer" )
#                        || UNIVERSAL::isa $args[0], "IPC::Run::binmode_pseudo_filter"
#                     )
#                  ) {
#                     if ( UNIVERSAL::isa $args[0], "IPC::Run::binmode_pseudo_filter" ) {
#                        $binmode = shift( @args )->();
#                     }
#                     else {
#                        unshift @filters, shift @args;
#                     }
#                  }
#               }
#
#               $dest = shift @args;
#
#               _debug(
#                  'Kid ', $cur_kid->{NUM}, "'s output fd ", $kfd,
#                  ' has ', scalar( @filters ), ' filters.'
#               ) if _debugging_details && @filters;
#
#               if ( $type eq '>pty>' ) {
#                  require IO::Pty;
#                  $self->{PTYS}->{$pty_id} = undef;
#               }
#            }
#
#            croak "'$_' missing a destination" if _empty $dest;
#            my $pipe = IPC::Run::IO->_new_internal(
#               $type, $kfd, $pty_id, $dest, $binmode, @filters
#            );
#            $pipe->{TRUNC} = $trunc;
#
#            if (  ( UNIVERSAL::isa( $dest, 'GLOB' ) || UNIVERSAL::isa( $dest, 'IO::Handle' ) )
#               && $type !~ /^>(pty>|pipe)$/
#            ) {
#	       _debug "setting DONT_CLOSE" if _debugging_details;
#               $pipe->{DONT_CLOSE} = 1; 
#            }
#            push @{$cur_kid->{OPS}}, $pipe;
#            push @{$cur_kid->{OPS}}, {
#               TYPE => 'dup',
#               KFD1 => 1,
#               KFD2 => 2,
#            } if $stderr_too;
#         }
#
#         elsif ( $_ eq "|" ) {
#            croak "No command before '$_'" unless $cur_kid;
#            unshift @{$cur_kid->{OPS}}, {
#               TYPE => '|',
#               KFD  => 1,
#            };
#            $succinct   = 1;
#            $assumed_fd = 1;
#            $cur_kid    = undef;
#         }
#
#         elsif ( $_ eq "&" ) {
#            croak "No command before '$_'" unless $cur_kid;
#            unshift @{$cur_kid->{OPS}}, {
#               TYPE => 'close',
#               KFD  => 0,
#            };
#            $succinct   = 1;
#            $assumed_fd = 0;
#            $cur_kid    = undef;
#         }
#
#         elsif ( $_ eq 'init' ) {
#            croak "No command before '$_'" unless $cur_kid;
#            push @{$cur_kid->{OPS}}, {
#               TYPE => 'init',
#               SUB  => shift @args,
#            };
#         }
#
#         elsif ( ! ref $_ ) {
#            $self->{$_} = shift @args;
#         }
#
#         elsif ( $_ eq 'init' ) {
#            croak "No command before '$_'" unless $cur_kid;
#            push @{$cur_kid->{OPS}}, {
#               TYPE => 'init',
#               SUB  => shift @args,
#            };
#         }
#
#         elsif ( $succinct && $first_parse ) {
#            unshift @args, $_;
#            if ( ! $assumed_fd ) {
#               $_ = "$assumed_fd<",
#            }
#            else {
#               $_ = "$assumed_fd>",
#            }
#            _debug "assuming '", $_, "'" if _debugging_details;
#            ++$assumed_fd;
#            $first_parse = 0;
#            goto REPARSE;
#         }
#
#         else {
#            croak join( 
#               '',
#               'Unexpected ',
#               ( ref() ? $_ : 'scalar' ),
#               ' in harness() parameter ',
#               $arg_count - @args
#            );
#         }
#      };
#      if ( $@ ) {
#         push @errs, $@;
#         _debug 'caught ', $@ if _debugging;
#      }
#   } }
#
#   die join( '', @errs ) if @errs;
#
#
#   $self->{STATE} = _harnessed;
#   return $self;
#}
#
#
#sub _open_pipes {
#   my IPC::Run $self = shift;
#
#   my @errs;
#
#   my @close_on_fail;
#
#   my $pipe_read_fd;
#
#   my @output_fds_accum;
#
#   for ( sort keys %{$self->{PTYS}} ) {
#      _debug "opening pty '", $_, "'" if _debugging_details;
#      my $pty = _pty;
#      $self->{PTYS}->{$_} = $pty;
#   }
#
#   for ( @{$self->{IOS}} ) {
#      eval { $_->init; };
#      if ( $@ ) {
#         push @errs, $@;
#         _debug 'caught ', $@ if _debugging;
#      }
#      else {
#         push @close_on_fail, $_;
#      }
#   }
#
#   for my $kid ( @{$self->{KIDS}} ) {
#      unless ( ref $kid->{VAL} eq 'CODE' ) {
#         $kid->{PATH} = _search_path $kid->{VAL}->[0];
#      }
#      if ( defined $pipe_read_fd ) {
#	 _debug "placing write end of pipe on kid $kid->{NUM}'s stdin"
#	    if _debugging_details;
#         unshift @{$kid->{OPS}}, {
#            TYPE => 'PIPE',  
#            KFD  => 0,
#            TFD  => $pipe_read_fd,
#         };
#         $pipe_read_fd = undef;
#      }
#      @output_fds_accum = ();
#      for my $op ( @{$kid->{OPS}} ) {
#         my $ok = eval {
#            if ( $op->{TYPE} eq '<' ) {
#               my $source = $op->{SOURCE};
#	       if ( ! ref $source ) {
#		  _debug(
#		     "kid ", $kid->{NUM}, " to read ", $op->{KFD},
#		     " from '" .  $source, "' (read only)"
#		  ) if _debugging_details;
#		  croak "simulated open failure"
#		     if $self->{_simulate_open_failure};
#		  $op->{TFD} = _sysopen( $source, O_RDONLY );
#		  push @close_on_fail, $op->{TFD};
#	       }
#	       elsif ( UNIVERSAL::isa( $source, 'GLOB' )
#		  ||   UNIVERSAL::isa( $source, 'IO::Handle' )
#	       ) {
#		  croak
#		     "Unopened filehandle in input redirect for $op->{KFD}"
#		     unless defined fileno $source;
#		  $op->{TFD} = fileno $source;
#		  _debug(
#		     "kid ", $kid->{NUM}, " to read ", $op->{KFD},
#		     " from fd ", $op->{TFD}
#		  ) if _debugging_details;
#	       }
#	       elsif ( UNIVERSAL::isa( $source, 'SCALAR' ) ) {
#		  _debug(
#		     "kid ", $kid->{NUM}, " to read ", $op->{KFD},
#		     " from SCALAR"
#		  ) if _debugging_details;
#
#		  $op->open_pipe( $self->_debug_fd );
#		  push @close_on_fail, $op->{KFD}, $op->{FD};
#
#		  my $s = '';
#		  $op->{KIN_REF} = \$s;
#	       }
#	       elsif ( UNIVERSAL::isa( $source, 'CODE' ) ) {
#		  _debug(
#		     'kid ', $kid->{NUM}, ' to read ', $op->{KFD}, ' from CODE'
#		  ) if _debugging_details;
#		  
#		  $op->open_pipe( $self->_debug_fd );
#		  push @close_on_fail, $op->{KFD}, $op->{FD};
#		  
#		  my $s = '';
#		  $op->{KIN_REF} = \$s;
#	       }
#	       else {
#		  croak(
#		     "'"
#		     . ref( $source )
#		     . "' not allowed as a source for input redirection"
#		  );
#	       }
#               $op->_init_filters;
#            }
#            elsif ( $op->{TYPE} eq '<pipe' ) {
#               _debug(
#                  'kid to read ', $op->{KFD},
#                  ' from a pipe IPC::Run opens and returns',
#               ) if _debugging_details;
#
#               my ( $r, $w ) = $op->open_pipe( $self->_debug_fd, $op->{SOURCE} );
#	       _debug "caller will write to ", fileno $op->{SOURCE}
#	          if _debugging_details;
#
#               $op->{TFD}    = $r;
#	       $op->{FD}     = undef; 
#               $op->_init_filters;
#            }
#            elsif ( $op->{TYPE} eq '<pty<' ) {
#               _debug(
#                  'kid to read ', $op->{KFD}, " from pty '", $op->{PTY_ID}, "'",
#               ) if _debugging_details;
#               
#               for my $source ( $op->{SOURCE} ) {
#                  if ( UNIVERSAL::isa( $source, 'SCALAR' ) ) {
#                     _debug(
#                        "kid ", $kid->{NUM}, " to read ", $op->{KFD},
#                        " from SCALAR via pty '", $op->{PTY_ID}, "'"
#                     ) if _debugging_details;
#
#                     my $s = '';
#                     $op->{KIN_REF} = \$s;
#                  }
#                  elsif ( UNIVERSAL::isa( $source, 'CODE' ) ) {
#                     _debug(
#                        "kid ", $kid->{NUM}, " to read ", $op->{KFD},
#                        " from CODE via pty '", $op->{PTY_ID}, "'"
#                     ) if _debugging_details;
#                     my $s = '';
#                     $op->{KIN_REF} = \$s;
#                  }
#                  else {
#                     croak(
#                        "'"
#                        . ref( $source )
#                        . "' not allowed as a source for '<pty<' redirection"
#                     );
#                  }
#               }
#               $op->{FD} = $self->{PTYS}->{$op->{PTY_ID}}->fileno;
#               $op->{TFD} = undef; 
#               $op->_init_filters;
#            }
#            elsif ( $op->{TYPE} eq '>' ) {
#               my $dest = $op->{DEST};
#               if ( ! ref $dest ) {
#                  _debug(
#                     "kid ", $kid->{NUM}, " to write ", $op->{KFD},
#                     " to '", $dest, "' (write only, create, ",
#                     ( $op->{TRUNC} ? 'truncate' : 'append' ),
#                     ")"
#                  ) if _debugging_details;
#                  croak "simulated open failure"
#                     if $self->{_simulate_open_failure};
#                  $op->{TFD} = _sysopen(
#                     $dest,
#                     ( O_WRONLY
#                     | O_CREAT 
#                     | ( $op->{TRUNC} ? O_TRUNC : O_APPEND )
#                     )
#                  );
#		  if ( Win32_MODE ) {
#		     POSIX::lseek( $op->{TFD}, 0, POSIX::SEEK_END() );
#		  }
#                  push @close_on_fail, $op->{TFD};
#               }
#               elsif ( UNIVERSAL::isa( $dest, 'GLOB' ) ) {
#                  croak(
#                   "Unopened filehandle in output redirect, command $kid->{NUM}"
#                  ) unless defined fileno $dest;
#                  my $old_fh = select( $dest ); $| = 1; select( $old_fh );
#                  $op->{TFD} = fileno $dest;
#                  _debug(
#                     'kid to write ', $op->{KFD}, ' to handle ', $op->{TFD}
#                  ) if _debugging_details;
#               }
#               elsif ( UNIVERSAL::isa( $dest, 'SCALAR' ) ) {
#                  _debug(
#                     "kid ", $kid->{NUM}, " to write $op->{KFD} to SCALAR"
#                  ) if _debugging_details;
#
#		  $op->open_pipe( $self->_debug_fd );
#                  push @close_on_fail, $op->{FD}, $op->{TFD};
#                  $$dest = '' if $op->{TRUNC};
#               }
#               elsif ( UNIVERSAL::isa( $dest, 'CODE' ) ) {
#                  _debug(
#                     "kid $kid->{NUM} to write $op->{KFD} to CODE"
#                  ) if _debugging_details;
#
#		  $op->open_pipe( $self->_debug_fd );
#                  push @close_on_fail, $op->{FD}, $op->{TFD};
#               }
#               else {
#                  croak(
#                     "'"
#                     . ref( $dest )
#                     . "' not allowed as a sink for output redirection"
#                  );
#               }
#               $output_fds_accum[$op->{KFD}] = $op;
#               $op->_init_filters;
#            }
#
#            elsif ( $op->{TYPE} eq '>pipe' ) {
#               _debug(
#                  "kid ", $kid->{NUM}, " to write ", $op->{KFD},
#		  ' to a pipe IPC::Run opens and returns'
#               ) if _debugging_details;
#
#               my ( $r, $w ) = $op->open_pipe( $self->_debug_fd, $op->{DEST} );
#	       _debug "caller will read from ", fileno $op->{DEST}
#	          if _debugging_details;
#
#               $op->{TFD} = $w;
#	       $op->{FD}  = undef; 
#               $op->_init_filters;
#
#               $output_fds_accum[$op->{KFD}] = $op;
#            }
#            elsif ( $op->{TYPE} eq '>pty>' ) {
#               my $dest = $op->{DEST};
#               if ( UNIVERSAL::isa( $dest, 'SCALAR' ) ) {
#                  _debug(
#                     "kid ", $kid->{NUM}, " to write ", $op->{KFD},
#                     " to SCALAR via pty '", $op->{PTY_ID}, "'"
#               ) if _debugging_details;
#
#                  $$dest = '' if $op->{TRUNC};
#               }
#               elsif ( UNIVERSAL::isa( $dest, 'CODE' ) ) {
#                  _debug(
#                     "kid ", $kid->{NUM}, " to write ", $op->{KFD},
#                     " to CODE via pty '", $op->{PTY_ID}, "'"
#                  ) if _debugging_details;
#               }
#               else {
#                  croak(
#                     "'"
#                     . ref( $dest )
#                     . "' not allowed as a sink for output redirection"
#                  );
#               }
#
#               $op->{FD} = $self->{PTYS}->{$op->{PTY_ID}}->fileno;
#               $op->{TFD} = undef; 
#               $output_fds_accum[$op->{KFD}] = $op;
#               $op->_init_filters;
#            }
#            elsif ( $op->{TYPE} eq '|' ) {
#               _debug(
#                  "pipelining $kid->{NUM} and "
#                  . ( $kid->{NUM} + 1 )
#               ) if _debugging_details;
#               ( $pipe_read_fd, $op->{TFD} ) = _pipe;
#	       if ( Win32_MODE ) {
#		  _dont_inherit( $pipe_read_fd );
#		  _dont_inherit( $op->{TFD} );
#	       }
#               @output_fds_accum = ();
#            }
#            elsif ( $op->{TYPE} eq '&' ) {
#               @output_fds_accum = ();
#            } 
#	    1;
#	 }; 
#	 unless ( $ok ) {
#	    push @errs, $@;
#	    _debug 'caught ', $@ if _debugging;
#	 }
#      } 
#   }
#
#   if ( @errs ) {
#      for ( @close_on_fail ) {
#         _close( $_ );
#         $_ = undef;
#      }
#      for ( keys %{$self->{PTYS}} ) {
#         next unless $self->{PTYS}->{$_};
#         close $self->{PTYS}->{$_};
#         $self->{PTYS}->{$_} = undef;
#      }
#      die join( '', @errs )
#   }
#
#   for ( my $num = 0; $num < $#{$self->{KIDS}}; ++$num ) {
#      for ( reverse @output_fds_accum ) {
#         next unless defined $_;
#         _debug(
#            'kid ', $self->{KIDS}->[$num]->{NUM}, ' also to write ', $_->{KFD},
#            ' to ', ref $_->{DEST}
#         ) if _debugging_details;
#         unshift @{$self->{KIDS}->[$num]->{OPS}}, $_;
#      }
#   }
#
#   @{$self->{PIPES}} = ();
#   $self->{RIN} = '';
#   $self->{WIN} = '';
#   $self->{EIN} = '';
#   $self->{PIN} = '';
#   for my $kid ( @{$self->{KIDS}} ) {
#      for ( @{$kid->{OPS}} ) {
#         if ( defined $_->{FD} ) {
#            _debug(
#               'kid ', $kid->{NUM}, '[', $kid->{PID}, "]'s ", $_->{KFD},
#               ' is my ', $_->{FD}
#            ) if _debugging_details;
#            vec( $self->{ $_->{TYPE} =~ /^</ ? 'WIN' : 'RIN' }, $_->{FD}, 1 ) = 1;
#            push @{$self->{PIPES}}, $_;
#         }
#      }
#   }
#
#   for my $io ( @{$self->{IOS}} ) {
#      my $fd = $io->fileno;
#      vec( $self->{RIN}, $fd, 1 ) = 1 if $io->mode =~ /r/;
#      vec( $self->{WIN}, $fd, 1 ) = 1 if $io->mode =~ /w/;
#      push @{$self->{PIPES}}, $io;
#   }
#
#   for my $pipe ( @{$self->{PIPES}} ) {
#      $pipe->{SOURCE_EMPTY} = 0;
#      $pipe->{PAUSED} = 0;
#      if ( $pipe->{TYPE} =~ /^>/ ) {
#         my $pipe_reader = sub {
#            my ( undef, $out_ref ) = @_;
#
#            return undef unless defined $pipe->{FD};
#            return 0 unless vec( $self->{ROUT}, $pipe->{FD}, 1 );
#
#            vec( $self->{ROUT}, $pipe->{FD}, 1 ) = 0;
#
#            _debug_desc_fd( 'reading from', $pipe ) if _debugging_details;
#            my $in = eval { _read( $pipe->{FD} ) };
#            if ( $@ ) {
#               $in = '';
#               die $@ unless
#	          $@ =~ $_EIO ||
#		  ($@ =~ /input or output/ && $^O =~ /aix/) 
#		  || ( Win32_MODE && $@ =~ /Bad file descriptor/ );
#            }
#
#            unless ( length $in ) {
#               $self->_clobber( $pipe );
#               return undef;
#            }
#
#            my $pos = pos $$out_ref;
#            $$out_ref .= $in;
#            pos( $$out_ref ) = $pos;
#            return 1;
#         };
#         push @{$pipe->{FILTERS}}, $pipe_reader;
#         push @{$self->{TEMP_FILTERS}}, $pipe_reader;
#      }
#      else {
#         my $pipe_writer = sub {
#            my ( $in_ref, $out_ref ) = @_;
#            return undef unless defined $pipe->{FD};
#            return 0
#               unless vec( $self->{WOUT}, $pipe->{FD}, 1 )
#                  || $pipe->{PAUSED};
#
#            vec( $self->{WOUT}, $pipe->{FD}, 1 ) = 0;
#
#            if ( ! length $$in_ref ) {
#               if ( ! defined get_more_input ) {
#                  $self->_clobber( $pipe );
#                  return undef;
#               }
#            }
#
#            unless ( length $$in_ref ) {
#               unless ( $pipe->{PAUSED} ) {
#                  _debug_desc_fd( 'pausing', $pipe ) if _debugging_details;
#                  vec( $self->{WIN}, $pipe->{FD}, 1 ) = 0;
#                  vec( $self->{PIN}, $pipe->{FD}, 1 ) = 1;
#                  $pipe->{PAUSED} = 1;
#               }
#               return 0;
#            }
#            _debug_desc_fd( 'writing to', $pipe ) if _debugging_details;
#
#            my $c = _write( $pipe->{FD}, $$in_ref );
#            substr( $$in_ref, 0, $c, '' );
#            return 1;
#         };
#         unshift @{$pipe->{FILTERS}}, $pipe_writer;
#         push    @{$self->{TEMP_FILTERS}}, $pipe_writer;
#      }
#   }
#}
#
#
#sub _dup2_gently {
#   my IPC::Run $self = shift;
#   my ( $files, $fd1, $fd2 ) = @_;
#   for ( @$files ) {
#      next unless defined $_->{TFD};
#      $_->{TFD} = _dup( $_->{TFD} ) if $_->{TFD} == $fd2;
#   }
#   $self->{DEBUG_FD} = _dup $self->{DEBUG_FD}
#      if defined $self->{DEBUG_FD} && $self->{DEBUG_FD} == $fd2;
#
#   _dup2_rudely( $fd1, $fd2 );
#}
#
#
#
#sub close_terminal {
#
#   POSIX::setsid() || croak "POSIX::setsid() failed";
#   _debug "closing stdin, out, err"
#      if _debugging_details;
#   close STDIN;
#   close STDERR;
#   close STDOUT;
#}
#
#
#sub _do_kid_and_exit {
#   my IPC::Run $self = shift;
#   my ( $kid ) = @_;
#
#   my ( $s1, $s2 );
#   if ($] < 5.008) {
#     $s1 = Symbol::gensym();
#     $s2 = Symbol::gensym();
#   }
#
#   eval {
#      local $cur_self = $self;
#
#      if ( _debugging ) {
#         _set_child_debug_name( ref $kid->{VAL} eq "CODE"
#         	 ? "CODE"
#         	 : basename( $kid->{VAL}->[0] )
#         );
#      }
#
#      my @needed = $self->{noinherit} ? () : ( 1, 1, 1 );
#      $needed[ $self->{SYNC_WRITER_FD} ] = 1;
#      $needed[ $self->{DEBUG_FD} ] = 1 if defined $self->{DEBUG_FD};
#
#      for ( @{$kid->{OPS}} ) {
#	 $needed[ $_->{TFD} ] = 1 if defined $_->{TFD};
#      }
#
#      my @closed;
#      if ( %{$self->{PTYS}} ) {
#	 for ( keys %{$self->{PTYS}} ) {
#	    _debug "Cleaning up parent's ptty '$_'" if _debugging_details;
#	    my $slave = $self->{PTYS}->{$_}->slave;
#	    $closed[ $self->{PTYS}->{$_}->fileno ] = 1;
#	    close $self->{PTYS}->{$_};
#	    $self->{PTYS}->{$_} = $slave;
#	 }
#
#	 close_terminal;
#	 $closed[ $_ ] = 1 for ( 0..2 );
#      }
#
#      for my $sibling ( @{$self->{KIDS}} ) {
#	 for ( @{$sibling->{OPS}} ) {
#	    if ( $_->{TYPE} =~ /^.pty.$/ ) {
#	       $_->{TFD} = $self->{PTYS}->{$_->{PTY_ID}}->fileno;
#	       $needed[$_->{TFD}] = 1;
#	    }
#
#	 }
#      }
#
#      _debug "open fds: ", join " ", keys %fds if _debugging_details;
#      for (keys %fds) {
#         if ( ! $closed[$_] && ! $needed[$_] ) {
#            _close( $_ );
#            $closed[$_] = 1;
#         }
#      }
#
#      my @lazy_close;
#      for ( @{$kid->{OPS}} ) {
#	 if ( defined $_->{TFD} ) {
#	    unless ( $_->{TFD} == $_->{KFD} ) {
#	       $self->_dup2_gently( $kid->{OPS}, $_->{TFD}, $_->{KFD} );
#	       push @lazy_close, $_->{TFD};
#	    }
#	 }
#	 elsif ( $_->{TYPE} eq 'dup' ) {
#	    $self->_dup2_gently( $kid->{OPS}, $_->{KFD1}, $_->{KFD2} )
#	       unless $_->{KFD1} == $_->{KFD2};
#	 }
#	 elsif ( $_->{TYPE} eq 'close' ) {
#	    for ( $_->{KFD} ) {
#	       if ( ! $closed[$_] ) {
#		  _close( $_ );
#		  $closed[$_] = 1;
#		  $_ = undef;
#	       }
#	    }
#	 }
#	 elsif ( $_->{TYPE} eq 'init' ) {
#	    $_->{SUB}->();
#	 }
#      }
#
#      for ( @lazy_close ) {
#	 unless ( $closed[$_] ) {
#	    _close( $_ );
#	    $closed[$_] = 1;
#	 }
#      }
#
#      if ( ref $kid->{VAL} ne 'CODE' ) {
#	 open $s1, ">&=$self->{SYNC_WRITER_FD}"
#	    or croak "$! setting filehandle to fd SYNC_WRITER_FD";
#	 fcntl $s1, F_SETFD, 1;
#
#	 if ( defined $self->{DEBUG_FD} ) {
#	    open $s2, ">&=$self->{DEBUG_FD}"
#	       or croak "$! setting filehandle to fd DEBUG_FD";
#	    fcntl $s2, F_SETFD, 1;
#	 }
#
#	 if ( _debugging ) {
#	    my @cmd = ( $kid->{PATH}, @{$kid->{VAL}}[1..$#{$kid->{VAL}}] );
#	    _debug 'execing ', join " ", map { /[\s\"]/ ? "'$_'" : $_ } @cmd;
#	 }
#
#	 die "exec failed: simulating exec() failure"
#	    if $self->{_simulate_exec_failure};
#
#	 _exec $kid->{PATH}, @{$kid->{VAL}}[1..$#{$kid->{VAL}}];
#
#	 croak "exec failed: $!";
#      }
#   };
#   if ( $@ ) {
#      _write $self->{SYNC_WRITER_FD}, $@;
#      POSIX::exit 1;
#   }
#
#   _close $self->{SYNC_WRITER_FD};
#   _debug 'calling fork()ed CODE ref' if _debugging;
#   POSIX::close $self->{DEBUG_FD}      if defined $self->{DEBUG_FD};
#   $kid->{VAL}->();
#
#   $kid->{VAL} = undef;
#
#   POSIX::exit 0;
#}
#
#
#sub start {
#   my $options;
#   if ( @_ && ref $_[-1] eq 'HASH' ) {
#      $options = pop;
#      require Data::Dumper;
#      carp "Passing in options as a hash is deprecated:\n", Data::Dumper::Dumper( $options );
#   }
#
#   my IPC::Run $self;
#   if ( @_ == 1 && UNIVERSAL::isa( $_[0], __PACKAGE__ ) ) {
#      $self = shift;
#      $self->{$_} = $options->{$_} for keys %$options;
#   }
#   else {
#      $self = harness( @_, $options ? $options : () );
#   }
#
#   local $cur_self = $self;
#
#   $self->kill_kill if $self->{STATE} == _started;
#
#   _debug "** starting" if _debugging;
#
#   $_->{RESULT} = undef for @{$self->{KIDS}};
#
#   $self->{clear_ins} = 1;
#
#   IPC::Run::Win32Helper::optimize $self
#       if Win32_MODE && $in_run;
#
#   my @errs;
#
#   for ( @{$self->{TIMERS}} ) {
#      eval { $_->start };
#      if ( $@ ) {
#         push @errs, $@;
#         _debug 'caught ', $@ if _debugging;
#      }
#   }
#
#   eval { $self->_open_pipes };
#   if ( $@ ) {
#      push @errs, $@;
#      _debug 'caught ', $@ if _debugging;
#   }
#
#   if ( ! @errs ) {
#      { my $ofh = select STDOUT; local $| = 1; select $ofh; }
#      { my $ofh = select STDERR; local $| = 1; select $ofh; }
#      for my $kid ( @{$self->{KIDS}} ) {
#         $kid->{RESULT} = undef;
#         _debug "child: ",
#            ref( $kid->{VAL} ) eq "CODE"
#            ? "CODE ref"
#            : (
#               "`",
#               join( " ", map /[^\w.-]/ ? "'$_'" : $_, @{$kid->{VAL}} ),
#               "`"
#            ) if _debugging_details;
#         eval {
#            croak "simulated failure of fork"
#               if $self->{_simulate_fork_failure};
#            unless ( Win32_MODE ) {
#	       $self->_spawn( $kid );
#            }
#            else {
#               _debug( 
#                  'spawning ',
#                  join(
#                     ' ',
#                     map(
#                        "'$_'",
#                        ( $kid->{PATH}, @{$kid->{VAL}}[1..$#{$kid->{VAL}}] )
#                     )
#                  )
#               ) if _debugging;
#	       _dont_inherit( $self->{DEBUG_FD} );
#               ( $kid->{PID}, $kid->{PROCESS} ) =
#		  IPC::Run::Win32Helper::win32_spawn( 
#		     [ $kid->{PATH}, @{$kid->{VAL}}[1..$#{$kid->{VAL}}] ],
#		     $kid->{OPS},
#		  );
#               _debug "spawn() = ", $kid->{PID} if _debugging;
#            }
#         };
#         if ( $@ ) {
#            push @errs, $@;
#            _debug 'caught ', $@ if _debugging;
#         }
#      }
#   }
#
#   for my $pty ( values %{$self->{PTYS}} ) {
#      close $pty->slave;
#   }
#
#   my @closed;
#   for my $kid ( @{$self->{KIDS}} ) {
#      for ( @{$kid->{OPS}} ) {
#         my $close_it = eval {
#            defined $_->{TFD}
#               && ! $_->{DONT_CLOSE}
#               && ! $closed[$_->{TFD}]
#               && ( ! Win32_MODE || ! $_->{RECV_THROUGH_TEMP_FILE} ) 
#         };
#         if ( $@ ) {
#            push @errs, $@;
#            _debug 'caught ', $@ if _debugging;
#         }
#         if ( $close_it || $@ ) {
#            eval {
#               _close( $_->{TFD} );
#               $closed[$_->{TFD}] = 1;
#               $_->{TFD} = undef;
#            };
#            if ( $@ ) {
#               push @errs, $@;
#               _debug 'caught ', $@ if _debugging;
#            }
#         }
#      }
#   }
#confess "gak!" unless defined $self->{PIPES};
#
#   if ( @errs ) {
#      eval { $self->_cleanup };
#      warn $@ if $@;
#      die join( '', @errs );
#   }
#
#   $self->{STATE} = _started;
#   return $self;
#}
#
#
#sub adopt {
#   my IPC::Run $self = shift;
#
#   for my $adoptee ( @_ ) {
#      push @{$self->{IOS}},    @{$adoptee->{IOS}};
#      push @{$self->{KIDS}},   @{$adoptee->{KIDS}};
#      push @{$self->{PIPES}},  @{$adoptee->{PIPES}};
#      $self->{PTYS}->{$_} = $adoptee->{PTYS}->{$_}
#         for keys %{$adoptee->{PYTS}};
#      push @{$self->{TIMERS}}, @{$adoptee->{TIMERS}};
#      $adoptee->{STATE} = _finished;
#   }
#}
#
#
#sub _clobber {
#   my IPC::Run $self = shift;
#   my ( $file ) = @_;
#   _debug_desc_fd( "closing", $file ) if _debugging_details;
#   my $doomed = $file->{FD};
#   my $dir = $file->{TYPE} =~ /^</ ? 'WIN' : 'RIN';
#   vec( $self->{$dir}, $doomed, 1 ) = 0;
#   vec( $self->{PIN},  $doomed, 1 ) = 0;
#   if ( $file->{TYPE} =~ /^(.)pty.$/ ) {
#      if ( $1 eq '>' ) {
#         _debug_desc_fd "closing pty", $file if _debugging_details;
#         close $self->{PTYS}->{$file->{PTY_ID}}
#            if defined $self->{PTYS}->{$file->{PTY_ID}};
#         $self->{PTYS}->{$file->{PTY_ID}} = undef;
#      }
#   }
#   elsif ( UNIVERSAL::isa( $file, 'IPC::Run::IO' ) ) {
#      $file->close unless $file->{DONT_CLOSE};
#   }
#   else {
#      _close( $doomed );
#   }
#
#   @{$self->{PIPES}} = grep
#      defined $_->{FD} && ( $_->{TYPE} ne $file->{TYPE} || $_->{FD} ne $doomed),
#      @{$self->{PIPES}};
#
#   $file->{FD} = undef;
#}
#
#sub _select_loop {
#   my IPC::Run $self = shift;
#
#   my $io_occurred;
#
#   my $not_forever = 0.01;
#
#SELECT:
#   while ( $self->pumpable ) {
#      if ( $io_occurred && $self->{break_on_io} ) {
#         _debug "exiting _select(): io occured and break_on_io set"
#	    if _debugging_details;
#         last;
#      }
#
#      my $timeout = $self->{non_blocking} ? 0 : undef;
#
#      if ( @{$self->{TIMERS}} ) {
#         my $now = time;
#         my $time_left;
#         for ( @{$self->{TIMERS}} ) {
#            next unless $_->is_running;
#            $time_left = $_->check( $now );
#            return if defined $time_left && ! $time_left;
#            $timeout = $time_left
#               if ! defined $timeout || $time_left < $timeout;
#         }
#      }
#
#      my $paused = 0;
#
#      for my $file ( @{$self->{PIPES}} ) {
#         next unless $file->{PAUSED} && $file->{TYPE} =~ /^</;
#
#         _debug_desc_fd( "checking for more input", $file ) if _debugging_details;
#         my $did;
#         1 while $did = $file->_do_filters( $self );
#         if ( defined $file->{FD} && ! defined( $did ) || $did ) {
#            _debug_desc_fd( "unpausing", $file ) if _debugging_details;
#            $file->{PAUSED} = 0;
#            vec( $self->{WIN}, $file->{FD}, 1 ) = 1;
#            vec( $self->{PIN}, $file->{FD}, 1 ) = 0;
#         }
#         else {
#            ++$paused;
#         }
#      }
#
#      if ( _debugging_details ) {
#         my $map = join(
#            '',
#            map {
#               my $out;
#               $out = 'r'                     if vec( $self->{RIN}, $_, 1 );
#               $out = $out ? 'b' : 'w'        if vec( $self->{WIN}, $_, 1 );
#               $out = 'p'           if ! $out && vec( $self->{PIN}, $_, 1 );
#               $out = $out ? uc( $out ) : 'x' if vec( $self->{EIN}, $_, 1 );
#               $out = '-' unless $out;
#               $out;
#            } (0..1024)
#         );
#         $map =~ s/((?:[a-zA-Z-]|\([^\)]*\)){12,}?)-*$/$1/;
#         _debug 'fds for select: ', $map if _debugging_details;
#      }
#
#      my $p = $self->pumpable;
#      last unless $p;
#      if ( $p != 0  && ( ! defined $timeout || $timeout > 0.1 ) ) {
#	 $timeout = $not_forever;
#         $not_forever *= 2;
#         $not_forever = 0.5 if $not_forever >= 0.5;
#      }
#
#      if ( ! defined $timeout && ! ( @{$self->{PIPES}} - $paused ) ) {
#         if ( $self->{break_on_io} ) {
#	    _debug "exiting _select(): no I/O to do and timeout=forever"
#               if _debugging;
#	    last;
#	 }
#
#	 $timeout = $not_forever;
#         $not_forever *= 2;
#         $not_forever = 0.5 if $not_forever >= 0.5;
#      }
#
#      _debug 'timeout=', defined $timeout ? $timeout : 'forever'
#         if _debugging_details;
#
#      my $nfound;
#      unless ( Win32_MODE ) {
#         $nfound = select(
#            $self->{ROUT} = $self->{RIN},
#            $self->{WOUT} = $self->{WIN},
#            $self->{EOUT} = $self->{EIN},
#            $timeout 
#	 );
#      }
#      else {
#	 my @in = map $self->{$_}, qw( RIN WIN EIN );
#	 for ( @in ) {
#	    $_ = undef unless index( ( unpack "b*", $_ ), 1 ) >= 0;
#	 }
#
#	 $nfound = select(
#            $self->{ROUT} = $in[0],
#            $self->{WOUT} = $in[1],
#            $self->{EOUT} = $in[2],
#            $timeout 
#         );
#
#	 for ( $self->{ROUT}, $self->{WOUT}, $self->{EOUT} ) {
#	    $_ = "" unless defined $_;
#	 }
#      }
#      last if ! $nfound && $self->{non_blocking};
#
#      if ($nfound < 0) {
#         if ($! == POSIX::EINTR) {
#            $self->{ROUT} = $self->{WOUT} = $self->{EOUT} = '';
#            $nfound = 0;
#         }
#         else {
#            croak "$! in select";
#         }
#      }
#
#      if ( _debugging_details ) {
#         my $map = join(
#            '',
#            map {
#               my $out;
#               $out = 'r'                     if vec( $self->{ROUT}, $_, 1 );
#               $out = $out ? 'b' : 'w'        if vec( $self->{WOUT}, $_, 1 );
#               $out = $out ? uc( $out ) : 'x' if vec( $self->{EOUT}, $_, 1 );
#               $out = '-' unless $out;
#               $out;
#            } (0..128)
#         );
#         $map =~ s/((?:[a-zA-Z-]|\([^\)]*\)){12,}?)-*$/$1/;
#         _debug "selected  ", $map;
#      }
#
#      my @pipes = @{$self->{PIPES}};
#      $io_occurred = $_->poll( $self ) ? 1 : $io_occurred for @pipes;
#   }
#
#   return;
#}
#
#
#sub _cleanup {
#   my IPC::Run $self = shift;
#   _debug "cleaning up" if _debugging_details;
#
#   for ( values %{$self->{PTYS}} ) {
#      next unless ref $_;
#      eval {
#         _debug "closing slave fd ", fileno $_->slave if _debugging_data;
#         close $_->slave;
#      };
#      carp $@ . " while closing ptys" if $@;
#      eval {
#         _debug "closing master fd ", fileno $_ if _debugging_data;
#         close $_;
#      };
#      carp $@ . " closing ptys" if $@;
#   }
#   
#   _debug "cleaning up pipes" if _debugging_details;
#   $self->_clobber( $self->{PIPES}->[0] ) while @{$self->{PIPES}};
#
#   for my $kid ( @{$self->{KIDS}} ) {
#      _debug "cleaning up kid ", $kid->{NUM} if _debugging_details;
#      if ( ! length $kid->{PID} ) {
#         _debug 'never ran child ', $kid->{NUM}, ", can't reap"
#            if _debugging;
#         for my $op ( @{$kid->{OPS}} ) {
#            _close( $op->{TFD} )
#               if defined $op->{TFD} && ! defined $op->{TEMP_FILE_HANDLE};
#         }
#      }
#      elsif ( ! defined $kid->{RESULT} ) {
#         _debug 'reaping child ', $kid->{NUM}, ' (pid ', $kid->{PID}, ')'
#            if _debugging;
#         my $pid = waitpid $kid->{PID}, 0;
#         $kid->{RESULT} = $?;
#         _debug 'reaped ', $pid, ', $?=', $kid->{RESULT}
#            if _debugging;
#      }
#
#
#      _debug "cleaning up filters" if _debugging_details;
#      for my $op ( @{$kid->{OPS}} ) {
#         @{$op->{FILTERS}} = grep {
#            my $filter = $_;
#            ! grep $filter == $_, @{$self->{TEMP_FILTERS}};
#         } @{$op->{FILTERS}};
#      }
#
#      for my $op ( @{$kid->{OPS}} ) {
#         $op->_cleanup( $self ) if UNIVERSAL::isa( $op, "IPC::Run::IO" );
#      }
#   }
#   $self->{STATE} = _finished;
#   @{$self->{TEMP_FILTERS}} = ();
#   _debug "done cleaning up" if _debugging_details;
#
#   POSIX::close $self->{DEBUG_FD} if defined $self->{DEBUG_FD};
#   $self->{DEBUG_FD} = undef;
#}
#
#
#sub pump {
#   die "pump() takes only a a single harness as a parameter"
#      unless @_ == 1 && UNIVERSAL::isa( $_[0], __PACKAGE__ );
#
#   my IPC::Run $self = shift;
#
#   local $cur_self = $self;
#
#   _debug "** pumping" 
#      if _debugging;
#
#      $self->start if $self->{STATE} < _started;
#      croak "process ended prematurely" unless $self->pumpable;
#
#      $self->{auto_close_ins} = 0;
#      $self->{break_on_io}    = 1;
#      $self->_select_loop;
#      return $self->pumpable;
#}
#
#
#sub pump_nb {
#   my IPC::Run $self = shift;
#
#   $self->{non_blocking} = 1;
#   my $r = eval { $self->pump };
#   $self->{non_blocking} = 0;
#   die $@ if $@;
#   return $r;
#}
#
#
#sub pumpable {
#   my IPC::Run $self = shift;
#
#   return -1 if grep !$_->{PAUSED}, @{$self->{PIPES}};
#
#   $self->reap_nb;
#   return 0 unless $self->_running_kids;
#
#   select undef, undef, undef, 0.0001;
#
#   $self->reap_nb;
#   return 0 unless $self->_running_kids;
#
#   return -1; 
#}
#
#
#sub _running_kids {
#   my IPC::Run $self = shift;
#   return grep
#      defined $_->{PID} && ! defined $_->{RESULT},
#      @{$self->{KIDS}};
#}
#
#
#my $still_runnings;
#
#sub reap_nb {
#   my IPC::Run $self = shift;
#
#   local $cur_self = $self;
#
#   for my $kid ( @{$self->{KIDS}} ) {
#      if ( Win32_MODE ) {
#	 next if ! defined $kid->{PROCESS} || defined $kid->{RESULT};
#	 unless ( $kid->{PROCESS}->Wait( 0 ) ) {
#	    _debug "kid $kid->{NUM} ($kid->{PID}) still running"
#               if _debugging_details;
#	    next;
#	 }
#
#         _debug "kid $kid->{NUM} ($kid->{PID}) exited"
#            if _debugging;
#
#	 $kid->{PROCESS}->GetExitCode( $kid->{RESULT} )
#	    or croak "$! while GetExitCode()ing for Win32 process";
#
#	 unless ( defined $kid->{RESULT} ) {
#	    $kid->{RESULT} = "0 but true";
#	    $? = $kid->{RESULT} = 0x0F;
#	 }
#	 else {
#	    $? = $kid->{RESULT} << 8;
#	 }
#      }
#      else {
#	 next if ! defined $kid->{PID} || defined $kid->{RESULT};
#	 my $pid = waitpid $kid->{PID}, POSIX::WNOHANG();
#	 unless ( $pid ) {
#	    _debug "$kid->{NUM} ($kid->{PID}) still running"
#               if _debugging_details;
#	    next;
#	 }
#
#	 if ( $pid < 0 ) {
#	    _debug "No such process: $kid->{PID}\n" if _debugging;
#	    $kid->{RESULT} = "unknown result, unknown PID";
#	 }
#	 else {
#            _debug "kid $kid->{NUM} ($kid->{PID}) exited"
#               if _debugging;
#
#	    confess "waitpid returned the wrong PID: $pid instead of $kid->{PID}"
#	       unless $pid = $kid->{PID};
#	    _debug "$kid->{PID} returned $?\n" if _debugging;
#	    $kid->{RESULT} = $?;
#	 }
#      }
#   }
#}
#
#
#sub finish {
#   my IPC::Run $self = shift;
#   my $options = @_ && ref $_[-1] eq 'HASH' ? pop : {};
#
#   local $cur_self = $self;
#
#   _debug "** finishing" if _debugging;
#
#   $self->{non_blocking}   = 0;
#   $self->{auto_close_ins} = 1;
#   $self->{break_on_io}    = 0;
#
#   while ( $self->pumpable ) {
#      $self->_select_loop( $options );
#   }
#   $self->_cleanup;
#
#   return ! $self->full_result;
#}
#
#
#sub _assert_finished {
#   my IPC::Run $self = $_[0];
#
#   croak "Harness not run" unless $self->{STATE} >= _finished;
#   croak "Harness not finished running" unless $self->{STATE} == _finished;
#}
#
#
#sub result {
#   &_assert_finished;
#   my IPC::Run $self = shift;
#   
#   if ( @_ ) {
#      my ( $which ) = @_;
#      croak(
#         "Only ",
#         scalar( @{$self->{KIDS}} ),
#         " child processes, no process $which"
#      )
#         unless $which >= 0 && $which <= $#{$self->{KIDS}};
#      return $self->{KIDS}->[$which]->{RESULT} >> 8;
#   }
#   else {
#      return undef unless @{$self->{KIDS}};
#      for ( @{$self->{KIDS}} ) {
#         return $_->{RESULT} >> 8 if $_->{RESULT} >> 8;
#      }
#   }
#}
#
#
#sub results {
#   &_assert_finished;
#   my IPC::Run $self = shift;
#
#   return map { (0+$_->{RESULT}) >> 8 } @{$self->{KIDS}};
#}
#
#
#sub full_result {
#   goto &result if @_ > 1;
#   &_assert_finished;
#
#   my IPC::Run $self = shift;
#
#   return undef unless @{$self->{KIDS}};
#   for ( @{$self->{KIDS}} ) {
#      return $_->{RESULT} if $_->{RESULT};
#   }
#}
#
#
#sub full_results {
#   &_assert_finished;
#   my IPC::Run $self = shift;
#
#   croak "Harness not run" unless $self->{STATE} >= _finished;
#   croak "Harness not finished running" unless $self->{STATE} == _finished;
#
#   return map $_->{RESULT}, @{$self->{KIDS}};
#}
#
#
#use vars (
#   '$filter_op',        
#   '$filter_num',       
#);
#
#
#
#sub binary(;$) {
#   my $enable = @_ ? shift : 1;
#   return bless sub { $enable }, "IPC::Run::binmode_pseudo_filter";
#}
#
#
#sub new_chunker(;$) {
#   my ( $re ) = @_;
#   $re = $/ if _empty $re;
#   $re = quotemeta( $re ) unless ref $re eq 'Regexp';
#   $re = qr/\A(.*?$re)/s;
#
#   return sub {
#      my ( $in_ref, $out_ref ) = @_;
#
#      return 0 if length $$out_ref;
#
#      return input_avail && do {
#         while (1) {
#            if ( $$in_ref =~ s/$re// ) {
#               $$out_ref .= $1;
#               return 1;
#            }
#            my $hmm = get_more_input;
#            unless ( defined $hmm ) {
#               $$out_ref = $$in_ref;
#               $$in_ref = '';
#               return length $$out_ref ? 1 : 0;
#            }
#            return 0 if $hmm eq 0;
#         }
#      }
#   };
#}
#
#
#sub new_appender($) {
#   my ( $suffix ) = @_;
#   croak "\$suffix undefined" unless defined $suffix;
#
#   return sub {
#      my ( $in_ref, $out_ref ) = @_;
#
#      return input_avail && do {
#         $$out_ref = join( '', $$out_ref, $$in_ref, $suffix );
#         $$in_ref = '';
#         1;
#      }
#   };
#}
#
#
#
#sub new_string_source {
#   my $ref;
#   if ( @_ > 1 ) {
#      $ref = [ @_ ],
#   }
#   else {
#      $ref = shift;
#   }
#
#   return ref $ref eq 'SCALAR'
#      ? sub {
#         my ( $in_ref, $out_ref ) = @_;
#
#         return defined $$ref
#            ? do {
#               $$out_ref .= $$ref;
#               my $r = length $$ref ? 1 : 0;
#               $$ref = undef;
#               $r;
#            }
#            : undef
#      }
#      : sub {
#         my ( $in_ref, $out_ref ) = @_;
#
#         return @$ref
#            ? do {
#               my $s = shift @$ref;
#               $$out_ref .= $s;
#               length $s ? 1 : 0;
#            }
#            : undef;
#      }
#}
#
#
#sub new_string_sink {
#   my ( $string_ref ) = @_;
#
#   return sub {
#      my ( $in_ref, $out_ref ) = @_;
#
#      return input_avail && do {
#         $$string_ref .= $$in_ref;
#         $$in_ref = '';
#         1;
#      }
#   };
#}
#
#
#
#
#sub io {
#   require IPC::Run::IO;
#   IPC::Run::IO->new( @_ );
#}
#
#
#sub timer;
#*timer = \&IPC::Run::Timer::timer;
#
#
#sub timeout;
#*timeout = \&IPC::Run::Timer::timeout;
#
#
#sub input_avail() {
#   confess "Undefined FBUF ref for $filter_num+1"
#      unless defined $filter_op->{FBUFS}->[$filter_num+1];
#   length ${$filter_op->{FBUFS}->[$filter_num+1]} || get_more_input;
#}
#
#
#sub get_more_input() {
#   ++$filter_num;
#   my $r = eval {
#      confess "get_more_input() called and no more filters in chain"
#         unless defined $filter_op->{FILTERS}->[$filter_num];
#      $filter_op->{FILTERS}->[$filter_num]->(
#         $filter_op->{FBUFS}->[$filter_num+1],
#         $filter_op->{FBUFS}->[$filter_num],
#      ); 
#   };
#   --$filter_num;
#   die $@ if $@;
#   return $r;
#}
#
#1;
#
### IPC/Run/Debug.pm ###
#package IPC::Run::Debug;
#
#
#
#use strict;
#use Exporter;
#use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS};
#BEGIN {
#	$VERSION = '0.90';
#	@ISA     = qw( Exporter );
#	@EXPORT  = qw(
#		_debug
#		_debug_desc_fd
#		_debugging
#		_debugging_data
#		_debugging_details
#		_debugging_gory_details
#		_debugging_not_optimized
#		_set_child_debug_name
#	);
#	
#	@EXPORT_OK = qw(
#		_debug_init
#		_debugging_level
#		_map_fds
#	);
#	%EXPORT_TAGS = (
#		default => \@EXPORT,
#		all     => [ @EXPORT, @EXPORT_OK ],
#	);
#}
#
#my $disable_debugging =
#   defined $ENV{IPCRUNDEBUG}
#   && (
#      ! $ENV{IPCRUNDEBUG}
#      || lc $ENV{IPCRUNDEBUG} eq "none"
#   );
#
#eval( $disable_debugging ? <<'STUBS' : <<'SUBS' ) or die $@;
#sub _map_fds()                 { "" }
#sub _debug                     {}
#sub _debug_desc_fd             {}
#sub _debug_init                {}
#sub _set_child_debug_name      {}
#sub _debugging()               { 0 }
#sub _debugging_level()         { 0 }
#sub _debugging_data()          { 0 }
#sub _debugging_details()       { 0 }
#sub _debugging_gory_details()  { 0 }
#sub _debugging_not_optimized() { 0 }
#
#1;
#STUBS
#
#use POSIX;
#
#sub _map_fds {
#   my $map = '';
#   my $digit = 0;
#   my $in_use;
#   my $dummy;
#   for my $fd (0..63) {
#      ## I'd like a quicker way (less user, cpu & expecially sys and kernal
#      ## calls) to detect open file descriptors.  Let me know...
#      ## Hmmm, could do a 0 length read and check for bad file descriptor...
#      ## but that segfaults on Win32
#      my $test_fd = POSIX::dup( $fd );
#      $in_use = defined $test_fd;
#      POSIX::close $test_fd if $in_use;
#      $map .= $in_use ? $digit : '-';
#      $digit = 0 if ++$digit > 9;
#   }
#   warn "No fds open???" unless $map =~ /\d/;
#   $map =~ s/(.{1,12})-*$/$1/;
#   return $map;
#}
#
#use vars qw( $parent_pid );
#
#$parent_pid = $$;
#
### TODO: move debugging to it's own module and make it compile-time
### optimizable.
#
### Give kid process debugging nice names
#my $debug_name;
#
#sub _set_child_debug_name {
#   $debug_name = shift;
#}
#
### There's a bit of hackery going on here.
###
### We want to have any code anywhere be able to emit
### debugging statements without knowing what harness the code is
### being called in/from, since we'd need to pass a harness around to
### everything.
###
### Thus, $cur_self was born.
##
#my %debug_levels = (
#   none    => 0,
#   basic   => 1,
#   data    => 2,
#   details => 3,
#   gore           => 4,
#   gory_details   => 4,
#   "gory details" => 4,
#   gory           => 4,
#   gorydetails    => 4,
#   all     => 10,
#   notopt  => 0,
#);
#
#my $warned;
#
#sub _debugging_level() {
#   my $level = 0;
#
#   $level = $IPC::Run::cur_self->{debug} || 0
#      if $IPC::Run::cur_self
#         && ( $IPC::Run::cur_self->{debug} || 0 ) >= $level;
#
#   if ( defined $ENV{IPCRUNDEBUG} ) {
#      my $v = $ENV{IPCRUNDEBUG};
#      $v = $debug_levels{lc $v} if $v =~ /[a-zA-Z]/;
#      unless ( defined $v ) {
#	 $warned ||= warn "Unknown debug level $ENV{IPCRUNDEBUG}, assuming 'basic' (1)\n";
#	 $v = 1;
#      }
#      $level = $v if $v > $level;
#   }
#   return $level;
#}
#
#sub _debugging_atleast($) {
#   my $min_level = shift || 1;
#
#   my $level = _debugging_level;
#   
#   return $level >= $min_level ? $level : 0;
#}
#
#sub _debugging()               { _debugging_atleast 1 }
#sub _debugging_data()          { _debugging_atleast 2 }
#sub _debugging_details()       { _debugging_atleast 3 }
#sub _debugging_gory_details()  { _debugging_atleast 4 }
#sub _debugging_not_optimized() { ( $ENV{IPCRUNDEBUG} || "" ) eq "notopt" }
#
#sub _debug_init {
#   ## This routine is called only in spawned children to fake out the
#   ## debug routines so they'll emit debugging info.
#   $IPC::Run::cur_self = {};
#   (  $parent_pid,
#      $^T, 
#      $IPC::Run::cur_self->{debug}, 
#      $IPC::Run::cur_self->{DEBUG_FD}, 
#      $debug_name 
#   ) = @_;
#}
#
#
#sub _debug {
##   return unless _debugging || _debugging_not_optimized;
#
#   my $fd = defined &IPC::Run::_debug_fd
#      ? IPC::Run::_debug_fd()
#      : fileno STDERR;
#
#   my $s;
#   my $debug_id;
#   $debug_id = join( 
#      " ",
#      join(
#         "",
#         defined $IPC::Run::cur_self ? "#$IPC::Run::cur_self->{ID}" : (),
#         "($$)",
#      ),
#      defined $debug_name && length $debug_name ? $debug_name        : (),
#   );
#   my $prefix = join(
#      "",
#      "IPC::Run",
#      sprintf( " %04d", time - $^T ),
#      ( _debugging_details ? ( " ", _map_fds ) : () ),
#      length $debug_id ? ( " [", $debug_id, "]" ) : (),
#      ": ",
#   );
#
#   my $msg = join( '', map defined $_ ? $_ : "<undef>", @_ );
#   chomp $msg;
#   $msg =~ s{^}{$prefix}gm;
#   $msg .= "\n";
#   POSIX::write( $fd, $msg, length $msg );
#}
#
#
#my @fd_descs = ( 'stdin', 'stdout', 'stderr' );
#
#sub _debug_desc_fd {
#   return unless _debugging;
#   my $text = shift;
#   my $op = pop;
#   my $kid = $_[0];
#
#Carp::carp join " ", caller(0), $text, $op  if defined $op  && UNIVERSAL::isa( $op, "IO::Pty" );
#
#   _debug(
#      $text,
#      ' ',
#      ( defined $op->{FD}
#         ? $op->{FD} < 3
#            ? ( $fd_descs[$op->{FD}] )
#            : ( 'fd ', $op->{FD} )
#         : $op->{FD}
#      ),
#      ( defined $op->{KFD}
#         ? (
#            ' (kid',
#            ( defined $kid ? ( ' ', $kid->{NUM}, ) : () ),
#            "'s ",
#            ( $op->{KFD} < 3
#               ? $fd_descs[$op->{KFD}]
#               : defined $kid
#                  && defined $kid->{DEBUG_FD}
#                  && $op->{KFD} == $kid->{DEBUG_FD}
#                  ? ( 'debug (', $op->{KFD}, ')' )
#                  : ( 'fd ', $op->{KFD} )
#            ),
#            ')',
#         )
#         : ()
#      ),
#   );
#}
#
#1;
#
#SUBS
#
### IPC/Run/IO.pm ###
#package IPC::Run::IO;
#
#
#
#use strict;
#use Carp;
#use Fcntl;
#use Symbol;
#
#use IPC::Run::Debug;
#use IPC::Run qw( Win32_MODE );
#
#use vars qw{$VERSION};
#BEGIN {
#	$VERSION = '0.90';
#	if ( Win32_MODE ) {
#		eval "use IPC::Run::Win32Helper; require IPC::Run::Win32IO; 1"
#		or ( $@ && die ) or die "$!";
#	}
#}
#
#sub _empty($);
#*_empty = \&IPC::Run::_empty;
#
#
#sub new {
#   my $class = shift;
#   $class = ref $class || $class;
#
#   my ( $external, $type, $internal ) = ( shift, shift, pop );
#
#   croak "$class: '$_' is not a valid I/O operator"
#      unless $type =~ /^(?:<<?|>>?)$/;
#
#   my IPC::Run::IO $self = $class->_new_internal(
#      $type, undef, undef, $internal, undef, @_
#   );
#
#   if ( ! ref $external ) {
#      $self->{FILENAME} = $external;
#   }
#   elsif ( ref eq 'GLOB' || UNIVERSAL::isa( $external, 'IO::Handle' ) ) {
#      $self->{HANDLE} = $external;
#      $self->{DONT_CLOSE} = 1;
#   }
#   else {
#      croak "$class: cannot accept " . ref( $external ) . " to do I/O with";
#   }
#
#   return $self;
#}
#
#
#sub _new_internal {
#   my $class = shift;
#   $class = ref $class || $class;
#
#   $class = "IPC::Run::Win32IO"
#      if Win32_MODE && $class eq "IPC::Run::IO";
#
#   my IPC::Run::IO $self;
#   $self = bless {}, $class;
#
#   my ( $type, $kfd, $pty_id, $internal, $binmode, @filters ) = @_;
#
#   $self->{TYPE}    = $type;
#   $self->{KFD}     = $kfd;
#   $self->{PTY_ID}  = $pty_id;
#   $self->binmode( $binmode );
#   $self->{FILTERS} = [ @filters ];
#
#   if ( $self->op =~ />/ ) {
#      croak "'$_' missing a destination" if _empty $internal;
#      $self->{DEST} = $internal;
#      if ( UNIVERSAL::isa( $self->{DEST}, 'CODE' ) ) {
#         unshift( 
#            @{$self->{FILTERS}},
#            sub {
#               my ( $in_ref ) = @_;
#
#               return IPC::Run::input_avail() && do {
#        	  $self->{DEST}->( $$in_ref );
#        	  $$in_ref = '';
#        	  1;
#               }
#            }
#         );
#      }
#   }
#   else {
#      croak "'$_' missing a source" if _empty $internal;
#      $self->{SOURCE} = $internal;
#      if ( UNIVERSAL::isa( $internal, 'CODE' ) ) {
#         push(
#            @{$self->{FILTERS}},
#            sub {
#               my ( $in_ref, $out_ref ) = @_;
#               return 0 if length $$out_ref;
#
#               return undef
#        	  if $self->{SOURCE_EMPTY};
#
#               my $in = $internal->();
#               unless ( defined $in ) {
#        	  $self->{SOURCE_EMPTY} = 1;
#        	  return undef 
#               }
#               return 0 unless length $in;
#               $$out_ref = $in;
#
#               return 1;
#            }
#         );
#      }
#      elsif ( UNIVERSAL::isa( $internal, 'SCALAR' ) ) {
#         push(
#            @{$self->{FILTERS}},
#            sub {
#               my ( $in_ref, $out_ref ) = @_;
#               return 0 if length $$out_ref;
#
#               return $self->{HARNESS}->{auto_close_ins} ? undef : 0
#        	  if IPC::Run::_empty ${$self->{SOURCE}}
#        	     || $self->{SOURCE_EMPTY};
#
#               $$out_ref = $$internal;
#               eval { $$internal = '' }
#        	  if $self->{HARNESS}->{clear_ins};
#
#               $self->{SOURCE_EMPTY} = $self->{HARNESS}->{auto_close_ins};
#
#               return 1;
#            }
#         );
#      }
#   }
#
#   return $self;
#}
#
#
#sub filename {
#   my IPC::Run::IO $self = shift;
#   $self->{FILENAME} = shift if @_;
#   return $self->{FILENAME};
#}
#
#
#sub init {
#   my IPC::Run::IO $self = shift;
#
#   $self->{SOURCE_EMPTY} = 0;
#   ${$self->{DEST}} = ''
#      if $self->mode =~ /r/ && ref $self->{DEST} eq 'SCALAR';
#
#   $self->open if defined $self->filename;
#   $self->{FD} = $self->fileno;
#
#   if ( ! $self->{FILTERS} ) {
#      $self->{FBUFS} = undef;
#   }
#   else {
#      @{$self->{FBUFS}} = map {
#         my $s = "";
#         \$s;
#      } ( @{$self->{FILTERS}}, '' );
#
#      $self->{FBUFS}->[0] = $self->{DEST}
#         if $self->{DEST} && ref $self->{DEST} eq 'SCALAR';
#      push @{$self->{FBUFS}}, $self->{SOURCE};
#   }
#
#   return undef;
#}
#
#
#
#my %open_flags = (
#   '>'  => O_RDONLY,
#   '>>' => O_RDONLY,
#   '<'  => O_WRONLY | O_CREAT | O_TRUNC,
#   '<<' => O_WRONLY | O_CREAT | O_APPEND,
#);
#
#sub open {
#   my IPC::Run::IO $self = shift;
#
#   croak "IPC::Run::IO: Can't open() a file with no name"
#      unless defined $self->{FILENAME};
#   $self->{HANDLE} = gensym unless $self->{HANDLE};
#
#   _debug
#      "opening '", $self->filename, "' mode '", $self->mode, "'"
#   if _debugging_data;
#   sysopen(
#      $self->{HANDLE},
#      $self->filename,
#      $open_flags{$self->op},
#   ) or croak
#         "IPC::Run::IO: $! opening '$self->{FILENAME}', mode '" . $self->mode . "'";
#
#   return undef;
#}
#
#
#
#sub _do_open {
#   my $self = shift;
#   my ( $child_debug_fd, $parent_handle ) = @_;
#
#
#   if ( $self->dir eq "<" ) {
#      ( $self->{TFD}, $self->{FD} ) = IPC::Run::_pipe_nb;
#      if ( $parent_handle ) {
#         CORE::open $parent_handle, ">&=$self->{FD}"
#            or croak "$! duping write end of pipe for caller";
#      }
#   }
#   else {
#      ( $self->{FD}, $self->{TFD} ) = IPC::Run::_pipe;
#      if ( $parent_handle ) {
#         CORE::open $parent_handle, "<&=$self->{FD}"
#            or croak "$! duping read end of pipe for caller";
#      }
#   }
#}
#
#sub open_pipe {
#   my IPC::Run::IO $self = shift;
#
#   croak "IPC::Run::IO: Can't pipe() when a file name has been set"
#      if defined $self->{FILENAME};
#
#   $self->_do_open( @_ );
#
#   return $self->dir eq "<"
#      ? ( $self->{TFD}, $self->{FD} )
#      : ( $self->{FD}, $self->{TFD} );
#}
#
#
#sub _cleanup { 
#   my $self = shift;
#   undef $self->{FAKE_PIPE};
#}
#
#
#
#sub close {
#   my IPC::Run::IO $self = shift;
#
#   if ( defined $self->{HANDLE} ) {
#      close $self->{HANDLE}
#         or croak(  "IPC::Run::IO: $! closing "
#            . ( defined $self->{FILENAME}
#               ? "'$self->{FILENAME}'"
#               : "handle"
#            )
#         );
#   }
#   else {
#      IPC::Run::_close( $self->{FD} );
#   }
#
#   $self->{FD} = undef;
#
#   return undef;
#}
#
#
#sub fileno {
#   my IPC::Run::IO $self = shift;
#
#   my $fd = fileno $self->{HANDLE};
#   croak(  "IPC::Run::IO: $! "
#         . ( defined $self->{FILENAME}
#            ? "'$self->{FILENAME}'"
#            : "handle"
#         )
#      ) unless defined $fd;
#
#   return $fd;
#}
#
#
#sub mode {
#   my IPC::Run::IO $self = shift;
#
#   croak "IPC::Run::IO: unexpected arguments for mode(): @_" if @_;
#
#   return ( $self->{TYPE} =~ /</     ? 'w' : 'r' ) . 
#          ( $self->{TYPE} =~ /<<|>>/ ? 'a' : ''  );
#}
#
#
#
#sub op {
#   my IPC::Run::IO $self = shift;
#
#   croak "IPC::Run::IO: unexpected arguments for op(): @_" if @_;
#
#   return $self->{TYPE};
#}
#
#
#sub binmode {
#   my IPC::Run::IO $self = shift;
#
#   $self->{BINMODE} = shift if @_;
#
#   return $self->{BINMODE};
#}
#
#
#
#sub dir {
#   my IPC::Run::IO $self = shift;
#
#   croak "IPC::Run::IO: unexpected arguments for dir(): @_" if @_;
#
#   return substr $self->{TYPE}, 0, 1;
#}
#
#
#
#use vars (
#'$filter_op',        
#'$filter_num'        
#);
#
#sub _init_filters {
#   my IPC::Run::IO $self = shift;
#
#confess "\$self not an IPC::Run::IO" unless UNIVERSAL::isa( $self, "IPC::Run::IO" );
#   $self->{FBUFS} = [];
#
#   $self->{FBUFS}->[0] = $self->{DEST}
#      if $self->{DEST} && ref $self->{DEST} eq 'SCALAR';
#
#   return unless $self->{FILTERS} && @{$self->{FILTERS}};
#
#   push @{$self->{FBUFS}}, map {
#      my $s = "";
#      \$s;
#   } ( @{$self->{FILTERS}}, '' );
#
#   push @{$self->{FBUFS}}, $self->{SOURCE};
#}
#
#
#sub poll {
#   my IPC::Run::IO $self = shift;
#   my ( $harness ) = @_;
#
#   if ( defined $self->{FD} ) {
#      my $d = $self->dir;
#      if ( $d eq "<" ) {
#         if ( vec $harness->{WOUT}, $self->{FD}, 1 ) {
#            _debug_desc_fd( "filtering data to", $self )
#               if _debugging_details;
#            return $self->_do_filters( $harness );
#         }
#      }
#      elsif ( $d eq ">" ) {
#         if ( vec $harness->{ROUT}, $self->{FD}, 1 ) {
#            _debug_desc_fd( "filtering data from", $self )
#               if _debugging_details;
#            return $self->_do_filters( $harness );
#         }
#      }
#   }
#   return 0;
#}
#
#
#sub _do_filters {
#   my IPC::Run::IO $self = shift;
#
#   ( $self->{HARNESS} ) = @_;
#
#   my ( $saved_op, $saved_num ) =($IPC::Run::filter_op,$IPC::Run::filter_num);
#   $IPC::Run::filter_op = $self;
#   $IPC::Run::filter_num = -1;
#   my $redos = 0;
#   my $r;
#   {
#	   $@ = '';
#	   $r = eval { IPC::Run::get_more_input(); };
#
#	   if(($@||'') =~ $IPC::Run::_EAGAIN && $redos++ < 200) {
#	       select(undef, undef, undef, 0.01);
#	       redo;
#	   }
#   }
#   ( $IPC::Run::filter_op, $IPC::Run::filter_num ) = ( $saved_op, $saved_num );
#   $self->{HARNESS} = undef;
#   die "ack ", $@ if $@;
#   return $r;
#}
#
#
#1;
### IPC/Run/Timer.pm ###
#package IPC::Run::Timer;
#
#
#use strict;
#use Carp;
#use Fcntl;
#use Symbol;
#use Exporter;
#use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS );
#BEGIN {
#	$VERSION   = '0.90';
#	@ISA       = qw( Exporter );
#	@EXPORT_OK = qw(
#		check
#		end_time
#		exception
#		expire
#		interval
#		is_expired
#		is_reset
#		is_running
#		name
#		reset
#		start
#		timeout
#		timer
#	);
#
#	%EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
#}
#
#require IPC::Run;
#use IPC::Run::Debug;
#
#my $resolution = 1;
#
#sub _parse_time {
#   for ( $_[0] ) {
#      return $_ unless defined $_;
#      return $_ if /^\d*(?:\.\d*)?$/;
#
#      my @f = reverse split( /[^\d\.]+/i );
#      croak "IPC::Run: invalid time string '$_'" unless @f <= 4;
#      my ( $s, $m, $h, $d ) = @f;
#      return
#      ( (
#	         ( $d || 0 )   * 24
#	       + ( $h || 0 ) ) * 60
#	       + ( $m || 0 ) ) * 60
#               + ( $s || 0 );
#   }
#}
#
#sub _calc_end_time {
#   my IPC::Run::Timer $self = shift;
#   my $interval = $self->interval;
#   $interval += $resolution if $interval;
#   $self->end_time( $self->start_time + $interval );
#}
#
#
#
#sub timer {
#   return IPC::Run::Timer->new( @_ );
#}
#
#
#
#sub timeout {
#   my $t = IPC::Run::Timer->new( @_ );
#   $t->exception( "IPC::Run: timeout on " . $t->name )
#      unless defined $t->exception;
#   return $t;
#}
#
#
#
#my $timer_counter;
#
#
#sub new {
#   my $class = shift;
#   $class = ref $class || $class;
#
#   my IPC::Run::Timer $self = bless {}, $class;
#
#   $self->{STATE} = 0;
#   $self->{DEBUG} = 0;
#   $self->{NAME}  = "timer #" . ++$timer_counter;
#
#   while ( @_ ) {
#      my $arg = shift;
#      if ( $arg =~ /^(?:\d+[^\a\d]){0,3}\d*(?:\.\d*)?$/ ) {
#         $self->interval( $arg );
#      }
#      elsif ( $arg eq 'exception' ) {
#         $self->exception( shift );
#      }
#      elsif ( $arg eq 'name' ) {
#         $self->name( shift );
#      }
#      elsif ( $arg eq 'debug' ) {
#         $self->debug( shift );
#      }
#      else {
#         croak "IPC::Run: unexpected parameter '$arg'";
#      }
#   }
#
#   _debug $self->name . ' constructed'
#      if $self->{DEBUG} || _debugging_details;
#
#   return $self;
#}
#
#
#sub check {
#   my IPC::Run::Timer $self = shift;
#   return undef if ! $self->is_running;
#   return 0     if  $self->is_expired;
#
#   my ( $now ) = @_;
#   $now = _parse_time( $now );
#   $now = time unless defined $now;
#
#   _debug(
#      "checking ", $self->name, " (end time ", $self->end_time, ") at ", $now 
#   ) if $self->{DEBUG} || _debugging_details;
#
#   my $left = $self->end_time - $now;
#   return $left if $left > 0;
#
#   $self->expire;
#   return 0;
#}
#
#
#
#
#sub debug {
#   my IPC::Run::Timer $self = shift;
#   $self->{DEBUG} = shift if @_;
#   return $self->{DEBUG};
#}
#
#
#
#
#sub end_time {
#   my IPC::Run::Timer $self = shift;
#   if ( @_ ) {
#      $self->{END_TIME} = shift;
#      _debug $self->name, ' end_time set to ', $self->{END_TIME}
#	 if $self->{DEBUG} > 2 || _debugging_details;
#   }
#   return $self->{END_TIME};
#}
#
#
#
#
#sub exception {
#   my IPC::Run::Timer $self = shift;
#   if ( @_ ) {
#      $self->{EXCEPTION} = shift;
#      _debug $self->name, ' exception set to ', $self->{EXCEPTION}
#	 if $self->{DEBUG} || _debugging_details;
#   }
#   return $self->{EXCEPTION};
#}
#
#
#
#sub interval {
#   my IPC::Run::Timer $self = shift;
#   if ( @_ ) {
#      $self->{INTERVAL} = _parse_time( shift );
#      _debug $self->name, ' interval set to ', $self->{INTERVAL}
#	 if $self->{DEBUG} > 2 || _debugging_details;
#
#      $self->_calc_end_time if $self->state;
#   }
#   return $self->{INTERVAL};
#}
#
#
#
#
#sub expire {
#   my IPC::Run::Timer $self = shift;
#   if ( defined $self->state ) {
#      _debug $self->name . ' expired'
#	 if $self->{DEBUG} || _debugging;
#
#      $self->state( undef );
#      croak $self->exception if $self->exception;
#   }
#   return undef;
#}
#
#
#
#
#sub is_running {
#   my IPC::Run::Timer $self = shift;
#   return $self->state ? 1 : 0;
#}
#
#
#   
#sub is_reset {
#   my IPC::Run::Timer $self = shift;
#   return defined $self->state && $self->state == 0;
#}
#
#
#
#sub is_expired {
#   my IPC::Run::Timer $self = shift;
#   return ! defined $self->state;
#}
#
#
#sub name {
#   my IPC::Run::Timer $self = shift;
# 
#   $self->{NAME} = shift if @_;
#   return defined $self->{NAME}
#      ? $self->{NAME}
#      : defined $self->{EXCEPTION}
#         ? 'timeout'
#	 : 'timer';
#}
#
#
#
#sub reset {
#   my IPC::Run::Timer $self = shift;
#   $self->state( 0 );
#   $self->end_time( undef );
#   _debug $self->name . ' reset'
#      if $self->{DEBUG} || _debugging;
#
#   return undef;
#}
#
#
#
#sub start {
#   my IPC::Run::Timer $self = shift;
#
#   my ( $interval, $now ) = map { _parse_time( $_ ) } @_;
#   $now = _parse_time( $now );
#   $now = time unless defined $now;
#
#   $self->interval( $interval ) if defined $interval;
#
#   $self->end_time( undef ) if ! $self->is_reset || $interval;
#
#   croak "IPC::Run: no timer interval or end_time defined for " . $self->name
#      unless defined $self->interval || defined $self->end_time;
#
#   $self->state( 1 );
#   $self->start_time( $now );
#   $self->_calc_end_time
#      unless defined $self->end_time;
#
#   _debug(
#      $self->name, " started at ", $self->start_time,
#      ", with interval ", $self->interval, ", end_time ", $self->end_time
#   ) if $self->{DEBUG} || _debugging;
#   return undef;
#}
#
#
#
#
#sub start_time {
#   my IPC::Run::Timer $self = shift;
#   if ( @_ ) {
#      $self->{START_TIME} = _parse_time( shift );
#      _debug $self->name, ' start_time set to ', $self->{START_TIME}
#	 if $self->{DEBUG} > 2 || _debugging;
#   }
#
#   return $self->{START_TIME};
#}
#
#
#
#sub state {
#   my IPC::Run::Timer $self = shift;
#   if ( @_ ) {
#      $self->{STATE} = shift;
#      _debug $self->name, ' state set to ', $self->{STATE}
#	 if $self->{DEBUG} > 2 || _debugging;
#   }
#   return $self->{STATE};
#}
#
#
#1;
#
### IPC/Run/Win32Helper.pm ###
#package IPC::Run::Win32Helper;
#
#
#use strict;
#use Carp;
#use IO::Handle;
#use vars qw{ $VERSION @ISA @EXPORT };
#BEGIN {
#	$VERSION = '0.90';
#	@ISA = qw( Exporter );
#	@EXPORT = qw(
#		win32_spawn
#		win32_parse_cmd_line
#		_dont_inherit
#		_inherit
#	);
#}
#
#require POSIX;
#
#use Text::ParseWords;
#use Win32::Process;
#use IPC::Run::Debug;
#use Win32API::File qw(
#   FdGetOsFHandle
#   SetHandleInformation
#   HANDLE_FLAG_INHERIT
#   INVALID_HANDLE_VALUE
#);
#
#sub _dont_inherit {
#   for ( @_ ) {
#      next unless defined $_;
#      my $fd = $_;
#      $fd = fileno $fd if ref $fd;
#      _debug "disabling inheritance of ", $fd if _debugging_details;
#      my $osfh = FdGetOsFHandle $fd;
#      croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE;
#
#      SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, 0 );
#   }
#}
#
#sub _inherit {       
#   for ( @_ ) {       
#      next unless defined $_;       
#      my $fd = $_;       
#      $fd = fileno $fd if ref $fd;       
#      _debug "enabling inheritance of ", $fd if _debugging_details;       
#      my $osfh = FdGetOsFHandle $fd;       
#      croak $^E if ! defined $osfh || $osfh == INVALID_HANDLE_VALUE;       
#      SetHandleInformation( $osfh, HANDLE_FLAG_INHERIT, 1 );       
#   }       
#}       
#
#
#sub optimize {
#   my ( $h ) = @_;
#
#   my @kids = @{$h->{KIDS}};
#
#   my $saw_pipe;
#
#   my ( $ok_to_optimize_outputs, $veto_output_optimization );
#
#   for my $kid ( @kids ) {
#      ( $ok_to_optimize_outputs, $veto_output_optimization ) = ()
#         unless $saw_pipe;
#
#      _debug
#         "Win32 optimizer: (kid $kid->{NUM}) STDIN piped, carrying over ok of non-SCALAR output optimization"
#         if _debugging_details && $ok_to_optimize_outputs;
#      _debug
#         "Win32 optimizer: (kid $kid->{NUM}) STDIN piped, carrying over veto of non-SCALAR output optimization"
#         if _debugging_details && $veto_output_optimization;
#
#      if ( $h->{noinherit} && ! $ok_to_optimize_outputs ) {
#	 _debug
#	    "Win32 optimizer: (kid $kid->{NUM}) STDIN not inherited from parent oking non-SCALAR output optimization"
#	    if _debugging_details && $ok_to_optimize_outputs;
#	 $ok_to_optimize_outputs = 1;
#      }
#
#      for ( @{$kid->{OPS}} ) {
#         if ( substr( $_->{TYPE}, 0, 1 ) eq "<" ) {
#            if ( $_->{TYPE} eq "<" ) {
#	       if ( @{$_->{FILTERS}} > 1 ) {
#	       }
#               elsif ( ref $_->{SOURCE} eq "SCALAR"
#	          || ref $_->{SOURCE} eq "GLOB"
#		  || UNIVERSAL::isa( $_, "IO::Handle" )
#	       ) {
#                  if ( $_->{KFD} == 0 ) {
#                     _debug
#                        "Win32 optimizer: (kid $kid->{NUM}) 0$_->{TYPE}",
#                        ref $_->{SOURCE},
#                        ", ok to optimize outputs"
#                        if _debugging_details;
#                     $ok_to_optimize_outputs = 1;
#                  }
#                  $_->{SEND_THROUGH_TEMP_FILE} = 1;
#                  next;
#               }
#               elsif ( ! ref $_->{SOURCE} && defined $_->{SOURCE} ) {
#                  if ( $_->{KFD} == 0 ) {
#                     _debug
#                        "Win32 optimizer: (kid $kid->{NUM}) 0<$_->{SOURCE}, ok to optimize outputs",
#                        if _debugging_details;
#                     $ok_to_optimize_outputs = 1;
#                  }
#                  next;
#               }
#            }
#            _debug
#               "Win32 optimizer: (kid $kid->{NUM}) ",
#               $_->{KFD},
#               $_->{TYPE},
#               defined $_->{SOURCE}
#                  ? ref $_->{SOURCE}      ? ref $_->{SOURCE}
#                                          : $_->{SOURCE}
#                  : defined $_->{FILENAME}
#                                          ? $_->{FILENAME}
#                                          : "",
#	       @{$_->{FILTERS}} > 1 ? " with filters" : (),
#               ", VETOING output opt."
#               if _debugging_details || _debugging_not_optimized;
#            $veto_output_optimization = 1;
#         }
#         elsif ( $_->{TYPE} eq "close" && $_->{KFD} == 0 ) {
#            $ok_to_optimize_outputs = 1;
#            _debug "Win32 optimizer: (kid $kid->{NUM}) saw 0<&-, ok to optimize outputs"
#               if _debugging_details;
#         }
#         elsif ( $_->{TYPE} eq "dup" && $_->{KFD2} == 0 ) {
#            $veto_output_optimization = 1;
#            _debug "Win32 optimizer: (kid $kid->{NUM}) saw 0<&$_->{KFD2}, VETOING output opt."
#               if _debugging_details || _debugging_not_optimized;
#         }
#         elsif ( $_->{TYPE} eq "|" ) {
#            $saw_pipe = 1;
#         }
#      }
#
#      if ( ! $ok_to_optimize_outputs && ! $veto_output_optimization ) {
#         _debug
#            "Win32 optimizer: (kid $kid->{NUM}) child STDIN not redirected, VETOING non-SCALAR output opt."
#            if _debugging_details || _debugging_not_optimized;
#         $veto_output_optimization = 1;
#      }
#
#      if ( $ok_to_optimize_outputs && $veto_output_optimization ) {
#         $ok_to_optimize_outputs = 0;
#         _debug "Win32 optimizer: (kid $kid->{NUM}) non-SCALAR output optimizations VETOed"
#            if _debugging_details || _debugging_not_optimized;
#      }
#
#
#      for ( @{$kid->{OPS}} ) {
#         if ( $_->{TYPE} eq ">" ) {
#            if ( ref $_->{DEST} eq "SCALAR"
#               || (
#                  ( @{$_->{FILTERS}} > 1
#		     || ref $_->{DEST} eq "CODE"
#		     || ref $_->{DEST} eq "ARRAY"  
#	          )
#                  && ( $ok_to_optimize_outputs && ! $veto_output_optimization ) 
#               )
#            ) {
#	       $_->{RECV_THROUGH_TEMP_FILE} = 1;
#	       next;
#            }
#	    _debug
#	       "Win32 optimizer: NOT optimizing (kid $kid->{NUM}) ",
#	       $_->{KFD},
#	       $_->{TYPE},
#	       defined $_->{DEST}
#		  ? ref $_->{DEST}      ? ref $_->{DEST}
#					  : $_->{SOURCE}
#		  : defined $_->{FILENAME}
#					  ? $_->{FILENAME}
#					  : "",
#		  @{$_->{FILTERS}} ? " with filters" : (),
#	       if _debugging_details;
#         }
#      }
#   }
#
#}
#
#
#sub win32_parse_cmd_line {
#   my $line = shift;
#   $line =~ s{(\\[\w\s])}{\\$1}g;
#   return shellwords $line;
#}
#
#
#sub _save {
#   my ( $saved, $saved_as, $fd ) = @_;
#
#   return if exists $saved->{$fd};
#
#   my $saved_fd = IPC::Run::_dup( $fd );
#   _dont_inherit $saved_fd;
#
#   $saved->{$fd} = $saved_fd;
#   $saved_as->{$saved_fd} = $fd;
#
#   _dont_inherit $saved->{$fd};
#}
#
#sub _dup2_gently {
#   my ( $saved, $saved_as, $fd1, $fd2 ) = @_;
#   _save $saved, $saved_as, $fd2;
#
#   if ( exists $saved_as->{$fd2} ) {
#      my $orig_fd = delete $saved_as->{$fd2};
#      my $saved_fd = IPC::Run::_dup( $fd2 );
#      _dont_inherit $saved_fd;
#
#      $saved->{$orig_fd} = $saved_fd;
#      $saved_as->{$saved_fd} = $orig_fd;
#   }
#   _debug "moving $fd1 to kid's $fd2" if _debugging_details;
#   IPC::Run::_dup2_rudely( $fd1, $fd2 );
#}
#
#sub win32_spawn {
#   my ( $cmd, $ops) = @_;
#
#   
#   my %saved;      
#   my %saved_as;   
#   
#   for my $op ( @$ops ) {
#      _dont_inherit $op->{FD}  if defined $op->{FD};
#
#      if ( defined $op->{KFD} && $op->{KFD} > 2 ) {
#         croak "Can't redirect fd #", $op->{KFD}, " on Win32";
#      }
#
#      if ( defined $op->{TFD} ) {
#	 unless ( $op->{TFD} == $op->{KFD} ) {
#	    _dup2_gently \%saved, \%saved_as, $op->{TFD}, $op->{KFD};
#	    _dont_inherit $op->{TFD};
#	 }
#      }
#      elsif ( $op->{TYPE} eq "dup" ) {
#         _dup2_gently \%saved, \%saved_as, $op->{KFD1}, $op->{KFD2}
#            unless $op->{KFD1} == $op->{KFD2};
#      }
#      elsif ( $op->{TYPE} eq "close" ) {
#	 _save \%saved, \%saved_as, $op->{KFD};
#	 IPC::Run::_close( $op->{KFD} );
#      }
#      elsif ( $op->{TYPE} eq "init" ) {
#         croak "init subs not allowed on Win32";
#      }
#   }
#
#   my $process;
#   my $cmd_line = join " ", map {
#      ( my $s = $_ ) =~ s/"/"""/g;
#      $s = qq{"$s"} if /[\"\s]|^$/;
#      $s;
#   } @$cmd;
#
#   _debug "cmd line: ", $cmd_line
#      if _debugging;
#
#   Win32::Process::Create( 
#      $process,
#      $cmd->[0],
#      $cmd_line,
#      1,  
#      NORMAL_PRIORITY_CLASS,
#      ".",
#   ) or croak "$!: Win32::Process::Create()";
#
#   for my $orig_fd ( keys %saved ) {
#      IPC::Run::_dup2_rudely( $saved{$orig_fd}, $orig_fd );
#      IPC::Run::_close( $saved{$orig_fd} );
#   }
#
#   return ( $process->GetProcessID(), $process );
#}
#
#
#1;
#
### IPC/Run/Win32IO.pm ###
#package IPC::Run::Win32IO;
#
#
#use strict;
#use Carp;
#use IO::Handle;
#use Socket;
#require POSIX;
#
#use vars qw{$VERSION};
#BEGIN {
#	$VERSION = '0.90';
#}
#
#use Socket qw( IPPROTO_TCP TCP_NODELAY );
#use Symbol;
#use Text::ParseWords;
#use Win32::Process;
#use IPC::Run::Debug qw( :default _debugging_level );
#use IPC::Run::Win32Helper qw( _inherit _dont_inherit );
#use Fcntl qw( O_TEXT O_RDONLY );
#
#use base qw( IPC::Run::IO );
#my @cleanup_fields;
#BEGIN {
#   @cleanup_fields = (
#      'SEND_THROUGH_TEMP_FILE', 
#      'RECV_THROUGH_TEMP_FILE', 
#      'TEMP_FILE_NAME',         
#
#      'PARENT_HANDLE',       
#      'PUMP_SOCKET_HANDLE',  
#      'PUMP_PIPE_HANDLE',    
#      'CHILD_HANDLE',        
#
#      'TEMP_FILE_HANDLE',    
#   );
#}
#
#use Win32API::File qw(
#   GetOsFHandle
#   OsFHandleOpenFd
#   OsFHandleOpen
#   FdGetOsFHandle
#   SetHandleInformation
#   SetFilePointer
#   HANDLE_FLAG_INHERIT
#   INVALID_HANDLE_VALUE
#
#   createFile
#   WriteFile
#   ReadFile
#   CloseHandle
#
#   FILE_ATTRIBUTE_TEMPORARY
#   FILE_FLAG_DELETE_ON_CLOSE
#   FILE_FLAG_WRITE_THROUGH
#
#   FILE_BEGIN
#);
#
#
#
#BEGIN {
#   () = (
#      SOL_SOCKET,
#      SO_REUSEADDR,
#      IPPROTO_TCP,
#      TCP_NODELAY,
#      HANDLE_FLAG_INHERIT,
#      INVALID_HANDLE_VALUE,
#   );
#}
#
#use constant temp_file_flags => (
#   FILE_ATTRIBUTE_TEMPORARY()   |
#   FILE_FLAG_DELETE_ON_CLOSE()  |
#   FILE_FLAG_WRITE_THROUGH()
#);
#
#my $tmp_file_counter;
#my $tmp_dir;
#
#sub _cleanup {
#    my IPC::Run::Win32IO $self = shift;
#    my ( $harness ) = @_;
#
#    $self->_recv_through_temp_file( $harness )
#       if $self->{RECV_THROUGH_TEMP_FILE};
#
#    CloseHandle( $self->{TEMP_FILE_HANDLE} )
#       if defined $self->{TEMP_FILE_HANDLE};
#
#    $self->{$_} = undef for @cleanup_fields;
#}
#
#
#sub _create_temp_file {
#   my IPC::Run::Win32IO $self = shift;
#
#   unless ( defined $tmp_dir ) {
#      $tmp_dir = File::Spec->catdir(
#         File::Spec->tmpdir, "IPC-Run.tmp"
#      );
#
#      unless ( -d $tmp_dir ) {
#         mkdir $tmp_dir or croak "$!: $tmp_dir";
#      }
#   }
#
#   $self->{TEMP_FILE_NAME} = File::Spec->catfile(
#      $tmp_dir, sprintf "Win32io-%06d-%08d", $$, $tmp_file_counter++
#   );
#
#   $self->{TEMP_FILE_HANDLE} = createFile(
#      $self->{TEMP_FILE_NAME},
#      "trw",         
#      {
#         Flags      => temp_file_flags,
#      },
#   ) or croak "Can't create temporary file, $self->{TEMP_FILE_NAME}: $^E";
#
#   $self->{TFD} = OsFHandleOpenFd $self->{TEMP_FILE_HANDLE}, 0;
#   $self->{FD} = undef;
#
#   _debug
#      "Win32 Optimizer: temp file (",
#      $self->{KFD},
#      $self->{TYPE},
#      $self->{TFD},
#      ", fh ",
#      $self->{TEMP_FILE_HANDLE},
#      "): ",
#      $self->{TEMP_FILE_NAME}
#      if _debugging_details;
#}
#
#
#sub _reset_temp_file_pointer {
#   my $self = shift;
#   SetFilePointer( $self->{TEMP_FILE_HANDLE}, 0, 0, FILE_BEGIN )
#      or confess "$^E seeking on (fd $self->{TFD}) $self->{TEMP_FILE_NAME} for kid's fd $self->{KFD}";
#}
#
#
#sub _send_through_temp_file {
#   my IPC::Run::Win32IO $self = shift;
#
#   _debug
#      "Win32 optimizer: optimizing "
#      . " $self->{KFD} $self->{TYPE} temp file instead of ",
#         ref $self->{SOURCE} || $self->{SOURCE}
#      if _debugging_details;
#
#   $self->_create_temp_file;
#
#   if ( defined ${$self->{SOURCE}} ) {
#      my $bytes_written = 0;
#      my $data_ref;
#      if ( $self->binmode ) {
#	 $data_ref = $self->{SOURCE};
#      }
#      else {
#         my $data = ${$self->{SOURCE}};  
#	 $data =~ s/(?<!\r)\n/\r\n/g;
#	 $data_ref = \$data;
#      }
#
#      WriteFile(
#         $self->{TEMP_FILE_HANDLE},
#         $$data_ref,
#         0,              
#         $bytes_written,
#         [],             
#      ) or croak
#         "$^E writing $self->{TEMP_FILE_NAME} for kid to read on fd $self->{KFD}";
#      _debug
#         "Win32 optimizer: wrote $bytes_written to temp file $self->{TEMP_FILE_NAME}"
#         if _debugging_data;
#
#      $self->_reset_temp_file_pointer;
#
#   }
#
#
#   _debug "Win32 optimizer: kid to read $self->{KFD} from temp file on $self->{TFD}"
#      if _debugging_details;
#}
#
#
#sub _init_recv_through_temp_file {
#   my IPC::Run::Win32IO $self = shift;
#
#   $self->_create_temp_file;
#}
#
#
#sub _recv_through_temp_file {
#   my IPC::Run::Win32IO $self = shift;
#
#   return undef unless defined $self->{TEMP_FILE_HANDLE};
#
#   push @{$self->{FILTERS}}, sub {
#      my ( undef, $out_ref ) = @_;
#
#      return undef unless defined $self->{TEMP_FILE_HANDLE};
#
#      my $r;
#      my $s;
#      ReadFile(
#	 $self->{TEMP_FILE_HANDLE},
#	 $s,
#	 999_999,  
#	 $r,
#	 []
#      ) or croak "$^E reading from $self->{TEMP_FILE_NAME}";
#
#      _debug "ReadFile( $self->{TFD} ) = $r chars '$s'" if _debugging_data;
#
#      return undef unless $r;
#
#      $s =~ s/\r\n/\n/g unless $self->binmode;
#
#      my $pos = pos $$out_ref;
#      $$out_ref .= $s;
#      pos( $out_ref ) = $pos;
#      return 1;
#   };
#
#   my ( $harness ) = @_;
#
#   $self->_reset_temp_file_pointer;
#
#   1 while $self->_do_filters( $harness );
#
#   pop @{$self->{FILTERS}};
#
#   IPC::Run::_close( $self->{TFD} );
#}
#
#
#sub poll {
#   my IPC::Run::Win32IO $self = shift;
#
#   return if $self->{SEND_THROUGH_TEMP_FILE} || $self->{RECV_THROUGH_TEMP_FILE};
#
#   return $self->SUPER::poll( @_ );
#}
#
#
#
#sub _spawn_pumper {
#   my ( $stdin, $stdout, $debug_fd, $binmode, $child_label, @opts ) = @_;
#   my ( $stdin_fd, $stdout_fd ) = ( fileno $stdin, fileno $stdout );
#
#   _debug "pumper stdin = ", $stdin_fd if _debugging_details;
#   _debug "pumper stdout = ", $stdout_fd if _debugging_details;
#   _inherit $stdin_fd, $stdout_fd, $debug_fd;
#   my @I_options = map qq{"-I$_"}, @INC;
#
#   my $cmd_line = join( " ",
#      qq{"$^X"},
#      @I_options,
#      qw(-MIPC::Run::Win32Pump -e 1 ),
#      FdGetOsFHandle( $stdin_fd ), 
#      FdGetOsFHandle( $stdout_fd ), 
#      FdGetOsFHandle( $debug_fd ), 
#      $binmode ? 1 : 0,
#      $$, $^T, _debugging_level, qq{"$child_label"},
#      @opts
#   );
#
#
#   _debug "pump cmd line: ", $cmd_line if _debugging_details;
#
#   my $process;
#   Win32::Process::Create( 
#      $process,
#      $^X,
#      $cmd_line,
#      1,  
#      NORMAL_PRIORITY_CLASS,
#      ".",
#   ) or croak "$!: Win32::Process::Create()";
#
#
#   close $stdin  or croak "$! closing pumper's stdin in parent";
#   close $stdout or croak "$! closing pumper's stdout in parent";
#
#
#   _debug "_spawn_pumper pid = ", $process->GetProcessID 
#      if _debugging_data;
#}
#
#
#my $next_port = 2048;
#my $loopback  = inet_aton "127.0.0.1";
#my $tcp_proto = getprotobyname('tcp');
#croak "$!: getprotobyname('tcp')" unless defined $tcp_proto;
#
#sub _socket {
#   my ( $server ) = @_;
#   $server ||= gensym;
#   my $client = gensym;
#
#   my $listener = gensym;
#   socket $listener, PF_INET, SOCK_STREAM, $tcp_proto
#      or croak "$!: socket()";
#   setsockopt $listener, SOL_SOCKET, SO_REUSEADDR, pack("l", 0)
#      or croak "$!: setsockopt()";
#
#   my $port;
#   my @errors;
#PORT_FINDER_LOOP:
#   {
#      $port = $next_port;
#      $next_port = 2048 if ++$next_port > 65_535; 
#      unless ( bind $listener, sockaddr_in( $port, $loopback ) ) {
#	 push @errors, "$! on port $port";
#	 croak join "\n", @errors if @errors > 10;
#         goto PORT_FINDER_LOOP;
#      }
#   }
#
#   _debug "win32 port = $port" if _debugging_details;
#
#   listen $listener, my $queue_size = 1
#      or croak "$!: listen()";
#
#   {
#      socket $client, PF_INET, SOCK_STREAM, $tcp_proto
#         or croak "$!: socket()";
#
#      my $paddr = sockaddr_in($port, $loopback );
#
#      connect $client, $paddr
#         or croak "$!: connect()";
#    
#      croak "$!: accept" unless defined $paddr;
#
#      setsockopt $client, IPPROTO_TCP, TCP_NODELAY, pack("l", 0)
#	 or croak "$!: setsockopt()";
#   }
#
#   {
#      _debug "accept()ing on port $port" if _debugging_details;
#      my $paddr = accept( $server, $listener );
#      croak "$!: accept()" unless defined $paddr;
#   }
#
#   _debug
#      "win32 _socket = ( ", fileno $server, ", ", fileno $client, " ) on port $port" 
#      if _debugging_details;
#   return ( $server, $client );
#}
#
#
#sub _open_socket_pipe {
#   my IPC::Run::Win32IO $self = shift;
#   my ( $debug_fd, $parent_handle ) = @_;
#
#   my $is_send_to_child = $self->dir eq "<";
#
#   $self->{CHILD_HANDLE}     = gensym;
#   $self->{PUMP_PIPE_HANDLE} = gensym;
#
#   ( 
#      $self->{PARENT_HANDLE},
#      $self->{PUMP_SOCKET_HANDLE}
#   ) = _socket $parent_handle;
#
#   binmode $self->{PARENT_HANDLE}      or die $!;
#   binmode $self->{PUMP_SOCKET_HANDLE} or die $!;
#
#_debug "PUMP_SOCKET_HANDLE = ", fileno $self->{PUMP_SOCKET_HANDLE}
#   if _debugging_details;
#
#   if ( $is_send_to_child ) {
#      pipe $self->{CHILD_HANDLE}, $self->{PUMP_PIPE_HANDLE}
#         or croak "$! opening child pipe";
#_debug "CHILD_HANDLE = ", fileno $self->{CHILD_HANDLE}
#   if _debugging_details;
#_debug "PUMP_PIPE_HANDLE = ", fileno $self->{PUMP_PIPE_HANDLE}
#   if _debugging_details;
#   }
#   else {
#      pipe $self->{PUMP_PIPE_HANDLE}, $self->{CHILD_HANDLE}
#         or croak "$! opening child pipe";
#_debug "CHILD_HANDLE = ", fileno $self->{CHILD_HANDLE}
#   if _debugging_details;
#_debug "PUMP_PIPE_HANDLE = ", fileno $self->{PUMP_PIPE_HANDLE}
#   if _debugging_details;
#   }
#
#   binmode $self->{CHILD_HANDLE};
#   binmode $self->{PUMP_PIPE_HANDLE};
#
#   _dont_inherit $self->{PARENT_HANDLE};
#
#   _dont_inherit $self->{PUMP_SOCKET_HANDLE};
#   _dont_inherit $self->{PUMP_PIPE_HANDLE};
#   _dont_inherit $self->{CHILD_HANDLE};
#
#   my ( $parent_fd, $child_fd ) = (
#      fileno $self->{PARENT_HANDLE},
#      fileno $self->{CHILD_HANDLE}
#   );
#
#   _debug "binmode on" if _debugging_data && $self->binmode;
#   _spawn_pumper(
#      $is_send_to_child
#	 ? ( $self->{PUMP_SOCKET_HANDLE}, $self->{PUMP_PIPE_HANDLE} )
#	 : ( $self->{PUMP_PIPE_HANDLE}, $self->{PUMP_SOCKET_HANDLE} ),
#      $debug_fd,
#      $self->binmode,
#      $child_fd . $self->dir . "pump" . $self->dir . $parent_fd,
#   );
#
#{
#my $foo;
#confess "PARENT_HANDLE no longer open"
#   unless POSIX::read( $parent_fd, $foo, 0 );
#}
#
#   _debug "win32_fake_pipe = ( $parent_fd, $child_fd )"
#      if _debugging_details;
#
#   $self->{FD}  = $parent_fd;
#   $self->{TFD} = $child_fd;
#}
#
#sub _do_open {
#   my IPC::Run::Win32IO $self = shift;
#
#   if ( $self->{SEND_THROUGH_TEMP_FILE} ) {
#      return $self->_send_through_temp_file( @_ );
#   }
#   elsif ( $self->{RECV_THROUGH_TEMP_FILE} ) {
#      return $self->_init_recv_through_temp_file( @_ );
#   }
#   else {
#      return $self->_open_socket_pipe( @_ );
#   }
#}
#
#1;
#
### IPC/Run/Win32Pump.pm ###
#package IPC::Run::Win32Pump;
#
#
#use strict;
#use vars qw{$VERSION};
#BEGIN {
#	$VERSION = '0.90';
#}
#
#use Win32API::File qw(
#   OsFHandleOpen
#);
#
#
#my ( $stdin_fh, $stdout_fh, $debug_fh, $binmode, $parent_pid, $parent_start_time, $debug, $child_label );
#BEGIN {
#   ( $stdin_fh, $stdout_fh, $debug_fh, $binmode, $parent_pid, $parent_start_time, $debug, $child_label ) = @ARGV;
#   if ( $debug ) {
#      eval "use IPC::Run::Debug qw( :default _debug_init ); 1;"
#	 or die $@;
#   }
#   else {
#      eval <<STUBS_END or die $@;
#	 sub _debug {}
#	 sub _debug_init {}
#	 sub _debugging() { 0 }
#	 sub _debugging_data() { 0 }
#	 sub _debugging_details() { 0 }
#	 sub _debugging_gory_details() { 0 }
#	 1;
#STUBS_END
#   }
#}
#
#if ( $debug ) {       
#close STDERR;       
#OsFHandleOpen( \*STDERR, $debug_fh, "w" )       
# or print "$! opening STDERR as Win32 handle $debug_fh in pumper $$";       
#}       
#close STDIN;       
#OsFHandleOpen( \*STDIN, $stdin_fh, "r" )       
#or die "$! opening STDIN as Win32 handle $stdin_fh in pumper $$";       
#close STDOUT;       
#OsFHandleOpen( \*STDOUT, $stdout_fh, "w" )       
#or die "$! opening STDOUT as Win32 handle $stdout_fh in pumper $$";       
#
#binmode STDIN;
#binmode STDOUT;
#$| = 1;
#select STDERR; $| = 1; select STDOUT;
#
#$child_label ||= "pump";
#_debug_init(
#$parent_pid,
#$parent_start_time,
#$debug,
#fileno STDERR,
#$child_label,
#);
#
#_debug "Entered" if _debugging_details;
#
#$| = 1;
#my $buf;
#my $total_count = 0;
#while (1) {
#my $count = sysread STDIN, $buf, 10_000;
#last unless $count;
#if ( _debugging_gory_details ) {
# my $msg = "'$buf'";
# substr( $msg, 100, -1 ) = '...' if length $msg > 100;
# $msg =~ s/\n/\\n/g;
# $msg =~ s/\r/\\r/g;
# $msg =~ s/\t/\\t/g;
# $msg =~ s/([\000-\037\177-\277])/sprintf "\0x%02x", ord $1/eg;
# _debug sprintf( "%5d chars revc: ", $count ), $msg;
#}
#$total_count += $count;
#$buf =~ s/\r//g unless $binmode;
#if ( _debugging_gory_details ) {
# my $msg = "'$buf'";
# substr( $msg, 100, -1 ) = '...' if length $msg > 100;
# $msg =~ s/\n/\\n/g;
# $msg =~ s/\r/\\r/g;
# $msg =~ s/\t/\\t/g;
# $msg =~ s/([\000-\037\177-\277])/sprintf "\0x%02x", ord $1/eg;
# _debug sprintf( "%5d chars sent: ", $count ), $msg;
#}
#print $buf;
#}
#
#_debug "Exiting, transferred $total_count chars" if _debugging_details;
#
#close STDOUT;
#close STDERR;
#
#1;
#
### IPC/System/Options.pm ###
#package IPC::System::Options;
#
#our $DATE = '2016-06-08'; 
#our $VERSION = '0.27'; 
#
#use strict;
#use warnings;
#
#use Proc::ChildError qw(explain_child_error);
#use String::ShellQuote;
#
#my $log;
#our %Global_Opts;
#
#sub import {
#    my $self = shift;
#
#    my $caller = caller();
#    my $i = 0;
#    while ($i < @_) {
#        if ($_[$i] =~ /\A(system|readpipe|backtick|run|import)\z/) {
#            no strict 'refs';
#            *{"$caller\::$_[$i]"} = \&{"$self\::" . $_[$i]};
#        } elsif ($_[$i] =~ /\A-(.+)/) {
#            die "$_[$i] requires an argument" unless $i < @_-1;
#            $Global_Opts{$1} = $_[$i+1];
#            $i++;
#        } else {
#            die "$_[$i] is not exported by ".__PACKAGE__;
#        }
#        $i++;
#    }
#}
#
#sub _quote {
#    if (@_ == 1) {
#        return $_[0];
#    }
#
#    if ($^O eq 'MSWin32') {
#        require Win32::ShellQuote;
#        return Win32::ShellQuote::quote_system_string(@_);
#    } else {
#        return join(" ", map { shell_quote($_) } @_);
#    }
#}
#
#sub _system_or_readpipe_or_run {
#    my $which = shift;
#    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
#    for (keys %Global_Opts) {
#        $opts->{$_} = $Global_Opts{$_} if !defined($opts->{$_});
#    }
#    my @args = @_;
#
#    my $opt_die = $opts->{die} || $opts->{dies};
#
#    my %save_env;
#    my %set_env;
#    if ($opts->{lang}) {
#        $set_env{LC_ALL}   = $opts->{lang};
#        $set_env{LANGUAGE} = $opts->{lang};
#        $set_env{LANG}     = $opts->{lang};
#    }
#    if ($opts->{env}) {
#        $set_env{$_} = $opts->{env}{$_} for keys %{ $opts->{env} };
#    }
#    if (%set_env) {
#        for (keys %set_env) {
#            $save_env{$_} = $ENV{$_};
#            $ENV{$_} = $set_env{$_};
#        }
#    }
#
#    $log ||= do { require Log::Any::IfLOG; Log::Any::IfLOG->get_logger } if $opts->{log};
#
#    my $wa;
#    my $res;
#    my $exit_code;
#    my $os_error;
#
#    my $code_capture = sub {
#        my $doit = shift;
#
#        if ($opts->{capture}) {
#            die "The 'capture' option has been replaced by 'capture_stdout' & 'capture_stderr', please adjust your code first";
#        }
#
#        if ($opts->{capture_stdout} && $opts->{capture_stderr}) {
#            require Capture::Tiny;
#            (${ $opts->{capture_stdout} }, ${ $opts->{capture_stderr} }) =
#                &Capture::Tiny::capture($doit);
#        } elsif ($opts->{capture_stdout}) {
#            require Capture::Tiny;
#            ${ $opts->{capture_stdout} } =
#                &Capture::Tiny::capture_stdout($doit);
#        } elsif ($opts->{capture_stderr}) {
#            require Capture::Tiny;
#            ${ $opts->{capture_stderr} } =
#                &Capture::Tiny::capture_stderr($doit);
#        } else {
#            $doit->();
#        }
#    };
#
#    if ($which eq 'system') {
#
#        $log->tracef("system(%s), env=%s", \@args, \%set_env) if $opts->{log};
#        my $doit = sub {
#            if ($opts->{shell}) {
#                $res = system _quote(@args);
#            } elsif (defined $opts->{shell}) {
#                $res = system {$args[0]} @args;
#            } else {
#                $res = system @args;
#            }
#            $exit_code = $?;
#            $os_error = $!;
#        };
#        $code_capture->($doit);
#
#    } elsif ($which eq 'readpipe') {
#
#        $wa = wantarray;
#        my $cmd = _quote(@args);
#        $log->tracef("qx(%s), env=%s", $cmd, \%set_env) if $opts->{log};
#        my $doit = sub {
#            if ($wa) {
#                $res = [`$cmd`];
#            } else {
#                $res = `$cmd`;
#            }
#            $exit_code = $?;
#            $os_error = $!;
#        };
#        $code_capture->($doit);
#
#        if ($opts->{log}) {
#            my $res_show;
#            if (defined $opts->{max_log_output}) {
#                $res_show = '';
#                if ($wa) {
#                    for (@$res) {
#                        if (length($res_show) + length($_) >=
#                                $opts->{max_log_output}) {
#                            $res_show .= substr(
#                                $_,0,$opts->{max_log_output}-length($res_show));
#                            last;
#                        } else {
#                            $res_show .= $_;
#                        }
#                    }
#                } else {
#                    if (length($res) > $opts->{max_log_output}) {
#                        $res_show = substr($res, 0, $opts->{max_log_output});
#                    }
#                }
#            }
#            $log->tracef("result of readpipe(): %s (%d bytes)",
#                         defined($res_show) ? $res_show : $res,
#                         defined($res_show) ?
#                             $opts->{max_log_output} : length($res))
#                unless $exit_code;
#        }
#
#    } else {
#
#        $log->tracef("run(%s), env=%s", \@args, \%set_env) if $opts->{log};
#        require IPC::Run;
#        $res = IPC::Run::run(
#            \@args,
#            defined($opts->{stdin}) ? \$opts->{stdin} : \*STDIN,
#            sub {
#                if ($opts->{capture_stdout}) {
#                    ${$opts->{capture_stdout}} .= $_[0];
#                } else {
#                    print $_[0];
#                }
#            }, 
#            sub {
#                if ($opts->{capture_stderr}) {
#                    ${$opts->{capture_stderr}} .= $_[0];
#                } else {
#                    print STDERR $_[0];
#                }
#            }, 
#        );
#        $exit_code = $?;
#        $os_error = $!;
#
#    } 
#
#    if (%save_env) {
#        for (keys %save_env) {
#            if (defined $save_env{$_}) {
#                $ENV{$_} = $save_env{$_};
#            } else {
#                undef $ENV{$_};
#            }
#        }
#    }
#
#    if ($exit_code) {
#        if ($opts->{log} || $opt_die) {
#            my $msg = sprintf(
#                "%s(%s) failed: %d (%s)%s%s",
#                $which,
#                join(" ", @args),
#                $exit_code,
#                explain_child_error($exit_code, $os_error),
#                (ref($opts->{capture_stdout}) ?
#                     ", captured stdout: <<" .
#                     (${$opts->{capture_stdout}} // ''). ">>" : ""),
#                (ref($opts->{capture_stderr}) ?
#                     ", captured stderr: <<" .
#                     (${$opts->{capture_stderr}} // ''). ">>" : ""),
#            );
#            $log->error($msg) if $opts->{log};
#            die $msg if $opt_die;
#        }
#    }
#
#    $? = $exit_code;
#    $! = $os_error;
#
#    return $wa && $which ne 'run' ? @$res : $res;
#}
#
#sub system {
#    _system_or_readpipe_or_run('system', @_);
#}
#
#sub backtick {
#    _system_or_readpipe_or_run('readpipe', @_);
#}
#
#sub readpipe {
#    _system_or_readpipe_or_run('readpipe', @_);
#}
#
#sub run {
#    _system_or_readpipe_or_run('run', @_);
#}
#
#1;
#
#__END__
#
### JSON.pm ###
#package JSON;
#
#
#use strict;
#use Carp ();
#use base qw(Exporter);
#@JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json);
#
#BEGIN {
#    $JSON::VERSION = '2.90';
#    $JSON::DEBUG   = 0 unless (defined $JSON::DEBUG);
#    $JSON::DEBUG   = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG };
#}
#
#my $Module_XS  = 'JSON::XS';
#my $Module_PP  = 'JSON::PP';
#my $Module_bp  = 'JSON::backportPP'; 
#my $PP_Version = '2.27203';
#my $XS_Version = '2.34';
#
#
#
#my @PublicMethods = qw/
#    ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref 
#    allow_blessed convert_blessed filter_json_object filter_json_single_key_object 
#    shrink max_depth max_size encode decode decode_prefix allow_unknown
#/;
#
#my @Properties = qw/
#    ascii latin1 utf8 indent space_before space_after relaxed canonical allow_nonref
#    allow_blessed convert_blessed shrink max_depth max_size allow_unknown
#/;
#
#my @XSOnlyMethods = qw/allow_tags/; 
#
#my @PPOnlyMethods = qw/
#    indent_length sort_by
#    allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed
#/; 
#
#
#my $_INSTALL_DONT_DIE  = 1; 
#my $_INSTALL_ONLY      = 2; 
#my $_ALLOW_UNSUPPORTED = 0;
#my $_UNIV_CONV_BLESSED = 0;
#my $_USSING_bpPP       = 0;
#
#
#
#unless ($JSON::Backend) {
#    $JSON::DEBUG and  Carp::carp("Check used worker module...");
#
#    my $backend = exists $ENV{PERL_JSON_BACKEND} ? $ENV{PERL_JSON_BACKEND} : 1;
#
#    if ($backend eq '1' or $backend =~ /JSON::XS\s*,\s*JSON::PP/) {
#        _load_xs($_INSTALL_DONT_DIE) or _load_pp();
#    }
#    elsif ($backend eq '0' or $backend eq 'JSON::PP') {
#        _load_pp();
#    }
#    elsif ($backend eq '2' or $backend eq 'JSON::XS') {
#        _load_xs();
#    }
#    elsif ($backend eq 'JSON::backportPP') {
#        $_USSING_bpPP = 1;
#        _load_pp();
#    }
#    else {
#        Carp::croak "The value of environmental variable 'PERL_JSON_BACKEND' is invalid.";
#    }
#}
#
#
#sub import {
#    my $pkg = shift;
#    my @what_to_export;
#    my $no_export;
#
#    for my $tag (@_) {
#        if ($tag eq '-support_by_pp') {
#            if (!$_ALLOW_UNSUPPORTED++) {
#                JSON::Backend::XS
#                    ->support_by_pp(@PPOnlyMethods) if ($JSON::Backend eq $Module_XS);
#            }
#            next;
#        }
#        elsif ($tag eq '-no_export') {
#            $no_export++, next;
#        }
#        elsif ( $tag eq '-convert_blessed_universally' ) {
#            eval q|
#                require B;
#                *UNIVERSAL::TO_JSON = sub {
#                    my $b_obj = B::svref_2object( $_[0] );
#                    return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
#                            : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
#                            : undef
#                            ;
#                }
#            | if ( !$_UNIV_CONV_BLESSED++ );
#            next;
#        }
#        push @what_to_export, $tag;
#    }
#
#    return if ($no_export);
#
#    __PACKAGE__->export_to_level(1, $pkg, @what_to_export);
#}
#
#
#
#sub jsonToObj {
#    my $alternative = 'from_json';
#    if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
#        shift @_; $alternative = 'decode';
#    }
#    Carp::carp "'jsonToObj' will be obsoleted. Please use '$alternative' instead.";
#    return JSON::from_json(@_);
#};
#
#sub objToJson {
#    my $alternative = 'to_json';
#    if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
#        shift @_; $alternative = 'encode';
#    }
#    Carp::carp "'objToJson' will be obsoleted. Please use '$alternative' instead.";
#    JSON::to_json(@_);
#};
#
#
#
#sub to_json ($@) {
#    if (
#        ref($_[0]) eq 'JSON'
#        or (@_ > 2 and $_[0] eq 'JSON')
#    ) {
#        Carp::croak "to_json should not be called as a method.";
#    }
#    my $json = JSON->new;
#
#    if (@_ == 2 and ref $_[1] eq 'HASH') {
#        my $opt  = $_[1];
#        for my $method (keys %$opt) {
#            $json->$method( $opt->{$method} );
#        }
#    }
#
#    $json->encode($_[0]);
#}
#
#
#sub from_json ($@) {
#    if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) {
#        Carp::croak "from_json should not be called as a method.";
#    }
#    my $json = JSON->new;
#
#    if (@_ == 2 and ref $_[1] eq 'HASH') {
#        my $opt  = $_[1];
#        for my $method (keys %$opt) {
#            $json->$method( $opt->{$method} );
#        }
#    }
#
#    return $json->decode( $_[0] );
#}
#
#
#
#sub true  { $JSON::true  }
#
#sub false { $JSON::false }
#
#sub null  { undef; }
#
#
#sub require_xs_version { $XS_Version; }
#
#sub backend {
#    my $proto = shift;
#    $JSON::Backend;
#}
#
#
#
#sub is_xs {
#    return $_[0]->backend eq $Module_XS;
#}
#
#
#sub is_pp {
#    return not $_[0]->is_xs;
#}
#
#
#sub pureperl_only_methods { @PPOnlyMethods; }
#
#
#sub property {
#    my ($self, $name, $value) = @_;
#
#    if (@_ == 1) {
#        my %props;
#        for $name (@Properties) {
#            my $method = 'get_' . $name;
#            if ($name eq 'max_size') {
#                my $value = $self->$method();
#                $props{$name} = $value == 1 ? 0 : $value;
#                next;
#            }
#            $props{$name} = $self->$method();
#        }
#        return \%props;
#    }
#    elsif (@_ > 3) {
#        Carp::croak('property() can take only the option within 2 arguments.');
#    }
#    elsif (@_ == 2) {
#        if ( my $method = $self->can('get_' . $name) ) {
#            if ($name eq 'max_size') {
#                my $value = $self->$method();
#                return $value == 1 ? 0 : $value;
#            }
#            $self->$method();
#        }
#    }
#    else {
#        $self->$name($value);
#    }
#
#}
#
#
#
#
#sub _load_xs {
#    my $opt = shift;
#
#    $JSON::DEBUG and Carp::carp "Load $Module_XS.";
#
#    JSON::Boolean::_overrride_overload($Module_XS);
#    JSON::Boolean::_overrride_overload($Module_PP);
#
#    eval qq|
#        use $Module_XS $XS_Version ();
#    |;
#
#    if ($@) {
#        if (defined $opt and $opt & $_INSTALL_DONT_DIE) {
#            $JSON::DEBUG and Carp::carp "Can't load $Module_XS...($@)";
#            return 0;
#        }
#        Carp::croak $@;
#    }
#
#    unless (defined $opt and $opt & $_INSTALL_ONLY) {
#        _set_module( $JSON::Backend = $Module_XS );
#        my $data = join("", <DATA>); 
#        close(DATA);
#        eval $data;
#        JSON::Backend::XS->init;
#    }
#
#    return 1;
#};
#
#
#sub _load_pp {
#    my $opt = shift;
#    my $backend = $_USSING_bpPP ? $Module_bp : $Module_PP;
#
#    $JSON::DEBUG and Carp::carp "Load $backend.";
#
#    JSON::Boolean::_overrride_overload($Module_XS);
#    JSON::Boolean::_overrride_overload($backend);
#
#    if ( $_USSING_bpPP ) {
#        eval qq| require $backend |;
#    }
#    else {
#        eval qq| use $backend $PP_Version () |;
#    }
#
#    if ($@) {
#        if ( $backend eq $Module_PP ) {
#            $JSON::DEBUG and Carp::carp "Can't load $Module_PP ($@), so try to load $Module_bp";
#            $_USSING_bpPP++;
#            $backend = $Module_bp;
#            JSON::Boolean::_overrride_overload($backend);
#            local $^W; 
#            eval qq| require $Module_bp |;
#        }
#        Carp::croak $@ if $@;
#    }
#
#    unless (defined $opt and $opt & $_INSTALL_ONLY) {
#        _set_module( $JSON::Backend = $Module_PP ); 
#        JSON::Backend::PP->init;
#    }
#};
#
#
#sub _set_module {
#    return if defined $JSON::true;
#
#    my $module = shift;
#
#    local $^W;
#    no strict qw(refs);
#
#    $JSON::true  = ${"$module\::true"};
#    $JSON::false = ${"$module\::false"};
#
#    push @JSON::ISA, $module;
#    if ( JSON->is_xs and JSON->backend->VERSION < 3 ) {
#        eval 'package JSON::PP::Boolean';
#        push @{"$module\::Boolean::ISA"}, qw(JSON::PP::Boolean);
#    }
#
#    *{"JSON::is_bool"} = \&{"$module\::is_bool"};
#
#    for my $method ($module eq $Module_XS ? @PPOnlyMethods : @XSOnlyMethods) {
#        *{"JSON::$method"} = sub {
#            Carp::carp("$method is not supported in $module.");
#            $_[0];
#        };
#    }
#
#    return 1;
#}
#
#
#
#
#package JSON::Boolean;
#
#my %Installed;
#
#sub _overrride_overload {
#    return; 
#    return if ($Installed{ $_[0] }++);
#
#    my $boolean = $_[0] . '::Boolean';
#
#    eval sprintf(q|
#        package %s;
#        use overload (
#            '""' => sub { ${$_[0]} == 1 ? 'true' : 'false' },
#            'eq' => sub {
#                my ($obj, $op) = ref ($_[0]) ? ($_[0], $_[1]) : ($_[1], $_[0]);
#                if ($op eq 'true' or $op eq 'false') {
#                    return "$obj" eq 'true' ? 'true' eq $op : 'false' eq $op;
#                }
#                else {
#                    return $obj ? 1 == $op : 0 == $op;
#                }
#            },
#        );
#    |, $boolean);
#
#    if ($@) { Carp::croak $@; }
#
#    if ( exists $INC{'JSON/XS.pm'} and $boolean eq 'JSON::XS::Boolean' ) {
#        local $^W;
#        my $true  = do { bless \(my $dummy = 1), $boolean };
#        my $false = do { bless \(my $dummy = 0), $boolean };
#        *JSON::XS::true  = sub () { $true };
#        *JSON::XS::false = sub () { $false };
#    }
#    elsif ( exists $INC{'JSON/PP.pm'} and $boolean eq 'JSON::PP::Boolean' ) {
#        local $^W;
#        my $true  = do { bless \(my $dummy = 1), $boolean };
#        my $false = do { bless \(my $dummy = 0), $boolean };
#        *JSON::PP::true  = sub { $true };
#        *JSON::PP::false = sub { $false };
#    }
#
#    return 1;
#}
#
#
#
#package JSON::Backend::PP;
#
#sub init {
#    local $^W;
#    no strict qw(refs); 
#    *{"JSON::decode_json"} = \&{"JSON::PP::decode_json"};
#    *{"JSON::encode_json"} = \&{"JSON::PP::encode_json"};
#    *{"JSON::PP::is_xs"}  = sub { 0 };
#    *{"JSON::PP::is_pp"}  = sub { 1 };
#    return 1;
#}
#
#
#package JSON;
#
#1;
#__DATA__
#
#
##
## Helper classes for Backend Module (XS)
##
#
#package JSON::Backend::XS;
#
#use constant INDENT_LENGTH_FLAG => 15 << 12;
#
#use constant UNSUPPORTED_ENCODE_FLAG => {
#    ESCAPE_SLASH      => 0x00000010,
#    ALLOW_BIGNUM      => 0x00000020,
#    AS_NONBLESSED     => 0x00000040,
#    EXPANDED          => 0x10000000, # for developer's
#};
#
#use constant UNSUPPORTED_DECODE_FLAG => {
#    LOOSE             => 0x00000001,
#    ALLOW_BIGNUM      => 0x00000002,
#    ALLOW_BAREKEY     => 0x00000004,
#    ALLOW_SINGLEQUOTE => 0x00000008,
#    EXPANDED          => 0x20000000, # for developer's
#};
#
#
#sub init {
#    local $^W;
#    no strict qw(refs);
#    *{"JSON::decode_json"} = \&{"JSON::XS::decode_json"};
#    *{"JSON::encode_json"} = \&{"JSON::XS::encode_json"};
#    *{"JSON::XS::is_xs"}  = sub { 1 };
#    *{"JSON::XS::is_pp"}  = sub { 0 };
#    return 1;
#}
#
#
#sub support_by_pp {
#    my ($class, @methods) = @_;
#
#    local $^W;
#    no strict qw(refs);
#
#    my $JSON_XS_encode_orignal     = \&JSON::XS::encode;
#    my $JSON_XS_decode_orignal     = \&JSON::XS::decode;
#    my $JSON_XS_incr_parse_orignal = \&JSON::XS::incr_parse;
#
#    *JSON::XS::decode     = \&JSON::Backend::XS::Supportable::_decode;
#    *JSON::XS::encode     = \&JSON::Backend::XS::Supportable::_encode;
#    *JSON::XS::incr_parse = \&JSON::Backend::XS::Supportable::_incr_parse;
#
#    *{JSON::XS::_original_decode}     = $JSON_XS_decode_orignal;
#    *{JSON::XS::_original_encode}     = $JSON_XS_encode_orignal;
#    *{JSON::XS::_original_incr_parse} = $JSON_XS_incr_parse_orignal;
#
#    push @JSON::Backend::XS::Supportable::ISA, 'JSON';
#
#    my $pkg = 'JSON::Backend::XS::Supportable';
#
#    *{JSON::new} = sub {
#        my $proto = JSON::XS->new; $$proto = 0;
#        bless  $proto, $pkg;
#    };
#
#
#    for my $method (@methods) {
#        my $flag = uc($method);
#        my $type |= (UNSUPPORTED_ENCODE_FLAG->{$flag} || 0);
#           $type |= (UNSUPPORTED_DECODE_FLAG->{$flag} || 0);
#
#        next unless($type);
#
#        $pkg->_make_unsupported_method($method => $type);
#    }
#
##    push @{"JSON::XS::Boolean::ISA"}, qw(JSON::PP::Boolean);
##    push @{"JSON::PP::Boolean::ISA"}, qw(JSON::Boolean);
#
#    $JSON::DEBUG and Carp::carp("set -support_by_pp mode.");
#
#    return 1;
#}
#
#
#
#
##
## Helper classes for XS
##
#
#package JSON::Backend::XS::Supportable;
#
#$Carp::Internal{'JSON::Backend::XS::Supportable'} = 1;
#
#sub _make_unsupported_method {
#    my ($pkg, $method, $type) = @_;
#
#    local $^W;
#    no strict qw(refs);
#
#    *{"$pkg\::$method"} = sub {
#        local $^W;
#        if (defined $_[1] ? $_[1] : 1) {
#            ${$_[0]} |= $type;
#        }
#        else {
#            ${$_[0]} &= ~$type;
#        }
#        $_[0];
#    };
#
#    *{"$pkg\::get_$method"} = sub {
#        ${$_[0]} & $type ? 1 : '';
#    };
#
#}
#
#
#sub _set_for_pp {
#    JSON::_load_pp( $_INSTALL_ONLY );
#
#    my $type  = shift;
#    my $pp    = JSON::PP->new;
#    my $prop = $_[0]->property;
#
#    for my $name (keys %$prop) {
#        $pp->$name( $prop->{$name} ? $prop->{$name} : 0 );
#    }
#
#    my $unsupported = $type eq 'encode' ? JSON::Backend::XS::UNSUPPORTED_ENCODE_FLAG
#                                        : JSON::Backend::XS::UNSUPPORTED_DECODE_FLAG;
#    my $flags       = ${$_[0]} || 0;
#
#    for my $name (keys %$unsupported) {
#        next if ($name eq 'EXPANDED'); # for developer's
#        my $enable = ($flags & $unsupported->{$name}) ? 1 : 0;
#        my $method = lc $name;
#        $pp->$method($enable);
#    }
#
#    $pp->indent_length( $_[0]->get_indent_length );
#
#    return $pp;
#}
#
#sub _encode { # using with PP encode
#    if (${$_[0]}) {
#        _set_for_pp('encode' => @_)->encode($_[1]);
#    }
#    else {
#        $_[0]->_original_encode( $_[1] );
#    }
#}
#
#
#sub _decode { # if unsupported-flag is set, use PP
#    if (${$_[0]}) {
#        _set_for_pp('decode' => @_)->decode($_[1]);
#    }
#    else {
#        $_[0]->_original_decode( $_[1] );
#    }
#}
#
#
#sub decode_prefix { # if unsupported-flag is set, use PP
#    _set_for_pp('decode' => @_)->decode_prefix($_[1]);
#}
#
#
#sub _incr_parse {
#    if (${$_[0]}) {
#        _set_for_pp('decode' => @_)->incr_parse($_[1]);
#    }
#    else {
#        $_[0]->_original_incr_parse( $_[1] );
#    }
#}
#
#
#sub get_indent_length {
#    ${$_[0]} << 4 >> 16;
#}
#
#
#sub indent_length {
#    my $length = $_[1];
#
#    if (!defined $length or $length > 15 or $length < 0) {
#        Carp::carp "The acceptable range of indent_length() is 0 to 15.";
#    }
#    else {
#        local $^W;
#        $length <<= 12;
#        ${$_[0]} &= ~ JSON::Backend::XS::INDENT_LENGTH_FLAG;
#        ${$_[0]} |= $length;
#        *JSON::XS::encode = \&JSON::Backend::XS::Supportable::_encode;
#    }
#
#    $_[0];
#}
#
#
#1;
#__END__
#
#=head1 NAME
#
#JSON - JSON (JavaScript Object Notation) encoder/decoder
#
#=head1 SYNOPSIS
#
# use JSON; # imports encode_json, decode_json, to_json and from_json.
# 
# # simple and fast interfaces (expect/generate UTF-8)
# 
# $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
# $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
# 
# # OO-interface
# 
# $json = JSON->new->allow_nonref;
# 
# $json_text   = $json->encode( $perl_scalar );
# $perl_scalar = $json->decode( $json_text );
# 
# $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
# 
# # If you want to use PP only support features, call with '-support_by_pp'
# # When XS unsupported feature is enable, using PP (de|en)code instead of XS ones.
# 
# use JSON -support_by_pp;
# 
# # option-acceptable interfaces (expect/generate UNICODE by default)
# 
# $json_text   = to_json( $perl_scalar, { ascii => 1, pretty => 1 } );
# $perl_scalar = from_json( $json_text, { utf8  => 1 } );
# 
# # Between (en|de)code_json and (to|from)_json, if you want to write
# # a code which communicates to an outer world (encoded in UTF-8),
# # recommend to use (en|de)code_json.
# 
#=head1 VERSION
#
#    2.90
#
#This version is compatible with JSON::XS B<2.34> and later.
#(Not yet compatble to JSON::XS B<3.0x>.)
#
#
#=head1 NOTE
#
#JSON::PP was earlier included in the C<JSON> distribution, but
#has since Perl 5.14 been a core module. For this reason,
#L<JSON::PP> was removed from the JSON distribution and can now
#be found also in the Perl5 repository at
#
#=over
#
#=item * L<http://perl5.git.perl.org/perl.git>
#
#=back
#
#(The newest JSON::PP version still exists in CPAN.)
#
#Instead, the C<JSON> distribution will include JSON::backportPP
#for backwards computability. JSON.pm should thus work as it did
#before.
#
#=head1 DESCRIPTION
#
# *************************** CAUTION **************************************
# *                                                                        *
# * INCOMPATIBLE CHANGE (JSON::XS version 2.90)                            *
# *                                                                        *
# * JSON.pm had patched JSON::XS::Boolean and JSON::PP::Boolean internally *
# * on loading time for making these modules inherit JSON::Boolean.        *
# * But since JSON::XS v3.0 it use Types::Serialiser as boolean class.     *
# * Then now JSON.pm breaks boolean classe overload features and           *
# * -support_by_pp if JSON::XS v3.0 or later is installed.                 *
# *                                                                        *
# * JSON::true and JSON::false returned JSON::Boolean objects.             *
# * For workaround, they return JSON::PP::Boolean objects in this version. *
# *                                                                        *
# *     isa_ok(JSON::true, 'JSON::PP::Boolean');                           *
# *                                                                        *
# * And it discards a feature:                                             *
# *                                                                        *
# *     ok(JSON::true eq 'true');                                          *
# *                                                                        *
# * In other word, JSON::PP::Boolean overload numeric only.                *
# *                                                                        *
# *     ok( JSON::true == 1 );                                             *
# *                                                                        *
# **************************************************************************
#
# ************************** CAUTION ********************************
# * This is 'JSON module version 2' and there are many differences  *
# * to version 1.xx                                                 *
# * Please check your applications using old version.              *
# *   See to 'INCOMPATIBLE CHANGES TO OLD VERSION'                  *
# *******************************************************************
#
#JSON (JavaScript Object Notation) is a simple data format.
#See to L<http://www.json.org/> and C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>).
#
#This module converts Perl data structures to JSON and vice versa using either
#L<JSON::XS> or L<JSON::PP>.
#
#JSON::XS is the fastest and most proper JSON module on CPAN which must be
#compiled and installed in your environment.
#JSON::PP is a pure-Perl module which is bundled in this distribution and
#has a strong compatibility to JSON::XS.
#
#This module try to use JSON::XS by default and fail to it, use JSON::PP instead.
#So its features completely depend on JSON::XS or JSON::PP.
#
#See to L<BACKEND MODULE DECISION>.
#
#To distinguish the module name 'JSON' and the format type JSON,
#the former is quoted by CE<lt>E<gt> (its results vary with your using media),
#and the latter is left just as it is.
#
#Module name : C<JSON>
#
#Format type : JSON
#
#=head2 FEATURES
#
#=over
#
#=item * correct unicode handling
#
#This module (i.e. backend modules) knows how to handle Unicode, documents
#how and when it does so, and even documents what "correct" means.
#
#Even though there are limitations, this feature is available since Perl version 5.6.
#
#JSON::XS requires Perl 5.8.2 (but works correctly in 5.8.8 or later), so in older versions
#C<JSON> should call JSON::PP as the backend which can be used since Perl 5.005.
#
#With Perl 5.8.x JSON::PP works, but from 5.8.0 to 5.8.2, because of a Perl side problem,
#JSON::PP works slower in the versions. And in 5.005, the Unicode handling is not available.
#See to L<JSON::PP/UNICODE HANDLING ON PERLS> for more information.
#
#See also to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>
#and L<JSON::XS/ENCODING/CODESET_FLAG_NOTES>.
#
#
#=item * round-trip integrity
#
#When you serialise a perl data structure using only data types supported
#by JSON and Perl, the deserialised data structure is identical on the Perl
#level. (e.g. the string "2.0" doesn't suddenly become "2" just because
#it looks like a number). There I<are> minor exceptions to this, read the
#L</MAPPING> section below to learn about those.
#
#
#=item * strict checking of JSON correctness
#
#There is no guessing, no generating of illegal JSON texts by default,
#and only JSON is accepted as input by default (the latter is a security
#feature).
#
#See to L<JSON::XS/FEATURES> and L<JSON::PP/FEATURES>.
#
#=item * fast
#
#This module returns a JSON::XS object itself if available.
#Compared to other JSON modules and other serialisers such as Storable,
#JSON::XS usually compares favorably in terms of speed, too.
#
#If not available, C<JSON> returns a JSON::PP object instead of JSON::XS and
#it is very slow as pure-Perl.
#
#=item * simple to use
#
#This module has both a simple functional interface as well as an
#object oriented interface interface.
#
#=item * reasonably versatile output formats
#
#You can choose between the most compact guaranteed-single-line format possible
#(nice for simple line-based protocols), a pure-ASCII format (for when your transport
#is not 8-bit clean, still supports the whole Unicode range), or a pretty-printed
#format (for when you want to read that stuff). Or you can combine those features
#in whatever way you like.
#
#=back
#
#=head1 FUNCTIONAL INTERFACE
#
#Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
#C<to_json> and C<from_json> are additional functions.
#
#=head2 encode_json
#
#    $json_text = encode_json $perl_scalar
#
#Converts the given Perl data structure to a UTF-8 encoded, binary string.
#
#This function call is functionally identical to:
#
#    $json_text = JSON->new->utf8->encode($perl_scalar)
#
#=head2 decode_json
#
#    $perl_scalar = decode_json $json_text
#
#The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
#to parse that as an UTF-8 encoded JSON text, returning the resulting
#reference.
#
#This function call is functionally identical to:
#
#    $perl_scalar = JSON->new->utf8->decode($json_text)
#
#
#=head2 to_json
#
#   $json_text = to_json($perl_scalar)
#
#Converts the given Perl data structure to a json string.
#
#This function call is functionally identical to:
#
#   $json_text = JSON->new->encode($perl_scalar)
#
#Takes a hash reference as the second.
#
#   $json_text = to_json($perl_scalar, $flag_hashref)
#
#So,
#
#   $json_text = to_json($perl_scalar, {utf8 => 1, pretty => 1})
#
#equivalent to:
#
#   $json_text = JSON->new->utf8(1)->pretty(1)->encode($perl_scalar)
#
#If you want to write a modern perl code which communicates to outer world,
#you should use C<encode_json> (supposed that JSON data are encoded in UTF-8).
#
#=head2 from_json
#
#   $perl_scalar = from_json($json_text)
#
#The opposite of C<to_json>: expects a json string and tries
#to parse it, returning the resulting reference.
#
#This function call is functionally identical to:
#
#    $perl_scalar = JSON->decode($json_text)
#
#Takes a hash reference as the second.
#
#    $perl_scalar = from_json($json_text, $flag_hashref)
#
#So,
#
#    $perl_scalar = from_json($json_text, {utf8 => 1})
#
#equivalent to:
#
#    $perl_scalar = JSON->new->utf8(1)->decode($json_text)
#
#If you want to write a modern perl code which communicates to outer world,
#you should use C<decode_json> (supposed that JSON data are encoded in UTF-8).
#
#=head2 JSON::is_bool
#
#    $is_boolean = JSON::is_bool($scalar)
#
#Returns true if the passed scalar represents either JSON::true or
#JSON::false, two constants that act like C<1> and C<0> respectively
#and are also used to represent JSON C<true> and C<false> in Perl strings.
#
#=head2 JSON::true
#
#Returns JSON true value which is blessed object.
#It C<isa> JSON::Boolean object.
#
#=head2 JSON::false
#
#Returns JSON false value which is blessed object.
#It C<isa> JSON::Boolean object.
#
#=head2 JSON::null
#
#Returns C<undef>.
#
#See L<MAPPING>, below, for more information on how JSON values are mapped to
#Perl.
#
#=head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
#
#This section supposes that your perl version is 5.8 or later.
#
#If you know a JSON text from an outer world - a network, a file content, and so on,
#is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
#with C<utf8> enable. And the decoded result will contain UNICODE characters.
#
#  # from network
#  my $json        = JSON->new->utf8;
#  my $json_text   = CGI->new->param( 'json_data' );
#  my $perl_scalar = $json->decode( $json_text );
#  
#  # from file content
#  local $/;
#  open( my $fh, '<', 'json.data' );
#  $json_text   = <$fh>;
#  $perl_scalar = decode_json( $json_text );
#
#If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
#
#  use Encode;
#  local $/;
#  open( my $fh, '<', 'json.data' );
#  my $encoding = 'cp932';
#  my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
#  
#  # or you can write the below code.
#  #
#  # open( my $fh, "<:encoding($encoding)", 'json.data' );
#  # $unicode_json_text = <$fh>;
#
#In this case, C<$unicode_json_text> is of course UNICODE string.
#So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
#Instead of them, you use C<JSON> module object with C<utf8> disable or C<from_json>.
#
#  $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
#  # or
#  $perl_scalar = from_json( $unicode_json_text );
#
#Or C<encode 'utf8'> and C<decode_json>:
#
#  $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
#  # this way is not efficient.
#
#And now, you want to convert your C<$perl_scalar> into JSON data and
#send it to an outer world - a network or a file content, and so on.
#
#Your data usually contains UNICODE strings and you want the converted data to be encoded
#in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
#
#  print encode_json( $perl_scalar ); # to a network? file? or display?
#  # or
#  print $json->utf8->encode( $perl_scalar );
#
#If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
#for some reason, then its characters are regarded as B<latin1> for perl
#(because it does not concern with your $encoding).
#You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
#Instead of them, you use C<JSON> module object with C<utf8> disable or C<to_json>.
#Note that the resulted text is a UNICODE string but no problem to print it.
#
#  # $perl_scalar contains $encoding encoded string values
#  $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
#  # or 
#  $unicode_json_text = to_json( $perl_scalar );
#  # $unicode_json_text consists of characters less than 0x100
#  print $unicode_json_text;
#
#Or C<decode $encoding> all string values and C<encode_json>:
#
#  $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
#  # ... do it to each string values, then encode_json
#  $json_text = encode_json( $perl_scalar );
#
#This method is a proper way but probably not efficient.
#
#See to L<Encode>, L<perluniintro>.
#
#
#=head1 COMMON OBJECT-ORIENTED INTERFACE
#
#=head2 new
#
#    $json = JSON->new
#
#Returns a new C<JSON> object inherited from either JSON::XS or JSON::PP
#that can be used to de/encode JSON strings.
#
#All boolean flags described below are by default I<disabled>.
#
#The mutators for flags all return the JSON object again and thus calls can
#be chained:
#
#   my $json = JSON->new->utf8->space_after->encode({a => [1,2]})
#   => {"a": [1, 2]}
#
#=head2 ascii
#
#    $json = $json->ascii([$enable])
#    
#    $enabled = $json->get_ascii
#
#If $enable is true (or missing), then the encode method will not generate characters outside
#the code range 0..127. Any Unicode characters outside that range will be escaped using either
#a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
#
#If $enable is false, then the encode method will not escape Unicode characters unless
#required by the JSON syntax or other flags. This results in a faster and more compact format.
#
#This feature depends on the used Perl version and environment.
#
#See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
#
#  JSON->new->ascii(1)->encode([chr 0x10401])
#  => ["\ud801\udc01"]
#
#=head2 latin1
#
#    $json = $json->latin1([$enable])
#    
#    $enabled = $json->get_latin1
#
#If $enable is true (or missing), then the encode method will encode the resulting JSON
#text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
#
#If $enable is false, then the encode method will not escape Unicode characters
#unless required by the JSON syntax or other flags.
#
#  JSON->new->latin1->encode (["\x{89}\x{abc}"]
#  => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
#
#=head2 utf8
#
#    $json = $json->utf8([$enable])
#    
#    $enabled = $json->get_utf8
#
#If $enable is true (or missing), then the encode method will encode the JSON result
#into UTF-8, as required by many protocols, while the decode method expects to be handled
#an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
#characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
#
#In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
#encoding families, as described in RFC4627.
#
#If $enable is false, then the encode method will return the JSON string as a (non-encoded)
#Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
#(e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
#
#
#Example, output UTF-16BE-encoded JSON:
#
#  use Encode;
#  $jsontext = encode "UTF-16BE", JSON::XS->new->encode ($object);
#
#Example, decode UTF-32LE-encoded JSON:
#
#  use Encode;
#  $object = JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
#
#See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
#
#
#=head2 pretty
#
#    $json = $json->pretty([$enable])
#
#This enables (or disables) all of the C<indent>, C<space_before> and
#C<space_after> (and in the future possibly more) flags in one call to
#generate the most readable (or most compact) form possible.
#
#Equivalent to:
#
#   $json->indent->space_before->space_after
#
#The indent space length is three and JSON::XS cannot change the indent
#space length.
#
#=head2 indent
#
#    $json = $json->indent([$enable])
#    
#    $enabled = $json->get_indent
#
#If C<$enable> is true (or missing), then the C<encode> method will use a multiline
#format as output, putting every array member or object/hash key-value pair
#into its own line, identifying them properly.
#
#If C<$enable> is false, no newlines or indenting will be produced, and the
#resulting JSON text is guaranteed not to contain any C<newlines>.
#
#This setting has no effect when decoding JSON texts.
#
#The indent space length is three.
#With JSON::PP, you can also access C<indent_length> to change indent space length.
#
#
#=head2 space_before
#
#    $json = $json->space_before([$enable])
#    
#    $enabled = $json->get_space_before
#
#If C<$enable> is true (or missing), then the C<encode> method will add an extra
#optional space before the C<:> separating keys from values in JSON objects.
#
#If C<$enable> is false, then the C<encode> method will not add any extra
#space at those places.
#
#This setting has no effect when decoding JSON texts.
#
#Example, space_before enabled, space_after and indent disabled:
#
#   {"key" :"value"}
#
#
#=head2 space_after
#
#    $json = $json->space_after([$enable])
#    
#    $enabled = $json->get_space_after
#
#If C<$enable> is true (or missing), then the C<encode> method will add an extra
#optional space after the C<:> separating keys from values in JSON objects
#and extra whitespace after the C<,> separating key-value pairs and array
#members.
#
#If C<$enable> is false, then the C<encode> method will not add any extra
#space at those places.
#
#This setting has no effect when decoding JSON texts.
#
#Example, space_before and indent disabled, space_after enabled:
#
#   {"key": "value"}
#
#
#=head2 relaxed
#
#    $json = $json->relaxed([$enable])
#    
#    $enabled = $json->get_relaxed
#
#If C<$enable> is true (or missing), then C<decode> will accept some
#extensions to normal JSON syntax (see below). C<encode> will not be
#affected in anyway. I<Be aware that this option makes you accept invalid
#JSON texts as if they were valid!>. I suggest only to use this option to
#parse application-specific files written by humans (configuration files,
#resource files etc.)
#
#If C<$enable> is false (the default), then C<decode> will only accept
#valid JSON texts.
#
#Currently accepted extensions are:
#
#=over 4
#
#=item * list items can have an end-comma
#
#JSON I<separates> array elements and key-value pairs with commas. This
#can be annoying if you write JSON texts manually and want to be able to
#quickly append elements, so this extension accepts comma at the end of
#such items not just between them:
#
#   [
#      1,
#      2, <- this comma not normally allowed
#   ]
#   {
#      "k1": "v1",
#      "k2": "v2", <- this comma not normally allowed
#   }
#
#=item * shell-style '#'-comments
#
#Whenever JSON allows whitespace, shell-style comments are additionally
#allowed. They are terminated by the first carriage-return or line-feed
#character, after which more white-space and comments are allowed.
#
#  [
#     1, # this comment not allowed in JSON
#        # neither this one...
#  ]
#
#=back
#
#
#=head2 canonical
#
#    $json = $json->canonical([$enable])
#    
#    $enabled = $json->get_canonical
#
#If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
#by sorting their keys. This is adding a comparatively high overhead.
#
#If C<$enable> is false, then the C<encode> method will output key-value
#pairs in the order Perl stores them (which will likely change between runs
#of the same script).
#
#This option is useful if you want the same data structure to be encoded as
#the same JSON text (given the same overall settings). If it is disabled,
#the same hash might be encoded differently even if contains the same data,
#as key-value pairs have no inherent ordering in Perl.
#
#This setting has no effect when decoding JSON texts.
#
#=head2 allow_nonref
#
#    $json = $json->allow_nonref([$enable])
#    
#    $enabled = $json->get_allow_nonref
#
#If C<$enable> is true (or missing), then the C<encode> method can convert a
#non-reference into its corresponding string, number or null JSON value,
#which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
#values instead of croaking.
#
#If C<$enable> is false, then the C<encode> method will croak if it isn't
#passed an arrayref or hashref, as JSON texts must either be an object
#or array. Likewise, C<decode> will croak if given something that is not a
#JSON object or array.
#
#   JSON->new->allow_nonref->encode ("Hello, World!")
#   => "Hello, World!"
#
#=head2 allow_unknown
#
#    $json = $json->allow_unknown ([$enable])
#    
#    $enabled = $json->get_allow_unknown
#
#If $enable is true (or missing), then "encode" will *not* throw an
#exception when it encounters values it cannot represent in JSON (for
#example, filehandles) but instead will encode a JSON "null" value.
#Note that blessed objects are not included here and are handled
#separately by c<allow_nonref>.
#
#If $enable is false (the default), then "encode" will throw an
#exception when it encounters anything it cannot encode as JSON.
#
#This option does not affect "decode" in any way, and it is
#recommended to leave it off unless you know your communications
#partner.
#
#=head2 allow_blessed
#
#    $json = $json->allow_blessed([$enable])
#    
#    $enabled = $json->get_allow_blessed
#
#If C<$enable> is true (or missing), then the C<encode> method will not
#barf when it encounters a blessed reference. Instead, the value of the
#B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
#disabled or no C<TO_JSON> method found) or a representation of the
#object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
#encoded. Has no effect on C<decode>.
#
#If C<$enable> is false (the default), then C<encode> will throw an
#exception when it encounters a blessed object.
#
#
#=head2 convert_blessed
#
#    $json = $json->convert_blessed([$enable])
#    
#    $enabled = $json->get_convert_blessed
#
#If C<$enable> is true (or missing), then C<encode>, upon encountering a
#blessed object, will check for the availability of the C<TO_JSON> method
#on the object's class. If found, it will be called in scalar context
#and the resulting scalar will be encoded instead of the object. If no
#C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
#to do.
#
#The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
#returns other blessed objects, those will be handled in the same
#way. C<TO_JSON> must take care of not causing an endless recursion cycle
#(== crash) in this case. The name of C<TO_JSON> was chosen because other
#methods called by the Perl core (== not by the user of the object) are
#usually in upper case letters and to avoid collisions with the C<to_json>
#function or method.
#
#This setting does not yet influence C<decode> in any way.
#
#If C<$enable> is false, then the C<allow_blessed> setting will decide what
#to do when a blessed object is found.
#
#=over
#
#=item convert_blessed_universally mode
#
#If use C<JSON> with C<-convert_blessed_universally>, the C<UNIVERSAL::TO_JSON>
#subroutine is defined as the below code:
#
#   *UNIVERSAL::TO_JSON = sub {
#       my $b_obj = B::svref_2object( $_[0] );
#       return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
#               : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
#               : undef
#               ;
#   }
#
#This will cause that C<encode> method converts simple blessed objects into
#JSON objects as non-blessed object.
#
#   JSON -convert_blessed_universally;
#   $json->allow_blessed->convert_blessed->encode( $blessed_object )
#
#This feature is experimental and may be removed in the future.
#
#=back
#
#=head2 filter_json_object
#
#    $json = $json->filter_json_object([$coderef])
#
#When C<$coderef> is specified, it will be called from C<decode> each
#time it decodes a JSON object. The only argument passed to the coderef
#is a reference to the newly-created hash. If the code references returns
#a single scalar (which need not be a reference), this value
#(i.e. a copy of that scalar to avoid aliasing) is inserted into the
#deserialised data structure. If it returns an empty list
#(NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
#hash will be inserted. This setting can slow down decoding considerably.
#
#When C<$coderef> is omitted or undefined, any existing callback will
#be removed and C<decode> will not change the deserialised hash in any
#way.
#
#Example, convert all JSON objects into the integer 5:
#
#   my $js = JSON->new->filter_json_object (sub { 5 });
#   # returns [5]
#   $js->decode ('[{}]'); # the given subroutine takes a hash reference.
#   # throw an exception because allow_nonref is not enabled
#   # so a lone 5 is not allowed.
#   $js->decode ('{"a":1, "b":2}');
#
#
#=head2 filter_json_single_key_object
#
#    $json = $json->filter_json_single_key_object($key [=> $coderef])
#
#Works remotely similar to C<filter_json_object>, but is only called for
#JSON objects having a single key named C<$key>.
#
#This C<$coderef> is called before the one specified via
#C<filter_json_object>, if any. It gets passed the single value in the JSON
#object. If it returns a single value, it will be inserted into the data
#structure. If it returns nothing (not even C<undef> but the empty list),
#the callback from C<filter_json_object> will be called next, as if no
#single-key callback were specified.
#
#If C<$coderef> is omitted or undefined, the corresponding callback will be
#disabled. There can only ever be one callback for a given key.
#
#As this callback gets called less often then the C<filter_json_object>
#one, decoding speed will not usually suffer as much. Therefore, single-key
#objects make excellent targets to serialise Perl objects into, especially
#as single-key JSON objects are as close to the type-tagged value concept
#as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
#support this in any way, so you need to make sure your data never looks
#like a serialised Perl hash.
#
#Typical names for the single object key are C<__class_whatever__>, or
#C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
#things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
#with real hashes.
#
#Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
#into the corresponding C<< $WIDGET{<id>} >> object:
#
#   # return whatever is in $WIDGET{5}:
#   JSON
#      ->new
#      ->filter_json_single_key_object (__widget__ => sub {
#            $WIDGET{ $_[0] }
#         })
#      ->decode ('{"__widget__": 5')
#
#   # this can be used with a TO_JSON method in some "widget" class
#   # for serialisation to json:
#   sub WidgetBase::TO_JSON {
#      my ($self) = @_;
#
#      unless ($self->{id}) {
#         $self->{id} = ..get..some..id..;
#         $WIDGET{$self->{id}} = $self;
#      }
#
#      { __widget__ => $self->{id} }
#   }
#
#
#=head2 shrink
#
#    $json = $json->shrink([$enable])
#    
#    $enabled = $json->get_shrink
#
#With JSON::XS, this flag resizes strings generated by either
#C<encode> or C<decode> to their minimum size possible. This can save
#memory when your JSON texts are either very very long or you have many
#short strings. It will also try to downgrade any strings to octet-form
#if possible: perl stores strings internally either in an encoding called
#UTF-X or in octet-form. The latter cannot store everything but uses less
#space in general (and some buggy Perl or C code might even rely on that
#internal representation being used).
#
#With JSON::PP, it is noop about resizing strings but tries
#C<utf8::downgrade> to the returned string by C<encode>. See to L<utf8>.
#
#See to L<JSON::XS/OBJECT-ORIENTED INTERFACE> and L<JSON::PP/METHODS>.
#
#=head2 max_depth
#
#    $json = $json->max_depth([$maximum_nesting_depth])
#    
#    $max_depth = $json->get_max_depth
#
#Sets the maximum nesting level (default C<512>) accepted while encoding
#or decoding. If a higher nesting level is detected in JSON text or a Perl
#data structure, then the encoder and decoder will stop and croak at that
#point.
#
#Nesting level is defined by number of hash- or arrayrefs that the encoder
#needs to traverse to reach a given point or the number of C<{> or C<[>
#characters without their matching closing parenthesis crossed to reach a
#given character in a string.
#
#If no argument is given, the highest possible setting will be used, which
#is rarely useful.
#
#Note that nesting is implemented by recursion in C. The default value has
#been chosen to be as large as typical operating systems allow without
#crashing. (JSON::XS)
#
#With JSON::PP as the backend, when a large value (100 or more) was set and
#it de/encodes a deep nested object/text, it may raise a warning
#'Deep recursion on subroutine' at the perl runtime phase.
#
#See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
#
#=head2 max_size
#
#    $json = $json->max_size([$maximum_string_size])
#    
#    $max_size = $json->get_max_size
#
#Set the maximum length a JSON text may have (in bytes) where decoding is
#being attempted. The default is C<0>, meaning no limit. When C<decode>
#is called on a string that is longer then this many bytes, it will not
#attempt to decode the string but throw an exception. This setting has no
#effect on C<encode> (yet).
#
#If no argument is given, the limit check will be deactivated (same as when
#C<0> is specified).
#
#See L<JSON::XS/SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
#
#=head2 encode
#
#    $json_text = $json->encode($perl_scalar)
#
#Converts the given Perl data structure (a simple scalar or a reference
#to a hash or array) to its JSON representation. Simple scalars will be
#converted into JSON string or number sequences, while references to arrays
#become JSON arrays and references to hashes become JSON objects. Undefined
#Perl values (e.g. C<undef>) become JSON C<null> values.
#References to the integers C<0> and C<1> are converted into C<true> and C<false>.
#
#=head2 decode
#
#    $perl_scalar = $json->decode($json_text)
#
#The opposite of C<encode>: expects a JSON text and tries to parse it,
#returning the resulting simple scalar or reference. Croaks on error.
#
#JSON numbers and strings become simple Perl scalars. JSON arrays become
#Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
#C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
#C<null> becomes C<undef>.
#
#=head2 decode_prefix
#
#    ($perl_scalar, $characters) = $json->decode_prefix($json_text)
#
#This works like the C<decode> method, but instead of raising an exception
#when there is trailing garbage after the first JSON object, it will
#silently stop parsing there and return the number of characters consumed
#so far.
#
#   JSON->new->decode_prefix ("[1] the tail")
#   => ([], 3)
#
#See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
#
#=head2 property
#
#    $boolean = $json->property($property_name)
#
#Returns a boolean value about above some properties.
#
#The available properties are C<ascii>, C<latin1>, C<utf8>,
#C<indent>,C<space_before>, C<space_after>, C<relaxed>, C<canonical>,
#C<allow_nonref>, C<allow_unknown>, C<allow_blessed>, C<convert_blessed>,
#C<shrink>, C<max_depth> and C<max_size>.
#
#   $boolean = $json->property('utf8');
#    => 0
#   $json->utf8;
#   $boolean = $json->property('utf8');
#    => 1
#
#Sets the property with a given boolean value.
#
#    $json = $json->property($property_name => $boolean);
#
#With no argument, it returns all the above properties as a hash reference.
#
#    $flag_hashref = $json->property();
#
#=head1 INCREMENTAL PARSING
#
#Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
#
#In some cases, there is the need for incremental parsing of JSON texts.
#This module does allow you to parse a JSON stream incrementally.
#It does so by accumulating text until it has a full JSON object, which
#it then can decode. This process is similar to using C<decode_prefix>
#to see if a full JSON object is available, but is much more efficient
#(and can be implemented with a minimum of method calls).
#
#The backend module will only attempt to parse the JSON text once it is sure it
#has enough text to get a decisive result, using a very simple but
#truly incremental parser. This means that it sometimes won't stop as
#early as the full parser, for example, it doesn't detect parenthesis
#mismatches. The only thing it guarantees is that it starts decoding as
#soon as a syntactically valid JSON text has been seen. This means you need
#to set resource limits (e.g. C<max_size>) to ensure the parser will stop
#parsing in the presence if syntax errors.
#
#The following methods implement this incremental parser.
#
#=head2 incr_parse
#
#    $json->incr_parse( [$string] ) # void context
#    
#    $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
#    
#    @obj_or_empty = $json->incr_parse( [$string] ) # list context
#
#This is the central parsing function. It can both append new text and
#extract objects from the stream accumulated so far (both of these
#functions are optional).
#
#If C<$string> is given, then this string is appended to the already
#existing JSON fragment stored in the C<$json> object.
#
#After that, if the function is called in void context, it will simply
#return without doing anything further. This can be used to add more text
#in as many chunks as you want.
#
#If the method is called in scalar context, then it will try to extract
#exactly I<one> JSON object. If that is successful, it will return this
#object, otherwise it will return C<undef>. If there is a parse error,
#this method will croak just as C<decode> would do (one can then use
#C<incr_skip> to skip the erroneous part). This is the most common way of
#using the method.
#
#And finally, in list context, it will try to extract as many objects
#from the stream as it can find and return them, or the empty list
#otherwise. For this to work, there must be no separators between the JSON
#objects or arrays, instead they must be concatenated back-to-back. If
#an error occurs, an exception will be raised as in the scalar context
#case. Note that in this case, any previously-parsed JSON texts will be
#lost.
#
#Example: Parse some JSON arrays/objects in a given string and return them.
#
#    my @objs = JSON->new->incr_parse ("[5][7][1,2]");
#
#=head2 incr_text
#
#    $lvalue_string = $json->incr_text
#
#This method returns the currently stored JSON fragment as an lvalue, that
#is, you can manipulate it. This I<only> works when a preceding call to
#C<incr_parse> in I<scalar context> successfully returned an object. Under
#all other circumstances you must not call this function (I mean it.
#although in simple tests it might actually work, it I<will> fail under
#real world conditions). As a special exception, you can also call this
#method before having parsed anything.
#
#This function is useful in two cases: a) finding the trailing text after a
#JSON object or b) parsing multiple JSON objects separated by non-JSON text
#(such as commas).
#
#    $json->incr_text =~ s/\s*,\s*//;
#
#In Perl 5.005, C<lvalue> attribute is not available.
#You must write codes like the below:
#
#    $string = $json->incr_text;
#    $string =~ s/\s*,\s*//;
#    $json->incr_text( $string );
#
#=head2 incr_skip
#
#    $json->incr_skip
#
#This will reset the state of the incremental parser and will remove the
#parsed text from the input buffer. This is useful after C<incr_parse>
#died, in which case the input buffer and incremental parser state is left
#unchanged, to skip the text parsed so far and to reset the parse state.
#
#=head2 incr_reset
#
#    $json->incr_reset
#
#This completely resets the incremental parser, that is, after this call,
#it will be as if the parser had never parsed anything.
#
#This is useful if you want to repeatedly parse JSON objects and want to
#ignore any trailing data, which means you have to reset the parser after
#each successful decode.
#
#See to L<JSON::XS/INCREMENTAL PARSING> for examples.
#
#
#=head1 JSON::PP SUPPORT METHODS
#
#The below methods are JSON::PP own methods, so when C<JSON> works
#with JSON::PP (i.e. the created object is a JSON::PP object), available.
#See to L<JSON::PP/JSON::PP OWN METHODS> in detail.
#
#If you use C<JSON> with additional C<-support_by_pp>, some methods
#are available even with JSON::XS. See to L<USE PP FEATURES EVEN THOUGH XS BACKEND>.
#
#   BEING { $ENV{PERL_JSON_BACKEND} = 'JSON::XS' }
#   
#   use JSON -support_by_pp;
#   
#   my $json = JSON->new;
#   $json->allow_nonref->escape_slash->encode("/");
#
#   # functional interfaces too.
#   print to_json(["/"], {escape_slash => 1});
#   print from_json('["foo"]', {utf8 => 1});
#
#If you do not want to all functions but C<-support_by_pp>,
#use C<-no_export>.
#
#   use JSON -support_by_pp, -no_export;
#   # functional interfaces are not exported.
#
#=head2 allow_singlequote
#
#    $json = $json->allow_singlequote([$enable])
#
#If C<$enable> is true (or missing), then C<decode> will accept
#any JSON strings quoted by single quotations that are invalid JSON
#format.
#
#    $json->allow_singlequote->decode({"foo":'bar'});
#    $json->allow_singlequote->decode({'foo':"bar"});
#    $json->allow_singlequote->decode({'foo':'bar'});
#
#As same as the C<relaxed> option, this option may be used to parse
#application-specific files written by humans.
#
#=head2 allow_barekey
#
#    $json = $json->allow_barekey([$enable])
#
#If C<$enable> is true (or missing), then C<decode> will accept
#bare keys of JSON object that are invalid JSON format.
#
#As same as the C<relaxed> option, this option may be used to parse
#application-specific files written by humans.
#
#    $json->allow_barekey->decode('{foo:"bar"}');
#
#=head2 allow_bignum
#
#    $json = $json->allow_bignum([$enable])
#
#If C<$enable> is true (or missing), then C<decode> will convert
#the big integer Perl cannot handle as integer into a L<Math::BigInt>
#object and convert a floating number (any) into a L<Math::BigFloat>.
#
#On the contrary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
#objects into JSON numbers with C<allow_blessed> enable.
#
#   $json->allow_nonref->allow_blessed->allow_bignum;
#   $bigfloat = $json->decode('2.000000000000000000000000001');
#   print $json->encode($bigfloat);
#   # => 2.000000000000000000000000001
#
#See to L<MAPPING> about the conversion of JSON number.
#
#=head2 loose
#
#    $json = $json->loose([$enable])
#
#The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
#and the module doesn't allow to C<decode> to these (except for \x2f).
#If C<$enable> is true (or missing), then C<decode>  will accept these
#unescaped strings.
#
#    $json->loose->decode(qq|["abc
#                                   def"]|);
#
#See to L<JSON::PP/JSON::PP OWN METHODS>.
#
#=head2 escape_slash
#
#    $json = $json->escape_slash([$enable])
#
#According to JSON Grammar, I<slash> (U+002F) is escaped. But by default
#JSON backend modules encode strings without escaping slash.
#
#If C<$enable> is true (or missing), then C<encode> will escape slashes.
#
#=head2 indent_length
#
#    $json = $json->indent_length($length)
#
#With JSON::XS, The indent space length is 3 and cannot be changed.
#With JSON::PP, it sets the indent space length with the given $length.
#The default is 3. The acceptable range is 0 to 15.
#
#=head2 sort_by
#
#    $json = $json->sort_by($function_name)
#    $json = $json->sort_by($subroutine_ref)
#
#If $function_name or $subroutine_ref are set, its sort routine are used.
#
#   $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
#   # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
#
#   $js = $pc->sort_by('own_sort')->encode($obj);
#   # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
#
#   sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
#
#As the sorting routine runs in the JSON::PP scope, the given
#subroutine name and the special variables C<$a>, C<$b> will begin
#with 'JSON::PP::'.
#
#If $integer is set, then the effect is same as C<canonical> on.
#
#See to L<JSON::PP/JSON::PP OWN METHODS>.
#
#=head1 MAPPING
#
#This section is copied from JSON::XS and modified to C<JSON>.
#JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
#
#See to L<JSON::XS/MAPPING>.
#
#=head2 JSON -> PERL
#
#=over 4
#
#=item object
#
#A JSON object becomes a reference to a hash in Perl. No ordering of object
#keys is preserved (JSON does not preserver object key ordering itself).
#
#=item array
#
#A JSON array becomes a reference to an array in Perl.
#
#=item string
#
#A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
#are represented by the same codepoints in the Perl string, so no manual
#decoding is necessary.
#
#=item number
#
#A JSON number becomes either an integer, numeric (floating point) or
#string scalar in perl, depending on its range and any fractional parts. On
#the Perl level, there is no difference between those as Perl handles all
#the conversion details, but an integer may take slightly less memory and
#might represent more values exactly than floating point numbers.
#
#If the number consists of digits only, C<JSON> will try to represent
#it as an integer value. If that fails, it will try to represent it as
#a numeric (floating point) value if that is possible without loss of
#precision. Otherwise it will preserve the number as a string value (in
#which case you lose roundtripping ability, as the JSON number will be
#re-encoded to a JSON string).
#
#Numbers containing a fractional or exponential part will always be
#represented as numeric (floating point) values, possibly at a loss of
#precision (in which case you might lose perfect roundtripping ability, but
#the JSON number will still be re-encoded as a JSON number).
#
#Note that precision is not accuracy - binary floating point values cannot
#represent most decimal fractions exactly, and when converting from and to
#floating point, C<JSON> only guarantees precision up to but not including
#the least significant bit.
#
#If the backend is JSON::PP and C<allow_bignum> is enable, the big integers 
#and the numeric can be optionally converted into L<Math::BigInt> and
#L<Math::BigFloat> objects.
#
#=item true, false
#
#These JSON atoms become C<JSON::true> and C<JSON::false>,
#respectively. They are overloaded to act almost exactly like the numbers
#C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
#the C<JSON::is_bool> function.
#
#   print JSON::true + 1;
#    => 1
#
#   ok(JSON::true eq  '1');
#   ok(JSON::true == 1);
#
#C<JSON> will install these missing overloading features to the backend modules.
#
#
#=item null
#
#A JSON null atom becomes C<undef> in Perl.
#
#C<JSON::null> returns C<undef>.
#
#=back
#
#
#=head2 PERL -> JSON
#
#The mapping from Perl to JSON is slightly more difficult, as Perl is a
#truly typeless language, so we can only guess which JSON type is meant by
#a Perl value.
#
#=over 4
#
#=item hash references
#
#Perl hash references become JSON objects. As there is no inherent ordering
#in hash keys (or JSON objects), they will usually be encoded in a
#pseudo-random order that can change between runs of the same program but
#stays generally the same within a single run of a program. C<JSON>
#optionally sort the hash keys (determined by the I<canonical> flag), so
#the same data structure will serialise to the same JSON text (given same
#settings and version of JSON::XS), but this incurs a runtime overhead
#and is only rarely useful, e.g. when you want to compare some JSON text
#against another for equality.
#
#In future, the ordered object feature will be added to JSON::PP using C<tie> mechanism.
#
#
#=item array references
#
#Perl array references become JSON arrays.
#
#=item other references
#
#Other unblessed references are generally not allowed and will cause an
#exception to be thrown, except for references to the integers C<0> and
#C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
#also use C<JSON::false> and C<JSON::true> to improve readability.
#
#   to_json [\0,JSON::true]      # yields [false,true]
#
#=item JSON::true, JSON::false, JSON::null
#
#These special values become JSON true and JSON false values,
#respectively. You can also use C<\1> and C<\0> directly if you want.
#
#JSON::null returns C<undef>.
#
#=item blessed objects
#
#Blessed objects are not directly representable in JSON. See the
#C<allow_blessed> and C<convert_blessed> methods on various options on
#how to deal with this: basically, you can choose between throwing an
#exception, encoding the reference as if it weren't blessed, or provide
#your own serialiser method.
#
#With C<convert_blessed_universally> mode,  C<encode> converts blessed
#hash references or blessed array references (contains other blessed references)
#into JSON members and arrays.
#
#   use JSON -convert_blessed_universally;
#   JSON->new->allow_blessed->convert_blessed->encode( $blessed_object );
#
#See to L<convert_blessed>.
#
#=item simple scalars
#
#Simple Perl scalars (any scalar that is not a reference) are the most
#difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
#JSON C<null> values, scalars that have last been used in a string context
#before encoding as JSON strings, and anything else as number value:
#
#   # dump as number
#   encode_json [2]                      # yields [2]
#   encode_json [-3.0e17]                # yields [-3e+17]
#   my $value = 5; encode_json [$value]  # yields [5]
#
#   # used as string, so dump as string
#   print $value;
#   encode_json [$value]                 # yields ["5"]
#
#   # undef becomes null
#   encode_json [undef]                  # yields [null]
#
#You can force the type to be a string by stringifying it:
#
#   my $x = 3.1; # some variable containing a number
#   "$x";        # stringified
#   $x .= "";    # another, more awkward way to stringify
#   print $x;    # perl does it for you, too, quite often
#
#You can force the type to be a number by numifying it:
#
#   my $x = "3"; # some variable containing a string
#   $x += 0;     # numify it, ensuring it will be dumped as a number
#   $x *= 1;     # same thing, the choice is yours.
#
#You can not currently force the type in other, less obscure, ways.
#
#Note that numerical precision has the same meaning as under Perl (so
#binary to decimal conversion follows the same rules as in Perl, which
#can differ to other languages). Also, your perl interpreter might expose
#extensions to the floating point numbers of your platform, such as
#infinities or NaN's - these cannot be represented in JSON, and it is an
#error to pass those in.
#
#=item Big Number
#
#If the backend is JSON::PP and C<allow_bignum> is enable, 
#C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
#objects into JSON numbers.
#
#
#=back
#
#=head1 JSON and ECMAscript
#
#See to L<JSON::XS/JSON and ECMAscript>.
#
#=head1 JSON and YAML
#
#JSON is not a subset of YAML.
#See to L<JSON::XS/JSON and YAML>.
#
#
#=head1 BACKEND MODULE DECISION
#
#When you use C<JSON>, C<JSON> tries to C<use> JSON::XS. If this call failed, it will
#C<uses> JSON::PP. The required JSON::XS version is I<2.2> or later.
#
#The C<JSON> constructor method returns an object inherited from the backend module,
#and JSON::XS object is a blessed scalar reference while JSON::PP is a blessed hash
#reference.
#
#So, your program should not depend on the backend module, especially
#returned objects should not be modified.
#
# my $json = JSON->new; # XS or PP?
# $json->{stash} = 'this is xs object'; # this code may raise an error!
#
#To check the backend module, there are some methods - C<backend>, C<is_pp> and C<is_xs>.
#
#  JSON->backend; # 'JSON::XS' or 'JSON::PP'
#  
#  JSON->backend->is_pp: # 0 or 1
#  
#  JSON->backend->is_xs: # 1 or 0
#  
#  $json->is_xs; # 1 or 0
#  
#  $json->is_pp; # 0 or 1
#
#
#If you set an environment variable C<PERL_JSON_BACKEND>, the calling action will be changed.
#
#=over
#
#=item PERL_JSON_BACKEND = 0 or PERL_JSON_BACKEND = 'JSON::PP'
#
#Always use JSON::PP
#
#=item PERL_JSON_BACKEND == 1 or PERL_JSON_BACKEND = 'JSON::XS,JSON::PP'
#
#(The default) Use compiled JSON::XS if it is properly compiled & installed,
#otherwise use JSON::PP.
#
#=item PERL_JSON_BACKEND == 2 or PERL_JSON_BACKEND = 'JSON::XS'
#
#Always use compiled JSON::XS, die if it isn't properly compiled & installed.
#
#=item PERL_JSON_BACKEND = 'JSON::backportPP'
#
#Always use JSON::backportPP.
#JSON::backportPP is JSON::PP back port module.
#C<JSON> includes JSON::backportPP instead of JSON::PP.
#
#=back
#
#These ideas come from L<DBI::PurePerl> mechanism.
#
#example:
#
# BEGIN { $ENV{PERL_JSON_BACKEND} = 'JSON::PP' }
# use JSON; # always uses JSON::PP
#
#In future, it may be able to specify another module.
#
#=head1 USE PP FEATURES EVEN THOUGH XS BACKEND
#
#Many methods are available with either JSON::XS or JSON::PP and
#when the backend module is JSON::XS, if any JSON::PP specific (i.e. JSON::XS unsupported)
#method is called, it will C<warn> and be noop.
#
#But If you C<use> C<JSON> passing the optional string C<-support_by_pp>,
#it makes a part of those unsupported methods available.
#This feature is achieved by using JSON::PP in C<de/encode>.
#
#   BEGIN { $ENV{PERL_JSON_BACKEND} = 2 } # with JSON::XS
#   use JSON -support_by_pp;
#   my $json = JSON->new;
#   $json->allow_nonref->escape_slash->encode("/");
#
#At this time, the returned object is a C<JSON::Backend::XS::Supportable>
#object (re-blessed XS object), and  by checking JSON::XS unsupported flags
#in de/encoding, can support some unsupported methods - C<loose>, C<allow_bignum>,
#C<allow_barekey>, C<allow_singlequote>, C<escape_slash> and C<indent_length>.
#
#When any unsupported methods are not enable, C<XS de/encode> will be
#used as is. The switch is achieved by changing the symbolic tables.
#
#C<-support_by_pp> is effective only when the backend module is JSON::XS
#and it makes the de/encoding speed down a bit.
#
#See to L<JSON::PP SUPPORT METHODS>.
#
#=head1 INCOMPATIBLE CHANGES TO OLD VERSION
#
#There are big incompatibility between new version (2.00) and old (1.xx).
#If you use old C<JSON> 1.xx in your code, please check it.
#
#See to L<Transition ways from 1.xx to 2.xx.>
#
#=over
#
#=item jsonToObj and objToJson are obsoleted.
#
#Non Perl-style name C<jsonToObj> and C<objToJson> are obsoleted
#(but not yet deleted from the source).
#If you use these functions in your code, please replace them
#with C<from_json> and C<to_json>.
#
#
#=item Global variables are no longer available.
#
#C<JSON> class variables - C<$JSON::AUTOCONVERT>, C<$JSON::BareKey>, etc...
#- are not available any longer.
#Instead, various features can be used through object methods.
#
#
#=item Package JSON::Converter and JSON::Parser are deleted.
#
#Now C<JSON> bundles with JSON::PP which can handle JSON more properly than them.
#
#=item Package JSON::NotString is deleted.
#
#There was C<JSON::NotString> class which represents JSON value C<true>, C<false>, C<null>
#and numbers. It was deleted and replaced by C<JSON::Boolean>.
#
#C<JSON::Boolean> represents C<true> and C<false>.
#
#C<JSON::Boolean> does not represent C<null>.
#
#C<JSON::null> returns C<undef>.
#
#C<JSON> makes L<JSON::XS::Boolean> and L<JSON::PP::Boolean> is-a relation
#to L<JSON::Boolean>.
#
#=item function JSON::Number is obsoleted.
#
#C<JSON::Number> is now needless because JSON::XS and JSON::PP have
#round-trip integrity.
#
#=item JSONRPC modules are deleted.
#
#Perl implementation of JSON-RPC protocol - C<JSONRPC >, C<JSONRPC::Transport::HTTP>
#and C<Apache::JSONRPC > are deleted in this distribution.
#Instead of them, there is L<JSON::RPC> which supports JSON-RPC protocol version 1.1.
#
#=back
#
#=head2 Transition ways from 1.xx to 2.xx.
#
#You should set C<suport_by_pp> mode firstly, because
#it is always successful for the below codes even with JSON::XS.
#
#    use JSON -support_by_pp;
#
#=over
#
#=item Exported jsonToObj (simple)
#
#  from_json($json_text);
#
#=item Exported objToJson (simple)
#
#  to_json($perl_scalar);
#
#=item Exported jsonToObj (advanced)
#
#  $flags = {allow_barekey => 1, allow_singlequote => 1};
#  from_json($json_text, $flags);
#
#equivalent to:
#
#  $JSON::BareKey = 1;
#  $JSON::QuotApos = 1;
#  jsonToObj($json_text);
#
#=item Exported objToJson (advanced)
#
#  $flags = {allow_blessed => 1, allow_barekey => 1};
#  to_json($perl_scalar, $flags);
#
#equivalent to:
#
#  $JSON::BareKey = 1;
#  objToJson($perl_scalar);
#
#=item jsonToObj as object method
#
#  $json->decode($json_text);
#
#=item objToJson as object method
#
#  $json->encode($perl_scalar);
#
#=item new method with parameters
#
#The C<new> method in 2.x takes any parameters no longer.
#You can set parameters instead;
#
#   $json = JSON->new->pretty;
#
#=item $JSON::Pretty, $JSON::Indent, $JSON::Delimiter
#
#If C<indent> is enable, that means C<$JSON::Pretty> flag set. And
#C<$JSON::Delimiter> was substituted by C<space_before> and C<space_after>.
#In conclusion:
#
#   $json->indent->space_before->space_after;
#
#Equivalent to:
#
#  $json->pretty;
#
#To change indent length, use C<indent_length>.
#
#(Only with JSON::PP, if C<-support_by_pp> is not used.)
#
#  $json->pretty->indent_length(2)->encode($perl_scalar);
#
#=item $JSON::BareKey
#
#(Only with JSON::PP, if C<-support_by_pp> is not used.)
#
#  $json->allow_barekey->decode($json_text)
#
#=item $JSON::ConvBlessed
#
#use C<-convert_blessed_universally>. See to L<convert_blessed>.
#
#=item $JSON::QuotApos
#
#(Only with JSON::PP, if C<-support_by_pp> is not used.)
#
#  $json->allow_singlequote->decode($json_text)
#
#=item $JSON::SingleQuote
#
#Disable. C<JSON> does not make such a invalid JSON string any longer.
#
#=item $JSON::KeySort
#
#  $json->canonical->encode($perl_scalar)
#
#This is the ascii sort.
#
#If you want to use with your own sort routine, check the C<sort_by> method.
#
#(Only with JSON::PP, even if C<-support_by_pp> is used currently.)
#
#  $json->sort_by($sort_routine_ref)->encode($perl_scalar)
# 
#  $json->sort_by(sub { $JSON::PP::a <=> $JSON::PP::b })->encode($perl_scalar)
#
#Can't access C<$a> and C<$b> but C<$JSON::PP::a> and C<$JSON::PP::b>.
#
#=item $JSON::SkipInvalid
#
#  $json->allow_unknown
#
#=item $JSON::AUTOCONVERT
#
#Needless. C<JSON> backend modules have the round-trip integrity.
#
#=item $JSON::UTF8
#
#Needless because C<JSON> (JSON::XS/JSON::PP) sets
#the UTF8 flag on properly.
#
#    # With UTF8-flagged strings
#
#    $json->allow_nonref;
#    $str = chr(1000); # UTF8-flagged
#
#    $json_text  = $json->utf8(0)->encode($str);
#    utf8::is_utf8($json_text);
#    # true
#    $json_text  = $json->utf8(1)->encode($str);
#    utf8::is_utf8($json_text);
#    # false
#
#    $str = '"' . chr(1000) . '"'; # UTF8-flagged
#
#    $perl_scalar  = $json->utf8(0)->decode($str);
#    utf8::is_utf8($perl_scalar);
#    # true
#    $perl_scalar  = $json->utf8(1)->decode($str);
#    # died because of 'Wide character in subroutine'
#
#See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
#
#=item $JSON::UnMapping
#
#Disable. See to L<MAPPING>.
#
#=item $JSON::SelfConvert
#
#This option was deleted.
#Instead of it, if a given blessed object has the C<TO_JSON> method,
#C<TO_JSON> will be executed with C<convert_blessed>.
#
#  $json->convert_blessed->encode($blessed_hashref_or_arrayref)
#  # if need, call allow_blessed
#
#Note that it was C<toJson> in old version, but now not C<toJson> but C<TO_JSON>.
#
#=back
#
#=head1 TODO
#
#=over
#
#=item example programs
#
#=back
#
#=head1 THREADS
#
#No test with JSON::PP. If with JSON::XS, See to L<JSON::XS/THREADS>.
#
#
#=head1 BUGS
#
#Please report bugs relevant to C<JSON> to E<lt>makamaka[at]cpan.orgE<gt>.
#
#
#=head1 SEE ALSO
#
#Most of the document is copied and modified from JSON::XS doc.
#
#L<JSON::XS>, L<JSON::PP>
#
#C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>)
#
#=head1 AUTHOR
#
#Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
#
#JSON::XS was written by  Marc Lehmann <schmorp[at]schmorp.de>
#
#The release of this new version owes to the courtesy of Marc Lehmann.
#
#
#=head1 COPYRIGHT AND LICENSE
#
#Copyright 2005-2013 by Makamaka Hannyaharamitu
#
#This library is free software; you can redistribute it and/or modify
#it under the same terms as Perl itself. 
#
#=cut
#
### Lingua/EN/Numbers/Ordinate.pm ###
#package Lingua::EN::Numbers::Ordinate;
#$Lingua::EN::Numbers::Ordinate::VERSION = '1.04';
#
#use 5.006;
#use strict;
#use warnings;
#require Exporter;
#
#our @ISA        = qw/ Exporter  /;
#our @EXPORT     = qw/ ordinate  /;
#our @EXPORT_OK  = qw/ ordsuf th /;
#
#
#
#
#sub ordsuf ($) {
#  return 'th' if not(defined($_[0])) or not( 0 + $_[0] );
#  my $n = abs($_[0]);  
#  return 'th' unless $n == int($n); 
#  $n %= 100;
#  return 'th' if $n == 11 or $n == 12 or $n == 13;
#  $n %= 10;
#  return 'st' if $n == 1; 
#  return 'nd' if $n == 2;
#  return 'rd' if $n == 3;
#  return 'th';
#}
#
#sub ordinate ($) {
#  my $i = $_[0] || 0;
#  return $i . ordsuf($i);
#}
#
#no warnings 'all';
#*th = \&ordinate; 
#
#1;
#
#__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.040';
#
#use Log::Any::Manager;
#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'} ) {
#        $class->_manager->set_default( $category, $default );
#    }
#
#    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" unless $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.040';
#
#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.040';
#
#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.040';
#
#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.040';
#
#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.040';
#
#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.040';
#
#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.040';
#
#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.040';
#
#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.040';
#
#sub new {
#    my $class = shift;
#    my $self  = {
#        entries         => [],
#        category_cache  => {},
#        default_adapter => {},
#    };
#    bless $self, $class;
#
#    return $self;
#}
#
#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 ) = @_;
#    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() } );
#    }
#
#    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.040';
#
#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;
#    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 );
#        return unless length $message;
#        $message = $self->{filter}->( $self->{category}, $numeric, $message )
#          if defined $self->{filter};
#        return unless defined $message and length $message;
#        $message = "$self->{prefix}$message"
#          if defined $self->{prefix} && length $self->{prefix};
#        return $self->{adapter}->$realname($message);
#    };
#    *{$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/Test.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Proxy::Test;
#
#our $VERSION = '1.040';
#
#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.040';
#
#no warnings 'once';
#$Log::Any::OverrideDefaultAdapterClass = 'Log::Any::Adapter::Test';
#$Log::Any::OverrideDefaultProxyClass   = 'Log::Any::Proxy::Test';
#
#1;
#
#__END__
#
### Mo.pm ###
#package Mo;
#$VERSION=0.39;
#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.39;
#
#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.39;
#
#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;$M="Mo::";
#$VERSION=0.39;
#*{$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;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;$M="Mo::";
#$VERSION=0.39;
#*{$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;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;my$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#*{$M.'exporter::e'}=sub{my($P)=@_;if(@{$M.EXPORT}){*{$P.$_}=\&{$M.$_}for@{$M.EXPORT}}};
### Mo/import.pm ###
#package Mo::import;my$M="Mo::";
#$VERSION=0.39;
#my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};
### Mo/importer.pm ###
#package Mo::importer;my$M="Mo::";
#$VERSION=0.39;
#*{$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;$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#*{$M.'nonlazy::e'}=sub{${shift().':N'}=1};
### Mo/option.pm ###
#package Mo::option;my$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#*{$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;my$M="Mo::";
#$VERSION=0.39;
#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__
#
### Nodejs/Util.pm ###
#package Nodejs::Util;
#
#our $DATE = '2016-07-03'; 
#our $VERSION = '0.006'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       get_nodejs_path
#                       nodejs_available
#                       system_nodejs
#               );
#
#our %SPEC;
#
#my %arg_all = (
#    all => {
#        schema => 'bool',
#        summary => 'Find all node.js instead of the first found',
#        description => <<'_',
#
#If this option is set to true, will return an array of paths intead of path.
#
#_
#    },
#);
#
#$SPEC{get_nodejs_path} = {
#    v => 1.1,
#    summary => 'Check the availability of Node.js executable in PATH',
#    description => <<'_',
#
#Return the path to executable or undef if none is available. Node.js is usually
#installed as 'node' or 'nodejs'.
#
#_
#    args => {
#        %arg_all,
#    },
#    result_naked => 1,
#};
#sub get_nodejs_path {
#    require File::Which;
#    require IPC::System::Options;
#
#    my %args = @_;
#
#    my @paths;
#    for my $name (qw/nodejs node/) {
#        my $path = File::Which::which($name);
#        next unless $path;
#
#        my $out = IPC::System::Options::readpipe(
#            $path, '-e', 'console.log(1+1)');
#        if ($out =~ /\A2\n?\z/) {
#            return $path unless $args{all};
#            push @paths, $path;
#        } else {
#        }
#    }
#    return undef unless @paths;
#    \@paths;
#}
#
#$SPEC{nodejs_available} = {
#    v => 1.1,
#    summary => 'Check the availability of Node.js',
#    description => <<'_',
#
#This is a more advanced alternative to `get_nodejs_path()`. Will check for
#`node` or `nodejs` in the PATH, like `get_nodejs_path()`. But you can also
#specify minimum version (and other options in the future). And it will return
#more details.
#
#Will return status 200 if everything is okay. Actual result will return the path
#to executable, and result metadata will contain extra result like detected
#version in `func.version`.
#
#Will return satus 412 if something is wrong. The return message will tell the
#reason.
#
#_
#    args => {
#        min_version => {
#            schema => 'str*',
#        },
#        path => {
#            summary => 'Search this instead of PATH environment variable',
#            schema => ['str*'],
#        },
#        %arg_all,
#    },
#};
#sub nodejs_available {
#    require IPC::System::Options;
#
#    my %args = @_;
#    my $all = $args{all};
#
#    my $paths = do {
#        local $ENV{PATH} = $args{path} if defined $args{path};
#        get_nodejs_path(all => 1);
#    };
#    defined $paths or return [412, "node.js not detected in PATH"];
#
#    my $res = [200, "OK"];
#    my @filtered_paths;
#    my @versions;
#    my @errors;
#
#    for my $path (@$paths) {
#        my $v;
#        if ($args{min_version}) {
#            my $out = IPC::System::Options::readpipe(
#                $path, '-v');
#            $out =~ /^(v\d+\.\d+\.\d+)$/ or do {
#                push @errors, "Can't recognize output of $path -v: $out";
#                next;
#            };
#            $v = version->parse($1);
#            $v >= version->parse($args{min_version}) or do {
#                push @errors, "Version of $path less than $args{min_version}";
#                next;
#            };
#        }
#        push @filtered_paths, $path;
#        push @versions, defined($v) ? "$v" : undef;
#    }
#
#    $res->[2]                 = $all ? \@filtered_paths : $filtered_paths[0];
#    $res->[3]{'func.path'}    = $all ? \@filtered_paths : $filtered_paths[0];
#    $res->[3]{'func.version'} = $all ? \@versions       : $versions[0];
#    $res->[3]{'func.errors'}  = \@errors;
#
#    unless (@filtered_paths) {
#        $res->[0] = 412;
#        $res->[1] = @errors == 1 ? $errors[0] :
#            "No eligible node.js found in PATH";
#    }
#
#    $res;
#}
#
#sub system_nodejs {
#    require IPC::System::Options;
#    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
#
#    my $harmony_scoping = delete $opts->{harmony_scoping};
#    my $path = delete $opts->{path};
#
#    my %detect_nodejs_args;
#    if ($harmony_scoping) {
#        $detect_nodejs_args{min_version} = '0.5.10';
#    }
#    if ($path) {
#        $detect_nodejs_args{path} = $path;
#    }
#    my $detect_res = nodejs_available(%detect_nodejs_args);
#    die "No eligible node.js binary available: ".
#        "$detect_res->[0] - $detect_res->[1]" unless $detect_res->[0] == 200;
#
#    my @extra_args;
#    if ($harmony_scoping) {
#        my $node_v = $detect_res->[3]{'func.version'};
#        if (version->parse($node_v) < version->parse("2.0.0")) {
#            push @extra_args, "--use_strict", "--harmony_scoping";
#        } else {
#            push @extra_args, "--use_strict";
#        }
#    }
#
#    IPC::System::Options::system(
#        $opts,
#        $detect_res->[2],
#        @extra_args,
#        @_,
#    );
#}
#
#1;
#
#__END__
#
### PERLANCAR/Module/List.pm ###
#package PERLANCAR::Module::List;
#
#our $DATE = '2016-03-17'; 
#our $VERSION = '0.003005'; 
#
#
#sub list_modules($$) {
#	my($prefix, $options) = @_;
#	my $trivial_syntax = $options->{trivial_syntax};
#	my($root_leaf_rx, $root_notleaf_rx);
#	my($notroot_leaf_rx, $notroot_notleaf_rx);
#	if($trivial_syntax) {
#		$root_leaf_rx = $notroot_leaf_rx = qr#:?(?:[^/:]+:)*[^/:]+:?#;
#		$root_notleaf_rx = $notroot_notleaf_rx =
#			qr#:?(?:[^/:]+:)*[^/:]+#;
#	} else {
#		$root_leaf_rx = $root_notleaf_rx = qr/[a-zA-Z_][0-9a-zA-Z_]*/;
#		$notroot_leaf_rx = $notroot_notleaf_rx = qr/[0-9a-zA-Z_]+/;
#	}
#	die "bad module name prefix `$prefix'"
#		unless $prefix =~ /\A(?:${root_notleaf_rx}::
#					 (?:${notroot_notleaf_rx}::)*)?\z/x &&
#			 $prefix !~ /(?:\A|[^:]::)\.\.?::/;
#	my $list_modules = $options->{list_modules};
#	my $list_prefixes = $options->{list_prefixes};
#	my $list_pod = $options->{list_pod};
#	my $use_pod_dir = $options->{use_pod_dir};
#	return {} unless $list_modules || $list_prefixes || $list_pod;
#	my $recurse = $options->{recurse};
#	my $return_path = $options->{return_path};
#	my $all = $options->{all};
#	my @prefixes = ($prefix);
#	my %seen_prefixes;
#	my %results;
#	while(@prefixes) {
#		my $prefix = pop(@prefixes);
#		my @dir_suffix = split(/::/, $prefix);
#		my $module_rx =
#			$prefix eq "" ? $root_leaf_rx : $notroot_leaf_rx;
#		my $pm_rx = qr/\A($module_rx)\.pmc?\z/;
#		my $pod_rx = qr/\A($module_rx)\.pod\z/;
#		my $dir_rx =
#			$prefix eq "" ? $root_notleaf_rx : $notroot_notleaf_rx;
#		$dir_rx = qr/\A$dir_rx\z/;
#		foreach my $incdir (@INC) {
#			my $dir = join("/", $incdir, @dir_suffix);
#			opendir(my $dh, $dir) or next;
#			while(defined(my $entry = readdir($dh))) {
#				if(($list_modules && $entry =~ $pm_rx) ||
#						($list_pod &&
#							$entry =~ $pod_rx)) {
#                                            $results{$prefix.$1} = $return_path ? ($all ? [@{ $results{$prefix.$1} || [] }, "$dir/$entry"] : "$dir/$entry") : undef
#						if $all && $return_path || !exists($results{$prefix.$1});
#				} elsif(($list_prefixes || $recurse) &&
#						($entry ne '.' && $entry ne '..') &&
#						$entry =~ $dir_rx &&
#						-d join("/", $dir,
#							$entry)) {
#					my $newpfx = $prefix.$entry."::";
#					next if exists $seen_prefixes{$newpfx};
#					$results{$newpfx} = $return_path ? ($all ? [@{ $results{$newpfx} || [] }, "$dir/$entry/"] : "$dir/$entry/") : undef
#						if ($all && $return_path || !exists($results{$newpfx})) && $list_prefixes;
#					push @prefixes, $newpfx if $recurse;
#				}
#			}
#			next unless $list_pod && $use_pod_dir;
#			$dir = join("/", $dir, "pod");
#			opendir($dh, $dir) or next;
#			while(defined(my $entry = readdir($dh))) {
#				if($entry =~ $pod_rx) {
#					$results{$prefix.$1} = $return_path ? ($all ? [@{ $results{$prefix.$1} || [] }, "$dir/$entry"] : "$dir/$entry") : undef;
#				}
#			}
#		}
#	}
#	return \%results;
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Complete.pm ###
#package Perinci::Sub::Complete;
#
#our $DATE = '2016-08-03'; 
#our $VERSION = '0.86'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::Any::IfLOG '$log';
#
#use Complete::Util qw(hashify_answer complete_array_elem combine_answers);
#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_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 $mod = "Perinci::Sub::XCompletion::$xcomp->[0]";
#            my $comp;
#            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->(%{ $xcomp->[1] });
#            }
#            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)
#* `ci` (bool, whether string matching should be case-insensitive)
#* `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
#`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`, `ci`, 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) {
#                require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::XCompletion::$xcomp->[0]";
#                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->(%{ $xcomp->[1] });
#                }
#                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  => [int => min => 0],
#        },
#    },
#);
#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) {
#               require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::XCompletion::$xelcomp->[0]";
#               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->(%{ $xelcomp->[1] });
#                }
#                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 ($type, $cs) = @{ $sch };
#        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_cli_arg} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using Rinci function metadata',
#    description => <<'_',
#
#This routine uses `Perinci::Sub::GetArgs::Argv` to generate `Getopt::Long`
#specification from arguments list in Rinci function metadata and common options.
#Then, it will use `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 `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`, `ci`, 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 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 `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},
#        );
#
#        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;
#                } 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 = '2016-08-24'; 
#our $VERSION = '0.73'; 
#
#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 @csets;
#    if ($_[1]) {
#        @csets = @{$_[0][1]};
#    } else {
#        @csets = ($_[0][1]);
#    }
#    for my $cset (@csets) {
#        my $rules = $cset->{'x.perl.coerce_rules'} //
#            $cset->{'x.coerce_rules'};
#        next unless $rules;
#        for my $rule (@$rules) {
#            next unless $rule =~ /\A([^_]+)_/;
#            return 1 if is_simple($1);
#        }
#    }
#    0;
#}
#
#sub _is_simple_is_array_of_simple {
#    my $sch = shift; 
#
#    my ($is_simple, $is_array_of_simple);
#
#    my $type = $sch->[0];
#    my $cset = $sch->[1];
#    if (is_type($type)) {
#        if (is_simple($type)) {
#            $is_simple = 1;
#        } elsif (_is_coercible_from_simple($sch)) {
#            $is_simple = 1;
#        } else {
#            $is_simple = 0;
#        }
#    } else {
#        require Data::Sah::Resolve;
#        my $res = Data::Sah::Resolve::resolve_schema(
#            {merge_clause_sets => 0}, $sch);
#        $type = $res->[0];
#        $cset = $res->[1][0] // {};
#        if (is_simple($type)) {
#            $is_simple = 1;
#        } elsif (_is_coercible_from_simple($res, 1)) {
#            $is_simple = 1;
#        } else {
#            $is_simple = 0;
#        }
#    }
#
#    my $eltype;
#    if ($type eq 'array' && ($eltype = $sch->[1]{of})) {
#        if (is_type($eltype)) {
#            if (is_simple($eltype)) {
#                $is_array_of_simple = 1;
#            } else {
#                $is_array_of_simple = 0;
#            }
#        } else {
#            require Data::Sah::Resolve;
#            my $res = Data::Sah::Resolve::resolve_schema(
#                {merge_clause_sets => 0}, $eltype);
#            $eltype = $res->[0];
#            $is_array_of_simple = is_simple($eltype);
#        }
#    }
#
#    ($is_simple, $is_array_of_simple, $type, $cset, $eltype);
#}
#
#sub _opt2ospec {
#    my ($opt, $schema, $arg_spec) = @_;
#    my ($is_simple, $is_array_of_simple, $type, $cset, $eltype) =
#        _is_simple_is_array_of_simple($schema);
#
#    my (@opts, @types, @isaos);
#
#    if ($is_array_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, 1;
#    }
#
#    if ($is_simple || !@opts) {
#        push @opts , $opt;
#        push @types, $type;
#        push @isaos, 0;
#    }
#
#    my @res;
#
#    for my $i (0..$#opts) {
#        my $opt   = $opts[$i];
#        my $type  = $types[$i];
#        my $isaos = $isaos[$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' :
#                         $isaos ? 's@' : 's');
#            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};
#        my $sch      = $arg_spec->{schema} // ['any', {}];
#        my ($is_simple, $is_array_of_simple, $type, $cset, $eltype) =
#            _is_simple_is_array_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;
#            } 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 `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 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", "bundling", "no_getopt_compat");
#        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, $type, $cset, $eltype) =
#                    _is_simple_is_array_of_simple($arg_spec->{schema});
#
#                if ($arg_spec->{greedy} && ref($val) eq 'ARRAY' &&
#                        !$is_array_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 = '2015-09-04'; 
#our $VERSION = '0.15'; 
#
#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;
#                    } 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-05-11'; 
#our $VERSION = '0.18'; 
#
#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 = '2016-02-21'; 
#our $VERSION = '0.45'; 
#
#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/ResObj.pm ###
#package Perinci::Sub::Util::ResObj;
#
#our $DATE = '2016-02-21'; 
#our $VERSION = '0.45'; 
#
#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 = '2016-02-21'; 
#our $VERSION = '0.45'; 
#
#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__
#
### Proc/ChildError.pm ###
#package Proc::ChildError;
#
#our $DATE = '2016-01-06'; 
#our $VERSION = '0.04'; 
#
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(explain_child_error);
#
#sub explain_child_error {
#    my $opts;
#    if (ref($_[0]) eq 'HASH') {
#        $opts = shift;
#    } else {
#        $opts = {};
#    }
#
#    my ($num, $str);
#    if (defined $_[0]) {
#        $num = $_[0];
#        $str = $_[1];
#    } else {
#        $num = $?;
#        $str = $!;
#    }
#
#    my $prefix = "";
#    if (defined $opts->{prog}) {
#        $prefix = "$opts->{prog} ";
#    }
#
#    if ($num == -1) {
#        return "${prefix}failed to execute: ".($str ? "$str ":"")."($num)";
#    } elsif ($num & 127) {
#        return sprintf(
#            "${prefix}died with signal %d, %s coredump",
#            ($num & 127),
#            (($num & 128) ? 'with' : 'without'));
#    } else {
#        return sprintf("${prefix}exited with code %d", $num >> 8);
#    }
#}
#
#1;
#
#__END__
#
### Regexp/Stringify.pm ###
#package Regexp::Stringify;
#
#our $DATE = '2016-03-15'; 
#our $VERSION = '0.05'; 
#
#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__
#
### Role/Tiny.pm ###
#package Role::Tiny;
#
#sub _getglob { \*{$_[0]} }
#sub _getstash { \%{"$_[0]::"} }
#
#use strict;
#use warnings;
#
#our $VERSION = '2.000001';
#$VERSION = eval $VERSION;
#
#our %INFO;
#our %APPLIED_TO;
#our %COMPOSED;
#our %COMPOSITE_INFO;
#our @ON_ROLE_CREATE;
#
#
#BEGIN {
#  *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
#  *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"};
#}
#
#sub Role::Tiny::__GUARD__::DESTROY {
#  delete $INC{$_[0]->[0]} if @{$_[0]};
#}
#
#sub _load_module {
#  (my $proto = $_[0]) =~ s/::/\//g;
#  $proto .= '.pm';
#  return 1 if $INC{$proto};
#  return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
#  my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
#    && bless([ $proto ], 'Role::Tiny::__GUARD__');
#  require $proto;
#  pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
#  return 1;
#}
#
#sub import {
#  my $target = caller;
#  my $me = shift;
#  strict->import;
#  warnings->import;
#  return if $me->is_role($target); 
#  $INFO{$target}{is_role} = 1;
#  my $stash = _getstash($target);
#  foreach my $type (qw(before after around)) {
#    *{_getglob "${target}::${type}"} = sub {
#      require Class::Method::Modifiers;
#      push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
#      return;
#    };
#  }
#  *{_getglob "${target}::requires"} = sub {
#    push @{$INFO{$target}{requires}||=[]}, @_;
#    return;
#  };
#  *{_getglob "${target}::with"} = sub {
#    $me->apply_roles_to_package($target, @_);
#    return;
#  };
#  my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
#  @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
#  $APPLIED_TO{$target} = { $target => undef };
#  $_->($target) for @ON_ROLE_CREATE;
#}
#
#sub role_application_steps {
#  qw(_install_methods _check_requires _install_modifiers _copy_applied_list);
#}
#
#sub apply_single_role_to_package {
#  my ($me, $to, $role) = @_;
#
#  _load_module($role);
#
#  die "This is apply_role_to_package" if ref($to);
#  die "${role} is not a Role::Tiny" unless $me->is_role($role);
#
#  foreach my $step ($me->role_application_steps) {
#    $me->$step($to, $role);
#  }
#}
#
#sub _copy_applied_list {
#  my ($me, $to, $role) = @_;
#  @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = ();
#}
#
#sub apply_roles_to_object {
#  my ($me, $object, @roles) = @_;
#  die "No roles supplied!" unless @roles;
#  my $class = ref($object);
#  bless($_[1], $me->create_class_with_roles($class, @roles));
#}
#
#my $role_suffix = 'A000';
#sub _composite_name {
#  my ($me, $superclass, @roles) = @_;
#
#  my $new_name = join(
#    '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
#  );
#
#  if (length($new_name) > 252) {
#    $new_name = $COMPOSED{abbrev}{$new_name} ||= do {
#      my $abbrev = substr $new_name, 0, 250 - length $role_suffix;
#      $abbrev =~ s/(?<!:):$//;
#      $abbrev.'__'.$role_suffix++;
#    };
#  }
#  return wantarray ? ($new_name, $compose_name) : $new_name;
#}
#
#sub create_class_with_roles {
#  my ($me, $superclass, @roles) = @_;
#
#  die "No roles supplied!" unless @roles;
#
#  _load_module($superclass);
#  {
#    my %seen;
#    $seen{$_}++ for @roles;
#    if (my @dupes = grep $seen{$_} > 1, @roles) {
#      die "Duplicated roles: ".join(', ', @dupes);
#    }
#  }
#
#  my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles);
#
#  return $new_name if $COMPOSED{class}{$new_name};
#
#  foreach my $role (@roles) {
#    _load_module($role);
#    die "${role} is not a Role::Tiny" unless $me->is_role($role);
#  }
#
#  require(_MRO_MODULE);
#
#  my $composite_info = $me->_composite_info_for(@roles);
#  my %conflicts = %{$composite_info->{conflicts}};
#  if (keys %conflicts) {
#    my $fail =
#      join "\n",
#        map {
#          "Method name conflict for '$_' between roles "
#          ."'".join(' and ', sort values %{$conflicts{$_}})."'"
#          .", cannot apply these simultaneously to an object."
#        } keys %conflicts;
#    die $fail;
#  }
#
#  my @composable = map $me->_composable_package_for($_), reverse @roles;
#
#  my @requires = grep {
#    my $method = $_;
#    !grep $_->can($method) && !$COMPOSED{role}{$_}{modifiers_only}{$method},
#      @composable
#  } @{$composite_info->{requires}};
#
#  $me->_check_requires(
#    $superclass, $compose_name, \@requires
#  );
#
#  *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ];
#
#  @{$APPLIED_TO{$new_name}||={}}{
#    map keys %{$APPLIED_TO{$_}}, @roles
#  } = ();
#
#  $COMPOSED{class}{$new_name} = 1;
#  return $new_name;
#}
#
#
#sub apply_role_to_package { shift->apply_single_role_to_package(@_) }
#
#sub apply_roles_to_package {
#  my ($me, $to, @roles) = @_;
#
#  return $me->apply_role_to_package($to, $roles[0]) if @roles == 1;
#
#  my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
#  my @have = grep $to->can($_), keys %conflicts;
#  delete @conflicts{@have};
#
#  if (keys %conflicts) {
#    my $fail =
#      join "\n",
#        map {
#          "Due to a method name conflict between roles "
#          ."'".join(' and ', sort values %{$conflicts{$_}})."'"
#          .", the method '$_' must be implemented by '${to}'"
#        } keys %conflicts;
#    die $fail;
#  }
#
#  my @role_methods = map $me->_concrete_methods_of($_), @roles;
#  local @{$_}{@have} for @role_methods;
#  delete @{$_}{@have} for @role_methods;
#
#  if ($INFO{$to}) {
#    delete $INFO{$to}{methods}; 
#  }
#
#  our %BACKCOMPAT_HACK;
#  if($me ne __PACKAGE__
#      and exists $BACKCOMPAT_HACK{$me} ? $BACKCOMPAT_HACK{$me} :
#      $BACKCOMPAT_HACK{$me} =
#        $me->can('role_application_steps')
#          == \&role_application_steps
#        && $me->can('apply_single_role_to_package')
#          != \&apply_single_role_to_package
#  ) {
#    foreach my $role (@roles) {
#      $me->apply_single_role_to_package($to, $role);
#    }
#  }
#  else {
#    foreach my $step ($me->role_application_steps) {
#      foreach my $role (@roles) {
#        $me->$step($to, $role);
#      }
#    }
#  }
#  $APPLIED_TO{$to}{join('|',@roles)} = 1;
#}
#
#sub _composite_info_for {
#  my ($me, @roles) = @_;
#  $COMPOSITE_INFO{join('|', sort @roles)} ||= do {
#    foreach my $role (@roles) {
#      _load_module($role);
#    }
#    my %methods;
#    foreach my $role (@roles) {
#      my $this_methods = $me->_concrete_methods_of($role);
#      $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
#    }
#    my %requires;
#    @requires{map @{$INFO{$_}{requires}||[]}, @roles} = ();
#    delete $requires{$_} for keys %methods;
#    delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
#    +{ conflicts => \%methods, requires => [keys %requires] }
#  };
#}
#
#sub _composable_package_for {
#  my ($me, $role) = @_;
#  my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role;
#  return $composed_name if $COMPOSED{role}{$composed_name};
#  $me->_install_methods($composed_name, $role);
#  my $base_name = $composed_name.'::_BASE';
#  _getstash($base_name);
#  { no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); }
#  my $modifiers = $INFO{$role}{modifiers}||[];
#  my @mod_base;
#  my @modifiers = grep !$composed_name->can($_),
#    do { my %h; @h{map @{$_}[1..$#$_-1], @$modifiers} = (); keys %h };
#  foreach my $modified (@modifiers) {
#    push @mod_base, "sub ${modified} { shift->next::method(\@_) }";
#  }
#  my $e;
#  {
#    local $@;
#    eval(my $code = join "\n", "package ${base_name};", @mod_base);
#    $e = "Evaling failed: $@\nTrying to eval:\n${code}" if $@;
#  }
#  die $e if $e;
#  $me->_install_modifiers($composed_name, $role);
#  $COMPOSED{role}{$composed_name} = {
#    modifiers_only => { map { $_ => 1 } @modifiers },
#  };
#  return $composed_name;
#}
#
#sub _check_requires {
#  my ($me, $to, $name, $requires) = @_;
#  return unless my @requires = @{$requires||$INFO{$name}{requires}||[]};
#  if (my @requires_fail = grep !$to->can($_), @requires) {
#    if (my $to_info = $INFO{$to}) {
#      push @{$to_info->{requires}||=[]}, @requires_fail;
#    } else {
#      die "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail);
#    }
#  }
#}
#
#sub _concrete_methods_of {
#  my ($me, $role) = @_;
#  my $info = $INFO{$role};
#  my $stash = _getstash($role);
#  my $not_methods = { reverse %{$info->{not_methods}||{}} };
#  $info->{methods} ||= +{
#    map {
#      my $code = *{$stash->{$_}}{CODE};
#      ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code)
#    } grep !ref($stash->{$_}), keys %$stash
#  };
#}
#
#sub methods_provided_by {
#  my ($me, $role) = @_;
#  die "${role} is not a Role::Tiny" unless $me->is_role($role);
#  (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
#}
#
#sub _install_methods {
#  my ($me, $to, $role) = @_;
#
#  my $info = $INFO{$role};
#
#  my $methods = $me->_concrete_methods_of($role);
#
#  my $stash = _getstash($to);
#
#  my %has_methods;
#  @has_methods{grep
#    +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}),
#    keys %$stash
#  } = ();
#
#  foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
#    no warnings 'once';
#    my $glob = _getglob "${to}::${i}";
#    *$glob = $methods->{$i};
#
#    next
#      unless $i =~ /^\(/
#        && ((defined &overload::nil && $methods->{$i} == \&overload::nil)
#            || (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
#
#    my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
#    next
#      unless defined $overload;
#
#    *$glob = \$overload;
#  }
#
#  $me->_install_does($to);
#}
#
#sub _install_modifiers {
#  my ($me, $to, $name) = @_;
#  return unless my $modifiers = $INFO{$name}{modifiers};
#  if (my $info = $INFO{$to}) {
#    push @{$info->{modifiers}}, @{$modifiers||[]};
#  } else {
#    foreach my $modifier (@{$modifiers||[]}) {
#      $me->_install_single_modifier($to, @$modifier);
#    }
#  }
#}
#
#my $vcheck_error;
#
#sub _install_single_modifier {
#  my ($me, @args) = @_;
#  defined($vcheck_error) or $vcheck_error = do {
#    local $@;
#    eval { Class::Method::Modifiers->VERSION(1.05); 1 }
#      ? 0
#      : $@
#  };
#  $vcheck_error and die $vcheck_error;
#  Class::Method::Modifiers::install_modifier(@args);
#}
#
#my $FALLBACK = sub { 0 };
#sub _install_does {
#  my ($me, $to) = @_;
#
#  return if $me->is_role($to);
#
#  my $does = $me->can('does_role');
#  *{_getglob "${to}::does"} = $does unless $to->can('does');
#
#  return
#    if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
#
#  my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
#  my $new_sub = sub {
#    my ($proto, $role) = @_;
#    $proto->$does($role) or $proto->$existing($role);
#  };
#  no warnings 'redefine';
#  return *{_getglob "${to}::DOES"} = $new_sub;
#}
#
#sub does_role {
#  my ($proto, $role) = @_;
#  require(_MRO_MODULE);
#  foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) {
#    return 1 if exists $APPLIED_TO{$class}{$role};
#  }
#  return 0;
#}
#
#sub is_role {
#  my ($me, $role) = @_;
#  return !!($INFO{$role} && $INFO{$role}{is_role});
#}
#
#1;
#__END__
#
### Role/Tiny/With.pm ###
#package Role::Tiny::With;
#
#use strict;
#use warnings;
#
#our $VERSION = '2.000001';
#$VERSION = eval $VERSION;
#
#use Role::Tiny ();
#
#use Exporter 'import';
#our @EXPORT = qw( with );
#
#sub with {
#    my $target = caller;
#    Role::Tiny->apply_roles_to_package($target, @_)
#}
#
#1;
#
#
#
### Sah/Schema/rinci/function_meta.pm ###
#package Sah::Schema::rinci::function_meta;
#
#our $DATE = '2016-07-25'; 
#our $VERSION = '1.1.80.1'; 
#
#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 => {},
#                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-07-25'; 
#our $VERSION = '1.1.80.1'; 
#
#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-07-25'; 
#our $VERSION = '1.1.80.1'; 
#
#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-07-25'; 
#our $VERSION = '1.1.80.1'; 
#
#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 => {},
#                         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-07-25'; 
#our $VERSION = '1.1.80.1'; 
#
#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-07-25'; 
#our $VERSION = '1.1.80.1'; 
#
#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-07-25'; 
#our $VERSION = '1.1.80.1'; 
#
#1;
#
#__END__
#
### Scalar/Util/Numeric/PP.pm ###
#package Scalar::Util::Numeric::PP;
#
#our $DATE = '2016-01-22'; 
#our $VERSION = '0.04'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       isint
#                       isnum
#                       isnan
#                       isinf
#                       isneg
#                       isfloat
#               );
#
#sub isint {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?(?:0|[1-9][0-9]*)\s*\z/s;
#    0;
#}
#
#sub isnan($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?nan\s*\z/is;
#    0;
#}
#
#sub isinf($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?inf(?:inity)?\s*\z/is;
#    0;
#}
#
#sub isneg($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*-/;
#    0;
#}
#
#sub isnum($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if isint($_);
#    return 1 if isfloat($_);
#    0;
#}
#
#sub isfloat($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?
#                 (?: (?:0|[1-9][0-9]*)(\.[0-9]+)? | (\.[0-9]+) )
#                 ([eE][+-]?[0-9]+)?\s*\z/sx && $1 || $2 || $3;
#    return 1 if isnan($_) || isinf($_);
#    0;
#}
#
#1;
#
#__END__
#
### String/ShellQuote.pm ###
#
#
#package String::ShellQuote;
#
#use strict;
#use vars qw($VERSION @ISA @EXPORT);
#
#require Exporter;
#
#$VERSION	= '1.04';
#@ISA		= qw(Exporter);
#@EXPORT		= qw(shell_quote shell_quote_best_effort shell_comment_quote);
#
#sub croak {
#    require Carp;
#    goto &Carp::croak;
#}
#
#sub _shell_quote_backend {
#    my @in = @_;
#    my @err = ();
#
#    if (0) {
#	require RS::Handy;
#	print RS::Handy::data_dump(\@in);
#    }
#
#    return \@err, '' unless @in;
#
#    my $ret = '';
#    my $saw_non_equal = 0;
#    foreach (@in) {
#	if (!defined $_ or $_ eq '') {
#	    $_ = "''";
#	    next;
#	}
#
#	if (s/\x00//g) {
#	    push @err, "No way to quote string containing null (\\000) bytes";
#	}
#
#    	my $escape = 0;
#
#
#	if (/=/) {
#	    if (!$saw_non_equal) {
#	    	$escape = 1;
#	    }
#	}
#	else {
#	    $saw_non_equal = 1;
#	}
#
#	if (m|[^\w!%+,\-./:=@^]|) {
#	    $escape = 1;
#	}
#
#	if ($escape
#		|| (!$saw_non_equal && /=/)) {
#
#    	    s/'/'\\''/g;
#
#    	    s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;
#
#	    $_ = "'$_'";
#	    s/^''//;
#	    s/''$//;
#	}
#    }
#    continue {
#	$ret .= "$_ ";
#    }
#
#    chop $ret;
#    return \@err, $ret;
#}
#
#
#sub shell_quote {
#    my ($rerr, $s) = _shell_quote_backend @_;
#
#    if (@$rerr) {
#    	my %seen;
#    	@$rerr = grep { !$seen{$_}++ } @$rerr;
#	my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
#	chomp $s;
#	croak $s;
#    }
#    return $s;
#}
#
#
#sub shell_quote_best_effort {
#    my ($rerr, $s) = _shell_quote_backend @_;
#
#    return $s;
#}
#
#
#sub shell_comment_quote {
#    return '' unless @_;
#    unless (@_ == 1) {
#	croak "Too many arguments to shell_comment_quote "
#	    	    . "(got " . @_ . " expected 1)";
#    }
#    local $_ = shift;
#    s/\n/\n#/g;
#    return $_;
#}
#
#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__
#
### Test/Data/Sah.pm ###
#package Test::Data::Sah;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010;
#use strict;
#use warnings;
#use Test::More 0.98;
#
#use Data::Dump qw(dump);
#use Data::Sah qw(gen_validator);
#use File::chdir;
#use File::Slurper qw(read_text);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       test_sah_cases
#                       run_spectest
#                       all_match
#                       any_match
#                       none_match
#               );
#
#sub test_sah_cases {
#    my $tests = shift;
#    my $opts  = shift // {};
#
#    my $sah = Data::Sah->new;
#    my $plc = $sah->get_compiler('perl');
#
#    my $gvopts = $opts->{gen_validator_opts} // {};
#    my $rt = $gvopts->{return_type} // 'bool';
#
#    for my $test (@$tests) {
#        my $v = gen_validator($test->{schema}, $gvopts);
#        my $res = $v->($test->{input});
#        my $name = $test->{name} //
#            "data " . dump($test->{input}) . " should".
#                ($test->{valid} ? " pass" : " not pass"). " schema " .
#                    dump($test->{schema});
#        my $testres;
#        if ($test->{valid}) {
#            if ($rt eq 'bool') {
#                $testres = ok($res, $name);
#            } elsif ($rt eq 'str') {
#                $testres = is($res, "", $name) or diag explain $res;
#            } elsif ($rt eq 'full') {
#                $testres = is(~~keys(%{$res->{errors}}), 0, $name) or diag explain $res;
#            }
#        } else {
#            if ($rt eq 'bool') {
#                $testres = ok(!$res, $name);
#            } elsif ($rt eq 'str') {
#                $testres = isnt($res, "", $name) or diag explain $res;
#            } elsif ($rt eq 'full') {
#                $testres = isnt(~~keys(%{$res->{errors}}), 0, $name) or diag explain $res;
#            }
#        }
#        next if $testres;
#
#        my $cd = $plc->compile(schema => $test->{schema});
#        diag "schema compilation result:\n----begin generated code----\n",
#            explain($cd->{result}), "\n----end generated code----\n",
#                "that code should return ", ($test->{valid} ? "true":"false"),
#                    " when fed \$data=", dump($test->{input}),
#                        " but instead returns ", dump($res);
#
#        my $vfull = gen_validator($test->{schema}, {return_type=>"full"});
#        diag "\nvalidator result (full):\n----begin result----\n",
#            explain($vfull->($test->{input})), "----end result----";
#    }
#}
#
#sub _decode_json {
#    state $json = do {
#        require JSON;
#        JSON->new->allow_nonref;
#    };
#    $json->decode(@_);
#}
#
#sub run_spectest {
#    require File::ShareDir;
#    require File::ShareDir::Tarball;
#    require Sah;
#
#    my %args = @_;
#
#    my $sah = Data::Sah->new;
#
#    my $dir;
#    if (version->parse($Sah::VERSION) == version->parse("0.9.27")) {
#        $dir = File::ShareDir::dist_dir("Sah");
#    } else {
#        $dir = File::ShareDir::Tarball::dist_dir("Sah");
#    }
#    $dir && (-d $dir) or die "Can't find spectest, have you installed Sah?";
#    (-f "$dir/spectest/00-normalize_schema.json")
#        or die "Something's wrong, spectest doesn't contain the correct files";
#
#    my @specfiles;
#    {
#        local $CWD = "$dir/spectest";
#        @specfiles = <*.json>;
#    }
#
#    my @files;
#    if ($ENV{TEST_SAH_SPECTEST_FILES}) {
#        @files = split /\s*,\s*|\s+/, $ENV{TEST_SAH_SPECTEST_FILES};
#    } else {
#        @files = @ARGV;
#    }
#
#    my @types;
#    if ($ENV{TEST_SAH_SPECTEST_TYPES}) {
#        @types = split /\s*,\s*|\s+/, $ENV{TEST_SAH_SPECTEST_TYPES};
#    }
#
#    my @include_tags;
#    if ($ENV{TEST_SAH_SPECTEST_INCLUDE_TAGS}) {
#        @include_tags = split /\s*,\s*|\s+/,
#            $ENV{TEST_SAH_SPECTEST_INCLUDE_TAGS};
#    }
#
#    my @exclude_tags;
#    if ($ENV{TEST_SAH_SPECTEST_EXCLUDE_TAGS}) {
#        @exclude_tags = split /\s*,\s*|\s+/,
#            $ENV{TEST_SAH_SPECTEST_EXCLUDE_TAGS};
#    }
#
#    my $code_test_excluded = sub {
#        my $test = shift;
#
#        if ($test->{tags} && @exclude_tags) {
#            if (any_match(\@exclude_tags, $test->{tags})) {
#                return "contains excluded tag(s) (".
#                    join(", ", @exclude_tags).")";
#            }
#        }
#        if (@include_tags) {
#            if (!all_match(\@include_tags, $test->{tags} // [])) {
#                return "does not contain all include tags (".
#                    join(", ", @include_tags).")";
#            }
#        }
#        "";
#    };
#
#    {
#        use experimental 'smartmatch';
#
#        last unless $args{test_normalize_schema};
#
#        for my $file ("00-normalize_schema.json") {
#            unless (!@files || $file ~~ @files) {
#                diag "Skipping file $file";
#                next;
#            }
#            subtest $file => sub {
#                my $tspec = _decode_json(~~read_text("$dir/spectest/$file"));
#                for my $test (@{ $tspec->{tests} }) {
#                    subtest $test->{name} => sub {
#                        if (my $reason = $code_test_excluded->($test)) {
#                            plan skip_all => "Skipping test $test->{name}: $reason";
#                            return;
#                        }
#                        eval {
#                            is_deeply(normalize_schema($test->{input}),
#                                      $test->{result}, "result");
#                        };
#                        my $eval_err = $@;
#                        if ($test->{dies}) {
#                            ok($eval_err, "dies");
#                        } else {
#                            ok(!$eval_err, "doesn't die")
#                                or diag $eval_err;
#                        }
#                    };
#                }
#                ok 1; 
#            };
#        }
#    }
#
#    {
#        use experimental 'smartmatch';
#
#        last unless $args{test_merge_clause_sets};
#
#        for my $file ("01-merge_clause_sets.json") {
#            last; 
#            unless (!@files || $file ~~ @files) {
#                diag "Skipping file $file";
#                next;
#            }
#            subtest $file => sub {
#                my $tspec = _decode_json(~~read_text("$dir/spectest/$file"));
#                for my $test (@{ $tspec->{tests} }) {
#                    subtest $test->{name} => sub {
#                        if (my $reason = $code_test_excluded->($test)) {
#                            plan skip_all => "Skipping test $test->{name}: $reason";
#                            return;
#                        }
#                        eval {
#                            is_deeply($sah->_merge_clause_sets(@{ $test->{input} }),
#                                      $test->{result}, "result");
#                        };
#                        my $eval_err = $@;
#                        if ($test->{dies}) {
#                            ok($eval_err, "dies");
#                        } else {
#                            ok(!$eval_err, "doesn't die")
#                                or diag $eval_err;
#                        }
#                    };
#                }
#                ok 1; 
#            };
#        }
#    }
#
#    {
#        use experimental 'smartmatch';
#
#        for my $file (grep /^10-type-/, @specfiles) {
#            unless (!@files || $file ~~ @files) {
#                diag "Skipping file $file";
#                next;
#            }
#            subtest $file => sub {
#                diag "Loading $file ...";
#                my $tspec = _decode_json(~~read_text("$dir/spectest/$file"));
#                note "Test version: ", $tspec->{version};
#                my $tests = $tspec->{tests};
#                if ($args{tests_func}) {
#                    $args{tests_func}->($tests, {
#                        parent_args => \%args,
#                        code_test_excluded => $code_test_excluded,
#                    });
#                } elsif ($args{test_func}) {
#                    for my $test (@$tests) {
#                        my $skip_reason;
#                        {
#                            if ($args{skip_if}) {
#                                $skip_reason = $args{skip_if}->($test);
#                                last if $skip_reason;
#                            }
#                            $skip_reason = $code_test_excluded->($test);
#                            last if $skip_reason;
#                        }
#                        my $tname = "(tags=".join(", ", sort @{ $test->{tags} // [] }).
#                            ") $test->{name}";
#                        if ($skip_reason) {
#                            diag "Skipping test $tname: $skip_reason";
#                            next;
#                        }
#                        note explain $test;
#                        subtest $tname => sub {
#                            $args{test_func}->($test);
#                        };
#                    } 
#                    ok 1; 
#                } else {
#                    die "Please specify 'test_func' or 'tests_func'";
#                }
#            }; 
#        } 
#    }
#
#}
#
#sub all_match {
#    use experimental 'smartmatch';
#
#    my ($list1, $list2) = @_;
#
#    for (@$list1) {
#        return 0 unless $_ ~~ @$list2;
#    }
#    1;
#}
#
#sub any_match {
#    use experimental 'smartmatch';
#
#    my ($list1, $list2) = @_;
#
#    for (@$list1) {
#        return 1 if $_ ~~ @$list2;
#    }
#    0;
#}
#
#sub none_match {
#    use experimental 'smartmatch';
#
#    my ($list1, $list2) = @_;
#
#    for (@$list1) {
#        return 0 if $_ ~~ @$list2;
#    }
#    1;
#}
#
#1;
#
#__END__
#
### Test/Data/Sah/Human.pm ###
#package Test::Data::Sah::Human;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Test::More 0.98;
#
#use Data::Sah;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(test_human);
#
#sub test_human {
#    my %args = @_;
#    subtest $args{name} // $args{result}, sub {
#        my $sah = Data::Sah->new;
#        my $hc = $sah->get_compiler("human");
#        my %hargs = (
#            schema => $args{schema},
#            lang => $args{lang},
#            %{ $args{compile_opts} // {} },
#        );
#        $hargs{format} //= "inline_text";
#        my $cd = $hc->compile(%hargs);
#
#        if (defined $args{result}) {
#            if (ref($args{result}) eq 'Regexp') {
#                like($cd->{result}, $args{result}, 'result');
#            } else {
#                is($cd->{result}, $args{result}, 'result');
#            }
#        }
#    };
#}
#
#1;
#
#__END__
#
### Test/Data/Sah/Perl.pm ###
#package Test::Data::Sah::Perl;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.87'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Test::Data::Sah qw(run_spectest all_match);
#use Test::More 0.98;
#
#use Data::Sah qw(gen_validator);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(run_spectest_for_perl);
#
#sub run_spectest_for_perl {
#    run_spectest(
#        test_merge_clause_sets => 1,
#        test_func => sub {
#            my $test = shift;
#
#            my $data = $test->{input};
#            my $ho = exists($test->{output}); 
#            my $vbool;
#            eval { $vbool = gen_validator(
#                $test->{schema}, {accept_ref=>$ho}) };
#            my $eval_err = $@;
#            if ($test->{dies}) {
#                ok($eval_err, "compile error");
#                return;
#            } else {
#                ok(!$eval_err, "compile success") or do {
#                    diag $eval_err;
#                    return;
#                };
#            }
#
#            if ($test->{valid_inputs}) {
#                for my $i (0..@{ $test->{valid_inputs} }-1) {
#                    my $data = $test->{valid_inputs}[$i];
#                    ok($vbool->($ho ? \$data : $data), "valid input [$i]");
#                }
#                for my $i (0..@{ $test->{invalid_inputs} }-1) {
#                    my $data = $test->{invalid_inputs}[$i];
#                    ok(!$vbool->($ho ? \$data : $data), "invalid input [$i]");
#                }
#            } elsif (exists $test->{valid}) {
#                if ($test->{valid}) {
#                    ok($vbool->($ho ? \$data : $data), "valid (rt=bool)");
#                    if ($ho) {
#                        is_deeply($data, $test->{output}, "output");
#                    }
#                } else {
#                    ok(!$vbool->($ho ? \$data : $data), "invalid (rt=bool)");
#                }
#            }
#
#            my $vstr = gen_validator($test->{schema},
#                                     {return_type=>'str'});
#            if (exists $test->{valid}) {
#                if ($test->{valid}) {
#                    is($vstr->($test->{input}), "", "valid (rt=str)");
#                } else {
#                    like($vstr->($test->{input}), qr/\S/, "invalid (rt=str)");
#                }
#            }
#
#            my $vfull = gen_validator($test->{schema},
#                                      {return_type=>'full'});
#            my $res = $vfull->($test->{input});
#            is(ref($res), 'HASH', "validator (rt=full) returns hash");
#            if (exists($test->{errors}) || exists($test->{warnings}) ||
#                    exists($test->{valid})) {
#                my $errors = $test->{errors} // ($test->{valid} ? 0 : 1);
#                is(scalar(keys %{ $res->{errors} // {} }), $errors, "errors (rt=full)")
#                    or diag explain $res;
#                my $warnings = $test->{warnings} // 0;
#                is(scalar(keys %{ $res->{warnings} // {} }), $warnings,
#                   "warnings (rt=full)")
#                    or diag explain $res;
#            }
#        }, 
#
#        skip_if => sub {
#            my $t = shift;
#            return 0 unless $t->{tags};
#
#            return "currently failing"
#                if all_match([qw/type:bool clause:between op/], $t->{tags});
#
#            for (qw/
#
#                       check
#                       check_each_elem
#                       check_each_index
#                       check_each_key
#                       check_each_value
#                       check_prop
#                       exists
#                       if
#                       postfilters
#                       prefilters
#                       prop
#                       uniq
#
#                   /) {
#                return "clause $_ not yet implemented"
#                    if all_match(["clause:$_"], $t->{tags});
#            }
#
#            return "properties are not yet implemented"
#                if grep {/^prop:/} @{ $t->{tags} };
#
#            0;
#        }, 
#
#    );
#}
#
#1;
#
#__END__
#
### Text/sprintfn.pm ###
#package Text::sprintfn;
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT    = qw(sprintfn printfn);
#
#our $VERSION = '0.08'; 
#
#our $distance  = 10;
#
#my  $re1   = qr/[^)]+/s;
#my  $re2   = qr{(?<fmt>
#                    %
#                       (?<pi> \d+\$ | \((?<npi>$re1)\)\$?)?
#                       (?<flags> [ +0#-]+)?
#                       (?<vflag> \*?[v])?
#                       (?<width> -?\d+ |
#                           \*\d+\$? |
#                           \((?<nwidth>$re1)\))?
#                       (?<dot>\.?)
#                       (?<prec>
#                           (?: \d+ | \* |
#                           \((?<nprec>$re1)\) ) ) ?
#                       (?<conv> [%csduoxefgXEGbBpniDUOF])
#                   )}x;
#our $regex = qr{($re2|%|[^%]+)}s;
#
#if (1) {
#    $regex = qr{( #all=1
#                    ( #fmt=2
#                        %
#                        (#pi=3
#                            \d+\$ | \(
#                            (#npi=4
#                                [^)]+)\)\$?)?
#                        (#flags=5
#                            [ +0#-]+)?
#                        (#vflag=6
#                            \*?[v])?
#                        (#width=7
#                            -?\d+ |
#                            \*\d+\$? |
#                            \((#nwidth=8
#                                [^)]+)\))?
#                        (#dot=9
#                            \.?)
#                        (#prec=10
#                            (?: \d+ | \* |
#                                \((#nprec=11
#                                    [^)]+)\) ) ) ?
#                        (#conv=12
#                            [%csduoxefgXEGbBpniDUOF])
#                    ) | % | [^%]+
#                )}xs;
#}
#
#sub sprintfn {
#    my ($format, @args) = @_;
#
#    my $hash;
#    if (ref($args[0]) eq 'HASH') {
#        $hash = shift(@args);
#    }
#    return sprintf($format, @args) if !$hash;
#
#    my %indexes; 
#    push @args, (undef) x $distance;
#
#    $format =~ s{$regex}{
#        my ($all, $fmt, $pi, $npi, $flags,
#            $vflag, $width, $nwidth, $dot, $prec,
#            $nprec, $conv) =
#            ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
#
#        my $res;
#        if ($fmt) {
#
#            if (defined $npi) {
#                my $i = $indexes{$npi};
#                if (!$i) {
#                    $i = @args + 1;
#                    push @args, $hash->{$npi};
#                    $indexes{$npi} = $i;
#                }
#                $pi = "${i}\$";
#            }
#
#            if (defined $nwidth) {
#                $width = $hash->{$nwidth};
#            }
#
#            if (defined $nprec) {
#                $prec = $hash->{$nprec};
#            }
#
#            $res = join("",
#                grep {defined} (
#                    "%",
#                    $pi, $flags, $vflag,
#                    $width, $dot, $prec, $conv)
#                );
#        } else {
#            my $i = @args + 1;
#            push @args, $all;
#            $res = "\%${i}\$s";
#        }
#        $res;
#    }xego;
#
#
#    sprintf $format, @args;
#}
#
#sub printfn {
#    print sprintfn @_;
#}
#
#1;
#
#__END__
#
### Tie/IxHash.pm ###
#
#require 5.005;
#
#package Tie::IxHash;
#use strict;
#use integer;
#require Tie::Hash;
#use vars qw/@ISA $VERSION/;
#@ISA = qw(Tie::Hash);
#
#$VERSION = $VERSION = '1.23';
#
#
#sub TIEHASH {
#  my($c) = shift;
#  my($s) = [];
#  $s->[0] = {};   
#  $s->[1] = [];   
#  $s->[2] = [];   
#  $s->[3] = 0;    
#
#  bless $s, $c;
#
#  $s->Push(@_) if @_;
#
#  return $s;
#}
#
#
#sub FETCH {
#  my($s, $k) = (shift, shift);
#  return exists( $s->[0]{$k} ) ? $s->[2][ $s->[0]{$k} ] : undef;
#}
#
#sub STORE {
#  my($s, $k, $v) = (shift, shift, shift);
#  
#  if (exists $s->[0]{$k}) {
#    my($i) = $s->[0]{$k};
#    $s->[1][$i] = $k;
#    $s->[2][$i] = $v;
#    $s->[0]{$k} = $i;
#  }
#  else {
#    push(@{$s->[1]}, $k);
#    push(@{$s->[2]}, $v);
#    $s->[0]{$k} = $#{$s->[1]};
#  }
#}
#
#sub DELETE {
#  my($s, $k) = (shift, shift);
#
#  if (exists $s->[0]{$k}) {
#    my($i) = $s->[0]{$k};
#    for ($i+1..$#{$s->[1]}) {    
#      $s->[0]{ $s->[1][$_] }--;    
#    }
#    if ( $i == $s->[3]-1 ) {
#      $s->[3]--;
#    }
#    delete $s->[0]{$k};
#    splice @{$s->[1]}, $i, 1;
#    return (splice(@{$s->[2]}, $i, 1))[0];
#  }
#  return undef;
#}
#
#sub EXISTS {
#  exists $_[0]->[0]{ $_[1] };
#}
#
#sub FIRSTKEY {
#  $_[0][3] = 0;
#  &NEXTKEY;
#}
#
#sub NEXTKEY {
#  return $_[0][1][ $_[0][3]++ ] if ($_[0][3] <= $#{ $_[0][1] } );
#  return undef;
#}
#
#
#
#
#sub new { TIEHASH(@_) }
#
#sub Clear {
#  my $s = shift;
#  $s->[0] = {};   
#  $s->[1] = [];   
#  $s->[2] = [];   
#  $s->[3] = 0;    
#  return;
#}
#
#sub Push {
#  my($s) = shift;
#  while (@_) {
#    $s->STORE(shift, shift);
#  }
#  return scalar(@{$s->[1]});
#}
#
#sub Push2 {
#  my($s) = shift;
#  $s->Splice($#{$s->[1]}+1, 0, @_);
#  return scalar(@{$s->[1]});
#}
#
#sub Pop {
#  my($s) = shift;
#  my($k, $v, $i);
#  $k = pop(@{$s->[1]});
#  $v = pop(@{$s->[2]});
#  if (defined $k) {
#    delete $s->[0]{$k};
#    return ($k, $v);
#  }
#  return undef;
#}
#
#sub Pop2 {
#  return $_[0]->Splice(-1);
#}
#
#sub Shift {
#  my($s) = shift;
#  my($k, $v, $i);
#  $k = shift(@{$s->[1]});
#  $v = shift(@{$s->[2]});
#  if (defined $k) {
#    delete $s->[0]{$k};
#    for (keys %{$s->[0]}) {
#      $s->[0]{$_}--;
#    }
#    return ($k, $v);
#  }
#  return undef;
#}
#
#sub Shift2 {
#  return $_[0]->Splice(0, 1);
#}
#
#sub Unshift {
#  my($s) = shift;
#  my($k, $v, @k, @v, $len, $i);
#
#  while (@_) {
#    ($k, $v) = (shift, shift);
#    if (exists $s->[0]{$k}) {
#      $i = $s->[0]{$k};
#      $s->[1][$i] = $k;
#      $s->[2][$i] = $v;
#      $s->[0]{$k} = $i;
#    }
#    else {
#      push(@k, $k);
#      push(@v, $v);
#      $len++;
#    }
#  }
#  if (defined $len) {
#    for (keys %{$s->[0]}) {
#      $s->[0]{$_} += $len;
#    }
#    $i = 0;
#    for (@k) {
#      $s->[0]{$_} = $i++;
#    }
#    unshift(@{$s->[1]}, @k);
#    return unshift(@{$s->[2]}, @v);
#  }
#  return scalar(@{$s->[1]});
#}
#
#sub Unshift2 {
#  my($s) = shift;
#  $s->Splice(0,0,@_);
#  return scalar(@{$s->[1]});
#}
#
#sub Splice {
#  my($s, $start, $len) = (shift, shift, shift);
#  my($k, $v, @k, @v, @r, $i, $siz);
#  my($end);                   
#
#  ($start, $end, $len) = $s->_lrange($start, $len);
#
#  if (defined $start) {
#    if ($len > 0) {
#      my(@k) = splice(@{$s->[1]}, $start, $len);
#      my(@v) = splice(@{$s->[2]}, $start, $len);
#      while (@k) {
#        $k = shift(@k);
#        delete $s->[0]{$k};
#        push(@r, $k, shift(@v));
#      }
#      for ($start..$#{$s->[1]}) {
#        $s->[0]{$s->[1][$_]} -= $len;
#      }
#    }
#    while (@_) {
#      ($k, $v) = (shift, shift);
#      if (exists $s->[0]{$k}) {
#        $i = $s->[0]{$k};
#        $s->[1][$i] = $k;
#        $s->[2][$i] = $v;
#        $s->[0]{$k} = $i;
#      }
#      else {
#        push(@k, $k);
#        push(@v, $v);
#        $siz++;
#      }
#    }
#    if (defined $siz) {
#      for ($start..$#{$s->[1]}) {
#        $s->[0]{$s->[1][$_]} += $siz;
#      }
#      $i = $start;
#      for (@k) {
#        $s->[0]{$_} = $i++;
#      }
#      splice(@{$s->[1]}, $start, 0, @k);
#      splice(@{$s->[2]}, $start, 0, @v);
#    }
#  }
#  return @r;
#}
#
#sub Delete {
#  my($s) = shift;
#
#  for (@_) {
#    $s->DELETE($_);
#  }
#}
#
#sub Replace {
#  my($s) = shift;
#  my($i, $v, $k) = (shift, shift, shift);
#  if (defined $i and $i <= $#{$s->[1]} and $i >= 0) {
#    if (defined $k) {
#      delete $s->[0]{ $s->[1][$i] };
#      $s->DELETE($k) ; 
#      $s->[1][$i] = $k;
#      $s->[2][$i] = $v;
#      $s->[0]{$k} = $i;
#      return $k;
#    }
#    else {
#      $s->[2][$i] = $v;
#      return $s->[1][$i];
#    }
#  }
#  return undef;
#}
#
#sub _lrange {
#  my($s) = shift;
#  my($offset, $len) = @_;
#  my($start, $end);         
#  my($size) = $#{$s->[1]}+1;
#
#  return undef unless defined $offset;
#  if($offset < 0) {
#    $start = $offset + $size;
#    $start = 0 if $start < 0;
#  }
#  else {
#    ($offset > $size) ? ($start = $size) : ($start = $offset);
#  }
#
#  if (defined $len) {
#    $len = -$len if $len < 0;
#    $len = $size - $start if $len > $size - $start;
#  }
#  else {
#    $len = $size - $start;
#  }
#  $end = $start + $len - 1;
#
#  return ($start, $end, $len);
#}
#
#sub Keys   { 
#  my($s) = shift;
#  return ( @_ == 1
#	 ? $s->[1][$_[0]]
#	 : ( @_
#	   ? @{$s->[1]}[@_]
#	   : @{$s->[1]} ) );
#}
#
#sub Values {
#  my($s) = shift;
#  return ( @_ == 1
#	 ? $s->[2][$_[0]]
#	 : ( @_
#	   ? @{$s->[2]}[@_]
#	   : @{$s->[2]} ) );
#}
#
#sub Indices { 
#  my($s) = shift;
#  return ( @_ == 1 ? $s->[0]{$_[0]} : @{$s->[0]}{@_} );
#}
#
#sub Length {
# return scalar @{$_[0]->[1]};
#}
#
#sub Reorder {
#  my($s) = shift;
#  my(@k, @v, %x, $i);
#  return unless @_;
#
#  $i = 0;
#  for (@_) {
#    if (exists $s->[0]{$_}) {
#      push(@k, $_);
#      push(@v, $s->[2][ $s->[0]{$_} ] );
#      $x{$_} = $i++;
#    }
#  }
#  $s->[1] = \@k;
#  $s->[2] = \@v;
#  $s->[0] = \%x;
#  return $s;
#}
#
#sub SortByKey {
#  my($s) = shift;
#  $s->Reorder(sort $s->Keys);
#}
#
#sub SortByValue {
#  my($s) = shift;
#  $s->Reorder(sort { $s->FETCH($a) cmp $s->FETCH($b) } $s->Keys)
#}
#
#1;
#__END__
#
