#!/usr/bin/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

our $DATE = '2017-07-31'; # DATE
our $DIST = 'File-RsyBak'; # DIST
our $VERSION = '0.35'; # VERSION

use 5.010001;
use strict;
use warnings;

require Perinci::CmdLine::Lite;

Perinci::CmdLine::Lite->new(
    url => "/File/RsyBak/backup",
    log => 1,
    program_name => "rsybak",
    per_arg_yaml => 1,
)->run;

# ABSTRACT: Backup files/directories with histories, using rsync
# PODNAME: rsybak

__END__

=pod

=encoding UTF-8

=head1 NAME

rsybak - Backup files/directories with histories, using rsync

=head1 VERSION

This document describes version 0.35 of rsybak (from Perl distribution File-RsyBak), released on 2017-07-31.

=head1 SYNOPSIS

Usage:

 % rsybak [options] <source> <target>

Examples:

 % rsybak /home/jajang/mydata /backup/jajang/mydata

=head1 OPTIONS

C<*> marks required options.

=head2 Main options

=over

=item B<--extra-dir>

Whether to force creation of source directory in target.

If set to 1, then backup(source => '/a', target => '/backup/a') will create
another 'a' directory in target, i.e. /backup/a/current/a. Otherwise, contents
of a/ will be directly copied under /backup/a/current/.

Will always be set to 1 if source is more than one, but default to 0 if source
is a single directory. You can set this to 1 to so that behaviour when there is
a single source is the same as behaviour when there are several sources.


=item B<--extra-rsync-opts-json>=I<s>

Pass extra options to rsync command (JSON-encoded).

See C<--extra-rsync-opts>.

=item B<--extra-rsync-opts-yaml>=I<s>

Pass extra options to rsync command (YAML-encoded).

See C<--extra-rsync-opts>.

=item B<--extra-rsync-opts>=I<s@>

Pass extra options to rsync command.

Extra options to pass to rsync command when doing backup. Note that the options
will be shell quoted, , so you should pass it unquoted, e.g. ['--exclude',
'/Program Files'].


Can be specified multiple times.

=item B<--histories-json>=I<s>

Histories/history levels (JSON-encoded).

See C<--histories>.

=item B<--histories-yaml>=I<s>

Histories/history levels (YAML-encoded).

See C<--histories>.

=item B<--histories>=I<i@>

Histories/history levels.

Default value:

 [-7,4,3]

Specifies number of backup histories to keep for level 1, 2, and so on. If
number is negative, specifies number of days to keep instead (regardless of
number of histories).


Can be specified multiple times.

=item B<--no-backup>

If backup=1 and rotate=0 then will only create new backup without rotating
histories.


=item B<--no-rotate>

If backup=0 and rotate=1 then will only do history rotating.


=item B<--source>=I<s>*

Director(y|ies) to backup.

=item B<--target>=I<s>*

Backup destination.

=back

=head2 Configuration options

=over

=item B<--config-path>=I<filename>

Set path to configuration file.

Can be specified multiple times.

=item B<--config-profile>=I<s>

Set configuration profile to use.

=item B<--no-config>

Do not use any configuration file.

=back

=head2 Environment options

=over

=item B<--no-env>

Do not read environment for default options.

=back

=head2 Logging options

=over

=item B<--debug>

Shortcut for --log-level=debug.

=item B<--log-level>=I<s>

Set log level.

=item B<--quiet>

Shortcut for --log-level=error.

=item B<--trace>

Shortcut for --log-level=trace.

=item B<--verbose>

Shortcut for --log-level=info.

=back

=head2 Output options

=over

=item B<--format>=I<s>

Choose output format, e.g. json, text.

Default value:

 undef

=item B<--json>

Set output format to json.

=item B<--naked-res>

When outputing as JSON, strip result envelope.

Default value:

 0

By default, when outputing as JSON, the full enveloped result is returned, e.g.:

    [200,"OK",[1,2,3],{"func.extra"=>4}]

The reason is so you can get the status (1st element), status message (2nd
element) as well as result metadata/extra result (4th element) instead of just
the result (3rd element). However, sometimes you want just the result, e.g. when
you want to pipe the result for more post-processing. In this case you can use
`--naked-res` so you just get:

    [1,2,3]


=back

=head2 Other options

=over

=item B<--help>, B<-h>, B<-?>

Display help message and exit.

=item B<--version>, B<-v>

Display program's version and exit.

=back

=head1 COMPLETION

This script has shell tab completion capability with support for several
shells.

=head2 bash

To activate bash completion for this script, put:

 complete -C rsybak rsybak

in your bash startup (e.g. F<~/.bashrc>). Your next shell session will then
recognize tab completion for the command. Or, you can also directly execute the
line above in your shell to activate immediately.

It is recommended, however, that you install modules using L<cpanm-shcompgen>
which can activate shell completion for scripts immediately.

=head2 tcsh

To activate tcsh completion for this script, put:

 complete rsybak 'p/*/`rsybak`/'

in your tcsh startup (e.g. F<~/.tcshrc>). Your next shell session will then
recognize tab completion for the command. Or, you can also directly execute the
line above in your shell to activate immediately.

It is also recommended to install L<shcompgen> (see above).

=head2 other shells

For fish and zsh, install L<shcompgen> as described above.

=head1 CONFIGURATION FILE

This script can read configuration files. Configuration files are in the format of L<IOD>, which is basically INI with some extra features.

By default, these names are searched for configuration filenames (can be changed using C<--config-path>): F<~/.config/rsybak.conf>, F<~/rsybak.conf>, or F</etc/rsybak.conf>.

All found files will be read and merged.

To disable searching for configuration files, pass C<--no-config>.

You can put multiple profiles in a single file by using section names like C<[profile=SOMENAME]> or C<[SOMESECTION profile=SOMENAME]>. Those sections will only be read if you specify the matching C<--config-profile SOMENAME>.

You can also put configuration for multiple programs inside a single file, and use filter C<program=NAME> in section names, e.g. C<[program=NAME ...]> or C<[SOMESECTION program=NAME]>. The section will then only be used when the reading program matches.

Finally, you can filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOMEVAR ...]>. If you only want a section to be read when the value of an environment variable has value equals something: C<[env=HOSTNAME=blink ...]> or C<[SOMESECTION env=HOSTNAME=blink ...]>. If you only want a section to be read when the value of an environment variable does not equal something: C<[env=HOSTNAME!=blink ...]> or C<[SOMESECTION env=HOSTNAME!=blink ...]>. If you only want a section to be read when an environment variable contains something: C<[env=HOSTNAME*=server ...]> or C<[SOMESECTION env=HOSTNAME*=server ...]>. Note that currently due to simplistic parsing, there must not be any whitespace in the value being compared because it marks the beginning of a new section filter or section name.

List of available configuration parameters:

 backup (see --no-backup)
 extra_dir (see --extra-dir)
 extra_rsync_opts (see --extra-rsync-opts)
 format (see --format)
 histories (see --histories)
 log_level (see --log-level)
 naked_res (see --naked-res)
 rotate (see --no-rotate)
 source (see --source)
 target (see --target)

=head1 ENVIRONMENT

=head2 RSYBAK_OPT => str

Specify additional command-line options.

=head1 FILES

F<~/.config/rsybak.conf>

F<~/rsybak.conf>

F</etc/rsybak.conf>

=head1 HOMEPAGE

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

=head1 SOURCE

Source repository is at L<https://github.com/sharyanto/perl-File-RsyBak>.

=head1 BUGS

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

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

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017, 2015, 2014, 2013, 2012, 2011 by perlancar@cpan.org.

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

=cut

__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
Color/ANSI/Util.pm,19043,10958,4;752
Complete/Bash.pm,30026,17459,5;1063
Complete/Common.pm,47512,945,6;1588
Complete/Env.pm,48481,2999,7;1627
Complete/File.pm,51505,8536,8;1752
Complete/Fish.pm,60066,2069,9;2025
Complete/Getopt/Long.pm,62167,18507,10;2115
Complete/Path.pm,80699,7961,11;2669
Complete/Tcsh.pm,88685,2757,12;2929
Complete/Util.pm,91467,21457,13;3034
Complete/Zsh.pm,112948,1345,14;3778
Config/IOD/Base.pm,114320,13009,15;3840
Config/IOD/Expr.pm,127356,1287,16;4332
Config/IOD/Reader.pm,128672,6377,17;4417
Data/Check/Structure.pm,135081,3504,18;4624
Data/Clean.pm,138607,7950,19;4786
Data/Clean/FromJSON.pm,146588,536,20;5058
Data/Clean/JSON.pm,147151,1140,21;5090
Data/Dmp.pm,148311,4396,22;5142
Data/Dump.pm,152728,12066,23;5326
Data/Dump/FilterContext.pm,164829,1740,24;5859
Data/Dump/Filtered.pm,166599,812,25;5953
Data/Dump/Trace.pm,167438,6339,26;5986
Data/ModeMerge.pm,173803,10593,27;6252
Data/ModeMerge/Config.pm,184429,2140,28;6570
Data/ModeMerge/Mode/ADD.pm,186604,1373,29;6641
Data/ModeMerge/Mode/Base.pm,188013,16705,30;6710
Data/ModeMerge/Mode/CONCAT.pm,204756,442,31;7240
Data/ModeMerge/Mode/DELETE.pm,205236,1218,32;7268
Data/ModeMerge/Mode/KEEP.pm,206490,1174,33;7343
Data/ModeMerge/Mode/NORMAL.pm,207702,1501,34;7411
Data/ModeMerge/Mode/SUBTRACT.pm,209243,2064,35;7504
Data/Sah.pm,211327,2541,36;7596
Data/Sah/Coerce.pm,213895,2722,37;7709
Data/Sah/Coerce/js/bool/float.pm,216658,560,38;7819
Data/Sah/Coerce/js/bool/str.pm,217257,717,39;7859
Data/Sah/Coerce/js/date/float_epoch.pm,218021,590,40;7902
Data/Sah/Coerce/js/date/obj_Date.pm,218655,597,41;7942
Data/Sah/Coerce/js/date/str.pm,219291,625,42;7981
Data/Sah/Coerce/js/duration/float_secs.pm,219966,741,43;8020
Data/Sah/Coerce/js/duration/str_iso8601.pm,220758,967,44;8062
Data/Sah/Coerce/perl/bool/str.pm,221766,561,45;8105
Data/Sah/Coerce/perl/date/float_epoch.pm,222376,1162,46;8143
Data/Sah/Coerce/perl/date/obj_DateTime.pm,223588,1094,47;8196
Data/Sah/Coerce/perl/date/obj_TimeMoment.pm,224734,1232,48;8248
Data/Sah/Coerce/perl/date/str_iso8601.pm,226015,1494,49;8300
Data/Sah/Coerce/perl/duration/float_secs.pm,227561,970,50;8355
Data/Sah/Coerce/perl/duration/obj_DateTimeDuration.pm,228593,1137,51;8403
Data/Sah/Coerce/perl/duration/str_human.pm,229781,1719,52;8452
Data/Sah/Coerce/perl/duration/str_iso8601.pm,231553,1447,53;8502
Data/Sah/Coerce/perl/float/str_percent.pm,233050,534,54;8551
Data/Sah/Coerce/perl/int/str_percent.pm,233632,520,55;8588
Data/Sah/CoerceCommon.pm,234185,8108,56;8625
Data/Sah/CoerceJS.pm,242322,3098,57;8893
Data/Sah/Compiler.pm,245449,20160,58;9012
Data/Sah/Compiler/Prog.pm,265643,23963,59;9708
Data/Sah/Compiler/Prog/TH.pm,289643,3108,60;10489
Data/Sah/Compiler/Prog/TH/all.pm,292792,534,61;10616
Data/Sah/Compiler/Prog/TH/any.pm,293367,534,62;10648
Data/Sah/Compiler/TH.pm,293933,1247,63;10680
Data/Sah/Compiler/TextResultRole.pm,295224,1190,64;10746
Data/Sah/Compiler/human.pm,296449,12247,65;10808
Data/Sah/Compiler/human/TH.pm,308734,1082,66;11252
Data/Sah/Compiler/human/TH/Comparable.pm,309865,688,67;11318
Data/Sah/Compiler/human/TH/HasElems.pm,310600,1964,68;11350
Data/Sah/Compiler/human/TH/Sortable.pm,312611,1543,69;11422
Data/Sah/Compiler/human/TH/all.pm,314196,1852,70;11489
Data/Sah/Compiler/human/TH/any.pm,316090,1801,71;11569
Data/Sah/Compiler/human/TH/array.pm,317935,2853,72;11648
Data/Sah/Compiler/human/TH/bool.pm,320831,1152,73;11759
Data/Sah/Compiler/human/TH/buf.pm,322025,472,74;11817
Data/Sah/Compiler/human/TH/cistr.pm,322541,266,75;11847
Data/Sah/Compiler/human/TH/code.pm,322850,470,76;11865
Data/Sah/Compiler/human/TH/date.pm,323363,564,77;11894
Data/Sah/Compiler/human/TH/duration.pm,323974,584,78;11924
Data/Sah/Compiler/human/TH/float.pm,324602,2136,79;11954
Data/Sah/Compiler/human/TH/hash.pm,326781,8935,80;12051
Data/Sah/Compiler/human/TH/int.pm,335758,1741,81;12392
Data/Sah/Compiler/human/TH/num.pm,337541,568,82;12471
Data/Sah/Compiler/human/TH/obj.pm,338151,901,83;12501
Data/Sah/Compiler/human/TH/re.pm,339093,516,84;12552
Data/Sah/Compiler/human/TH/str.pm,339651,2306,85;12583
Data/Sah/Compiler/human/TH/undef.pm,342001,528,86;12688
Data/Sah/Compiler/perl.pm,342563,9709,87;12719
Data/Sah/Compiler/perl/TH.pm,352309,1300,88;13120
Data/Sah/Compiler/perl/TH/all.pm,353650,316,89;13168
Data/Sah/Compiler/perl/TH/any.pm,354007,316,90;13190
Data/Sah/Compiler/perl/TH/array.pm,354366,4412,91;13212
Data/Sah/Compiler/perl/TH/bool.pm,358820,2360,92;13346
Data/Sah/Compiler/perl/TH/buf.pm,361221,292,93;13430
Data/Sah/Compiler/perl/TH/cistr.pm,361556,3621,94;13449
Data/Sah/Compiler/perl/TH/code.pm,365219,456,95;13582
Data/Sah/Compiler/perl/TH/date.pm,365717,5699,96;13609
Data/Sah/Compiler/perl/TH/duration.pm,371462,5788,97;13765
Data/Sah/Compiler/perl/TH/float.pm,377293,6295,98;13931
Data/Sah/Compiler/perl/TH/hash.pm,383630,15326,99;14115
Data/Sah/Compiler/perl/TH/int.pm,398997,1065,100;14584
Data/Sah/Compiler/perl/TH/num.pm,400103,2067,101;14635
Data/Sah/Compiler/perl/TH/obj.pm,402211,882,102;14711
Data/Sah/Compiler/perl/TH/re.pm,403133,523,103;14757
Data/Sah/Compiler/perl/TH/str.pm,403697,5218,104;14786
Data/Sah/Compiler/perl/TH/undef.pm,408958,453,105;14957
Data/Sah/Human.pm,409437,667,106;14984
Data/Sah/Lang.pm,410129,261,107;15019
Data/Sah/Lang/fr_FR.pm,410421,1563,108;15040
Data/Sah/Lang/id_ID.pm,412015,8191,109;15146
Data/Sah/Lang/zh_CN.pm,420237,1463,110;15542
Data/Sah/Normalize.pm,421730,6073,111;15649
Data/Sah/Resolve.pm,427831,3692,112;15830
Data/Sah/Type/BaseType.pm,431557,2720,113;15938
Data/Sah/Type/Comparable.pm,434313,735,114;16071
Data/Sah/Type/HasElems.pm,435082,3599,115;16104
Data/Sah/Type/Sortable.pm,438715,1980,116;16248
Data/Sah/Type/all.pm,440724,463,117;16331
Data/Sah/Type/any.pm,441216,463,118;16354
Data/Sah/Type/array.pm,441710,756,119;16377
Data/Sah/Type/bool.pm,442496,437,120;16410
Data/Sah/Type/buf.pm,442962,179,121;16434
Data/Sah/Type/cistr.pm,443172,181,122;16448
Data/Sah/Type/code.pm,443383,185,123;16462
Data/Sah/Type/date.pm,443598,300,124;16476
Data/Sah/Type/duration.pm,443932,304,125;16494
Data/Sah/Type/float.pm,444267,886,126;16512
Data/Sah/Type/hash.pm,445183,4580,127;16559
Data/Sah/Type/int.pm,449792,648,128;16747
Data/Sah/Type/num.pm,450469,256,129;16778
Data/Sah/Type/obj.pm,450754,509,130;16794
Data/Sah/Type/re.pm,451291,224,131;16822
Data/Sah/Type/str.pm,451544,775,132;16837
Data/Sah/Type/undef.pm,452350,167,133;16876
Data/Sah/Util/Func.pm,452547,329,134;16888
Data/Sah/Util/Role.pm,452906,3345,135;16911
Data/Sah/Util/Type.pm,456281,3406,136;17026
Data/Sah/Util/Type/Date.pm,459722,5074,137;17155
Data/Sah/Util/TypeX.pm,464827,337,138;17301
Encode/Locale.pm,465189,4317,139;17326
File/Flock/Retry.pm,469534,1846,140;17491
File/RsyBak.pm,471403,11690,141;17592
File/RsyBak/Packed.pm,483123,107,142;17953
File/ShareDir.pm,483255,6309,143;17963
File/ShareDir/Tarball.pm,489597,1502,144;18268
File/Slurper.pm,491123,2626,145;18346
File/Which.pm,493771,2267,146;18449
File/chdir.pm,496060,3979,147;18564
Function/Fallback/CoreOrPP.pm,500077,1761,148;18752
Getopt/Long/Negate/EN.pm,501871,1797,149;18843
Getopt/Long/Util.pm,503696,9068,150;18895
HTTP/Config.pm,512787,6230,151;19226
HTTP/Date.pm,519038,5770,152;19463
HTTP/Headers.pm,524832,10708,153;19710
HTTP/Headers/Auth.pm,535569,1769,154;20157
HTTP/Headers/ETag.pm,537367,1831,155;20250
HTTP/Headers/Util.pm,539227,1623,156;20336
HTTP/Message.pm,540874,18232,157;20428
HTTP/Request.pm,559130,2603,158;21164
HTTP/Request/Common.pm,561764,7085,159;21298
HTTP/Response.pm,568874,6948,160;21594
HTTP/Status.pm,575845,3451,161;21917
HTTP/Tiny.pm,579317,36936,162;22030
HTTP/Tiny/UNIX.pm,616279,2136,163;23260
IO/HTML.pm,618434,5421,164;23358
IO/Pty.pm,623873,3553,165;23582
IO/Tty.pm,627444,2398,166;23729
IPC/Run.pm,629861,58501,167;23837
IPC/Run/Debug.pm,688387,5820,168;25941
IPC/Run/IO.pm,694229,9028,169;26182
IPC/Run/Timer.pm,703282,5982,170;26584
IPC/Run/Win32Helper.pm,709295,8528,171;26887
IPC/Run/Win32IO.pm,717850,10764,172;27177
IPC/Run/Win32Pump.pm,728643,2368,173;27624
IPC/System/Options.pm,731041,10604,174;27722
JSON.pm,741661,71912,175;28082
JSON/PP.pm,813592,41741,176;30381
JSON/PP/Boolean.pm,855360,43,177;31935
LWP/MediaTypes.pm,855429,3425,178;31942
Lingua/EN/Numbers/Ordinate.pm,858892,724,179;32123
Lingua/EN/PluralToSingular.pm,859654,5931,180;32162
Log/ger.pm,865604,3404,181;32574
Log/ger/App.pm,869031,2557,182;32707
Log/ger/Format.pm,871614,184,183;32807
Log/ger/Format/None.pm,871829,281,184;32820
Log/ger/Heavy.pm,872135,14822,185;32839
Log/ger/Layout.pm,886983,138,186;33178
Log/ger/Layout/Pattern.pm,887155,3658,187;33189
Log/ger/Output.pm,890839,136,188;33316
Log/ger/Output/Array.pm,891007,565,189;33327
Log/ger/Output/Composite.pm,891608,9657,190;33359
Log/ger/Output/File.pm,901296,792,191;33586
Log/ger/Output/Null.pm,902119,328,192;33625
Log/ger/Output/Screen.pm,902480,2452,193;33645
Log/ger/Output/String.pm,904965,981,194;33733
Log/ger/Output/Syslog.pm,905979,1440,195;33774
Log/ger/Plugin.pm,907445,990,196;33833
Log/ger/Plugin/MultilevelLog.pm,908475,552,197;33890
Log/ger/Util.pm,909051,6956,198;33920
Mo.pm,916021,591,199;34155
Mo/Golf.pm,916631,7519,200;34159
Mo/Inline.pm,924171,2047,201;34376
Mo/Moose.pm,926238,533,202;34462
Mo/Mouse.pm,926791,563,203;34467
Mo/build.pm,927374,248,204;34472
Mo/builder.pm,927644,338,205;34476
Mo/chain.pm,928002,216,206;34480
Mo/coerce.pm,928239,330,207;34484
Mo/default.pm,928591,435,208;34488
Mo/exporter.pm,929049,176,209;34492
Mo/import.pm,929246,185,210;34496
Mo/importer.pm,929454,207,211;34500
Mo/is.pm,929678,228,212;34504
Mo/nonlazy.pm,929928,129,213;34508
Mo/option.pm,930078,259,214;34512
Mo/required.pm,930360,340,215;34516
Mo/xs.pm,930717,256,216;34520
Module/Installed/Tiny.pm,931006,3030,217;34524
Monkey/Patch/Action.pm,934067,1546,218;34641
Monkey/Patch/Action/Handle.pm,935651,2831,219;34702
Nodejs/Util.pm,938505,4944,220;34815
PERLANCAR/File/HomeDir.pm,943483,1188,221;35001
PERLANCAR/Module/List.pm,944704,2921,222;35061
Perinci/Access/Lite.pm,947656,6811,223;35143
Perinci/AccessUtil.pm,954497,2450,224;35340
Perinci/CmdLine/Base.pm,956979,44411,225;35428
Perinci/CmdLine/Help.pm,1001422,7326,226;36823
Perinci/CmdLine/Lite.pm,1008780,13087,227;37057
Perinci/CmdLine/Util/Config.pm,1021906,7499,228;37507
Perinci/Object.pm,1029431,1131,229;37769
Perinci/Object/EnvResult.pm,1030598,1591,230;37827
Perinci/Object/EnvResultMulti.pm,1032230,1060,231;37912
Perinci/Object/EnvResultTable.pm,1033331,359,232;37962
Perinci/Object/Function.pm,1033725,1337,233;37983
Perinci/Object/Metadata.pm,1035097,2643,234;38047
Perinci/Object/Package.pm,1037774,222,235;38182
Perinci/Object/ResMeta.pm,1038030,222,236;38199
Perinci/Object/Variable.pm,1038287,224,237;38216
Perinci/Result/Format/Lite.pm,1038549,17690,238;38233
Perinci/Sub/Complete.pm,1056271,45843,239;38696
Perinci/Sub/ConvertArgs/Argv.pm,1102154,4241,240;39907
Perinci/Sub/ConvertArgs/Array.pm,1106436,2051,241;40049
Perinci/Sub/DepChecker.pm,1108521,5057,242;40130
Perinci/Sub/GetArgs/Argv.pm,1113614,38488,243;40319
Perinci/Sub/GetArgs/Array.pm,1152139,3800,244;41379
Perinci/Sub/Normalize.pm,1155972,4885,245;41510
Perinci/Sub/To/CLIDocData.pm,1160894,16158,246;41662
Perinci/Sub/Util.pm,1177080,12303,247;42112
Perinci/Sub/Util/Args.pm,1189416,3131,248;42550
Perinci/Sub/Util/ResObj.pm,1192582,243,249;42667
Perinci/Sub/Util/Sort.pm,1192858,463,250;42682
Proc/ChildError.pm,1193348,1012,251;42711
Progress/Any.pm,1194384,13409,252;42761
Progress/Any/Output.pm,1207824,1286,253;43273
Progress/Any/Output/Null.pm,1209146,226,254;43337
Progress/Any/Output/TermProgressBarColor.pm,1209424,5941,255;43358
Regexp/Stringify.pm,1215393,2473,256;43574
Role/Tiny.pm,1217887,11598,257;43673
Role/Tiny/With.pm,1229511,297,258;44101
Sah/Schema/rinci/function_meta.pm,1229850,3632,259;44123
Sah/Schema/rinci/meta.pm,1233515,683,260;44261
Sah/Schema/rinci/result_meta.pm,1234238,611,261;44304
Sah/SchemaR/rinci/function_meta.pm,1234892,7833,262;44339
Sah/SchemaR/rinci/meta.pm,1242759,1990,263;44510
Sah/SchemaR/rinci/result_meta.pm,1244790,960,264;44569
Sah/Schemas/Rinci.pm,1245779,108,265;44610
Scalar/Util/Numeric/PP.pm,1245921,1353,266;44619
String/Elide/Parts.pm,1247304,4770,267;44689
String/LineNumber.pm,1252103,859,268;44842
String/PerlQuote.pm,1252990,890,269;44882
String/ShellQuote.pm,1253909,1822,270;44932
String/Wildcard/Bash.pm,1255763,2159,271;45046
Sub/Delete.pm,1257944,1622,272;45134
Test/Config/IOD/Common.pm,1259600,6053,273;45200
Test/Data/Sah.pm,1265678,9810,274;45469
Test/Data/Sah/Human.pm,1275519,934,275;45778
Test/Data/Sah/Perl.pm,1276483,4123,276;45820
Text/ANSI/BaseUtil.pm,1280636,21721,277;45945
Text/ANSI/Util.pm,1302383,903,278;46674
Text/Table/Any.pm,1303312,4431,279;46711
Text/Table/Tiny.pm,1307770,2733,280;46832
Text/sprintfn.pm,1310528,3295,281;46931
Tie/IxHash.pm,1313845,6075,282;47056
Time/Duration.pm,1319945,5577,283;47402
URI.pm,1325537,6816,284;47606
URI/Escape.pm,1332375,1725,285;47936
URI/Heuristic.pm,1334125,3511,286;48014
URI/IRI.pm,1337655,731,287;48170
URI/QueryParam.pm,1338412,1928,288;48215
URI/Split.pm,1340361,1067,289;48306
URI/URL.pm,1341447,3546,290;48352
URI/WithBase.pm,1345017,2154,291;48530
URI/data.pm,1347191,1669,292;48640
URI/file.pm,1348880,2852,293;48718
URI/file/Base.pm,1351757,1579,294;48845
URI/file/FAT.pm,1353360,433,295;48930
URI/file/Mac.pm,1353817,2184,296;48957
URI/file/OS2.pm,1356025,497,297;49075
URI/file/QNX.pm,1356546,330,298;49106
URI/file/Unix.pm,1356901,981,299;49126
URI/file/Win32.pm,1357908,1707,300;49183
URI/ftp.pm,1359634,690,301;49269
URI/gopher.pm,1360346,1608,302;49308
URI/http.pm,1361974,479,303;49384
URI/https.pm,1362474,185,304;49412
URI/ldap.pm,1362679,290,305;49427
URI/ldapi.pm,1362990,497,306;49449
URI/ldaps.pm,1363508,185,307;49479
URI/mailto.pm,1363715,1191,308;49494
URI/mms.pm,1364925,164,309;49564
URI/news.pm,1365109,1227,310;49577
URI/nntp.pm,1366356,138,311;49644
URI/pop.pm,1366513,1254,312;49655
URI/rlogin.pm,1367789,168,313;49726
URI/rsync.pm,1367978,189,314;49739
URI/rtsp.pm,1368187,164,315;49753
URI/rtspu.pm,1368372,165,316;49766
URI/sftp.pm,1368557,135,317;49779
URI/sip.pm,1368711,1574,318;49790
URI/sips.pm,1370305,184,319;49869
URI/snews.pm,1370510,187,320;49884
URI/ssh.pm,1370716,186,321;49899
URI/telnet.pm,1370924,167,322;49915
URI/tn3270.pm,1371113,167,323;49928
URI/urn.pm,1371299,2153,324;49941
URI/urn/isbn.pm,1373476,2158,325;50044
URI/urn/oid.pm,1375657,320,326;50143
YAML/Old.pm,1375997,2533,327;50164
YAML/Old/Dumper.pm,1378557,14625,328;50265
YAML/Old/Dumper/Base.pm,1393214,3367,329;50769
YAML/Old/Error.pm,1396607,5986,330;50872
YAML/Old/Loader.pm,1402620,21662,331;51063
YAML/Old/Loader/Base.pm,1424314,1025,332;51762
YAML/Old/Marshall.pm,1425368,939,333;51795
YAML/Old/Mo.pm,1426330,2688,334;51842
YAML/Old/Node.pm,1429043,4412,335;51914
YAML/Old/Tag.pm,1433479,240,336;52132
YAML/Old/Types.pm,1433745,5701,337;52151
experimental.pm,1439470,2970,338;52368

### Capture/Tiny.pm ###
#use 5.006;
#use strict;
#use warnings;
#package Capture::Tiny;
#our $VERSION = '0.44';
#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__
#
### Color/ANSI/Util.pm ###
#package Color::ANSI::Util;
#
#our $DATE = '2016-10-04'; 
#our $VERSION = '0.15'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       ansi16_to_rgb
#                       rgb_to_ansi16
#                       rgb_to_ansi16_fg_code
#                       ansi16fg
#                       rgb_to_ansi16_bg_code
#                       ansi16bg
#
#                       ansi256_to_rgb
#                       rgb_to_ansi256
#                       rgb_to_ansi256_fg_code
#                       ansi256fg
#                       rgb_to_ansi256_bg_code
#                       ansi256bg
#
#                       rgb_to_ansi24b_fg_code
#                       ansi24bfg
#                       rgb_to_ansi24b_bg_code
#                       ansi24bbg
#
#                       rgb_to_ansi_fg_code
#                       ansifg
#                       rgb_to_ansi_bg_code
#                       ansibg
#               );
#
#my %ansi16 = (
#    0  => '000000',
#    1  => '800000',
#    2  => '008000',
#    3  => '808000',
#    4  => '000080',
#    5  => '800080',
#    6  => '008080',
#    7  => 'c0c0c0',
#    8  => '808080',
#    9  => 'ff0000',
#    10 => '00ff00',
#    11 => 'ffff00',
#    12 => '0000ff',
#    13 => 'ff00ff',
#    14 => '00ffff',
#    15 => 'ffffff',
#);
#my @revansi16;
#for (sort {$a<=>$b} keys %ansi16) {
#    $ansi16{$_} =~ /(..)(..)(..)/;
#    push @revansi16, [hex($1), hex($2), hex($3), $_];
#}
#
#my %ansi256 = (
#    %ansi16,
#
#    16 => '000000',  17 => '00005f',  18 => '000087',  19 => '0000af',  20 => '0000d7',  21 => '0000ff',
#    22 => '005f00',  23 => '005f5f',  24 => '005f87',  25 => '005faf',  26 => '005fd7',  27 => '005fff',
#    28 => '008700',  29 => '00875f',  30 => '008787',  31 => '0087af',  32 => '0087d7',  33 => '0087ff',
#    34 => '00af00',  35 => '00af5f',  36 => '00af87',  37 => '00afaf',  38 => '00afd7',  39 => '00afff',
#    40 => '00d700',  41 => '00d75f',  42 => '00d787',  43 => '00d7af',  44 => '00d7d7',  45 => '00d7ff',
#    46 => '00ff00',  47 => '00ff5f',  48 => '00ff87',  49 => '00ffaf',  50 => '00ffd7',  51 => '00ffff',
#    52 => '5f0000',  53 => '5f005f',  54 => '5f0087',  55 => '5f00af',  56 => '5f00d7',  57 => '5f00ff',
#    58 => '5f5f00',  59 => '5f5f5f',  60 => '5f5f87',  61 => '5f5faf',  62 => '5f5fd7',  63 => '5f5fff',
#    64 => '5f8700',  65 => '5f875f',  66 => '5f8787',  67 => '5f87af',  68 => '5f87d7',  69 => '5f87ff',
#    70 => '5faf00',  71 => '5faf5f',  72 => '5faf87',  73 => '5fafaf',  74 => '5fafd7',  75 => '5fafff',
#    76 => '5fd700',  77 => '5fd75f',  78 => '5fd787',  79 => '5fd7af',  80 => '5fd7d7',  81 => '5fd7ff',
#    82 => '5fff00',  83 => '5fff5f',  84 => '5fff87',  85 => '5fffaf',  86 => '5fffd7',  87 => '5fffff',
#    88 => '870000',  89 => '87005f',  90 => '870087',  91 => '8700af',  92 => '8700d7',  93 => '8700ff',
#    94 => '875f00',  95 => '875f5f',  96 => '875f87',  97 => '875faf',  98 => '875fd7',  99 => '875fff',
#    100 => '878700', 101 => '87875f', 102 => '878787', 103 => '8787af', 104 => '8787d7', 105 => '8787ff',
#    106 => '87af00', 107 => '87af5f', 108 => '87af87', 109 => '87afaf', 110 => '87afd7', 111 => '87afff',
#    112 => '87d700', 113 => '87d75f', 114 => '87d787', 115 => '87d7af', 116 => '87d7d7', 117 => '87d7ff',
#    118 => '87ff00', 119 => '87ff5f', 120 => '87ff87', 121 => '87ffaf', 122 => '87ffd7', 123 => '87ffff',
#    124 => 'af0000', 125 => 'af005f', 126 => 'af0087', 127 => 'af00af', 128 => 'af00d7', 129 => 'af00ff',
#    130 => 'af5f00', 131 => 'af5f5f', 132 => 'af5f87', 133 => 'af5faf', 134 => 'af5fd7', 135 => 'af5fff',
#    136 => 'af8700', 137 => 'af875f', 138 => 'af8787', 139 => 'af87af', 140 => 'af87d7', 141 => 'af87ff',
#    142 => 'afaf00', 143 => 'afaf5f', 144 => 'afaf87', 145 => 'afafaf', 146 => 'afafd7', 147 => 'afafff',
#    148 => 'afd700', 149 => 'afd75f', 150 => 'afd787', 151 => 'afd7af', 152 => 'afd7d7', 153 => 'afd7ff',
#    154 => 'afff00', 155 => 'afff5f', 156 => 'afff87', 157 => 'afffaf', 158 => 'afffd7', 159 => 'afffff',
#    160 => 'd70000', 161 => 'd7005f', 162 => 'd70087', 163 => 'd700af', 164 => 'd700d7', 165 => 'd700ff',
#    166 => 'd75f00', 167 => 'd75f5f', 168 => 'd75f87', 169 => 'd75faf', 170 => 'd75fd7', 171 => 'd75fff',
#    172 => 'd78700', 173 => 'd7875f', 174 => 'd78787', 175 => 'd787af', 176 => 'd787d7', 177 => 'd787ff',
#    178 => 'd7af00', 179 => 'd7af5f', 180 => 'd7af87', 181 => 'd7afaf', 182 => 'd7afd7', 183 => 'd7afff',
#    184 => 'd7d700', 185 => 'd7d75f', 186 => 'd7d787', 187 => 'd7d7af', 188 => 'd7d7d7', 189 => 'd7d7ff',
#    190 => 'd7ff00', 191 => 'd7ff5f', 192 => 'd7ff87', 193 => 'd7ffaf', 194 => 'd7ffd7', 195 => 'd7ffff',
#    196 => 'ff0000', 197 => 'ff005f', 198 => 'ff0087', 199 => 'ff00af', 200 => 'ff00d7', 201 => 'ff00ff',
#    202 => 'ff5f00', 203 => 'ff5f5f', 204 => 'ff5f87', 205 => 'ff5faf', 206 => 'ff5fd7', 207 => 'ff5fff',
#    208 => 'ff8700', 209 => 'ff875f', 210 => 'ff8787', 211 => 'ff87af', 212 => 'ff87d7', 213 => 'ff87ff',
#    214 => 'ffaf00', 215 => 'ffaf5f', 216 => 'ffaf87', 217 => 'ffafaf', 218 => 'ffafd7', 219 => 'ffafff',
#    220 => 'ffd700', 221 => 'ffd75f', 222 => 'ffd787', 223 => 'ffd7af', 224 => 'ffd7d7', 225 => 'ffd7ff',
#    226 => 'ffff00', 227 => 'ffff5f', 228 => 'ffff87', 229 => 'ffffaf', 230 => 'ffffd7', 231 => 'ffffff',
#
#    232 => '080808', 233 => '121212', 234 => '1c1c1c', 235 => '262626', 236 => '303030', 237 => '3a3a3a',
#    238 => '444444', 239 => '4e4e4e', 240 => '585858', 241 => '606060', 242 => '666666', 243 => '767676',
#    244 => '808080', 245 => '8a8a8a', 246 => '949494', 247 => '9e9e9e', 248 => 'a8a8a8', 249 => 'b2b2b2',
#    250 => 'bcbcbc', 251 => 'c6c6c6', 252 => 'd0d0d0', 253 => 'dadada', 254 => 'e4e4e4', 255 => 'eeeeee',
#);
#my @revansi256;
#for (sort {$a<=>$b} keys %ansi256) {
#    $ansi256{$_} =~ /(..)(..)(..)/;
#    push @revansi256, [hex($1), hex($2), hex($3), $_];
#}
#
#sub ansi16_to_rgb {
#    my ($input) = @_;
#
#    if ($input =~ /^\d+$/) {
#        if ($input >= 0 && $input <= 15) {
#            return $ansi16{$input + 0}; 
#        } else {
#            die "Invalid ANSI 16-color number '$input'";
#        }
#    } elsif ($input =~ /^(?:(bold|bright) \s )?
#                        (black|red|green|yellow|blue|magenta|cyan|white)$/ix) {
#        my ($bold, $col) = (lc($1 // ""), lc($2));
#        my $i;
#        if ($col eq 'black') {
#            $i = 0;
#        } elsif ($col eq 'red') {
#            $i = 1;
#        } elsif ($col eq 'green') {
#            $i = 2;
#        } elsif ($col eq 'yellow') {
#            $i = 3;
#        } elsif ($col eq 'blue') {
#            $i = 4;
#        } elsif ($col eq 'magenta') {
#            $i = 5;
#        } elsif ($col eq 'cyan') {
#            $i = 6;
#        } elsif ($col eq 'white') {
#            $i = 7;
#        }
#        $i += 8 if $bold;
#        return $ansi16{$i};
#    } else {
#        die "Invalid ANSI 16-color name '$input'";
#    }
#}
#
#sub _rgb_to_indexed {
#    my ($rgb, $table) = @_;
#
#    $rgb =~ /^#?([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})$/
#        or die "Invalid RGB input '$rgb'";
#    my $r = hex($1);
#    my $g = hex($2);
#    my $b = hex($3);
#
#    my ($minsqdist, $res);
#    for my $e (@$table) {
#        my $sqdist =
#            abs($e->[0]-$r)**2 + abs($e->[1]-$g)**2 + abs($e->[2]-$b)**2;
#        return $e->[3] if $sqdist == 0;
#        if (!defined($minsqdist) || $minsqdist > $sqdist) {
#            $minsqdist = $sqdist;
#            $res = $e->[3];
#        }
#    }
#    return $res;
#}
#
#sub ansi256_to_rgb {
#    my ($input) = @_;
#
#    $input += 0;
#    exists($ansi256{$input}) or die "Invalid ANSI 256-color index '$input'";
#    $ansi256{$input};
#}
#
#sub rgb_to_ansi16 {
#    my ($input) = @_;
#    _rgb_to_indexed($input, \@revansi16);
#}
#
#sub rgb_to_ansi256 {
#    my ($input) = @_;
#    _rgb_to_indexed($input, \@revansi256);
#}
#
#sub rgb_to_ansi16_fg_code {
#    my ($input) = @_;
#
#    my $res = _rgb_to_indexed($input, \@revansi16);
#    return "\e[" . ($res >= 8 ? ($res+30-8) . ";1" : ($res+30)) . "m";
#}
#
#sub ansi16fg  { goto &rgb_to_ansi16_fg_code  }
#
#sub rgb_to_ansi16_bg_code {
#    my ($input) = @_;
#
#    my $res = _rgb_to_indexed($input, \@revansi16);
#    return "\e[" . ($res >= 8 ? ($res+40-8) : ($res+40)) . "m";
#}
#
#sub ansi16bg  { goto &rgb_to_ansi16_bg_code  }
#
#sub rgb_to_ansi256_fg_code {
#    my ($input) = @_;
#
#    my $res = _rgb_to_indexed($input, \@revansi16);
#    return "\e[38;5;${res}m";
#}
#
#sub ansi256fg { goto &rgb_to_ansi256_fg_code }
#
#sub rgb_to_ansi256_bg_code {
#    my ($input) = @_;
#
#    my $res = _rgb_to_indexed($input, \@revansi16);
#    return "\e[48;5;${res}m";
#}
#
#sub ansi256bg { goto &rgb_to_ansi256_bg_code }
#
#sub rgb_to_ansi24b_fg_code {
#    my ($rgb) = @_;
#
#    return sprintf("\e[38;2;%d;%d;%dm",
#                   hex(substr($rgb, 0, 2)),
#                   hex(substr($rgb, 2, 2)),
#                   hex(substr($rgb, 4, 2)));
#}
#
#sub ansi24bfg { goto &rgb_to_ansi24b_fg_code }
#
#sub rgb_to_ansi24b_bg_code {
#    my ($rgb) = @_;
#
#    return sprintf("\e[48;2;%d;%d;%dm",
#                   hex(substr($rgb, 0, 2)),
#                   hex(substr($rgb, 2, 2)),
#                   hex(substr($rgb, 4, 2)));
#}
#
#sub ansi24bbg { goto &rgb_to_ansi24b_bg_code }
#
#our $_use_termdetsw = 1;
#our $_color_depth; 
#sub _color_depth {
#    unless (defined $_color_depth) {
#        {
#            if (defined $ENV{COLOR} && !$ENV{COLOR}) {
#                $_color_depth = 0;
#                last;
#            }
#            if (defined $ENV{COLOR_DEPTH}) {
#                $_color_depth = $ENV{COLOR_DEPTH};
#                last;
#            }
#            if ($_use_termdetsw) {
#                eval { require Term::Detect::Software };
#                if (!$@) {
#                    $_color_depth = Term::Detect::Software::detect_terminal_cached()->{color_depth};
#                    last;
#                }
#            }
#            if ($ENV{KONSOLE_DBUS_SERVICE}) {
#                $_color_depth = 2**24;
#                last;
#            }
#            $_color_depth = 16;
#        }
#    };
#    $_color_depth;
#}
#
#sub rgb_to_ansi_fg_code {
#    my ($rgb) = @_;
#    my $cd = _color_depth();
#    if ($cd >= 2**24) {
#        rgb_to_ansi24b_fg_code($rgb);
#    } elsif ($cd >= 256) {
#        rgb_to_ansi256_fg_code($rgb);
#    } elsif ($cd >= 16) {
#        rgb_to_ansi16_fg_code($rgb);
#    } else {
#        "";
#    }
#}
#
#sub ansifg { goto &rgb_to_ansi_fg_code }
#
#sub rgb_to_ansi_bg_code {
#    my ($rgb) = @_;
#    my $cd = _color_depth();
#    if ($cd >= 2**24) {
#        rgb_to_ansi24b_bg_code($rgb);
#    } elsif ($cd >= 256) {
#        rgb_to_ansi256_bg_code($rgb);
#    } else {
#        rgb_to_ansi16_bg_code($rgb);
#    }
#}
#
#sub ansibg { goto &rgb_to_ansi_bg_code }
#
#1;
#
#__END__
#
### Complete/Bash.pm ###
#package Complete::Bash;
#
#our $DATE = '2016-12-28'; 
#our $VERSION = '0.31'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       point
#                       parse_cmdline
#                       join_wordbreak_words
#                       format_completion
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
#    my ($user, $slash) = @_;
#    my @ent;
#    if (length $user) {
#        @ent = getpwnam($user);
#    } else {
#        @ent = getpwuid($>);
#        $user = $ent[0];
#    }
#    return $ent[7] . $slash if @ent;
#    "~$user$slash"; 
#}
#
#sub _add_unquoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word, $after_ws) = @_;
#
#
#    $word =~ s!^(~)(\w*)(/|\z) |  # 1) tilde  2) username  3) optional slash
#               \\(.)           |  # 4) escaped char
#               \$(\w+)            # 5) variable name
#              !
#                  $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
#                      $4 ? $4 :
#                          ($is_cur_word ? "\$$5" : $ENV{$5})
#                              !egx;
#    $word;
#}
#
#sub _add_double_quoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word) = @_;
#
#    $word =~ s!\\(.)           |  # 1) escaped char
#               \$(\w+)            # 2) variable name
#              !
#                  $1 ? $1 :
#                      ($is_cur_word ? "\$$2" : $ENV{$2})
#                          !egx;
#    $word;
#}
#
#sub _add_single_quoted {
#    my $word = shift;
#    $word =~ s/\\(.)/$1/g;
#    $word;
#}
#
#$SPEC{point} = {
#    v => 1.1,
#    summary => 'Return line with point marked by a marker',
#    description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
#    point("^foo") # => ("foo", 0)
#    point("fo^o") # => ("foo", 2)
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line which contains a marker character',
#            schema => 'str*',
#            pos => 0,
#        },
#        marker => {
#            summary => 'Marker character',
#            schema => ['str*', len=>1],
#            default => '^',
#            pos => 1,
#        },
#    },
#    result_naked => 1,
#};
#sub point {
#    my ($line, $marker) = @_;
#    $marker //= '^';
#
#    my $point = index($line, $marker);
#    die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
#    $line =~ s/\Q$marker\E//;
#    ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
#    v => 1.1,
#    summary => 'Parse shell command-line for processing by completion routines',
#    description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
#    command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
#    ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
#    ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
#   variable substitution for `COMP_WORDS`). However, note that special shell
#   variables that are not environment variables like `$0`, `$_`, `$IFS` will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
#  By default `COMP_WORDBREAKS` is:
#
#    "'@><=;|&(:
#
#  So if raw command-line is:
#
#    command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#  then the parse result will be:
#
#    ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#  which is annoying sometimes. But we follow bash here so we can more easily
#  accept input from a joined `COMP_WORDS` if we write completion bash functions,
#  e.g. (in the example, `foo` is a Perl script):
#
#    _foo ()
#    {
#        local words=(${COMP_CWORDS[@]})
#        # add things to words, etc
#        local point=... # calculate the new point
#        COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
#    }
#
#  To avoid these word-breaking characters to be split/grouped, we can escape
#  them with backslash or quote them, e.g.:
#
#    command "http://example.com:80" Foo\:\:Bar
#
#  which bash will parse as:
#
#    ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
#  and we parse as:
#
#    ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
#  equivalent:
#
#    % cmd --foo=bar
#    % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line, defaults to COMP_LINE environment',
#            schema => 'str*',
#            pos => 0,
#        },
#        point => {
#            summary => 'Point/position to complete in command-line, '.
#                'defaults to COMP_POINT',
#            schema => 'int*',
#            pos => 1,
#        },
#        opts => {
#            summary => 'Options',
#            schema => 'hash*',
#            description => <<'_',
#
#Optional. Known options:
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
#  position of cursor, for example (`^` marks the position of cursor):
#  `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
#  doing tab completion.
#
#_
#            schema => 'hash*',
#            pos => 2,
#        },
#    },
#    result => {
#        schema => ['array*', len=>2],
#        description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in `@ARGV`), you need to strip the first element from
#`$words` and reduce `$cword` by 1.
#
#
#_
#    },
#    result_naked => 1,
#    links => [
#    ],
#};
#sub parse_cmdline {
#    no warnings 'uninitialized';
#    my ($line, $point, $opts) = @_;
#
#    $line  //= $ENV{COMP_LINE};
#    $point //= $ENV{COMP_POINT} // 0;
#
#    die "$0: COMP_LINE not set, make sure this script is run under ".
#        "bash completion (e.g. through complete -C)\n" unless defined $line;
#
#
#    my @words;
#    my $cword;
#    my $pos = 0;
#    my $pos_min_ws = 0;
#    my $after_ws = 1; 
#    my $chunk;
#    my $add_blank;
#    my $is_cur_word;
#    $line =~ s!(                                                         # 1) everything
#                  (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*)               |  #  2) open "  3) content  4) space after
#                  (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*)               |  #  5) open '  6) content  7) space after
#                  ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) |  #  8) unquoted word  9) space after
#                  ([\@><=|&\(:]+) |                                      #  10) non-whitespace word-breaking characters
#                  \s+
#              )!
#                  $pos += length($1);
#                  #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
#                  #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
#                  if ($2 || $5 || defined($8)) {
#                      # double-quoted/single-quoted/unquoted chunk
#
#                      if (not(defined $cword)) {
#                          $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
#                          #say "D:pos_min_ws=$pos_min_ws";
#                          if ($point <= $pos_min_ws) {
#                              $cword = @words - ($after_ws ? 0 : 1);
#                          } elsif ($point < $pos) {
#                              $cword = @words + 1 - ($after_ws ? 0 : 1);
#                              $add_blank = 1;
#                          }
#                      }
#
#                      if ($after_ws) {
#                          $is_cur_word = defined($cword) && $cword==@words;
#                      } else {
#                          $is_cur_word = defined($cword) && $cword==@words-1;
#                      }
#                      #say "D:is_cur_word=$is_cur_word";
#                      $chunk =
#                          $2 ? _add_double_quoted($3, $is_cur_word) :
#                              $5 ? _add_single_quoted($6) :
#                              _add_unquoted($8, $is_cur_word, $after_ws);
#                      if ($opts && $opts->{truncate_current_word} &&
#                              $is_cur_word && $pos > $point) {
#                          $chunk = substr(
#                              $chunk, 0, length($chunk)-($pos_min_ws-$point));
#                          #say "D:truncating current word to <$chunk>";
#                      }
#                      if ($after_ws) {
#                          push @words, $chunk;
#                      } else {
#                          $words[-1] .= $chunk;
#                      }
#                      if ($add_blank) {
#                          push @words, '';
#                          $add_blank = 0;
#                      }
#                      $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
#
#                  } elsif ($10) {
#                      # non-whitespace word-breaking characters
#                      push @words, $10;
#                      $after_ws = 1;
#                  } else {
#                      # whitespace
#                      $after_ws = 1;
#                  }
#    !egx;
#
#    $cword //= @words;
#    $words[$cword] //= '';
#
#    [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
#    v => 1.1,
#    summary => 'Post-process parse_cmdline() result by joining some words',
#    description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
#    "'@><=;|&(:
#
#So if command-line is:
#
#    command -MData::Dump bob@example.org
#
#then they will be parsed as:
#
#    ["command", "-MData", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
#    ["command", "-MData::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
#    my ($words, $cword) = @_;
#    my $new_words = [];
#    my $i = -1;
#    while (++$i < @$words) {
#        my $w = $words->[$i];
#        if ($w =~ /\A[\@=:]+\z/) {
#            if (@$new_words and $#$new_words != $cword) {
#                $new_words->[-1] .= $w;
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            } else {
#                push @$new_words, $w;
#            }
#            if ($i+1 < @$words) {
#                $i++;
#                $new_words->[-1] .= $words->[$i];
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            }
#        } else {
#            push @$new_words, $w;
#        }
#    }
#    [$new_words, $cword];
#}
#
#$SPEC{format_completion} = {
#    v => 1.1,
#    summary => 'Format completion for output (for shell)',
#    description => <<'_',
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the `Complete`
#POD. Aside from `words`, this function also recognizes these keys:
#
#* `as` (str): Either `string` (the default) or `array` (to return array of lines
#  instead of the lines joined together). Returning array is useful if you are
#  doing completion inside `Term::ReadLine`, for example, where the library
#  expects an array.
#
#* `esc_mode` (str): Escaping mode for entries. Either `default` (most
#  nonalphanumeric characters will be escaped), `shellvar` (like `default`, but
#  dollar sign `$` will not be escaped, convenient when completing environment
#  variables for example), `filename` (currently equals to `default`), `option`
#  (currently equals to `default`), or `none` (no escaping will be done).
#
#* `path_sep` (str): If set, will enable "path mode", useful for
#  completing/drilling-down path. Below is the description of "path mode".
#
#  In shell, when completing filename (e.g. `foo`) and there is only a single
#  possible completion (e.g. `foo` or `foo.txt`), the shell will display the
#  completion in the buffer and automatically add a space so the user can move to
#  the next argument. This is also true when completing other values like
#  variables or program names.
#
#  However, when completing directory (e.g. `/et` or `Downloads`) and there is
#  solely a single completion possible and it is a directory (e.g. `/etc` or
#  `Downloads`), the shell automatically adds the path separator character
#  instead (`/etc/` or `Downloads/`). The user can press Tab again to complete
#  for files/directories inside that directory, and so on. This is obviously more
#  convenient compared to when shell adds a space instead.
#
#  The `path_sep` option, when set, will employ a trick to mimic this behaviour.
#  The trick is, if you have a completion array of `['foo/']`, it will be changed
#  to `['foo/', 'foo/ ']` (the second element is the first element with added
#  space at the end) to prevent bash from adding a space automatically.
#
#  Path mode is not restricted to completing filesystem paths. Anything path-like
#  can use it. For example when you are completing Java or Perl module name (e.g.
#  `com.company.product.whatever` or `File::Spec::Unix`) you can use this mode
#  (with `path_sep` appropriately set to, e.g. `.` or `::`).
#
#_
#    args_as => 'array',
#    args => {
#        completion => {
#            summary => 'Completion answer structure',
#            description => <<'_',
#
#Either an array or hash. See function description for more details.
#
#_
#            schema=>['any*' => of => ['hash*', 'array*']],
#            req=>1,
#            pos=>0,
#        },
#        opts => {
#            schema=>'hash*',
#            pos=>1,
#        },
#    },
#    result => {
#        summary => 'Formatted string (or array, if `as` is set to `array`)',
#        schema => ['any*' => of => ['str*', 'array*']],
#    },
#    result_naked => 1,
#};
#sub format_completion {
#    my ($hcomp, $opts) = @_;
#
#    $opts //= {};
#
#    $hcomp = {words=>$hcomp} unless ref($hcomp) eq 'HASH';
#    my $comp     = $hcomp->{words};
#    my $as       = $hcomp->{as} // 'string';
#    my $esc_mode = $hcomp->{esc_mode} // $hcomp->{escmode} // 'default';
#    my $path_sep = $hcomp->{path_sep};
#
#    if (defined($path_sep) && @$comp == 1) {
#        my $re = qr/\Q$path_sep\E\z/;
#        my $word;
#        if (ref($comp->[0]) eq 'HASH') {
#            $comp = [$comp->[0], {word=>"$comp->[0] "}] if
#                $comp->[0]{word} =~ $re;
#        } else {
#            $comp = [$comp->[0], "$comp->[0] "]
#                if $comp->[0] =~ $re;
#        }
#    }
#
#    if (defined($opts->{word})) {
#        if ($opts->{word} =~ s/(.+[\@><=;|&\(:])//) {
#            my $prefix = $1;
#            for (@$comp) {
#                if (ref($_) eq 'HASH') {
#                    $_->{word} =~ s/\A\Q$prefix\E//i;
#                } else {
#                    s/\A\Q$prefix\E//i;
#                }
#            }
#        }
#    }
#
#    my @res;
#    for my $entry (@$comp) {
#        my $word = ref($entry) eq 'HASH' ? $entry->{word} : $entry;
#        if ($esc_mode eq 'shellvar') {
#            $word =~ s!([^A-Za-z0-9,+._/\$~-])!\\$1!g;
#        } elsif ($esc_mode eq 'none') {
#        } else {
#            $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
#        }
#        push @res, $word;
#    }
#
#    if ($as eq 'array') {
#        return \@res;
#    } else {
#        return join("", map {($_, "\n")} @res);
#    }
#}
#
#1;
#
#__END__
#
### Complete/Common.pm ###
#package Complete::Common;
#
#our $DATE = '2016-01-05'; 
#our $VERSION = '0.22'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       %arg_word
#               );
#
#our %EXPORT_TAGS = (
#    all => \@EXPORT_OK
#);
#
#our %arg_word = (
#    word => {
#        summary => 'Word to complete',
#        schema => ['str', default=>''],
#        pos=>0,
#        req=>1,
#    },
#);
#
#our $OPT_CI          = ($ENV{COMPLETE_OPT_CI}          // 1) ? 1:0;
#our $OPT_WORD_MODE   = ($ENV{COMPLETE_OPT_WORD_MODE}   // 1) ? 1:0;
#our $OPT_CHAR_MODE   = ($ENV{COMPLETE_OPT_CHAR_MODE}   // 1) ? 1:0;
#our $OPT_FUZZY       = ($ENV{COMPLETE_OPT_FUZZY}       // 1)+0;
#our $OPT_MAP_CASE    = ($ENV{COMPLETE_OPT_MAP_CASE}    // 1) ? 1:0;
#our $OPT_EXP_IM_PATH = ($ENV{COMPLETE_OPT_EXP_IM_PATH} // 1) ? 1:0;
#our $OPT_DIG_LEAF    = ($ENV{COMPLETE_OPT_DIG_LEAF}    // 1) ? 1:0;
#
#1;
#
#__END__
#
### Complete/Env.pm ###
#package Complete::Env;
#
#our $DATE = '2016-10-18'; 
#our $VERSION = '0.39'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_env
#                       complete_env_elem
#                       complete_path_env_elem
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines related to environment variables',
#};
#
#$SPEC{complete_env} = {
#    v => 1.1,
#    summary => 'Complete from environment variables',
#    description => <<'_',
#
#On Windows, environment variable names are all converted to uppercase. You can
#use case-insensitive option (`ci`) to match against original casing.
#
#_
#    args => {
#        word     => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_env {
#    require Complete::Util;
#
#    my %args  = @_;
#    my $word     = $args{word} // "";
#    if ($word =~ /^\$/) {
#        Complete::Util::complete_array_elem(
#            word=>$word, array=>[map {"\$$_"} keys %ENV],
#        );
#    } else {
#        Complete::Util::complete_array_elem(
#            word=>$word, array=>[keys %ENV],
#        );
#    }
#}
#
#$SPEC{complete_env_elem} = {
#    v => 1.1,
#    summary => 'Complete from elements of an environment variable',
#    description => <<'_',
#
#An environment variable like PATH contains colon- (or, on Windows, semicolon-)
#separated elements. This routine complete from the elements of such variable.
#
#_
#    args => {
#        word     => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
#        env      => {
#            summary => 'Name of environment variable to use',
#            schema  => 'str*',
#            req => 1,
#            pos => 1,
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_env_elem {
#    require Complete::Util;
#
#    my %args  = @_;
#    my $word  = $args{word} // "";
#    my $env   = $args{env};
#    my @elems;
#    if ($^O eq 'MSWin32') {
#        @elems = split /;/, ($ENV{$env} // '');
#    } else {
#        @elems = split /:/, ($ENV{$env} // '');
#    }
#    Complete::Util::complete_array_elem(
#        word=>$word, array=>\@elems,
#    );
#}
#
#$SPEC{complete_path_env_elem} = {
#    v => 1.1,
#    summary => 'Complete from elements of PATH environment variable',
#    description => <<'_',
#
#PATH environment variable contains colon- (or, on Windows, semicolon-) separated
#elements. This routine complete from those elements.
#
#_
#    args => {
#        word     => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_path_env_elem {
#    my %args  = @_;
#    complete_env_elem(word => $args{word}, env => 'PATH');
#}
#
#1;
#
#__END__
#
### Complete/File.pm ###
#package Complete::File;
#
#our $DATE = '2017-07-14'; 
#our $VERSION = '0.43'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_file
#                       complete_dir
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines related to files',
#};
#
#$SPEC{complete_file} = {
#    v => 1.1,
#    summary => 'Complete file and directory from local filesystem',
#    args => {
#        %arg_word,
#        filter => {
#            summary => 'Only return items matching this filter',
#            description => <<'_',
#
#Filter can either be a string or a code.
#
#For string filter, you can specify a pipe-separated groups of sequences of these
#characters: f, d, r, w, x. Dash can appear anywhere in the sequence to mean
#not/negate. An example: `f` means to only show regular files, `-f` means only
#show non-regular files, `drwx` means to show only directories which are
#readable, writable, and executable (cd-able). `wf|wd` means writable regular
#files or writable directories.
#
#For code filter, you supply a coderef. The coderef will be called for each item
#with these arguments: `$name`. It should return true if it wants the item to be
#included.
#
#_
#            schema  => ['any*' => {of => ['str*', 'code*']}],
#            tags => ['category:filtering'],
#        },
#        file_regex_filter => {
#            summary => 'Filter shortcut for file regex',
#            description => <<'_',
#
#This is a shortcut for constructing a filter. So instead of using `filter`, you
#use this option. This will construct a filter of including only directories or
#regular files, and the file must match a regex pattern. This use-case is common.
#
#_
#            schema => 're*',
#            tags => ['category:filtering'],
#        },
#        exclude_dir => {
#            schema => 'bool*',
#            description => <<'_',
#
#This is also an alternative to specifying full `filter`. Set this to true if you
#do not want directories.
#
#If you only want directories, take a look at `complete_dir()`.
#
#_
#            tags => ['category:filtering'],
#        },
#        file_ext_filter => {
#            schema => ['any*', of=>['re*', ['array*',of=>'str*']]],
#            description => <<'_',
#
#This is also an alternative to specifying full `filter` or `file_regex_filter`.
#You can set this to a regex or a set of extensions to accept. Note that like in
#`file_regex_filter`, directories of any name is also still allowed.
#
#_
#            tags => ['category:filtering'],
#        },
#        starting_path => {
#            schema  => 'str*',
#            default => '.',
#        },
#        handle_tilde => {
#            schema  => 'bool',
#            default => 1,
#        },
#        allow_dot => {
#            summary => 'If turned off, will not allow "." or ".." in path',
#            description => <<'_',
#
#This is most useful when combined with `starting_path` option to prevent user
#going up/outside the starting path.
#
#_
#            schema  => 'bool',
#            default => 1,
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_file {
#    require Complete::Path;
#    require Encode;
#    require File::Glob;
#
#    my %args   = @_;
#    my $word   = $args{word} // "";
#    my $handle_tilde = $args{handle_tilde} // 1;
#    my $allow_dot   = $args{allow_dot} // 1;
#
#    my $result_prefix;
#    my $starting_path = $args{starting_path} // '.';
#    if ($handle_tilde && $word =~ s!\A(~[^/]*)/!!) {
#        $result_prefix = "$1/";
#        my @dir = File::Glob::bsd_glob($1); 
#        return [] unless @dir;
#        $starting_path = Encode::decode('UTF-8', $dir[0]);
#    } elsif ($allow_dot && $word =~ s!\A((?:\.\.?/+)+|/+)!!) {
#        $starting_path = $1;
#        $result_prefix = $1;
#        $starting_path =~ s#/+\z## unless $starting_path =~ m!\A/!;
#    }
#
#    return [] if !$allow_dot &&
#        $word =~ m!(?:\A|/)\.\.?(?:\z|/)!;
#
#    my $list = sub {
#        my ($path, $intdir, $isint) = @_;
#        opendir my($dh), $path or return undef;
#        my @res;
#        for (sort readdir $dh) {
#            next if ($_ eq '.' || $_ eq '..') && $intdir eq '';
#            next if $isint && !(-d "$path/$_");
#            push @res, Encode::decode('UTF-8', $_);
#        }
#        \@res;
#    };
#
#
#    my $filter;
#    if ($args{filter} && !ref($args{filter})) {
#        my @seqs = split /\s*\|\s*/, $args{filter};
#        $filter = sub {
#            my $name = shift;
#            my @st = stat($name) or return 0;
#            my $mode = $st[2];
#            my $pass;
#          SEQ:
#            for my $seq (@seqs) {
#                my $neg = sub { $_[0] };
#                for my $c (split //, $seq) {
#                    if    ($c eq '-') { $neg = sub { $_[0] ? 0 : 1 } }
#                    elsif ($c eq 'r') { next SEQ unless $neg->($mode & 0400) }
#                    elsif ($c eq 'w') { next SEQ unless $neg->($mode & 0200) }
#                    elsif ($c eq 'x') { next SEQ unless $neg->($mode & 0100) }
#                    elsif ($c eq 'f') { next SEQ unless $neg->($mode & 0100000)}
#                    elsif ($c eq 'd') { next SEQ unless $neg->($mode & 0040000)}
#                    else {
#                        die "Unknown character in filter: $c (in $seq)";
#                    }
#                }
#                $pass = 1; last SEQ;
#            }
#            $pass;
#        };
#    } elsif ($args{filter} && ref($args{filter}) eq 'CODE') {
#        $filter = $args{filter};
#    }
#
#    my $filter_fregex;
#    if ($args{file_regex_filter}) {
#        $filter_fregex = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            return 1 if $name =~ $args{file_regex_filter};
#            0;
#        };
#    }
#
#    my $filter_fext;
#    if ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'Regexp') {
#        $filter_fext = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
#            return 1 if $ext =~ $args{file_ext_filter};
#            0;
#        };
#    } elsif ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'ARRAY') {
#        $filter_fext = sub {
#            my $name = shift;
#            return 1 if -d $name;
#            return 0 unless -f _;
#            my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
#            if ($Complete::Common::OPT_CI) {
#                $ext = lc($ext);
#                for my $e (@{ $args{file_ext_filter} }) {
#                    return 1 if $ext eq lc($e);
#                }
#            } else {
#                for my $e (@{ $args{file_ext_filter} }) {
#                    return 1 if $ext eq $e;
#                }
#            }
#            0;
#        };
#    }
#
#    my $filter_dir;
#    if ($args{_dir}) {
#        $filter_dir = sub { return 0 unless (-d $_[0]); 1 };
#    }
#
#    my $filter_xdir;
#    if ($args{exclude_dir}) {
#        $filter_xdir = sub { return 0 if (-d $_[0]); 1 };
#    }
#
#    my $final_filter = sub {
#        my $name = shift;
#        if ($filter_dir)    { return 0 unless $filter_dir->($name)    }
#        if ($filter_xdir)   { return 0 unless $filter_xdir->($name)   }
#        if ($filter)        { return 0 unless $filter->($name)        }
#        if ($filter_fregex) { return 0 unless $filter_fregex->($name) }
#        if ($filter_fext)   { return 0 unless $filter_fext->($name)   }
#        1;
#    };
#
#    Complete::Path::complete_path(
#        word => $word,
#        list_func => $list,
#        is_dir_func => sub { -d $_[0] },
#        filter_func => $final_filter,
#        starting_path => $starting_path,
#        result_prefix => $result_prefix,
#    );
#}
#
#$SPEC{complete_dir} = do {
#    my $spec = {%{ $SPEC{complete_file} }}; 
#
#    $spec->{summary} = 'Complete directory from local filesystem '.
#        '(wrapper for complete_dir() that only picks directories)';
#    $spec->{args} = { %{$spec->{args}} }; 
#    delete $spec->{args}{file_regex_filter};
#    delete $spec->{args}{file_ext_filter};
#    delete $spec->{args}{exclude_dir};
#
#    $spec;
#};
#sub complete_dir {
#    my %args = @_;
#
#    complete_file(%args, _dir=>1);
#}
#
#1;
#
#__END__
#
### Complete/Fish.pm ###
#package Complete::Fish;
#
#our $DATE = '2016-10-21'; 
#our $VERSION = '0.05'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       format_completion
#               );
#
#require Complete::Bash;
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion module for fish shell',
#};
#
#$SPEC{format_completion} = {
#    v => 1.1,
#    summary => 'Format completion for output (for shell)',
#    description => <<'_',
#
#fish accepts completion reply in the form of one entry per line to STDOUT.
#Description can be added to each entry, prefixed by tab character.
#
#_
#    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` key is set to `array`)',
#        schema => ['any*' => of => ['str*', 'array*']],
#    },
#    result_naked => 1,
#};
#sub format_completion {
#    my $comp = shift;
#
#    my $as;
#    my $entries;
#
#    if (ref($comp) eq 'HASH') {
#        $as = $comp->{as} // 'string';
#        $entries = Complete::Bash::format_completion({%$comp, as=>'array'});
#    } else {
#        $as = 'string';
#        $entries = Complete::Bash::format_completion({
#            words=>$comp, as=>'array',
#        });
#    }
#
#    {
#        my $compary = ref($comp) eq 'HASH' ? $comp->{words} : $comp;
#        for (my $i=0; $i<@$compary; $i++) {
#
#            my $desc = (ref($compary->[$i]) eq 'HASH' ?
#                            $compary->[$i]{description} : '' ) // '';
#            $desc =~ s/\R/ /g;
#            $entries->[$i] .= "\t$desc";
#        }
#    }
#
#    if ($as eq 'string') {
#        $entries = join("", map{"$_\n"} @$entries);
#    }
#    $entries;
#}
#
#1;
#
#__END__
#
### Complete/Getopt/Long.pm ###
#package Complete::Getopt::Long;
#
#our $DATE = '2017-01-13'; 
#our $VERSION = '0.46'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_cli_arg
#               );
#
#our %SPEC;
#
#sub _default_completion {
#    require Complete::Env;
#    require Complete::File;
#    require Complete::Util;
#
#    my %args = @_;
#    my $word = $args{word} // '';
#
#    my $fres;
#
#    if ($word =~ /\A\$/) {
#        {
#            my $compres = Complete::Env::complete_env(
#                word=>$word);
#            last unless @$compres;
#            $fres = {words=>$compres, esc_mode=>'shellvar'};
#            goto RETURN_RES;
#        }
#    }
#
#    if ($word =~ m!\A~([^/]*)\z!) {
#        {
#            eval { require Unix::Passwd::File };
#            last if $@;
#            my $res = Unix::Passwd::File::list_users(detail=>1);
#            last unless $res->[0] == 200;
#            my $compres = Complete::Util::complete_array_elem(
#                array=>[map {"~" . $_->{user} . ((-d $_->{home}) ? "/":"")}
#                            @{ $res->[2] }],
#                word=>$word,
#            );
#            last unless @$compres;
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#    }
#
#    if ($word =~ m!\A(~[^/]*)/!) {
#        $fres = {words=>Complete::File::complete_file(word=>$word),
#                 path_sep=>'/'};
#        goto RETURN_RES;
#    }
#
#    require String::Wildcard::Bash;
#    if (String::Wildcard::Bash::contains_wildcard($word)) {
#        {
#            my $compres = [glob("$word*")];
#            last unless @$compres;
#            for (@$compres) {
#                $_ .= "/" if (-d $_);
#            }
#            $fres = {words=>$compres, path_sep=>'/'};
#            goto RETURN_RES;
#        }
#    }
#    $fres = {words=>Complete::File::complete_file(word=>$word),
#             path_sep=>'/'};
#  RETURN_RES:
#    $fres;
#}
#
#sub _expand1 {
#    my ($opt, $opts) = @_;
#    my @candidates;
#    my $is_hash = ref($opts) eq 'HASH';
#    for ($is_hash ? (sort {length($a)<=>length($b)} keys %$opts) : @$opts) {
#        next unless index($_, $opt) == 0;
#        push @candidates, $is_hash ? $opts->{$_} : $_;
#        last if $opt eq $_;
#    }
#    return @candidates == 1 ? $candidates[0] : undef;
#}
#
#sub _mark_seen {
#    my ($seen_opts, $opt, $opts) = @_;
#    my $opthash = $opts->{$opt};
#    return unless $opthash;
#    my $ospec = $opthash->{ospec};
#    for (keys %$opts) {
#        my $v = $opts->{$_};
#        $seen_opts->{$_}++ if $v->{ospec} eq $ospec;
#    }
#}
#
#$SPEC{complete_cli_arg} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using '.
#        'Getopt::Long specification',
#    description => <<'_',
#
#This routine can complete option names, where the option names are retrieved
#from <pm:Getopt::Long> specification. If you provide completion routine in
#`completion`, you can also complete _option values_ and _arguments_.
#
#Note that this routine does not use <pm:Getopt::Long> (it does its own parsing)
#and currently is not affected by Getopt::Long's configuration. Its behavior
#mimics Getopt::Long under these configuration: `no_ignore_case`, `bundling` (or
#`no_bundling` if the `bundling` option is turned off). Which I think is the
#sensible default. This routine also does not currently support `auto_help` and
#`auto_version`, so you'll need to add those options specifically if you want to
#recognize `--help/-?` and `--version`, respectively.
#
#_
#    args => {
#        getopt_spec => {
#            summary => 'Getopt::Long specification',
#            schema  => 'hash*',
#            req     => 1,
#        },
#        completion => {
#            summary     =>
#                'Completion routine to complete option value/argument',
#            schema      => 'code*',
#            description => <<'_',
#
#Completion code will receive a hash of arguments (`%args`) containing these
#keys:
#
#* `type` (str, what is being completed, either `optval`, or `arg`)
#* `word` (str, word to be completed)
#* `cword` (int, position of words in the words array, starts from 0)
#* `opt` (str, option name, e.g. `--str`; undef if we're completing argument)
#* `ospec` (str, Getopt::Long option spec, e.g. `str|S=s`; undef when completing
#  argument)
#* `argpos` (int, argument position, zero-based; undef if type='optval')
#* `nth` (int, the number of times this option has seen before, starts from 0
#  that means this is the first time this option has been seen; undef when
#  type='arg')
#* `seen_opts` (hash, all the options seen in `words`)
#* `parsed_opts` (hash, options parsed the standard/raw way)
#
#as well as all keys from `extras` (but these won't override the above keys).
#
#and is expected to return a completion answer structure as described in
#`Complete` which is either a hash or an array. The simplest form of answer is
#just to return an array of strings. The various `complete_*` function like those
#in <pm:Complete::Util> or the other `Complete::*` modules are suitable to use
#here.
#
#Completion routine can also return undef to express declination, in which case
#the default completion routine will then be consulted. The default routine
#completes from shell environment variables (`$FOO`), Unix usernames (`~foo`),
#and files/directories.
#
#Example:
#
#    use Complete::Unix qw(complete_user);
#    use Complete::Util qw(complete_array_elem);
#    complete_cli_arg(
#        getopt_spec => {
#            'help|h'   => sub{...},
#            'format=s' => \$format,
#            'user=s'   => \$user,
#        },
#        completion  => sub {
#            my %args  = @_;
#            my $word  = $args{word};
#            my $ospec = $args{ospec};
#            if ($ospec && $ospec eq 'format=s') {
#                complete_array_elem(array=>[qw/json text xml yaml/], word=>$word);
#            } else {
#                complete_user(word=>$word);
#            }
#        },
#    );
#
#_
#        },
#        words => {
#            summary     => 'Command line arguments, like @ARGV',
#            description => <<'_',
#
#See function `parse_cmdline` in <pm:Complete::Bash> on how to produce this (if
#you're using bash).
#
#_
#            schema      => 'array*',
#            req         => 1,
#        },
#        cword => {
#            summary     =>
#                "Index in words of the word we're trying to complete",
#            description => <<'_',
#
#See function `parse_cmdline` in <pm:Complete::Bash> on how to produce this (if
#you're using bash).
#
#_
#            schema      => 'int*',
#            req         => 1,
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `type`, `word`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#        bundling => {
#            schema  => 'bool*',
#            default => 1,
#            'summary.alt.bool.not' => 'Turn off bundling',
#            description => <<'_',
#
#If you turn off bundling, completion of short-letter options won't support
#bundling (e.g. `-b<tab>` won't add more single-letter options), but single-dash
#multiletter options can be recognized. Currently only those specified with a
#single dash will be completed. For example if you have `-foo=s` in your option
#specification, `-f<tab>` can complete it.
#
#This can be used to complete old-style programs, e.g. emacs which has options
#like `-nw`, `-nbc` etc (but also have double-dash options like
#`--no-window-system` or `--no-blinking-cursor`).
#
#_
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => ['any*' => of => ['hash*', 'array*']],
#        description => <<'_',
#
#You can use `format_completion` function in <pm:Complete::Bash> module to format
#the result of this function for bash.
#
#_
#    },
#};
#sub complete_cli_arg {
#    require Complete::Util;
#    require Getopt::Long::Util;
#
#    my %args = @_;
#
#    my $fname = __PACKAGE__ . "::complete_cli_arg"; 
#    my $fres;
#
#    $args{words} or die "Please specify words";
#    my @words = @{ $args{words} };
#    defined(my $cword = $args{cword}) or die "Please specify cword";
#    my $gospec = $args{getopt_spec} or die "Please specify getopt_spec";
#    my $comp = $args{completion};
#    my $extras = $args{extras} // {};
#    my $bundling = $args{bundling} // 1;
#    my %parsed_opts;
#
#
#    my %opts;
#    for my $ospec (keys %$gospec) {
#        my $res = Getopt::Long::Util::parse_getopt_long_opt_spec($ospec)
#            or die "Can't parse option spec '$ospec'";
#        next if $res->{is_arg};
#        $res->{min_vals} //= $res->{type} ? 1 : 0;
#        $res->{max_vals} //= $res->{type} || $res->{opttype} ? 1:0;
#        for my $o0 (@{ $res->{opts} }) {
#            my @o = $res->{is_neg} && length($o0) > 1 ?
#                ($o0, "no$o0", "no-$o0") : ($o0);
#            for my $o (@o) {
#                my $k = length($o)==1 ||
#                    (!$bundling && $res->{dash_prefix} eq '-') ?
#                        "-$o" : "--$o";
#                $opts{$k} = {
#                    name => $k,
#                    ospec => $ospec, 
#                    parsed => $res,
#                };
#            }
#        }
#    }
#    my @optnames = sort keys %opts;
#
#    my %seen_opts;
#
#
#    my @expects;
#
#    my $i = -1;
#    my $argpos = 0;
#
#  WORD:
#    while (1) {
#        last WORD if ++$i >= @words;
#        my $word = $words[$i];
#
#        if ($word eq '--' && $i != $cword) {
#            $expects[$i] = {separator=>1};
#            while (1) {
#                $i++;
#                last WORD if $i >= @words;
#                $expects[$i] = {arg=>1, argpos=>$argpos++};
#            }
#        }
#
#        if ($word =~ /\A-/) {
#
#          SHORT_OPTS:
#            {
#                last unless $opts{"-".substr($word,1,1)};
#
#                last unless $bundling;
#
#                my $j = $i;
#                my $rest = substr($word, 1);
#                my @inswords;
#                my $encounter_equal_sign;
#              EXPAND:
#                while (1) {
#                    $rest =~ s/(.)// or last;
#                    my $opt = "-$1";
#                    my $opthash = $opts{$opt};
#                    unless ($opthash) {
#                        @inswords = ();
#                        $expects[$i]{short_only} = 0;
#                        $rest = $word;
#                        last EXPAND;
#                    }
#                    if ($opthash->{parsed}{max_vals}) {
#                        _mark_seen(\%seen_opts, $opt, \%opts);
#
#                        if ($i == $j) {
#                            $words[$i] = $opt;
#                        } else {
#                            push @inswords, $opt;
#                            $j++;
#                        }
#
#                        my $expand;
#                        if (length $rest) {
#                            $expand++;
#                            $expects[$j > $i ? $j+1 : $j+2]{do_complete_optname} = 0;
#                            $expects[$j > $i ? $j+1 : $j+2]{optval} = $opt;
#                        } else {
#                            $expects[$j > $i ? $j-1 : $j]{optname} = $opt;
#                            $expects[$j > $i ? $j-1 : $j]{comp_result} = [
#                                substr($word, 0, length($word)-length($rest))];
#                        }
#
#                        if ($rest =~ s/\A=//) {
#                            $encounter_equal_sign++;
#                        }
#
#                        if ($expand) {
#                            push @inswords, "=", $rest;
#                            $j+=2;
#                        }
#                        last EXPAND;
#                    }
#                    _mark_seen(\%seen_opts, $opt, \%opts);
#                    if ($i == $j) {
#                        $words[$i] = $opt;
#                    } else {
#                        push @inswords, $opt;
#                    }
#                    $j++;
#                }
#
#
#                my $prefix = $encounter_equal_sign ? '' :
#                    substr($word, 0, length($word)-length($rest));
#                splice @words, $i+1, 0, @inswords;
#                for (0..@inswords) {
#                    $expects[$i+$_]{prefix} = $prefix;
#                    $expects[$i+$_]{word}   = $rest;
#                }
#                $cword += @inswords;
#                $i += @inswords;
#                $word = $words[$i];
#                $expects[$i]{short_only} //= 1;
#            } 
#
#          SPLIT_EQUAL:
#            {
#                if ($word =~ /\A(--?[^=]+)(=)(.*)/) {
#                    splice @words, $i, 1, $1, $2, $3;
#                    $word = $1;
#                    $cword += 2 if $cword >= $i;
#                }
#            }
#
#            my $opt = $word;
#            my $opthash = _expand1($opt, \%opts);
#
#            if ($opthash) {
#                $opt = $opthash->{name};
#                $expects[$i]{optname} = $opt;
#                my $nth = $seen_opts{$opt} // 0;
#                $expects[$i]{nth} = $nth;
#                _mark_seen(\%seen_opts, $opt, \%opts);
#
#                my $min_vals = $opthash->{parsed}{min_vals};
#                my $max_vals = $opthash->{parsed}{max_vals};
#
#                if ($i+1 < @words && $words[$i+1] eq '=') {
#                    $i++;
#                    $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
#                    if (!$max_vals) { $min_vals = $max_vals = 1 }
#                }
#
#                for (1 .. $min_vals) {
#                    $i++;
#                    last WORD if $i >= @words;
#                    $expects[$i]{optval} = $opt;
#                    $expects[$i]{nth} = $nth;
#                    push @{ $parsed_opts{$opt} }, $words[$i];
#                }
#                for (1 .. $max_vals-$min_vals) {
#                    last if $i+$_ >= @words;
#                    last if $words[$i+$_] =~ /\A-/; 
#                    $expects[$i+$_]{optval} = $opt; 
#                    $expects[$i]{nth} = $nth;
#                    push @{ $parsed_opts{$opt} }, $words[$i+$_];
#                }
#            } else {
#                $opt = undef;
#                $expects[$i]{optname} = $opt;
#
#                if ($i+1 < @words && $words[$i+1] eq '=') {
#                    $i++;
#                    $expects[$i] = {separator=>1, optval=>undef, word=>''};
#                    if ($i+1 < @words) {
#                        $i++;
#                        $expects[$i]{optval} = $opt;
#                    }
#                }
#            }
#        } else {
#            $expects[$i]{optname} = '';
#            $expects[$i]{arg} = 1;
#            $expects[$i]{argpos} = $argpos++;
#        }
#    }
#
#    my $exp = $expects[$cword];
#    my $word = $exp->{word} // $words[$cword];
#
#
#    my @answers;
#
#    {
#        last if $word =~ /\A[^-]/;
#        last unless exists $exp->{optname};
#        last if defined($exp->{do_complete_optname}) &&
#            !$exp->{do_complete_optname};
#        if ($exp->{comp_result}) {
#            push @answers, $exp->{comp_result};
#            last;
#        }
#        my $opt = $exp->{optname};
#        my @o;
#        for (@optnames) {
#            my $repeatable = 0;
#            next if $exp->{short_only} && /\A--/;
#            if ($seen_opts{$_}) {
#                my $opthash = $opts{$_};
#                my $ospecval = $gospec->{$opthash->{ospec}};
#                my $parsed = $opthash->{parsed};
#                if (ref($ospecval) eq 'ARRAY') {
#                    $repeatable = 1;
#                } elsif ($parsed->{desttype} || $parsed->{is_inc}) {
#                    $repeatable = 1;
#                }
#            }
#            next if $seen_opts{$_} && !$repeatable && (
#                (!$opt || $opt ne $_) ||
#                    (defined($exp->{prefix}) &&
#                         index($exp->{prefix}, substr($opt, 1, 1)) >= 0));
#            if (defined $exp->{prefix}) {
#                my $o = $_; $o =~ s/\A-//;
#                push @o, "$exp->{prefix}$o";
#            } else {
#                push @o, $_;
#            }
#        }
#        my $compres = Complete::Util::complete_array_elem(
#            array => \@o, word => $word);
#        push @answers, $compres;
#        if (!exists($exp->{optval}) && !exists($exp->{arg})) {
#            $fres = {words=>$compres, esc_mode=>'option'};
#            goto RETURN_RES;
#        }
#    }
#
#    {
#        last unless exists($exp->{optval});
#        my $opt = $exp->{optval};
#        my $opthash = $opts{$opt} if $opt;
#        my %compargs = (
#            %$extras,
#            type=>'optval', words=>\@words, cword=>$args{cword},
#            word=>$word, opt=>$opt, ospec=>$opthash->{ospec},
#            argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
#            parsed_opts=>\%parsed_opts,
#        );
#        my $compres;
#        if ($comp) {
#            $compres = $comp->(%compargs);
#            Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
#                if defined $exp->{prefix};
#        }
#        if (!$compres || !$comp) {
#            $compres = _default_completion(%compargs);
#            Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix})
#                if defined $exp->{prefix};
#        }
#        push @answers, $compres;
#    }
#
#    {
#        last unless exists($exp->{arg});
#        my %compargs = (
#            %$extras,
#            type=>'arg', words=>\@words, cword=>$args{cword},
#            word=>$word, opt=>undef, ospec=>undef,
#            argpos=>$exp->{argpos}, seen_opts=>\%seen_opts,
#            parsed_opts=>\%parsed_opts,
#        );
#        my $compres = $comp->(%compargs) if $comp;
#        if (!defined $compres) {
#            $compres = _default_completion(%compargs);
#        }
#        push @answers, $compres;
#    }
#
#    $fres = Complete::Util::combine_answers(@answers) // [];
#
#  RETURN_RES:
#    $fres;
#}
#
#1;
#
#__END__
#
### Complete/Path.pm ###
#package Complete::Path;
#
#our $DATE = '2017-07-03'; 
#our $VERSION = '0.24'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#our $COMPLETE_PATH_TRACE = $ENV{COMPLETE_PATH_TRACE} // 0;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_path
#               );
#
#sub _dig_leaf {
#    my ($p, $list_func, $is_dir_func, $filter_func, $path_sep) = @_;
#    my $num_dirs;
#    my $listres = $list_func->($p, '', 0);
#    return $p unless ref($listres) eq 'ARRAY' && @$listres;
#    my @candidates;
#  L1:
#    for my $e (@$listres) {
#        my $p2 = $p =~ m!\Q$path_sep\E\z! ? "$p$e" : "$p$path_sep$e";
#        {
#            local $_ = $p2; 
#            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 = '2017-07-03'; 
#our $VERSION = '0.59'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Complete::Common qw(:all);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       hashify_answer
#                       arrayify_answer
#                       combine_answers
#                       modify_answer
#                       ununiquify_answer
#                       complete_array_elem
#                       complete_hash_key
#                       complete_comma_sep
#               );
#
#our %SPEC;
#
#our $COMPLETE_UTIL_TRACE = $ENV{COMPLETE_UTIL_TRACE} // 0;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'General completion routine',
#    description => <<'_',
#
#This package provides some generic completion routines that follow the
#<pm:Complete> convention. (If you are looking for bash/shell tab completion
#routines, take a look at the See Also section.) The main routine is
#`complete_array_elem` which tries to complete a word using choices from elements
#of supplied array. For example:
#
#    complete_array_elem(word => "a", array => ["apple", "apricot", "banana"]);
#
#The routine will first try a simple substring prefix matching. If that fails,
#will try some other methods like word-mode, character-mode, or fuzzy matching.
#These methods can be disabled using settings.
#
#There are other utility routines e.g. for converting completion answer structure
#from hash to array/array to hash, combine or modify answer, etc. These routines
#are usually used by the other more specific or higher-level completion modules.
#
#_
#};
#
#$SPEC{hashify_answer} = {
#    v => 1.1,
#    summary => 'Make sure we return completion answer in hash form',
#    description => <<'_',
#
#This function accepts a hash or an array. If it receives an array, will convert
#the array into `{words=>$ary}' first to make sure the completion answer is in
#hash form.
#
#Then will add keys from `meta` to the hash.
#
#_
#    args => {
#        arg => {
#            summary => '',
#            schema  => ['any*' => of => ['array*','hash*']],
#            req => 1,
#            pos => 0,
#        },
#        meta => {
#            summary => 'Metadata (extra keys) for the hash',
#            schema  => 'hash*',
#            pos => 1,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#    },
#};
#sub hashify_answer {
#    my $ans = shift;
#    if (ref($ans) ne 'HASH') {
#        $ans = {words=>$ans};
#    }
#    if (@_) {
#        my $meta = shift;
#        for (keys %$meta) {
#            $ans->{$_} = $meta->{$_};
#        }
#    }
#    $ans;
#}
#
#$SPEC{arrayify_answer} = {
#    v => 1.1,
#    summary => 'Make sure we return completion answer in array form',
#    description => <<'_',
#
#This is the reverse of `hashify_answer`. It accepts a hash or an array. If it
#receives a hash, will return its `words` key.
#
#_
#    args => {
#        arg => {
#            summary => '',
#            schema  => ['any*' => of => ['array*','hash*']],
#            req => 1,
#            pos => 0,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'array*',
#    },
#};
#sub arrayify_answer {
#    my $ans = shift;
#    if (ref($ans) eq 'HASH') {
#        $ans = $ans->{words};
#    }
#    $ans;
#}
#
#sub __min(@) {
#    my $m = $_[0];
#    for (@_) {
#        $m = $_ if $_ < $m;
#    }
#    $m;
#}
#
#our $code_editdist;
#our $editdist_flex;
#
#sub __editdist {
#    my @a = split //, shift;
#    my @b = split //, shift;
#
#    my @d;
#    $d[$_][0] = $_ for 0 .. @a;
#    $d[0][$_] = $_ for 0 .. @b;
#
#    for my $i (1 .. @a) {
#        for my $j (1 .. @b) {
#            $d[$i][$j] = (
#                $a[$i-1] eq $b[$j-1]
#                    ? $d[$i-1][$j-1]
#                    : 1 + __min(
#                        $d[$i-1][$j],
#                        $d[$i][$j-1],
#                        $d[$i-1][$j-1]
#                    )
#                );
#        }
#    }
#
#    $d[@a][@b];
#}
#
#my %complete_array_elem_args = (
#    %arg_word,
#    array       => {
#        schema => ['array*'=>{of=>'str*'}],
#        req => 1,
#        pos => 1,
#        greedy => 1,
#    },
#    exclude     => {
#        schema => ['array*'],
#    },
#    replace_map => {
#        schema => ['hash*', each_value=>['array*', of=>'str*']],
#        description => <<'_',
#
#You can supply correction entries in this option. An example is when array if
#`['mount','unmount']` and `umount` is a popular "typo" for `unmount`. When
#someone already types `um` it cannot be completed into anything (even the
#current fuzzy mode will return *both* so it cannot complete immediately).
#
#One solution is to add replace_map `{'unmount'=>['umount']}`. This way, `umount`
#will be regarded the same as `unmount` and when user types `um` it can be
#completed unambiguously into `unmount`.
#
#_
#        tags => ['experimental'],
#    },
#);
#
#$SPEC{complete_array_elem} = {
#    v => 1.1,
#    summary => 'Complete from array',
#    description => <<'_',
#
#Try to find completion from an array of strings. Will attempt several methods,
#from the cheapest and most discriminating to the most expensive and least
#discriminating: normal string prefix matching, word-mode matching (see
#`Complete::Common::OPT_WORD_MODE` for more details), char-mode matching (see
#`Complete::Common::OPT_CHAR_MODE` for more details), and fuzzy matching (see
#`Complete::Common::OPT_FUZZY` for more details).
#
#Will sort the resulting completion list, so you don't have to presort the array.
#
#_
#    args => {
#        %complete_array_elem_args,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_array_elem {
#    my %args  = @_;
#
#    my $array0    = $args{array} or die "Please specify array";
#    my $word      = $args{word} // "";
#
#    my $ci          = $Complete::Common::OPT_CI;
#    my $map_case    = $Complete::Common::OPT_MAP_CASE;
#    my $word_mode   = $Complete::Common::OPT_WORD_MODE;
#    my $char_mode   = $Complete::Common::OPT_CHAR_MODE;
#    my $fuzzy       = $Complete::Common::OPT_FUZZY;
#
#    log_trace("[computil] entering complete_array_elem(), word=<%s>", $word)
#        if $COMPLETE_UTIL_TRACE;
#
#    my $res;
#
#    unless (@$array0) {
#        $res = []; goto RETURN_RES;
#    }
#
#    my $wordn = $ci ? uc($word) : $word; $wordn =~ s/_/-/g if $map_case;
#
#    my $excluden;
#    if ($args{exclude}) {
#        $excluden = {};
#        for my $el (@{$args{exclude}}) {
#            my $eln = $ci ? uc($el) : $el; $eln =~ s/_/-/g if $map_case;
#            $excluden->{$eln} //= 1;
#        }
#    }
#
#    my $rmapn;
#    my $rev_rmapn; 
#    if (my $rmap = $args{replace_map}) {
#        $rmapn = {};
#        $rev_rmapn = {};
#        for my $k (keys %$rmap) {
#            my $kn = $ci ? uc($k) : $k; $kn =~ s/_/-/g if $map_case;
#            my @vn;
#            for my $v (@{ $rmap->{$k} }) {
#                my $vn = $ci ? uc($v) : $v; $vn =~ s/_/-/g if $map_case;
#                push @vn, $vn;
#                $rev_rmapn->{$vn} //= $k;
#            }
#            $rmapn->{$kn} = \@vn;
#        }
#    }
#
#    my @words; 
#    my @array ;  
#    my @arrayn;  
#
#    log_trace("[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_trace("[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_trace("[computil] Trying word-mode matching (re=%s) ...", $re) if $COMPLETE_UTIL_TRACE;
#
#        for my $i (0..$#array) {
#            my $match;
#            {
#                if ($arrayn[$i] =~ $re) {
#                    $match++;
#                    last;
#                }
#                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_trace("[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_trace("[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_trace("[computil] Result from char-mode matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#    }
#
#    if ($fuzzy && !@words) {
#        log_trace("[computil] Trying fuzzy matching ...") if $COMPLETE_UTIL_TRACE;
#        $code_editdist //= do {
#            my $env = $ENV{COMPLETE_UTIL_LEVENSHTEIN} // '';
#            if ($env eq 'xs') {
#                require Text::Levenshtein::XS;
#                $editdist_flex = 0;
#                \&Text::Levenshtein::XS::distance;
#            } elsif ($env eq 'flexible') {
#                require Text::Levenshtein::Flexible;
#                $editdist_flex = 1;
#                \&Text::Levenshtein::Flexible::levenshtein_l;
#            } elsif ($env eq 'pp') {
#                $editdist_flex = 0;
#                \&__editdist;
#            } elsif (eval { require Text::Levenshtein::Flexible; 1 }) {
#                $editdist_flex = 1;
#                \&Text::Levenshtein::Flexible::levenshtein_l;
#            } else {
#                $editdist_flex = 0;
#                \&__editdist;
#            }
#        };
#
#        my $factor = 1.3;
#        my $x = -1;
#        my $y = 1;
#
#
#        my %editdists;
#      ELEM:
#        for my $i (0..$#array) {
#            my $eln = $arrayn[$i];
#
#            for my $l (length($wordn)-$y .. length($wordn)+$y) {
#                next if $l <= 0;
#                my $chopped = substr($eln, 0, $l);
#                my $maxd = __min(
#                    __min(length($chopped), length($word))/$factor,
#                    $fuzzy,
#                );
#                my $d;
#                unless (defined $editdists{$chopped}) {
#                    if ($editdist_flex) {
#                        $d = $code_editdist->($wordn, $chopped, $maxd);
#                        next ELEM unless defined $d;
#                    } else {
#                        $d = $code_editdist->($wordn, $chopped);
#                    }
#                    $editdists{$chopped} = $d;
#                } else {
#                    $d = $editdists{$chopped};
#                }
#                next unless $d <= $maxd;
#                push @words, $array[$i];
#                next ELEM;
#            }
#        }
#        log_trace("[computil] Result from fuzzy matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
#    }
#
#    if ($rmapn && @words) {
#        my @wordsn;
#        for my $el (@words) {
#            my $eln = $ci ? uc($el) : $el; $eln =~ s/_/-/g if $map_case;
#            push @wordsn, $eln;
#        }
#        for my $i (0..$#words) {
#            if (my $w = $rev_rmapn->{$wordsn[$i]}) {
#                $words[$i] = $w;
#            }
#        }
#    }
#
#    $res =$ci ? [sort {lc($a) cmp lc($b)} @words] : [sort @words];
#
#  RETURN_RES:
#    log_trace("[computil] leaving complete_array_elem(), res=%s", $res)
#        if $COMPLETE_UTIL_TRACE;
#    $res;
#}
#
#$SPEC{complete_hash_key} = {
#    v => 1.1,
#    summary => 'Complete from hash keys',
#    args => {
#        %arg_word,
#        hash      => { schema=>['hash*'=>{}], req=>1 },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_hash_key {
#    my %args  = @_;
#    my $hash      = $args{hash} or die "Please specify hash";
#    my $word      = $args{word} // "";
#
#    complete_array_elem(
#        word=>$word, array=>[sort keys %$hash],
#    );
#}
#
#my %complete_comma_sep_args = (
#    %complete_array_elem_args,
#    sep => {
#        schema  => 'str*',
#        default => ',',
#    },
#    uniq => {
#        summary => 'Whether list should contain unique elements',
#        description => <<'_',
#
#When this option is set to true, if the formed list in the current word already
#contains an element, the element will not be offered again as completion answer.
#For example, if `elems` is `[1,2,3,4]` and `word` is `2,3,` then without `uniq`
#set to true the completion answer is:
#
#    2,3,1
#    2,3,2
#    2,3,3
#    2,3,4
#
#but with `uniq` set to true, the completion answer becomes:
#
#    2,3,1
#    2,3,4
#
#See also the `remaining` option for a more general mechanism of offering fewer
#elements.
#
#_
#        schema => ['bool*', is=>1],
#    },
#    remaining => {
#        schema => ['code*'],
#        summary => 'What elements should remain for completion',
#        description => <<'_',
#
#This is a more general mechanism if the `uniq` option does not suffice. Suppose
#you are offering completion for sorting fields. The elements are field names as
#well as field names prefixed with dash (`-`) to mean sorting with a reverse
#order. So for example `elems` is `["name","-name","age","-age"]`. When current
#word is `name`, it doesn't make sense to offer `name` nor `-name` again as the
#next sorting field. So we can set `remaining` to this code:
#
#    sub {
#        my ($seen_elems, $elems) = @_;
#
#        my %seen;
#        for (@$seen_elems) {
#            (my $nodash = $_) =~ s/^-//;
#            $seen{$nodash}++;
#        }
#
#        my @remaining;
#        for (@$elems) {
#            (my $nodash = $_) =~ s/^-//;
#            push @remaining, $_ unless $seen{$nodash};
#        }
#
#        \@remaining;
#    }
#
#As you can see above, the code is given `$seen_elems` and `$elems` as arguments
#and is expected to return remaining elements to offer.
#
#_
#        tags => ['hidden-cli'],
#    },
#);
#$complete_comma_sep_args{elems} = delete $complete_comma_sep_args{array};
#
#$SPEC{complete_comma_sep} = {
#    v => 1.1,
#    summary => 'Complete a comma-separated list string',
#    args => {
#        %complete_comma_sep_args,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array',
#    },
#};
#sub complete_comma_sep {
#    my %args  = @_;
#    my $word      = delete $args{word} // "";
#    my $sep       = delete $args{sep} // ',';
#    my $elems     = delete $args{elems} or die "Please specify elems";
#    my $uniq      = delete $args{uniq};
#    my $remaining = delete $args{remaining};
#
#    my $ci = $Complete::Common::OPT_CI;
#
#    my @mentioned_elems = split /\Q$sep\E/, $word, -1;
#    my $cae_word = @mentioned_elems ? pop(@mentioned_elems) : '';
#
#    my $remaining_elems;
#    if ($remaining) {
#        $remaining_elems = $remaining->(\@mentioned_elems, $elems);
#    } elsif ($uniq) {
#        my %mem;
#        $remaining_elems = [];
#        for (@mentioned_elems) {
#            if ($ci) { $mem{lc $_}++ } else { $mem{$_}++ }
#        }
#        for (@$elems) {
#            push @$remaining_elems, $_ unless ($ci ? $mem{lc $_} : $mem{$_});
#        }
#    } else {
#        $remaining_elems = $elems;
#    }
#
#    my $cae_res = complete_array_elem(
#        %args,
#        word  => $cae_word,
#        array => $remaining_elems,
#    );
#
#    my $prefix = join($sep, @mentioned_elems);
#    $prefix .= $sep if @mentioned_elems;
#    $cae_res = [map { "$prefix$_" } @$cae_res];
#
#    {
#        last unless @$cae_res == 1;
#        last if @$remaining_elems <= 1;
#        $cae_res->[0] .= $sep;
#    }
#    $cae_res;
#}
#
#$SPEC{combine_answers} = {
#    v => 1.1,
#    summary => 'Given two or more answers, combine them into one',
#    description => <<'_',
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool <prog:cpanm>, which accepts a filename (a tarball like
#`*.tar.gz`), a directory, or a module name. You can do something like this:
#
#    combine_answers(
#        complete_file(word=>$word),
#        complete_module(word=>$word),
#    );
#
#But if a completion answer has a metadata `final` set to true, then that answer
#is used as the final answer without any combining with the other answers.
#
#_
#    args => {
#        answers => {
#            schema => [
#                'array*' => {
#                    of => ['any*', of=>['hash*','array*']], 
#                    min_len => 1,
#                },
#            ],
#            req => 1,
#            pos => 0,
#            greedy => 1,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#        description => <<'_',
#
#Return a combined completion answer. Words from each input answer will be
#combined, order preserved and duplicates removed. The other keys from each
#answer will be merged.
#
#_
#    },
#};
#sub combine_answers {
#    require List::Util;
#
#    return undef unless @_;
#    return $_[0] if @_ < 2;
#
#    my $final = {words=>[]};
#    my $encounter_hash;
#    my $add_words = sub {
#        my $words = shift;
#        for my $entry (@$words) {
#            push @{ $final->{words} }, $entry
#                unless List::Util::first(
#                    sub {
#                        (ref($entry) ? $entry->{word} : $entry)
#                            eq
#                                (ref($_) ? $_->{word} : $_)
#                            }, @{ $final->{words} }
#                        );
#        }
#    };
#
#  ANSWER:
#    for my $ans (@_) {
#        if (ref($ans) eq 'ARRAY') {
#            $add_words->($ans);
#        } elsif (ref($ans) eq 'HASH') {
#            $encounter_hash++;
#
#            if ($ans->{final}) {
#                $final = $ans;
#                last ANSWER;
#            }
#
#            $add_words->($ans->{words} // []);
#            for (keys %$ans) {
#                if ($_ eq 'words') {
#                    next;
#                } elsif ($_ eq 'static') {
#                    if (exists $final->{$_}) {
#                        $final->{$_} &&= $ans->{$_};
#                    } else {
#                        $final->{$_} = $ans->{$_};
#                    }
#                } else {
#                    $final->{$_} = $ans->{$_};
#                }
#            }
#        }
#    }
#
#    if ($final->{words}) {
#        $final->{words} = [
#            sort {
#                (ref($a) ? $a->{word} : $a) cmp
#                    (ref($b) ? $b->{word} : $b);
#            }
#                @{ $final->{words} }];
#    }
#
#    $encounter_hash ? $final : $final->{words};
#}
#
#$SPEC{modify_answer} = {
#    v => 1.1,
#    summary => 'Modify answer (add prefix/suffix, etc)',
#    args => {
#        answer => {
#            schema => ['any*', of=>['hash*','array*']], 
#            req => 1,
#            pos => 0,
#        },
#        suffix => {
#            schema => 'str*',
#        },
#        prefix => {
#            schema => 'str*',
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'undef',
#    },
#};
#sub modify_answer {
#    my %args = @_;
#
#    my $answer = $args{answer};
#    my $words = ref($answer) eq 'HASH' ? $answer->{words} : $answer;
#
#    if (defined(my $prefix = $args{prefix})) {
#        $_ = "$prefix$_" for @$words;
#    }
#    if (defined(my $suffix = $args{suffix})) {
#        $_ = "$_$suffix" for @$words;
#    }
#    undef;
#}
#
#$SPEC{ununiquify_answer} = {
#    v => 1.1,
#    summary => 'If answer contains only one item, make it two',
#    description => <<'_',
#
#For example, if answer is `["a"]`, then will make answer become `["a","a "]`.
#This will prevent shell from automatically adding space.
#
#_
#    args => {
#        answer => {
#            schema => ['any*', of=>['hash*','array*']], 
#            req => 1,
#            pos => 0,
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'undef',
#    },
#};
#sub ununiquify_answer {
#    my %args = @_;
#
#    my $answer = $args{answer};
#    my $words = ref($answer) eq 'HASH' ? $answer->{words} : $answer;
#
#    if (@$words == 1) {
#        push @$words, "$words->[0] ";
#    }
#    undef;
#}
#
#1;
#
#__END__
#
### Complete/Zsh.pm ###
#package Complete::Zsh;
#
#our $DATE = '2016-10-22'; 
#our $VERSION = '0.03'; 
#
#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 zsh shell',
#};
#
#$SPEC{format_completion} = {
#    v => 1.1,
#    summary => 'Format completion for output (for shell)',
#    description => <<'_',
#
#zsh accepts completion reply in the form of one entry per line to STDOUT.
#Currently the formatting is done using `Complete::Bash`'s `format_completion`.
#
#_
#    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` key is set to `array`)',
#        schema => ['any*' => of => ['str*', 'array*']],
#    },
#    result_naked => 1,
#};
#sub format_completion {
#    Complete::Bash::format_completion(@_);
#}
#
#1;
#
#__END__
#
### Config/IOD/Base.pm ###
#package Config::IOD::Base;
#
#our $DATE = '2017-01-16'; 
#our $VERSION = '0.32'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use constant +{
#    COL_V_ENCODING => 0, 
#    COL_V_WS1 => 1,
#    COL_V_VALUE => 2,
#    COL_V_WS2 => 3,
#    COL_V_COMMENT_CHAR => 4,
#    COL_V_COMMENT => 5,
#};
#
#sub new {
#    my ($class, %attrs) = @_;
#    $attrs{default_section} //= 'GLOBAL';
#    $attrs{allow_bang_only} //= 1;
#    $attrs{allow_duplicate_key} //= 1;
#    $attrs{enable_encoding} //= 1;
#    $attrs{enable_quoting}  //= 1;
#    $attrs{enable_bracket}  //= 1;
#    $attrs{enable_brace}    //= 1;
#    $attrs{enable_tilde}    //= 1;
#    $attrs{enable_expr}     //= 0;
#    $attrs{ignore_unknown_directive} //= 0;
#    bless \%attrs, $class;
#}
#
#sub _parse_command_line {
#    my ($self, $str) = @_;
#
#    $str =~ s/\A\s+//ms;
#    $str =~ s/\s+\z//ms;
#
#    my @argv;
#    my $buf;
#    my $escaped;
#    my $double_quoted;
#    my $single_quoted;
#
#    for my $char (split //, $str) {
#        if ($escaped) {
#            $buf .= $char;
#            $escaped = undef;
#            next;
#        }
#
#        if ($char eq '\\') {
#            if ($single_quoted) {
#                $buf .= $char;
#            }
#            else {
#                $escaped = 1;
#            }
#            next;
#        }
#
#        if ($char =~ /\s/) {
#            if ($single_quoted || $double_quoted) {
#                $buf .= $char;
#            }
#            else {
#                push @argv, $buf if defined $buf;
#                undef $buf;
#            }
#            next;
#        }
#
#        if ($char eq '"') {
#            if ($single_quoted) {
#                $buf .= $char;
#                next;
#            }
#            $double_quoted = !$double_quoted;
#            next;
#        }
#
#        if ($char eq "'") {
#            if ($double_quoted) {
#                $buf .= $char;
#                next;
#            }
#            $single_quoted = !$single_quoted;
#            next;
#        }
#
#        $buf .= $char;
#    }
#    push @argv, $buf if defined $buf;
#
#    if ($escaped || $single_quoted || $double_quoted) {
#        return undef;
#    }
#
#    \@argv;
#}
#
#sub _parse_raw_value {
#    my ($self, $val, $needs_res) = @_;
#
#    if ($val =~ /\A!/ && $self->{enable_encoding}) {
#
#        $val =~ s/!(\w+)(\s+)// or return ("Invalid syntax in encoded value");
#        my ($enc, $ws1) = ($1, $2);
#
#        my $res = [
#            "!$enc", 
#            $ws1, 
#            $1, 
#            $2, 
#            $3, 
#            $4, 
#        ] if $needs_res;
#
#        $enc = "json" if $enc eq 'j';
#        $enc = "hex"  if $enc eq 'h';
#        $enc = "expr" if $enc eq 'e';
#
#        if ($self->{allow_encodings}) {
#            return ("Encoding '$enc' is not in ".
#                        "allow_encodings list")
#                unless grep {$_ eq $enc} @{$self->{allow_encodings}};
#        }
#        if ($self->{disallow_encodings}) {
#            return ("Encoding '$enc' is in ".
#                        "disallow_encodings list")
#                if grep {$_ eq $enc} @{$self->{disallow_encodings}};
#        }
#
#        if ($enc eq 'json') {
#
#            $val =~ /\A
#                     (".*"|\[.*\]|\{.*\}|\S+)
#                     (\s*)
#                     (?: ([;#])(.*) )?
#                     \z/x or return ("Invalid syntax in JSON-encoded value");
#            my $decode_res = $self->_decode_json($val);
#            return ($decode_res->[1]) unless $decode_res->[0] == 200;
#            return (undef, $res, $decode_res->[2]);
#
#        } elsif ($enc eq 'path' || $enc eq 'paths') {
#
#            my $decode_res = $self->_decode_path_or_paths($val, $enc);
#            return ($decode_res->[1]) unless $decode_res->[0] == 200;
#            return (undef, $res, $decode_res->[2]);
#
#        } elsif ($enc eq 'hex') {
#
#            $val =~ /\A
#                     ([0-9A-Fa-f]*)
#                     (\s*)
#                     (?: ([;#])(.*) )?
#                     \z/x or return ("Invalid syntax in hex-encoded value");
#            my $decode_res = $self->_decode_hex($1);
#            return ($decode_res->[1]) unless $decode_res->[0] == 200;
#            return (undef, $res, $decode_res->[2]);
#
#        } elsif ($enc eq 'base64') {
#
#            $val =~ m!\A
#                      ([A-Za-z0-9+/]*=*)
#                      (\s*)
#                      (?: ([;#])(.*) )?
#                      \z!x or return ("Invalid syntax in base64-encoded value");
#            my $decode_res = $self->_decode_base64($1);
#            return ($decode_res->[1]) unless $decode_res->[0] == 200;
#            return (undef, $res, $decode_res->[2]);
#
#        } elsif ($enc eq 'none') {
#
#            return (undef, $res, $val);
#
#        } elsif ($enc eq 'expr') {
#
#            return ("expr is not allowed (enable_expr=0)")
#                unless $self->{enable_expr};
#            $val =~ m!\A
#                      ((?:[^#;])+?)
#                      (\s*)
#                      (?: ([;#])(.*) )?
#                      \z!x or return ("Invalid syntax in expr-encoded value");
#            my $decode_res = $self->_decode_expr($1);
#            return ($decode_res->[1]) unless $decode_res->[0] == 200;
#            return (undef, $res, $decode_res->[2]);
#
#        } else {
#
#            return ("unknown encoding '$enc'");
#
#        }
#
#    } elsif ($val =~ /\A"/ && $self->{enable_quoting}) {
#
#        $val =~ /\A
#                 "( (?:
#                         \\\\ | # backslash
#                         \\.  | # escaped something
#                         [^"\\]+ # non-doublequote or non-backslash
#                     )* )"
#                 (\s*)
#                 (?: ([;#])(.*) )?
#                 \z/x or return ("Invalid syntax in quoted string value");
#        my $res = [
#            '"', 
#            '', 
#            $1, 
#            $2, 
#            $3, 
#            $4, 
#        ] if $needs_res;
#        my $decode_res = $self->_decode_json(qq("$1"));
#        return ($decode_res->[1]) unless $decode_res->[0] == 200;
#        return (undef, $res, $decode_res->[2]);
#
#    } elsif ($val =~ /\A\[/ && $self->{enable_bracket}) {
#
#        $val =~ /\A
#                 \[(.*)\]
#                 (?:
#                     (\s*)
#                     ([#;])(.*)
#                 )?
#                 \z/x or return ("Invalid syntax in bracketed array value");
#        my $res = [
#            '[', 
#            '', 
#            $1, 
#            $2, 
#            $3, 
#            $4, 
#        ] if $needs_res;
#        my $decode_res = $self->_decode_json("[$1]");
#        return ($decode_res->[1]) unless $decode_res->[0] == 200;
#        return (undef, $res, $decode_res->[2]);
#
#    } elsif ($val =~ /\A\{/ && $self->{enable_brace}) {
#
#        $val =~ /\A
#                 \{(.*)\}
#                 (?:
#                     (\s*)
#                     ([#;])(.*)
#                 )?
#                 \z/x or return ("Invalid syntax in braced hash value");
#        my $res = [
#            '{', 
#            '', 
#            $1, 
#            $2, 
#            $3, 
#            $4, 
#        ] if $needs_res;
#        my $decode_res = $self->_decode_json("{$1}");
#        return ($decode_res->[1]) unless $decode_res->[0] == 200;
#        return (undef, $res, $decode_res->[2]);
#
#    } elsif ($val =~ /\A~/ && $self->{enable_tilde}) {
#
#        $val =~ /\A
#                 ~(.*)
#                 (\s*)
#                 (?: ([;#])(.*) )?
#                 \z/x or return ("Invalid syntax in path value");
#        my $res = [
#            '~', 
#            '', 
#            $1, 
#            $2, 
#            $3, 
#            $4, 
#        ] if $needs_res;
#
#        my $decode_res = $self->_decode_path_or_paths($val, 'path');
#        return ($decode_res->[1]) unless $decode_res->[0] == 200;
#        return (undef, $res, $decode_res->[2]);
#
#    } else {
#
#        $val =~ /\A
#                 (.*?)
#                 (\s*)
#                 (?: ([#;])(.*) )?
#                 \z/x or return ("Invalid syntax in value"); 
#        my $res = [
#            '', 
#            '', 
#            $1, 
#            $2, 
#            $3, 
#            $4, 
#        ] if $needs_res;
#        return (undef, $res, $1);
#
#    }
#}
#
#sub _get_my_user_name {
#    if ($^O eq 'MSWin32') {
#        return $ENV{USERNAME};
#    } else {
#        return $ENV{USER} if $ENV{USER};
#        my @pw;
#        eval { @pw = getpwuid($>) };
#        return $pw[0] if @pw;
#    }
#}
#
#sub _get_my_home_dir {
#    if ($^O eq 'MSWin32') {
#        return $ENV{HOME} if $ENV{HOME};
#        return $ENV{USERPROFILE} if $ENV{USERPROFILE};
#        return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
#            if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
#    } else {
#        return $ENV{HOME} if $ENV{HOME};
#        my @pw;
#        eval { @pw = getpwuid($>) };
#        return $pw[7] if @pw;
#    }
#
#    die "Can't get home directory";
#}
#
#sub _get_users_home_dir {
#    my ($name) = @_;
#
#    if ($^O eq 'MSWin32') {
#        return undef;
#    } else {
#        if ($name eq getpwuid($<)) {
#            return _get_my_home_dir();
#        }
#
#      SCOPE: {
#            my $home = (getpwnam($name))[7];
#            return $home if $home and -d $home;
#        }
#
#        return undef;
#    }
#
#}
#
#sub _decode_json {
#    my ($self, $val) = @_;
#    state $json = do {
#        if (eval { require Cpanel::JSON::XS; 1 }) {
#            Cpanel::JSON::XS->new->allow_nonref;
#        } else {
#            require JSON::PP;
#            JSON::PP->new->allow_nonref;
#        }
#    };
#    my $res;
#    eval { $res = $json->decode($val) };
#    if ($@) {
#        return [500, "Invalid JSON: $@"];
#    } else {
#        return [200, "OK", $res];
#    }
#}
#
#sub _decode_path_or_paths {
#    my ($self, $val, $which) = @_;
#
#    if ($val =~ m!\A~([^/]+)?(?:/|\z)!) {
#        my $home_dir = length($1) ?
#            _get_users_home_dir($1) : _get_my_home_dir();
#        unless ($home_dir) {
#            if (length $1) {
#                return [500, "Can't get home directory for user '$1' in path"];
#            } else {
#                return [500, "Can't get home directory for current user in path"];
#            }
#        }
#        $val =~ s!\A~([^/]+)?!$home_dir!;
#    }
#    $val =~ s!(?<=.)/\z!!;
#
#    if ($which eq 'path') {
#        return [200, "OK", $val];
#    } else {
#        return [200, "OK", [glob $val]];
#    }
#}
#
#sub _decode_hex {
#    my ($self, $val) = @_;
#    [200, "OK", pack("H*", $val)];
#}
#
#sub _decode_base64 {
#    my ($self, $val) = @_;
#    require MIME::Base64;
#    [200, "OK", MIME::Base64::decode_base64($val)];
#}
#
#sub _decode_expr {
#    require Config::IOD::Expr;
#
#    my ($self, $val) = @_;
#    no strict 'refs';
#    local *{"Config::IOD::Expr::val"} = sub {
#        my $arg = shift;
#        if ($arg =~ /(.+)\.(.+)/) {
#            return $self->{_res}{$1}{$2};
#        } else {
#            return $self->{_res}{ $self->{_cur_section} }{$arg};
#        }
#    };
#    Config::IOD::Expr::_parse_expr($val);
#}
#
#sub _err {
#    my ($self, $msg) = @_;
#    die join(
#        "",
#        @{ $self->{_include_stack} } ? "$self->{_include_stack}[0] " : "",
#        "line $self->{_linum}: ",
#        $msg
#    );
#}
#
#sub _push_include_stack {
#    require Cwd;
#
#    my ($self, $path) = @_;
#
#    if (@{ $self->{_include_stack} }) {
#        require File::Spec;
#        my ($vol, $dir, $file) =
#            File::Spec->splitpath($self->{_include_stack}[-1]);
#        $path = File::Spec->rel2abs($path, File::Spec->catpath($vol, $dir));
#    }
#
#    my $abs_path = Cwd::abs_path($path) or return [400, "Invalid path name"];
#    return [409, "Recursive", $abs_path]
#        if grep { $_ eq $abs_path } @{ $self->{_include_stack} };
#    push @{ $self->{_include_stack} }, $abs_path;
#    return [200, "OK", $abs_path];
#}
#
#sub _pop_include_stack {
#    my $self = shift;
#
#    die "BUG: Overpopped _pop_include_stack"
#        unless @{$self->{_include_stack}};
#    pop @{ $self->{_include_stack} };
#}
#
#sub _init_read {
#    my $self = shift;
#
#    $self->{_include_stack} = [];
#}
#
#sub _read_file {
#    my ($self, $filename) = @_;
#    open my $fh, "<", $filename
#        or die "Can't open file '$filename': $!";
#    binmode($fh, ":utf8");
#    local $/;
#    return scalar <$fh>;
#}
#
#sub read_file {
#    my $self = shift;
#    my $filename = shift;
#    $self->_init_read;
#    my $res = $self->_push_include_stack($filename);
#    die "Can't read '$filename': $res->[1]" unless $res->[0] == 200;
#    $res =
#        $self->_read_string($self->_read_file($filename), @_);
#    $self->_pop_include_stack;
#    $res;
#}
#
#sub read_string {
#    my $self = shift;
#    $self->_init_read;
#    $self->_read_string(@_);
#}
#
#1;
#
#__END__
#
### Config/IOD/Expr.pm ###
#package Config::IOD::Expr;
#
#our $DATE = '2017-01-16'; 
#our $VERSION = '0.32'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#my $EXPR_RE = qr{
#
#(?&ANSWER)
#
#(?(DEFINE)
#
#(?<ANSWER>    (?&ADD))
#(?<ADD>       (?&MULT)   | (?&MULT)  (?: \s* ([+.-]) \s* (?&MULT)  )+)
#(?<MULT>      (?&UNARY)  | (?&UNARY) (?: \s* ([*/x%]) \s* (?&UNARY))+)
#(?<UNARY>     (?&POWER)  | [!~+-] (?&POWER))
#(?<POWER>     (?&TERM)   | (?&TERM) (?: \s* \*\* \s* (?&TERM))+)
#
#(?<TERM>
#    (?&NUM)
#  | (?&STR_SINGLE)
#  | (?&STR_DOUBLE)
#  | undef
#  | (?&FUNC)
#  | \( \s* ((?&ANSWER)) \s* \)
#)
#
#(?<FUNC> val \s* \( (?&TERM) \))
#
#(?<NUM>
#    (
#     -?
#     (?: 0 | [1-9]\d* )
#     (?: \. \d+ )?
#     (?: [eE] [-+]? \d+ )?
#    )
#)
#
#(?<STR_SINGLE>
#    (
#     '
#     (?:
#         [^\\']+
#       |
#         \\ ['\\]
#       |
#         \\
#     )*
#     '
#    )
#)
#
#(?<STR_DOUBLE>
#    (
#     "
#     (?:
#         [^\\"]+
#       |
#         \\ ["'\\\$tnrfbae]
## octal, hex, wide hex
#     )*
#     "
#    )
#)
#
#) # DEFINE
#
#}msx;
#
#sub _parse_expr {
#    my $str = shift;
#
#    return [400, 'Not a valid expr'] unless $str =~ m{\A$EXPR_RE\z}o;
#    my $res = eval $str;
#    return [500, "Died when evaluating expr: $@"] if $@;
#    [200, "OK", $res];
#}
#
#1;
#
#__END__
#
### Config/IOD/Reader.pm ###
#package Config::IOD::Reader;
#
#our $DATE = '2017-01-16'; 
#our $VERSION = '0.32'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Config::IOD::Base);
#
#sub _merge {
#    my ($self, $section) = @_;
#
#    my $res = $self->{_res};
#    for my $msect (@{ $self->{_merge} }) {
#        if ($msect eq $section) {
#            next;
#        }
#        if (!exists($res->{$msect})) {
#            local $self->{_linum} = $self->{_linum}-1;
#            $self->_err("Can't merge section '$msect' to '$section': ".
#                            "Section '$msect' not seen yet");
#        }
#        for my $k (keys %{ $res->{$msect} }) {
#            $res->{$section}{$k} //= $res->{$msect}{$k};
#        }
#    }
#}
#
#sub _init_read {
#    my $self = shift;
#
#    $self->SUPER::_init_read;
#    $self->{_res} = {};
#    $self->{_merge} = undef;
#    $self->{_num_seen_section_lines} = 0;
#    $self->{_cur_section} = $self->{default_section};
#    $self->{_arrayified} = {};
#}
#
#sub _read_string {
#    my ($self, $str, $cb) = @_;
#
#    my $res = $self->{_res};
#    my $cur_section = $self->{_cur_section};
#
#    my $directive_re = $self->{allow_bang_only} ?
#        qr/^;?\s*!\s*(\w+)\s*/ :
#        qr/^;\s*!\s*(\w+)\s*/;
#
#    my $_raw_val; 
#
#    my @lines = split /^/, $str;
#    local $self->{_linum} = 0;
#  LINE:
#    for my $line (@lines) {
#        $self->{_linum}++;
#
#        if ($line !~ /\S/) {
#            next LINE;
#        }
#
#        if ($line =~ s/$directive_re//) {
#            my $directive = $1;
#            if ($self->{allow_directives}) {
#                $self->_err("Directive '$directive' is not in ".
#                                "allow_directives list")
#                    unless grep { $_ eq $directive }
#                        @{$self->{allow_directives}};
#            }
#            if ($self->{disallow_directives}) {
#                $self->_err("Directive '$directive' is in ".
#                                "disallow_directives list")
#                    if grep { $_ eq $directive }
#                        @{$self->{disallow_directives}};
#            }
#            my $args = $self->_parse_command_line($line);
#            if (!defined($args)) {
#                $self->_err("Invalid arguments syntax '$line'");
#            }
#
#            if ($cb) {
#                $cb->(
#                    event => 'directive',
#                    linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
#                    directive => $directive,
#                    args => $args,
#                );
#            }
#
#            if ($directive eq 'include') {
#                my $path;
#                if (! @$args) {
#                    $self->_err("Missing filename to include");
#                } elsif (@$args > 1) {
#                    $self->_err("Extraneous arguments");
#                } else {
#                    $path = $args->[0];
#                }
#                my $res = $self->_push_include_stack($path);
#                if ($res->[0] != 200) {
#                    $self->_err("Can't include '$path': $res->[1]");
#                }
#                $path = $res->[2];
#                $self->_read_string($self->_read_file($path, $cb));
#                $self->_pop_include_stack;
#            } elsif ($directive eq 'merge') {
#                $self->{_merge} = @$args ? $args : undef;
#            } elsif ($directive eq 'noop') {
#            } else {
#                if ($self->{ignore_unknown_directive}) {
#                    next LINE;
#                } else {
#                    $self->_err("Unknown directive '$directive'");
#                }
#            }
#            next LINE;
#        }
#
#        if ($line =~ /^\s*[;#]/) {
#
#            if ($cb) {
#                $cb->(
#                    event => 'comment',
#                    linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
#                );
#            }
#
#            next LINE;
#        }
#
#        if ($line =~ /^\s*\[\s*(.+?)\s*\](?: \s*[;#].*)?/) {
#            my $prev_section = $self->{_cur_section};
#            $self->{_cur_section} = $cur_section = $1;
#            $res->{$cur_section} //= {};
#            $self->{_num_seen_section_lines}++;
#
#            if ($self->{_merge} && $self->{_num_seen_section_lines} > 1) {
#                $self->_merge($prev_section);
#            }
#
#            if ($cb) {
#                $cb->(
#                    event => 'section',
#                    linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
#                    section => $cur_section,
#                );
#            }
#
#            next LINE;
#        }
#
#        if ($line =~ /^\s*([^=]+?)\s*=\s*(.*)/) {
#            my $key = $1;
#            my $val = $2;
#
#            if ($val =~ /\A["!\\[\{~]/) {
#                $_raw_val = $val if $cb;
#                my ($err, $parse_res, $decoded_val) = $self->_parse_raw_value($val);
#                $self->_err("Invalid value: " . $err) if $err;
#                $val = $decoded_val;
#            } else {
#                $_raw_val = $val if $cb;
#                $val =~ s/\s*[#;].*//; 
#            }
#
#            if (exists $res->{$cur_section}{$key}) {
#                if (!$self->{allow_duplicate_key}) {
#                    $self->_err("Duplicate key: $key (section $cur_section)");
#                } elsif ($self->{_arrayified}{$cur_section}{$key}++) {
#                    push @{ $res->{$cur_section}{$key} }, $val;
#                } else {
#                    $res->{$cur_section}{$key} = [
#                        $res->{$cur_section}{$key}, $val];
#                }
#            } else {
#                $res->{$cur_section}{$key} = $val;
#            }
#
#            if ($cb) {
#                $cb->(
#                    event => 'key',
#                    linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
#                    key => $key,
#                    val => $val,
#                    raw_val => $_raw_val,
#                );
#            }
#
#            next LINE;
#        }
#
#        $self->_err("Invalid syntax");
#    }
#
#    if ($self->{_merge} && $self->{_num_seen_section_lines} > 1) {
#        $self->_merge($cur_section);
#    }
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Check/Structure.pm ###
#package Data::Check::Structure;
#
#our $DATE = '2017-07-18'; 
#our $VERSION = '0.04'; 
#
#use strict;
#
#use Exporter 'import';
#our @EXPORT_OK = qw(
#                       is_aoa
#                       is_aoaos
#                       is_aoh
#                       is_aohos
#                       is_aos
#                       is_hoa
#                       is_hoaos
#                       is_hoh
#                       is_hohos
#                       is_hos
#               );
#
#sub is_aos {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'ARRAY';
#    for my $i (0..@$data-1) {
#        last if defined($max) && $i >= $max;
#        return 0 if ref($data->[$i]);
#    }
#    1;
#}
#
#sub is_aoa {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'ARRAY';
#    for my $i (0..@$data-1) {
#        last if defined($max) && $i >= $max;
#        return 0 unless ref($data->[$i]) eq 'ARRAY';
#    }
#    1;
#}
#
#sub is_aoaos {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'ARRAY';
#    my $aos_opts = {max=>$max};
#    for my $i (0..@$data-1) {
#        last if defined($max) && $i >= $max;
#        return 0 unless is_aos($data->[$i], $aos_opts);
#    }
#    1;
#}
#
#sub is_aoh {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'ARRAY';
#    for my $i (0..@$data-1) {
#        last if defined($max) && $i >= $max;
#        return 0 unless ref($data->[$i]) eq 'HASH';
#    }
#    1;
#}
#
#sub is_aohos {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'ARRAY';
#    my $hos_opts = {max=>$max};
#    for my $i (0..@$data-1) {
#        last if defined($max) && $i >= $max;
#        return 0 unless is_hos($data->[$i], $hos_opts);
#    }
#    1;
#}
#
#sub is_hos {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'HASH';
#    my $i = 0;
#    for my $k (keys %$data) {
#        last if defined($max) && ++$i >= $max;
#        return 0 if ref($data->{$k});
#    }
#    1;
#}
#
#sub is_hoa {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'HASH';
#    my $i = 0;
#    for my $k (keys %$data) {
#        last if defined($max) && ++$i >= $max;
#        return 0 unless ref($data->{$k}) eq 'ARRAY';
#    }
#    1;
#}
#
#sub is_hoaos {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'HASH';
#    my $i = 0;
#    for my $k (keys %$data) {
#        last if defined($max) && ++$i >= $max;
#        return 0 unless is_aos($data->{$k});
#    }
#    1;
#}
#
#sub is_hoh {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'HASH';
#    my $i = 0;
#    for my $k (keys %$data) {
#        last if defined($max) && ++$i >= $max;
#        return 0 unless ref($data->{$k}) eq 'HASH';
#    }
#    1;
#}
#
#sub is_hohos {
#    my ($data, $opts) = @_;
#    $opts ||= {};
#    my $max = $opts->{max};
#
#    return 0 unless ref($data) eq 'HASH';
#    my $i = 0;
#    for my $k (keys %$data) {
#        last if defined($max) && ++$i >= $max;
#        return 0 unless is_hos($data->{$k});
#    }
#    1;
#}
#
#1;
#
#__END__
#
### Data/Clean.pm ###
#package Data::Clean;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.49'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#sub new {
#    my ($class, %opts) = @_;
#    my $self = bless {_opts=>\%opts}, $class;
#    log_trace("Cleanser options: %s", \%opts);
#
#    my $cd = $self->_generate_cleanser_code;
#    for my $mod (keys %{ $cd->{modules} }) {
#        (my $mod_pm = "$mod.pm") =~ s!::!/!g;
#        require $mod_pm;
#    }
#    $self->{_cd} = $cd;
#    $self->{_code} = eval $cd->{src};
#    {
#        last unless $cd->{clone_func} =~ /(.+)::(.+)/;
#        (my $mod_pm = "$1.pm") =~ s!::!/!g;
#        require $mod_pm;
#    }
#    die "Can't generate code: $@" if $@;
#
#    $self;
#}
#
#sub command_call_method {
#    my ($self, $cd, $args) = @_;
#    my $mn = $args->[0];
#    die "Invalid method name syntax" unless $mn =~ /\A\w+\z/;
#    return "{{var}} = {{var}}->$mn; \$ref = ref({{var}})";
#}
#
#sub command_call_func {
#    my ($self, $cd, $args) = @_;
#    my $fn = $args->[0];
#    die "Invalid func name syntax" unless $fn =~ /\A\w+(::\w+)*\z/;
#    return "{{var}} = $fn({{var}}); \$ref = ref({{var}})";
#}
#
#sub command_one_or_zero {
#    my ($self, $cd, $args) = @_;
#    return "{{var}} = {{var}} ? 1:0; \$ref = ''";
#}
#
#sub command_deref_scalar {
#    my ($self, $cd, $args) = @_;
#    return '{{var}} = ${ {{var}} }; $ref = ref({{var}})';
#}
#
#sub command_stringify {
#    my ($self, $cd, $args) = @_;
#    return '{{var}} = "{{var}}"; $ref = ""';
#}
#
#sub command_replace_with_ref {
#    my ($self, $cd, $args) = @_;
#    return '{{var}} = $ref; $ref = ""';
#}
#
#sub command_replace_with_str {
#    require String::PerlQuote;
#
#    my ($self, $cd, $args) = @_;
#    return "{{var}} = ".String::PerlQuote::double_quote($args->[0]).'; $ref=""';
#}
#
#sub command_unbless {
#    my ($self, $cd, $args) = @_;
#
#    return join(
#        "",
#        'my $reftype = Scalar::Util::reftype({{var}}); ',
#        '{{var}} = $reftype eq "HASH" ? {%{ {{var}} }} :',
#        ' $reftype eq "ARRAY" ? [@{ {{var}} }] :',
#        ' $reftype eq "SCALAR" ? \(my $copy = ${ {{var}} }) :',
#        ' $reftype eq "CODE" ? sub { goto &{ {{var}} } } :',
#        '(die "Cannot unbless object with type $ref")',
#    );
#}
#
#sub command_clone {
#    my ($self, $cd, $args) = @_;
#
#    my $limit = $args->[0] // 1;
#    return join(
#        "",
#        "if (++\$ctr_circ <= $limit) { ",
#        "{{var}} = $cd->{clone_func}({{var}}); redo ",
#        "} else { ",
#        "{{var}} = 'CIRCULAR'; \$ref = '' }",
#    );
#}
#
#sub command_die {
#    my ($self, $cd, $args) = @_;
#    return "die";
#}
#
#sub _generate_cleanser_code {
#    my $self = shift;
#    my $opts = $self->{_opts};
#
#    my $cd = {
#        modules => {}, 
#        clone_func   => $self->{_opts}{'!clone_func'},
#        code => '',
#    };
#
#    $cd->{modules}{'Scalar::Util'} //= 0;
#
#    if (!$cd->{clone_func}) {
#        if (eval { require Data::Clone; 1 }) {
#            $cd->{clone_func} = 'Data::Clone::clone';
#        } else {
#            $cd->{clone_func} = 'Clone::PP::clone';
#        }
#    }
#    {
#        last unless $cd->{clone_func} =~ /(.+)::(.+)/;
#        $cd->{modules}{$1} //= 0;
#    }
#
#    my (@code, @stmts_ary, @stmts_hash, @stmts_main);
#
#    my $n = 0;
#    my $add_stmt = sub {
#        my $which = shift;
#        if ($which eq 'if' || $which eq 'new_if') {
#            my ($cond0, $act0) = @_;
#            for ([\@stmts_ary, '$e', 'ary'],
#                 [\@stmts_hash, '$h->{$k}', 'hash'],
#                 [\@stmts_main, '$_', 'main']) {
#                my $act  = $act0 ; $act  =~ s/\Q{{var}}\E/$_->[1]/g;
#                my $cond = $cond0; $cond =~ s/\Q{{var}}\E/$_->[1]/g;
#                push @{ $_->[0] }, "    ".($n && $which ne 'new_if' ? "els":"")."if ($cond) { $act }\n";
#            }
#            $n++;
#        } else {
#            my ($stmt0) = @_;
#            for ([\@stmts_ary, '$e', 'ary'],
#                 [\@stmts_hash, '$h->{$k}', 'hash'],
#                 [\@stmts_main, '$_', 'main']) {
#                my $stmt = $stmt0; $stmt =~ s/\Q{{var}}\E/$_->[1]/g;
#                push @{ $_->[0] }, "    $stmt;\n";
#            }
#        }
#    };
#    my $add_if = sub {
#        $add_stmt->('if', @_);
#    };
#    my $add_new_if = sub {
#        $add_stmt->('new_if', @_);
#    };
#    my $add_if_ref = sub {
#        my ($ref, $act0) = @_;
#        $add_if->("\$ref eq '$ref'", $act0);
#    };
#    my $add_new_if_ref = sub {
#        my ($ref, $act0) = @_;
#        $add_new_if->("\$ref eq '$ref'", $act0);
#    };
#
#    my $circ = $opts->{-circular};
#    if ($circ) {
#        my $meth = "command_$circ->[0]";
#        die "Can't handle command $circ->[0] for option '-circular'" unless $self->can($meth);
#        my @args = @$circ; shift @args;
#        my $act = $self->$meth($cd, \@args);
#        $add_new_if->('$ref && $refs{ {{var}} }++', $act);
#    }
#
#    for my $on (grep {/\A\w*(::\w+)*\z/} sort keys %$opts) {
#        my $o = $opts->{$on};
#        next unless $o;
#        my $meth = "command_$o->[0]";
#        die "Can't handle command $o->[0] for option '$on'" unless $self->can($meth);
#        my @args = @$o; shift @args;
#        my $act = $self->$meth($cd, \@args);
#        $add_if_ref->($on, $act);
#    }
#
#    for my $p ([-obj => 'Scalar::Util::blessed({{var}})']) {
#        my $o = $opts->{$p->[0]};
#        next unless $o;
#        my $meth = "command_$o->[0]";
#        die "Can't handle command $o->[0] for option '$p->[0]'" unless $self->can($meth);
#        my @args = @$o; shift @args;
#        $add_if->($p->[1], $self->$meth($cd, \@args));
#    }
#
#    if ($opts->{'!recurse_obj'}) {
#        $add_stmt->('stmt', 'my $reftype=Scalar::Util::reftype({{var}})//""');
#        $add_new_if->('$reftype eq "ARRAY"', '$process_array->({{var}})');
#        $add_if->('$reftype eq "HASH"' , '$process_hash->({{var}})');
#    } else {
#        $add_new_if_ref->("ARRAY", '$process_array->({{var}})');
#        $add_if_ref->("HASH" , '$process_hash->({{var}})');
#    }
#
#    for my $p ([-ref => '$ref']) {
#        my $o = $opts->{$p->[0]};
#        next unless $o;
#        my $meth = "command_$o->[0]";
#        die "Can't handle command $o->[0] for option '$p->[0]'" unless $self->can($meth);
#        my @args = @$o; shift @args;
#        $add_if->($p->[1], $self->$meth($cd, \@args));
#    }
#
#    push @code, 'sub {'."\n";
#    push @code, 'my $data = shift;'."\n";
#    push @code, 'state %refs;'."\n" if $circ;
#    push @code, 'state $ctr_circ;'."\n" if $circ;
#    push @code, 'state $process_array;'."\n";
#    push @code, 'state $process_hash;'."\n";
#    push @code, (
#        'if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { ',
#        'my $ref=ref($e);'."\n",
#        join("", @stmts_ary).'} } }'."\n"
#    );
#    push @code, (
#        'if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { ',
#        'my $ref=ref($h->{$k});'."\n",
#        join("", @stmts_hash).'} } }'."\n"
#    );
#    push @code, '%refs = (); $ctr_circ=0;'."\n" if $circ;
#    push @code, (
#        'for ($data) { ',
#        'my $ref=ref($_);'."\n",
#        join("", @stmts_main).'}'."\n"
#    );
#    push @code, '$data'."\n";
#    push @code, '}'."\n";
#
#    my $code = join("", @code).";";
#
#    if ($ENV{LOG_CLEANSER_CODE} && log_is_trace()) {
#        require String::LineNumber;
#        log_trace("Cleanser code:\n%s",
#                     $ENV{LINENUM} // 1 ?
#                         String::LineNumber::linenum($code) : $code);
#    }
#
#    $cd->{src} = $code;
#
#    $cd;
#}
#
#sub clean_in_place {
#    my ($self, $data) = @_;
#
#    $self->{_code}->($data);
#}
#
#sub clone_and_clean {
#    no strict 'refs';
#
#    my ($self, $data) = @_;
#    my $clone = &{$self->{_cd}{clone_func}}($data);
#    $self->clean_in_place($clone);
#}
#
#1;
#
#__END__
#
### Data/Clean/FromJSON.pm ###
#package Data::Clean::FromJSON;
#
#our $DATE = '2017-01-15'; 
#our $VERSION = '0.38'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Data::Clean);
#
#sub new {
#    my ($class, %opts) = @_;
#    $opts{"JSON::PP::Boolean"} //= ['one_or_zero'];
#
#    $opts{"JSON::XS::Boolean"} //= ['one_or_zero'];
#
#    $opts{"Cpanel::JSON::XS::Boolean"} //= ['one_or_zero'];
#
#    $class->SUPER::new(%opts);
#}
#
#sub get_cleanser {
#    my $class = shift;
#    state $singleton = $class->new;
#    $singleton;
#}
#
#1;
#
#__END__
#
### Data/Clean/JSON.pm ###
#package Data::Clean::JSON;
#
#our $DATE = '2017-01-15'; 
#our $VERSION = '0.38'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Data::Clean);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       clean_json_in_place
#                       clone_and_clean_json
#               );
#
#sub new {
#    my ($class, %opts) = @_;
#    $opts{DateTime}  //= [call_method => 'epoch'];
#    $opts{'Time::Moment'} //= [call_method => 'epoch'];
#    $opts{'Math::BigInt'} //= [call_method => 'bstr'];
#    $opts{Regexp}    //= ['stringify'];
#    $opts{version}   //= ['stringify'];
#
#    $opts{SCALAR}    //= ['deref_scalar'];
#    $opts{-ref}      //= ['replace_with_ref'];
#    $opts{-circular} //= ['clone'];
#    $opts{-obj}      //= ['unbless'];
#
#    $opts{'!recurse_obj'} //= 1;
#    $class->SUPER::new(%opts);
#}
#
#sub get_cleanser {
#    my $class = shift;
#    state $singleton = $class->new;
#    $singleton;
#}
#
#sub clean_json_in_place {
#    __PACKAGE__->get_cleanser->clean_in_place(@_);
#}
#
#sub clone_and_clean_json {
#    __PACKAGE__->get_cleanser->clone_and_clean(@_);
#}
#
#1;
#
#__END__
#
### Data/Dmp.pm ###
#package Data::Dmp;
#
#our $DATE = '2017-01-30'; 
#our $VERSION = '0.23'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Scalar::Util qw(looks_like_number blessed reftype refaddr);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT = qw(dd dmp);
#
#our %_seen_refaddrs;
#our %_subscripts;
#our @_fixups;
#
#our $OPT_PERL_VERSION = "5.010";
#our $OPT_REMOVE_PRAGMAS = 0;
#our $OPT_DEPARSE = 1;
#our $OPT_STRINGIFY_NUMBERS = 0;
#
#my %esc = (
#    "\a" => "\\a",
#    "\b" => "\\b",
#    "\t" => "\\t",
#    "\n" => "\\n",
#    "\f" => "\\f",
#    "\r" => "\\r",
#    "\e" => "\\e",
#);
#
#sub _double_quote {
#    local($_) = $_[0];
#
#    s/([\\\"\@\$])/\\$1/g;
#    return qq("$_") unless /[^\040-\176]/;  
#
#    s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
#    s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
#    s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
#    s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
#    return qq("$_");
#}
#
#sub _dump_code {
#    my $code = shift;
#
#    state $deparse = do {
#        require B::Deparse;
#        B::Deparse->new("-l"); 
#    };
#
#    my $res = $deparse->coderef2text($code);
#
#    my ($res_before_first_line, $res_after_first_line) =
#        $res =~ /(.+?)^(#line .+)/ms;
#
#    if ($OPT_REMOVE_PRAGMAS) {
#        $res_before_first_line = "{";
#    } elsif ($OPT_PERL_VERSION < 5.016) {
#        $res_before_first_line =~ s/no feature ':all';/no feature;/m;
#    }
#    $res_after_first_line =~ s/^#line .+//gm;
#
#    $res = "sub" . $res_before_first_line . $res_after_first_line;
#    $res =~ s/^\s+//gm;
#    $res =~ s/\n+//g;
#    $res =~ s/;\}\z/}/;
#    $res;
#}
#
#sub _quote_key {
#    $_[0] =~ /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ ||
#        $_[0] =~ /\A-?[1-9][0-9]{0,8}\z/ ? $_[0] : _double_quote($_[0]);
#}
#
#sub _dump {
#    my ($val, $subscript) = @_;
#
#    my $ref = ref($val);
#    if ($ref eq '') {
#        if (!defined($val)) {
#            return "undef";
#        } elsif (looks_like_number($val) && !$OPT_STRINGIFY_NUMBERS &&
#                     $val eq $val+0 &&
#                     $val !~ /\A-?(?:inf(?:inity)?|nan)\z/i
#                 ) {
#            return $val;
#        } else {
#            return _double_quote($val);
#        }
#    }
#    my $refaddr = refaddr($val);
#    $_subscripts{$refaddr} //= $subscript;
#    if ($_seen_refaddrs{$refaddr}++) {
#        push @_fixups, "\$a->$subscript=\$a",
#            ($_subscripts{$refaddr} ? "->$_subscripts{$refaddr}" : ""), ";";
#        return "'fix'";
#    }
#
#    my $class;
#
#    if ($ref eq 'Regexp' || $ref eq 'REGEXP') {
#        require Regexp::Stringify;
#        return Regexp::Stringify::stringify_regexp(
#            regexp=>$val, with_qr=>1, plver=>$OPT_PERL_VERSION);
#    }
#
#    if (blessed $val) {
#        $class = $ref;
#        $ref = reftype($val);
#    }
#
#    my $res;
#    if ($ref eq 'ARRAY') {
#        $res = "[";
#        my $i = 0;
#        for (@$val) {
#            $res .= "," if $i;
#            $res .= _dump($_, "$subscript\[$i]");
#            $i++;
#        }
#        $res .= "]";
#    } elsif ($ref eq 'HASH') {
#        $res = "{";
#        my $i = 0;
#        for (sort keys %$val) {
#            $res .= "," if $i++;
#            my $k = _quote_key($_);
#            my $v = _dump($val->{$_}, "$subscript\{$k}");
#            $res .= "$k=>$v";
#        }
#        $res .= "}";
#    } elsif ($ref eq 'SCALAR') {
#        $res = "\\"._dump($$val, $subscript);
#    } elsif ($ref eq 'REF') {
#        $res = "\\"._dump($$val, $subscript);
#    } elsif ($ref eq 'CODE') {
#        $res = $OPT_DEPARSE ? _dump_code($val) : 'sub{"DUMMY"}';
#    } else {
#        die "Sorry, I can't dump $val (ref=$ref) yet";
#    }
#
#    $res = "bless($res,"._double_quote($class).")" if defined($class);
#    $res;
#}
#
#our $_is_dd;
#sub _dd_or_dmp {
#    local %_seen_refaddrs;
#    local %_subscripts;
#    local @_fixups;
#
#    my $res;
#    if (@_ > 1) {
#        $res = "(" . join(",", map {_dump($_, '')} @_) . ")";
#    } else {
#        $res = _dump($_[0], '');
#    }
#    if (@_fixups) {
#        $res = "do{my\$a=$res;" . join("", @_fixups) . "\$a}";
#    }
#
#    if ($_is_dd) {
#        say $res;
#        return wantarray() || @_ > 1 ? @_ : $_[0];
#    } else {
#        return $res;
#    }
#}
#
#sub dd { local $_is_dd=1; _dd_or_dmp(@_) } 
#sub dmp { goto &_dd_or_dmp }
#
#1;
#
#__END__
#
### Data/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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#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_trace("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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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/Coerce/perl/float/str_percent.pm ###
#package Data::Sah::Coerce::perl::float::str_percent;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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(
#        " && ",
#        "$dt =~ /\\A([+-]?\\d+(?:\\.\\d*)?)%\\z/",
#    );
#
#    $res->{expr_coerce} = "\$1/100";
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Coerce/perl/int/str_percent.pm ###
#package Data::Sah::Coerce::perl::int::str_percent;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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(
#        " && ",
#        "$dt =~ /\\A([+-]?\\d+)%\\z/",
#    );
#
#    $res->{expr_coerce} = "\$1/100";
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/CoerceCommon.pm ###
#package Data::Sah::CoerceCommon;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.023'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#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_trace("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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Mo qw(default);
#use Role::Tiny::With;
#use Log::ger;
#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_trace(
#            "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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#use 5.010;
#use strict;
#use warnings;
#use Log::ger;
#
#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_trace("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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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_trace('[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::ger;';
#}
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-04-19'; 
#our $VERSION = '0.007'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(resolve_schema);
#
#sub _resolve {
#    my ($opts, $type, $clsets, $seen) = @_;
#
#    die "Recursive schema definition: ".join(" -> ", @$seen, $type)
#        if grep { $type eq $_ } @$seen;
#    push @$seen, $type;
#
#    (my $typemod_pm = "Data/Sah/Type/$type.pm") =~ s!::!/!g;
#    eval { require $typemod_pm; 1 };
#    my $err = $@;
#    return [$type, $clsets] unless $err;
#    die "Can't check whether $type is a builtin Sah type: $err"
#        unless $err =~ /\ACan't locate/;
#
#    my $schmod = "Sah::Schema::$type";
#    (my $schmod_pm = "$schmod.pm") =~ s!::!/!g;
#    eval { require $schmod_pm; 1 };
#    die "Not a known built-in Sah type '$type' (can't locate ".
#        "Data::Sah::Type::$type) and not a known schema name '$type' ($@)"
#            if $@;
#    no strict 'refs';
#    my $sch2 = ${"$schmod\::schema"};
#    die "BUG: Schema module $schmod doesn't contain \$schema" unless $sch2;
#    unshift @$clsets, $sch2->[1];
#    _resolve($opts, $sch2->[0], $clsets, $seen);
#}
#
#sub resolve_schema {
#    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
#    my $sch = shift;
#
#    unless ($opts->{schema_is_normalized}) {
#        require Data::Sah::Normalize;
#        $sch =  Data::Sah::Normalize::normalize_schema($sch);
#    }
#    $opts->{merge_clause_sets} //= 1;
#
#    my $seen = [];
#    my $res = _resolve($opts, $sch->[0], keys(%{$sch->[1]}) ? [$sch->[1]] : [], $seen);
#
#  MERGE:
#    {
#        last unless $opts->{merge_clause_sets};
#        last if @{ $res->[1] } < 2;
#
#        my @clsets = (shift @{ $res->[1] });
#        for my $clset (@{ $res->[1] }) {
#            my $has_merge_mode_keys;
#            for (keys %$clset) {
#                if (/\Amerge\./) {
#                    $has_merge_mode_keys = 1;
#                    last;
#                }
#            }
#            if ($has_merge_mode_keys) {
#                state $merger = do {
#                    require Data::ModeMerge;
#                    my $mm = Data::ModeMerge->new(config => {
#                        recurse_array => 1,
#                    });
#                    $mm->modes->{NORMAL}  ->prefix   ('merge.normal.');
#                    $mm->modes->{NORMAL}  ->prefix_re(qr/\Amerge\.normal\./);
#                    $mm->modes->{ADD}     ->prefix   ('merge.add.');
#                    $mm->modes->{ADD}     ->prefix_re(qr/\Amerge\.add\./);
#                    $mm->modes->{CONCAT}  ->prefix   ('merge.concat.');
#                    $mm->modes->{CONCAT}  ->prefix_re(qr/\Amerge\.concat\./);
#                    $mm->modes->{SUBTRACT}->prefix   ('merge.subtract.');
#                    $mm->modes->{SUBTRACT}->prefix_re(qr/\Amerge\.subtract\./);
#                    $mm->modes->{DELETE}  ->prefix   ('merge.delete.');
#                    $mm->modes->{DELETE}  ->prefix_re(qr/\Amerge\.delete\./);
#                    $mm->modes->{KEEP}    ->prefix   ('merge.keep.');
#                    $mm->modes->{KEEP}    ->prefix_re(qr/\Amerge\.keep\./);
#                    $mm;
#                };
#                my $merge_res = $merger->merge($clsets[-1], $clset);
#                unless ($merge_res->{success}) {
#                    die "Can't merge clause set: $merge_res->{error}";
#                }
#                $clsets[-1] = $merge_res->{result};
#            } else {
#                push @clsets, $clset;
#            }
#        }
#
#        $res->[1] = \@clsets;
#    }
#
#    $res->[2] = $seen if $opts->{return_intermediates};
#
#    $res;
#}
#
#1;
#
#__END__
#
### Data/Sah/Type/BaseType.pm ###
#package Data::Sah::Type::BaseType;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#use Role::Tiny;
#use Data::Sah::Util::Role 'has_clause';
#
#1;
#
#__END__
#
### Data/Sah/Util/Func.pm ###
#package Data::Sah::Util::Func;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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-12-09'; 
#our $VERSION = '0.46'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(get_type is_type is_simple is_numeric is_collection is_ref);
#
#our $type_metas = {
#    all   => {scalar=>0, numeric=>0, ref=>0},
#    any   => {scalar=>0, numeric=>0, ref=>0},
#    array => {scalar=>0, numeric=>0, ref=>1},
#    bool  => {scalar=>1, numeric=>0, ref=>0},
#    buf   => {scalar=>1, numeric=>0, ref=>0},
#    cistr => {scalar=>1, numeric=>0, ref=>0},
#    code  => {scalar=>1, numeric=>0, ref=>1},
#    float => {scalar=>1, numeric=>1, ref=>0},
#    hash  => {scalar=>0, numeric=>0, ref=>1},
#    int   => {scalar=>1, numeric=>1, ref=>0},
#    num   => {scalar=>1, numeric=>1, ref=>0},
#    obj   => {scalar=>1, numeric=>0, ref=>1},
#    re    => {scalar=>1, numeric=>0, ref=>1, simple=>1},
#    str   => {scalar=>1, numeric=>0, ref=>0},
#    undef => {scalar=>1, numeric=>0, ref=>0},
#    date     => {scalar=>1, numeric=>0, ref=>0},
#    duration => {scalar=>1, numeric=>0, ref=>0},
#};
#
#sub get_type {
#    my $sch = shift;
#
#    if (ref($sch) eq 'ARRAY') {
#        $sch = $sch->[0];
#    }
#
#    if (defined($sch) && !ref($sch)) {
#        $sch =~ s/\*\z//;
#        return $sch;
#    } else {
#        return undef;
#    }
#}
#
#sub _normalize {
#    require Data::Sah::Normalize;
#
#    my ($sch, $opts) = @_;
#    return $sch if $opts->{schema_is_normalized};
#    return Data::Sah::Normalize::normalize_schema($sch);
#}
#
#sub _handle_any_all {
#    my ($sch, $opts, $crit) = @_;
#    $sch = _normalize($sch, $opts);
#    return 0 if $sch->[1]{'of.op'};
#    my $of = $sch->[1]{of};
#    return 0 unless $of && ref($of) eq 'ARRAY' && @$of;
#    for (@$of) {
#        return 0 unless $crit->($_);
#    }
#    1;
#}
#
#sub is_type {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    $type;
#}
#
#sub is_simple {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_simple(shift) });
#    }
#    return $tmeta->{simple} // ($tmeta->{scalar} && !$tmeta->{ref});
#}
#
#sub is_collection {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_collection(shift) });
#    }
#    return !$tmeta->{scalar};
#}
#
#sub is_numeric {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_numeric(shift) });
#    }
#    return $tmeta->{numeric};
#}
#
#sub is_ref {
#    my ($sch, $opts) = @_;
#    $opts //= {};
#
#    my $type = get_type($sch) or return undef;
#    my $tmeta = $type_metas->{$type} or return undef;
#    if ($type eq 'any' || $type eq 'all') {
#        return _handle_any_all($sch, $opts, sub { is_ref(shift) });
#    }
#    return $tmeta->{ref};
#}
#
#1;
#
#__END__
#
### Data/Sah/Util/Type/Date.pm ###
#package Data::Sah::Util::Type::Date;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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__
#
### Encode/Locale.pm ###
#package Encode::Locale;
#
#use strict;
#our $VERSION = "1.05";
#
#use base 'Exporter';
#our @EXPORT_OK = qw(
#    decode_argv env
#    $ENCODING_LOCALE $ENCODING_LOCALE_FS
#    $ENCODING_CONSOLE_IN $ENCODING_CONSOLE_OUT
#);
#
#use Encode ();
#use Encode::Alias ();
#
#our $ENCODING_LOCALE;
#our $ENCODING_LOCALE_FS;
#our $ENCODING_CONSOLE_IN;
#our $ENCODING_CONSOLE_OUT;
#
#sub DEBUG () { 0 }
#
#sub _init {
#    if ($^O eq "MSWin32") {
#	unless ($ENCODING_LOCALE) {
#	    eval {
#		unless (defined &GetACP) {
#		    require Win32;
#                    eval { Win32::GetACP() };
#		    *GetACP = sub { &Win32::GetACP } unless $@;
#		}
#		unless (defined &GetACP) {
#		    require Win32::API;
#		    Win32::API->Import('kernel32', 'int GetACP()');
#		}
#		if (defined &GetACP) {
#		    my $cp = GetACP();
#		    $ENCODING_LOCALE = "cp$cp" if $cp;
#		}
#	    };
#	}
#
#	unless ($ENCODING_CONSOLE_IN) {
#            unless (defined &GetInputCP) {
#                eval {
#                    require Win32;
#                    eval { Win32::GetConsoleCP() };
#                    *GetInputCP = sub { &Win32::GetConsoleCP } unless $@;
#                    *GetOutputCP = sub { &Win32::GetConsoleOutputCP } unless $@;
#                };
#                unless (defined &GetInputCP) {
#                    eval {
#                        require Win32::Console;
#                        eval { Win32::Console::InputCP() };
#                        *GetInputCP = sub { &Win32::Console::InputCP }
#                            unless $@;
#                        *GetOutputCP = sub { &Win32::Console::OutputCP }
#                            unless $@;
#                    };
#                }
#                unless (defined &GetInputCP) {
#                    *GetInputCP = *GetOutputCP = sub {
#                        ((qx(chcp) || '') =~ /^Active code page: (\d+)/)
#                            ? $1 : ();
#                    };
#                }
#	    }
#            my $cp = GetInputCP();
#            $ENCODING_CONSOLE_IN = "cp$cp" if $cp;
#            $cp = GetOutputCP();
#            $ENCODING_CONSOLE_OUT = "cp$cp" if $cp;
#	}
#    }
#
#    unless ($ENCODING_LOCALE) {
#	eval {
#	    require I18N::Langinfo;
#	    $ENCODING_LOCALE = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
#
#	    $ENCODING_LOCALE = "ascii" if $ENCODING_LOCALE eq "646";
#
#	    $ENCODING_LOCALE = "hp-roman8" if $^O eq "hpux" && $ENCODING_LOCALE eq "roman8";
#	};
#	$ENCODING_LOCALE ||= $ENCODING_CONSOLE_IN;
#    }
#
#    if ($^O eq "darwin") {
#	$ENCODING_LOCALE_FS ||= "UTF-8";
#    }
#
#    $ENCODING_LOCALE ||= $^O eq "MSWin32" ? "cp1252" : "UTF-8";
#    $ENCODING_LOCALE_FS ||= $ENCODING_LOCALE;
#    $ENCODING_CONSOLE_IN ||= $ENCODING_LOCALE;
#    $ENCODING_CONSOLE_OUT ||= $ENCODING_CONSOLE_IN;
#
#    unless (Encode::find_encoding($ENCODING_LOCALE)) {
#	my $foundit;
#	if (lc($ENCODING_LOCALE) eq "gb18030") {
#	    eval {
#		require Encode::HanExtra;
#	    };
#	    if ($@) {
#		die "Need Encode::HanExtra to be installed to support locale codeset ($ENCODING_LOCALE), stopped";
#	    }
#	    $foundit++ if Encode::find_encoding($ENCODING_LOCALE);
#	}
#	die "The locale codeset ($ENCODING_LOCALE) isn't one that perl can decode, stopped"
#	    unless $foundit;
#
#    }
#
#}
#
#_init();
#Encode::Alias::define_alias(sub {
#    no strict 'refs';
#    no warnings 'once';
#    return ${"ENCODING_" . uc(shift)};
#}, "locale");
#
#sub _flush_aliases {
#    no strict 'refs';
#    for my $a (keys %Encode::Alias::Alias) {
#	if (defined ${"ENCODING_" . uc($a)}) {
#	    delete $Encode::Alias::Alias{$a};
#	    warn "Flushed alias cache for $a" if DEBUG;
#	}
#    }
#}
#
#sub reinit {
#    $ENCODING_LOCALE = shift;
#    $ENCODING_LOCALE_FS = shift;
#    $ENCODING_CONSOLE_IN = $ENCODING_LOCALE;
#    $ENCODING_CONSOLE_OUT = $ENCODING_LOCALE;
#    _init();
#    _flush_aliases();
#}
#
#sub decode_argv {
#    die if defined wantarray;
#    for (@ARGV) {
#	$_ = Encode::decode(locale => $_, @_);
#    }
#}
#
#sub env {
#    my $k = Encode::encode(locale => shift);
#    my $old = $ENV{$k};
#    if (@_) {
#	my $v = shift;
#	if (defined $v) {
#	    $ENV{$k} = Encode::encode(locale => $v);
#	}
#	else {
#	    delete $ENV{$k};
#	}
#    }
#    return Encode::decode(locale => $old) if defined wantarray;
#}
#
#1;
#
#__END__
#
### File/Flock/Retry.pm ###
#package File::Flock::Retry;
#
#our $DATE = '2017-07-01'; 
#our $VERSION = '0.62'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Fcntl ':flock';
#
#sub lock {
#    my ($class, $path, $opts) = @_;
#    $opts //= {};
#    my %h;
#
#    defined($path) or die "Please specify path";
#    $h{path}    = $path;
#    $h{retries} = $opts->{retries} // 60;
#    $h{shared}  = $opts->{shared} // 0;
#
#    my $self = bless \%h, $class;
#    $self->_lock;
#    $self;
#}
#
#sub _lock {
#    my $self = shift;
#
#    return 0 if $self->{_fh};
#
#    my $path = $self->{path};
#    my $existed = -f $path;
#    my $exists;
#    my $tries = 0;
#  TRY:
#    while (1) {
#        $tries++;
#
#        open $self->{_fh}, ">>", $path
#            or die "Can't open lock file '$path': $!";
#
#        my @st1 = stat($self->{_fh}); 
#
#        if (flock($self->{_fh}, ($self->{shared} ? LOCK_SH : LOCK_EX) | LOCK_NB)) {
#            redo TRY unless @st1;
#
#            my @st2 = stat($path); 
#
#            redo TRY unless @st2;
#
#            redo TRY if $st1[0] != $st2[0] || $st1[1] != $st2[1];
#
#            last;
#        } else {
#            $tries <= $self->{retries}
#                or die "Can't acquire lock on '$path' after $tries seconds";
#            sleep 1;
#        }
#    }
#    $self->{_created} = !$existed;
#    1;
#}
#
#sub _unlock {
#    my ($self) = @_;
#
#    my $path = $self->{path};
#
#    return 0 unless $self->{_fh};
#
#    unlink $self->{path} if $self->{_created} && !(-s $self->{path});
#
#    {
#        no warnings;
#
#        flock $self->{_fh}, LOCK_UN;
#    }
#    close delete($self->{_fh});
#    1;
#}
#
#sub release {
#    my $self = shift;
#    $self->_unlock;
#}
#
#sub unlock {
#    my $self = shift;
#    $self->_unlock;
#}
#
#sub DESTROY {
#    my $self = shift;
#    $self->_unlock;
#}
#
#1;
#
#__END__
#
### File/RsyBak.pm ###
#package File::RsyBak;
#
#our $DATE = '2017-07-31'; 
#our $VERSION = '0.35'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use File::chdir;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(backup);
#
#our %SPEC;
#
#sub _parse_path {
#    require Cwd;
#
#    my ($path) = @_;
#    $path =~ s!/+$!!;
#    if ($path =~ m!^(\S+)::([^/]+)/?(.*)$!) {
#        return {
#            raw=>$path, remote=>1, host=>$1,
#            proto=>"rsync", module=>$2, path=>$3,
#        };
#    } elsif ($path =~ m!([^@]+)?\@?(^\S+):(.*)$!) {
#        return {
#            raw=>$path, remote=>1, host=>$2,
#            user=>$1, proto=>"ssh", path=>$3,
#        };
#    } else {
#        return {
#            raw=>$path, remote=>0, path=>$path,
#            abs_path=>Cwd::abs_path($path)
#        };
#    }
#}
#
#sub _check_sources {
#    my ($sources) = @_;
#
#    my $all_local = 1;
#    for (@$sources) {
#        if ($_->{remote}) { $all_local = 0; last }
#    }
#
#    my $all_remote = 1;
#    for (@$sources) {
#        if (!$_->{remote}) { $all_remote = 0; last }
#    }
#
#    return [400, "Sources must be all local or all remote"]
#        unless $all_remote || $all_local;
#
#    if ($all_remote) {
#        my $host;
#        for (@$sources) {
#            $host //= $_->{host};
#            return [400, "Remote sources must all be from the same machine"]
#                if $host ne $_->{host};
#        }
#    }
#    [200, "OK"];
#}
#
#$SPEC{backup} = {
#    v             => 1.1,
#    summary       =>
#        'Backup files/directories with histories, using rsync',
#    args          => {
#        source           => {
#            summary      => 'Director(y|ies) to backup',
#            schema       => 'str*', 
#            req          => 1,
#            pos          => 0,
#        },
#        target           => {
#            summary      => 'Backup destination',
#            schema       => ['str*'   => {}],
#            req          => 1,
#            pos          => 1,
#        },
#        histories        => {
#            summary      => 'Histories/history levels',
#            schema       => ['array' => {
#                default      => [-7, 4, 3],
#                of           => 'int*',
#            }],
#            description  => <<'_',
#
#Specifies number of backup histories to keep for level 1, 2, and so on. If
#number is negative, specifies number of days to keep instead (regardless of
#number of histories).
#
#_
#        },
#        extra_dir        => {
#            summary      =>
#                'Whether to force creation of source directory in target',
#            schema       => ['bool'   => {}],
#            description  => <<'_',
#
#If set to 1, then backup(source => '/a', target => '/backup/a') will create
#another 'a' directory in target, i.e. /backup/a/current/a. Otherwise, contents
#of a/ will be directly copied under /backup/a/current/.
#
#Will always be set to 1 if source is more than one, but default to 0 if source
#is a single directory. You can set this to 1 to so that behaviour when there is
#a single source is the same as behaviour when there are several sources.
#
#_
#        },
#        backup           => {
#            summary      => 'Whether to do backup or not',
#            schema       => [bool     => {
#                default      => 1,
#            }],
#            description  => <<'_',
#
#If backup=1 and rotate=0 then will only create new backup without rotating
#histories.
#
#_
#        },
#        rotate           => {
#            summary      => 'Whether to do rotate after backup or not',
#            schema       => [bool     => {
#                default      => 1,
#            }],
#            description  => <<'_',
#
#If backup=0 and rotate=1 then will only do history rotating.
#
#_
#        },
#        extra_rsync_opts => {
#            summary      => 'Pass extra options to rsync command',
#            schema       => [array    => {
#                of           => 'str*',
#            }],
#            description  => <<'_',
#
#Extra options to pass to rsync command when doing backup. Note that the options
#will be shell quoted, , so you should pass it unquoted, e.g. ['--exclude',
#'/Program Files'].
#
#_
#        },
#    },
#
#    examples => [
#        {
#            argv         => ['/home/jajang/mydata','/backup/jajang/mydata'],
#            test         => 0,
#            'x.doc.show_result' => 0,
#            description  => <<'_',
#
#Backup /home/jajang/mydata to /backup/jajang/mydata using the default number of
#histories ([-7, 4, 3]).
#
#_
#        },
#    ],
#
#    deps => {
#        all => [
#            {prog => 'nice'},
#            {prog => 'rsync'}, 
#            {prog => 'rm'},    
#        ],
#    },
#};
#sub backup {
#    require File::Flock::Retry;
#    require File::Path;
#    require File::Which;
#
#    my %args = @_;
#
#    my $source    = $args{source} or return [400, "Please specify source"];
#    my @sources   = ref($source) eq 'ARRAY' ? @$source : ($source);
#    for (@sources) { $_ = _parse_path($_) }
#    my $res = _check_sources(\@sources);
#    return $res unless $res->[0] == 200;
#    my $target    = $args{target} or return [400, "Please specify target"];
#    $target       = _parse_path($target);
#    $target->{remote} and
#        return [400, "Sorry, target can't be remote at the moment"];
#    my $histories = $args{histories} // [-7, 4, 3];
#    ref($histories) eq 'ARRAY' or return [400, "histories must be array"];
#    my $backup    = $args{backup} // 1;
#    my $rotate    = $args{rotate} // 1;
#    my $extra_dir = $args{extra_dir} || (@sources > 1);
#
#    my $rsync_path = File::Which::which("rsync")
#        or return [500, "Can't find rsync in PATH"];
#
#    unless (-d $target->{abs_path}) {
#        log_debug("Creating target directory %s ...", $target->{abs_path});
#        File::Path::make_path($target->{abs_path})
#            or return [500, "Error: Can't create target directory ".
#                "$target->{abs_path}: $!"];
#    }
#
#    my $lock = File::Flock::Retry->lock("$target->{abs_path}/.lock");
#
#    if ($backup) {
#        _backup(
#            \@sources, $target,
#            {
#                extra_dir        => $extra_dir,
#                extra_rsync_opts => $args{extra_rsync_opts},
#            });
#    }
#
#    if ($rotate) {
#        _rotate($target->{abs_path}, $histories);
#    }
#
#    [200, "OK"];
#}
#
#sub _backup {
#    require POSIX;
#    require String::ShellQuote; String::ShellQuote->import;
#
#    my ($sources, $target, $opts) = @_;
#    log_info("Starting backup %s ==> %s ...",
#                [map {$_->{raw}} @$sources], $target);
#    my $cmd;
#    $cmd = join(
#        "",
#        "nice -n19 rsync ",
#        ($opts->{extra_rsync_opts} ? map { shell_quote($_), " " }
#             @{$opts->{extra_rsync_opts}} : ()),
#        "-a --del --force --ignore-errors --ignore-existing ",
#        (log_is_debug() ? "-v " : ""),
#        ((-e "$target->{abs_path}/current") ?
#             "--link-dest ".shell_quote("$target->{abs_path}/current")." "
#                 : ""),
#        map({ shell_quote($_->{raw}), ($opts->{extra_dir} ? "" : "/"), " " }
#                @$sources),
#        shell_quote("$target->{abs_path}/.tmp/"),
#    );
#    log_debug("Running rsync ...");
#    log_trace("system(): $cmd");
#    system $cmd;
#    log_warn("rsync didn't succeed ($?)".
#                   ", please recheck") if $?;
#
#
#    if (-e "$target->{abs_path}/current") {
#        my $tspath = "$target->{abs_path}/.current.timestamp";
#        my @st     = stat($tspath);
#        my $tstamp = POSIX::strftime(
#            "%Y-%m-%d\@%H:%M:%S+00",
#            gmtime( $st[9] || time() )); 
#        log_debug("rename $target->{abs_path}/current ==> ".
#                        "hist.$tstamp ...");
#        unless (rename "$target->{abs_path}/current",
#                "$target->{abs_path}/hist.$tstamp") {
#            log_warn("Failed renaming $target->{abs_path}/current ==> ".
#                         "hist.$tstamp: $!");
#        }
#        log_debug("touch $tspath ...");
#        system "touch ".shell_quote($tspath);
#    }
#
#    log_debug("rename $target->{abs_path}/.tmp ==> current ...");
#    unless (rename "$target->{abs_path}/.tmp",
#            "$target->{abs_path}/current") {
#        log_warn("Failed renaming $target->{abs_path}/.tmp ==> current: $!");
#    }
#
#    log_info("Finished backup %s ==> %s", $sources, $target);
#}
#
#sub _rotate {
#    require String::ShellQuote; String::ShellQuote->import;
#    require Time::Local;
#
#    my ($target, $histories) = @_;
#    log_info("Rotating backup histories in %s (%s) ...",
#                $target, $histories);
#
#    local $CWD = $target; 
#
#    my $now = time();
#    for my $level (1 .. @$histories) {
#        my $is_highest_level  = $level == @$histories;
#        my $prefix            = "hist" . ($level == 1 ? '' : $level);
#        my $prefix_next_level = "hist" . ($level + 1);
#        my $n                 = $histories->[$level - 1];
#        my $moved             = 0;
#
#        if ($n > 0) {
#            log_debug("Only keeping $n level-$level histories ...");
#            my @f = reverse sort grep { !/\.tmp$/ } glob "$prefix.*";
#            my $any_tagged = (grep {/t$/} @f) ? 1 : 0;
#            for my $f (@f[ $n .. @f - 1 ]) {
#                my ($st, $tagged) = $f =~ /[^.]+\.(.+?)(t)?$/;
#                my $f2 = "$prefix_next_level.$st";
#                if (!$is_highest_level &&
#                        !$moved && ($tagged || !$any_tagged)) {
#                    log_debug("Moving history level: $f -> $f2");
#                    rename $f, $f2;
#                    $moved++;
#                    if ($f ne $f[0]) {
#                        rename $f[0], "$f[0]t";
#                    }
#                } else {
#                    log_debug("Removing history: $f ...");
#                    system "nice -n19 rm -rf " . shell_quote($f);
#                }
#            }
#        } else {
#            $n = -$n;
#            log_debug("Only keeping $n day(s) of level-$level histories ...");
#            my @f = reverse sort grep { !/\.tmp$/ } glob "$prefix.*";
#            my $any_tagged = ( grep {/t$/} @f ) ? 1 : 0;
#            for my $f (@f) {
#                my ($st, $tagged) = $f =~ /[^.]+\.(.+?)(t)?$/;
#                my $f2 = "$prefix_next_level.$st";
#                my $t;
#                $st =~ /(\d\d\d\d)-(\d\d)-(\d\d)\@(\d\d):(\d\d):(\d\d)\+00/;
#                $t = Time::Local::timegm($6, $5, $4, $3, $2 - 1, $1) if $1;
#                unless ($st && $t) {
#                    log_warn("Wrong format of history, ignored: $f");
#                    next;
#                }
#                if ($t > $now) {
#                    log_warn("History in the future, ignored: $f");
#                    next;
#                }
#                my $delta = ($now - $t) / 86400;
#                if ($delta > $n) {
#                    if (!$is_highest_level &&
#                            !$moved && ( $tagged || !$any_tagged)) {
#                        log_debug("Moving history level: $f -> $f2");
#                        rename $f, $f2;
#                        $moved++;
#                        if ($f ne $f[0]) {
#                            rename $f[0], "$f[0]t";
#                        }
#                    } else {
#                        log_debug("Removing history: $f ...");
#                        system "nice -n19 rm -rf " . shell_quote($f);
#                    }
#                }
#            }
#        }
#    }
#}
#
#1;
#
#__END__
#
### File/RsyBak/Packed.pm ###
#package File::RsyBak::Packed;
#
#our $DATE = '2017-07-31'; 
#our $VERSION = '0.35'; 
#
#
#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.009';
#use strict;
#use warnings;
#
#use Carp 'croak';
#use Exporter 5.57 'import';
#
#use Encode qw(:fallbacks);
#use PerlIO::encoding;
#
#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 = FB_CROAK;
#	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 = FB_CROAK;
#	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 = FB_CROAK;
#	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.08'; 
#
#our $USE_NONCORE_XS_FIRST = 1;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       clone
#                       clone_list
#                       unbless
#                       uniq
#               );
#
#sub clone {
#    my $data = shift;
#    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
#    goto FALLBACK unless eval { require Data::Clone; 1 };
#
#  STANDARD:
#    return Data::Clone::clone($data);
#
#  FALLBACK:
#    require Clone::PP;
#    return Clone::PP::clone($data);
#}
#
#sub clone_list {
#    map { clone($_) } @_;
#}
#
#sub _unbless_fallback {
#    my $ref = shift;
#
#    my $r = ref($ref);
#    return $ref unless $r;
#
#    my ($r2, $r3) = "$ref" =~ /(.+)=(.+?)\(/
#        or return $ref;
#
#    if ($r3 eq 'HASH') {
#        return { %$ref };
#    } elsif ($r3 eq 'ARRAY') {
#        return [ @$ref ];
#    } elsif ($r3 eq 'SCALAR') {
#        return \( my $copy = ${$ref} );
#    } elsif ($r3 eq 'CODE') {
#        return sub { goto &$ref };
#    } else {
#        die "Can't handle $ref";
#    }
#}
#
#sub unbless {
#    my $ref = shift;
#
#    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
#    goto FALLBACK unless eval { require Acme::Damn; 1 };
#
#  STANDARD:
#    return Acme::Damn::damn($ref);
#
#  FALLBACK:
#    return _unbless_fallback($ref);
#}
#
#sub uniq {
#    goto FALLBACK unless $USE_NONCORE_XS_FIRST;
#    goto FALLBACK unless eval { require List::MoreUtils; 1 };
#
#  STANDARD:
#    return List::MoreUtils::uniq(@_);
#
#  FALLBACK:
#    my %h;
#    my @res;
#    for (@_) {
#        push @res, $_ unless $h{$_}++;
#    }
#    return @res;
#}
#
#1;
#
#__END__
#
### Getopt/Long/Negate/EN.pm ###
#package Getopt::Long::Negate::EN;
#
#our $DATE = '2016-03-01'; 
#our $VERSION = '0.05'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(negations_for_option);
#
#sub negations_for_option {
#    my $word = shift;
#
#    if    ($word =~ /\Awith([_-].+)/   ) { return ("without$1") }
#    elsif ($word =~ /\Awithout([_-].+)/) { return ("with$1")    }
#
#    elsif ($word =~ /\Ais([_-].+)/     ) { return ("isnt$1")    }
#    elsif ($word =~ /\Aisnt([_-].+)/   ) { return ("is$1")      }
#    elsif ($word =~ /\Aare([_-].+)/    ) { return ("arent$1")   }
#    elsif ($word =~ /\Aarent([_-].+)/  ) { return ("are$1")     }
#
#    elsif ($word =~ /\Ahas([_-].+)/    ) { return ("hasnt$1")   }
#    elsif ($word =~ /\Ahave([_-].+)/   ) { return ("havent$1")  }
#    elsif ($word =~ /\Ahasnt([_-].+)/  ) { return ("has$1")     }
#    elsif ($word =~ /\Ahavent([_-].+)/ ) { return ("have$1")    }
#
#    elsif ($word =~ /\Acan([_-].+)/    ) { return ("cant$1")    }
#    elsif ($word =~ /\Acant([_-].+)/   ) { return ("can$1")     }
#
#    elsif ($word =~ /\Aenabled([_-].+)/ ) { return ("disabled$1") }
#    elsif ($word =~ /\Adisabled([_-].+)/) { return ("enabled$1")  }
#    elsif ($word =~ /\Aenable([_-].+)/ )  { return ("disable$1")  }
#    elsif ($word =~ /\Adisable([_-].+)/)  { return ("enable$1")   }
#
#    elsif ($word =~ /\Aallowed([_-].+)/ )   { return ("disallowed$1") }
#    elsif ($word =~ /\Adisallowed([_-].+)/) { return ("allowed$1")    }
#    elsif ($word =~ /\Aallow([_-].+)/ )     { return ("disallow$1")   }
#    elsif ($word =~ /\Adisallow([_-].+)/)   { return ("allow$1")      }
#
#    elsif ($word =~ /\Ano[_-](.+)/     ) { return ($1)          }
#
#    else {
#        return ("no-$word", "no$word");
#    }
#}
#
#1;
#
#__END__
#
### Getopt/Long/Util.pm ###
#package Getopt::Long::Util;
#
#our $DATE = '2016-10-30'; 
#our $VERSION = '0.88'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       parse_getopt_long_opt_spec
#                       humanize_getopt_long_opt_spec
#                       detect_getopt_long_script
#                       gen_getopt_long_spec_from_getopt_std_spec
#               );
#
#our %SPEC;
#
#$SPEC{parse_getopt_long_opt_spec} = {
#    v => 1.1,
#    summary => 'Parse a single Getopt::Long option specification',
#    description => <<'_',
#
#Will produce a hash with some keys:
#
#* `is_arg` (if true, then option specification is the special `<>` for argument
#  callback)
#* `opts` (array of option names, in the order specified in the opt spec)
#* `type` (string, type name)
#* `desttype` (either '', or '@' or '%'),
#* `is_neg` (true for `--opt!`)
#* `is_inc` (true for `--opt+`)
#* `min_vals` (int, usually 0 or 1)
#* `max_vals` (int, usually 0 or 1 except for option that requires multiple
#  values)
#
#Will return undef if it can't parse the string.
#
#_
#    args => {
#        optspec => {
#            schema => 'str*',
#            req => 1,
#            pos => 0,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#    },
#    examples => [
#        {
#            args => {optspec => 'help|h|?'},
#            result => {dash_prefix=>'', opts=>['help', 'h', '?']},
#        },
#        {
#            args => {optspec=>'--foo=s'},
#            result => {dash_prefix=>'--', opts=>['foo'], type=>'s', desttype=>''},
#        },
#    ],
#};
#sub parse_getopt_long_opt_spec {
#    my $optspec = shift;
#    return {is_arg=>1, dash_prefix=>'', opts=>[]}
#        if $optspec eq '<>';
#    $optspec =~ qr/\A
#               (?P<dash_prefix>-{0,2})
#               (?P<name>[A-Za-z0-9_][A-Za-z0-9_-]*)
#               (?P<aliases> (?: \| (?:[^:|!+=:-][^:|!+=:]*) )*)?
#               (?:
#                   (?P<is_neg>!) |
#                   (?P<is_inc>\+) |
#                   (?:
#                       =
#                       (?P<type>[siof])
#                       (?P<desttype>|[%@])?
#                       (?:
#                           \{
#                           (?: (?P<min_vals>\d+), )?
#                           (?P<max_vals>\d+)
#                           \}
#                       )?
#                   ) |
#                   (?:
#                       :
#                       (?P<opttype>[siof])
#                       (?P<desttype>|[%@])
#                   ) |
#                   (?:
#                       :
#                       (?P<optnum>\d+)
#                       (?P<desttype>|[%@])
#                   )
#                   (?:
#                       :
#                       (?P<optplus>\+)
#                       (?P<desttype>|[%@])
#                   )
#               )?
#               \z/x
#                   or return undef;
#    my %res = %+;
#
#    if ($res{aliases}) {
#        my @als;
#        for my $al (split /\|/, $res{aliases}) {
#            next unless length $al;
#            next if $al eq $res{name};
#            next if grep {$_ eq $al} @als;
#            push @als, $al;
#        }
#        $res{opts} = [$res{name}, @als];
#    } else {
#        $res{opts} = [$res{name}];
#    }
#    delete $res{name};
#    delete $res{aliases};
#
#    $res{is_neg} = 1 if $res{is_neg};
#    $res{is_inc} = 1 if $res{is_inc};
#
#    \%res;
#}
#
#$SPEC{humanize_getopt_long_opt_spec} = {
#    v => 1.1,
#    description => <<'_',
#
#Convert <pm:Getopt::Long> option specification like `help|h|?` or `--foo=s` or
#`debug!` into, respectively, `--help, -h, -?` or `--foo=s` or `--(no)debug`.
#Will die if can't parse the string. The output is suitable for including in
#help/usage text.
#
#_
#    args => {
#        optspec => {
#            schema => 'str*',
#            req => 1,
#            pos => 0,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#    result => {
#        schema => 'str*',
#    },
#};
#sub humanize_getopt_long_opt_spec {
#    my $optspec = shift;
#
#    my $parse = parse_getopt_long_opt_spec($optspec)
#        or die "Can't parse opt spec $optspec";
#
#    return "argument" if $parse->{is_arg};
#
#    my $res = '';
#    my $i = 0;
#    for (@{ $parse->{opts} }) {
#        $i++;
#        $res .= ", " if length($res);
#        if ($parse->{is_neg} && length($_) > 1) {
#            $res .= "--(no)$_";
#        } else {
#            if (length($_) > 1) {
#                $res .= "--$_";
#            } else {
#                $res .= "-$_";
#            }
#            $res .= "=$parse->{type}" if $i==1 && $parse->{type};
#        }
#    }
#    $res;
#}
#
#$SPEC{detect_getopt_long_script} = {
#    v => 1.1,
#    summary => 'Detect whether a file is a Getopt::Long-based CLI script',
#    description => <<'_',
#
#The criteria are:
#
#* the file must exist and readable;
#
#* (optional, if `include_noexec` is false) file must have its executable mode
#  bit set;
#
#* content must start with a shebang C<#!>;
#
#* either: must be perl script (shebang line contains 'perl') and must contain
#  something like `use Getopt::Long`;
#
#_
#    args => {
#        filename => {
#            summary => 'Path to file to be checked',
#            schema => 'str*',
#            pos => 0,
#            cmdline_aliases => {f=>{}},
#        },
#        string => {
#            summary => 'String to be checked',
#            schema => 'buf*',
#        },
#        include_noexec => {
#            summary => 'Include scripts that do not have +x mode bit set',
#            schema  => 'bool*',
#            default => 1,
#        },
#    },
#    args_rels => {
#        'req_one' => ['filename', 'string'],
#    },
#};
#sub detect_getopt_long_script {
#    my %args = @_;
#
#    (defined($args{filename}) xor defined($args{string}))
#        or return [400, "Please specify either filename or string"];
#    my $include_noexec  = $args{include_noexec}  // 1;
#
#    my $yesno = 0;
#    my $reason = "";
#    my %extrameta;
#
#    my $str = $args{string};
#  DETECT:
#    {
#        if (defined $args{filename}) {
#            my $fn = $args{filename};
#            unless (-f $fn) {
#                $reason = "'$fn' is not a file";
#                last;
#            };
#            if (!$include_noexec && !(-x _)) {
#                $reason = "'$fn' is not an executable";
#                last;
#            }
#            my $fh;
#            unless (open $fh, "<", $fn) {
#                $reason = "Can't be read";
#                last;
#            }
#            read $fh, $str, 2;
#            unless ($str eq '#!') {
#                $reason = "Does not start with a shebang (#!) sequence";
#                last;
#            }
#            my $shebang = <$fh>;
#            unless ($shebang =~ /perl/) {
#                $reason = "Does not have 'perl' in the shebang line";
#                last;
#            }
#            seek $fh, 0, 0;
#            {
#                local $/;
#                $str = <$fh>;
#            }
#        }
#        unless ($str =~ /\A#!/) {
#            $reason = "Does not start with a shebang (#!) sequence";
#            last;
#        }
#        unless ($str =~ /\A#!.*perl/) {
#            $reason = "Does not have 'perl' in the shebang line";
#            last;
#        }
#
#
#
#        for (split /^/, $str) {
#            if (/^\s*(use|require)\s+(Getopt::Long(?:::Complete)?)(\s|;|$)/) {
#                $yesno = 1;
#                $extrameta{'func.module'} = $2;
#                last DETECT;
#            }
#        }
#
#        $reason = "Can't find any statement requiring Getopt::Long(?::Complete)? module";
#    } 
#
#    [200, "OK", $yesno, {"func.reason"=>$reason, %extrameta}];
#}
#
#$SPEC{gen_getopt_long_spec_from_getopt_std_spec} = {
#    v => 1.1,
#    summary => 'Generate Getopt::Long spec from Getopt::Std spec',
#    args => {
#        spec => {
#            summary => 'Getopt::Std spec string',
#            schema => 'str*',
#            req => 1,
#            pos => 0,
#        },
#        is_getopt => {
#            summary => 'Whether to assume spec is for getopt() or getopts()',
#            description => <<'_',
#
#By default spec is assumed to be for getopts() instead of getopt(). This means
#that for a spec like `abc:`, `a` and `b` don't take argument while `c` does. But
#if `is_getopt` is true, the meaning of `:` is reversed: `a` and `b` take
#arguments while `c` doesn't.
#
#_
#            schema => 'bool',
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#    },
#};
#sub gen_getopt_long_spec_from_getopt_std_spec {
#    my %args = @_;
#
#    my $is_getopt = $args{is_getopt};
#    my $spec = {};
#
#    while ($args{spec} =~ /(.)(:?)/g) {
#        $spec->{$1 . ($is_getopt ? ($2 ? "" : "=s") : ($2 ? "=s" : ""))} =
#            sub {};
#    }
#
#    $spec;
#}
#
#
#__END__
#
### HTTP/Config.pm ###
#package HTTP::Config;
#
#use strict;
#use warnings;
#
#use URI;
#
#our $VERSION = "6.11";
#
#sub new {
#    my $class = shift;
#    return bless [], $class;
#}
#
#sub entries {
#    my $self = shift;
#    @$self;
#}
#
#sub empty {
#    my $self = shift;
#    not @$self;
#}
#
#sub add {
#    if (@_ == 2) {
#        my $self = shift;
#        push(@$self, shift);
#        return;
#    }
#    my($self, %spec) = @_;
#    push(@$self, \%spec);
#    return;
#}
#
#sub find2 {
#    my($self, %spec) = @_;
#    my @found;
#    my @rest;
# ITEM:
#    for my $item (@$self) {
#        for my $k (keys %spec) {
#            no warnings 'uninitialized';
#            if (!exists $item->{$k} || $spec{$k} ne $item->{$k}) {
#                push(@rest, $item);
#                next ITEM;
#            }
#        }
#        push(@found, $item);
#    }
#    return \@found unless wantarray;
#    return \@found, \@rest;
#}
#
#sub find {
#    my $self = shift;
#    my $f = $self->find2(@_);
#    return @$f if wantarray;
#    return $f->[0];
#}
#
#sub remove {
#    my($self, %spec) = @_;
#    my($removed, $rest) = $self->find2(%spec);
#    @$self = @$rest if @$removed;
#    return @$removed;
#}
#
#my %MATCH = (
#    m_scheme => sub {
#        my($v, $uri) = @_;
#        return $uri->_scheme eq $v;  
#    },
#    m_secure => sub {
#        my($v, $uri) = @_;
#        my $secure = $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https";
#        return $secure == !!$v;
#    },
#    m_host_port => sub {
#        my($v, $uri) = @_;
#        return unless $uri->can("host_port");
#        return $uri->host_port eq $v, 7;
#    },
#    m_host => sub {
#        my($v, $uri) = @_;
#        return unless $uri->can("host");
#        return $uri->host eq $v, 6;
#    },
#    m_port => sub {
#        my($v, $uri) = @_;
#        return unless $uri->can("port");
#        return $uri->port eq $v;
#    },
#    m_domain => sub {
#        my($v, $uri) = @_;
#        return unless $uri->can("host");
#        my $h = $uri->host;
#        $h = "$h.local" unless $h =~ /\./;
#        $v = ".$v" unless $v =~ /^\./;
#        return length($v), 5 if substr($h, -length($v)) eq $v;
#        return 0;
#    },
#    m_path => sub {
#        my($v, $uri) = @_;
#        return unless $uri->can("path");
#        return $uri->path eq $v, 4;
#    },
#    m_path_prefix => sub {
#        my($v, $uri) = @_;
#        return unless $uri->can("path");
#        my $path = $uri->path;
#        my $len = length($v);
#        return $len, 3 if $path eq $v;
#        return 0 if length($path) <= $len;
#        $v .= "/" unless $v =~ m,/\z,,;
#        return $len, 3 if substr($path, 0, length($v)) eq $v;
#        return 0;
#    },
#    m_path_match => sub {
#        my($v, $uri) = @_;
#        return unless $uri->can("path");
#        return $uri->path =~ $v;
#    },
#    m_uri__ => sub {
#        my($v, $k, $uri) = @_;
#        return unless $uri->can($k);
#        return 1 unless defined $v;
#        return $uri->$k eq $v;
#    },
#    m_method => sub {
#        my($v, $uri, $request) = @_;
#        return $request && $request->method eq $v;
#    },
#    m_proxy => sub {
#        my($v, $uri, $request) = @_;
#        return $request && ($request->{proxy} || "") eq $v;
#    },
#    m_code => sub {
#        my($v, $uri, $request, $response) = @_;
#        $v =~ s/xx\z//;
#        return unless $response;
#        return length($v), 2 if substr($response->code, 0, length($v)) eq $v;
#    },
#    m_media_type => sub {  
#        my($v, $uri, $request, $response) = @_;
#        return unless $response;
#        return 1, 1 if $v eq "*/*";
#        my $ct = $response->content_type;
#        return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,;
#        return 3, 1 if $v eq "html" && $response->content_is_html;
#        return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml;
#        return 10, 1 if $v eq $ct;
#        return 0;
#    },
#    m_header__ => sub {
#        my($v, $k, $uri, $request, $response) = @_;
#        return unless $request;
#        return 1 if $request->header($k) eq $v;
#        return 1 if $response && $response->header($k) eq $v;
#        return 0;
#    },
#    m_response_attr__ => sub {
#        my($v, $k, $uri, $request, $response) = @_;
#        return unless $response;
#        return 1 if !defined($v) && exists $response->{$k};
#        return 0 unless exists $response->{$k};
#        return 1 if $response->{$k} eq $v;
#        return 0;
#    },
#);
#
#sub matching {
#    my $self = shift;
#    if (@_ == 1) {
#        if ($_[0]->can("request")) {
#            unshift(@_, $_[0]->request);
#            unshift(@_, undef) unless defined $_[0];
#        }
#        unshift(@_, $_[0]->uri_canonical) if $_[0] && $_[0]->can("uri_canonical");
#    }
#    my($uri, $request, $response) = @_;
#    $uri = URI->new($uri) unless ref($uri);
#
#    my @m;
# ITEM:
#    for my $item (@$self) {
#        my $order;
#        for my $ikey (keys %$item) {
#            my $mkey = $ikey;
#            my $k;
#            $k = $1 if $mkey =~ s/__(.*)/__/;
#            if (my $m = $MATCH{$mkey}) {
#                my($c, $o);
#                my @arg = (
#                    defined($k) ? $k : (),
#                    $uri, $request, $response
#                );
#                my $v = $item->{$ikey};
#                $v = [$v] unless ref($v) eq "ARRAY";
#                for (@$v) {
#                    ($c, $o) = $m->($_, @arg);
#                    last if $c;
#                }
#                next ITEM unless $c;
#                $order->[$o || 0] += $c;
#            }
#        }
#        $order->[7] ||= 0;
#        $item->{_order} = join(".", reverse map sprintf("%03d", $_ || 0), @$order);
#        push(@m, $item);
#    }
#    @m = sort { $b->{_order} cmp $a->{_order} } @m;
#    delete $_->{_order} for @m;
#    return @m if wantarray;
#    return $m[0];
#}
#
#sub add_item {
#    my $self = shift;
#    my $item = shift;
#    return $self->add(item => $item, @_);
#}
#
#sub remove_items {
#    my $self = shift;
#    return map $_->{item}, $self->remove(@_);
#}
#
#sub matching_items {
#    my $self = shift;
#    return map $_->{item}, $self->matching(@_);
#}
#
#1;
#
#__END__
#
### HTTP/Date.pm ###
#package HTTP::Date;
#
#$VERSION = "6.02";
#
#require Exporter;
#@ISA = qw(Exporter);
#@EXPORT = qw(time2str str2time);
#@EXPORT_OK = qw(parse_date time2iso time2isoz);
#
#use strict;
#require Time::Local;
#
#use vars qw(@DoW @MoY %MoY);
#@DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
#@MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
#@MoY{@MoY} = (1..12);
#
#my %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, Z => 1);
#
#
#sub time2str (;$)
#{
#    my $time = shift;
#    $time = time unless defined $time;
#    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
#    sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
#	    $DoW[$wday],
#	    $mday, $MoY[$mon], $year+1900,
#	    $hour, $min, $sec);
#}
#
#
#sub str2time ($;$)
#{
#    my $str = shift;
#    return undef unless defined $str;
#
#    if ($str =~ /^[SMTWF][a-z][a-z], (\d\d) ([JFMAJSOND][a-z][a-z]) (\d\d\d\d) (\d\d):(\d\d):(\d\d) GMT$/) {
#	return eval {
#	    my $t = Time::Local::timegm($6, $5, $4, $1, $MoY{$2}-1, $3);
#	    $t < 0 ? undef : $t;
#	};
#    }
#
#    my @d = parse_date($str);
#    return undef unless @d;
#    $d[1]--;        
#
#    my $tz = pop(@d);
#    unless (defined $tz) {
#	unless (defined($tz = shift)) {
#	    return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
#			  my $t = Time::Local::timelocal(reverse @d) + $frac;
#			  $t < 0 ? undef : $t;
#		        };
#	}
#    }
#
#    my $offset = 0;
#    if ($GMT_ZONE{uc $tz}) {
#    }
#    elsif ($tz =~ /^([-+])?(\d\d?):?(\d\d)?$/) {
#	$offset = 3600 * $2;
#	$offset += 60 * $3 if $3;
#	$offset *= -1 if $1 && $1 eq '-';
#    }
#    else {
#	eval { require Time::Zone } || return undef;
#	$offset = Time::Zone::tz_offset($tz);
#	return undef unless defined $offset;
#    }
#
#    return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
#		  my $t = Time::Local::timegm(reverse @d) + $frac;
#		  $t < 0 ? undef : $t - $offset;
#		};
#}
#
#
#sub parse_date ($)
#{
#    local($_) = shift;
#    return unless defined;
#
#    s/^\s+//;  
#    s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; 
#
#    my($day, $mon, $yr, $hr, $min, $sec, $tz, $ampm);
#
#    (($day,$mon,$yr,$hr,$min,$sec,$tz) =
#        /^
#	 (\d\d?)               # day
#	    (?:\s+|[-\/])
#	 (\w+)                 # month
#	    (?:\s+|[-\/])
#	 (\d+)                 # year
#	 (?:
#	       (?:\s+|:)       # separator before clock
#	    (\d\d?):(\d\d)     # hour:min
#	    (?::(\d\d))?       # optional seconds
#	 )?                    # optional clock
#	    \s*
#	 ([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone
#	    \s*
#	 (?:\(\w+\)|\w{3,})?   # ASCII representation of timezone.
#	    \s*$
#	/x)
#
#    ||
#
#    (($mon, $day, $hr, $min, $sec, $tz, $yr) =
#	/^
#	 (\w{1,3})             # month
#	    \s+
#	 (\d\d?)               # day
#	    \s+
#	 (\d\d?):(\d\d)        # hour:min
#	 (?::(\d\d))?          # optional seconds
#	    \s+
#	 (?:([A-Za-z]+)\s+)?   # optional timezone
#	 (\d+)                 # year
#	    \s*$               # allow trailing whitespace
#	/x)
#
#    ||
#
#    (($mon, $day, $yr, $hr, $min, $sec) =
#	/^
#	 (\w{3})               # month
#	    \s+
#	 (\d\d?)               # day
#	    \s+
#	 (?:
#	    (\d\d\d\d) |       # year
#	    (\d{1,2}):(\d{2})  # hour:min
#            (?::(\d\d))?       # optional seconds
#	 )
#	 \s*$
#       /x)
#
#    ||
#
#    (($yr, $mon, $day, $hr, $min, $sec, $tz) =
#	/^
#	  (\d{4})              # year
#	     [-\/]?
#	  (\d\d?)              # numerical month
#	     [-\/]?
#	  (\d\d?)              # day
#	 (?:
#	       (?:\s+|[-:Tt])  # separator before clock
#	    (\d\d?):?(\d\d)    # hour:min
#	    (?::?(\d\d(?:\.\d*)?))?  # optional seconds (and fractional)
#	 )?                    # optional clock
#	    \s*
#	 ([-+]?\d\d?:?(:?\d\d)?
#	  |Z|z)?               # timezone  (Z is "zero meridian", i.e. GMT)
#	    \s*$
#	/x)
#
#    ||
#
#    (($mon, $day, $yr, $hr, $min, $ampm) =
#        /^
#          (\d{2})                # numerical month
#             -
#          (\d{2})                # day
#             -
#          (\d{2})                # year
#             \s+
#          (\d\d?):(\d\d)([APap][Mm])  # hour:min AM or PM
#             \s*$
#        /x)
#
#    ||
#    return;  
#
#    $mon = $MoY{$mon} ||
#           $MoY{"\u\L$mon"} ||
#	   ($mon =~ /^\d\d?$/ && $mon >= 1 && $mon <= 12 && int($mon)) ||
#           return;
#
#    unless (defined $yr) {
#	my $cur_mon;
#	($cur_mon, $yr) = (localtime)[4, 5];
#	$yr += 1900;
#	$cur_mon++;
#	$yr-- if $mon > $cur_mon;
#    }
#    elsif (length($yr) < 3) {
#	my $cur_yr = (localtime)[5] + 1900;
#	my $m = $cur_yr % 100;
#	my $tmp = $yr;
#	$yr += $cur_yr - $m;
#	$m -= $tmp;
#	$yr += ($m > 0) ? 100 : -100
#	    if abs($m) > 50;
#    }
#
#    $hr  = 0 unless defined($hr);
#    $min = 0 unless defined($min);
#    $sec = 0 unless defined($sec);
#
#    if ($ampm) {
#	$ampm = uc $ampm;
#	$hr = 0 if $hr == 12 && $ampm eq 'AM';
#	$hr += 12 if $ampm eq 'PM' && $hr != 12;
#    }
#
#    return($yr, $mon, $day, $hr, $min, $sec, $tz)
#	if wantarray;
#
#    if (defined $tz) {
#	$tz = "Z" if $tz =~ /^(GMT|UTC?|[-+]?0+)$/;
#    }
#    else {
#	$tz = "";
#    }
#    return sprintf("%04d-%02d-%02d %02d:%02d:%02d%s",
#		   $yr, $mon, $day, $hr, $min, $sec, $tz);
#}
#
#
#sub time2iso (;$)
#{
#    my $time = shift;
#    $time = time unless defined $time;
#    my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
#    sprintf("%04d-%02d-%02d %02d:%02d:%02d",
#	    $year+1900, $mon+1, $mday, $hour, $min, $sec);
#}
#
#
#sub time2isoz (;$)
#{
#    my $time = shift;
#    $time = time unless defined $time;
#    my($sec,$min,$hour,$mday,$mon,$year) = gmtime($time);
#    sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
#            $year+1900, $mon+1, $mday, $hour, $min, $sec);
#}
#
#1;
#
#
#__END__
#
### HTTP/Headers.pm ###
#package HTTP::Headers;
#
#use strict;
#use warnings;
#
#use Carp ();
#
#our $VERSION = "6.11";
#
#our $TRANSLATE_UNDERSCORE = 1 unless defined $TRANSLATE_UNDERSCORE;
#
#
#my @general_headers = qw(
#    Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade
#    Via Warning
#);
#
#my @request_headers = qw(
#    Accept Accept-Charset Accept-Encoding Accept-Language
#    Authorization Expect From Host
#    If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
#    Max-Forwards Proxy-Authorization Range Referer TE User-Agent
#);
#
#my @response_headers = qw(
#    Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server
#    Vary WWW-Authenticate
#);
#
#my @entity_headers = qw(
#    Allow Content-Encoding Content-Language Content-Length Content-Location
#    Content-MD5 Content-Range Content-Type Expires Last-Modified
#);
#
#my %entity_header = map { lc($_) => 1 } @entity_headers;
#
#my @header_order = (
#    @general_headers,
#    @request_headers,
#    @response_headers,
#    @entity_headers,
#);
#
#my %header_order;
#my %standard_case;
#
#{
#    my $i = 0;
#    for (@header_order) {
#	my $lc = lc $_;
#	$header_order{$lc} = ++$i;
#	$standard_case{$lc} = $_;
#    }
#}
#
#
#
#sub new
#{
#    my($class) = shift;
#    my $self = bless {}, $class;
#    $self->header(@_) if @_; 
#    $self;
#}
#
#
#sub header
#{
#    my $self = shift;
#    Carp::croak('Usage: $h->header($field, ...)') unless @_;
#    my(@old);
#    my %seen;
#    while (@_) {
#	my $field = shift;
#        my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET';
#	@old = $self->_header($field, shift, $op);
#    }
#    return @old if wantarray;
#    return $old[0] if @old <= 1;
#    join(", ", @old);
#}
#
#sub clear
#{
#    my $self = shift;
#    %$self = ();
#}
#
#
#sub push_header
#{
#    my $self = shift;
#    return $self->_header(@_, 'PUSH_H') if @_ == 2;
#    while (@_) {
#	$self->_header(splice(@_, 0, 2), 'PUSH_H');
#    }
#}
#
#
#sub init_header
#{
#    Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3;
#    shift->_header(@_, 'INIT');
#}
#
#
#sub remove_header
#{
#    my($self, @fields) = @_;
#    my $field;
#    my @values;
#    foreach $field (@fields) {
#	$field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE;
#	my $v = delete $self->{lc $field};
#	push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v;
#    }
#    return @values;
#}
#
#sub remove_content_headers
#{
#    my $self = shift;
#    unless (defined(wantarray)) {
#	delete @$self{grep $entity_header{$_} || /^content-/, keys %$self};
#	return;
#    }
#
#    my $c = ref($self)->new;
#    for my $f (grep $entity_header{$_} || /^content-/, keys %$self) {
#	$c->{$f} = delete $self->{$f};
#    }
#    if (exists $self->{'::std_case'}) {
#	$c->{'::std_case'} = $self->{'::std_case'};
#    }
#    $c;
#}
#
#
#sub _header
#{
#    my($self, $field, $val, $op) = @_;
#
#    Carp::croak("Illegal field name '$field'")
#        if rindex($field, ':') > 1 || !length($field);
#
#    unless ($field =~ /^:/) {
#	$field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE;
#	my $old = $field;
#	$field = lc $field;
#	unless($standard_case{$field} || $self->{'::std_case'}{$field}) {
#	    $old =~ s/\b(\w)/\u$1/g;
#	    $self->{'::std_case'}{$field} = $old;
#	}
#    }
#
#    $op ||= defined($val) ? 'SET' : 'GET';
#    if ($op eq 'PUSH_H') {
#	if (exists $self->{$field}) {
#	    my $h = $self->{$field};
#	    if (ref($h) eq 'ARRAY') {
#		push(@$h, ref($val) eq "ARRAY" ? @$val : $val);
#	    }
#	    else {
#		$self->{$field} = [$h, ref($val) eq "ARRAY" ? @$val : $val]
#	    }
#	    return;
#	}
#	$self->{$field} = $val;
#	return;
#    }
#
#    my $h = $self->{$field};
#    my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ());
#
#    unless ($op eq 'GET' || ($op eq 'INIT' && @old)) {
#	if (defined($val)) {
#	    my @new = ($op eq 'PUSH') ? @old : ();
#	    if (ref($val) ne 'ARRAY') {
#		push(@new, $val);
#	    }
#	    else {
#		push(@new, @$val);
#	    }
#	    $self->{$field} = @new > 1 ? \@new : $new[0];
#	}
#	elsif ($op ne 'PUSH') {
#	    delete $self->{$field};
#	}
#    }
#    @old;
#}
#
#
#sub _sorted_field_names
#{
#    my $self = shift;
#    return [ sort {
#        ($header_order{$a} || 999) <=> ($header_order{$b} || 999) ||
#         $a cmp $b
#    } grep !/^::/, keys %$self ];
#}
#
#
#sub header_field_names {
#    my $self = shift;
#    return map $standard_case{$_} || $self->{'::std_case'}{$_} || $_, @{ $self->_sorted_field_names },
#	if wantarray;
#    return grep !/^::/, keys %$self;
#}
#
#
#sub scan
#{
#    my($self, $sub) = @_;
#    my $key;
#    for $key (@{ $self->_sorted_field_names }) {
#	my $vals = $self->{$key};
#	if (ref($vals) eq 'ARRAY') {
#	    my $val;
#	    for $val (@$vals) {
#		$sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $val);
#	    }
#	}
#	else {
#	    $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $vals);
#	}
#    }
#}
#
#sub flatten {
#	my($self)=@_;
#
#	(
#		map {
#			my $k = $_;
#			map {
#				( $k => $_ )
#			} $self->header($_);
#		} $self->header_field_names
#	);
#}
#
#sub as_string
#{
#    my($self, $endl) = @_;
#    $endl = "\n" unless defined $endl;
#
#    my @result = ();
#    for my $key (@{ $self->_sorted_field_names }) {
#	next if index($key, '_') == 0;
#	my $vals = $self->{$key};
#	if ( ref($vals) eq 'ARRAY' ) {
#	    for my $val (@$vals) {
#		$val = '' if not defined $val;
#		my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
#		$field =~ s/^://;
#		if ( index($val, "\n") >= 0 ) {
#		    $val = _process_newline($val, $endl);
#		}
#		push @result, $field . ': ' . $val;
#	    }
#	}
#	else {
#	    $vals = '' if not defined $vals;
#	    my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
#	    $field =~ s/^://;
#	    if ( index($vals, "\n") >= 0 ) {
#		$vals = _process_newline($vals, $endl);
#	    }
#	    push @result, $field . ': ' . $vals;
#	}
#    }
#
#    join($endl, @result, '');
#}
#
#sub _process_newline {
#    local $_ = shift;
#    my $endl = shift;
#    s/\s+$//;        
#    s/\n(\x0d?\n)+/\n/g;     
#    s/\n([^\040\t])/\n $1/g; 
#    s/\n/$endl/g;    
#    $_;
#}
#
#
#
#if (eval { require Storable; 1 }) {
#    *clone = \&Storable::dclone;
#} else {
#    *clone = sub {
#	my $self = shift;
#	my $clone = HTTP::Headers->new;
#	$self->scan(sub { $clone->push_header(@_);} );
#	$clone;
#    };
#}
#
#
#sub _date_header
#{
#    require HTTP::Date;
#    my($self, $header, $time) = @_;
#    my($old) = $self->_header($header);
#    if (defined $time) {
#	$self->_header($header, HTTP::Date::time2str($time));
#    }
#    $old =~ s/;.*// if defined($old);
#    HTTP::Date::str2time($old);
#}
#
#
#sub date                { shift->_date_header('Date',                @_); }
#sub expires             { shift->_date_header('Expires',             @_); }
#sub if_modified_since   { shift->_date_header('If-Modified-Since',   @_); }
#sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); }
#sub last_modified       { shift->_date_header('Last-Modified',       @_); }
#
#sub client_date         { shift->_date_header('Client-Date',         @_); }
#
#
#sub content_type      {
#    my $self = shift;
#    my $ct = $self->{'content-type'};
#    $self->{'content-type'} = shift if @_;
#    $ct = $ct->[0] if ref($ct) eq 'ARRAY';
#    return '' unless defined($ct) && length($ct);
#    my @ct = split(/;\s*/, $ct, 2);
#    for ($ct[0]) {
#	s/\s+//g;
#	$_ = lc($_);
#    }
#    wantarray ? @ct : $ct[0];
#}
#
#sub content_type_charset {
#    my $self = shift;
#    require HTTP::Headers::Util;
#    my $h = $self->{'content-type'};
#    $h = $h->[0] if ref($h);
#    $h = "" unless defined $h;
#    my @v = HTTP::Headers::Util::split_header_words($h);
#    if (@v) {
#	my($ct, undef, %ct_param) = @{$v[0]};
#	my $charset = $ct_param{charset};
#	if ($ct) {
#	    $ct = lc($ct);
#	    $ct =~ s/\s+//;
#	}
#	if ($charset) {
#	    $charset = uc($charset);
#	    $charset =~ s/^\s+//;  $charset =~ s/\s+\z//;
#	    undef($charset) if $charset eq "";
#	}
#	return $ct, $charset if wantarray;
#	return $charset;
#    }
#    return undef, undef if wantarray;
#    return undef;
#}
#
#sub content_is_text {
#    my $self = shift;
#    return $self->content_type =~ m,^text/,;
#}
#
#sub content_is_html {
#    my $self = shift;
#    return $self->content_type eq 'text/html' || $self->content_is_xhtml;
#}
#
#sub content_is_xhtml {
#    my $ct = shift->content_type;
#    return $ct eq "application/xhtml+xml" ||
#           $ct eq "application/vnd.wap.xhtml+xml";
#}
#
#sub content_is_xml {
#    my $ct = shift->content_type;
#    return 1 if $ct eq "text/xml";
#    return 1 if $ct eq "application/xml";
#    return 1 if $ct =~ /\+xml$/;
#    return 0;
#}
#
#sub referer           {
#    my $self = shift;
#    if (@_ && $_[0] =~ /#/) {
#	my $uri = shift;
#	if (ref($uri)) {
#	    $uri = $uri->clone;
#	    $uri->fragment(undef);
#	}
#	else {
#	    $uri =~ s/\#.*//;
#	}
#	unshift @_, $uri;
#    }
#    ($self->_header('Referer', @_))[0];
#}
#*referrer = \&referer;  
#
#sub title             { (shift->_header('Title',            @_))[0] }
#sub content_encoding  { (shift->_header('Content-Encoding', @_))[0] }
#sub content_language  { (shift->_header('Content-Language', @_))[0] }
#sub content_length    { (shift->_header('Content-Length',   @_))[0] }
#
#sub user_agent        { (shift->_header('User-Agent',       @_))[0] }
#sub server            { (shift->_header('Server',           @_))[0] }
#
#sub from              { (shift->_header('From',             @_))[0] }
#sub warning           { (shift->_header('Warning',          @_))[0] }
#
#sub www_authenticate  { (shift->_header('WWW-Authenticate', @_))[0] }
#sub authorization     { (shift->_header('Authorization',    @_))[0] }
#
#sub proxy_authenticate  { (shift->_header('Proxy-Authenticate',  @_))[0] }
#sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] }
#
#sub authorization_basic       { shift->_basic_auth("Authorization",       @_) }
#sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) }
#
#sub _basic_auth {
#    require MIME::Base64;
#    my($self, $h, $user, $passwd) = @_;
#    my($old) = $self->_header($h);
#    if (defined $user) {
#	Carp::croak("Basic authorization user name can't contain ':'")
#	  if $user =~ /:/;
#	$passwd = '' unless defined $passwd;
#	$self->_header($h => 'Basic ' .
#                             MIME::Base64::encode("$user:$passwd", ''));
#    }
#    if (defined $old && $old =~ s/^\s*Basic\s+//) {
#	my $val = MIME::Base64::decode($old);
#	return $val unless wantarray;
#	return split(/:/, $val, 2);
#    }
#    return;
#}
#
#
#1;
#
#__END__
#
### HTTP/Headers/Auth.pm ###
#package HTTP::Headers::Auth;
#
#use strict;
#use warnings;
#
#our $VERSION = "6.11";
#
#use HTTP::Headers;
#
#package
#    HTTP::Headers;
#
#BEGIN {
#    undef(&www_authenticate);
#    undef(&proxy_authenticate);
#}
#
#require HTTP::Headers::Util;
#
#sub _parse_authenticate
#{
#    my @ret;
#    for (HTTP::Headers::Util::split_header_words(@_)) {
#	if (!defined($_->[1])) {
#	    push(@ret, shift(@$_) => {});
#	    shift @$_;
#	}
#	if (@ret) {
#	    while (@$_) {
#		my $k = shift @$_;
#		my $v = shift @$_;
#	        $ret[-1]{$k} = $v;
#	    }
#	}
#	else {
#	}
#    }
#    @ret;
#}
#
#sub _authenticate
#{
#    my $self = shift;
#    my $header = shift;
#    my @old = $self->_header($header);
#    if (@_) {
#	$self->remove_header($header);
#	my @new = @_;
#	while (@new) {
#	    my $a_scheme = shift(@new);
#	    if ($a_scheme =~ /\s/) {
#		$self->push_header($header, $a_scheme);
#	    }
#	    else {
#		my @param;
#		if (@new) {
#		    my $p = $new[0];
#		    if (ref($p) eq "ARRAY") {
#			@param = @$p;
#			shift(@new);
#		    }
#		    elsif (ref($p) eq "HASH") {
#			@param = %$p;
#			shift(@new);
#		    }
#		}
#		my $val = ucfirst(lc($a_scheme));
#		if (@param) {
#		    my $sep = " ";
#		    while (@param) {
#			my $k = shift @param;
#			my $v = shift @param;
#			if ($v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm") {
#			    $v =~ s,([\\\"]),\\$1,g;
#			    $v = qq("$v");
#			}
#			$val .= "$sep$k=$v";
#			$sep = ", ";
#		    }
#		}
#		$self->push_header($header, $val);
#	    }
#	}
#    }
#    return unless defined wantarray;
#    wantarray ? _parse_authenticate(@old) : join(", ", @old);
#}
#
#
#sub www_authenticate    { shift->_authenticate("WWW-Authenticate", @_)   }
#sub proxy_authenticate  { shift->_authenticate("Proxy-Authenticate", @_) }
#
#1;
### HTTP/Headers/ETag.pm ###
#package HTTP::Headers::ETag;
#
#use strict;
#use warnings;
#
#our $VERSION = "6.11";
#
#require HTTP::Date;
#
#require HTTP::Headers;
#package
#    HTTP::Headers;
#
#sub _etags
#{
#    my $self = shift;
#    my $header = shift;
#    my @old = _split_etag_list($self->_header($header));
#    if (@_) {
#	$self->_header($header => join(", ", _split_etag_list(@_)));
#    }
#    wantarray ? @old : join(", ", @old);
#}
#
#sub etag          { shift->_etags("ETag", @_); }
#sub if_match      { shift->_etags("If-Match", @_); }
#sub if_none_match { shift->_etags("If-None-Match", @_); }
#
#sub if_range {
#    my $self = shift;
#    my @old = $self->_header("If-Range");
#    if (@_) {
#	my $new = shift;
#	if (!defined $new) {
#	    $self->remove_header("If-Range");
#	}
#	elsif ($new =~ /^\d+$/) {
#	    $self->_date_header("If-Range", $new);
#	}
#	else {
#	    $self->_etags("If-Range", $new);
#	}
#    }
#    return unless defined(wantarray);
#    for (@old) {
#	my $t = HTTP::Date::str2time($_);
#	$_ = $t if $t;
#    }
#    wantarray ? @old : join(", ", @old);
#}
#
#
#
#
#sub _split_etag_list
#{
#    my(@val) = @_;
#    my @res;
#    for (@val) {
#        while (length) {
#            my $weak = "";
#	    $weak = "W/" if s,^\s*[wW]/,,;
#            my $etag = "";
#	    if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
#		push(@res, "$weak$1");
#            }
#            elsif (s/^\s*,//) {
#                push(@res, qq(W/"")) if $weak;
#            }
#            elsif (s/^\s*([^,\s]+)//) {
#                $etag = $1;
#		$etag =~ s/([\"\\])/\\$1/g;
#	        push(@res, qq($weak"$etag"));
#            }
#            elsif (s/^\s+// || !length) {
#                push(@res, qq(W/"")) if $weak;
#            }
#            else {
#	 	die "This should not happen: '$_'";
#            }
#        }
#   }
#   @res;
#}
#
#1;
### HTTP/Headers/Util.pm ###
#package HTTP::Headers::Util;
#
#use strict;
#use warnings;
#
#our $VERSION = "6.11";
#
#use base 'Exporter';
#
#our @EXPORT_OK=qw(split_header_words _split_header_words join_header_words);
#
#
#sub split_header_words {
#    my @res = &_split_header_words;
#    for my $arr (@res) {
#	for (my $i = @$arr - 2; $i >= 0; $i -= 2) {
#	    $arr->[$i] = lc($arr->[$i]);
#	}
#    }
#    return @res;
#}
#
#sub _split_header_words
#{
#    my(@val) = @_;
#    my @res;
#    for (@val) {
#	my @cur;
#	while (length) {
#	    if (s/^\s*(=*[^\s=;,]+)//) {  
#		push(@cur, $1);
#		if (s/^\s*=\s*\"([^\"\\]*(?:\\.[^\"\\]*)*)\"//) {
#		    my $val = $1;
#		    $val =~ s/\\(.)/$1/g;
#		    push(@cur, $val);
#		}
#		elsif (s/^\s*=\s*([^;,\s]*)//) {
#		    my $val = $1;
#		    $val =~ s/\s+$//;
#		    push(@cur, $val);
#		}
#		else {
#		    push(@cur, undef);
#		}
#	    }
#	    elsif (s/^\s*,//) {
#		push(@res, [@cur]) if @cur;
#		@cur = ();
#	    }
#	    elsif (s/^\s*;// || s/^\s+//) {
#	    }
#	    else {
#		die "This should not happen: '$_'";
#	    }
#	}
#	push(@res, \@cur) if @cur;
#    }
#    @res;
#}
#
#
#sub join_header_words
#{
#    @_ = ([@_]) if @_ && !ref($_[0]);
#    my @res;
#    for (@_) {
#	my @cur = @$_;
#	my @attr;
#	while (@cur) {
#	    my $k = shift @cur;
#	    my $v = shift @cur;
#	    if (defined $v) {
#		if ($v =~ /[\x00-\x20()<>@,;:\\\"\/\[\]?={}\x7F-\xFF]/ || !length($v)) {
#		    $v =~ s/([\"\\])/\\$1/g;  
#		    $k .= qq(="$v");
#		}
#		else {
#		    $k .= "=$v";
#		}
#	    }
#	    push(@attr, $k);
#	}
#	push(@res, join("; ", @attr)) if @attr;
#    }
#    join(", ", @res);
#}
#
#
#1;
#
#__END__
#
### HTTP/Message.pm ###
#package HTTP::Message;
#
#use strict;
#use warnings;
#
#our $VERSION = "6.11";
#
#require HTTP::Headers;
#require Carp;
#
#my $CRLF = "\015\012";   
#unless ($HTTP::URI_CLASS) {
#    if ($ENV{PERL_HTTP_URI_CLASS}
#    &&  $ENV{PERL_HTTP_URI_CLASS} =~ /^([\w:]+)$/) {
#        $HTTP::URI_CLASS = $1;
#    } else {
#        $HTTP::URI_CLASS = "URI";
#    }
#}
#eval "require $HTTP::URI_CLASS"; die $@ if $@;
#
#*_utf8_downgrade = defined(&utf8::downgrade) ?
#    sub {
#        utf8::downgrade($_[0], 1) or
#            Carp::croak("HTTP::Message content must be bytes")
#    }
#    :
#    sub {
#    };
#
#sub new
#{
#    my($class, $header, $content) = @_;
#    if (defined $header) {
#	Carp::croak("Bad header argument") unless ref $header;
#        if (ref($header) eq "ARRAY") {
#	    $header = HTTP::Headers->new(@$header);
#	}
#	else {
#	    $header = $header->clone;
#	}
#    }
#    else {
#	$header = HTTP::Headers->new;
#    }
#    if (defined $content) {
#        _utf8_downgrade($content);
#    }
#    else {
#        $content = '';
#    }
#
#    bless {
#	'_headers' => $header,
#	'_content' => $content,
#    }, $class;
#}
#
#
#sub parse
#{
#    my($class, $str) = @_;
#
#    my @hdr;
#    while (1) {
#	if ($str =~ s/^([^\s:]+)[ \t]*: ?(.*)\n?//) {
#	    push(@hdr, $1, $2);
#	    $hdr[-1] =~ s/\r\z//;
#	}
#	elsif (@hdr && $str =~ s/^([ \t].*)\n?//) {
#	    $hdr[-1] .= "\n$1";
#	    $hdr[-1] =~ s/\r\z//;
#	}
#	else {
#	    $str =~ s/^\r?\n//;
#	    last;
#	}
#    }
#    local $HTTP::Headers::TRANSLATE_UNDERSCORE;
#    new($class, \@hdr, $str);
#}
#
#
#sub clone
#{
#    my $self  = shift;
#    my $clone = HTTP::Message->new($self->headers,
#				   $self->content);
#    $clone->protocol($self->protocol);
#    $clone;
#}
#
#
#sub clear {
#    my $self = shift;
#    $self->{_headers}->clear;
#    $self->content("");
#    delete $self->{_parts};
#    return;
#}
#
#
#sub protocol {
#    shift->_elem('_protocol',  @_);
#}
#
#sub headers {
#    my $self = shift;
#
#    $self->_content unless exists $self->{_content};
#
#    $self->{_headers};
#}
#
#sub headers_as_string {
#    shift->headers->as_string(@_);
#}
#
#
#sub content  {
#
#    my $self = $_[0];
#    if (defined(wantarray)) {
#	$self->_content unless exists $self->{_content};
#	my $old = $self->{_content};
#	$old = $$old if ref($old) eq "SCALAR";
#	&_set_content if @_ > 1;
#	return $old;
#    }
#
#    if (@_ > 1) {
#	&_set_content;
#    }
#    else {
#	Carp::carp("Useless content call in void context") if $^W;
#    }
#}
#
#
#sub _set_content {
#    my $self = $_[0];
#    _utf8_downgrade($_[1]);
#    if (!ref($_[1]) && ref($self->{_content}) eq "SCALAR") {
#	${$self->{_content}} = $_[1];
#    }
#    else {
#	die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";
#	$self->{_content} = $_[1];
#	delete $self->{_content_ref};
#    }
#    delete $self->{_parts} unless $_[2];
#}
#
#
#sub add_content
#{
#    my $self = shift;
#    $self->_content unless exists $self->{_content};
#    my $chunkref = \$_[0];
#    $chunkref = $$chunkref if ref($$chunkref);  
#
#    _utf8_downgrade($$chunkref);
#
#    my $ref = ref($self->{_content});
#    if (!$ref) {
#	$self->{_content} .= $$chunkref;
#    }
#    elsif ($ref eq "SCALAR") {
#	${$self->{_content}} .= $$chunkref;
#    }
#    else {
#	Carp::croak("Can't append to $ref content");
#    }
#    delete $self->{_parts};
#}
#
#sub add_content_utf8 {
#    my($self, $buf)  = @_;
#    utf8::upgrade($buf);
#    utf8::encode($buf);
#    $self->add_content($buf);
#}
#
#sub content_ref
#{
#    my $self = shift;
#    $self->_content unless exists $self->{_content};
#    delete $self->{_parts};
#    my $old = \$self->{_content};
#    my $old_cref = $self->{_content_ref};
#    if (@_) {
#	my $new = shift;
#	Carp::croak("Setting content_ref to a non-ref") unless ref($new);
#	delete $self->{_content};  
#	$self->{_content} = $new;
#	$self->{_content_ref}++;
#    }
#    $old = $$old if $old_cref;
#    return $old;
#}
#
#
#sub content_charset
#{
#    my $self = shift;
#    if (my $charset = $self->content_type_charset) {
#	return $charset;
#    }
#
#    my $cref = $self->decoded_content(ref => 1, charset => "none");
#
#    for ($$cref) {
#	return "UTF-8"     if /^\xEF\xBB\xBF/;
#	return "UTF-32LE" if /^\xFF\xFE\x00\x00/;
#	return "UTF-32BE" if /^\x00\x00\xFE\xFF/;
#	return "UTF-16LE" if /^\xFF\xFE/;
#	return "UTF-16BE" if /^\xFE\xFF/;
#    }
#
#    if ($self->content_is_xml) {
#	for ($$cref) {
#	    return "UTF-32BE" if /^\x00\x00\x00</;
#	    return "UTF-32LE" if /^<\x00\x00\x00/;
#	    return "UTF-16BE" if /^(?:\x00\s)*\x00</;
#	    return "UTF-16LE" if /^(?:\s\x00)*<\x00/;
#	    if (/^\s*(<\?xml[^\x00]*?\?>)/) {
#		if ($1 =~ /\sencoding\s*=\s*(["'])(.*?)\1/) {
#		    my $enc = $2;
#		    $enc =~ s/^\s+//; $enc =~ s/\s+\z//;
#		    return $enc if $enc;
#		}
#	    }
#	}
#	return "UTF-8";
#    }
#    elsif ($self->content_is_html) {
#	require IO::HTML;
#	my $encoding = IO::HTML::find_charset_in($$cref, { encoding    => 1,
#	                                                   need_pragma => 0 });
#	return $encoding->mime_name if $encoding;
#    }
#    elsif ($self->content_type eq "application/json") {
#	for ($$cref) {
#	    return "UTF-32BE" if /^\x00\x00\x00./s;
#	    return "UTF-32LE" if /^.\x00\x00\x00/s;
#	    return "UTF-16BE" if /^\x00.\x00./s;
#	    return "UTF-16LE" if /^.\x00.\x00/s;
#	    return "UTF-8";
#	}
#    }
#    if ($self->content_type =~ /^text\//) {
#	for ($$cref) {
#	    if (length) {
#		return "US-ASCII" unless /[\x80-\xFF]/;
#		require Encode;
#		eval {
#		    Encode::decode_utf8($_, Encode::FB_CROAK() | Encode::LEAVE_SRC());
#		};
#		return "UTF-8" unless $@;
#		return "ISO-8859-1";
#	    }
#	}
#    }
#
#    return undef;
#}
#
#
#sub decoded_content
#{
#    my($self, %opt) = @_;
#    my $content_ref;
#    my $content_ref_iscopy;
#
#    eval {
#	$content_ref = $self->content_ref;
#	die "Can't decode ref content" if ref($content_ref) ne "SCALAR";
#
#	if (my $h = $self->header("Content-Encoding")) {
#	    $h =~ s/^\s+//;
#	    $h =~ s/\s+$//;
#	    for my $ce (reverse split(/\s*,\s*/, lc($h))) {
#		next unless $ce;
#		next if $ce eq "identity" || $ce eq "none";
#		if ($ce eq "gzip" || $ce eq "x-gzip") {
#		    require IO::Uncompress::Gunzip;
#		    my $output;
#		    IO::Uncompress::Gunzip::gunzip($content_ref, \$output, Transparent => 0)
#			or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError";
#		    $content_ref = \$output;
#		    $content_ref_iscopy++;
#		}
#		elsif ($ce eq "x-bzip2" or $ce eq "bzip2") {
#		    require IO::Uncompress::Bunzip2;
#		    my $output;
#		    IO::Uncompress::Bunzip2::bunzip2($content_ref, \$output, Transparent => 0)
#			or die "Can't bunzip content: $IO::Uncompress::Bunzip2::Bunzip2Error";
#		    $content_ref = \$output;
#		    $content_ref_iscopy++;
#		}
#		elsif ($ce eq "deflate") {
#		    require IO::Uncompress::Inflate;
#		    my $output;
#		    my $status = IO::Uncompress::Inflate::inflate($content_ref, \$output, Transparent => 0);
#		    my $error = $IO::Uncompress::Inflate::InflateError;
#		    unless ($status) {
#			$output = undef;
#			require IO::Uncompress::RawInflate;
#			unless (IO::Uncompress::RawInflate::rawinflate($content_ref, \$output)) {
#			    $self->push_header("Client-Warning" =>
#				"Could not raw inflate content: $IO::Uncompress::RawInflate::RawInflateError");
#			    $output = undef;
#			}
#		    }
#		    die "Can't inflate content: $error" unless defined $output;
#		    $content_ref = \$output;
#		    $content_ref_iscopy++;
#		}
#		elsif ($ce eq "compress" || $ce eq "x-compress") {
#		    die "Can't uncompress content";
#		}
#		elsif ($ce eq "base64") {  
#		    require MIME::Base64;
#		    $content_ref = \MIME::Base64::decode($$content_ref);
#		    $content_ref_iscopy++;
#		}
#		elsif ($ce eq "quoted-printable") { 
#		    require MIME::QuotedPrint;
#		    $content_ref = \MIME::QuotedPrint::decode($$content_ref);
#		    $content_ref_iscopy++;
#		}
#		else {
#		    die "Don't know how to decode Content-Encoding '$ce'";
#		}
#	    }
#	}
#
#	if ($self->content_is_text || (my $is_xml = $self->content_is_xml)) {
#	    my $charset = lc(
#	        $opt{charset} ||
#		$self->content_type_charset ||
#		$opt{default_charset} ||
#		$self->content_charset ||
#		"ISO-8859-1"
#	    );
#	    if ($charset eq "none") {
#	    }
#	    elsif ($charset eq "us-ascii" || $charset eq "iso-8859-1") {
#		if ($$content_ref =~ /[^\x00-\x7F]/ && defined &utf8::upgrade) {
#		    unless ($content_ref_iscopy) {
#			my $copy = $$content_ref;
#			$content_ref = \$copy;
#			$content_ref_iscopy++;
#		    }
#		    utf8::upgrade($$content_ref);
#		}
#	    }
#	    else {
#		require Encode;
#		eval {
#		    $content_ref = \Encode::decode($charset, $$content_ref,
#			 ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());
#		};
#		if ($@) {
#		    my $retried;
#		    if ($@ =~ /^Unknown encoding/) {
#			my $alt_charset = lc($opt{alt_charset} || "");
#			if ($alt_charset && $charset ne $alt_charset) {
#			    $content_ref = \Encode::decode($alt_charset, $$content_ref,
#				 ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC())
#			        unless $alt_charset eq "none";
#			    $retried++;
#			}
#		    }
#		    die unless $retried;
#		}
#		die "Encode::decode() returned undef improperly" unless defined $$content_ref;
#		if ($is_xml) {
#		    $$content_ref =~ s/^\x{FEFF}//;
#		    if ($$content_ref =~ /^(\s*<\?xml[^\x00]*?\?>)/) {
#			substr($$content_ref, 0, length($1)) =~ s/\sencoding\s*=\s*(["']).*?\1//;
#		    }
#		}
#	    }
#	}
#    };
#    if ($@) {
#	Carp::croak($@) if $opt{raise_error};
#	return undef;
#    }
#
#    return $opt{ref} ? $content_ref : $$content_ref;
#}
#
#
#sub decodable
#{
#    my $self = shift;
#    my @enc;
#    eval {
#        require IO::Uncompress::Gunzip;
#        push(@enc, "gzip", "x-gzip");
#    };
#    eval {
#        require IO::Uncompress::Inflate;
#        require IO::Uncompress::RawInflate;
#        push(@enc, "deflate");
#    };
#    eval {
#        require IO::Uncompress::Bunzip2;
#        push(@enc, "x-bzip2");
#    };
#    return wantarray ? @enc : join(", ", @enc);
#}
#
#
#sub decode
#{
#    my $self = shift;
#    return 1 unless $self->header("Content-Encoding");
#    if (defined(my $content = $self->decoded_content(charset => "none"))) {
#	$self->remove_header("Content-Encoding", "Content-Length", "Content-MD5");
#	$self->content($content);
#	return 1;
#    }
#    return 0;
#}
#
#
#sub encode
#{
#    my($self, @enc) = @_;
#
#    Carp::croak("Can't encode multipart/* messages") if $self->content_type =~ m,^multipart/,;
#    Carp::croak("Can't encode message/* messages") if $self->content_type =~ m,^message/,;
#
#    return 1 unless @enc;  
#
#    my $content = $self->content;
#    for my $encoding (@enc) {
#	if ($encoding eq "identity") {
#	}
#	elsif ($encoding eq "base64") {
#	    require MIME::Base64;
#	    $content = MIME::Base64::encode($content);
#	}
#	elsif ($encoding eq "gzip" || $encoding eq "x-gzip") {
#	    require IO::Compress::Gzip;
#	    my $output;
#	    IO::Compress::Gzip::gzip(\$content, \$output, Minimal => 1)
#		or die "Can't gzip content: $IO::Compress::Gzip::GzipError";
#	    $content = $output;
#	}
#	elsif ($encoding eq "deflate") {
#	    require IO::Compress::Deflate;
#	    my $output;
#	    IO::Compress::Deflate::deflate(\$content, \$output)
#		or die "Can't deflate content: $IO::Compress::Deflate::DeflateError";
#	    $content = $output;
#	}
#	elsif ($encoding eq "x-bzip2") {
#	    require IO::Compress::Bzip2;
#	    my $output;
#	    IO::Compress::Bzip2::bzip2(\$content, \$output)
#		or die "Can't bzip2 content: $IO::Compress::Bzip2::Bzip2Error";
#	    $content = $output;
#	}
#	elsif ($encoding eq "rot13") {  
#	    $content =~ tr/A-Za-z/N-ZA-Mn-za-m/;
#	}
#	else {
#	    return 0;
#	}
#    }
#    my $h = $self->header("Content-Encoding");
#    unshift(@enc, $h) if $h;
#    $self->header("Content-Encoding", join(", ", @enc));
#    $self->remove_header("Content-Length", "Content-MD5");
#    $self->content($content);
#    return 1;
#}
#
#
#sub as_string
#{
#    my($self, $eol) = @_;
#    $eol = "\n" unless defined $eol;
#
#    my $content = $self->content;
#
#    return join("", $self->{'_headers'}->as_string($eol),
#		    $eol,
#		    $content,
#		    (@_ == 1 && length($content) &&
#		     $content !~ /\n\z/) ? "\n" : "",
#		);
#}
#
#
#sub dump
#{
#    my($self, %opt) = @_;
#    my $content = $self->content;
#    my $chopped = 0;
#    if (!ref($content)) {
#	my $maxlen = $opt{maxlength};
#	$maxlen = 512 unless defined($maxlen);
#	if ($maxlen && length($content) > $maxlen * 1.1 + 3) {
#	    $chopped = length($content) - $maxlen;
#	    $content = substr($content, 0, $maxlen) . "...";
#	}
#
#	$content =~ s/\\/\\\\/g;
#	$content =~ s/\t/\\t/g;
#	$content =~ s/\r/\\r/g;
#
#	$content =~ s/([\0-\11\13-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
#	$content =~ s/([\0-\11\13-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
#	$content =~ s/([^\12\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
#	$content =~ s/( +)\n/("\\40" x length($1)) . "\n"/eg;
#	$content =~ s/(\n+)\n/("\\n" x length($1)) . "\n"/eg;
#	$content =~ s/\n\z/\\n/;
#
#	my $no_content = $opt{no_content};
#	$no_content = "(no content)" unless defined $no_content;
#	if ($content eq $no_content) {
#	    $content =~ s/^(.)/sprintf('\\x%02X',ord($1))/eg;
#	}
#	elsif ($content eq "") {
#	    $content = $no_content;
#	}
#    }
#
#    my @dump;
#    push(@dump, $opt{preheader}) if $opt{preheader};
#    push(@dump, $self->{_headers}->as_string, $content);
#    push(@dump, "(+ $chopped more bytes not shown)") if $chopped;
#
#    my $dump = join("\n", @dump, "");
#    $dump =~ s/^/$opt{prefix}/gm if $opt{prefix};
#
#    print $dump unless defined wantarray;
#    return $dump;
#}
#
#sub _part_class {
#    return __PACKAGE__;
#}
#
#sub parts {
#    my $self = shift;
#    if (defined(wantarray) && (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR")) {
#	$self->_parts;
#    }
#    my $old = $self->{_parts};
#    if (@_) {
#	my @parts = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
#	my $ct = $self->content_type || "";
#	if ($ct =~ m,^message/,) {
#	    Carp::croak("Only one part allowed for $ct content")
#		if @parts > 1;
#	}
#	elsif ($ct !~ m,^multipart/,) {
#	    $self->remove_content_headers;
#	    $self->content_type("multipart/mixed");
#	}
#	$self->{_parts} = \@parts;
#	_stale_content($self);
#    }
#    return @$old if wantarray;
#    return $old->[0];
#}
#
#sub add_part {
#    my $self = shift;
#    if (($self->content_type || "") !~ m,^multipart/,) {
#	my $p = $self->_part_class->new(
#	    $self->remove_content_headers,
#	    $self->content(""),
#	);
#	$self->content_type("multipart/mixed");
#	$self->{_parts} = [];
#        if ($p->headers->header_field_names || $p->content ne "") {
#            push(@{$self->{_parts}}, $p);
#        }
#    }
#    elsif (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR") {
#	$self->_parts;
#    }
#
#    push(@{$self->{_parts}}, @_);
#    _stale_content($self);
#    return;
#}
#
#sub _stale_content {
#    my $self = shift;
#    if (ref($self->{_content}) eq "SCALAR") {
#	$self->_content;
#    }
#    else {
#	delete $self->{_content};
#	delete $self->{_content_ref};
#    }
#}
#
#
#our $AUTOLOAD;
#sub AUTOLOAD
#{
#    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
#
#    no strict 'refs';
#    *$method = sub { local $Carp::Internal{+__PACKAGE__} = 1; shift->headers->$method(@_) };
#    goto &$method;
#}
#
#
#sub DESTROY {}  
#
#
#sub _elem
#{
#    my $self = shift;
#    my $elem = shift;
#    my $old = $self->{$elem};
#    $self->{$elem} = $_[0] if @_;
#    return $old;
#}
#
#
#sub _parts {
#    my $self = shift;
#    my $ct = $self->content_type;
#    if ($ct =~ m,^multipart/,) {
#	require HTTP::Headers::Util;
#	my @h = HTTP::Headers::Util::split_header_words($self->header("Content-Type"));
#	die "Assert" unless @h;
#	my %h = @{$h[0]};
#	if (defined(my $b = $h{boundary})) {
#	    my $str = $self->content;
#	    $str =~ s/\r?\n--\Q$b\E--.*//s;
#	    if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) {
#		$self->{_parts} = [map $self->_part_class->parse($_),
#				   split(/\r?\n--\Q$b\E\r?\n/, $str)]
#	    }
#	}
#    }
#    elsif ($ct eq "message/http") {
#	require HTTP::Request;
#	require HTTP::Response;
#	my $content = $self->content;
#	my $class = ($content =~ m,^(HTTP/.*)\n,) ?
#	    "HTTP::Response" : "HTTP::Request";
#	$self->{_parts} = [$class->parse($content)];
#    }
#    elsif ($ct =~ m,^message/,) {
#	$self->{_parts} = [ $self->_part_class->parse($self->content) ];
#    }
#
#    $self->{_parts} ||= [];
#}
#
#
#sub _content {
#    my $self = shift;
#    my $ct = $self->{_headers}->header("Content-Type") || "multipart/mixed";
#    if ($ct =~ m,^\s*message/,i) {
#	_set_content($self, $self->{_parts}[0]->as_string($CRLF), 1);
#	return;
#    }
#
#    require HTTP::Headers::Util;
#    my @v = HTTP::Headers::Util::split_header_words($ct);
#    Carp::carp("Multiple Content-Type headers") if @v > 1;
#    @v = @{$v[0]};
#
#    my $boundary;
#    my $boundary_index;
#    for (my @tmp = @v; @tmp;) {
#	my($k, $v) = splice(@tmp, 0, 2);
#	if ($k eq "boundary") {
#	    $boundary = $v;
#	    $boundary_index = @v - @tmp - 1;
#	    last;
#	}
#    }
#
#    my @parts = map $_->as_string($CRLF), @{$self->{_parts}};
#
#    my $bno = 0;
#    $boundary = _boundary() unless defined $boundary;
# CHECK_BOUNDARY:
#    {
#	for (@parts) {
#	    if (index($_, $boundary) >= 0) {
#		$boundary = _boundary(++$bno);
#		redo CHECK_BOUNDARY;
#	    }
#	}
#    }
#
#    if ($boundary_index) {
#	$v[$boundary_index] = $boundary;
#    }
#    else {
#	push(@v, boundary => $boundary);
#    }
#
#    $ct = HTTP::Headers::Util::join_header_words(@v);
#    $self->{_headers}->header("Content-Type", $ct);
#
#    _set_content($self, "--$boundary$CRLF" .
#	                join("$CRLF--$boundary$CRLF", @parts) .
#			"$CRLF--$boundary--$CRLF",
#                        1);
#}
#
#
#sub _boundary
#{
#    my $size = shift || return "xYzZY";
#    require MIME::Base64;
#    my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
#    $b =~ s/[\W]/X/g;  
#    $b;
#}
#
#
#1;
#
#
#__END__
#
### HTTP/Request.pm ###
#package HTTP::Request;
#
#use strict;
#use warnings;
#
#use base 'HTTP::Message';
#
#our $VERSION = "6.11";
#
#sub new
#{
#    my($class, $method, $uri, $header, $content) = @_;
#    my $self = $class->SUPER::new($header, $content);
#    $self->method($method);
#    $self->uri($uri);
#    $self;
#}
#
#
#sub parse
#{
#    my($class, $str) = @_;
#    my $request_line;
#    if ($str =~ s/^(.*)\n//) {
#	$request_line = $1;
#    }
#    else {
#	$request_line = $str;
#	$str = "";
#    }
#
#    my $self = $class->SUPER::parse($str);
#    my($method, $uri, $protocol) = split(' ', $request_line);
#    $self->method($method) if defined($method);
#    $self->uri($uri) if defined($uri);
#    $self->protocol($protocol) if $protocol;
#    $self;
#}
#
#
#sub clone
#{
#    my $self = shift;
#    my $clone = bless $self->SUPER::clone, ref($self);
#    $clone->method($self->method);
#    $clone->uri($self->uri);
#    $clone;
#}
#
#
#sub method
#{
#    shift->_elem('_method', @_);
#}
#
#
#sub uri
#{
#    my $self = shift;
#    my $old = $self->{'_uri'};
#    if (@_) {
#	my $uri = shift;
#	if (!defined $uri) {
#	}
#	elsif (ref $uri) {
#	    Carp::croak("A URI can't be a " . ref($uri) . " reference")
#		if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY';
#	    Carp::croak("Can't use a " . ref($uri) . " object as a URI")
#		unless $uri->can('scheme');
#	    $uri = $uri->clone;
#	    unless ($HTTP::URI_CLASS eq "URI") {
#		eval { local $SIG{__DIE__}; $uri = $uri->abs; };
#		die $@ if $@ && $@ !~ /Missing base argument/;
#	    }
#	}
#	else {
#	    $uri = $HTTP::URI_CLASS->new($uri);
#	}
#	$self->{'_uri'} = $uri;
#        delete $self->{'_uri_canonical'};
#    }
#    $old;
#}
#
#*url = \&uri;  
#
#sub uri_canonical
#{
#    my $self = shift;
#    return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical;
#}
#
#
#sub accept_decodable
#{
#    my $self = shift;
#    $self->header("Accept-Encoding", scalar($self->decodable));
#}
#
#sub as_string
#{
#    my $self = shift;
#    my($eol) = @_;
#    $eol = "\n" unless defined $eol;
#
#    my $req_line = $self->method || "-";
#    my $uri = $self->uri;
#    $uri = (defined $uri) ? $uri->as_string : "-";
#    $req_line .= " $uri";
#    my $proto = $self->protocol;
#    $req_line .= " $proto" if $proto;
#
#    return join($eol, $req_line, $self->SUPER::as_string(@_));
#}
#
#sub dump
#{
#    my $self = shift;
#    my @pre = ($self->method || "-", $self->uri || "-");
#    if (my $prot = $self->protocol) {
#	push(@pre, $prot);
#    }
#
#    return $self->SUPER::dump(
#        preheader => join(" ", @pre),
#	@_,
#    );
#}
#
#
#1;
#
#__END__
#
### HTTP/Request/Common.pm ###
#package HTTP::Request::Common;
#
#use strict;
#use warnings;
#
#our $DYNAMIC_FILE_UPLOAD ||= 0;  
#
#use Exporter 5.57 'import';
#
#our @EXPORT =qw(GET HEAD PUT POST);
#our @EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD DELETE);
#
#require HTTP::Request;
#use Carp();
#
#our $VERSION = "6.11";
#
#my $CRLF = "\015\012";   
#
#sub GET  { _simple_req('GET',  @_); }
#sub HEAD { _simple_req('HEAD', @_); }
#sub DELETE { _simple_req('DELETE', @_); }
#
#for my $type (qw(PUT POST)) {
#    no strict 'refs';
#    *{ __PACKAGE__ . "::" . $type } = sub {
#        return request_type_with_data($type, @_);
#    };
#}
#
#sub request_type_with_data
#{
#    my $type = shift;
#    my $url  = shift;
#    my $req = HTTP::Request->new($type => $url);
#    my $content;
#    $content = shift if @_ and ref $_[0];
#    my($k, $v);
#    while (($k,$v) = splice(@_, 0, 2)) {
#	if (lc($k) eq 'content') {
#	    $content = $v;
#	}
#	else {
#	    $req->push_header($k, $v);
#	}
#    }
#    my $ct = $req->header('Content-Type');
#    unless ($ct) {
#	$ct = 'application/x-www-form-urlencoded';
#    }
#    elsif ($ct eq 'form-data') {
#	$ct = 'multipart/form-data';
#    }
#
#    if (ref $content) {
#	if ($ct =~ m,^multipart/form-data\s*(;|$),i) {
#	    require HTTP::Headers::Util;
#	    my @v = HTTP::Headers::Util::split_header_words($ct);
#	    Carp::carp("Multiple Content-Type headers") if @v > 1;
#	    @v = @{$v[0]};
#
#	    my $boundary;
#	    my $boundary_index;
#	    for (my @tmp = @v; @tmp;) {
#		my($k, $v) = splice(@tmp, 0, 2);
#		if ($k eq "boundary") {
#		    $boundary = $v;
#		    $boundary_index = @v - @tmp - 1;
#		    last;
#		}
#	    }
#
#	    ($content, $boundary) = form_data($content, $boundary, $req);
#
#	    if ($boundary_index) {
#		$v[$boundary_index] = $boundary;
#	    }
#	    else {
#		push(@v, boundary => $boundary);
#	    }
#
#	    $ct = HTTP::Headers::Util::join_header_words(@v);
#	}
#	else {
#	    require URI;
#	    my $url = URI->new('http:');
#	    $url->query_form(ref($content) eq "HASH" ? %$content : @$content);
#	    $content = $url->query;
#
#	    $content =~ s/(?<!%0D)%0A/%0D%0A/g if defined($content);
#	}
#    }
#
#    $req->header('Content-Type' => $ct);  
#    if (defined($content)) {
#	$req->header('Content-Length' =>
#		     length($content)) unless ref($content);
#	$req->content($content);
#    }
#    else {
#        $req->header('Content-Length' => 0);
#    }
#    $req;
#}
#
#
#sub _simple_req
#{
#    my($method, $url) = splice(@_, 0, 2);
#    my $req = HTTP::Request->new($method => $url);
#    my($k, $v);
#    my $content;
#    while (($k,$v) = splice(@_, 0, 2)) {
#	if (lc($k) eq 'content') {
#	    $req->add_content($v);
#            $content++;
#	}
#	else {
#	    $req->push_header($k, $v);
#	}
#    }
#    if ($content && !defined($req->header("Content-Length"))) {
#        $req->header("Content-Length", length(${$req->content_ref}));
#    }
#    $req;
#}
#
#
#sub form_data   
#{
#    my($data, $boundary, $req) = @_;
#    my @data = ref($data) eq "HASH" ? %$data : @$data;  
#    my $fhparts;
#    my @parts;
#    while (my ($k,$v) = splice(@data, 0, 2)) {
#	if (!ref($v)) {
#	    $k =~ s/([\\\"])/\\$1/g;  
#            no warnings 'uninitialized';
#	    push(@parts,
#		 qq(Content-Disposition: form-data; name="$k"$CRLF$CRLF$v));
#	}
#	else {
#	    my($file, $usename, @headers) = @$v;
#	    unless (defined $usename) {
#		$usename = $file;
#		$usename =~ s,.*/,, if defined($usename);
#	    }
#            $k =~ s/([\\\"])/\\$1/g;
#	    my $disp = qq(form-data; name="$k");
#            if (defined($usename) and length($usename)) {
#                $usename =~ s/([\\\"])/\\$1/g;
#                $disp .= qq(; filename="$usename");
#            }
#	    my $content = "";
#	    my $h = HTTP::Headers->new(@headers);
#	    if ($file) {
#		open(my $fh, "<", $file) or Carp::croak("Can't open file $file: $!");
#		binmode($fh);
#		if ($DYNAMIC_FILE_UPLOAD) {
#                    close($fh);
#		    $content = \$file;
#		}
#		else {
#		    local($/) = undef; 
#		    $content = <$fh>;
#		    close($fh);
#		}
#		unless ($h->header("Content-Type")) {
#		    require LWP::MediaTypes;
#		    LWP::MediaTypes::guess_media_type($file, $h);
#		}
#	    }
#	    if ($h->header("Content-Disposition")) {
#		$disp = $h->header("Content-Disposition");
#		$h->remove_header("Content-Disposition");
#	    }
#	    if ($h->header("Content")) {
#		$content = $h->header("Content");
#		$h->remove_header("Content");
#	    }
#	    my $head = join($CRLF, "Content-Disposition: $disp",
#			           $h->as_string($CRLF),
#			           "");
#	    if (ref $content) {
#		push(@parts, [$head, $$content]);
#		$fhparts++;
#	    }
#	    else {
#		push(@parts, $head . $content);
#	    }
#	}
#    }
#    return ("", "none") unless @parts;
#
#    my $content;
#    if ($fhparts) {
#	$boundary = boundary(10) 
#	    unless $boundary;
#
#	for (1..@parts-1) {
#	    splice(@parts, $_*2-1, 0, "$CRLF--$boundary$CRLF");
#	}
#	unshift(@parts, "--$boundary$CRLF");
#	push(@parts, "$CRLF--$boundary--$CRLF");
#
#	my $length = 0;
#	for (@parts) {
#	    if (ref $_) {
#	 	my ($head, $f) = @$_;
#		my $file_size;
#		unless ( -f $f && ($file_size = -s _) ) {
#		    undef $length;
#		    last;
#		}
#	    	$length += $file_size + length $head;
#	    }
#	    else {
#		$length += length;
#	    }
#        }
#        $length && $req->header('Content-Length' => $length);
#
#	$content = sub {
#	    for (;;) {
#		unless (@parts) {
#		    defined $length && $length != 0 &&
#		    	Carp::croak "length of data sent did not match calculated Content-Length header.  Probably because uploaded file changed in size during transfer.";
#		    return;
#		}
#		my $p = shift @parts;
#		unless (ref $p) {
#		    $p .= shift @parts while @parts && !ref($parts[0]);
#		    defined $length && ($length -= length $p);
#		    return $p;
#		}
#		my($buf, $fh) = @$p;
#                unless (ref($fh)) {
#                    my $file = $fh;
#                    undef($fh);
#                    open($fh, "<", $file) || Carp::croak("Can't open file $file: $!");
#                    binmode($fh);
#                }
#		my $buflength = length $buf;
#		my $n = read($fh, $buf, 2048, $buflength);
#		if ($n) {
#		    $buflength += $n;
#		    unshift(@parts, ["", $fh]);
#		}
#		else {
#		    close($fh);
#		}
#		if ($buflength) {
#		    defined $length && ($length -= $buflength);
#		    return $buf 
#	    	}
#	    }
#	};
#
#    }
#    else {
#	$boundary = boundary() unless $boundary;
#
#	my $bno = 0;
#      CHECK_BOUNDARY:
#	{
#	    for (@parts) {
#		if (index($_, $boundary) >= 0) {
#		    $boundary = boundary(++$bno);
#		    redo CHECK_BOUNDARY;
#		}
#	    }
#	    last;
#	}
#	$content = "--$boundary$CRLF" .
#	           join("$CRLF--$boundary$CRLF", @parts) .
#		   "$CRLF--$boundary--$CRLF";
#    }
#
#    wantarray ? ($content, $boundary) : $content;
#}
#
#
#sub boundary
#{
#    my $size = shift || return "xYzZY";
#    require MIME::Base64;
#    my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
#    $b =~ s/[\W]/X/g;  
#    $b;
#}
#
#1;
#
#__END__
#
#
### HTTP/Response.pm ###
#package HTTP::Response;
#
#use strict;
#use warnings;
#
#use base 'HTTP::Message';
#
#our $VERSION = "6.11";
#
#use HTTP::Status ();
#
#
#sub new
#{
#    my($class, $rc, $msg, $header, $content) = @_;
#    my $self = $class->SUPER::new($header, $content);
#    $self->code($rc);
#    $self->message($msg);
#    $self;
#}
#
#
#sub parse
#{
#    my($class, $str) = @_;
#    my $status_line;
#    if ($str =~ s/^(.*)\n//) {
#	$status_line = $1;
#    }
#    else {
#	$status_line = $str;
#	$str = "";
#    }
#
#    my $self = $class->SUPER::parse($str);
#    my($protocol, $code, $message);
#    if ($status_line =~ /^\d{3} /) {
#       ($code, $message) = split(' ', $status_line, 2);
#    } else {
#       ($protocol, $code, $message) = split(' ', $status_line, 3);
#    }
#    $self->protocol($protocol) if $protocol;
#    $self->code($code) if defined($code);
#    $self->message($message) if defined($message);
#    $self;
#}
#
#
#sub clone
#{
#    my $self = shift;
#    my $clone = bless $self->SUPER::clone, ref($self);
#    $clone->code($self->code);
#    $clone->message($self->message);
#    $clone->request($self->request->clone) if $self->request;
#    $clone;
#}
#
#
#sub code      { shift->_elem('_rc',      @_); }
#sub message   { shift->_elem('_msg',     @_); }
#sub previous  { shift->_elem('_previous',@_); }
#sub request   { shift->_elem('_request', @_); }
#
#
#sub status_line
#{
#    my $self = shift;
#    my $code = $self->{'_rc'}  || "000";
#    my $mess = $self->{'_msg'} || HTTP::Status::status_message($code) || "Unknown code";
#    return "$code $mess";
#}
#
#
#sub base
#{
#    my $self = shift;
#    my $base = (
#	$self->header('Content-Base'),        
#	$self->header('Content-Location'),    
#	$self->header('Base'),                
#    )[0];
#    if ($base && $base =~ /^$URI::scheme_re:/o) {
#	return $HTTP::URI_CLASS->new($base);
#    }
#
#    my $req = $self->request;
#    if ($req) {
#        return $HTTP::URI_CLASS->new_abs($base, $req->uri);
#    }
#
#    return undef;
#}
#
#
#sub redirects {
#    my $self = shift;
#    my @r;
#    my $r = $self;
#    while (my $p = $r->previous) {
#        push(@r, $p);
#        $r = $p;
#    }
#    return @r unless wantarray;
#    return reverse @r;
#}
#
#
#sub filename
#{
#    my $self = shift;
#    my $file;
#
#    my $cd = $self->header('Content-Disposition');
#    if ($cd) {
#	require HTTP::Headers::Util;
#	if (my @cd = HTTP::Headers::Util::split_header_words($cd)) {
#	    my ($disposition, undef, %cd_param) = @{$cd[-1]};
#	    $file = $cd_param{filename};
#
#	    if ($file && $file =~ /^=\?(.+?)\?(.+?)\?(.+)\?=$/) {
#		my $charset = $1;
#		my $encoding = uc($2);
#		my $encfile = $3;
#
#		if ($encoding eq 'Q' || $encoding eq 'B') {
#		    local($SIG{__DIE__});
#		    eval {
#			if ($encoding eq 'Q') {
#			    $encfile =~ s/_/ /g;
#			    require MIME::QuotedPrint;
#			    $encfile = MIME::QuotedPrint::decode($encfile);
#			}
#			else { 
#			    require MIME::Base64;
#			    $encfile = MIME::Base64::decode($encfile);
#			}
#
#			require Encode;
#			require Encode::Locale;
#			Encode::from_to($encfile, $charset, "locale_fs");
#		    };
#
#		    $file = $encfile unless $@;
#		}
#	    }
#	}
#    }
#
#    unless (defined($file) && length($file)) {
#	my $uri;
#	if (my $cl = $self->header('Content-Location')) {
#	    $uri = URI->new($cl);
#	}
#	elsif (my $request = $self->request) {
#	    $uri = $request->uri;
#	}
#
#	if ($uri) {
#	    $file = ($uri->path_segments)[-1];
#	}
#    }
#
#    if ($file) {
#	$file =~ s,.*[\\/],,;  
#    }
#
#    if ($file && !length($file)) {
#	$file = undef;
#    }
#
#    $file;
#}
#
#
#sub as_string
#{
#    my $self = shift;
#    my($eol) = @_;
#    $eol = "\n" unless defined $eol;
#
#    my $status_line = $self->status_line;
#    my $proto = $self->protocol;
#    $status_line = "$proto $status_line" if $proto;
#
#    return join($eol, $status_line, $self->SUPER::as_string(@_));
#}
#
#
#sub dump
#{
#    my $self = shift;
#
#    my $status_line = $self->status_line;
#    my $proto = $self->protocol;
#    $status_line = "$proto $status_line" if $proto;
#
#    return $self->SUPER::dump(
#	preheader => $status_line,
#        @_,
#    );
#}
#
#
#sub is_info     { HTTP::Status::is_info     (shift->{'_rc'}); }
#sub is_success  { HTTP::Status::is_success  (shift->{'_rc'}); }
#sub is_redirect { HTTP::Status::is_redirect (shift->{'_rc'}); }
#sub is_error    { HTTP::Status::is_error    (shift->{'_rc'}); }
#sub is_client_error { HTTP::Status::is_client_error (shift->{'_rc'}); }
#sub is_server_error { HTTP::Status::is_server_error (shift->{'_rc'}); }
#
#
#sub error_as_HTML
#{
#    my $self = shift;
#    my $title = 'An Error Occurred';
#    my $body  = $self->status_line;
#    $body =~ s/&/&amp;/g;
#    $body =~ s/</&lt;/g;
#    return <<EOM;
#<html>
#<head><title>$title</title></head>
#<body>
#<h1>$title</h1>
#<p>$body</p>
#</body>
#</html>
#EOM
#}
#
#
#sub current_age
#{
#    my $self = shift;
#    my $time = shift;
#
#    my $response_time = $self->client_date;
#    my $date = $self->date;
#
#    my $age = 0;
#    if ($response_time && $date) {
#	$age = $response_time - $date;  
#	$age = 0 if $age < 0;
#    }
#
#    my $age_v = $self->header('Age');
#    if ($age_v && $age_v > $age) {
#	$age = $age_v;   
#    }
#
#    if ($response_time) {
#	my $request = $self->request;
#	if ($request) {
#	    my $request_time = $request->date;
#	    if ($request_time && $request_time < $response_time) {
#		$age += $response_time - $request_time;
#	    }
#	}
#	$age += ($time || time) - $response_time;
#    }
#    return $age;
#}
#
#
#sub freshness_lifetime
#{
#    my($self, %opt) = @_;
#
#    for my $cc ($self->header('Cache-Control')) {
#	for my $cc_dir (split(/\s*,\s*/, $cc)) {
#	    return $1 if $cc_dir =~ /^max-age\s*=\s*(\d+)/i;
#	}
#    }
#
#    my $date = $self->date || $self->client_date || $opt{time} || time;
#    if (my $expires = $self->expires) {
#	return $expires - $date;
#    }
#
#    return undef if exists $opt{heuristic_expiry} && !$opt{heuristic_expiry};
#
#    $opt{h_min} ||= 60;
#    $opt{h_max} ||= 24 * 3600;
#    $opt{h_lastmod_fraction} ||= 0.10; 
#    $opt{h_default} ||= 3600;
#
#
#    if (my $last_modified = $self->last_modified) {
#	my $h_exp = ($date - $last_modified) * $opt{h_lastmod_fraction};
#	return $opt{h_min} if $h_exp < $opt{h_min};
#	return $opt{h_max} if $h_exp > $opt{h_max};
#	return $h_exp;
#    }
#
#    return $opt{h_min} if $opt{h_min} > $opt{h_default};
#    return $opt{h_default};
#}
#
#
#sub is_fresh
#{
#    my($self, %opt) = @_;
#    $opt{time} ||= time;
#    my $f = $self->freshness_lifetime(%opt);
#    return undef unless defined($f);
#    return $f > $self->current_age($opt{time});
#}
#
#
#sub fresh_until
#{
#    my($self, %opt) = @_;
#    $opt{time} ||= time;
#    my $f = $self->freshness_lifetime(%opt);
#    return undef unless defined($f);
#    return $f - $self->current_age($opt{time}) + $opt{time};
#}
#
#1;
#
#
#__END__
#
### HTTP/Status.pm ###
#package HTTP::Status;
#
#use strict;
#use warnings;
#
#require 5.002;   
#
#use base 'Exporter';
#our @EXPORT = qw(is_info is_success is_redirect is_error status_message);
#our @EXPORT_OK = qw(is_client_error is_server_error);
#
#our $VERSION = "6.11";
#
#
#
#my %StatusCode = (
#    100 => 'Continue',
#    101 => 'Switching Protocols',
#    102 => 'Processing',                      
#    200 => 'OK',
#    201 => 'Created',
#    202 => 'Accepted',
#    203 => 'Non-Authoritative Information',
#    204 => 'No Content',
#    205 => 'Reset Content',
#    206 => 'Partial Content',
#    207 => 'Multi-Status',                    
#    208 => 'Already Reported',		      
#    300 => 'Multiple Choices',
#    301 => 'Moved Permanently',
#    302 => 'Found',
#    303 => 'See Other',
#    304 => 'Not Modified',
#    305 => 'Use Proxy',
#    307 => 'Temporary Redirect',
#    308 => 'Permanent Redirect',              
#    400 => 'Bad Request',
#    401 => 'Unauthorized',
#    402 => 'Payment Required',
#    403 => 'Forbidden',
#    404 => 'Not Found',
#    405 => 'Method Not Allowed',
#    406 => 'Not Acceptable',
#    407 => 'Proxy Authentication Required',
#    408 => 'Request Timeout',
#    409 => 'Conflict',
#    410 => 'Gone',
#    411 => 'Length Required',
#    412 => 'Precondition Failed',
#    413 => 'Request Entity Too Large',
#    414 => 'Request-URI Too Large',
#    415 => 'Unsupported Media Type',
#    416 => 'Request Range Not Satisfiable',
#    417 => 'Expectation Failed',
#    418 => 'I\'m a teapot',		      
#    422 => 'Unprocessable Entity',            
#    423 => 'Locked',                          
#    424 => 'Failed Dependency',               
#    425 => 'No code',                         
#    426 => 'Upgrade Required',                
#    428 => 'Precondition Required',
#    429 => 'Too Many Requests',
#    431 => 'Request Header Fields Too Large',
#    449 => 'Retry with',                      
#    500 => 'Internal Server Error',
#    501 => 'Not Implemented',
#    502 => 'Bad Gateway',
#    503 => 'Service Unavailable',
#    504 => 'Gateway Timeout',
#    505 => 'HTTP Version Not Supported',
#    506 => 'Variant Also Negotiates',         
#    507 => 'Insufficient Storage',            
#    509 => 'Bandwidth Limit Exceeded',        
#    510 => 'Not Extended',                    
#    511 => 'Network Authentication Required',
#);
#
#my $mnemonicCode = '';
#my ($code, $message);
#while (($code, $message) = each %StatusCode) {
#    $message =~ s/I'm/I am/;
#    $message =~ tr/a-z \-/A-Z__/;
#    $mnemonicCode .= "sub HTTP_$message () { $code }\n";
#    $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n";  
#    $mnemonicCode .= "push(\@EXPORT_OK, 'HTTP_$message');\n";
#    $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n";
#}
#eval $mnemonicCode; 
#die if $@;
#
#*RC_MOVED_TEMPORARILY = \&RC_FOUND;  
#push(@EXPORT, "RC_MOVED_TEMPORARILY");
#
#our %EXPORT_TAGS = (
#   constants => [grep /^HTTP_/, @EXPORT_OK],
#   is => [grep /^is_/, @EXPORT, @EXPORT_OK],
#);
#
#
#sub status_message  ($) { $StatusCode{$_[0]}; }
#
#sub is_info         ($) { $_[0] >= 100 && $_[0] < 200; }
#sub is_success      ($) { $_[0] >= 200 && $_[0] < 300; }
#sub is_redirect     ($) { $_[0] >= 300 && $_[0] < 400; }
#sub is_error        ($) { $_[0] >= 400 && $_[0] < 600; }
#sub is_client_error ($) { $_[0] >= 400 && $_[0] < 500; }
#sub is_server_error ($) { $_[0] >= 500 && $_[0] < 600; }
#
#1;
#
#
#__END__
#
### HTTP/Tiny.pm ###
#package HTTP::Tiny;
#use strict;
#use warnings;
#
#our $VERSION = '0.056';
#
#use Carp ();
#
#
#my @attributes;
#BEGIN {
#    @attributes = qw(
#        cookie_jar default_headers http_proxy https_proxy keep_alive
#        local_address max_redirect max_size proxy no_proxy timeout
#        SSL_options verify_SSL
#    );
#    my %persist_ok = map {; $_ => 1 } qw(
#        cookie_jar default_headers max_redirect max_size
#    );
#    no strict 'refs';
#    no warnings 'uninitialized';
#    for my $accessor ( @attributes ) {
#        *{$accessor} = sub {
#            @_ > 1
#                ? do {
#                    delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
#                    $_[0]->{$accessor} = $_[1]
#                }
#                : $_[0]->{$accessor};
#        };
#    }
#}
#
#sub agent {
#    my($self, $agent) = @_;
#    if( @_ > 1 ){
#        $self->{agent} =
#            (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
#    }
#    return $self->{agent};
#}
#
#sub new {
#    my($class, %args) = @_;
#
#    my $self = {
#        max_redirect => 5,
#        timeout      => 60,
#        keep_alive   => 1,
#        verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, 
#        no_proxy     => $ENV{no_proxy},
#    };
#
#    bless $self, $class;
#
#    $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
#
#    for my $key ( @attributes ) {
#        $self->{$key} = $args{$key} if exists $args{$key}
#    }
#
#    $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
#
#    $self->_set_proxies;
#
#    return $self;
#}
#
#sub _set_proxies {
#    my ($self) = @_;
#
#
#    if (! exists $self->{proxy} ) {
#        $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
#    }
#
#    if ( defined $self->{proxy} ) {
#        $self->_split_proxy( 'generic proxy' => $self->{proxy} ); 
#    }
#    else {
#        delete $self->{proxy};
#    }
#
#    if (! exists $self->{http_proxy} ) {
#        local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD};
#        $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
#    }
#
#    if ( defined $self->{http_proxy} ) {
#        $self->_split_proxy( http_proxy => $self->{http_proxy} ); 
#        $self->{_has_proxy}{http} = 1;
#    }
#    else {
#        delete $self->{http_proxy};
#    }
#
#    if (! exists $self->{https_proxy} ) {
#        $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
#    }
#
#    if ( $self->{https_proxy} ) {
#        $self->_split_proxy( https_proxy => $self->{https_proxy} ); 
#        $self->{_has_proxy}{https} = 1;
#    }
#    else {
#        delete $self->{https_proxy};
#    }
#
#    unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
#        $self->{no_proxy} =
#            (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
#    }
#
#    return;
#}
#
#
#for my $sub_name ( qw/get head put post delete/ ) {
#    my $req_method = uc $sub_name;
#    no strict 'refs';
#    eval <<"HERE"; 
#    sub $sub_name {
#        my (\$self, \$url, \$args) = \@_;
#        \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
#        or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
#        return \$self->request('$req_method', \$url, \$args || {});
#    }
#HERE
#}
#
#
#sub post_form {
#    my ($self, $url, $data, $args) = @_;
#    (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
#        or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
#
#    my $headers = {};
#    while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
#        $headers->{lc $key} = $value;
#    }
#    delete $args->{headers};
#
#    return $self->request('POST', $url, {
#            %$args,
#            content => $self->www_form_urlencode($data),
#            headers => {
#                %$headers,
#                'content-type' => 'application/x-www-form-urlencoded'
#            },
#        }
#    );
#}
#
#
#sub mirror {
#    my ($self, $url, $file, $args) = @_;
#    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
#      or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
#    if ( -e $file and my $mtime = (stat($file))[9] ) {
#        $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
#    }
#    my $tempfile = $file . int(rand(2**31));
#
#    require Fcntl;
#    sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
#       or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
#    binmode $fh;
#    $args->{data_callback} = sub { print {$fh} $_[0] };
#    my $response = $self->request('GET', $url, $args);
#    close $fh
#        or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
#
#    if ( $response->{success} ) {
#        rename $tempfile, $file
#            or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
#        my $lm = $response->{headers}{'last-modified'};
#        if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
#            utime $mtime, $mtime, $file;
#        }
#    }
#    $response->{success} ||= $response->{status} eq '304';
#    unlink $tempfile;
#    return $response;
#}
#
#
#my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
#
#sub request {
#    my ($self, $method, $url, $args) = @_;
#    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
#      or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
#    $args ||= {}; 
#
#    my $response;
#    for ( 0 .. 1 ) {
#        $response = eval { $self->_request($method, $url, $args) };
#        last unless $@ && $idempotent{$method}
#            && $@ =~ m{^(?:Socket closed|Unexpected end)};
#    }
#
#    if (my $e = $@) {
#        if ( ref $e eq 'HASH' && exists $e->{status} ) {
#            return $e;
#        }
#
#        $e = "$e";
#        $response = {
#            url     => $url,
#            success => q{},
#            status  => 599,
#            reason  => 'Internal Exception',
#            content => $e,
#            headers => {
#                'content-type'   => 'text/plain',
#                'content-length' => length $e,
#            }
#        };
#    }
#    return $response;
#}
#
#
#sub www_form_urlencode {
#    my ($self, $data) = @_;
#    (@_ == 2 && ref $data)
#        or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
#    (ref $data eq 'HASH' || ref $data eq 'ARRAY')
#        or Carp::croak("form data must be a hash or array reference\n");
#
#    my @params = ref $data eq 'HASH' ? %$data : @$data;
#    @params % 2 == 0
#        or Carp::croak("form data reference must have an even number of terms\n");
#
#    my @terms;
#    while( @params ) {
#        my ($key, $value) = splice(@params, 0, 2);
#        if ( ref $value eq 'ARRAY' ) {
#            unshift @params, map { $key => $_ } @$value;
#        }
#        else {
#            push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
#        }
#    }
#
#    return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
#}
#
#
#sub can_ssl {
#    my ($self) = @_;
#
#    my($ok, $reason) = (1, '');
#
#    unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
#        $ok = 0;
#        $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
#    }
#
#    unless (eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}) {
#        $ok = 0;
#        $reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/;
#    }
#
#    if ( ref($self) && ( $self->{verify_SSL} || $self->{SSL_options}{SSL_verify_mode} ) ) {
#        my $handle = HTTP::Tiny::Handle->new(
#            SSL_options => $self->{SSL_options},
#            verify_SSL  => $self->{verify_SSL},
#        );
#        unless ( eval { $handle->_find_CA_file; 1 } ) {
#            $ok = 0;
#            $reason .= "$@";
#        }
#    }
#
#    wantarray ? ($ok, $reason) : $ok;
#}
#
#
#my %DefaultPort = (
#    http => 80,
#    https => 443,
#);
#
#sub _agent {
#    my $class = ref($_[0]) || $_[0];
#    (my $default_agent = $class) =~ s{::}{-}g;
#    return $default_agent . "/" . $class->VERSION;
#}
#
#sub _request {
#    my ($self, $method, $url, $args) = @_;
#
#    my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
#
#    my $request = {
#        method    => $method,
#        scheme    => $scheme,
#        host      => $host,
#        port      => $port,
#        host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
#        uri       => $path_query,
#        headers   => {},
#    };
#
#    my $handle = delete $self->{handle};
#    if ( $handle ) {
#        unless ( $handle->can_reuse( $scheme, $host, $port ) ) {
#            $handle->close;
#            undef $handle;
#        }
#    }
#    $handle ||= $self->_open_handle( $request, $scheme, $host, $port );
#
#    $self->_prepare_headers_and_cb($request, $args, $url, $auth);
#    $handle->write_request($request);
#
#    my $response;
#    do { $response = $handle->read_response_header }
#        until (substr($response->{status},0,1) ne '1');
#
#    $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
#
#    if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
#        $handle->close;
#        return $self->_request(@redir_args, $args);
#    }
#
#    my $known_message_length;
#    if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
#        $known_message_length = 1;
#    }
#    else {
#        my $data_cb = $self->_prepare_data_cb($response, $args);
#        $known_message_length = $handle->read_body($data_cb, $response);
#    }
#
#    if ( $self->{keep_alive}
#        && $known_message_length
#        && $response->{protocol} eq 'HTTP/1.1'
#        && ($response->{headers}{connection} || '') ne 'close'
#    ) {
#        $self->{handle} = $handle;
#    }
#    else {
#        $handle->close;
#    }
#
#    $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
#    $response->{url} = $url;
#    return $response;
#}
#
#sub _open_handle {
#    my ($self, $request, $scheme, $host, $port) = @_;
#
#    my $handle  = HTTP::Tiny::Handle->new(
#        timeout         => $self->{timeout},
#        SSL_options     => $self->{SSL_options},
#        verify_SSL      => $self->{verify_SSL},
#        local_address   => $self->{local_address},
#        keep_alive      => $self->{keep_alive}
#    );
#
#    if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
#        return $self->_proxy_connect( $request, $handle );
#    }
#    else {
#        return $handle->connect($scheme, $host, $port);
#    }
#}
#
#sub _proxy_connect {
#    my ($self, $request, $handle) = @_;
#
#    my @proxy_vars;
#    if ( $request->{scheme} eq 'https' ) {
#        Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy};
#        @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
#        if ( $proxy_vars[0] eq 'https' ) {
#            Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
#        }
#    }
#    else {
#        Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy};
#        @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
#    }
#
#    my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
#
#    if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
#        $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
#    }
#
#    $handle->connect($p_scheme, $p_host, $p_port);
#
#    if ($request->{scheme} eq 'https') {
#        $self->_create_proxy_tunnel( $request, $handle );
#    }
#    else {
#        $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
#    }
#
#    return $handle;
#}
#
#sub _split_proxy {
#    my ($self, $type, $proxy) = @_;
#
#    my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
#
#    unless(
#        defined($scheme) && length($scheme) && length($host) && length($port)
#        && $path_query eq '/'
#    ) {
#        Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
#    }
#
#    return ($scheme, $host, $port, $auth);
#}
#
#sub _create_proxy_tunnel {
#    my ($self, $request, $handle) = @_;
#
#    $handle->_assert_ssl;
#
#    my $agent = exists($request->{headers}{'user-agent'})
#        ? $request->{headers}{'user-agent'} : $self->{agent};
#
#    my $connect_request = {
#        method    => 'CONNECT',
#        uri       => "$request->{host}:$request->{port}",
#        headers   => {
#            host => "$request->{host}:$request->{port}",
#            'user-agent' => $agent,
#        }
#    };
#
#    if ( $request->{headers}{'proxy-authorization'} ) {
#        $connect_request->{headers}{'proxy-authorization'} =
#            delete $request->{headers}{'proxy-authorization'};
#    }
#
#    $handle->write_request($connect_request);
#    my $response;
#    do { $response = $handle->read_response_header }
#        until (substr($response->{status},0,1) ne '1');
#
#    unless (substr($response->{status},0,1) eq '2') {
#        die $response;
#    }
#
#    $handle->start_ssl( $request->{host} );
#
#    return;
#}
#
#sub _prepare_headers_and_cb {
#    my ($self, $request, $args, $url, $auth) = @_;
#
#    for ($self->{default_headers}, $args->{headers}) {
#        next unless defined;
#        while (my ($k, $v) = each %$_) {
#            $request->{headers}{lc $k} = $v;
#        }
#    }
#
#    if (exists $request->{headers}{'host'}) {
#        die(qq/The 'Host' header must not be provided as header option\n/);
#    }
#
#    $request->{headers}{'host'}         = $request->{host_port};
#    $request->{headers}{'user-agent'} ||= $self->{agent};
#    $request->{headers}{'connection'}   = "close"
#        unless $self->{keep_alive};
#
#    if ( defined $args->{content} ) {
#        if (ref $args->{content} eq 'CODE') {
#            $request->{headers}{'content-type'} ||= "application/octet-stream";
#            $request->{headers}{'transfer-encoding'} = 'chunked'
#              unless $request->{headers}{'content-length'}
#                  || $request->{headers}{'transfer-encoding'};
#            $request->{cb} = $args->{content};
#        }
#        elsif ( length $args->{content} ) {
#            my $content = $args->{content};
#            if ( $] ge '5.008' ) {
#                utf8::downgrade($content, 1)
#                    or die(qq/Wide character in request message body\n/);
#            }
#            $request->{headers}{'content-type'} ||= "application/octet-stream";
#            $request->{headers}{'content-length'} = length $content
#              unless $request->{headers}{'content-length'}
#                  || $request->{headers}{'transfer-encoding'};
#            $request->{cb} = sub { substr $content, 0, length $content, '' };
#        }
#        $request->{trailer_cb} = $args->{trailer_callback}
#            if ref $args->{trailer_callback} eq 'CODE';
#    }
#
#    if ( $self->{cookie_jar} ) {
#        my $cookies = $self->cookie_jar->cookie_header( $url );
#        $request->{headers}{cookie} = $cookies if length $cookies;
#    }
#
#    if ( length $auth && ! defined $request->{headers}{authorization} ) {
#        $self->_add_basic_auth_header( $request, 'authorization' => $auth );
#    }
#
#    return;
#}
#
#sub _add_basic_auth_header {
#    my ($self, $request, $header, $auth) = @_;
#    require MIME::Base64;
#    $request->{headers}{$header} =
#        "Basic " . MIME::Base64::encode_base64($auth, "");
#    return;
#}
#
#sub _prepare_data_cb {
#    my ($self, $response, $args) = @_;
#    my $data_cb = $args->{data_callback};
#    $response->{content} = '';
#
#    if (!$data_cb || $response->{status} !~ /^2/) {
#        if (defined $self->{max_size}) {
#            $data_cb = sub {
#                $_[1]->{content} .= $_[0];
#                die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
#                  if length $_[1]->{content} > $self->{max_size};
#            };
#        }
#        else {
#            $data_cb = sub { $_[1]->{content} .= $_[0] };
#        }
#    }
#    return $data_cb;
#}
#
#sub _update_cookie_jar {
#    my ($self, $url, $response) = @_;
#
#    my $cookies = $response->{headers}->{'set-cookie'};
#    return unless defined $cookies;
#
#    my @cookies = ref $cookies ? @$cookies : $cookies;
#
#    $self->cookie_jar->add( $url, $_ ) for @cookies;
#
#    return;
#}
#
#sub _validate_cookie_jar {
#    my ($class, $jar) = @_;
#
#    for my $method ( qw/add cookie_header/ ) {
#        Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
#            unless ref($jar) && ref($jar)->can($method);
#    }
#
#    return;
#}
#
#sub _maybe_redirect {
#    my ($self, $request, $response, $args) = @_;
#    my $headers = $response->{headers};
#    my ($status, $method) = ($response->{status}, $request->{method});
#    if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))
#        and $headers->{location}
#        and ++$args->{redirects} <= $self->{max_redirect}
#    ) {
#        my $location = ($headers->{location} =~ /^\//)
#            ? "$request->{scheme}://$request->{host_port}$headers->{location}"
#            : $headers->{location} ;
#        return (($status eq '303' ? 'GET' : $method), $location);
#    }
#    return;
#}
#
#sub _split_url {
#    my $url = pop;
#
#    my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
#      or die(qq/Cannot parse URL: '$url'\n/);
#
#    $scheme     = lc $scheme;
#    $path_query = "/$path_query" unless $path_query =~ m<\A/>;
#
#    my $auth = '';
#    if ( (my $i = index $host, '@') != -1 ) {
#        $auth = substr $host, 0, $i, ''; 
#        substr $host, 0, 1, '';          
#
#        $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
#    }
#    my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
#             : $scheme eq 'http'                  ? 80
#             : $scheme eq 'https'                 ? 443
#             : undef;
#
#    return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
#}
#
#my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
#my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
#sub _http_date {
#    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
#    return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
#        substr($DoW,$wday*4,3),
#        $mday, substr($MoY,$mon*4,3), $year+1900,
#        $hour, $min, $sec
#    );
#}
#
#sub _parse_http_date {
#    my ($self, $str) = @_;
#    require Time::Local;
#    my @tl_parts;
#    if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
#        @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
#    }
#    elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
#        @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
#    }
#    elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
#        @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
#    }
#    return eval {
#        my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
#        $t < 0 ? undef : $t;
#    };
#}
#
#my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
#$escapes{' '}="+";
#my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
#
#sub _uri_escape {
#    my ($self, $str) = @_;
#    if ( $] ge '5.008' ) {
#        utf8::encode($str);
#    }
#    else {
#        $str = pack("U*", unpack("C*", $str)) 
#            if ( length $str == do { use bytes; length $str } );
#        $str = pack("C*", unpack("C*", $str)); 
#    }
#    $str =~ s/($unsafe_char)/$escapes{$1}/ge;
#    return $str;
#}
#
#package
#    HTTP::Tiny::Handle; 
#use strict;
#use warnings;
#
#use Errno      qw[EINTR EPIPE];
#use IO::Socket qw[SOCK_STREAM];
#
#my $SOCKET_CLASS =
#    $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
#    eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' :
#    'IO::Socket::INET';
#
#sub BUFSIZE () { 32768 } 
#
#my $Printable = sub {
#    local $_ = shift;
#    s/\r/\\r/g;
#    s/\n/\\n/g;
#    s/\t/\\t/g;
#    s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
#    $_;
#};
#
#my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
#
#sub new {
#    my ($class, %args) = @_;
#    return bless {
#        rbuf             => '',
#        timeout          => 60,
#        max_line_size    => 16384,
#        max_header_lines => 64,
#        verify_SSL       => 0,
#        SSL_options      => {},
#        %args
#    }, $class;
#}
#
#sub connect {
#    @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
#    my ($self, $scheme, $host, $port) = @_;
#
#    if ( $scheme eq 'https' ) {
#        $self->_assert_ssl;
#    }
#    elsif ( $scheme ne 'http' ) {
#      die(qq/Unsupported URL scheme '$scheme'\n/);
#    }
#    $self->{fh} = $SOCKET_CLASS->new(
#        PeerHost  => $host,
#        PeerPort  => $port,
#        $self->{local_address} ?
#            ( LocalAddr => $self->{local_address} ) : (),
#        Proto     => 'tcp',
#        Type      => SOCK_STREAM,
#        Timeout   => $self->{timeout},
#        KeepAlive => !!$self->{keep_alive}
#    ) or die(qq/Could not connect to '$host:$port': $@\n/);
#
#    binmode($self->{fh})
#      or die(qq/Could not binmode() socket: '$!'\n/);
#
#    $self->start_ssl($host) if $scheme eq 'https';
#
#    $self->{scheme} = $scheme;
#    $self->{host} = $host;
#    $self->{port} = $port;
#    $self->{pid} = $$;
#    $self->{tid} = _get_tid();
#
#    return $self;
#}
#
#sub start_ssl {
#    my ($self, $host) = @_;
#
#    if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
#        unless ( $self->{fh}->stop_SSL ) {
#            my $ssl_err = IO::Socket::SSL->errstr;
#            die(qq/Error halting prior SSL connection: $ssl_err/);
#        }
#    }
#
#    my $ssl_args = $self->_ssl_args($host);
#    IO::Socket::SSL->start_SSL(
#        $self->{fh},
#        %$ssl_args,
#        SSL_create_ctx_callback => sub {
#            my $ctx = shift;
#            Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
#        },
#    );
#
#    unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
#        my $ssl_err = IO::Socket::SSL->errstr;
#        die(qq/SSL connection failed for $host: $ssl_err\n/);
#    }
#}
#
#sub close {
#    @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
#    my ($self) = @_;
#    CORE::close($self->{fh})
#      or die(qq/Could not close socket: '$!'\n/);
#}
#
#sub write {
#    @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
#    my ($self, $buf) = @_;
#
#    if ( $] ge '5.008' ) {
#        utf8::downgrade($buf, 1)
#            or die(qq/Wide character in write()\n/);
#    }
#
#    my $len = length $buf;
#    my $off = 0;
#
#    local $SIG{PIPE} = 'IGNORE';
#
#    while () {
#        $self->can_write
#          or die(qq/Timed out while waiting for socket to become ready for writing\n/);
#        my $r = syswrite($self->{fh}, $buf, $len, $off);
#        if (defined $r) {
#            $len -= $r;
#            $off += $r;
#            last unless $len > 0;
#        }
#        elsif ($! == EPIPE) {
#            die(qq/Socket closed by remote server: $!\n/);
#        }
#        elsif ($! != EINTR) {
#            if ($self->{fh}->can('errstr')){
#                my $err = $self->{fh}->errstr();
#                die (qq/Could not write to SSL socket: '$err'\n /);
#            }
#            else {
#                die(qq/Could not write to socket: '$!'\n/);
#            }
#
#        }
#    }
#    return $off;
#}
#
#sub read {
#    @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
#    my ($self, $len, $allow_partial) = @_;
#
#    my $buf  = '';
#    my $got = length $self->{rbuf};
#
#    if ($got) {
#        my $take = ($got < $len) ? $got : $len;
#        $buf  = substr($self->{rbuf}, 0, $take, '');
#        $len -= $take;
#    }
#
#    while ($len > 0) {
#        $self->can_read
#          or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
#        my $r = sysread($self->{fh}, $buf, $len, length $buf);
#        if (defined $r) {
#            last unless $r;
#            $len -= $r;
#        }
#        elsif ($! != EINTR) {
#            if ($self->{fh}->can('errstr')){
#                my $err = $self->{fh}->errstr();
#                die (qq/Could not read from SSL socket: '$err'\n /);
#            }
#            else {
#                die(qq/Could not read from socket: '$!'\n/);
#            }
#        }
#    }
#    if ($len && !$allow_partial) {
#        die(qq/Unexpected end of stream\n/);
#    }
#    return $buf;
#}
#
#sub readline {
#    @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
#    my ($self) = @_;
#
#    while () {
#        if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
#            return $1;
#        }
#        if (length $self->{rbuf} >= $self->{max_line_size}) {
#            die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
#        }
#        $self->can_read
#          or die(qq/Timed out while waiting for socket to become ready for reading\n/);
#        my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
#        if (defined $r) {
#            last unless $r;
#        }
#        elsif ($! != EINTR) {
#            if ($self->{fh}->can('errstr')){
#                my $err = $self->{fh}->errstr();
#                die (qq/Could not read from SSL socket: '$err'\n /);
#            }
#            else {
#                die(qq/Could not read from socket: '$!'\n/);
#            }
#        }
#    }
#    die(qq/Unexpected end of stream while looking for line\n/);
#}
#
#sub read_header_lines {
#    @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
#    my ($self, $headers) = @_;
#    $headers ||= {};
#    my $lines   = 0;
#    my $val;
#
#    while () {
#         my $line = $self->readline;
#
#         if (++$lines >= $self->{max_header_lines}) {
#             die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
#         }
#         elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
#             my ($field_name) = lc $1;
#             if (exists $headers->{$field_name}) {
#                 for ($headers->{$field_name}) {
#                     $_ = [$_] unless ref $_ eq "ARRAY";
#                     push @$_, $2;
#                     $val = \$_->[-1];
#                 }
#             }
#             else {
#                 $val = \($headers->{$field_name} = $2);
#             }
#         }
#         elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
#             $val
#               or die(qq/Unexpected header continuation line\n/);
#             next unless length $1;
#             $$val .= ' ' if length $$val;
#             $$val .= $1;
#         }
#         elsif ($line =~ /\A \x0D?\x0A \z/x) {
#            last;
#         }
#         else {
#            die(q/Malformed header line: / . $Printable->($line) . "\n");
#         }
#    }
#    return $headers;
#}
#
#sub write_request {
#    @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
#    my($self, $request) = @_;
#    $self->write_request_header(@{$request}{qw/method uri headers/});
#    $self->write_body($request) if $request->{cb};
#    return;
#}
#
#my %HeaderCase = (
#    'content-md5'      => 'Content-MD5',
#    'etag'             => 'ETag',
#    'te'               => 'TE',
#    'www-authenticate' => 'WWW-Authenticate',
#    'x-xss-protection' => 'X-XSS-Protection',
#);
#
#sub write_header_lines {
#    (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n");
#    my($self, $headers, $prefix_data) = @_;
#
#    my $buf = (defined $prefix_data ? $prefix_data : '');
#    while (my ($k, $v) = each %$headers) {
#        my $field_name = lc $k;
#        if (exists $HeaderCase{$field_name}) {
#            $field_name = $HeaderCase{$field_name};
#        }
#        else {
#            $field_name =~ /\A $Token+ \z/xo
#              or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
#            $field_name =~ s/\b(\w)/\u$1/g;
#            $HeaderCase{lc $field_name} = $field_name;
#        }
#        for (ref $v eq 'ARRAY' ? @$v : $v) {
#            $_ = '' unless defined $_;
#            $buf .= "$field_name: $_\x0D\x0A";
#        }
#    }
#    $buf .= "\x0D\x0A";
#    return $self->write($buf);
#}
#
#sub read_body {
#    @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
#    my ($self, $cb, $response) = @_;
#    my $te = $response->{headers}{'transfer-encoding'} || '';
#    my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
#    return $chunked
#        ? $self->read_chunked_body($cb, $response)
#        : $self->read_content_body($cb, $response);
#}
#
#sub write_body {
#    @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
#    my ($self, $request) = @_;
#    if ($request->{headers}{'content-length'}) {
#        return $self->write_content_body($request);
#    }
#    else {
#        return $self->write_chunked_body($request);
#    }
#}
#
#sub read_content_body {
#    @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
#    my ($self, $cb, $response, $content_length) = @_;
#    $content_length ||= $response->{headers}{'content-length'};
#
#    if ( defined $content_length ) {
#        my $len = $content_length;
#        while ($len > 0) {
#            my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
#            $cb->($self->read($read, 0), $response);
#            $len -= $read;
#        }
#        return length($self->{rbuf}) == 0;
#    }
#
#    my $chunk;
#    $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
#
#    return;
#}
#
#sub write_content_body {
#    @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
#    my ($self, $request) = @_;
#
#    my ($len, $content_length) = (0, $request->{headers}{'content-length'});
#    while () {
#        my $data = $request->{cb}->();
#
#        defined $data && length $data
#          or last;
#
#        if ( $] ge '5.008' ) {
#            utf8::downgrade($data, 1)
#                or die(qq/Wide character in write_content()\n/);
#        }
#
#        $len += $self->write($data);
#    }
#
#    $len == $content_length
#      or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
#
#    return $len;
#}
#
#sub read_chunked_body {
#    @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
#    my ($self, $cb, $response) = @_;
#
#    while () {
#        my $head = $self->readline;
#
#        $head =~ /\A ([A-Fa-f0-9]+)/x
#          or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
#
#        my $len = hex($1)
#          or last;
#
#        $self->read_content_body($cb, $response, $len);
#
#        $self->read(2) eq "\x0D\x0A"
#          or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
#    }
#    $self->read_header_lines($response->{headers});
#    return 1;
#}
#
#sub write_chunked_body {
#    @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
#    my ($self, $request) = @_;
#
#    my $len = 0;
#    while () {
#        my $data = $request->{cb}->();
#
#        defined $data && length $data
#          or last;
#
#        if ( $] ge '5.008' ) {
#            utf8::downgrade($data, 1)
#                or die(qq/Wide character in write_chunked_body()\n/);
#        }
#
#        $len += length $data;
#
#        my $chunk  = sprintf '%X', length $data;
#           $chunk .= "\x0D\x0A";
#           $chunk .= $data;
#           $chunk .= "\x0D\x0A";
#
#        $self->write($chunk);
#    }
#    $self->write("0\x0D\x0A");
#    $self->write_header_lines($request->{trailer_cb}->())
#        if ref $request->{trailer_cb} eq 'CODE';
#    return $len;
#}
#
#sub read_response_header {
#    @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
#    my ($self) = @_;
#
#    my $line = $self->readline;
#
#    $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
#      or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
#
#    my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
#
#    die (qq/Unsupported HTTP protocol: $protocol\n/)
#        unless $version =~ /0*1\.0*[01]/;
#
#    return {
#        status       => $status,
#        reason       => $reason,
#        headers      => $self->read_header_lines,
#        protocol     => $protocol,
#    };
#}
#
#sub write_request_header {
#    @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
#    my ($self, $method, $request_uri, $headers) = @_;
#
#    return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A");
#}
#
#sub _do_timeout {
#    my ($self, $type, $timeout) = @_;
#    $timeout = $self->{timeout}
#        unless defined $timeout && $timeout >= 0;
#
#    my $fd = fileno $self->{fh};
#    defined $fd && $fd >= 0
#      or die(qq/select(2): 'Bad file descriptor'\n/);
#
#    my $initial = time;
#    my $pending = $timeout;
#    my $nfound;
#
#    vec(my $fdset = '', $fd, 1) = 1;
#
#    while () {
#        $nfound = ($type eq 'read')
#            ? select($fdset, undef, undef, $pending)
#            : select(undef, $fdset, undef, $pending) ;
#        if ($nfound == -1) {
#            $! == EINTR
#              or die(qq/select(2): '$!'\n/);
#            redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
#            $nfound = 0;
#        }
#        last;
#    }
#    $! = 0;
#    return $nfound;
#}
#
#sub can_read {
#    @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
#    my $self = shift;
#    if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
#        return 1 if $self->{fh}->pending;
#    }
#    return $self->_do_timeout('read', @_)
#}
#
#sub can_write {
#    @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
#    my $self = shift;
#    return $self->_do_timeout('write', @_)
#}
#
#sub _assert_ssl {
#    my($ok, $reason) = HTTP::Tiny->can_ssl();
#    die $reason unless $ok;
#}
#
#sub can_reuse {
#    my ($self,$scheme,$host,$port) = @_;
#    return 0 if
#        $self->{pid} != $$
#        || $self->{tid} != _get_tid()
#        || length($self->{rbuf})
#        || $scheme ne $self->{scheme}
#        || $host ne $self->{host}
#        || $port ne $self->{port}
#        || eval { $self->can_read(0) }
#        || $@ ;
#        return 1;
#}
#
#sub _find_CA_file {
#    my $self = shift();
#
#    if ( $self->{SSL_options}->{SSL_ca_file} ) {
#        unless ( -r $self->{SSL_options}->{SSL_ca_file} ) {
#            die qq/SSL_ca_file '$self->{SSL_options}->{SSL_ca_file}' not found or not readable\n/;
#        }
#        return $self->{SSL_options}->{SSL_ca_file};
#    }
#
#    return Mozilla::CA::SSL_ca_file()
#        if eval { require Mozilla::CA; 1 };
#
#    foreach my $ca_bundle (
#        "/etc/ssl/certs/ca-certificates.crt",     
#        "/etc/pki/tls/certs/ca-bundle.crt",       
#        "/etc/ssl/ca-bundle.pem",                 
#        "/etc/openssl/certs/ca-certificates.crt", 
#        "/etc/ssl/cert.pem",                      
#        "/usr/local/share/certs/ca-root-nss.crt", 
#        "/etc/pki/tls/cacert.pem",                
#        "/etc/certs/ca-certificates.crt",         
#    ) {
#        return $ca_bundle if -e $ca_bundle;
#    }
#
#    die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
#      . qq/Try installing Mozilla::CA from CPAN\n/;
#}
#
#sub _get_tid {
#    no warnings 'reserved'; 
#    return threads->can("tid") ? threads->tid : 0;
#}
#
#sub _ssl_args {
#    my ($self, $host) = @_;
#
#    my %ssl_args;
#
#    if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
#        $ssl_args{SSL_hostname} = $host,          
#    }
#
#    if ($self->{verify_SSL}) {
#        $ssl_args{SSL_verifycn_scheme}  = 'http'; 
#        $ssl_args{SSL_verifycn_name}    = $host;  
#        $ssl_args{SSL_verify_mode}      = 0x01;   
#        $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
#    }
#    else {
#        $ssl_args{SSL_verifycn_scheme}  = 'none'; 
#        $ssl_args{SSL_verify_mode}      = 0x00;   
#    }
#
#    for my $k ( keys %{$self->{SSL_options}} ) {
#        $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
#    }
#
#    return \%ssl_args;
#}
#
#1;
#
#__END__
#
### HTTP/Tiny/UNIX.pm ###
#package HTTP::Tiny::UNIX;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $DATE = '2014-07-04'; 
#our $VERSION = '0.04'; 
#
#
#use parent qw(HTTP::Tiny);
#
#use IO::Socket::UNIX;
#
#sub _split_url {
#    my ($self, $url) = @_;
#
#    if ($url =~ m<\A[^:/?#]+://>) {
#        $self->{_unix} = 0;
#        return $self->SUPER::_split_url($url);
#    }
#
#    my ($scheme, $sock_path, $path_query) =
#        $url =~ m<\A(\w+):(.+?)/(/[^#]*)>
#            or die "Cannot parse HTTP-over-Unix URL: '$url'\n";
#
#    $self->{_unix} = 1;
#    $self->{_path_query} = $path_query;
#
#    $scheme = lc $scheme;
#    die "Only http scheme is supported\n" unless $scheme eq 'http';
#
#    return  ($scheme, $sock_path, -1,    $path_query, '');
#}
#
#sub _open_handle {
#    my ($self, $request, $scheme, $host, $port) = @_;
#
#    return $self->SUPER::_open_handle($request, $scheme, $host, $port)
#        unless $self->{_unix};
#
#    my $handle = HTTP::Tiny::Handle::UNIX->new(
#        timeout => $self->{timeout},
#    );
#
#    $handle->connect($scheme, $host, $port, $self);
#}
#
#package
#    HTTP::Tiny::Handle::UNIX;
#
#use parent -norequire, 'HTTP::Tiny::Handle';
#
#use IO::Socket;
#
#sub connect {
#    my ($self, $scheme, $host, $port, $tiny) = @_;
#
#    my $path = $host;
#
#    local($^W) = 0;
#    my $sock = IO::Socket::UNIX->new(
#        Peer    => $path,
#        Type    => SOCK_STREAM,
#        Timeout => $self->{timeout},
#        Host    => 'localhost',
#    );
#
#    unless ($sock) {
#        $@ =~ s/^.*?: //;
#        die "Can't open Unix socket $path\: $@";
#    }
#
#    eval { $sock->blocking(0); };
#
#    $self->{fh} = $sock;
#
#    $self->{scheme} = $scheme;
#    $self->{host} = $host;
#    $self->{port} = $port;
#    $self->{_unix} = 1;
#    $self->{_tiny} = $tiny;
#    $self;
#}
#
#sub write_request_header {
#    my ($self, $method, $request_uri, $headers) = @_;
#
#    return $self->write_request_header($method, $request_uri, $headers)
#        unless $self->{_unix};
#
#    return $self->write_header_lines($headers, "$method $self->{_tiny}{_path_query} HTTP/1.1\x0D\x0A");
#}
#
#1;
#
#__END__
#
### IO/HTML.pm ###
#package IO::HTML;
#
#use 5.008;
#use strict;
#use warnings;
#
#use Carp 'croak';
#use Encode 2.10 qw(decode find_encoding); 
#use Exporter 5.57 'import';
#
#our $VERSION = '1.001';
#
#our $default_encoding ||= 'cp1252';
#
#our @EXPORT    = qw(html_file);
#our @EXPORT_OK = qw(find_charset_in html_file_and_encoding html_outfile
#                    sniff_encoding);
#
#our %EXPORT_TAGS = (
#  rw  => [qw( html_file html_file_and_encoding html_outfile )],
#  all => [ @EXPORT, @EXPORT_OK ],
#);
#
#
#
#sub html_file
#{
#  (&html_file_and_encoding)[0]; 
#} 
#
#
#
#sub html_file_and_encoding
#{
#  my ($filename, $options) = @_;
#
#  $options ||= {};
#
#  open(my $in, '<:raw', $filename) or croak "Failed to open $filename: $!";
#
#
#  my ($encoding, $bom) = sniff_encoding($in, $filename, $options);
#
#  if (not defined $encoding) {
#    croak "No default encoding specified"
#        unless defined($encoding = $default_encoding);
#    $encoding = find_encoding($encoding) if $options->{encoding};
#  } 
#
#  binmode $in, sprintf(":encoding(%s):crlf",
#                       $options->{encoding} ? $encoding->name : $encoding);
#
#  return ($in, $encoding, $bom);
#} 
#
#
#sub html_outfile
#{
#  my ($filename, $encoding, $bom) = @_;
#
#  if (not defined $encoding) {
#    croak "No default encoding specified"
#        unless defined($encoding = $default_encoding);
#  } 
#  elsif (ref $encoding) {
#    $encoding = $encoding->name;
#  }
#
#  open(my $out, ">:encoding($encoding)", $filename)
#      or croak "Failed to open $filename: $!";
#
#  print $out "\x{FeFF}" if $bom;
#
#  return $out;
#} 
#
#
#sub sniff_encoding
#{
#  my ($in, $filename, $options) = @_;
#
#  $filename = 'file' unless defined $filename;
#  $options ||= {};
#
#  my $pos = tell $in;
#  croak "Could not seek $filename: $!" if $pos < 0;
#
#  croak "Could not read $filename: $!" unless defined read $in, my $buf, 1024;
#
#  seek $in, $pos, 0 or croak "Could not seek $filename: $!";
#
#
#  my $bom;
#  my $encoding = do {
#    if ($buf =~ /^\xFe\xFF/) {
#      $bom = 2;
#      'UTF-16BE';
#    } elsif ($buf =~ /^\xFF\xFe/) {
#      $bom = 2;
#      'UTF-16LE';
#    } elsif ($buf =~ /^\xEF\xBB\xBF/) {
#      $bom = 3;
#      'utf-8-strict';
#    } else {
#      find_charset_in($buf, $options); 
#    }
#  }; 
#
#  if ($bom) {
#    seek $in, $bom, 1 or croak "Could not seek $filename: $!";
#    $bom = 1;
#  }
#  elsif (not defined $encoding) { 
#    my $test = decode('utf-8-strict', $buf, Encode::FB_QUIET);
#    if ($buf =~ /^(?:                   # nothing left over
#         | [\xC2-\xDF]                  # incomplete 2-byte char
#         | [\xE0-\xEF] [\x80-\xBF]?     # incomplete 3-byte char
#         | [\xF0-\xF4] [\x80-\xBF]{0,2} # incomplete 4-byte char
#        )\z/x and $test =~ /[^\x00-\x7F]/) {
#      $encoding = 'utf-8-strict';
#    } 
#  } 
#
#  if (defined $encoding and $options->{encoding} and not ref $encoding) {
#    $encoding = find_encoding($encoding);
#  } 
#
#  return wantarray ? ($encoding, $bom) : $encoding;
#} 
#
#
#sub _get_attribute
#{
#  m!\G[\x09\x0A\x0C\x0D /]+!gc; 
#
#  return if /\G>/gc or not /\G(=?[^\x09\x0A\x0C\x0D =]*)/gc;
#
#  my ($name, $value) = (lc $1, '');
#
#  if (/\G[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/gc
#      and (/\G"([^"]*)"?/gc or
#           /\G'([^']*)'?/gc or
#           /\G([^\x09\x0A\x0C\x0D >]*)/gc)) {
#    $value = lc $1;
#  } 
#
#  return wantarray ? ($name, $value) : 1;
#} 
#
#sub _get_charset_from_meta
#{
#  for (shift) {
#    while (/charset[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/ig) {
#      return $1 if (/\G"([^"]*)"/gc or
#                    /\G'([^']*)'/gc or
#                    /\G(?!['"])([^\x09\x0A\x0C\x0D ;]+)/gc);
#    }
#  } 
#
#  return undef;
#} 
#
#
#sub find_charset_in
#{
#  for (shift) {
#    my $options = shift || {};
#    my $stop = length > 1024 ? 1024 : length; 
#
#    my $expect_pragma = (defined $options->{need_pragma}
#                         ? $options->{need_pragma} : 1);
#
#    pos() = 0;
#    while (pos() < $stop) {
#      if (/\G<!--.*?(?<=--)>/sgc) {
#      } 
#      elsif (m!\G<meta(?=[\x09\x0A\x0C\x0D /])!gic) {
#        my ($got_pragma, $need_pragma, $charset);
#
#        while (my ($name, $value) = &_get_attribute) {
#          if ($name eq 'http-equiv' and $value eq 'content-type') {
#            $got_pragma = 1;
#          } elsif ($name eq 'content' and not defined $charset) {
#            $need_pragma = $expect_pragma
#                if defined($charset = _get_charset_from_meta($value));
#          } elsif ($name eq 'charset') {
#            $charset = $value;
#            $need_pragma = 0;
#          }
#        } 
#
#        if (defined $need_pragma and (not $need_pragma or $got_pragma)) {
#          $charset = 'UTF-8'  if $charset =~ /^utf-?16/;
#          $charset = 'cp1252' if $charset eq 'iso-8859-1'; 
#          if (my $encoding = find_encoding($charset)) {
#            return $options->{encoding} ? $encoding : $encoding->name;
#          } 
#        } 
#      } 
#      elsif (m!\G</?[a-zA-Z][^\x09\x0A\x0C\x0D >]*!gc) {
#        1 while &_get_attribute;
#      } 
#      elsif (m{\G<[!/?][^>]*}gc) {
#      } 
#      elsif (m/\G</gc) {
#      } 
#
#      m/\G[^<]+/gc;
#    } 
#  } 
#
#  return undef;                 
#} 
#
#
#*file               = \&html_file;
#*file_and_encoding  = \&html_file_and_encoding;
#*outfile            = \&html_outfile;
#
#
#1;
#
#__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 = '2017-07-10'; 
#our $VERSION = '0.32'; 
#
#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 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 = @_;
#
#    for (keys %$opts) {
#        die "Unknown option '$_'"
#            unless /\A(
#                        capture_stdout|capture_stderr|capture_merged|
#                        chdir|dies?|dry_run|env|lang|log||max_log_output|shell|
#                        stdin # XXX: only for run()
#                    )\z/x;
#    }
#
#    my $opt_die = $opts->{die} || $opts->{dies};
#
#    my $exit_code;
#    my $os_error = "";
#    my $extra_error;
#
#    if ($opts->{log}) {
#        require Log::ger;
#        Log::ger->import;
#    }
#
#    my $cwd;
#    if ($opts->{chdir}) {
#        require Cwd;
#        $cwd = Cwd::getcwd();
#        if (!defined $cwd) { 
#            $log->error("Can't getcwd: $!") if $log;
#            $exit_code = -1;
#            $os_error = $!;
#            $extra_error = "Can't getcwd";
#            goto CHECK_RESULT;
#        }
#        unless (chdir $opts->{chdir}) {
#            $log->error("Can't chdir to '$opts->{chdir}': $!") if $log;
#            $exit_code = -1;
#            $os_error = $!;
#            $extra_error = "Can't chdir";
#            goto CHECK_RESULT;
#        }
#    }
#
#    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{$_};
#        }
#    }
#
#    my $wa;
#    my $res;
#
#    my $code_capture = sub {
#        my $doit = shift;
#
#        if ($opts->{capture_stdout} && $opts->{capture_stderr}) {
#            require Capture::Tiny;
#            (${ $opts->{capture_stdout} }, ${ $opts->{capture_stderr} }) =
#                &Capture::Tiny::capture($doit);
#        } elsif ($opts->{capture_merged}) {
#            require Capture::Tiny;
#            ${ $opts->{capture_merged} } =
#                &Capture::Tiny::capture_merged($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') {
#
#        if ($opts->{log} || $opts->{dry_run}) {
#            if ($opts->{log}) {
#                no strict 'refs';
#                my $routine;
#                my $label = "";
#                if ($opts->{dry_run}) {
#                    $label = "[DRY RUN] ";
#                    $routine = "log_info";
#                } else {
#                    $routine = "log_trace";
#                }
#                $routine->("%ssystem(%s), env=%s", $label, \@args, \%set_env);
#            } else {
#                warn "[DRY RUN] system(".join(", ", @args).")\n";
#            }
#            if ($opts->{dry_run}) {
#                $exit_code = 0;
#                $res = "";
#                goto CHECK_RESULT;
#            }
#        }
#
#        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);
#
#        if ($opts->{log} || $opts->{dry_run}) {
#            if ($opts->{log}) {
#                no strict 'refs';
#                my $routine;
#                my $label = "";
#                if ($opts->{dry_run}) {
#                    $label = "[DRY RUN] ";
#                    $routine = "log_info";
#                } else {
#                    $routine = "log_trace";
#                }
#                $routine->("%sreadpipe(%s), env=%s", $label, $cmd, \%set_env);
#            } else {
#                warn "[DRY RUN] readpipe($cmd)\n";
#            }
#            if ($opts->{dry_run}) {
#                $exit_code = 0;
#                $res = "";
#                goto CHECK_RESULT;
#            }
#        }
#
#        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_trace("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 {
#
#        if ($opts->{log} || $opts->{dry_run}) {
#            if ($opts->{log}) {
#                no strict 'refs';
#                my $routine;
#                my $label = "";
#                if ($opts->{dry_run}) {
#                    $label = "[DRY RUN] ";
#                    $routine = "log_info";
#                } else {
#                    $routine = "log_trace";
#                }
#                $routine->("%srun(%s), env=%s", $label,
#                           join(", ", @args), \%set_env);
#            } else {
#                warn "[DRY RUN] run(".join(", ", @args).")\n";
#            }
#            if ($opts->{dry_run}) {
#                $exit_code = 0;
#                $res = "";
#                goto CHECK_RESULT;
#            }
#        }
#
#        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 ($cwd) {
#        unless (chdir $cwd) {
#            $log->error("Can't chdir back to '$cwd': $!") if $log;
#            $exit_code ||= -1;
#            $os_error = $!;
#            $extra_error = "Can't chdir back";
#            goto CHECK_RESULT;
#        }
#    }
#
#  CHECK_RESULT:
#    if ($exit_code) {
#        if ($opts->{log} || $opt_die) {
#            my $msg = sprintf(
#                "%s(%s) failed: %s (%s)%s%s%s",
#                $which,
#                join(" ", @args),
#                defined $extra_error ? "" : $exit_code,
#                defined $extra_error ? "$extra_error: $os_error" : explain_child_error($exit_code, $os_error),
#                (ref($opts->{capture_stdout}) ?
#                     ", captured stdout: <<" .
#                     (defined ${$opts->{capture_stdout}} ? ${$opts->{capture_stdout}} : ''). ">>" : ""),
#                (ref($opts->{capture_stderr}) ?
#                     ", captured stderr: <<" .
#                     (defined ${$opts->{capture_stderr}} ? ${$opts->{capture_stderr}} : ''). ">>" : ""),
#                (ref($opts->{capture_merged}) ?
#                     ", captured merged: <<" .
#                     (defined ${$opts->{capture_merged}} ? ${$opts->{capture_merged}} : ''). ">>" : ""),
#            );
#            log_error($msg) if $opts->{log};
#            die $msg if $opt_die;
#        }
#    }
#
#    $? = $exit_code;
#
#    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
#
### JSON/PP.pm ###
#package JSON::PP;
#
#
#use 5.005;
#use strict;
#use base qw(Exporter);
#use overload ();
#
#use Carp ();
#use B ();
#
#$JSON::PP::VERSION = '2.27300';
#
#@JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
#
#
#use constant P_ASCII                => 0;
#use constant P_LATIN1               => 1;
#use constant P_UTF8                 => 2;
#use constant P_INDENT               => 3;
#use constant P_CANONICAL            => 4;
#use constant P_SPACE_BEFORE         => 5;
#use constant P_SPACE_AFTER          => 6;
#use constant P_ALLOW_NONREF         => 7;
#use constant P_SHRINK               => 8;
#use constant P_ALLOW_BLESSED        => 9;
#use constant P_CONVERT_BLESSED      => 10;
#use constant P_RELAXED              => 11;
#
#use constant P_LOOSE                => 12;
#use constant P_ALLOW_BIGNUM         => 13;
#use constant P_ALLOW_BAREKEY        => 14;
#use constant P_ALLOW_SINGLEQUOTE    => 15;
#use constant P_ESCAPE_SLASH         => 16;
#use constant P_AS_NONBLESSED        => 17;
#
#use constant P_ALLOW_UNKNOWN        => 18;
#
#use constant OLD_PERL => $] < 5.008 ? 1 : 0;
#
#BEGIN {
#    my @xs_compati_bit_properties = qw(
#            latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
#            allow_blessed convert_blessed relaxed allow_unknown
#    );
#    my @pp_bit_properties = qw(
#            allow_singlequote allow_bignum loose
#            allow_barekey escape_slash as_nonblessed
#    );
#
#    if ($] < 5.008 ) {
#        my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
#        eval qq| require $helper |;
#        if ($@) { Carp::croak $@; }
#    }
#
#    for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
#        my $flag_name = 'P_' . uc($name);
#
#        eval qq/
#            sub $name {
#                my \$enable = defined \$_[1] ? \$_[1] : 1;
#
#                if (\$enable) {
#                    \$_[0]->{PROPS}->[$flag_name] = 1;
#                }
#                else {
#                    \$_[0]->{PROPS}->[$flag_name] = 0;
#                }
#
#                \$_[0];
#            }
#
#            sub get_$name {
#                \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
#            }
#        /;
#    }
#
#}
#
#
#
#
#my %encode_allow_method
#     = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
#                          allow_blessed convert_blessed indent indent_length allow_bignum
#                          as_nonblessed
#                        /;
#my %decode_allow_method
#     = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
#                          allow_barekey max_size relaxed/;
#
#
#my $JSON; 
#
#sub encode_json ($) { 
#    ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
#}
#
#
#sub decode_json { 
#    ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
#}
#
#
#sub to_json($) {
#   Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
#}
#
#
#sub from_json($) {
#   Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
#}
#
#
#
#sub new {
#    my $class = shift;
#    my $self  = {
#        max_depth   => 512,
#        max_size    => 0,
#        indent      => 0,
#        FLAGS       => 0,
#        fallback      => sub { encode_error('Invalid value. JSON can only reference.') },
#        indent_length => 3,
#    };
#
#    bless $self, $class;
#}
#
#
#sub encode {
#    return $_[0]->PP_encode_json($_[1]);
#}
#
#
#sub decode {
#    return $_[0]->PP_decode_json($_[1], 0x00000000);
#}
#
#
#sub decode_prefix {
#    return $_[0]->PP_decode_json($_[1], 0x00000001);
#}
#
#
#
#
#
#sub pretty {
#    my ($self, $v) = @_;
#    my $enable = defined $v ? $v : 1;
#
#    if ($enable) { 
#        $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
#    }
#    else {
#        $self->indent(0)->space_before(0)->space_after(0);
#    }
#
#    $self;
#}
#
#
#sub max_depth {
#    my $max  = defined $_[1] ? $_[1] : 0x80000000;
#    $_[0]->{max_depth} = $max;
#    $_[0];
#}
#
#
#sub get_max_depth { $_[0]->{max_depth}; }
#
#
#sub max_size {
#    my $max  = defined $_[1] ? $_[1] : 0;
#    $_[0]->{max_size} = $max;
#    $_[0];
#}
#
#
#sub get_max_size { $_[0]->{max_size}; }
#
#
#sub filter_json_object {
#    $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
#    $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
#    $_[0];
#}
#
#sub filter_json_single_key_object {
#    if (@_ > 1) {
#        $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
#    }
#    $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
#    $_[0];
#}
#
#sub indent_length {
#    if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
#        Carp::carp "The acceptable range of indent_length() is 0 to 15.";
#    }
#    else {
#        $_[0]->{indent_length} = $_[1];
#    }
#    $_[0];
#}
#
#sub get_indent_length {
#    $_[0]->{indent_length};
#}
#
#sub sort_by {
#    $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
#    $_[0];
#}
#
#sub allow_bigint {
#    Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
#}
#
#
#
#
#{ 
#
#    my $max_depth;
#    my $indent;
#    my $ascii;
#    my $latin1;
#    my $utf8;
#    my $space_before;
#    my $space_after;
#    my $canonical;
#    my $allow_blessed;
#    my $convert_blessed;
#
#    my $indent_length;
#    my $escape_slash;
#    my $bignum;
#    my $as_nonblessed;
#
#    my $depth;
#    my $indent_count;
#    my $keysort;
#
#
#    sub PP_encode_json {
#        my $self = shift;
#        my $obj  = shift;
#
#        $indent_count = 0;
#        $depth        = 0;
#
#        my $idx = $self->{PROPS};
#
#        ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
#            $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
#         = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
#                    P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
#
#        ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
#
#        $keysort = $canonical ? sub { $a cmp $b } : undef;
#
#        if ($self->{sort_by}) {
#            $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
#                     : $self->{sort_by} =~ /\D+/       ? $self->{sort_by}
#                     : sub { $a cmp $b };
#        }
#
#        encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
#             if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
#
#        my $str  = $self->object_to_json($obj);
#
#        $str .= "\n" if ( $indent ); 
#
#        unless ($ascii or $latin1 or $utf8) {
#            utf8::upgrade($str);
#        }
#
#        if ($idx->[ P_SHRINK ]) {
#            utf8::downgrade($str, 1);
#        }
#
#        return $str;
#    }
#
#
#    sub object_to_json {
#        my ($self, $obj) = @_;
#        my $type = ref($obj);
#
#        if($type eq 'HASH'){
#            return $self->hash_to_json($obj);
#        }
#        elsif($type eq 'ARRAY'){
#            return $self->array_to_json($obj);
#        }
#        elsif ($type) { 
#            if (blessed($obj)) {
#
#                return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
#
#                if ( $convert_blessed and $obj->can('TO_JSON') ) {
#                    my $result = $obj->TO_JSON();
#                    if ( defined $result and ref( $result ) ) {
#                        if ( refaddr( $obj ) eq refaddr( $result ) ) {
#                            encode_error( sprintf(
#                                "%s::TO_JSON method returned same object as was passed instead of a new one",
#                                ref $obj
#                            ) );
#                        }
#                    }
#
#                    return $self->object_to_json( $result );
#                }
#
#                return "$obj" if ( $bignum and _is_bignum($obj) );
#                return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); 
#
#                encode_error( sprintf("encountered object '%s', but neither allow_blessed "
#                    . "nor convert_blessed settings are enabled", $obj)
#                ) unless ($allow_blessed);
#
#                return 'null';
#            }
#            else {
#                return $self->value_to_json($obj);
#            }
#        }
#        else{
#            return $self->value_to_json($obj);
#        }
#    }
#
#
#    sub hash_to_json {
#        my ($self, $obj) = @_;
#        my @res;
#
#        encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
#                                         if (++$depth > $max_depth);
#
#        my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
#        my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
#
#        for my $k ( _sort( $obj ) ) {
#            if ( OLD_PERL ) { utf8::decode($k) } 
#            push @res, string_to_json( $self, $k )
#                          .  $del
#                          . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
#        }
#
#        --$depth;
#        $self->_down_indent() if ($indent);
#
#        return   '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' )  . '}';
#    }
#
#
#    sub array_to_json {
#        my ($self, $obj) = @_;
#        my @res;
#
#        encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
#                                         if (++$depth > $max_depth);
#
#        my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
#
#        for my $v (@$obj){
#            push @res, $self->object_to_json($v) || $self->value_to_json($v);
#        }
#
#        --$depth;
#        $self->_down_indent() if ($indent);
#
#        return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
#    }
#
#
#    sub value_to_json {
#        my ($self, $value) = @_;
#
#        return 'null' if(!defined $value);
#
#        my $b_obj = B::svref_2object(\$value);  
#        my $flags = $b_obj->FLAGS;
#
#        return $value 
#            if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); 
#
#        my $type = ref($value);
#
#        if(!$type){
#            return string_to_json($self, $value);
#        }
#        elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
#            return $$value == 1 ? 'true' : 'false';
#        }
#        elsif ($type) {
#            if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
#                return $self->value_to_json("$value");
#            }
#
#            if ($type eq 'SCALAR' and defined $$value) {
#                return   $$value eq '1' ? 'true'
#                       : $$value eq '0' ? 'false'
#                       : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
#                       : encode_error("cannot encode reference to scalar");
#            }
#
#             if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
#                 return 'null';
#             }
#             else {
#                 if ( $type eq 'SCALAR' or $type eq 'REF' ) {
#                    encode_error("cannot encode reference to scalar");
#                 }
#                 else {
#                    encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
#                 }
#             }
#
#        }
#        else {
#            return $self->{fallback}->($value)
#                 if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
#            return 'null';
#        }
#
#    }
#
#
#    my %esc = (
#        "\n" => '\n',
#        "\r" => '\r',
#        "\t" => '\t',
#        "\f" => '\f',
#        "\b" => '\b',
#        "\"" => '\"',
#        "\\" => '\\\\',
#        "\'" => '\\\'',
#    );
#
#
#    sub string_to_json {
#        my ($self, $arg) = @_;
#
#        $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
#        $arg =~ s/\//\\\//g if ($escape_slash);
#        $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
#
#        if ($ascii) {
#            $arg = JSON_PP_encode_ascii($arg);
#        }
#
#        if ($latin1) {
#            $arg = JSON_PP_encode_latin1($arg);
#        }
#
#        if ($utf8) {
#            utf8::encode($arg);
#        }
#
#        return '"' . $arg . '"';
#    }
#
#
#    sub blessed_to_json {
#        my $reftype = reftype($_[1]) || '';
#        if ($reftype eq 'HASH') {
#            return $_[0]->hash_to_json($_[1]);
#        }
#        elsif ($reftype eq 'ARRAY') {
#            return $_[0]->array_to_json($_[1]);
#        }
#        else {
#            return 'null';
#        }
#    }
#
#
#    sub encode_error {
#        my $error  = shift;
#        Carp::croak "$error";
#    }
#
#
#    sub _sort {
#        defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
#    }
#
#
#    sub _up_indent {
#        my $self  = shift;
#        my $space = ' ' x $indent_length;
#
#        my ($pre,$post) = ('','');
#
#        $post = "\n" . $space x $indent_count;
#
#        $indent_count++;
#
#        $pre = "\n" . $space x $indent_count;
#
#        return ($pre,$post);
#    }
#
#
#    sub _down_indent { $indent_count--; }
#
#
#    sub PP_encode_box {
#        {
#            depth        => $depth,
#            indent_count => $indent_count,
#        };
#    }
#
#} 
#
#
#sub _encode_ascii {
#    join('',
#        map {
#            $_ <= 127 ?
#                chr($_) :
#            $_ <= 65535 ?
#                sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
#        } unpack('U*', $_[0])
#    );
#}
#
#
#sub _encode_latin1 {
#    join('',
#        map {
#            $_ <= 255 ?
#                chr($_) :
#            $_ <= 65535 ?
#                sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
#        } unpack('U*', $_[0])
#    );
#}
#
#
#sub _encode_surrogates { 
#    my $uni = $_[0] - 0x10000;
#    return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
#}
#
#
#sub _is_bignum {
#    $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
#}
#
#
#
#
#my $max_intsize;
#
#BEGIN {
#    my $checkint = 1111;
#    for my $d (5..64) {
#        $checkint .= 1;
#        my $int   = eval qq| $checkint |;
#        if ($int =~ /[eE]/) {
#            $max_intsize = $d - 1;
#            last;
#        }
#    }
#}
#
#{ 
#
#    my %escapes = ( 
#        b    => "\x8",
#        t    => "\x9",
#        n    => "\xA",
#        f    => "\xC",
#        r    => "\xD",
#        '\\' => '\\',
#        '"'  => '"',
#        '/'  => '/',
#    );
#
#    my $text; 
#    my $at;   
#    my $ch;   
#    my $len;  
#    my $depth;          
#    my $encoding;       
#    my $is_valid_utf8;  
#    my $utf8_len;       
#    my $utf8;           
#    my $max_depth;      
#    my $max_size;
#    my $relaxed;
#    my $cb_object;
#    my $cb_sk_object;
#
#    my $F_HOOK;
#
#    my $allow_bigint;   
#    my $singlequote;    
#    my $loose;          
#    my $allow_barekey;  
#
#
#    sub PP_decode_json {
#        my ($self, $opt); 
#
#        ($self, $text, $opt) = @_;
#
#        ($at, $ch, $depth) = (0, '', 0);
#
#        if ( !defined $text or ref $text ) {
#            decode_error("malformed JSON string, neither array, object, number, string or atom");
#        }
#
#        my $idx = $self->{PROPS};
#
#        ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
#            = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
#
#        if ( $utf8 ) {
#            utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
#        }
#        else {
#            utf8::upgrade( $text );
#            utf8::encode( $text );
#        }
#
#        $len = length $text;
#
#        ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
#             = @{$self}{qw/max_depth  max_size cb_object cb_sk_object F_HOOK/};
#
#        if ($max_size > 1) {
#            use bytes;
#            my $bytes = length $text;
#            decode_error(
#                sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
#                    , $bytes, $max_size), 1
#            ) if ($bytes > $max_size);
#        }
#
#        my @octets = unpack('C4', $text);
#        $encoding =   ( $octets[0] and  $octets[1]) ? 'UTF-8'
#                    : (!$octets[0] and  $octets[1]) ? 'UTF-16BE'
#                    : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
#                    : ( $octets[2]                ) ? 'UTF-16LE'
#                    : (!$octets[2]                ) ? 'UTF-32LE'
#                    : 'unknown';
#
#        white(); 
#
#        my $valid_start = defined $ch; 
#
#        my $result = value();
#
#        return undef if ( !$result && ( $opt & 0x10000000 ) ); 
#
#        decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
#
#        if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
#                decode_error(
#                'JSON text must be an object or array (but found number, string, true, false or null,'
#                       . ' use allow_nonref to allow this)', 1);
#        }
#
#        Carp::croak('something wrong.') if $len < $at; 
#
#        my $consumed = defined $ch ? $at - 1 : $at; 
#
#        white(); 
#
#        if ( $ch ) {
#            return ( $result, $consumed ) if ($opt & 0x00000001); 
#            decode_error("garbage after JSON object");
#        }
#
#        ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
#    }
#
#
#    sub next_chr {
#        return $ch = undef if($at >= $len);
#        $ch = substr($text, $at++, 1);
#    }
#
#
#    sub value {
#        white();
#        return          if(!defined $ch);
#        return object() if($ch eq '{');
#        return array()  if($ch eq '[');
#        return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
#        return number() if($ch =~ /[0-9]/ or $ch eq '-');
#        return word();
#    }
#
#    sub string {
#        my ($i, $s, $t, $u);
#        my $utf16;
#        my $is_utf8;
#
#        ($is_valid_utf8, $utf8_len) = ('', 0);
#
#        $s = ''; 
#
#        if($ch eq '"' or ($singlequote and $ch eq "'")){
#            my $boundChar = $ch;
#
#            OUTER: while( defined(next_chr()) ){
#
#                if($ch eq $boundChar){
#                    next_chr();
#
#                    if ($utf16) {
#                        decode_error("missing low surrogate character in surrogate pair");
#                    }
#
#                    utf8::decode($s) if($is_utf8);
#
#                    return $s;
#                }
#                elsif($ch eq '\\'){
#                    next_chr();
#                    if(exists $escapes{$ch}){
#                        $s .= $escapes{$ch};
#                    }
#                    elsif($ch eq 'u'){ 
#                        my $u = '';
#
#                        for(1..4){
#                            $ch = next_chr();
#                            last OUTER if($ch !~ /[0-9a-fA-F]/);
#                            $u .= $ch;
#                        }
#
#                        if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { 
#                            $utf16 = $u;
#                        }
#                        elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { 
#                            unless (defined $utf16) {
#                                decode_error("missing high surrogate character in surrogate pair");
#                            }
#                            $is_utf8 = 1;
#                            $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
#                            $utf16 = undef;
#                        }
#                        else {
#                            if (defined $utf16) {
#                                decode_error("surrogate pair expected");
#                            }
#
#                            if ( ( my $hex = hex( $u ) ) > 127 ) {
#                                $is_utf8 = 1;
#                                $s .= JSON_PP_decode_unicode($u) || next;
#                            }
#                            else {
#                                $s .= chr $hex;
#                            }
#                        }
#
#                    }
#                    else{
#                        unless ($loose) {
#                            $at -= 2;
#                            decode_error('illegal backslash escape sequence in string');
#                        }
#                        $s .= $ch;
#                    }
#                }
#                else{
#
#                    if ( ord $ch  > 127 ) {
#                        unless( $ch = is_valid_utf8($ch) ) {
#                            $at -= 1;
#                            decode_error("malformed UTF-8 character in JSON string");
#                        }
#                        else {
#                            $at += $utf8_len - 1;
#                        }
#
#                        $is_utf8 = 1;
#                    }
#
#                    if (!$loose) {
#                        if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { 
#                            $at--;
#                            decode_error('invalid character encountered while parsing JSON string');
#                        }
#                    }
#
#                    $s .= $ch;
#                }
#            }
#        }
#
#        decode_error("unexpected end of string while parsing JSON string");
#    }
#
#
#    sub white {
#        while( defined $ch  ){
#            if($ch le ' '){
#                next_chr();
#            }
#            elsif($ch eq '/'){
#                next_chr();
#                if(defined $ch and $ch eq '/'){
#                    1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
#                }
#                elsif(defined $ch and $ch eq '*'){
#                    next_chr();
#                    while(1){
#                        if(defined $ch){
#                            if($ch eq '*'){
#                                if(defined(next_chr()) and $ch eq '/'){
#                                    next_chr();
#                                    last;
#                                }
#                            }
#                            else{
#                                next_chr();
#                            }
#                        }
#                        else{
#                            decode_error("Unterminated comment");
#                        }
#                    }
#                    next;
#                }
#                else{
#                    $at--;
#                    decode_error("malformed JSON string, neither array, object, number, string or atom");
#                }
#            }
#            else{
#                if ($relaxed and $ch eq '#') { 
#                    pos($text) = $at;
#                    $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
#                    $at = pos($text);
#                    next_chr;
#                    next;
#                }
#
#                last;
#            }
#        }
#    }
#
#
#    sub array {
#        my $a  = $_[0] || []; 
#
#        decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
#                                                    if (++$depth > $max_depth);
#
#        next_chr();
#        white();
#
#        if(defined $ch and $ch eq ']'){
#            --$depth;
#            next_chr();
#            return $a;
#        }
#        else {
#            while(defined($ch)){
#                push @$a, value();
#
#                white();
#
#                if (!defined $ch) {
#                    last;
#                }
#
#                if($ch eq ']'){
#                    --$depth;
#                    next_chr();
#                    return $a;
#                }
#
#                if($ch ne ','){
#                    last;
#                }
#
#                next_chr();
#                white();
#
#                if ($relaxed and $ch eq ']') {
#                    --$depth;
#                    next_chr();
#                    return $a;
#                }
#
#            }
#        }
#
#        decode_error(", or ] expected while parsing array");
#    }
#
#
#    sub object {
#        my $o = $_[0] || {}; 
#        my $k;
#
#        decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
#                                                if (++$depth > $max_depth);
#        next_chr();
#        white();
#
#        if(defined $ch and $ch eq '}'){
#            --$depth;
#            next_chr();
#            if ($F_HOOK) {
#                return _json_object_hook($o);
#            }
#            return $o;
#        }
#        else {
#            while (defined $ch) {
#                $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
#                white();
#
#                if(!defined $ch or $ch ne ':'){
#                    $at--;
#                    decode_error("':' expected");
#                }
#
#                next_chr();
#                $o->{$k} = value();
#                white();
#
#                last if (!defined $ch);
#
#                if($ch eq '}'){
#                    --$depth;
#                    next_chr();
#                    if ($F_HOOK) {
#                        return _json_object_hook($o);
#                    }
#                    return $o;
#                }
#
#                if($ch ne ','){
#                    last;
#                }
#
#                next_chr();
#                white();
#
#                if ($relaxed and $ch eq '}') {
#                    --$depth;
#                    next_chr();
#                    if ($F_HOOK) {
#                        return _json_object_hook($o);
#                    }
#                    return $o;
#                }
#
#            }
#
#        }
#
#        $at--;
#        decode_error(", or } expected while parsing object/hash");
#    }
#
#
#    sub bareKey { 
#        my $key;
#        while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
#            $key .= $ch;
#            next_chr();
#        }
#        return $key;
#    }
#
#
#    sub word {
#        my $word =  substr($text,$at-1,4);
#
#        if($word eq 'true'){
#            $at += 3;
#            next_chr;
#            return $JSON::PP::true;
#        }
#        elsif($word eq 'null'){
#            $at += 3;
#            next_chr;
#            return undef;
#        }
#        elsif($word eq 'fals'){
#            $at += 3;
#            if(substr($text,$at,1) eq 'e'){
#                $at++;
#                next_chr;
#                return $JSON::PP::false;
#            }
#        }
#
#        $at--; 
#
#        decode_error("'null' expected")  if ($word =~ /^n/);
#        decode_error("'true' expected")  if ($word =~ /^t/);
#        decode_error("'false' expected") if ($word =~ /^f/);
#        decode_error("malformed JSON string, neither array, object, number, string or atom");
#    }
#
#
#    sub number {
#        my $n    = '';
#        my $v;
#
#        if($ch eq '0'){
#            my $peek = substr($text,$at,1);
#            my $hex  = $peek =~ /[xX]/; 
#
#            if($hex){
#                decode_error("malformed number (leading zero must not be followed by another digit)");
#                ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
#            }
#            else{ 
#                ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
#                if (defined $n and length $n > 1) {
#                    decode_error("malformed number (leading zero must not be followed by another digit)");
#                }
#            }
#
#            if(defined $n and length($n)){
#                if (!$hex and length($n) == 1) {
#                   decode_error("malformed number (leading zero must not be followed by another digit)");
#                }
#                $at += length($n) + $hex;
#                next_chr;
#                return $hex ? hex($n) : oct($n);
#            }
#        }
#
#        if($ch eq '-'){
#            $n = '-';
#            next_chr;
#            if (!defined $ch or $ch !~ /\d/) {
#                decode_error("malformed number (no digits after initial minus)");
#            }
#        }
#
#        while(defined $ch and $ch =~ /\d/){
#            $n .= $ch;
#            next_chr;
#        }
#
#        if(defined $ch and $ch eq '.'){
#            $n .= '.';
#
#            next_chr;
#            if (!defined $ch or $ch !~ /\d/) {
#                decode_error("malformed number (no digits after decimal point)");
#            }
#            else {
#                $n .= $ch;
#            }
#
#            while(defined(next_chr) and $ch =~ /\d/){
#                $n .= $ch;
#            }
#        }
#
#        if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
#            $n .= $ch;
#            next_chr;
#
#            if(defined($ch) and ($ch eq '+' or $ch eq '-')){
#                $n .= $ch;
#                next_chr;
#                if (!defined $ch or $ch =~ /\D/) {
#                    decode_error("malformed number (no digits after exp sign)");
#                }
#                $n .= $ch;
#            }
#            elsif(defined($ch) and $ch =~ /\d/){
#                $n .= $ch;
#            }
#            else {
#                decode_error("malformed number (no digits after exp sign)");
#            }
#
#            while(defined(next_chr) and $ch =~ /\d/){
#                $n .= $ch;
#            }
#
#        }
#
#        $v .= $n;
#
#        if ($v !~ /[.eE]/ and length $v > $max_intsize) {
#            if ($allow_bigint) { 
#                require Math::BigInt;
#                return Math::BigInt->new($v);
#            }
#            else {
#                return "$v";
#            }
#        }
#        elsif ($allow_bigint) {
#            require Math::BigFloat;
#            return Math::BigFloat->new($v);
#        }
#
#        return 0+$v;
#    }
#
#
#    sub is_valid_utf8 {
#
#        $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
#                  : $_[0] =~ /[\xC2-\xDF]/  ? 2
#                  : $_[0] =~ /[\xE0-\xEF]/  ? 3
#                  : $_[0] =~ /[\xF0-\xF4]/  ? 4
#                  : 0
#                  ;
#
#        return unless $utf8_len;
#
#        my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
#
#        return ( $is_valid_utf8 =~ /^(?:
#             [\x00-\x7F]
#            |[\xC2-\xDF][\x80-\xBF]
#            |[\xE0][\xA0-\xBF][\x80-\xBF]
#            |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
#            |[\xED][\x80-\x9F][\x80-\xBF]
#            |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
#            |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
#            |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
#            |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
#        )$/x )  ? $is_valid_utf8 : '';
#    }
#
#
#    sub decode_error {
#        my $error  = shift;
#        my $no_rep = shift;
#        my $str    = defined $text ? substr($text, $at) : '';
#        my $mess   = '';
#        my $type   = $] >= 5.008           ? 'U*'
#                   : $] <  5.006           ? 'C*'
#                   : utf8::is_utf8( $str ) ? 'U*' 
#                   : 'C*'
#                   ;
#
#        for my $c ( unpack( $type, $str ) ) { 
#            $mess .=  $c == 0x07 ? '\a'
#                    : $c == 0x09 ? '\t'
#                    : $c == 0x0a ? '\n'
#                    : $c == 0x0d ? '\r'
#                    : $c == 0x0c ? '\f'
#                    : $c <  0x20 ? sprintf('\x{%x}', $c)
#                    : $c == 0x5c ? '\\\\'
#                    : $c <  0x80 ? chr($c)
#                    : sprintf('\x{%x}', $c)
#                    ;
#            if ( length $mess >= 20 ) {
#                $mess .= '...';
#                last;
#            }
#        }
#
#        unless ( length $mess ) {
#            $mess = '(end of string)';
#        }
#
#        Carp::croak (
#            $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
#        );
#
#    }
#
#
#    sub _json_object_hook {
#        my $o    = $_[0];
#        my @ks = keys %{$o};
#
#        if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
#            my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
#            if (@val == 1) {
#                return $val[0];
#            }
#        }
#
#        my @val = $cb_object->($o) if ($cb_object);
#        if (@val == 0 or @val > 1) {
#            return $o;
#        }
#        else {
#            return $val[0];
#        }
#    }
#
#
#    sub PP_decode_box {
#        {
#            text    => $text,
#            at      => $at,
#            ch      => $ch,
#            len     => $len,
#            depth   => $depth,
#            encoding      => $encoding,
#            is_valid_utf8 => $is_valid_utf8,
#        };
#    }
#
#} 
#
#
#sub _decode_surrogates { 
#    my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
#    my $un  = pack('U*', $uni);
#    utf8::encode( $un );
#    return $un;
#}
#
#
#sub _decode_unicode {
#    my $un = pack('U', hex shift);
#    utf8::encode( $un );
#    return $un;
#}
#
#
#BEGIN {
#
#    unless ( defined &utf8::is_utf8 ) {
#       require Encode;
#       *utf8::is_utf8 = *Encode::is_utf8;
#    }
#
#    if ( $] >= 5.008 ) {
#        *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
#        *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
#        *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
#        *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
#    }
#
#    if ($] >= 5.008 and $] < 5.008003) { 
#        package JSON::PP;
#        require subs;
#        subs->import('join');
#        eval q|
#            sub join {
#                return '' if (@_ < 2);
#                my $j   = shift;
#                my $str = shift;
#                for (@_) { $str .= $j . $_; }
#                return $str;
#            }
#        |;
#    }
#
#
#    sub JSON::PP::incr_parse {
#        local $Carp::CarpLevel = 1;
#        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
#    }
#
#
#    sub JSON::PP::incr_skip {
#        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
#    }
#
#
#    sub JSON::PP::incr_reset {
#        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
#    }
#
#    eval q{
#        sub JSON::PP::incr_text : lvalue {
#            $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
#
#            if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
#                Carp::croak("incr_text can not be called when the incremental parser already started parsing");
#            }
#            $_[0]->{_incr_parser}->{incr_text};
#        }
#    } if ( $] >= 5.006 );
#
#} 
#
#
#
#BEGIN {
#    eval 'require Scalar::Util';
#    unless($@){
#        *JSON::PP::blessed = \&Scalar::Util::blessed;
#        *JSON::PP::reftype = \&Scalar::Util::reftype;
#        *JSON::PP::refaddr = \&Scalar::Util::refaddr;
#    }
#    else{ 
#        eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
#        *JSON::PP::blessed = sub {
#            local($@, $SIG{__DIE__}, $SIG{__WARN__});
#            ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
#        };
#        my %tmap = qw(
#            B::NULL   SCALAR
#            B::HV     HASH
#            B::AV     ARRAY
#            B::CV     CODE
#            B::IO     IO
#            B::GV     GLOB
#            B::REGEXP REGEXP
#        );
#        *JSON::PP::reftype = sub {
#            my $r = shift;
#
#            return undef unless length(ref($r));
#
#            my $t = ref(B::svref_2object($r));
#
#            return
#                exists $tmap{$t} ? $tmap{$t}
#              : length(ref($$r)) ? 'REF'
#              :                    'SCALAR';
#        };
#        *JSON::PP::refaddr = sub {
#          return undef unless length(ref($_[0]));
#
#          my $addr;
#          if(defined(my $pkg = blessed($_[0]))) {
#            $addr .= bless $_[0], 'Scalar::Util::Fake';
#            bless $_[0], $pkg;
#          }
#          else {
#            $addr .= $_[0]
#          }
#
#          $addr =~ /0x(\w+)/;
#          local $^W;
#          hex($1);
#        }
#    }
#}
#
#
#
#$JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
#$JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
#
#sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
#
#sub true  { $JSON::PP::true  }
#sub false { $JSON::PP::false }
#sub null  { undef; }
#
#
#package JSON::PP::Boolean;
#
#use overload (
#   "0+"     => sub { ${$_[0]} },
#   "++"     => sub { $_[0] = ${$_[0]} + 1 },
#   "--"     => sub { $_[0] = ${$_[0]} - 1 },
#   fallback => 1,
#);
#
#
#
#package JSON::PP::IncrParser;
#
#use strict;
#
#use constant INCR_M_WS   => 0; 
#use constant INCR_M_STR  => 1; 
#use constant INCR_M_BS   => 2; 
#use constant INCR_M_JSON => 3; 
#use constant INCR_M_C0   => 4;
#use constant INCR_M_C1   => 5;
#
#$JSON::PP::IncrParser::VERSION = '1.01';
#
#my $unpack_format = $] < 5.006 ? 'C*' : 'U*';
#
#sub new {
#    my ( $class ) = @_;
#
#    bless {
#        incr_nest    => 0,
#        incr_text    => undef,
#        incr_parsing => 0,
#        incr_p       => 0,
#    }, $class;
#}
#
#
#sub incr_parse {
#    my ( $self, $coder, $text ) = @_;
#
#    $self->{incr_text} = '' unless ( defined $self->{incr_text} );
#
#    if ( defined $text ) {
#        if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
#            utf8::upgrade( $self->{incr_text} ) ;
#            utf8::decode( $self->{incr_text} ) ;
#        }
#        $self->{incr_text} .= $text;
#    }
#
#
#    my $max_size = $coder->get_max_size;
#
#    if ( defined wantarray ) {
#
#        $self->{incr_mode} = INCR_M_WS unless defined $self->{incr_mode};
#
#        if ( wantarray ) {
#            my @ret;
#
#            $self->{incr_parsing} = 1;
#
#            do {
#                push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
#
#                unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
#                    $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR;
#                }
#
#            } until ( length $self->{incr_text} >= $self->{incr_p} );
#
#            $self->{incr_parsing} = 0;
#
#            return @ret;
#        }
#        else { 
#            $self->{incr_parsing} = 1;
#            my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
#            $self->{incr_parsing} = 0 if defined $obj; 
#            return $obj ? $obj : undef; 
#        }
#
#    }
#
#}
#
#
#sub _incr_parse {
#    my ( $self, $coder, $text, $skip ) = @_;
#    my $p = $self->{incr_p};
#    my $restore = $p;
#
#    my @obj;
#    my $len = length $text;
#
#    if ( $self->{incr_mode} == INCR_M_WS ) {
#        while ( $len > $p ) {
#            my $s = substr( $text, $p, 1 );
#            $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
#            $self->{incr_mode} = INCR_M_JSON;
#            last;
#       }
#    }
#
#    while ( $len > $p ) {
#        my $s = substr( $text, $p++, 1 );
#
#        if ( $s eq '"' ) {
#            if (substr( $text, $p - 2, 1 ) eq '\\' ) {
#                next;
#            }
#
#            if ( $self->{incr_mode} != INCR_M_STR  ) {
#                $self->{incr_mode} = INCR_M_STR;
#            }
#            else {
#                $self->{incr_mode} = INCR_M_JSON;
#                unless ( $self->{incr_nest} ) {
#                    last;
#                }
#            }
#        }
#
#        if ( $self->{incr_mode} == INCR_M_JSON ) {
#
#            if ( $s eq '[' or $s eq '{' ) {
#                if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
#                    Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
#                }
#            }
#            elsif ( $s eq ']' or $s eq '}' ) {
#                last if ( --$self->{incr_nest} <= 0 );
#            }
#            elsif ( $s eq '#' ) {
#                while ( $len > $p ) {
#                    last if substr( $text, $p++, 1 ) eq "\n";
#                }
#            }
#
#        }
#
#    }
#
#    $self->{incr_p} = $p;
#
#    return if ( $self->{incr_mode} == INCR_M_STR and not $self->{incr_nest} );
#    return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
#
#    return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
#
#    local $Carp::CarpLevel = 2;
#
#    $self->{incr_p} = $restore;
#    $self->{incr_c} = $p;
#
#    my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
#
#    $self->{incr_text} = substr( $self->{incr_text}, $p );
#    $self->{incr_p} = 0;
#
#    return $obj || '';
#}
#
#
#sub incr_text {
#    if ( $_[0]->{incr_parsing} ) {
#        Carp::croak("incr_text can not be called when the incremental parser already started parsing");
#    }
#    $_[0]->{incr_text};
#}
#
#
#sub incr_skip {
#    my $self  = shift;
#    $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
#    $self->{incr_p} = 0;
#}
#
#
#sub incr_reset {
#    my $self = shift;
#    $self->{incr_text}    = undef;
#    $self->{incr_p}       = 0;
#    $self->{incr_mode}    = 0;
#    $self->{incr_nest}    = 0;
#    $self->{incr_parsing} = 0;
#}
#
#
#
#1;
#__END__
### JSON/PP/Boolean.pm ###
#
#use JSON::PP ();
#use strict;
#
#1;
#
#
### LWP/MediaTypes.pm ###
#package LWP::MediaTypes;
#
#require Exporter;
#@ISA = qw(Exporter);
#@EXPORT = qw(guess_media_type media_suffix);
#@EXPORT_OK = qw(add_type add_encoding read_media_types);
#$VERSION = "6.02";
#
#use strict;
#
#
#my %suffixType = (
#    'txt'   => 'text/plain',
#    'html'  => 'text/html',
#    'gif'   => 'image/gif',
#    'jpg'   => 'image/jpeg',
#    'xml'   => 'text/xml',
#);
#
#my %suffixExt = (
#    'text/plain' => 'txt',
#    'text/html'  => 'html',
#    'image/gif'  => 'gif',
#    'image/jpeg' => 'jpg',
#    'text/xml'   => 'xml',
#);
#
#my %suffixEncoding = (
#    'Z'   => 'compress',
#    'gz'  => 'gzip',
#    'hqx' => 'x-hqx',
#    'uu'  => 'x-uuencode',
#    'z'   => 'x-pack',
#    'bz2' => 'x-bzip2',
#);
#
#read_media_types();
#
#
#
#sub guess_media_type
#{
#    my($file, $header) = @_;
#    return undef unless defined $file;
#
#    my $fullname;
#    if (ref($file)) {
#	$file = $file->path;
#    }
#    else {
#	$fullname = $file;  
#    }
#
#    my @encoding = ();
#    my $ct = undef;
#    for (file_exts($file)) {
#	if (exists $suffixEncoding{$_}) {
#	    unshift(@encoding, $suffixEncoding{$_});
#	    next;
#	}
#	if (exists $suffixEncoding{lc $_}) {
#	    unshift(@encoding, $suffixEncoding{lc $_});
#	    next;
#	}
#
#	if (exists $suffixType{$_}) {
#	    $ct = $suffixType{$_};
#	    last;
#	}
#	if (exists $suffixType{lc $_}) {
#	    $ct = $suffixType{lc $_};
#	    last;
#	}
#
#	last;
#    }
#    unless (defined $ct) {
#	if (defined $fullname) {
#	    $ct = (-T $fullname) ? "text/plain" : "application/octet-stream";
#	}
#	else {
#	    $ct = "application/octet-stream";
#	}
#    }
#
#    if ($header) {
#	$header->header('Content-Type' => $ct);
#	$header->header('Content-Encoding' => \@encoding) if @encoding;
#    }
#
#    wantarray ? ($ct, @encoding) : $ct;
#}
#
#
#sub media_suffix {
#    if (!wantarray && @_ == 1 && $_[0] !~ /\*/) {
#	return $suffixExt{lc $_[0]};
#    }
#    my(@type) = @_;
#    my(@suffix, $ext, $type);
#    foreach (@type) {
#	if (s/\*/.*/) {
#	    while(($ext,$type) = each(%suffixType)) {
#		push(@suffix, $ext) if $type =~ /^$_$/i;
#	    }
#	}
#	else {
#	    my $ltype = lc $_;
#	    while(($ext,$type) = each(%suffixType)) {
#		push(@suffix, $ext) if lc $type eq $ltype;
#	    }
#	}
#    }
#    wantarray ? @suffix : $suffix[0];
#}
#
#
#sub file_exts 
#{
#    require File::Basename;
#    my @parts = reverse split(/\./, File::Basename::basename($_[0]));
#    pop(@parts);        
#    @parts;
#}
#
#
#sub add_type 
#{
#    my($type, @exts) = @_;
#    for my $ext (@exts) {
#	$ext =~ s/^\.//;
#	$suffixType{$ext} = $type;
#    }
#    $suffixExt{lc $type} = $exts[0] if @exts;
#}
#
#
#sub add_encoding
#{
#    my($type, @exts) = @_;
#    for my $ext (@exts) {
#	$ext =~ s/^\.//;
#	$suffixEncoding{$ext} = $type;
#    }
#}
#
#
#sub read_media_types 
#{
#    my(@files) = @_;
#
#    local($/, $_) = ("\n", undef);  
#
#    my @priv_files = ();
#    push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
#	if defined $ENV{HOME};  
#
#    my $typefile;
#    unless (@files) {
#	@files = map {"$_/LWP/media.types"} @INC;
#	push @files, @priv_files;
#    }
#    for $typefile (@files) {
#	local(*TYPE);
#	open(TYPE, $typefile) || next;
#	while (<TYPE>) {
#	    next if /^\s*#/; 
#	    next if /^\s*$/; 
#	    s/#.*//;         
#	    my($type, @exts) = split(' ', $_);
#	    add_type($type, @exts);
#	}
#	close(TYPE);
#    }
#}
#
#1;
#
#
#__END__
#
### 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/ger.pm ###
#package Log::ger;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#
#our $re_addr = qr/\(0x([0-9a-f]+)/o;
#
#our %Levels = (
#    fatal   => 1,
#    error   => 2,
#    warn    => 3,
#    info    => 4,
#    debug   => 5,
#    trace   => 6,
#);
#
#our %Level_Aliases = (
#    off => 0,
#    warning => 3,
#);
#
#our $Current_Level = 3;
#
#our $Caller_Depth_Offset = 0;
#
#our $_logger_is_null;
#
#our $_dumper;
#
#our %Global_Hooks;
#
#
#our %Package_Targets; 
#our %Per_Package_Hooks; 
#
#our %Hash_Targets; 
#our %Per_Hash_Hooks; 
#
#our %Object_Targets; 
#our %Per_Object_Hooks; 
#
#my $sub0 = sub {0};
#my $sub1 = sub {1};
#my $default_null_routines = [
#    (map {
#        [$sub0, "log_$_", $Levels{$_}, 'log_sub'],
#            [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "log_is_$_",
#             $Levels{$_}, 'is_sub'],
#        [$sub0, $_, $Levels{$_}, 'log_method'],
#            [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "is_$_",
#             $Levels{$_}, 'is_method'],
#         } keys %Levels),
#];
#
#sub install_routines {
#    my ($target, $target_arg, $routines) = @_;
#
#    if ($target eq 'package') {
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            *{"$target_arg\::$name"} = $code;
#        }
#    } elsif ($target eq 'object') {
#        my $pkg = ref $target_arg;
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_method\z/;
#            *{"$pkg\::$name"} = $code;
#        }
#    } elsif ($target eq 'hash') {
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            $target_arg->{$name} = $code;
#        }
#    }
#}
#
#sub add_target {
#    my ($target, $target_arg, $args, $replace) = @_;
#    $replace = 1 unless defined $replace;
#
#    if ($target eq 'package') {
#        unless ($replace) { return if $Package_Targets{$target_arg} }
#        $Package_Targets{$target_arg} = $args;
#    } elsif ($target eq 'object') {
#        my ($addr) = "$target_arg" =~ $re_addr;
#        unless ($replace) { return if $Object_Targets{$addr} }
#        $Object_Targets{$addr} = [$target_arg, $args];
#    } elsif ($target eq 'hash') {
#        my ($addr) = "$target_arg" =~ $re_addr;
#        unless ($replace) { return if $Hash_Targets{$addr} }
#        $Hash_Targets{$addr} = [$target_arg, $args];
#    }
#}
#
#sub get_logger {
#    my ($package, %args) = @_;
#
#    my $caller = caller(0);
#    $args{category} = $caller if !defined($args{category});
#    my $obj = []; $obj =~ $re_addr;
#    my $pkg = "Log::ger::Obj$1"; bless $obj, $pkg;
#    add_target(object => $obj, \%args);
#    if (keys %Global_Hooks) {
#        require Log::ger::Heavy;
#        init_target(object => $obj, \%args);
#    } else {
#        install_routines(object => $obj, $default_null_routines);
#    }
#    $obj; 
#}
#
#sub import {
#    my ($package, %args) = @_;
#
#    my $caller = caller(0);
#    $args{category} = $caller if !defined($args{category});
#    add_target(package => $caller, \%args);
#    if (keys %Global_Hooks) {
#        require Log::ger::Heavy;
#        init_target(package => $caller, \%args);
#    } else {
#        install_routines(package => $caller, $default_null_routines);
#    }
#}
#
#1;
#
#__END__
#
### Log/ger/App.pm ###
#package Log::ger::App;
#
#our $DATE = '2017-07-14'; 
#our $VERSION = '0.003'; 
#
#
#sub _level_from_env {
#    my $prefix = shift;
#    return $ENV{"${prefix}LOG_LEVEL"} if defined $ENV{"${prefix}LOG_LEVEL"};
#    return 'trace' if $ENV{"${prefix}TRACE"};
#    return 'debug' if $ENV{"${prefix}DEBUG"};
#    return 'info'  if $ENV{"${prefix}VERBOSE"};
#    return 'error' if $ENV{"${prefix}QUIET"};
#    undef;
#}
#
#sub _is_daemon {
#    return $main::IS_DAEMON if defined $main::IS_DAEMON;
#    for (
#        "App/Daemon.pm",
#        "Daemon/Easy.pm",
#        "Daemon/Daemonize.pm",
#        "Daemon/Generic.pm",
#        "Daemonise.pm",
#        "Daemon/Simple.pm",
#        "HTTP/Daemon.pm",
#        "IO/Socket/INET/Daemon.pm",
#        "MooseX/Daemonize.pm",
#        "Net/Daemon.pm",
#        "Net/Server.pm",
#        "Proc/Daemon.pm",
#        "Proc/PID/File.pm",
#        "Win32/Daemon/Simple.pm") {
#        return 1 if $INC{$_};
#    }
#    0;
#}
#
#sub import {
#    my ($pkg, %args) = @_;
#
#    require Log::ger;
#    require Log::ger::Util;
#
#    my $level = $args{level};
#    $level = _level_from_env("") || 'warn' if !defined($level);
#    $Log::ger::Current_Level = Log::ger::Util::numeric_level($level);
#
#    my $is_daemon = $args{daemon};
#    $is_daemon = _is_daemon() if !defined($is_daemon);
#
#    my $is_oneliner = $0 eq '-e';
#
#    my $progname = $args{name};
#    unless (defined $progname) {
#        ($progname = $0) =~ s!.+/!!;
#        $progname =~ s/\.pl$//;
#    }
#    unless (length $progname) {
#        $progname = "prog";
#    }
#
#    my %conf = (
#        outputs => {},
#    );
#
#    unless ($is_daemon) {
#        $conf{outputs}{Screen} = {
#            conf   => { formatter => sub { "$progname: $_[0]" } },
#            level  => _level_from_env("SCREEN_"),
#        };
#    }
#
#    unless ($0 eq '-') {
#        require PERLANCAR::File::HomeDir;
#        my $path = $> ?
#            PERLANCAR::File::HomeDir::get_my_home_dir()."/$progname.log" :
#              "/var/log/$progname.log";
#        $conf{outputs}{File} = {
#            conf   => { path => $path },
#            level  => _level_from_env("FILE_"),
#            layout => [Pattern => {format => '[pid %P] [%d] %m'}],
#        };
#    }
#
#    if ($is_daemon) {
#        $conf{outputs}{Syslog} = {
#            conf => { ident => $progname, facility => 'daemon' },
#            level => _level_from_env("SYSLOG_"),
#        };
#    }
#
#    require Log::ger::Output;
#    Log::ger::Output->set('Composite', %conf);
#}
#
#1;
#
#__END__
#
### Log/ger/Format.pm ###
#package Log::ger::Format;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use parent qw(Log::ger::Plugin);
#
#sub _import_sets_for_current_package { 1 }
#
#1;
#
#__END__
#
### Log/ger/Format/None.pm ###
#package Log::ger::Format::None;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#sub get_hooks {
#    return {
#        create_formatter => [
#            __PACKAGE__, 50,
#            sub {
#                [sub {shift}];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Heavy.pm ###
#package Log::ger::Heavy;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#
#package
#    Log::ger;
#
#
#our %Default_Hooks = (
#    create_formatter => [
#        [__PACKAGE__, 90,
#         sub {
#             my %args = @_;
#
#             my $formatter = sub {
#                 return $_[0] if @_ < 2;
#                 my $fmt = shift;
#                 my @args;
#                 for (@_) {
#                     if (!defined($_)) {
#                         push @args, '<undef>';
#                     } elsif (ref $_) {
#                         require Log::ger::Util unless $_dumper;
#                         push @args, Log::ger::Util::_dump($_);
#                     } else {
#                         push @args, $_;
#                     }
#                 }
#                 sprintf $fmt, @args;
#             };
#             [$formatter];
#         }],
#    ],
#
#    create_layouter => [],
#
#    create_routine_names => [
#        [__PACKAGE__, 90,
#         sub {
#             my %args = @_;
#
#             my $levels = [keys %Levels];
#
#             return [{
#                 log_subs    => [map { ["log_$_", $_]    } @$levels],
#                 is_subs     => [map { ["log_is_$_", $_] } @$levels],
#                 log_methods => [map { ["$_", $_]        } @$levels],
#                 is_methods  => [map { ["is_$_", $_]     } @$levels],
#             }, 1];
#         }],
#    ],
#
#    create_log_routine => [
#        [__PACKAGE__, 10,
#         sub {
#             my %args = @_;
#             my $level = $args{level};
#             if (defined($level) && (
#                 $Current_Level < $level ||
#                     @{ $Global_Hooks{create_log_routine} } == 1)
#             ) {
#                 $_logger_is_null = 1;
#                 return [sub {0}];
#             }
#             [undef]; 
#         }],
#    ],
#
#    create_logml_routine => [],
#
#    create_is_routine => [
#        [__PACKAGE__, 90,
#         sub {
#             my %args = @_;
#             my $level = $args{level};
#             [sub { $Current_Level >= $level }];
#         }],
#    ],
#
#    before_install_routines => [],
#
#    after_install_routines => [],
#);
#
#for my $phase (keys %Default_Hooks) {
#    $Global_Hooks{$phase} = [@{ $Default_Hooks{$phase} }];
#}
#
#sub run_hooks {
#    my ($phase, $hook_args, $flow_control,
#        $target, $target_arg) = @_;
#
#    $Global_Hooks{$phase} or die "Unknown phase '$phase'";
#    my @hooks = @{ $Global_Hooks{$phase} };
#
#    if ($target eq 'package') {
#        unshift @hooks, @{ $Per_Package_Hooks{$target_arg}{$phase} || [] };
#    } elsif ($target eq 'hash') {
#        my ($addr) = "$target_arg" =~ $re_addr;
#        unshift @hooks, @{ $Per_Hash_Hooks{$addr}{$phase} || [] };
#    } elsif ($target eq 'object') {
#        my ($addr) = "$target_arg" =~ $re_addr;
#        unshift @hooks, @{ $Per_Object_Hooks{$addr}{$phase} || [] };
#    }
#
#    my $res;
#    for my $hook (sort {$a->[1] <=> $b->[1]} @hooks)  {
#        my $hook_res = $hook->[2]->(%$hook_args);
#        if (defined $hook_res->[0]) {
#            $res = $hook_res->[0];
#            if (ref $flow_control eq 'CODE') {
#                last if $flow_control->($hook, $hook_res);
#            } else {
#                last if $flow_control;
#            }
#        }
#        last if $hook_res->[1];
#    }
#    return $res;
#}
#
#sub init_target {
#    my ($target, $target_arg, $init_args) = @_;
#
#    my %hook_args = (
#        target     => $target,
#        target_arg => $target_arg,
#        init_args  => $init_args,
#    );
#
#    my %formatters;
#    run_hooks(
#        'create_formatter', \%hook_args,
#        sub {
#            my ($hook, $hook_res) = @_;
#            my ($formatter, $flow_control, $fmtname) = @$hook_res;
#            $fmtname = 'default' if !defined($fmtname);
#            $formatters{$fmtname} ||= $formatter;
#            $flow_control;
#        },
#        $target, $target_arg);
#
#    my $layouter =
#        run_hooks('create_layouter', \%hook_args, 1, $target, $target_arg);
#
#    my $routine_names = {};
#    run_hooks(
#        'create_routine_names', \%hook_args,
#        sub {
#            my ($hook, $hook_res) = @_;
#            my ($rn, $flow_control) = @$hook_res;
#            $rn or return;
#            for (keys %$rn) {
#                push @{ $routine_names->{$_} }, @{ $rn->{$_} };
#            }
#            $flow_control;
#        },
#        $target, $target_arg);
#
#    my @routines;
#    my $object = $target eq 'object';
#
#  CREATE_LOG_ROUTINES:
#    {
#        my @rn;
#        if ($target eq 'package') {
#            push @rn, @{ $routine_names->{log_subs} || [] };
#            push @rn, @{ $routine_names->{logml_subs} || [] };
#        } else {
#            push @rn, @{ $routine_names->{log_methods} || [] };
#            push @rn, @{ $routine_names->{logml_methods} || [] };
#        }
#        my $mllogger0;
#        for my $rn (@rn) {
#            my ($rname, $lname, $fmtname) = @$rn;
#            my $lnum = $Levels{$lname} if defined $lname;
#            my $routine_name_is_ml = !defined($lname);
#            $fmtname = 'default' if !defined($fmtname);
#
#            my $logger;
#            my ($logger0, $logger0_is_ml);
#            $_logger_is_null = 0;
#            for my $phase (qw/create_logml_routine create_log_routine/) {
#                local $hook_args{name} = $rname;
#                local $hook_args{level} = $lnum;
#                local $hook_args{str_level} = $lname;
#                $logger0_is_ml = $phase eq 'create_logml_routine';
#                if ($mllogger0) {
#                    $logger0 = $mllogger0;
#                    last;
#                }
#                $logger0 = run_hooks(
#                    $phase, \%hook_args, 1, $target, $target_arg)
#                    or next;
#                if ($logger0_is_ml) {
#                    $mllogger0 = $logger0;
#                }
#                last;
#            }
#            unless ($logger0) {
#                $_logger_is_null = 1;
#                $logger0 = sub {0};
#            }
#
#            require Log::ger::Util if !$logger0_is_ml && $routine_name_is_ml;
#
#            {
#                if ($_logger_is_null) {
#                    $logger = $logger0;
#                    last;
#                }
#
#                my $formatter = $formatters{$fmtname}
#                    or die "Formatter named '$fmtname' not available";
#                if ($formatter) {
#                    if ($layouter) {
#                        if ($logger0_is_ml) {
#                            if ($routine_name_is_ml) {
#                                if ($object) { $logger = sub { shift; my $lnum=shift; my $lname = Log::ger::Util::string_level($lnum);
#                                                                                      $logger0->($init_args, $lnum, $layouter->($formatter->(@_), $init_args, $lnum, $lname)) };
#                                } else {       $logger = sub {        my $lnum=shift; my $lname = Log::ger::Util::string_level($lnum);
#                                                                                      $logger0->($init_args, $lnum, $layouter->($formatter->(@_), $init_args, $lnum, $lname)) }; }
#                            } else { 
#                                if ($object) { $logger = sub { shift;                 $logger0->($init_args, $lnum, $layouter->($formatter->(@_), $init_args, $lnum, $lname)) };
#                                } else {       $logger = sub {                        $logger0->($init_args, $lnum, $layouter->($formatter->(@_), $init_args, $lnum, $lname)) }; }
#                            }
#                        } else { 
#                            if ($routine_name_is_ml) {
#                                if ($object) { $logger = sub { shift; return 0 if Log::ger::Util::numeric_level(shift) > $Current_Level;
#                                                                                      $logger0->($init_args,        $layouter->($formatter->(@_), $init_args, $lnum, $lname)) };
#                                } else {       $logger = sub {        return 0 if Log::ger::Util::numeric_level(shift) > $Current_Level;
#                                                                                      $logger0->($init_args,        $layouter->($formatter->(@_), $init_args, $lnum, $lname)) }; }
#                            } else { 
#                                if ($object) { $logger = sub { shift;                 $logger0->($init_args,        $layouter->($formatter->(@_), $init_args, $lnum, $lname)) };
#                                } else {       $logger = sub {                        $logger0->($init_args,        $layouter->($formatter->(@_), $init_args, $lnum, $lname)) }; }
#                            }
#                        }
#                    } else { 
#                        if ($logger0_is_ml) {
#                            if ($routine_name_is_ml) {
#                                if ($object) { $logger = sub { shift; my $lnum=shift; $logger0->($init_args, $lnum,             $formatter->(@_)                            ) };
#                                } else {       $logger = sub {        my $lnum=shift; $logger0->($init_args, $lnum,             $formatter->(@_)                            ) }; }
#                            } else { 
#                                if ($object) { $logger = sub { shift;                 $logger0->($init_args, $lnum,             $formatter->(@_)                            ) };
#                                } else {       $logger = sub {                        $logger0->($init_args, $lnum,             $formatter->(@_)                            ) }; }
#                            }
#                        } else { 
#                            if ($routine_name_is_ml) {
#                                if ($object) { $logger = sub { shift; return 0 if Log::ger::Util::numeric_level(shift) > $Current_Level;
#                                                                                      $logger0->($init_args,                    $formatter->(@_)                            ) };
#                                } else {       $logger = sub {        return 0 if Log::ger::Util::numeric_level(shift) > $Current_Level;
#                                                                                      $logger0->($init_args,                    $formatter->(@_)                            ) }; }
#                            } else { 
#                                if ($object) { $logger = sub { shift;                 $logger0->($init_args,                    $formatter->(@_)                            ) };
#                                } else {       $logger = sub {                        $logger0->($init_args,                    $formatter->(@_)                            ) }; }
#                            }
#                        }
#                    }
#                } else { 
#                    { 
#                        if ($logger0_is_ml) {
#                            if ($routine_name_is_ml) {
#                                if ($object) { $logger = sub { shift; my $lnum=shift; $logger0->($init_args, $lnum,                          @_                             ) };
#                                } else {       $logger = sub {        my $lnum=shift; $logger0->($init_args, $lnum,                          @_                             ) }; }
#                            } else { 
#                                if ($object) { $logger = sub { shift;                 $logger0->($init_args, $lnum,                          @_                             ) };
#                                } else {       $logger = sub {                        $logger0->($init_args, $lnum,                          @_                             ) }; }
#                            }
#                        } else { 
#                            if ($routine_name_is_ml) {
#                                if ($object) { $logger = sub { shift; return 0 if Log::ger::Util::numeric_level(shift) > $Current_Level;
#                                                                                      $logger0->($init_args,                                 @_                             ) };
#                                } else {       $logger = sub {        return 0 if Log::ger::Util::numeric_level(shift) > $Current_Level;
#                                                                                      $logger0->($init_args,                                 @_                             ) }; }
#                            } else {
#                                if ($object) { $logger = sub { shift;                 $logger0->($init_args,                                 @_                             ) };
#                                } else {       $logger = sub {                        $logger0->($init_args,                                 @_                             ) }; }
#                            }
#                        }
#                    }
#                }
#            }
#          L1:
#            my $type = $routine_name_is_ml ?
#                ($object ? 'logml_method' : 'logml_sub') :
#                ($object ? 'log_method' : 'log_sub');
#            push @routines, [$logger, $rname, $lnum, $type];
#        }
#    }
#  CREATE_IS_ROUTINES:
#    {
#        my @rn;
#        my $type;
#        if ($target eq 'package') {
#            push @rn, @{ $routine_names->{is_subs} || [] };
#            $type = 'is_sub';
#        } else {
#            push @rn, @{ $routine_names->{is_methods} || [] };
#            $type = 'is_method';
#        }
#        for my $rn (@rn) {
#            my ($rname, $lname) = @$rn;
#            my $lnum = $Levels{$lname};
#
#            local $hook_args{name} = $rname;
#            local $hook_args{level} = $lnum;
#            local $hook_args{str_level} = $lname;
#
#            my $code_is =
#                run_hooks('create_is_routine', \%hook_args, 1,
#                          $target, $target_arg);
#            next unless $code_is;
#            push @routines, [$code_is, $rname, $lnum, $type];
#        }
#    }
#
#    {
#        local $hook_args{routines} = \@routines;
#        local $hook_args{formatters} = \%formatters;
#        local $hook_args{layouter} = $layouter;
#        run_hooks('before_install_routines', \%hook_args, 0,
#                  $target, $target_arg);
#    }
#
#    install_routines($target, $target_arg, \@routines);
#
#    {
#        local $hook_args{routines} = \@routines;
#        run_hooks('after_install_routines', \%hook_args, 0,
#                  $target, $target_arg);
#    }
#}
#
#1;
#
#__END__
#
### Log/ger/Layout.pm ###
#package Log::ger::Layout;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use parent qw(Log::ger::Plugin);
#
#1;
#
#__END__
#
### Log/ger/Layout/Pattern.pm ###
#package Log::ger::Layout::Pattern;
#
#our $DATE = '2017-06-28'; 
#our $VERSION = '0.001'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Log::ger ();
#use Time::HiRes qw(time);
#
#our $caller_depth_offset = 4;
#
#our $time_start = time();
#our $time_now   = $time_start;
#our $time_last  = $time_start;
#
#my @per_message_data;
#
#our %format_for = (
#    'c' => sub { $_[1]{category} },
#    'C' => sub {
#        $per_message_data[0] //= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset)];
#        $per_message_data[1] //= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset-1)];
#        $per_message_data[0][0] // $per_message_data[1][0];
#    },
#    'd' => sub {
#        my @t = localtime($time_now);
#        sprintf(
#            "%04d-%02d-%02dT%02d:%02d:%02d",
#            $t[5]+1900, $t[4]+1, $t[3],
#            $t[2], $t[1], $t[0],
#        );
#    },
#    'D' => sub {
#        my @t = gmtime($time_now);
#        sprintf(
#            "%04d-%02d-%02dT%02d:%02d:%02d",
#            $t[5]+1900, $t[4]+1, $t[3],
#            $t[2], $t[1], $t[0],
#        );
#    },
#    'F' => sub {
#        $per_message_data[0] //= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset)];
#        $per_message_data[1] //= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset-1)];
#        $per_message_data[0][1] // $per_message_data[1][1];
#    },
#    'H' => sub {
#        require Sys::Hostname;
#        Sys::Hostname::hostname();
#    },
#    'l' => sub {
#        $per_message_data[0] ||= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset)];
#        $per_message_data[1] ||= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset-1)];
#        sprintf(
#            "%s (%s:%d)",
#            $per_message_data[0][3] // $per_message_data[1][3],
#            $per_message_data[1][1],
#            $per_message_data[1][2],
#        );
#    },
#    'L' => sub {
#        $per_message_data[1] ||= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset-1)];
#        $per_message_data[1][2];
#    },
#    'm' => sub { $_[0] },
#    'M' => sub {
#        $per_message_data[0] ||= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset)];
#        $per_message_data[1] ||= [caller($Log::ger::Caller_Depth_Offset+$caller_depth_offset-1)];
#        my $sub = $per_message_data[0][3] // $per_message_data[1][3];
#        $sub =~ s/.+:://;
#        $sub;
#    },
#    'n' => sub { "\n" },
#    'p' => sub { $_[3] },
#    'P' => sub { $$ },
#    'r' => sub { sprintf("%.3f", $time_now - $time_start) },
#    'R' => sub { sprintf("%.3f", $time_now - $time_last ) },
#    'T' => sub {
#        $per_message_data[2] //= do {
#            my @st;
#            my $i = $Log::ger::Caller_Depth_Offset+$caller_depth_offset-1;
#            while (my @c = caller($i++)) {
#                push @st, \@c;
#            }
#            \@st;
#        };
#        my $st = '';
#        for my $frame (@{ $per_message_data[2] }) {
#            $st .= "$frame->[3] ($frame->[1]:$frame->[2])\n";
#        }
#        $st;
#    },
#    '%' => sub { '%' },
#);
#
#sub _layout {
#    my $format = shift;
#
#    ($time_last, $time_now) = ($time_now, time());
#    @per_message_data = ();
#
#    $format =~ s/%(.)/
#        exists $format_for{$1} ? $format_for{$1}->(@_) :
#        die("Unknown format '%$1'")/eg;
#    $format;
#}
#
#sub get_hooks {
#    my %conf = @_;
#
#    $conf{format} or die "Please specify format";
#
#    return {
#        create_layouter => [
#            __PACKAGE__, 50,
#            sub {
#                [sub { _layout($conf{format}, @_) }];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Output.pm ###
#package Log::ger::Output;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use parent 'Log::ger::Plugin';
#
#1;
#
#__END__
#
### Log/ger/Output/Array.pm ###
#package Log::ger::Output::Array;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use strict;
#use warnings;
#
#sub get_hooks {
#    my %conf = @_;
#
#    $conf{array} or die "Please specify array";
#
#    return {
#        create_log_routine => [
#            __PACKAGE__, 50,
#            sub {
#                my %args = @_;
#
#                my $logger = sub {
#                    my ($ctx, $msg) = @_;
#                    push @{$conf{array}}, $msg;
#                };
#                [$logger];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Output/Composite.pm ###
#package Log::ger::Output::Composite;
#
#our $DATE = '2017-07-02'; 
#our $VERSION = '0.007'; 
#
#use strict;
#use warnings;
#
#sub _get_min_max_level {
#    my $level = shift;
#    my ($min, $max);
#    if (defined $level) {
#        if (ref $level eq 'ARRAY') {
#            $min = Log::ger::Util::numeric_level($level->[0]);
#            $max = Log::ger::Util::numeric_level($level->[1]);
#            ($min, $max) = ($max, $min) if $min > $max;
#        } else {
#            $min = 0;
#            $max = Log::ger::Util::numeric_level($level);
#        }
#    }
#    ($min, $max);
#}
#
#sub get_hooks {
#    my %conf = @_;
#
#    my @ospecs;
#    {
#        my $outputs = $conf{outputs};
#        for my $oname (sort keys %$outputs) {
#            my $ospec0 = $outputs->{$oname};
#            my @ospecs0;
#            if (ref $ospec0 eq 'ARRAY') {
#                @ospecs0 = map { +{ %{$_} } } @$ospec0;
#            } else {
#                @ospecs0 = (+{ %{ $ospec0 } });
#            }
#
#            die "Invalid output name '$oname'"
#                unless $oname =~ /\A\w+(::\w+)*\z/;
#            my $mod = "Log::ger::Output::$oname";
#            (my $mod_pm = "$mod.pm") =~ s!::!/!g;
#            require $mod_pm;
#            for my $ospec (@ospecs0) {
#                $ospec->{_name} = $oname;
#                $ospec->{_mod} = $mod;
#                push @ospecs, $ospec;
#            }
#        }
#    }
#
#    return {
#        'create_logml_routine' => [
#            __PACKAGE__, 50,
#            sub {
#                no strict 'refs';
#                require Data::Dmp;
#
#                my %args = @_;
#
#                my $target = $args{target};
#                my $target_arg = $args{target_arg};
#
#                my $loggers = [];
#                my $logger_is_ml = [];
#                my $layouters = [];
#                for my $ospec (@ospecs) {
#                    my $oname = $ospec->{_name};
#                    my $mod = "Log::ger::Output::$oname";
#                    my $hooks = &{"$mod\::get_hooks"}(%{ $ospec->{conf} || {} })
#                        or die "Output module $mod does not return any hooks";
#                    my @hook_args = (
#                        target => $args{target},
#                        target_arg => $args{target_arg},
#                        init_args => $args{init_args},
#                    );
#                    my $res;
#                    {
#                        if ($hooks->{create_logml_routine}) {
#                            $res = $hooks->{create_logml_routine}->[2]->(
#                                @hook_args);
#                            if ($res->[0]) {
#                                push @$loggers, $res->[0];
#                                push @$logger_is_ml, 1;
#                                last;
#                            }
#                        }
#                        push @hook_args, (level => 6, str_level => 'trace');
#                        if ($hooks->{create_log_routine}) {
#                            $res = $hooks->{create_log_routine}->[2]->(
#                                @hook_args);
#                            if ($res->[0]) {
#                                push @$loggers, $res->[0];
#                                push @$logger_is_ml, 0;
#                                last;
#                            }
#                        }
#                        die "Output module $mod does not produce logger in ".
#                            "its create_logml_routine nor create_log_routine ".
#                                "hook";
#                    }
#                    if ($ospec->{layout}) {
#                        my $lname = $ospec->{layout}[0];
#                        my $lconf = $ospec->{layout}[1] || {};
#                        my $lmod  = "Log::ger::Layout::$lname";
#                        (my $lmod_pm = "$lmod.pm") =~ s!::!/!g;
#                        require $lmod_pm;
#                        my $lhooks = &{"$lmod\::get_hooks"}(%$lconf)
#                            or die "Layout module $lmod does not return ".
#                            "any hooks";
#                        $lhooks->{create_layouter}
#                            or die "Layout module $mod does not declare ".
#                            "layouter";
#                        my @lhook_args = (
#                            target => $args{target},
#                            target_arg => $args{target_arg},
#                            init_args => $args{init_args},
#                        );
#                        my $lres = $lhooks->{create_layouter}->[2]->(
#                            @lhook_args) or die "Hook from layout module ".
#                                "$lmod does not produce layout routine";
#                        ref $lres->[0] eq 'CODE'
#                            or die "Layouter from layout module $lmod ".
#                            "is not a coderef";
#                        push @$layouters, $lres->[0];
#                    } else {
#                        push @$layouters, undef;
#                    }
#                }
#                unless (@$loggers) {
#                    $Log::err::_logger_is_null = 1;
#                    return [sub {0}];
#                }
#
#                my $varname = do {
#                    my $suffix;
#                    if ($args{target} eq 'package') {
#                        $suffix = $args{target_arg};
#                    } else {
#                        ($suffix) = "$args{target_arg}" =~ /\(0x(\w+)/;
#                    }
#                    "Log::ger::Stash::OComposite_$suffix";
#                };
#                {
#                    no strict 'refs';
#                    ${$varname} = [];
#                    ${$varname}->[0] = $loggers;
#                    ${$varname}->[1] = $layouters;
#                    ${$varname}->[2] = $args{init_args};
#                }
#
#                my $logger;
#                {
#                    my @src;
#                    push @src, "sub {\n";
#                    push @src, "  my (\$ctx, \$lvl, \$msg) = \@_;\n";
#
#                    for my $i (0..$#ospecs) {
#                        my $ospec = $ospecs[$i];
#                        push @src, "  # output #$i: $ospec->{_name}\n";
#                        push @src, "  {\n";
#
#                        if ($ospec->{category_level} || $conf{category_level}) {
#                            push @src, "    my \$cat = \$ctx->{category} || ".
#                                "'';\n";
#
#                            my @cats;
#                            if ($ospec->{category_level}) {
#                                for my $cat (keys %{$ospec->{category_level}}) {
#                                    my $clevel = $ospec->{category_level}{$cat};
#                                    push @cats, [$cat, 1, $clevel];
#                                }
#                            }
#                            if ($conf{category_level}) {
#                                for my $cat (keys %{$conf{category_level}}) {
#                                    my $clevel = $conf{category_level}{$cat};
#                                    push @cats, [$cat, 2, $clevel];
#                                }
#                            }
#
#                            for my $cat (sort {
#                                length($b->[0]) <=> length($a->[0]) ||
#                                    $a->[0] cmp $b->[0] ||
#                                        $a->[1] <=> $b->[1]} @cats) {
#                                push @src, "    if (\$cat eq ".Data::Dmp::dmp($cat->[0])." || index(\$cat, ".Data::Dmp::dmp("$cat->[0]\::").") == 0) { ";
#                                my ($min_level, $max_level) =
#                                    _get_min_max_level($cat->[2]);
#                                push @src, "if (\$lvl >= $min_level && ".
#                                    "\$lvl <= $max_level) { goto L } else { last }";
#                                push @src, " }\n";
#                            }
#                            push @src, "\n";
#                        }
#
#                        my ($min_level, $max_level) = _get_min_max_level(
#                            $ospec->{level});
#                        if (defined $min_level) {
#                            push @src, "    if (\$lvl >= $min_level && ".
#                                "\$lvl <= $max_level) { goto L } else { last }\n";
#                        }
#
#                        push @src, "    if (\$Log::ger::Current_Level >= \$lvl) { goto L } else { last }\n";
#
#                        if ($logger_is_ml->[$i]) {
#                            push @src, "    L: if (\$$varname\->[1][$i]) { \$$varname\->[0][$i]->(\$ctx, \$lvl, \$$varname\->[1][$i]->(\$msg, \$$varname\->[2], \$lvl, Log::ger::Util::string_level(\$lvl))) } else { \$$varname\->[0][$i]->(\$ctx, \$lvl, \$msg) }\n";
#                        } else {
#                            push @src, "    L: if (\$$varname\->[1][$i]) { \$$varname\->[0][$i]->(\$ctx,        \$$varname\->[1][$i]->(\$msg, \$$varname\->[2], \$lvl, Log::ger::Util::string_level(\$lvl))) } else { \$$varname\->[0][$i]->(\$ctx,        \$msg) }\n";
#                        }
#                        push @src, "  }\n";
#                        push @src, "  # end output #$i\n\n";
#                    } 
#
#                    push @src, "};\n";
#                    my $src = join("", @src);
#
#                    $logger = eval $src;
#                }
#                [$logger];
#            }]
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Output/File.pm ###
#package Log::ger::Output::File;
#
#our $DATE = '2017-06-23'; 
#our $VERSION = '0.002'; 
#
#use strict;
#use warnings;
#
#sub get_hooks {
#    my %conf = @_;
#
#    my $fh;
#    if (defined(my $path = $conf{path})) {
#        open $fh, ">>", $path or die "Can't open log file '$path': $!";
#    } elsif ($fh = $conf{handle}) {
#    } else {
#        die "Please specify 'path' or 'handle'";
#    }
#
#    return {
#        create_log_routine => [
#            __PACKAGE__, 50,
#            sub {
#                my %args = @_;
#
#                my $logger = sub {
#                    print $fh $_[1];
#                    print $fh "\n" unless $_[1] =~ /\R\z/;
#                    $fh->flush;
#                };
#                [$logger];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Output/Null.pm ###
#package Log::ger::Output::Null;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#sub get_hooks {
#    return {
#        create_log_routine => [
#            __PACKAGE__, 50,
#            sub {
#                $Log::ger::_logger_is_null = 1;
#                [sub {0}];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Output/Screen.pm ###
#package Log::ger::Output::Screen;
#
#our $DATE = '2017-06-30'; 
#our $VERSION = '0.005'; 
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#my %colors = (
#    1 => "\e[31m"  , 
#    2 => "\e[35m"  , 
#    3 => "\e[1;34m", 
#    4 => "\e[32m"  , 
#    5 => "",         
#    6 => "\e[33m"  , 
#);
#
#sub hook_before_log {
#    my ($ctx, $msg) = @_;
#}
#
#sub hook_after_log {
#    my ($ctx, $msg) = @_;
#    print { $ctx->{_fh} } "\n" unless $msg =~ /\R\z/;
#}
#
#sub get_hooks {
#    my %conf = @_;
#
#    my $stderr = $conf{stderr};
#    $stderr = 1 unless defined $stderr;
#    my $handle = $stderr ? \*STDERR : \*STDOUT;
#    my $use_color = $conf{use_color};
#    $use_color = $ENV{COLOR} unless defined $use_color;
#    $use_color = (-t STDOUT) unless defined $use_color;
#    my $formatter = $conf{formatter};
#
#    return {
#        create_log_routine => [
#            __PACKAGE__, 50,
#            sub {
#                my %args = @_;
#                my $logger = sub {
#                    my $level = $args{level};
#                    my $msg = $_[1];
#                    if ($formatter) {
#                        $msg = $formatter->($msg);
#                    }
#                    hook_before_log({ _fh=>$handle }, $msg);
#                    if ($use_color) {
#                        print $handle $colors{$level}, $msg, "\e[0m";
#                    } else {
#                        print $handle $msg;
#                    }
#                    hook_after_log({ _fh=>$handle }, $msg);
#                };
#                [$logger];
#            }],
#        create_logml_routine => [
#            __PACKAGE__, 50,
#            sub {
#                my %args = @_;
#                my $logger = sub {
#                    my $level = Log::ger::Util::numeric_level($_[1]);
#                    return if $level > $Log::ger::Current_Level;
#                    my $msg = $_[2];
#                    if ($formatter) {
#                        $msg = $formatter->($msg);
#                    }
#                    hook_before_log({ _fh=>$handle }, $msg);
#                    if ($use_color) {
#                        print $handle $colors{$level}, $msg, "\e[0m";
#                    } else {
#                        print $handle $msg;
#                    }
#                    hook_after_log({ _fh=>$handle }, $msg);
#                };
#                [$logger];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Output/String.pm ###
#package Log::ger::Output::String;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use strict;
#use warnings;
#
#sub get_hooks {
#    my %conf = @_;
#
#    $conf{string} or die "Please specify string";
#
#    my $formatter = $conf{formatter};
#    my $append_newline = $conf{append_newline};
#    $append_newline = 1 unless defined $append_newline;
#
#    return {
#        create_log_routine => [
#            __PACKAGE__, 50,
#            sub {
#                my %args = @_;
#                my $level = $args{level};
#                my $logger = sub {
#                    my $msg = $_[1];
#                    if ($formatter) {
#                        $msg = $formatter->($msg);
#                    }
#                    ${ $conf{string} } .= $msg;
#                    ${ $conf{string} } .= "\n"
#                        unless !$append_newline || $msg =~ /\R\z/;
#                };
#                [$logger];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Output/Syslog.pm ###
#package Log::ger::Output::Syslog;
#
#our $DATE = '2017-07-12'; 
#our $VERSION = '0.001'; 
#
#use strict 'subs', 'vars';
#use warnings;
#
#our %level_map = (
#    fatal => 'crit',
#    error => 'err',
#    warn  => 'warning',
#    info  => 'info',
#    debug => 'debug',
#    trace => 'debug',
#);
#
#sub get_hooks {
#    my %conf = @_;
#
#    my $ident = delete($conf{ident});
#    defined($ident) or die "Please specify ident";
#
#    my $facility = $conf{facility} || 'user';
#    $facility =~ /\A(auth|daemon|ftp|mail|user)\z/
#        or die "Invalid value for facility, please choose ".
#        "auth|daemon|ftp|mail|user";
#
#    my $logopt = delete($conf{logopt});
#    $logopt = "pid" unless defined $logopt;
#
#    require Sys::Syslog;
#    Sys::Syslog::openlog($ident, $logopt, $facility) or die;
#
#    return {
#        create_log_routine => [
#            __PACKAGE__, 50,
#            sub {
#                my %args = @_;
#
#                my $str_level = $args{str_level};
#                $level_map{$str_level} or die "Don't know how to map ".
#                    "Log::ger level '$str_level' to syslog level";
#
#                my $logger = sub {
#                    Sys::Syslog::syslog(
#                        &{"Sys::Syslog::LOG_".uc($level_map{$str_level})},
#                        $_[1],
#                    );
#                };
#                [$logger];
#            }],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Plugin.pm ###
#package Log::ger::Plugin;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#sub set {
#    my $pkg = shift;
#
#    my %args;
#    if (ref $_[0] eq 'HASH') {
#        %args = %{shift()};
#    } else {
#        %args = (name => shift, conf => {@_});
#    }
#
#    $args{prefix} ||= $pkg . '::';
#    Log::ger::Util::set_plugin(%args);
#}
#
#sub set_for_current_package {
#    my $pkg = shift;
#
#    my %args;
#    if (ref $_[0] eq 'HASH') {
#        %args = %{shift()};
#    } else {
#        %args = (name => shift, conf => {@_});
#    }
#
#    my $caller = caller(0);
#    $args{target} = 'package';
#    $args{target_arg} = $caller;
#
#    set($pkg, \%args);
#}
#
#sub _import_sets_for_current_package { 0 }
#
#sub import {
#    if (@_ > 1) {
#        if ($_[0]->_import_sets_for_current_package) {
#            goto &set_for_current_package;
#        } else {
#            goto &set;
#        }
#    }
#}
#
#1;
#
#__END__
#
### Log/ger/Plugin/MultilevelLog.pm ###
#package Log::ger::Plugin::MultilevelLog;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use strict;
#use warnings;
#
#use Log::ger::Util;
#
#sub get_hooks {
#    my %conf = @_;
#
#    return {
#        create_routine_names => [
#            __PACKAGE__, 50,
#            sub {
#                return [{
#                    logml_subs    => [[$conf{sub_name}    || 'log', undef]],
#                    logml_methods => [[$conf{method_name} || 'log', undef]],
#                }];
#            },
#        ],
#    };
#}
#
#1;
#
#__END__
#
### Log/ger/Util.pm ###
#package Log::ger::Util;
#
#our $DATE = '2017-07-30'; 
#our $VERSION = '0.020'; 
#
#use strict;
#use warnings;
#
#require Log::ger;
#require Log::ger::Heavy;
#
#sub _dump {
#    unless ($Log::ger::_dumper) {
#        eval {
#            require Data::Dmp;
#            $Data::Dmp::OPT_REMOVE_PRAGMAS = 1;
#            1;
#        };
#        if ($@) {
#            no warnings 'once';
#            require Data::Dumper;
#            $Log::ger::_dumper = sub {
#                local $Data::Dumper::Terse = 1;
#                local $Data::Dumper::Indent = 0;
#                local $Data::Dumper::Useqq = 1;
#                local $Data::Dumper::Deparse = 1;
#                local $Data::Dumper::Quotekeys = 0;
#                local $Data::Dumper::Sortkeys = 1;
#                local $Data::Dumper::Trailingcomma = 1;
#                Data::Dumper::Dumper($_[0]);
#            };
#        } else {
#            $Log::ger::_dumper = sub { Data::Dmp::dmp($_[0]) };
#        }
#    }
#    $Log::ger::_dumper->($_[0]);
#}
#
#sub numeric_level {
#    my $level = shift;
#    return $level if $level =~ /\A\d+\z/;
#    return $Log::ger::Levels{$level}
#        if defined $Log::ger::Levels{$level};
#    return $Log::ger::Level_Aliases{$level}
#        if defined $Log::ger::Level_Aliases{$level};
#    die "Unknown level '$level'";
#}
#
#sub string_level {
#    my $level = shift;
#    return $level if defined $Log::ger::Levels{$level};
#    $level = $Log::ger::Level_Aliases{$level}
#        if defined $Log::ger::Level_Aliases{$level};
#    for (keys %Log::ger::Levels) {
#        my $v = $Log::ger::Levels{$_};
#        return $_ if $v == $level;
#    }
#    die "Unknown level '$level'";
#}
#
#sub set_level {
#    no warnings 'once';
#    $Log::ger::Current_Level = numeric_level(shift);
#    reinit_all_targets();
#}
#
#sub _action_on_hooks {
#    no warnings 'once';
#
#    my ($action, $target, $target_arg, $phase) = splice @_, 0, 4;
#
#    my $hooks = $Log::ger::Global_Hooks{$phase} or die "Unknown phase '$phase'";
#    if ($target eq 'package') {
#        $hooks = ($Log::ger::Per_Package_Hooks{$target_arg}{$phase} ||= []);
#    } elsif ($target eq 'object') {
#        my ($addr) = $target_arg =~ $Log::ger::re_addr;
#        $hooks = ($Log::ger::Per_Object_Hooks{$addr}{$phase} ||= []);
#    } elsif ($target eq 'hash') {
#        my ($addr) = $target_arg =~ $Log::ger::re_addr;
#        $hooks = ($Log::ger::Per_Hash_Hooks{$addr}{$phase} ||= []);
#    }
#
#    if ($action eq 'add') {
#        my $hook = shift;
#        unshift @$hooks, $hook;
#    } elsif ($action eq 'reset') {
#        my $saved = [@$hooks];
#        splice @$hooks, 0, scalar(@$hooks),
#            @{ $Log::ger::Default_Hooks{$phase} };
#        return $saved;
#    } elsif ($action eq 'empty') {
#        my $saved = [@$hooks];
#        splice @$hooks, 0;
#        return $saved;
#    } elsif ($action eq 'save') {
#        return [@$hooks];
#    } elsif ($action eq 'restore') {
#        my $saved = shift;
#        splice @$hooks, 0, scalar(@$hooks), @$saved;
#        return $saved;
#    }
#}
#
#sub add_hook {
#    my ($phase, $hook) = @_;
#    _action_on_hooks('add', '', undef, $phase, $hook);
#}
#
#sub add_per_target_hook {
#    my ($target, $target_arg, $phase, $hook) = @_;
#    _action_on_hooks('add', $target, $target_arg, $phase, $hook);
#}
#
#sub reset_hooks {
#    my ($phase) = @_;
#    _action_on_hooks('reset', '', undef, $phase);
#}
#
#sub reset_per_target_hooks {
#    my ($target, $target_arg, $phase) = @_;
#    _action_on_hooks('reset', $target, $target_arg, $phase);
#}
#
#sub empty_hooks {
#    my ($phase) = @_;
#    _action_on_hooks('empty', '', undef, $phase);
#}
#
#sub empty_per_target_hooks {
#    my ($target, $target_arg, $phase) = @_;
#    _action_on_hooks('empty', $target, $target_arg, $phase);
#}
#
#sub save_hooks {
#    my ($phase) = @_;
#    _action_on_hooks('save', '', undef, $phase);
#}
#
#sub save_per_target_hooks {
#    my ($target, $target_arg, $phase) = @_;
#    _action_on_hooks('save', $target, $target_arg, $phase);
#}
#
#sub restore_hooks {
#    my ($phase, $saved) = @_;
#    _action_on_hooks('restore', '', undef, $phase, $saved);
#}
#
#sub restore_per_target_hooks {
#    my ($target, $target_arg, $phase, $saved) = @_;
#    _action_on_hooks('restore', $target, $target_arg, $phase, $saved);
#}
#
#sub reinit_target {
#    my ($target, $target_arg) = @_;
#
#    Log::ger::add_target($target, $target_arg, {}, 0);
#
#    if ($target eq 'package') {
#        my $init_args = $Log::ger::Package_Targets{$target_arg};
#        Log::ger::init_target(package => $target_arg, $init_args);
#    } elsif ($target eq 'object') {
#        my ($obj_addr) = $target_arg =~ $Log::ger::re_addr
#            or die "Invalid object '$target_arg': not a reference";
#        my $v = $Log::ger::Object_Targets{$obj_addr}
#            or die "Unknown object target '$target_arg'";
#        Log::ger::init_target(object => $v->[0], $v->[1]);
#    } elsif ($target eq 'hash') {
#        my ($hash_addr) = $target_arg =~ $Log::ger::re_addr
#            or die "Invalid hashref '$target_arg': not a reference";
#        my $v = $Log::ger::Hash_Targets{$hash_addr}
#            or die "Unknown hash target '$target_arg'";
#        Log::ger::init_target(hash => $v->[0], $v->[1]);
#    } else {
#        die "Unknown target '$target'";
#    }
#}
#
#sub reinit_all_targets {
#    for my $pkg (keys %Log::ger::Package_Targets) {
#        Log::ger::init_target(
#            package => $pkg, $Log::ger::Package_Targets{$pkg});
#    }
#    for my $k (keys %Log::ger::Object_Targets) {
#        my ($obj, $init_args) = @{ $Log::ger::Object_Targets{$k} };
#        Log::ger::init_target(object => $obj, $init_args);
#    }
#    for my $k (keys %Log::ger::Hash_Targets) {
#        my ($hash, $init_args) = @{ $Log::ger::Hash_Targets{$k} };
#        Log::ger::init_target(hash => $hash, $init_args);
#    }
#}
#
#sub set_plugin {
#    no strict 'refs';
#
#    my %args = @_;
#
#    my $hooks;
#    if ($args{hooks}) {
#        $hooks = $args{hooks};
#    } else {
#        my $prefix = $args{prefix} || 'Log::ger::Plugin::';
#        my $mod = $args{name};
#        $mod = $prefix . $mod unless index($mod, $prefix) == 0;
#        (my $mod_pm = "$mod.pm") =~ s!::!/!g;
#        require $mod_pm;
#        $hooks = &{"$mod\::get_hooks"}(%{ $args{conf} || {} });
#    }
#
#    for my $phase (keys %$hooks) {
#        my $hook = $hooks->{$phase};
#        if (defined $args{target}) {
#            add_per_target_hook(
#                $args{target}, $args{target_arg}, $phase, $hook);
#        } else {
#            add_hook($phase, $hook);
#        }
#    }
#
#    my $reinit = $args{reinit};
#    $reinit = 1 unless defined $reinit;
#    if ($reinit) {
#        if (defined $args{target}) {
#            reinit_target($args{target}, $args{target_arg});
#        } else {
#            reinit_all_targets();
#        }
#    }
#}
#
#1;
#
#__END__
#
### Mo.pm ###
#package Mo;
#$Mo::VERSION = '0.40';
#$VERSION='0.40';
#no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};@_=(default,@_)if!($#_%2);$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};
### Mo/Golf.pm ###
#
#use strict;
#use warnings;
#package Mo::Golf;
#
#our $VERSION='0.40';
#
#use PPI;
#
#my %short_names = (
#    (
#        map {($_, substr($_, 0, 1))}
#        qw(
#            args builder class default exports features
#            generator import is_lazy method MoPKG name
#            nonlazy_defaults options reftype self
#        )
#    ),
#    build_subs => 'B',
#    old_constructor => 'C',
#    caller_pkg => 'P',
#);
#
#my %short_barewords = ( EAGERINIT => q{':E'}, NONLAZY => q{':N'} );
#
#my %hands_off = map {($_,1)} qw'&import *import';
#
#sub import {
#    return unless @_ == 2 and $_[1] eq 'golf';
#    binmode STDOUT;
#    my $text = do { local $/; <> };
#    print STDOUT golf( $text );
#};
#
#sub golf {
#    my ( $text ) = @_;
#
#    my $tree = PPI::Document->new( \$text );
#
#    my %finder_subs = _finder_subs();
#
#    my @order = qw( comments duplicate_whitespace whitespace trailing_whitespace );
#
#    for my $name ( @order ) {
#        my $elements = $tree->find( $finder_subs{$name} );
#        die $@ if !defined $elements;
#        $_->delete for @{ $elements || [] };
#    }
#
#    $tree->find( $finder_subs{$_} )
#      for qw( del_superfluous_concat del_last_semicolon_in_block separate_version shorten_var_names shorten_barewords );
#    die $@ if $@;
#
#    for my $name ( 'double_semicolon' ) {
#        my $elements = $tree->find( $finder_subs{$name} );
#        die $@ if !defined $elements;
#        $_->delete for @{ $elements || [] };
#    }
#
#    return $tree->serialize . "\n";
#}
#
#sub tok { "PPI::Token::$_[0]" }
#
#sub _finder_subs {
#    return (
#        comments => sub { $_[1]->isa( tok 'Comment' ) },
#
#        duplicate_whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#
#            $current->set_content(' ') if 1 < length $current->content;
#
#            return 0 if !$current->next_token;
#            return 0 if !$current->next_token->isa( tok 'Whitespace' );
#            return 1;
#        },
#
#        whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#            my $prev = $current->previous_token;
#            my $next = $current->next_token;
#
#            return 1 if $prev->isa( tok 'Number' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Word' )   and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Symbol' ) and $next->isa( tok 'Operator' ) and $next->content =~ /^\W/; 
#
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Single' ) and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Quote::Double' ) and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Symbol' )        and $next->content =~ /^\W/; 
#            return 1 if $prev->isa( tok 'Operator' ) and $next->isa( tok 'Structure' )     and $next->content =~ /^\W/; 
#
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Symbol' );           
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Structure' );        
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Quote::Double' );    
#            return 1 if $prev->isa( tok 'Symbol' )     and $next->isa( tok 'Structure' );        
#            return 1 if $prev->isa( tok 'ArrayIndex' ) and $next->isa( tok 'Operator' );         
#            return 1 if $prev->isa( tok 'Word' )       and $next->isa( tok 'Cast' );             
#            return 0;
#        },
#
#        trailing_whitespace => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Whitespace' );
#            my $prev = $current->previous_token;
#
#            return 1 if $prev->isa( tok 'Structure' );                                           
#            return 1 if $prev->isa( tok 'Operator' ) and $prev->content =~ /\W$/;                
#            return 1 if $prev->isa( tok 'Quote::Double' );                                       
#            return 1 if $prev->isa( tok 'Quote::Single' );                                       
#
#            return 0;
#        },
#
#        double_semicolon => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Structure' );
#            return 0 if $current->content ne ';';
#
#            my $prev = $current->previous_token;
#
#            return 0 if !$prev->isa( tok 'Structure' );
#            return 0 if $prev->content ne ';';
#
#            return 1;
#        },
#
#        del_last_semicolon_in_block => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( 'PPI::Structure::Block' );
#
#            my $last = $current->last_token;
#
#            return 0 if !$last->isa( tok 'Structure' );
#            return 0 if $last->content ne '}';
#
#            my $maybe_semi = $last->previous_token;
#
#            return 0 if !$maybe_semi->isa( tok 'Structure' );
#            return 0 if $maybe_semi->content ne ';';
#
#            $maybe_semi->delete;
#
#            return 1;
#        },
#
#        del_superfluous_concat => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Operator' );
#
#            my $prev = $current->previous_token;
#            my $next = $current->next_token;
#
#            return 0 if $current->content ne '.';
#            return 0 if !$prev->isa( tok 'Quote::Double' );
#            return 0 if !$next->isa( tok 'Quote::Double' );
#
#            $current->delete;
#            $prev->set_content( $prev->{separator} . $prev->string . $next->string . $prev->{separator} );
#            $next->delete;
#
#            return 1;
#        },
#
#        separate_version => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( 'PPI::Statement' );
#
#            my $first = $current->first_token;
#            return 0 if $first->content ne '$VERSION';
#
#            $current->$_( PPI::Token::Whitespace->new( "\n" ) ) for qw( insert_before insert_after );
#
#            return 1;
#        },
#
#        shorten_var_names => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Symbol' );
#
#            my $long_name = $current->canonical;
#
#            return 1 if $hands_off{$long_name};
#            (my $name = $long_name) =~ s/^([\$\@\%])// or die $long_name;
#            my $sigil = $1;
#            die "variable $long_name conflicts with shortened var name"
#                if grep {
#                    $name eq $_
#                } values %short_names;
#
#            my $short_name = $short_names{$name};
#            $current->set_content( "$sigil$short_name" ) if $short_name;
#
#            return 1;
#        },
#
#        shorten_barewords => sub {
#            my ( $top, $current ) = @_;
#            return 0 if !$current->isa( tok 'Word' );
#
#            my $name = $current->content;
#
#            die "bareword $name conflicts with shortened bareword"
#                if grep {
#                    $name eq $_
#                } values %short_barewords;
#
#            my $short_name = $short_barewords{$name};
#            $current->set_content( $short_name ) if $short_name;
#
#            return 1;
#        },
#    );
#}
#
### Mo/Inline.pm ###
#
#package Mo::Inline;
#use Mo;
#
#our $VERSION='0.40';
#
#use IO::All;
#
#my $matcher = qr/((?m:^#\s*use Mo(\s.*)?;.*\n))(?:#.*\n)*(?:.{400,}\n)?/;
#
#sub run {
#    my $self = shift;
#    my @files;
#    if (not @_ and -d 'lib') {
#        print "Searching the 'lib' directory for a Mo to inline:\n";
#        @_ = 'lib';
#    }
#    if (not @_ or @_ == 1 and $_[0] =~ /^(?:-\?|-h|--help)$/) {
#        print usage();
#        return 0;
#    }
#    for my $name (@_) {
#        die "No file or directory called '$name'"
#            unless -e $name;
#        die "'$name' is not a Perl module"
#            if -f $name and $name !~ /\.pm$/;
#        if (-f $name) {
#            push @files, $name;
#        }
#        elsif (-d $name) {
#            push @_, grep /\.pm$/, map { "$_" } io($name)->All_Files;
#        }
#    }
#
#    die "No .pm files specified"
#        unless @files;
#
#    for my $file (@files) {
#        my $text = io($file)->all;
#        if ($text !~ $matcher) {
#            print "Ignoring $file - No Mo to Inline!\n";
#            next;
#        }
#        $self->inline($file, 1);
#    }
#}
#
#sub inline {
#    my ($self, $file, $noisy) = @_;
#    my $text = io($file)->all;
#    $text =~ s/$matcher/"$1" . &inliner($2)/eg;
#    io($file)->print($text);
#    print "Mo Inlined $file\n"
#        if $noisy;
#}
#
#sub inliner {
#    my $mo = shift;
#    require Mo;
#    my @features = grep {$_ ne 'qw'} ($mo =~ /(\w+)/g);
#    for (@features) {
#        eval "require Mo::$_; 1" or die $@;
#    }
#    my $inline = '';
#    $inline .= $_ for map {
#        my $module = $_;
#        $module .= '.pm';
#        my @lines = io($INC{$module})->chomp->getlines;
#        $lines[-1];
#    } ('Mo', map { s!::!/!g; "Mo/$_" } @features);
#    return <<"...";
##   The following line of code was produced from the previous line by
##   Mo::Inline version $VERSION
#$inline\@f=qw[@features];use strict;use warnings;
#...
#}
#
#sub usage {
#    <<'...';
#Usage: mo-linline <perl module files or directories>
#
#...
#}
#
#1;
#
### Mo/Moose.pm ###
#package Mo::Moose;
#$Mo::Moose::VERSION = '0.40';$M="Mo::";
#$VERSION='0.40';
#*{$M.'Moose::e'}=sub{my($P,$e)=@_;$P=~s/::$//;%$e=(M=>1);require Moose;Moose->import({into=>$P});Moose::Util::MetaRole::apply_metaroles(for=>$P,class_metaroles=>{attribute=>['Attr::Trait']},)};BEGIN{package Attr::Trait;
#$Attr::Trait::VERSION = '0.40';use Moose::Role;around _process_options=>sub{my$orig=shift;my$c=shift;my($n,$o)=@_;$o->{is}||='rw';$o->{lazy}||=1 if defined$o->{default}or defined$o->{builder};$c->$orig(@_)};$INC{'Attr/Trait.pm'}=1}
### Mo/Mouse.pm ###
#package Mo::Mouse;
#$Mo::Mouse::VERSION = '0.40';$M="Mo::";
#$VERSION='0.40';
#*{$M.'Mouse::e'}=sub{my($P,$e)=@_;$P=~s/::$//;%$e=(M=>1);require Mouse;require Mouse::Util::MetaRole;Mouse->import({into=>$P});Mouse::Util::MetaRole::apply_metaroles(for=>$P,class_metaroles=>{attribute=>['Attr::Trait']},)};BEGIN{package Attr::Trait;
#$Attr::Trait::VERSION = '0.40';use Mouse::Role;around _process_options=>sub{my$orig=shift;my$c=shift;my($n,$o)=@_;$o->{is}||='rw';$o->{lazy}||=1 if defined$o->{default}or defined$o->{builder};$c->$orig(@_)};$INC{'Attr/Trait.pm'}=1}
### Mo/build.pm ###
#package Mo::build;
#$Mo::build::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'build::e'}=sub{my($P,$e)=@_;$e->{new}=sub{$c=shift;my$s=&{$M.Object::new}($c,@_);my@B;do{@B=($c.::BUILD,@B)}while($c)=@{$c.::ISA};exists&$_&&&$_($s)for@B;$s}};
### Mo/builder.pm ###
#package Mo::builder;
#$Mo::builder::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=\&{$P.$b}and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};
### Mo/chain.pm ###
#package Mo::chain;
#$Mo::chain::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'chain::e'}=sub{my($P,$e,$o)=@_;$o->{chain}=sub{my($m,$n,%a)=@_;$a{chain}or return$m;sub{$#_?($m->(@_),return$_[0]):$m->(@_)}}};
### Mo/coerce.pm ###
#package Mo::coerce;
#$Mo::coerce::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'coerce::e'}=sub{my($P,$e,$o)=@_;$o->{coerce}=sub{my($m,$n,%a)=@_;$a{coerce}or return$m;sub{$#_?$m->($_[0],$a{coerce}->($_[1])):$m->(@_)}};my$C=$e->{new}||*{$M.Object::new}{CODE};$e->{new}=sub{my$s=$C->(@_);$s->$_($s->{$_})for keys%$s;$s}};
### Mo/default.pm ###
#package Mo::default;
#$Mo::default::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;exists$a{default}or return$m;my($d,$r)=$a{default};my$g='HASH'eq($r=ref$d)?sub{+{%$d}}:'ARRAY'eq$r?sub{[@$d]}:'CODE'eq$r?$d:sub{$d};my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=$g and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$g->(@_):$m->(@_)}}};
### Mo/exporter.pm ###
#package Mo::exporter;
#$Mo::exporter::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'exporter::e'}=sub{my($P)=@_;if(@{$M.EXPORT}){*{$P.$_}=\&{$M.$_}for@{$M.EXPORT}}};
### Mo/import.pm ###
#package Mo::import;
#$Mo::import::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};
### Mo/importer.pm ###
#package Mo::importer;
#$Mo::importer::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'importer::e'}=sub{my($P,$e,$o,$f)=@_;(my$pkg=$P)=~s/::$//;&{$P.'importer'}($pkg,@$f)if defined&{$P.'importer'}};
### Mo/is.pm ###
#package Mo::is;
#$Mo::is::VERSION = '0.40';$M="Mo::";
#$VERSION='0.40';
#*{$M.'is::e'}=sub{my($P,$e,$o)=@_;$o->{is}=sub{my($m,$n,%a)=@_;$a{is}or return$m;sub{$#_&&$a{is}eq'ro'&&caller ne'Mo::coerce'?die$n.' is ro':$m->(@_)}}};
### Mo/nonlazy.pm ###
#package Mo::nonlazy;
#$Mo::nonlazy::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'nonlazy::e'}=sub{${shift().':N'}=1};
### Mo/option.pm ###
#package Mo::option;
#$Mo::option::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'option::e'}=sub{my($P,$e,$o)=@_;$o->{option}=sub{my($m,$n,%a)=@_;$a{option}or return$m;my$n2=$n;*{$P."read_$n2"}=sub{$_[0]->{$n2}};sub{$#_?$m->(@_):$m->(@_,1);$_[0]}}};
### Mo/required.pm ###
#package Mo::required;
#$Mo::required::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#*{$M.'required::e'}=sub{my($P,$e,$o)=@_;$o->{required}=sub{my($m,$n,%a)=@_;if($a{required}){my$C=*{$P."new"}{CODE}||*{$M.Object::new}{CODE};no warnings 'redefine';*{$P."new"}=sub{my$s=$C->(@_);my%a=@_[1..$#_];die$n." required"if!exists$a{$n};$s}}$m}};
### Mo/xs.pm ###
#package Mo::xs;
#$Mo::xs::VERSION = '0.40';my$M="Mo::";
#$VERSION='0.40';
#require Class::XSAccessor;*{$M.'xs::e'}=sub{my($P,$e,$o,$f)=@_;$P=~s/::$//;$e->{has}=sub{my($n,%a)=@_;Class::XSAccessor->import(class=>$P,accessors=>{$n=>$n})}if!grep!/^xs$/,@$f};
### Module/Installed/Tiny.pm ###
#package Module::Installed::Tiny;
#
#our $DATE = '2016-08-04'; 
#our $VERSION = '0.003'; 
#
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(module_installed module_source);
#
#our $SEPARATOR;
#BEGIN {
#    if ($^O =~ /^(dos|os2)/i) {
#        $SEPARATOR = '\\';
#    } elsif ($^O =~ /^MacOS/i) {
#        $SEPARATOR = ':';
#    } else {
#        $SEPARATOR = '/';
#    }
#}
#
#sub _module_source {
#    my $name_pm = shift;
#
#    for my $entry (@INC) {
#        next unless defined $entry;
#        my $ref = ref($entry);
#        my ($is_hook, @hook_res);
#        if ($ref eq 'ARRAY') {
#            $is_hook++;
#            @hook_res = $entry->[0]->($entry, $name_pm);
#        } elsif (UNIVERSAL::can($entry, 'INC')) {
#            $is_hook++;
#            @hook_res = $entry->INC($name_pm);
#        } elsif ($ref eq 'CODE') {
#            $is_hook++;
#            @hook_res = $entry->($entry, $name_pm);
#        } else {
#            my $path = "$entry$SEPARATOR$name_pm";
#            if (-f $path) {
#                open my($fh), "<", $path
#                    or die "Can't locate $name_pm: $path: $!";
#                local $/;
#                return scalar <$fh>;
#            }
#        }
#
#        if ($is_hook) {
#            next unless @hook_res;
#            my $prepend_ref = shift @hook_res if ref($hook_res[0]) eq 'SCALAR';
#            my $fh          = shift @hook_res if ref($hook_res[0]) eq 'GLOB';
#            my $code        = shift @hook_res if ref($hook_res[0]) eq 'CODE';
#            my $code_state  = shift @hook_res if @hook_res;
#            if ($fh) {
#                my $src = "";
#                local $_;
#                while (!eof($fh)) {
#                    $_ = <$fh>;
#                    if ($code) {
#                        $code->($code, $code_state);
#                    }
#                    $src .= $_;
#                }
#                $src = $$prepend_ref . $src if $prepend_ref;
#                return $src;
#            } elsif ($code) {
#                my $src = "";
#                local $_;
#                while ($code->($code, $code_state)) {
#                    $src .= $_;
#                }
#                $src = $$prepend_ref . $src if $prepend_ref;
#                return $src;
#            }
#        }
#    }
#
#    die "Can't locate $name_pm in \@INC (\@INC contains: ".join(" ", @INC).")";
#}
#
#sub module_source {
#    my $name = shift;
#
#    my $name_pm;
#    if ($name =~ /\A\w+(?:::\w+)*\z/) {
#        ($name_pm = "$name.pm") =~ s!::!$SEPARATOR!g;
#    } else {
#        $name_pm = $name;
#    }
#
#    _module_source $name_pm;
#}
#
#sub module_installed {
#    my $name = shift;
#
#    my $name_pm;
#    if ($name =~ /\A\w+(?:::\w+)*\z/) {
#        ($name_pm = "$name.pm") =~ s!::!$SEPARATOR!g;
#    } else {
#        $name_pm = $name;
#    }
#
#    return 1 if exists $INC{$name_pm};
#
#    if (eval { _module_source $name_pm; 1 }) {
#        1;
#    } else {
#        0;
#    }
#}
#
#1;
#
#__END__
#
### Monkey/Patch/Action.pm ###
#package Monkey::Patch::Action;
#
#use 5.010001;
#use warnings;
#use strict;
#
#our $VERSION = '0.05'; 
#
#use Monkey::Patch::Action::Handle;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(patch_package);
#our %EXPORT_TAGS = (all => \@EXPORT_OK);
#
#sub patch_package {
#    my ($package, $subname, $action, $code, @extra) = @_;
#
#    die "Please specify action" unless $action;
#    if ($action eq 'delete') {
#        die "code not needed for 'delete' action" if $code;
#    } else {
#        die "Please specify code" unless $code;
#    }
#
#    my $name = "$package\::$subname";
#    my $type;
#    if ($action eq 'add') {
#        die "Adding $name: must not already exist" if defined(&$name);
#        $type = 'sub';
#    } elsif ($action eq 'replace') {
#        die "Replacing $name: must already exist" unless defined(&$name);
#        $type = 'sub';
#    } elsif ($action eq 'add_or_replace') {
#        $type = 'sub';
#    } elsif ($action eq 'wrap') {
#        die "Wrapping $name: must already exist" unless defined(&$name);
#        $type = 'wrap';
#    } elsif ($action eq 'delete') {
#        $type = 'delete';
#    } else {
#        die "Unknown action '$action', please use either ".
#            "wrap/add/replace/add_or_replace/delete";
#    }
#
#    my @caller = caller(0);
#
#    Monkey::Patch::Action::Handle->new(
#        package => $package,
#        subname => $subname,
#        extra   => \@extra,
#        patcher => \@caller,
#        code    => $code,
#
#        -type   => $type,
#    );
#}
#
#1;
#
#__END__
#
### Monkey/Patch/Action/Handle.pm ###
#package Monkey::Patch::Action::Handle;
#
#use 5.010;
#use strict;
#use warnings;
#
#use Scalar::Util qw(weaken);
#use Sub::Delete;
#
#our $VERSION = '0.05'; 
#
#my %stacks;
#
#sub __find_previous {
#    my ($stack, $code) = @_;
#    state $empty = sub {};
#
#    for my $i (1..$#$stack) {
#        if ($stack->[$i][1] == $code) {
#            return $stack->[$i-1][2] // $stack->[$i-1][1];
#        }
#    }
#    $empty;
#}
#
#sub new {
#    my ($class, %args) = @_;
#
#    my $type = $args{-type};
#    delete $args{-type};
#
#    my $code = $args{code};
#
#    my $name = "$args{package}::$args{subname}";
#    my $stack;
#    if (!$stacks{$name}) {
#        $stacks{$name} = [];
#        push @{$stacks{$name}}, [sub => \&$name] if defined(&$name);
#    }
#    $stack = $stacks{$name};
#
#    my $self = bless \%args, $class;
#
#    no strict 'refs';
#    no warnings 'redefine';
#    if ($type eq 'sub') {
#        push @$stack, [$type => $code];
#        *$name = $code;
#    } elsif ($type eq 'delete') {
#        $code = sub {};
#        $args{code} = $code;
#        push @$stack, [$type, $code];
#        delete_sub $name;
#    } elsif ($type eq 'wrap') {
#        weaken($self);
#        my $wrapper = sub {
#            my $ctx = {
#                package => $self->{package},
#                subname => $self->{subname},
#                extra   => $self->{extra},
#                orig    => __find_previous($stack, $self->{code}),
#            };
#            unshift @_, $ctx;
#            goto &{$self->{code}};
#        };
#        push @$stack, [$type => $code => $wrapper];
#        *$name = $wrapper;
#    }
#
#    $self;
#}
#
#sub DESTROY {
#    my $self = shift;
#
#    my $name  = "$self->{package}::$self->{subname}";
#    my $stack = $stacks{$name};
#    my $code  = $self->{code};
#
#    for my $i (0..$#$stack) {
#        if($stack->[$i][1] == $code) {
#            if ($stack->[$i+1]) {
#                if ($stack->[$i+1][0] eq 'wrap' &&
#                        ($i == 0 || $stack->[$i-1][0] eq 'delete')) {
#                    my $p = $self->{patcher};
#                    warn "Warning: unapplying patch to $name ".
#                        "(applied in $p->[1]:$p->[2]) before a wrapping patch";
#                }
#            }
#
#            no strict 'refs';
#            if ($i == @$stack-1) {
#                if ($i) {
#                    no warnings 'redefine';
#                    if ($stack->[$i-1][0] eq 'delete') {
#                        delete_sub $name;
#                    } else {
#                        *$name = $stack->[$i-1][2] // $stack->[$i-1][1];
#                    }
#                } else {
#                    delete_sub $name;
#                }
#            }
#            splice @$stack, $i, 1;
#            last;
#        }
#    }
#}
#
#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/File/HomeDir.pm ###
#package PERLANCAR::File::HomeDir;
#
#our $DATE = '2017-01-05'; 
#our $VERSION = '0.05'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       get_my_home_dir
#               );
#
#our $DIE_ON_FAILURE = 0;
#
#sub get_my_home_dir {
#    if ($^O eq 'MSWin32') {
#        return $ENV{HOME} if $ENV{HOME};
#        return $ENV{USERPROFILE} if $ENV{USERPROFILE};
#        return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
#            if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
#    } else {
#        return $ENV{HOME} if $ENV{HOME};
#        my @pw;
#        eval { @pw = getpwuid($>) };
#        return $pw[7] if @pw;
#    }
#
#    if ($DIE_ON_FAILURE) {
#        die "Can't get home directory";
#    } else {
#        return undef;
#    }
#}
#
#sub get_users_home_dir {
#    my ($name) = @_;
#
#    if ($^O eq 'MSWin32') {
#        return undef;
#    } else {
#        if ($name eq getpwuid($<)) {
#            return get_my_home_dir();
#        }
#
#      SCOPE: {
#            my $home = (getpwnam($name))[7];
#            return $home if $home and -d $home;
#        }
#
#        return undef;
#    }
#
#}
#
#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/Access/Lite.pm ###
#package Perinci::Access::Lite;
#
#our $DATE = '2016-09-25'; 
#our $VERSION = '0.14'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Perinci::AccessUtil qw(strip_riap_stuffs_from_res);
#
#sub new {
#    my ($class, %args) = @_;
#    $args{riap_version} //= 1.1;
#    bless \%args, $class;
#}
#
#sub __package_exists {
#    no strict 'refs';
#
#    my $pkg = shift;
#
#    return unless $pkg =~ /\A\w+(::\w+)*\z/;
#    if ($pkg =~ s/::(\w+)\z//) {
#        return !!${$pkg . "::"}{$1 . "::"};
#    } else {
#        return !!$::{$pkg . "::"};
#    }
#}
#
#sub request {
#    no strict 'refs';
#
#    my ($self, $action, $url, $extra) = @_;
#
#
#    $extra //= {};
#
#    my $v = $extra->{v} // 1.1;
#    if ($v ne '1.1' && $v ne '1.2') {
#        return [501, "Riap protocol not supported, must be 1.1 or 1.2"];
#    }
#
#    my $res;
#    if ($url =~ m!\A(?:pl:)?/(\w+(?:/\w+)*)/(\w*)\z!) {
#        my ($mod_uripath, $func) = ($1, $2);
#        (my $pkg = $mod_uripath) =~ s!/!::!g;
#        my $mod_pm = "$mod_uripath.pm";
#
#        my $pkg_exists;
#
#      LOAD:
#        {
#            last if exists $INC{$mod_pm};
#            $pkg_exists = __package_exists($pkg);
#            last LOAD if $pkg =~ /\A(main)\z/;
#            last if $pkg_exists && defined(${"$pkg\::VERSION"});
#            eval { require $mod_pm };
#            return [500, "Can't load module $pkg: $@"] if $@;
#        }
#
#        if ($action eq 'list') {
#            return [501, "Action 'list' not implemented for ".
#                        "non-package entities"]
#                if length($func);
#            no strict 'refs';
#            my $spec = \%{"$pkg\::SPEC"};
#            return [200, "OK (list)", [grep {/\A\w+\z/} sort keys %$spec]];
#        } elsif ($action eq 'info') {
#            my $data = {
#                uri => "$mod_uripath/$func",
#                type => (!length($func) ? "package" :
#                             $func =~ /\A\w+\z/ ? "function" :
#                                 $func =~ /\A[\@\$\%]/ ? "variable" :
#                                     "?"),
#            };
#            return [200, "OK (info)", $data];
#        } elsif ($action eq 'meta' || $action eq 'call') {
#            return [501, "Action 'call' not implemented for package entity"]
#                if !length($func) && $action eq 'call';
#            my $meta;
#            {
#                no strict 'refs';
#                if (length $func) {
#                    $meta = ${"$pkg\::SPEC"}{$func}
#                        or return [
#                            500, "No metadata for '$url' (".
#                                ($pkg_exists ? "package '$pkg' exists, perhaps you mentioned '$pkg' somewhere without actually loading the module, or perhaps '$func' is a typo?" :
#                                     "package '$pkg' doesn't exist, perhaps '$mod_uripath' or '$func' is a typo?") .
#                                ")"];
#                } else {
#                    $meta = ${"$pkg\::SPEC"}{':package'} // {v=>1.1};
#                }
#                $meta->{entity_v}    //= ${"$pkg\::VERSION"};
#                $meta->{entity_date} //= ${"$pkg\::DATE"};
#            }
#
#            require Perinci::Sub::Normalize;
#            $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
#            if ($action eq 'meta') {
#                $meta->{_orig_args_as} = $meta->{args_as};
#                $meta->{args_as} = 'hash';
#                $meta->{_orig_result_naked} = $meta->{result_naked};
#                $meta->{result_naked} = 0;
#                return [200, "OK ($action)", $meta];
#            }
#
#            my $args = { %{$extra->{args} // {}} }; 
#            if ($meta->{features} && $meta->{features}{progress}) {
#                require Progress::Any;
#                $args->{-progress} = Progress::Any->get_indicator;
#            }
#
#            my $aa = $meta->{args_as} // 'hash';
#            my @args;
#            if ($aa =~ /array/) {
#                require Perinci::Sub::ConvertArgs::Array;
#                my $convres = Perinci::Sub::ConvertArgs::Array::convert_args_to_array(
#                    args => $args, meta => $meta,
#                );
#                return $convres unless $convres->[0] == 200;
#                if ($aa =~ /ref/) {
#                    @args = ($convres->[2]);
#                } else {
#                    @args = @{ $convres->[2] };
#                }
#            } elsif ($aa eq 'hashref') {
#                @args = ({ %$args });
#            } else {
#                @args = %$args;
#            }
#
#            {
#                no strict 'refs';
#                $res = &{"$pkg\::$func"}(@args);
#            }
#
#            if ($meta->{result_naked}) {
#                $res = [200, "OK (envelope added by ".__PACKAGE__.")", $res];
#            }
#
#            if (defined $res->[2]) {
#                if ($meta->{result} && $meta->{result}{schema} &&
#                        $meta->{result}{schema}[0] eq 'buf') {
#                    $res->[3]{'x.hint.result_binary'} = 1;
#                }
#            }
#
#        } else {
#            return [501, "Unknown/unsupported action '$action'"];
#        }
#    } elsif ($url =~ m!\Ahttps?:/(/?)!i) {
#        my $is_unix = !$1;
#        my $ht;
#        require JSON;
#        state $json = JSON->new->allow_nonref;
#        if ($is_unix) {
#            require HTTP::Tiny::UNIX;
#            $ht = HTTP::Tiny::UNIX->new;
#        } else {
#            require HTTP::Tiny;
#            $ht = HTTP::Tiny->new;
#        }
#        my %headers = (
#            "x-riap-v" => $self->{riap_version},
#            "x-riap-action" => $action,
#            "x-riap-fmt" => "json",
#            "content-type" => "application/json",
#        );
#        my $args = $extra->{args} // {};
#        for (keys %$extra) {
#            next if /\Aargs\z/;
#            $headers{"x-riap-$_"} = $extra->{$_};
#        }
#        my $htres = $ht->post(
#            $url, {
#                headers => \%headers,
#                content => $json->encode($args),
#            });
#        return [500, "Network error: $htres->{status} - $htres->{reason}"]
#            if $htres->{status} != 200;
#        return [500, "Server error: didn't return JSON (".$htres->{headers}{'content-type'}.")"]
#            unless $htres->{headers}{'content-type'} eq 'application/json';
#        return [500, "Server error: didn't return Riap 1.1 response (".$htres->{headers}{'x-riap-v'}.")"]
#            unless $htres->{headers}{'x-riap-v'} =~ /\A1\.1(\.\d+)?\z/;
#        $res = $json->decode($htres->{content});
#    } else {
#        return [501, "Unsupported scheme or bad URL '$url'"];
#    }
#
#    strip_riap_stuffs_from_res($res);
#}
#
#1;
#
#__END__
#
### Perinci/AccessUtil.pm ###
#package Perinci::AccessUtil;
#
#our $DATE = '2015-09-06'; 
#our $VERSION = '0.06'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use MIME::Base64;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(insert_riap_stuffs_to_res
#                    strip_riap_stuffs_from_res
#                    decode_args_in_riap_req);
#
#sub insert_riap_stuffs_to_res {
#    my ($res, $def_ver, $nmeta, $encode) = @_;
#
#    $res->[3]{'riap.v'} //= $def_ver // 1.1;
#    if ($res->[3]{'riap.v'} >= 1.2) {
#        {
#            last unless $encode // 1;
#            last if $res->[3]{'riap.result_encoding'};
#            if ($nmeta) {
#                last unless $nmeta->{result}{schema} &&
#                    $nmeta->{result}{schema}[0] eq 'buf';
#            }
#            last unless defined($res->[2]) && !ref($res->[2]) &&
#                $res->[2] =~ /[^\x20-\x7f]/;
#            $res->[2] = encode_base64($res->[2], "");
#            $res->[3]{'riap.result_encoding'} = 'base64';
#        }
#    }
#    $res;
#}
#
#sub strip_riap_stuffs_from_res {
#    my $res = shift;
#
#    my $ver = $res->[3]{'riap.v'} // 1.1;
#    return [501, "Riap version returned by server ($ver) is not supported, ".
#                "only recognize v1.1 and v1.2"]
#        unless $ver == 1.1 || $ver == 1.2;
#
#    if ($ver >= 1.2) {
#        for my $k (keys %{$res->[3]}) {
#            next unless $k =~ /\Ariap\./;
#            my $val = $res->[3]{$k};
#            if ($k eq 'riap.v') {
#            } elsif ($k eq 'riap.result_encoding') {
#                return [501, "Unknown result_encoding returned by server ".
#                            "($val), only base64 is supported"]
#                    unless $val eq 'base64';
#                $res->[2] = decode_base64($res->[2]//'');
#            } else {
#                return [501, "Unknown Riap attribute in result metadata ".
#                            "returned by server ($k)"];
#            }
#            delete $res->[3]{$k};
#        }
#    }
#
#    $res;
#}
#
#sub decode_args_in_riap_req {
#    my $req = shift;
#
#    my $v = $req->{v} // 1.1;
#    if ($v >= 1.2) {
#        if ($req->{args}) {
#            my $args = $req->{args};
#            for (keys %$args) {
#                next unless /\A(.+):base64\z/;
#                $args->{$1} = decode_base64($args->{$_});
#                delete $args->{$_};
#            }
#        }
#    }
#    $req;
#}
#
#1;
#
#__END__
#
### Perinci/CmdLine/Base.pm ###
#package Perinci::CmdLine::Base;
#
#our $DATE = '2017-07-22'; 
#our $VERSION = '1.77'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#
#BEGIN {
#    if ($INC{'Perinci/CmdLine/Classic.pm'}) {
#        require Moo; Moo->import;
#    } else {
#        require Mo; Mo->import(qw(build default));
#    }
#}
#
#has actions => (is=>'rw');
#has common_opts => (is=>'rw');
#has completion => (is=>'rw');
#has default_subcommand => (is=>'rw');
#has get_subcommand_from_arg => (is=>'rw', default=>1);
#has auto_abbrev_subcommand => (is=>'rw', default=>1);
#has description => (is=>'rw');
#has exit => (is=>'rw', default=>1);
#has formats => (is=>'rw');
#has default_format => (is=>'rw');
#has pass_cmdline_object => (is=>'rw', default=>0);
#has per_arg_json => (is=>'rw');
#has per_arg_yaml => (is=>'rw');
#has program_name => (
#    is=>'rw',
#    default => sub {
#        my $pn = $ENV{PERINCI_CMDLINE_PROGRAM_NAME};
#        if (!defined($pn)) {
#            $pn = $0; $pn =~ s!.+/!!;
#        }
#        $pn;
#    });
#has riap_version => (is=>'rw', default=>1.1);
#has riap_client => (is=>'rw');
#has riap_client_args => (is=>'rw');
#has subcommands => (is=>'rw');
#has summary => (is=>'rw');
#has tags => (is=>'rw');
#has url => (is=>'rw');
#has log => (is=>'rw', default => 0);
#has log_level => (is=>'rw');
#
#has read_env => (is=>'rw', default=>1);
#has env_name => (
#    is => 'rw',
#    lazy => 1,
#    default => sub {
#        my $self = shift;
#        __default_env_name($self->program_name);
#    },
#);
#
#has read_config => (is=>'rw', default=>1);
#has config_filename => (is=>'rw');
#has config_dirs => (
#    is=>'rw',
#    default => sub {
#        require Perinci::CmdLine::Util::Config;
#        Perinci::CmdLine::Util::Config::get_default_config_dirs();
#    },
#);
#
#has cleanser => (
#    is => 'rw',
#    lazy => 1,
#    default => sub {
#        require Data::Clean::JSON;
#        Data::Clean::JSON->get_cleanser;
#    },
#);
#has use_cleanser => (is=>'rw', default=>1);
#
#has extra_urls_for_version => (is=>'rw');
#
#has skip_format => (is=>'rw');
#
#has use_utf8 => (
#    is=>'rw',
#    default => sub {
#        $ENV{UTF8} // 0;
#    },
#);
#
#has default_dry_run => (
#    is=>'rw',
#    default => 0,
#);
#
#
#
#our %copts = (
#
#    version => {
#        getopt  => "version|v",
#        summary => "Display program's version and exit",
#        usage   => "--version (or -v)",
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{action} = 'version';
#            $r->{skip_parse_subcommand_argv} = 1;
#        },
#    },
#
#    help => {
#        getopt  => 'help|h|?',
#        summary => 'Display help message and exit',
#        usage   => "--help (or -h, -?)",
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{action} = 'help';
#            $r->{skip_parse_subcommand_argv} = 1;
#        },
#        order => 0, 
#    },
#
#    format => {
#        getopt  => 'format=s',
#        summary => 'Choose output format, e.g. json, text',
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{format} = $val;
#        },
#        default => undef,
#        tags => ['category:output'],
#        is_settable_via_config => 1,
#    },
#    json => {
#        getopt  => 'json',
#        summary => 'Set output format to json',
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{format} = (-t STDOUT) ? 'json-pretty' : 'json';
#        },
#        tags => ['category:output'],
#    },
#
#    naked_res => {
#        getopt  => 'naked-res!',
#        summary => 'When outputing as JSON, strip result envelope',
#        'summary.alt.bool.not' => 'When outputing as JSON, add result envelope',
#        description => <<'_',
#
#By default, when outputing as JSON, the full enveloped result is returned, e.g.:
#
#    [200,"OK",[1,2,3],{"func.extra"=>4}]
#
#The reason is so you can get the status (1st element), status message (2nd
#element) as well as result metadata/extra result (4th element) instead of just
#the result (3rd element). However, sometimes you want just the result, e.g. when
#you want to pipe the result for more post-processing. In this case you can use
#`--naked-res` so you just get:
#
#    [1,2,3]
#
#_
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{naked_res} = $val ? 1:0;
#        },
#        default => 0,
#        tags => ['category:output'],
#        is_settable_via_config => 1,
#    },
#
#    subcommands => {
#        getopt  => 'subcommands',
#        summary => 'List available subcommands',
#        usage   => "--subcommands",
#        show_in_usage => sub {
#            my ($self, $r) = @_;
#            !$r->{subcommand_name};
#        },
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{action} = 'subcommands';
#            $r->{skip_parse_subcommand_argv} = 1;
#        },
#    },
#
#    cmd => {
#        getopt  => "cmd=s",
#        summary => 'Select subcommand',
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{subcommand_name} = $val;
#            $r->{subcommand_name_from} = '--cmd';
#        },
#        completion => sub {
#            require Complete::Util;
#            my %args = @_;
#            my $cmdline = $args{cmdline};
#            Complete::Util::complete_array_elem(
#                array => [keys %{ $cmdline->list_subcommands }],
#                word  => $args{word},
#                ci    => 1,
#            );
#        },
#    },
#
#    config_path => {
#        getopt  => 'config-path=s@',
#        schema  => ['array*', of => 'str*'],
#        'x.schema.element_entity' => 'filename',
#        summary => 'Set path to configuration file',
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{config_paths} //= [];
#            push @{ $r->{config_paths} }, $val;
#        },
#        tags => ['category:configuration'],
#    },
#    no_config => {
#        getopt  => 'no-config',
#        summary => 'Do not use any configuration file',
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{read_config} = 0;
#        },
#        tags => ['category:configuration'],
#    },
#    no_env => {
#        getopt  => 'no-env',
#        summary => 'Do not read environment for default options',
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{read_env} = 0;
#        },
#        tags => ['category:environment'],
#    },
#    config_profile => {
#        getopt  => 'config-profile=s',
#        summary => 'Set configuration profile to use',
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{config_profile} = $val;
#        },
#        completion => sub {
#
#            my %args = @_;
#            my $word    = $args{word} // '';
#            my $cmdline = $args{cmdline};
#            my $r       = $args{r};
#
#            return undef unless $cmdline;
#
#            {
#                $r->{read_config} = 1;
#
#                my $res = $cmdline->parse_argv($r);
#
#                $cmdline->_read_config($r) unless $r->{config};
#            }
#
#            return [] unless $r->{config};
#
#            my @profiles;
#            for my $section (keys %{$r->{config}}) {
#                my %keyvals;
#                for my $word (split /\s+/, ($section eq 'GLOBAL' ? '' : $section)) {
#                    if ($word =~ /(.+)=(.*)/) {
#                        $keyvals{$1} = $2;
#                    } else {
#                        $keyvals{subcommand} = $word;
#                    }
#                }
#                if (defined(my $p = $keyvals{profile})) {
#                    push @profiles, $p unless grep {$_ eq $p} @profiles;
#                }
#            }
#
#            require Complete::Util;
#            Complete::Util::complete_array_elem(
#                array=>\@profiles, word=>$word, ci=>1);
#        },
#        tags => ['category:configuration'],
#    },
#
#    log_level => {
#        getopt  => 'log-level=s',
#        summary => 'Set log level',
#        schema  => ['str*' => in => [
#            qw/trace debug info warn warning error fatal/]],
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{log_level} = $val;
#        },
#        is_settable_via_config => 1,
#        tags => ['category:logging'],
#    },
#    trace => {
#        getopt  => "trace",
#        summary => "Shortcut for --log-level=trace",
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{log_level} = 'trace';
#        },
#        tags => ['category:logging'],
#    },
#    debug => {
#        getopt  => "debug",
#        summary => "Shortcut for --log-level=debug",
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{log_level} = 'debug';
#        },
#        tags => ['category:logging'],
#    },
#    verbose => {
#        getopt  => "verbose",
#        summary => "Shortcut for --log-level=info",
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{log_level} = 'info';
#            $r->{_help_verbose} = 1;
#        },
#        tags => ['category:logging'],
#    },
#    quiet => {
#        getopt  => "quiet",
#        summary => "Shortcut for --log-level=error",
#        handler => sub {
#            my ($go, $val, $r) = @_;
#            $r->{log_level} = 'error';
#        },
#        tags => ['category:logging'],
#    },
#
#);
#
#sub __default_env_name {
#    my ($prog) = @_;
#
#    for ($prog) {
#        $_ //= "PROG"; 
#        $_ = uc($_);
#        s/[^A-Z0-9]+/_/g;
#        $_ = "_$_" if /\A\d/;
#    }
#    "${prog}_OPT";
#}
#
#sub hook_before_run {}
#
#sub hook_before_read_config_file {}
#
#sub hook_after_read_config_file {}
#
#sub hook_before_action {}
#
#sub hook_after_action {}
#
#sub get_meta {
#    my ($self, $r, $url) = @_;
#
#    my $res = $self->riap_client->request(meta => $url);
#    die $res unless $res->[0] == 200;
#    my $meta = $res->[2];
#    $r->{meta} = $meta;
#    log_trace("[pericmd] Running hook_after_get_meta ...");
#    $self->hook_after_get_meta($r);
#    $meta;
#}
#
#sub get_program_and_subcommand_name {
#    my ($self, $r) = @_;
#    my $res = ($self->program_name // "") . " " .
#        ($r->{subcommand_name} // "");
#    $res =~ s/\s+$//;
#    $res;
#}
#
#sub get_subcommand_data {
#    my ($self, $name) = @_;
#
#    my $scs = $self->subcommands;
#    return undef unless $scs;
#
#    if (ref($scs) eq 'CODE') {
#        return $scs->($self, name=>$name);
#    } else {
#        return $scs->{$name};
#    }
#}
#
#sub list_subcommands {
#    my ($self) = @_;
#    return $self->{_cache_subcommands} if $self->{_cache_subcommands};
#
#    my $scs = $self->subcommands;
#    my $res;
#    if ($scs) {
#        if (ref($scs) eq 'CODE') {
#            $scs = $scs->($self);
#            die [500, "BUG: Subcommands code didn't return a hashref"]
#                unless ref($scs) eq 'HASH';
#        }
#        $res = $scs;
#    } else {
#        $res = {};
#    }
#    $self->{_cache_subcommands} = $res;
#    $res;
#}
#
#sub status2exitcode {
#    my ($self, $status) = @_;
#    return 0 if $status =~ /^2..|304/;
#    $status - 300;
#}
#
#sub _detect_completion {
#    my ($self, $r) = @_;
#
#    if ($ENV{COMP_SHELL}) {
#        $r->{shell} = $ENV{COMP_SHELL};
#        return 1;
#    } elsif ($ENV{COMP_LINE}) {
#        $r->{shell} = 'bash';
#        return 1;
#    } elsif ($ENV{COMMAND_LINE}) {
#        $r->{shell} = 'tcsh';
#        return 1;
#    }
#
#    $r->{shell} //= 'bash';
#    0;
#}
#
#sub _read_env {
#    my ($self, $r) = @_;
#
#    return [] unless $self->read_env;
#    my $env_name = $self->env_name;
#    my $env = $ENV{$env_name};
#    log_trace("[pericmd] Checking env %s: %s", $env_name, $env);
#    return [] unless defined $env;
#
#
#    my $words;
#    if ($r->{shell} eq 'bash') {
#        require Complete::Bash;
#        ($words, undef) = @{ Complete::Bash::parse_cmdline($env, 0) };
#    } elsif ($r->{shell} eq 'fish') {
#        ($words, undef) = @{ Complete::Base::parse_cmdline($env) };
#    } elsif ($r->{shell} eq 'tcsh') {
#        require Complete::Tcsh;
#        ($words, undef) = @{ Complete::Tcsh::parse_cmdline($env) };
#    } elsif ($r->{shell} eq 'zsh') {
#        require Complete::Bash;
#        ($words, undef) = @{ Complete::Bash::parse_cmdline($env) };
#    } else {
#        die "Unsupported shell '$r->{shell}'";
#    }
#    log_trace("[pericmd] Words from env: %s", $words);
#    $words;
#}
#
#sub do_dump {
#    require Data::Dump;
#
#    my ($self, $r) = @_;
#
#    local $r->{in_dump} = 1;
#
#    $self->_parse_argv1($r);
#
#    if ($r->{read_env}) {
#        my $env_words = $self->_read_env($r);
#        unshift @ARGV, @$env_words;
#    }
#
#    my $scd = $r->{subcommand_data};
#    my $meta = $self->get_meta($r, $scd->{url} // $self->{url});
#
#    my $dump = join(
#        "",
#        "# BEGIN DUMP $ENV{PERINCI_CMDLINE_DUMP}\n",
#        Data::Dump::dump($self), "\n",
#        "# END DUMP $ENV{PERINCI_CMDLINE_DUMP}\n",
#    );
#
#    [200, "OK", $dump,
#     {
#         "cmdline.skip_format" => 1,
#     }];
#}
#
#sub do_completion {
#    my ($self, $r) = @_;
#
#    local $r->{in_completion} = 1;
#
#    my ($words, $cword);
#    if ($r->{shell} eq 'bash') {
#        require Complete::Bash;
#        require Encode;
#        ($words, $cword) = @{ Complete::Bash::parse_cmdline(undef, undef, {truncate_current_word=>1}) };
#        ($words, $cword) = @{ Complete::Bash::join_wordbreak_words($words, $cword) };
#        $words = [map {Encode::decode('UTF-8', $_)} @$words];
#    } elsif ($r->{shell} eq 'fish') {
#        require Complete::Bash;
#        ($words, $cword) = @{ Complete::Bash::parse_cmdline() };
#    } elsif ($r->{shell} eq 'tcsh') {
#        require Complete::Tcsh;
#        ($words, $cword) = @{ Complete::Tcsh::parse_cmdline() };
#    } elsif ($r->{shell} eq 'zsh') {
#        require Complete::Bash;
#        ($words, $cword) = @{ Complete::Bash::parse_cmdline() };
#    } else {
#        die "Unsupported shell '$r->{shell}'";
#    }
#
#    shift @$words; $cword--; 
#
#    @ARGV = @$words;
#
#    $self->_parse_argv1($r);
#
#    if ($r->{read_env}) {
#        my $env_words = $self->_read_env($r);
#        unshift @ARGV, @$env_words;
#        $cword += @$env_words;
#    }
#
#
#    $r->{format} = 'text';
#
#    my $scd = $r->{subcommand_data};
#    my $meta = $self->get_meta($r, $scd->{url} // $self->{url});
#
#    my $subcommand_name_from = $r->{subcommand_name_from} // '';
#
#    require Perinci::Sub::Complete;
#    my $compres = Perinci::Sub::Complete::complete_cli_arg(
#        meta            => $meta, 
#        words           => $words,
#        cword           => $cword,
#        common_opts     => $self->common_opts,
#        riap_server_url => $scd->{url},
#        riap_uri        => undef,
#        riap_client     => $self->riap_client,
#        extras          => {r=>$r, cmdline=>$self},
#        func_arg_starts_at => ($subcommand_name_from eq 'arg' ? 1:0),
#        completion      => sub {
#            my %args = @_;
#            my $type = $args{type};
#
#            if ($self->completion) {
#                my $res = $self->completion(%args);
#                return $res if $res;
#            }
#            if ($self->subcommands &&
#                    $subcommand_name_from ne '--cmd' &&
#                         $type eq 'arg' && $args{argpos}==0) {
#                require Complete::Util;
#                return Complete::Util::complete_array_elem(
#                    array => [keys %{ $self->list_subcommands }],
#                    word  => $words->[$cword]);
#            }
#
#            return undef;
#        },
#    );
#
#    my $formatted;
#    if ($r->{shell} eq 'bash') {
#        require Complete::Bash;
#        $formatted = Complete::Bash::format_completion(
#            $compres, {word=>$words->[$cword]});
#    } elsif ($r->{shell} eq 'fish') {
#        require Complete::Fish;
#        $formatted = Complete::Fish::format_completion($compres);
#    } elsif ($r->{shell} eq 'tcsh') {
#        require Complete::Tcsh;
#        $formatted = Complete::Tcsh::format_completion($compres);
#    } elsif ($r->{shell} eq 'zsh') {
#        require Complete::Zsh;
#        $formatted = Complete::Zsh::format_completion($compres);
#    }
#
#    $self->use_utf8(1);
#
#    [200, "OK", $formatted,
#     {
#         "func.words" => $words,
#         "func.cword" => $cword,
#         "cmdline.skip_format" => 1,
#     }];
#}
#
#sub _read_config {
#    require Perinci::CmdLine::Util::Config;
#
#    my ($self, $r) = @_;
#
#    my $res = Perinci::CmdLine::Util::Config::read_config(
#        config_paths     => $r->{config_paths},
#        config_filename  => $self->config_filename,
#        config_dirs      => $self->config_dirs,
#        program_name     => $self->program_name,
#    );
#    die $res unless $res->[0] == 200;
#    $r->{config} = $res->[2];
#    $r->{read_config_files} = $res->[3]{'func.read_files'};
#    $r->{_config_section_read_order} = $res->[3]{'func.section_read_order'}; 
#}
#
#sub __min(@) {
#    my $m = $_[0];
#    for (@_) {
#        $m = $_ if $_ < $m;
#    }
#    $m;
#}
#
#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];
#}
#
#sub __uniq {
#    my %seen = ();
#    my $k;
#    my $seen_undef;
#    grep { defined $_ ? not $seen{ $k = $_ }++ : not $seen_undef++ } @_;
#}
#
#sub __find_similar_strings {
#    my ($needle, $haystack, $cut) = @_;
#
#    my $factor   = 1.5;
#    my $max_dist = 4;
#
#    my @res =
#        map { $_->[0] }
#        sort { $a->[1] <=> $b->[1] }
#        grep { defined }
#        map {
#            my $el = $_;
#            if ($cut && length($_) > length($needle)) {
#                $el = substr($el, 0, length($needle));
#            }
#            my $d = __editdist($el, $needle);
#            my $max_distance = __min(
#                __min(length($el), length($needle))/$factor,
#                $max_dist,
#            );
#            ($d <= $max_distance) ? [$_, $d] : undef
#        } @$haystack;
#
#    $cut ? __uniq(@res) : @res;
#}
#
#sub __find_similar_go_opts {
#    my ($opt, $go_spec) = @_;
#
#    $opt =~ s/^--?//;
#
#    my @ospecs0 = ref($go_spec) eq 'ARRAY' ?
#        keys(%{ { @$go_spec } }) : keys(%$go_spec);
#    my @ospecs;
#    for my $o (@ospecs0) {
#        $o =~ s/^--?//;
#        my $is_neg = $o =~ /\!$/;
#        $o =~ s/[=:].+|[?+!]$//;
#        for (split /\|/, $o) {
#            if ($is_neg && length($_) > 1) {
#                push @ospecs, $_, "no$_", "no-$_";
#            } else {
#                push @ospecs, $_;
#            }
#        }
#    }
#
#    map { length($_) > 1 ? "--$_" : "-$_" }
#        __find_similar_strings($opt, \@ospecs, "cut");
#}
#
#sub _parse_argv1 {
#    my ($self, $r) = @_;
#
#    my @go_spec;
#    {
#
#        require Getopt::Long;
#        my $old_go_conf = Getopt::Long::Configure(
#            'pass_through', 'no_ignore_case', 'no_auto_abbrev',
#            'no_getopt_compat', 'gnu_compat', 'bundling');
#        my $co = $self->common_opts // {};
#        for my $k (keys %$co) {
#            push @go_spec, $co->{$k}{getopt} => sub {
#                my ($go, $val) = @_;
#                $co->{$k}{handler}->($go, $val, $r);
#            };
#        }
#        Getopt::Long::GetOptions(@go_spec);
#        Getopt::Long::Configure($old_go_conf);
#    }
#
#    {
#        my $scn = $r->{subcommand_name};
#        my $scn_from = $r->{subcommand_name_from};
#        if (!defined($scn) && defined($self->{default_subcommand})) {
#            if ($self->get_subcommand_from_arg == 1) {
#                $scn = $self->{default_subcommand};
#                $scn_from = 'default_subcommand';
#            } elsif ($self->get_subcommand_from_arg == 2 && !@ARGV) {
#                $scn = $self->{default_subcommand};
#                $scn_from = 'default_subcommand';
#            }
#        }
#        if (!defined($scn) && $self->{subcommands} && @ARGV) {
#            if ($ARGV[0] =~ /\A-/) {
#                if ($r->{in_completion}) {
#                    $scn = shift @ARGV;
#                    $scn_from = 'arg';
#                } else {
#                    my $suggestion = '';
#                    my @similar = __find_similar_go_opts($ARGV[0], \@go_spec);
#                    $suggestion = " (perhaps you meant ".
#                        join("/", @similar)."?)" if @similar;
#                    die [400, "Unknown option: $ARGV[0]".$suggestion];
#                }
#            } else {
#                $scn = shift @ARGV;
#                $scn_from = 'arg';
#            }
#        }
#
#        my $scd;
#        if (defined $scn) {
#            $scd = $self->get_subcommand_data($scn);
#            unless ($r->{in_completion}) {
#                unless ($scd) {
#                    my $scs = $self->list_subcommands;
#                    if ($self->auto_abbrev_subcommand) {
#                        my $num_matches = 0;
#                        my $complete_scn;
#                        for (keys %$scs) {
#                            if (index($_, $scn) == 0) {
#                                $num_matches++;
#                                $complete_scn = $_;
#                                last if $num_matches > 1;
#                            }
#                        }
#                        if ($num_matches == 1) {
#                            $scn = $complete_scn;
#                            $scd = $self->get_subcommand_data($scn);
#                            goto L1;
#                        }
#                    }
#                    my @similar =
#                        __find_similar_strings($scn, [keys %$scs]);
#                    my $suggestion = '';
#                    $suggestion = " (perhaps you meant ".
#                        join("/", @similar)."?)" if @similar;
#                    die [500, "Unknown subcommand: $scn".$suggestion];
#                }
#            }
#        } elsif (!$r->{action} && $self->{subcommands}) {
#            $r->{action} = 'help';
#            $r->{skip_parse_subcommand_argv} = 1;
#        } else {
#            $scn = '';
#            $scd = {
#                url => $self->url,
#                summary => $self->summary,
#                description => $self->description,
#                pass_cmdline_object => $self->pass_cmdline_object,
#                tags => $self->tags,
#            };
#        }
#      L1:
#        $r->{subcommand_name} = $scn;
#        $r->{subcommand_name_from} = $scn_from;
#        $r->{subcommand_data} = $scd;
#    }
#
#    $r->{_parse_argv1_done} = 1;
#}
#
#sub _parse_argv2 {
#    require Perinci::CmdLine::Util::Config;
#
#    my ($self, $r) = @_;
#
#    my %args;
#
#    if ($r->{read_env}) {
#        my $env_words = $self->_read_env($r);
#        unshift @ARGV, @$env_words;
#    }
#
#    if ($r->{skip_parse_subcommand_argv}) {
#        return [200, "OK (subcommand options parsing skipped)"];
#    } else {
#        my $scd = $r->{subcommand_data};
#        my $meta = $self->get_meta($r, $scd->{url});
#
#        if ($scd->{args}) {
#            $args{$_} = $scd->{args}{$_} for keys %{ $scd->{args} };
#        }
#
#        if ($r->{read_config}) {
#
#            log_trace("[pericmd] Running hook_before_read_config_file ...");
#            $self->hook_before_read_config_file($r);
#
#            $self->_read_config($r);
#
#            log_trace("[pericmd] Running hook_after_read_config_file ...");
#            $self->hook_after_read_config_file($r);
#
#            my $res = Perinci::CmdLine::Util::Config::get_args_from_config(
#                r                  => $r,
#                config             => $r->{config},
#                args               => \%args,
#                program_name       => $self->program_name,
#                subcommand_name    => $r->{subcommand_name},
#                config_profile     => $r->{config_profile},
#                common_opts        => $self->common_opts,
#                meta               => $meta,
#                meta_is_normalized => 1,
#            );
#            die $res unless $res->[0] == 200;
#            log_trace("[pericmd] args after reading config files: %s",
#                         \%args);
#            my $found = $res->[3]{'func.found'};
#            if (defined($r->{config_profile}) && !$found &&
#                    defined($r->{read_config_files}) &&
#                        @{$r->{read_config_files}} &&
#                            !$r->{ignore_missing_config_profile_section}) {
#                return [412, "Profile '$r->{config_profile}' not found ".
#                            "in configuration file"];
#            }
#
#        }
#
#
#        my $copts = $self->common_opts;
#        my %old_handlers;
#        for (keys %$copts) {
#            my $h = $copts->{$_}{handler};
#            $copts->{$_}{handler} = sub {
#                my ($go, $val) = @_;
#                $h->($go, $val, $r);
#            };
#            $old_handlers{$_} = $h;
#        }
#
#        my $has_cmdline_src;
#        for my $ak (keys %{$meta->{args} // {}}) {
#            my $av = $meta->{args}{$ak};
#            if ($av->{cmdline_src}) {
#                $has_cmdline_src = 1;
#                last;
#            }
#            if ($av->{stream}) {
#                unless ($av->{cmdline_src} &&
#                            $av->{cmdline_src} =~
#                                /\A(stdin|file|stdin_or_files?|stdin_or_args)\z/) {
#                    die "BUG: stream argument '$ak' needs to have cmdline_src ".
#                        "set to stdin, file, stdin_or_file, stdin_or_files, or stdin_or_args";
#                }
#            }
#        }
#
#        require Perinci::Sub::GetArgs::Argv;
#        my $ga_res = Perinci::Sub::GetArgs::Argv::get_args_from_argv(
#            argv                => \@ARGV,
#            args                => \%args,
#            meta                => $meta,
#            meta_is_normalized  => 1,
#            allow_extra_elems   => $has_cmdline_src ? 1:0,
#            per_arg_json        => $self->{per_arg_json},
#            per_arg_yaml        => $self->{per_arg_yaml},
#            common_opts         => $copts,
#            strict              => $r->{in_completion} ? 0:1,
#            (ggls_res            => $r->{_ggls_res}) x defined($r->{_ggls_res}),
#            on_missing_required_args => sub {
#                my %a = @_;
#
#                my ($an, $aa, $as) = ($a{arg}, $a{args}, $a{spec});
#                my $src = $as->{cmdline_src} // '';
#
#                $src = '' if $src eq 'stdin_or_args' && -t STDIN;
#
#                if ($src && $as->{req}) {
#                    return 1;
#                } else {
#                    return 0;
#                }
#            },
#        );
#
#        return $ga_res unless $ga_res->[0] == 200;
#
#        for (keys %$copts) {
#            $copts->{$_}{handler} = $old_handlers{$_};
#        }
#
#        return $ga_res;
#    }
#}
#
#sub parse_argv {
#    my ($self, $r) = @_;
#
#    log_trace("[pericmd] Parsing \@ARGV: %s", \@ARGV);
#
#
#    $self->_parse_argv1($r) unless $r->{_parse_argv1_done};
#    $self->_parse_argv2($r);
#}
#
#sub __gen_iter {
#    require Data::Sah::Util::Type;
#
#    my ($fh, $argspec, $argname) = @_;
#    my $schema = $argspec->{schema};
#    $schema = $schema->[1]{of} if $schema->[0] eq 'array';
#    my $type = Data::Sah::Util::Type::get_type($schema);
#
#    if (Data::Sah::Util::Type::is_simple($schema)) {
#        my $chomp = $type eq 'buf' ? 0 :
#            $argspec->{'cmdline.chomp'} // 1;
#        return sub {
#            local $/ = \(64*1024) if $type eq 'buf';
#
#            state $eof;
#            return undef if $eof;
#            my $l = <$fh>;
#            unless (defined $l) {
#                $eof++; return undef;
#            }
#            chomp($l) if $chomp;
#            $l;
#        };
#    } else {
#        require JSON;
#        state $json = JSON->new->allow_nonref;
#        my $i = -1;
#        return sub {
#            state $eof;
#            return undef if $eof;
#            $i++;
#            my $l = <$fh>;
#            unless (defined $l) {
#                $eof++; return undef;
#            }
#            eval { $l = $json->decode($l) };
#            if ($@) {
#                die "Invalid JSON in stream argument '$argname' record #$i: $@";
#            }
#            $l;
#        };
#    }
#}
#
#sub parse_cmdline_src {
#    my ($self, $r) = @_;
#
#    my $action = $r->{action};
#    my $meta   = $r->{meta};
#
#    my $url = $r->{subcommand_data}{url} // $self->{url} // '';
#    my $is_network = $url =~ m!^(https?|riap[^:]+):!;
#
#    if ($action eq 'call') {
#        my $args_p = $meta->{args} // {};
#        my $stdin_seen;
#        for my $an (sort {
#            my $csa  = $args_p->{$a}{cmdline_src};
#            my $csb  = $args_p->{$b}{cmdline_src};
#            my $posa = $args_p->{$a}{pos} // 9999;
#            my $posb = $args_p->{$b}{pos} // 9999;
#
#            (
#                !$csa || !$csb ? 0 :
#                    $csa eq 'stdin_line' && $csb eq 'stdin_line' ? 0 :
#                    $csa eq 'stdin_line' && $csb =~ /^(stdin|stdin_or_files?|stdin_or_args)/ ? -1 :
#                    $csb eq 'stdin_line' && $csa =~ /^(stdin|stdin_or_files?|stdin_or_args)/ ? 1 : 0
#            )
#            ||
#
#            ($posa <=> $posb)
#
#            ||
#            ($a cmp $b)
#        } keys %$args_p) {
#            my $as = $args_p->{$an};
#            my $src = $as->{cmdline_src};
#            my $type = $as->{schema}[0]
#                or die "BUG: No schema is defined for arg '$an'";
#            my $do_stream = $as->{stream} && $url !~ /^https?:/;
#            if ($src) {
#                die [531,
#                     "Invalid 'cmdline_src' value for argument '$an': $src"]
#                    unless $src =~ /\A(stdin|file|stdin_or_files?|stdin_or_args|stdin_line)\z/;
#                die [531,
#                     "Sorry, argument '$an' is set cmdline_src=$src, but type ".
#                         "is not str/buf/array, only those are supported now"]
#                    unless $do_stream || $type =~ /\A(str|buf|array)\z/; 
#
#                if ($src =~ /\A(stdin|stdin_or_files?|stdin_or_args)\z/) {
#                    die [531, "Only one argument can be specified ".
#                             "cmdline_src stdin/stdin_or_file/stdin_or_files/stdin_or_args"]
#                        if $stdin_seen++;
#                }
#                my $is_ary = $type eq 'array';
#                if ($src eq 'stdin_line' && !exists($r->{args}{$an})) {
#                    require Perinci::Object;
#                    my $term_readkey_available = eval { require Term::ReadKey; 1 };
#                    my $prompt = Perinci::Object::rimeta($as)->langprop('cmdline_prompt') //
#                        sprintf($self->default_prompt_template, $an);
#                    print $prompt;
#                    my $iactive = (-t STDOUT);
#                    Term::ReadKey::ReadMode('noecho')
#                          if $term_readkey_available && $iactive && $as->{is_password};
#                    chomp($r->{args}{$an} = <STDIN>);
#                    do { print "\n"; Term::ReadKey::ReadMode(0) if $term_readkey_available }
#                        if $iactive && $as->{is_password};
#                    $r->{args}{"-cmdline_src_$an"} = 'stdin_line';
#                } elsif ($src eq 'stdin' || $src eq 'file' &&
#                        ($r->{args}{$an}//"") eq '-') {
#                    die [400, "Argument $an must be set to '-' which means ".
#                             "from stdin"]
#                        if defined($r->{args}{$an}) &&
#                            $r->{args}{$an} ne '-';
#                    $r->{args}{$an} = $do_stream ?
#                        __gen_iter(\*STDIN, $as, $an) :
#                            $is_ary ? [<STDIN>] :
#                                do {local $/; ~~<STDIN>};
#                    $r->{args}{"-cmdline_src_$an"} = 'stdin';
#                } elsif ($src eq 'stdin_or_file' || $src eq 'stdin_or_files') {
#                    local @ARGV = @ARGV;
#                    unshift @ARGV, $r->{args}{$an}
#                        if defined $r->{args}{$an};
#
#                    splice @ARGV, 1
#                        if @ARGV > 1 && $src eq 'stdin_or_file';
#
#
#                    for (@ARGV) {
#                        next if $_ eq '-';
#                        die [500, "Can't read file '$_': $!"] if !(-r $_);
#                    }
#
#                    $r->{args}{"-cmdline_srcfilenames_$an"} = [@ARGV];
#                    $r->{args}{$an} = $do_stream ?
#                        __gen_iter(\*ARGV, $as, $an) :
#                            $is_ary ? [<>] :
#                                do {local $/; ~~<>};
#                    $r->{args}{"-cmdline_src_$an"} = $src;
#                } elsif ($src eq 'stdin_or_args' && !(-t STDIN)) {
#                    unless (defined($r->{args}{$an})) {
#                        $r->{args}{$an} = $do_stream ?
#                            __gen_iter(\*STDIN, $as, $an) :
#                            $is_ary ? [map {chomp;$_} <STDIN>] :
#                                do {local $/; ~~<STDIN>};
#                    }
#                } elsif ($src eq 'file') {
#                    unless (exists $r->{args}{$an}) {
#                        if ($as->{req}) {
#                            die [400,
#                                 "Please specify filename for argument '$an'"];
#                        } else {
#                            next;
#                        }
#                    }
#                    die [400, "Please specify filename for argument '$an'"]
#                        unless defined $r->{args}{$an};
#                    my $fh;
#                    my $fname = $r->{args}{$an};
#                    unless (open $fh, "<", $fname) {
#                        die [500, "Can't open file '$fname' for argument '$an'".
#                                 ": $!"];
#                    }
#                    $r->{args}{$an} = $do_stream ?
#                        __gen_iter($fh, $as, $an) :
#                            $is_ary ? [<$fh>] :
#                                do { local $/; ~~<$fh> };
#                    $r->{args}{"-cmdline_src_$an"} = 'file';
#                    $r->{args}{"-cmdline_srcfilenames_$an"} = [$fname];
#                }
#            }
#
#            if ($self->riap_version == 1.2 && $is_network &&
#                    defined($r->{args}{$an}) && $args_p->{$an}{schema} &&
#                        $args_p->{$an}{schema}[0] eq 'buf' &&
#                            !$r->{args}{"$an:base64"}) {
#                require MIME::Base64;
#                $r->{args}{"$an:base64"} =
#                    MIME::Base64::encode_base64($r->{args}{$an}, "");
#                delete $r->{args}{$an};
#            }
#        } 
#    }
#}
#
#sub select_output_handle {
#    my ($self, $r) = @_;
#
#    my $resmeta = $r->{res}[3] // {};
#
#    my $handle;
#  SELECT_HANDLE:
#    {
#        if ($ENV{VIEW_RESULT} // $resmeta->{"cmdline.view_result"}) {
#            my $viewer = $resmeta->{"cmdline.viewer"} // $ENV{VIEWER} //
#                $ENV{BROWSER};
#            last if defined $viewer && !$viewer; 
#            die [500, "No VIEWER program set"] unless defined $viewer;
#            $r->{viewer} = $viewer;
#            require File::Temp;
#            my $filename;
#            ($handle, $filename) = File::Temp::tempfile();
#            $r->{viewer_temp_path} = $filename;
#        }
#
#        if ($ENV{PAGE_RESULT} // $resmeta->{"cmdline.page_result"}) {
#            require File::Which;
#            my $pager = $resmeta->{"cmdline.pager"} //
#                $ENV{PAGER};
#            unless (defined $pager) {
#                $pager = "less -FRSX" if File::Which::which("less");
#            }
#            unless (defined $pager) {
#                $pager = "more" if File::Which::which("more");
#            }
#            unless (defined $pager) {
#                die [500, "Can't determine PAGER"];
#            }
#            last unless $pager; 
#            open $handle, "| $pager";
#        }
#        $handle //= \*STDOUT;
#    }
#    $r->{output_handle} = $handle;
#}
#
#sub display_result {
#    require Data::Sah::Util::Type;
#
#    my ($self, $r) = @_;
#
#    my $meta = $r->{meta};
#    my $res = $r->{res};
#    my $fres = $r->{fres};
#    my $resmeta = $res->[3] // {};
#
#    my $handle = $r->{output_handle};
#
#    my $sch = $meta->{result}{schema};
#    my $type = Data::Sah::Util::Type::get_type($sch) // '';
#
#    if ($resmeta->{stream} // $meta->{result}{stream}) {
#        my $x = $res->[2];
#        if (ref($x) eq 'CODE') {
#            if (Data::Sah::Util::Type::is_simple($sch)) {
#                while (defined(my $l = $x->())) {
#                    print $l;
#                    print "\n" unless $type eq 'buf';
#                }
#            } else {
#                require JSON;
#                state $json = JSON->new->allow_nonref;
#                if ($self->use_cleanser) {
#                    while (defined(my $rec = $x->())) {
#                        print $json->encode(
#                            $self->cleanser->clone_and_clean($rec)), "\n";
#                    }
#                } else {
#                    while (defined(my $rec = $x->())) {
#                        print $json->encode($rec), "\n";
#                    }
#                }
#            }
#        } else {
#            die "Result is a stream but no coderef provided";
#        }
#    } else {
#        print $handle $fres;
#        if ($r->{viewer}) {
#            require ShellQuote::Any::Tiny;
#            my $cmd = $r->{viewer} ." ". ShellQuote::Any::Tiny::shell_quote($r->{viewer_temp_path});
#            system $cmd;
#        }
#    }
#}
#
#sub run {
#    my ($self) = @_;
#    log_trace("[pericmd] -> run(), \@ARGV=%s", \@ARGV);
#
#    my $co = $self->common_opts;
#
#    my $r = {
#        orig_argv   => [@ARGV],
#        common_opts => $co,
#    };
#
#    if ($ENV{PERINCI_CMDLINE_DUMP}) {
#        $r->{res} = $self->do_dump($r);
#        goto FORMAT;
#    }
#
#    if ($self->_detect_completion($r)) {
#        $r->{res} = $self->do_completion($r);
#        goto FORMAT;
#    }
#
#    $r->{naked_res} = $co->{naked_res}{default} if $co->{naked_res};
#    $r->{format}    = $co->{format}{default} if $co->{format};
#
#    {
#        last if (-t STDOUT) || $r->{format};
#        last unless eval { require Pipe::Find; 1 };
#        my $pipeinfo = Pipe::Find::get_stdout_pipe_process();
#        last unless $pipeinfo;
#        last unless $pipeinfo->{exe} =~ m![/\\]td\z! ||
#            $pipeinfo->{cmdline} =~ m!\A([^\0]*[/\\])?perl\0([^\0]*[/\\])?td\0!;
#        $r->{format} = 'json';
#    }
#
#    $r->{format} //= $self->default_format;
#
#    if ($self->read_config) {
#        $r->{read_config} = 1;
#    }
#
#    if ($self->read_env) {
#        $r->{read_env} = 1;
#    }
#
#    eval {
#        log_trace("[pericmd] Running hook_before_run ...");
#        $self->hook_before_run($r);
#
#        my $parse_res = $self->parse_argv($r);
#        if ($parse_res->[0] == 501) {
#            $r->{send_argv} = 1;
#        } elsif ($parse_res->[0] != 200) {
#            die $parse_res;
#        }
#        $r->{parse_argv_res} = $parse_res;
#        $r->{args} = $parse_res->[2] // {};
#
#        $r->{action} //= 'call';
#
#        if ($self->log) {
#            require Log::ger::App;
#            my $default_level = do {
#                my $dry_run = $r->{dry_run} // $self->default_dry_run;
#                $dry_run ? 'info' : 'warn';
#            };
#            Log::ger::App->import(
#                level => $r->{log_level} // $self->log_level // $default_level,
#                name  => $self->program_name,
#            );
#        }
#
#        log_trace("[pericmd] Running hook_after_parse_argv ...");
#        $self->hook_after_parse_argv($r);
#
#        $self->parse_cmdline_src($r);
#
#
#        my $missing = $parse_res->[3]{"func.missing_args"};
#        die [400, "Missing required argument(s): ".join(", ", @$missing)]
#            if $missing && @$missing;
#
#        my $scd = $r->{subcommand_data};
#        if ($scd->{pass_cmdline_object} // $self->pass_cmdline_object) {
#            $r->{args}{-cmdline} = $self;
#            $r->{args}{-cmdline_r} = $r;
#        }
#
#        log_trace("[pericmd] Running hook_before_action ...");
#        $self->hook_before_action($r);
#
#        my $meth = "action_$r->{action}";
#        die [500, "Unknown action $r->{action}"] unless $self->can($meth);
#        log_trace("[pericmd] Running %s() ...", $meth);
#        $r->{res} = $self->$meth($r);
#
#        log_trace("[pericmd] Running hook_after_action ...");
#        $self->hook_after_action($r);
#    };
#    my $err = $@;
#    if ($err || !$r->{res}) {
#        if ($err) {
#            $err = [500, "Died: $err"] unless ref($err) eq 'ARRAY';
#            if (%Devel::Confess::) {
#                no warnings 'once';
#                require Scalar::Util;
#                my $id = Scalar::Util::refaddr($err);
#                my $stack_trace = $Devel::Confess::MESSAGES{$id};
#                $err->[1] .= "\n$stack_trace" if $stack_trace;
#            }
#            $err->[1] =~ s/\n+$//;
#            $r->{res} = $err;
#        } else {
#            $r->{res} = [500, "Bug: no response produced"];
#        }
#    } elsif (ref($r->{res}) ne 'ARRAY') {
#        log_trace("[pericmd] res=%s", $r->{res}); 
#        $r->{res} = [500, "Bug in program: result not an array"];
#    } elsif (!$r->{res}[0] || $r->{res}[0] < 200 || $r->{res}[0] > 555) {
#        log_trace("[pericmd] res=%s", $r->{res}); 
#        $r->{res} = [500, "Bug in program: invalid result status, ".
#                         "must be 200 <= x <= 555"];
#    }
#    $r->{format} //= $r->{res}[3]{'cmdline.default_format'};
#    $r->{format} //= $r->{meta}{'cmdline.default_format'};
#    my $restore_orig_result;
#    my $orig_result;
#    if (exists $r->{res}[3]{'cmdline.result'}) {
#        $restore_orig_result = 1;
#        $orig_result = $r->{res}[2];
#        $r->{res}[2] = $r->{res}[3]{'cmdline.result'};
#    }
#  FORMAT:
#    my $is_success = $r->{res}[0] =~ /\A2/ || $r->{res}[0] == 304;
#    if ($is_success &&
#            ($self->skip_format ||
#             $r->{meta}{'cmdline.skip_format'} ||
#             $r->{res}[3]{'cmdline.skip_format'})) {
#        $r->{fres} = $r->{res}[2] // '';
#    } elsif ($is_success &&
#                 ($r->{res}[3]{stream} // $r->{meta}{result}{stream})) {
#    }else {
#        log_trace("[pericmd] Running hook_format_result ...");
#        $r->{res}[3]{stream} = 0;
#        $r->{fres} = $self->hook_format_result($r) // '';
#    }
#    $self->select_output_handle($r);
#    log_trace("[pericmd] Running hook_display_result ...");
#    $self->hook_display_result($r);
#    log_trace("[pericmd] Running hook_after_run ...");
#    $self->hook_after_run($r);
#
#    if ($restore_orig_result) {
#        $r->{res}[2] = $orig_result;
#    }
#
#    my $exitcode;
#    if ($r->{res}[3] && defined($r->{res}[3]{'cmdline.exit_code'})) {
#        $exitcode = $r->{res}[3]{'cmdline.exit_code'};
#    } else {
#        $exitcode = $self->status2exitcode($r->{res}[0]);
#    }
#    if ($self->exit) {
#        log_trace("[pericmd] exit(%s)", $exitcode);
#        exit $exitcode;
#    } else {
#        log_trace("[pericmd] <- run(), exitcode=%s", $exitcode);
#        $r->{res}[3]{'x.perinci.cmdline.base.exit_code'} = $exitcode;
#        return $r->{res};
#    }
#}
#
#1;
#
#__END__
#
### Perinci/CmdLine/Help.pm ###
#package Perinci::CmdLine::Help;
#
#our $DATE = '2017-07-24'; 
#our $VERSION = '0.16'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(gen_help);
#
#our %SPEC;
#
#$SPEC{gen_help} = {
#    v => 1.1,
#    summary => 'Generate help message for Perinci::CmdLine-based app',
#    args => {
#        program_name => {
#            schema => 'str*',
#            req => 1,
#        },
#        program_summary => {
#            schema => 'str*',
#        },
#        subcommands => {
#            schema => 'hash',
#        },
#        meta => {
#            summary => 'Function metadata, must be normalized',
#            schema => 'hash*',
#            req => 1,
#        },
#        common_opts => {
#            schema => 'hash*',
#            default => {},
#        },
#        per_arg_json => {
#            schema => 'bool*',
#        },
#        per_arg_yaml => {
#            schema => 'bool*',
#        },
#        ggls_res => {
#            summary => 'Full result from gen_getopt_long_spec_from_meta()',
#            schema  => 'array*', 
#            description => <<'_',
#
#If you already call <pm:Perinci::Sub::GetArgs::Argv>'s
#`gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
#here, to avoid calculating twice.
#
#_
#        },
#    },
#};
#sub gen_help {
#    no warnings 'once';
#    require Text::Wrap;
#
#    my %args = @_;
#
#    local $Text::Wrap::columns = $ENV{COLUMNS} // 80;
#
#    my $meta = $args{meta};
#    my $common_opts = $args{common_opts} // {};
#
#    my @help;
#
#    my $progname = $args{program_name};
#    {
#        my $sum = $args{program_summary} // $meta->{summary};
#        last unless $sum;
#        push @help, $progname, " - ", $sum, "\n\n";
#    }
#
#    my $clidocdata;
#
#    push @help, "Usage:\n";
#    {
#        for (sort {
#            ($common_opts->{$a}{order} // 99) <=>
#                ($common_opts->{$b}{order} // 99) ||
#                    $a cmp $b
#            } keys %$common_opts) {
#            my $co = $common_opts->{$_};
#            next unless $co->{usage};
#            push @help, "  $progname $co->{usage}\n";
#        }
#
#        require Perinci::Sub::To::CLIDocData;
#        my $res = Perinci::Sub::To::CLIDocData::gen_cli_doc_data_from_meta(
#            meta => $meta, meta_is_normalized => 1,
#            common_opts  => $common_opts,
#            per_arg_json => $args{per_arg_json},
#            per_arg_yaml => $args{per_arg_yaml},
#            (ggls_res => $args{ggls_res}) x defined($args{ggls_res}),
#        );
#        die [500, "gen_cli_doc_data_from_meta failed: ".
#                 "$res->[0] - $res->[1]"] unless $res->[0] == 200;
#        $clidocdata = $res->[2];
#        my $usage = $clidocdata->{usage_line};
#        $usage =~ s/\[\[prog\]\]/$progname/;
#        push @help, "  $usage\n";
#    }
#
#    {
#        my $subcommands = $args{subcommands} or last;
#        push @help, "\nSubcommands:\n";
#        if (keys(%$subcommands) >= 12) {
#            push @help, Text::Wrap::wrap(
#                "  ", "  ", join(", ", sort keys %$subcommands)), "\n";
#        } else {
#            for my $sc_name (sort keys %$subcommands) {
#                my $sc_spec = $subcommands->{$sc_name};
#                next unless $sc_spec->{show_in_help} //1;
#                push @help, "  $sc_name\n";
#            }
#        }
#    }
#
#    {
#        last unless @{ $clidocdata->{examples} };
#        push @help, "\nExamples:\n";
#        my $i = 0;
#        my $egs = $clidocdata->{examples};
#        for my $eg (@$egs) {
#            $i++;
#            my $cmdline = $eg->{cmdline};
#            $cmdline =~ s/\[\[prog\]\]/$progname/;
#            push @help, "\n" if $eg->{summary} && $i > 1;
#            if ($eg->{summary}) {
#                push @help, "  $eg->{summary}:\n";
#            } else {
#                push @help, "\n";
#            }
#            push @help, "  % $cmdline\n";
#        }
#    }
#
#    {
#        my $desc = $args{program_description} // $meta->{description};
#        last unless $desc;
#        $desc =~ s/\A\n+//;
#        $desc =~ s/\n+\z//;
#        push @help, "\n", $desc, "\n" if $desc =~ /\S/;
#    }
#
#    {
#        require Data::Dmp;
#
#        my $opts = $clidocdata->{opts};
#        last unless keys %$opts;
#
#        my %options_by_cat; 
#        for my $optkey (keys %$opts) {
#            for my $cat (@{ $opts->{$optkey}{categories} }) {
#                push @{ $options_by_cat{$cat} }, $optkey;
#            }
#        }
#
#        my $cats_spec = $clidocdata->{option_categories};
#        for my $cat (sort {
#            ($cats_spec->{$a}{order} // 50) <=> ($cats_spec->{$b}{order} // 50)
#                || $a cmp $b }
#                         keys %options_by_cat) {
#            my @opts = sort {length($b)<=>length($a)}
#                @{ $options_by_cat{$cat} };
#            my $len = length($opts[0]);
#            @opts = sort {
#                (my $a_without_dash = $a) =~ s/^-+//;
#                (my $b_without_dash = $b) =~ s/^-+//;
#                lc($a) cmp lc($b);
#            } @opts;
#            push @help, "\n$cat:\n";
#            for my $opt (@opts) {
#                my $ospec = $opts->{$opt};
#                my $arg_spec = $ospec->{arg_spec};
#                next if grep {$_ eq 'hidden'} @{$arg_spec->{tags} // []};
#                my $is_bool = $arg_spec->{schema} &&
#                    $arg_spec->{schema}[0] eq 'bool';
#                my $show_default = exists($ospec->{default}) &&
#                    !$is_bool && !$ospec->{is_base64} &&
#                        !$ospec->{is_json} && !$ospec->{is_yaml} &&
#                            !$ospec->{is_alias};
#
#                my $add_sum = '';
#                if ($ospec->{is_base64}) {
#                    $add_sum = " (as base64-encoded str)";
#                } elsif ($ospec->{is_json}) {
#                    $add_sum = " (as JSON-encoded str)";
#                } elsif ($ospec->{is_yaml}) {
#                    $add_sum = " (as YAML-encoded str)";
#                }
#
#                my $argv = '';
#                if (!$ospec->{main_opt} && defined($ospec->{pos})) {
#                    if ($ospec->{greedy}) {
#                        $argv = " (=arg[$ospec->{pos}-])";
#                    } else {
#                        $argv = " (=arg[$ospec->{pos}])";
#                    }
#                }
#
#                my $cmdline_src = '';
#                if (!$ospec->{main_opt} && defined($arg_spec->{cmdline_src})) {
#                    $cmdline_src = " (or from $arg_spec->{cmdline_src})";
#                    $cmdline_src =~ s!_or_!/!g;
#                }
#
#                push @help, sprintf(
#                    "  %-${len}s  %s%s%s%s%s\n",
#                    $opt,
#                    Text::Wrap::wrap("", " " x (2+$len+2 +2),
#                                     $ospec->{summary}//''),
#                    $add_sum,
#                    $argv,
#                    $cmdline_src,
#                    ($show_default && defined($ospec->{default}) ?
#                         " [".Data::Dmp::dmp($ospec->{default})."]":""),
#
#                );
#            }
#        }
#    }
#
#    [200, "OK", join("", @help)];
#}
#
#1;
#
#__END__
#
### Perinci/CmdLine/Lite.pm ###
#package Perinci::CmdLine::Lite;
#
#our $DATE = '2017-07-22'; 
#our $VERSION = '1.77'; 
#
#use 5.010001;
#use Log::ger;
#
#use List::Util qw(first);
#use Mo qw(build default);
#extends 'Perinci::CmdLine::Base';
#
#
#has default_prompt_template => (
#    is=>'rw',
#    default => 'Enter %s: ',
#);
#has validate_args => (
#    is=>'rw',
#    default => 1,
#);
#
#my $formats = [qw/text text-simple text-pretty json json-pretty csv html html+datatables/];
#
#sub BUILD {
#    my ($self, $args) = @_;
#
#    if (!$self->{riap_client}) {
#        require Perinci::Access::Lite;
#        my %rcargs = (
#            riap_version => $self->{riap_version} // 1.1,
#            %{ $self->{riap_client_args} // {} },
#        );
#        $self->{riap_client} = Perinci::Access::Lite->new(%rcargs);
#    }
#
#    if (!$self->{actions}) {
#        $self->{actions} = {
#            call => {},
#            version => {},
#            subcommands => {},
#            help => {},
#        };
#    }
#
#    my $_t = sub {
#        no warnings;
#        my $co_name = shift;
#        my $href = $Perinci::CmdLine::Base::copts{$co_name};
#        %$href;
#    };
#
#    if (!$self->{common_opts}) {
#        my $copts = {};
#
#        $copts->{version}   = { $_t->('version'), };
#        $copts->{help}      = { $_t->('help'), };
#
#        unless ($self->skip_format) {
#            $copts->{format}    = {
#                $_t->('format'),
#                schema => ['str*' => in => $formats],
#            };
#            $copts->{json}      = { $_t->('json'), };
#            $copts->{naked_res} = { $_t->('naked_res'), };
#        }
#        if ($self->subcommands) {
#            $copts->{subcommands} = { $_t->('subcommands'), };
#        }
#        if ($self->default_subcommand) {
#            $copts->{cmd} = { $_t->('cmd') };
#        }
#        if ($self->read_config) {
#            $copts->{config_path}    = { $_t->('config_path') };
#            $copts->{no_config}      = { $_t->('no_config') };
#            $copts->{config_profile} = { $_t->('config_profile') };
#        }
#        if ($self->read_env) {
#            $copts->{no_env} = { $_t->('no_env') };
#        }
#        if ($self->log) {
#            $copts->{log_level} = { $_t->('log_level'), };
#            $copts->{trace}     = { $_t->('trace'), };
#            $copts->{debug}     = { $_t->('debug'), };
#            $copts->{verbose}   = { $_t->('verbose'), };
#            $copts->{quiet}     = { $_t->('quiet'), };
#        }
#        $self->{common_opts} = $copts;
#    }
#
#    $self->{formats} //= $formats;
#
#    $self->{per_arg_json} //= 1;
#}
#
#my $setup_progress;
#sub _setup_progress_output {
#    my $self = shift;
#
#    return unless $ENV{PROGRESS} // (-t STDOUT);
#
#    require Progress::Any::Output;
#    Progress::Any::Output->set("TermProgressBarColor");
#    $setup_progress = 1;
#}
#
#sub _unsetup_progress_output {
#    my $self = shift;
#
#    return unless $setup_progress;
#    no warnings 'once';
#    my $out = $Progress::Any::outputs{''}[0];
#    $out->cleanup if $out->can("cleanup");
#    $setup_progress = 0;
#}
#
#sub hook_after_parse_argv {
#    my ($self, $r) = @_;
#
#    my $ass  = $r->{meta}{args} // {};
#    my $args = $r->{args};
#    for (keys %$ass) {
#        next if exists $args->{$_};
#        my $as = $ass->{$_};
#        if (exists $as->{default}) {
#            $args->{$_} = $as->{default};
#        } elsif ($as->{schema} && exists $as->{schema}[1]{default}) {
#            $args->{$_} = $as->{schema}[1]{default};
#        }
#    }
#}
#
#sub equal2 {
#    state $require = do { require Scalar::Util };
#
#    my ($val1, $val2) = @_;
#
#
#    if (defined $val1) {
#        return 0 unless defined $val2;
#        if (ref $val1) {
#            return 0 unless ref $val2;
#            return Scalar::Util::refaddr($val1) eq Scalar::Util::refaddr($val2);
#        } else {
#            return 0 if ref $val2;
#            return $val1 eq $val2;
#        }
#    } else {
#        return 0 if defined $val2;
#        return 1;
#    }
#}
#
#sub hook_before_action {
#    my ($self, $r) = @_;
#
#  VALIDATE_ARGS:
#    {
#        last unless $self->validate_args;
#
#        last unless $r->{action} eq 'call';
#
#        my $meta = $r->{meta};
#
#        last if $meta->{'x.perinci.sub.wrapper.logs'} &&
#            (grep { $_->{validate_args} }
#             @{ $meta->{'x.perinci.sub.wrapper.logs'} });
#
#        require Data::Sah;
#
#        my %validators; 
#
#        for my $arg (sort keys %{ $meta->{args} // {} }) {
#            next unless exists($r->{args}{$arg});
#
#            next if $meta->{args}{$arg}{stream};
#
#            my $schema = $meta->{args}{$arg}{schema};
#            next unless $schema;
#            unless ($validators{"$schema"}) {
#                my $v = Data::Sah::gen_validator($schema, {
#                    return_type => 'str+val',
#                    schema_is_normalized => 1,
#                });
#                $validators{"$schema"} = $v;
#            }
#            my $res = $validators{"$schema"}->($r->{args}{$arg});
#            if ($res->[0]) {
#                die [400, "Argument '$arg' fails validation: $res->[0]"];
#            }
#            my $val0 = $r->{args}{$arg};
#            my $coerced_val = $res->[1];
#            $r->{args}{$arg} = $coerced_val;
#            $r->{args}{"-orig_$arg"} = $val0 unless equal2($val0, $coerced_val);
#        }
#
#        if ($meta->{args_rels}) {
#            my $schema = [hash => $meta->{args_rels}];
#            my $sah = Data::Sah->new;
#            my $hc  = $sah->get_compiler("human");
#            my $cd  = $hc->init_cd;
#            $cd->{args}{lang} //= $cd->{default_lang};
#            my $v = Data::Sah::gen_validator($schema, {
#                return_type => 'str',
#                human_hash_values => {
#                    field  => $hc->_xlt($cd, "argument"),
#                    fields => $hc->_xlt($cd, "arguments"),
#                },
#            });
#            my $res = $v->($r->{args});
#            if ($res) {
#                die [400, $res];
#            }
#        }
#
#    }
#}
#
#sub hook_format_result {
#    require Perinci::Result::Format::Lite;
#    my ($self, $r) = @_;
#
#    my $fmt = $r->{format} // 'text';
#
#    if ($fmt eq 'html+datatables') {
#        $fmt = 'text-pretty';
#        $ENV{VIEW_RESULT} //= 1;
#        $ENV{FORMAT_PRETTY_TABLE_BACKEND} //= 'Text::Table::HTML::DataTables';
#    }
#
#    my $fres = Perinci::Result::Format::Lite::format(
#        $r->{res}, $fmt, $r->{naked_res}, $self->{use_cleanser});
#
#    if ($fmt =~ /text/ && $r->{res}[0] =~ /\A[45]/ && defined($r->{res}[1])) {
#        $fres = $self->program_name . ": $fres";
#    }
#
#    $fres;
#}
#
#sub hook_format_row {
#    my ($self, $r, $row) = @_;
#
#    if (ref($row) eq 'ARRAY') {
#        return join("\t", @$row) . "\n";
#    } else {
#        return ($row // "") . "\n";
#    }
#}
#
#sub hook_display_result {
#    my ($self, $r) = @_;
#
#    my $res  = $r->{res};
#    my $resmeta = $res->[3] // {};
#
#    my $handle = $r->{output_handle};
#
#    my $utf8;
#    {
#        last if defined($utf8 = $ENV{UTF8});
#        if ($resmeta->{'x.hint.result_binary'}) {
#            $utf8 = 0; last;
#        }
#        if ($r->{subcommand_data}) {
#            last if defined($utf8 = $r->{subcommand_data}{use_utf8});
#        }
#        $utf8 = $self->use_utf8;
#    }
#    binmode($handle, ":utf8") if $utf8;
#
#    $self->display_result($r);
#}
#
#sub hook_after_run {
#    my ($self, $r) = @_;
#    $self->_unsetup_progress_output;
#}
#
#sub hook_after_get_meta {
#    my ($self, $r) = @_;
#
#    require Perinci::Object;
#    my $metao = Perinci::Object::risub($r->{meta});
#    if ($metao->can_dry_run) {
#        my $default_dry_run = $metao->default_dry_run // $self->default_dry_run;
#        $r->{dry_run} = 1 if $default_dry_run;
#        $r->{dry_run} = ($ENV{DRY_RUN} ? 1:0) if defined $ENV{DRY_RUN};
#        require Perinci::Sub::GetArgs::Argv;
#        my $ggls_res = Perinci::Sub::GetArgs::Argv::gen_getopt_long_spec_from_meta(
#            meta               => $r->{meta},
#            meta_is_normalized => 1,
#            args               => $r->{args},
#            common_opts        => $self->common_opts,
#            per_arg_json       => $self->{per_arg_json},
#            per_arg_yaml       => $self->{per_arg_yaml},
#        );
#        my $meta_uses_opt_n = 0;
#        {
#            last unless $ggls_res->[0] == 200;
#            my $opts = $ggls_res->[3]{'func.opts'};
#            if (grep { $_ eq '-n' } @$opts) { $meta_uses_opt_n = 1 }
#        }
#        my $optname = 'dry-run' . ($meta_uses_opt_n ? '' : '|n');
#        $self->common_opts->{dry_run} = {
#            getopt  => $default_dry_run ? "$optname!" : $optname,
#            summary => $default_dry_run ?
#                "Disable simulation mode (also via DRY_RUN=0)" :
#                "Run in simulation mode (also via DRY_RUN=1)",
#            handler => sub {
#                my ($go, $val, $r) = @_;
#                if ($val) {
#                    log_debug("[pericmd] Dry-run mode is activated");
#                    $r->{dry_run} = 1;
#                } else {
#                    log_debug("[pericmd] Dry-run mode is deactivated");
#                    $r->{dry_run} = 0;
#                }
#            },
#        };
#    }
#
#    if ($r->{meta}{deps} && !$r->{in_dump} && !$r->{in_completion}) {
#        require Perinci::Sub::DepChecker;
#        my $res = Perinci::Sub::DepChecker::check_deps($r->{meta}{deps});
#        if ($res) {
#            die [412, "Dependency failed: $res"];
#        }
#    }
#}
#
#sub action_subcommands {
#    my ($self, $r) = @_;
#
#    if (!$self->subcommands) {
#        say "There are no subcommands.";
#        return 0;
#    }
#
#    say "Available subcommands:";
#    my $scs = $self->list_subcommands;
#    my $longest = 6;
#    for (keys %$scs) { my $l = length; $longest = $l if $l > $longest }
#    [200, "OK",
#     join("",
#          (map { sprintf("  %-${longest}s  %s\n",$_,$scs->{$_}{summary}//"") }
#               sort keys %$scs),
#      )];
#}
#
#sub action_version {
#    no strict 'refs';
#
#    my ($self, $r) = @_;
#
#    my @text;
#
#    {
#        my $meta = $r->{meta} = $self->get_meta($r, $self->url);
#        push @text, $self->get_program_and_subcommand_name($r),
#            " version ", ($meta->{entity_v} // "?"),
#            ($meta->{entity_date} ? " ($meta->{entity_date})" : ''),
#            "\n";
#        for my $mod (@{ $meta->{'x.dynamic_generator_modules'} // [] }) {
#            push @text, "  $mod version ", ${"$mod\::VERSION"},
#                (${"$mod\::DATE"} ? " (".${"$mod\::DATE"}.")" : ""),
#                    "\n";
#        }
#    }
#
#    for my $url (@{ $self->extra_urls_for_version // [] }) {
#        my $meta = $self->get_meta($r, $url);
#        push @text, "  $url version ", ($meta->{entity_v} // "?"),
#            ($meta->{entity_date} ? " ($meta->{entity_date})" : ''),
#            "\n";
#    }
#
#    push @text, "  ", __PACKAGE__,
#        " version ", ($Perinci::CmdLine::Lite::VERSION // "?"),
#        ($Perinci::CmdLine::Lite::DATE ?
#         " ($Perinci::CmdLine::Lite::DATE)":''),
#        "\n";
#
#    [200, "OK", join("", @text)];
#}
#
#sub action_help {
#    require Perinci::CmdLine::Help;
#
#    my ($self, $r) = @_;
#
#    my @help;
#    my $scn    = $r->{subcommand_name};
#    my $scd    = $r->{subcommand_data};
#
#    my $meta = $self->get_meta($r, $scd->{url} // $self->{url});
#
#    my $common_opts = { %{$self->common_opts} };
#
#    my $has_sc_no_sc = $self->subcommands &&
#        !length($r->{subcommand_name} // '');
#    delete $common_opts->{subcommands} if $self->subcommands && !$has_sc_no_sc;
#
#    my $res = Perinci::CmdLine::Help::gen_help(
#        program_name => $self->get_program_and_subcommand_name($r),
#        program_summary => ($scd ? $scd->{summary}:undef ) // $meta->{summary},
#        program_description => $scd ? $scd->{description} : undef,
#        meta => $meta,
#        subcommands => $has_sc_no_sc ? $self->list_subcommands : undef,
#        common_opts => $common_opts,
#        per_arg_json => $self->per_arg_json,
#        per_arg_yaml => $self->per_arg_yaml,
#    );
#
#    $res->[3]{"cmdline.skip_format"} = 1;
#    $res;
#}
#
#sub action_call {
#    my ($self, $r) = @_;
#
#    my %extra;
#    if ($r->{send_argv}) {
#        log_trace("[pericmd] Sending argv to server: %s", $extra{argv});
#        $extra{argv} = $r->{orig_argv};
#    } else {
#        my %extra_args;
#        $extra_args{-dry_run} = 1 if $r->{dry_run};
#        $extra{args} = {%extra_args, %{$r->{args}}};
#    }
#
#    $extra{stream_arg} = 1 if $r->{stream_arg};
#
#    my $url = $r->{subcommand_data}{url};
#
#    log_trace("[pericmd] Riap request: action=call, url=%s", $url);
#
#
#    if ($r->{meta}{features}{progress}) {
#        $self->_setup_progress_output;
#    }
#
#    $self->riap_client->request(
#        call => $url, \%extra);
#}
#
#1;
#
#__END__
#
### Perinci/CmdLine/Util/Config.pm ###
#package Perinci::CmdLine::Util::Config;
#
#our $DATE = '2017-01-13'; 
#our $VERSION = '1.71'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#our %SPEC;
#
#sub _get_my_home_dir {
#    if ($^O eq 'MSWin32') {
#        return $ENV{HOME} if $ENV{HOME};
#        return $ENV{USERPROFILE} if $ENV{USERPROFILE};
#        return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
#            if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
#    } else {
#        return $ENV{HOME} if $ENV{HOME};
#        my @pw;
#        eval { @pw = getpwuid($>) };
#        return $pw[7] if @pw;
#    }
#    die "Can't get home directory";
#}
#
#$SPEC{get_default_config_dirs} = {
#    v => 1.1,
#    args => {},
#};
#sub get_default_config_dirs {
#    my @dirs;
#    my $home = _get_my_home_dir();
#    if ($^O eq 'MSWin32') {
#        push @dirs, $home;
#    } else {
#        push @dirs, "$home/.config", $home, "/etc";
#    }
#    \@dirs;
#}
#
#$SPEC{read_config} = {
#    v => 1.1,
#    args => {
#        config_paths    => {},
#        config_filename => {},
#        config_dirs     => {},
#        program_name    => {},
#    },
#};
#sub read_config {
#    require Config::IOD::Reader;
#
#    my %args = @_;
#
#    my $config_dirs = $args{config_dirs} // get_default_config_dirs();
#
#    my $paths;
#
#    my @filenames;
#    my %section_config_filename_map;
#    if (my $names = $args{config_filename}) {
#        for my $name (ref($names) eq 'ARRAY' ? @$names : ($names)) {
#            if (ref($name) eq 'HASH') {
#                $section_config_filename_map{$name->{filename}} = $name->{section};
#                push @filenames, $name->{filename};
#            } else {
#                $section_config_filename_map{$name} = 'GLOBAL';
#                push @filenames, $name;
#            }
#        }
#    }
#    unless (@filenames) {
#        @filenames = (($args{program_name} // "prog") . ".conf");
#    }
#
#    if ($args{config_paths}) {
#        $paths = $args{config_paths};
#    } else {
#        for my $dir (@$config_dirs) {
#            for my $name (@filenames) {
#                my $path = "$dir/" . $name;
#                push @$paths, $path if -e $path;
#            }
#        }
#    }
#
#    my $reader = Config::IOD::Reader->new;
#    my %res;
#    my @read;
#    my %section_read_order;
#    for my $i (0..$#{$paths}) {
#        my $path           = $paths->[$i];
#        my $filename = $path; $filename =~ s!.*[/\\]!!;
#        my $wanted_section = $section_config_filename_map{$filename};
#        my $j = 0;
#        $section_read_order{GLOBAL} = [$i, $j++];
#        my $hoh = $reader->read_file(
#            $path,
#            sub {
#                my %args = @_;
#                return unless $args{event} eq 'section';
#                my $section = $args{section};
#                $section_read_order{$section} = [$i, $j++];
#            },
#        );
#        push @read, $path;
#        for my $section (keys %$hoh) {
#            my $hash = $hoh->{$section};
#
#            my $s = $section; $s =~ s/\s*\S*=.*\z//; 
#            $s = 'GLOBAL' if $s eq '';
#            next unless !defined($wanted_section) || $s eq $wanted_section;
#
#            for (keys %$hash) {
#                $res{$section}{$_} = $hash->{$_};
#            }
#        }
#    }
#    [200, "OK", \%res, {
#        'func.read_files' => \@read,
#        'func.section_read_order' => \%section_read_order,
#    }];
#}
#
#$SPEC{get_args_from_config} = {
#    v => 1.1,
#    args => {
#        r => {},
#        config => {},
#        args => {},
#        subcommand_name => {},
#        config_profile => {},
#        common_opts => {},
#        meta => {},
#        meta_is_normalized => {},
#    },
#};
#sub get_args_from_config {
#    my %fargs = @_;
#
#    my $r       = $fargs{r};
#    my $conf    = $fargs{config};
#    my $progn   = $fargs{program_name};
#    my $scn     = $fargs{subcommand_name} // '';
#    my $profile = $fargs{config_profile};
#    my $args    = $fargs{args} // {};
#    my $copts   = $fargs{common_opts};
#    my $meta    = $fargs{meta};
#    my $found;
#
#    unless ($fargs{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
#    }
#
#    my $csro = $r->{_config_section_read_order} // {};
#    my @sections = sort {
#        my $csro_a = $csro->{$a} // [0,0];
#        my $csro_b = $csro->{$b} // [0,0];
#        $csro_a->[0] <=> $csro_b->[0] ||
#            $csro_a->[1] <=> $csro_b->[1] ||
#            $a cmp $b
#        } keys %$conf;
#
#    my %seen_profiles; 
#    for my $section0 (@sections) {
#        my %keyvals;
#        my $sect_name;
#        for my $word (split /\s+/, $section0) {
#            if ($word =~ /(.*?)=(.*)/) {
#                $keyvals{$1} = $2;
#            } else {
#                $sect_name //= $word;
#            }
#        }
#        $seen_profiles{$keyvals{profile}}++ if defined $keyvals{profile};
#
#        my $sect_scn     = $keyvals{subcommand} // '';
#        my $sect_profile = $keyvals{profile};
#
#        if (length $scn) {
#            if (length($sect_scn) && $sect_scn ne $scn) {
#                next;
#            }
#        } else {
#            if (length $sect_scn) {
#                next;
#            }
#        }
#
#        if (defined $profile) {
#            if (defined($sect_profile) && $sect_profile ne $profile) {
#                next;
#            }
#            $found = 1 if defined($sect_profile) && $sect_profile eq $profile;
#        } else {
#            if (defined($sect_profile)) {
#                next;
#            }
#        }
#
#        if (defined($progn) && defined($keyvals{program})) {
#            if ($progn ne $keyvals{program}) {
#                next;
#            }
#        }
#
#        if (defined(my $env = $keyvals{env})) {
#            my ($var, $val);
#            if (($var, $val) = $env =~ /\A(\w+)=(.*)\z/) {
#                if (($ENV{$var} // '') ne $val) {
#                    next;
#                }
#            } elsif (($var, $val) = $env =~ /\A(\w+)!=(.*)\z/) {
#                if (($ENV{$var} // '') eq $val) {
#                    next;
#                }
#            } elsif (($var, $val) = $env =~ /\A(\w+)\*=(.*)\z/) {
#                if (index(($ENV{$var} // ''), $val) < 0) {
#                    next;
#                }
#            } else {
#                if (!$ENV{$env}) {
#                    next;
#                }
#            }
#        }
#
#
#        my $as = $meta->{args} // {};
#        for my $k (keys %{ $conf->{$section0} }) {
#            my $v = $conf->{$section0}{$k};
#            if ($copts->{$k} && $copts->{$k}{is_settable_via_config}) {
#                my $sch = $copts->{$k}{schema};
#                if ($sch) {
#                    require Data::Sah::Normalize;
#                    $sch = Data::Sah::Normalize::normalize_schema($sch);
#                    if (ref($v) ne 'ARRAY' && $sch->[0] eq 'array') {
#                        $v = [$v];
#                    }
#                }
#                $copts->{$k}{handler}->(undef, $v, $r);
#            } else {
#                $k =~ s/\.arg\z//;
#
#                if (ref($v) ne 'ARRAY' && $as->{$k} && $as->{$k}{schema} &&
#                        $as->{$k}{schema}[0] eq 'array') {
#                    $v = [$v];
#                }
#                $args->{$k} = $v;
#            }
#        }
#    }
#
#    [200, "OK", $args, {'func.found'=>$found}];
#}
#
#1;
#
#__END__
#
### Perinci/Object.pm ###
#package Perinci::Object;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA    = qw(Exporter);
#our @EXPORT = qw(rimeta risub rivar ripkg envres envresmulti envrestable
#                 riresmeta);
#
#sub rimeta {
#    require Perinci::Object::Metadata;
#    Perinci::Object::Metadata->new(@_);
#}
#
#sub risub {
#    require Perinci::Object::Function;
#    Perinci::Object::Function->new(@_);
#}
#
#sub rivar {
#    require Perinci::Object::Variable;
#    Perinci::Object::Variable->new(@_);
#}
#
#sub ripkg {
#    require Perinci::Object::Package;
#    Perinci::Object::Package->new(@_);
#}
#
#sub envres {
#    require Perinci::Object::EnvResult;
#    Perinci::Object::EnvResult->new(@_);
#}
#
#sub envresmulti {
#    require Perinci::Object::EnvResultMulti;
#    Perinci::Object::EnvResultMulti->new(@_);
#}
#
#sub envrestable {
#    require Perinci::Object::EnvResultTable;
#    Perinci::Object::EnvResultTable->new(@_);
#}
#
#sub riresmeta {
#    require Perinci::Object::ResMeta;
#    Perinci::Object::ResMeta->new(@_);
#}
#
#1;
#
#__END__
#
### Perinci/Object/EnvResult.pm ###
#package Perinci::Object::EnvResult;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#sub new {
#    my ($class, $res) = @_;
#    $res //= [0, "", undef];
#    my $obj = \$res;
#    bless $obj, $class;
#}
#
#sub new_ok {
#    my $class = shift;
#    my $res = [200, "OK"];
#    if (@_) {
#        push @$res, $_[0];
#    }
#    $class->new($res);
#}
#
#sub status {
#    my ($self, $new) = @_;
#    if (defined $new) {
#        die "Status must be an integer between 100 and 555" unless
#            int($new) eq $new && $new >= 100 && $new <= 555;
#        my $old = ${$self}->[0];
#        ${$self}->[0] = $new;
#        return $old;
#    }
#    ${$self}->[0];
#}
#
#sub message {
#    my ($self, $new) = @_;
#    if (defined $new) {
#        die "Extra must be a string" if ref($new);
#        my $old = ${$self}->[1];
#        ${$self}->[1] = $new;
#        return $old;
#    }
#    ${$self}->[1];
#}
#
#
#sub payload {
#    my ($self, $new) = @_;
#    if (defined $new) {
#        my $old = ${$self}->[2];
#        ${$self}->[2] = $new;
#        return $old;
#    }
#    ${$self}->[2];
#}
#
#sub meta {
#    my ($self, $new) = @_;
#    if (defined $new) {
#        die "Extra must be a hashref" unless ref($new) eq 'HASH';
#        my $old = ${$self}->[3];
#        ${$self}->[3] = $new;
#        return $old;
#    }
#    ${$self}->[3];
#}
#
#sub is_success {
#    my ($self) = @_;
#    my $status = ${$self}->[0];
#    $status >= 200 && $status <= 299;
#}
#
#sub as_struct {
#    my ($self) = @_;
#    ${$self};
#}
#
#1;
#
#__END__
#
### Perinci/Object/EnvResultMulti.pm ###
#package Perinci::Object::EnvResultMulti;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use parent qw(Perinci::Object::EnvResult);
#
#sub new {
#    my ($class, $res) = @_;
#    $res //= [200, "Success/no items"];
#    my $obj = \$res;
#    bless $obj, $class;
#}
#
#sub add_result {
#    my ($self, $status, $message, $extra) = @_;
#    my $num_ok  = 0;
#    my $num_nok = 0;
#
#    push @{ ${$self}->[3]{results} },
#        {status=>$status, message=>$message, %{ $extra // {} }};
#    for (@{ ${$self}->[3]{results} // [] }) {
#        if ($_->{status} =~ /\A(2|304)/) {
#            $num_ok++;
#        } else {
#            $num_nok++;
#        }
#    }
#    if ($num_ok) {
#        if ($num_nok) {
#            ${$self}->[0] = 207;
#            ${$self}->[1] = "Partial success";
#        } else {
#            ${$self}->[0] = 200;
#            ${$self}->[1] = "All success";
#        }
#    } else {
#        ${$self}->[0] = $status;
#        ${$self}->[1] = $message;
#    }
#}
#
#1;
#
#__END__
#
### Perinci/Object/EnvResultTable.pm ###
#package Perinci::Object::EnvResultTable;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use parent qw(Perinci::Object::EnvResult);
#
#sub add_field {
#    my ($self, $name, %attrs) = @_;
#    ${$self}->[3]{'table.fields'} //= [];
#    push @{ ${$self}->[3]{'table.fields'} }, $name;
#}
#
#1;
#
#__END__
#
### Perinci/Object/Function.pm ###
#package Perinci::Object::Function;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use parent qw(Perinci::Object::Metadata);
#
#sub type { "function" }
#
#sub feature {
#    my $self = shift;
#    my $name = shift;
#    if (@_) {
#        die "1.0 can't set feature" if $self->v eq 1.0;
#        my $value = shift;
#        ${$self}->{features} //= {};
#        my $old = ${$self}->{features}{$name};
#        ${$self}->{features}{$name} = $value;
#        return $old;
#    } else {
#        ${$self}->{features}{$name};
#    }
#}
#
#sub features {
#    my $self = shift;
#    ${$self}->{features} // {};
#}
#
#sub can_dry_run {
#    my $self = shift;
#    my $ff = ${$self}->{features} // {};
#    $ff->{dry_run} // $ff->{tx} && $ff->{tx}{v} == 2;
#}
#
#sub default_dry_run {
#    my $self = shift;
#    my $ff = ${$self}->{features} // {};
#    ref($ff->{dry_run}) eq 'HASH' && $ff->{dry_run}{default};
#}
#
#sub arg {
#    my $self = shift;
#    my $name = shift;
#    if (@_) {
#        die "1.0 can't set arg" if $self->v eq 1.0;
#        my $value = shift;
#        ${$self}->{args} //= {};
#        my $old = ${$self}->{args}{$name};
#        ${$self}->{args}{$name} = $value;
#        return $old;
#    } else {
#        ${$self}->{args}{$name};
#    }
#}
#
#1;
#
#__END__
#
### Perinci/Object/Metadata.pm ###
#package Perinci::Object::Metadata;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#sub __trim_blank_lines {
#    local $_ = shift;
#    return $_ unless defined;
#    s/\A(?:\n\s*)+//;
#    s/(?:\n\s*){2,}\z/\n/;
#    $_;
#}
#
#sub new {
#    my ($class, $meta) = @_;
#    $meta //= {};
#    my $obj = \$meta;
#    bless $obj, $class;
#}
#
#sub v {
#    my $self = shift;
#    ${$self}->{v} // 1.0;
#}
#
#sub type {
#    die "BUG: type() must be subclassed";
#}
#
#sub as_struct {
#    my $self = shift;
#    ${$self};
#}
#
#sub langprop {
#    my $self = shift;
#    my $opts;
#    if (ref($_[0]) eq 'HASH') {
#        $opts = shift;
#    } else {
#        $opts = {};
#    }
#    my $prop = shift;
#
#    my $deflang = ${$self}->{default_lang} // "en_US";
#    my $olang   = $opts->{lang} || $ENV{LANGUAGE} || $ENV{LANG} || $deflang;
#    $olang =~ s/\W.+//; 
#    $olang = "en_US" if $olang eq 'C';
#    (my $olang2 = $olang) =~ s/\A([a-z]{2})_[A-Z]{2}\z/$1/; 
#    my $mark    = $opts->{mark_different_lang} // 1;
#
#    my @k;
#    if ($olang eq $deflang) {
#        @k = ([$olang, $prop, 0]);
#    } else {
#        @k = (
#            [$olang, "$prop.alt.lang.$olang", 0],
#            ([$olang2, "$prop.alt.lang.$olang2", 0]) x !!($olang2 ne $olang),
#            [$deflang, $prop, $mark],
#        );
#    }
#
#    my $v;
#  GET:
#    for my $k (@k) {
#        $v = ${$self}->{$k->[1]};
#        if (defined $v) {
#            if ($k->[2]) {
#                my $has_nl = $v =~ s/\n\z//;
#                $v = "{$olang|$k->[0] $v}" . ($has_nl ? "\n" : "");
#            }
#            $v = __trim_blank_lines($v);
#            last GET;
#        }
#    }
#
#    if (@_) {
#        ${$self}->{$k[0][1]} = $_[0];
#    }
#
#    $v;
#}
#
#sub name {
#    my $self = shift;
#    my $opts;
#    if (@_ && ref($_[0]) eq 'HASH') {
#        $opts = shift;
#    } else {
#        $opts = {};
#    }
#    $self->langprop($opts, "name", @_);
#}
#
#sub caption {
#    my $self = shift;
#    my $opts;
#    if (@_ && ref($_[0]) eq 'HASH') {
#        $opts = shift;
#    } else {
#        $opts = {};
#    }
#    $self->langprop($opts, "caption", @_);
#}
#
#sub summary {
#    my $self = shift;
#    my $opts;
#    if (@_ && ref($_[0]) eq 'HASH') {
#        $opts = shift;
#    } else {
#        $opts = {};
#    }
#    $self->langprop($opts, "summary", @_);
#}
#
#sub description {
#    my $self = shift;
#    my $opts;
#    if (@_ && ref($_[0]) eq 'HASH') {
#        $opts = shift;
#    } else {
#        $opts = {};
#    }
#    $self->langprop($opts, "description", @_);
#}
#
#1;
#
#__END__
#
### Perinci/Object/Package.pm ###
#package Perinci::Object::Package;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use parent qw(Perinci::Object::Metadata);
#
#sub type { "package" }
#
#1;
#
#__END__
#
### Perinci/Object/ResMeta.pm ###
#package Perinci::Object::ResMeta;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use parent qw(Perinci::Object::Metadata);
#
#sub type { "resmeta" }
#
#1;
#
#__END__
#
### Perinci/Object/Variable.pm ###
#package Perinci::Object::Variable;
#
#our $DATE = '2017-02-03'; 
#our $VERSION = '0.30'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use parent qw(Perinci::Object::Metadata);
#
#sub type { "variable" }
#
#1;
#
#__END__
#
### Perinci/Result/Format/Lite.pm ###
#package Perinci::Result::Format::Lite;
#
#our $DATE = '2017-05-31'; 
#our $VERSION = '0.25'; 
#
#use 5.010001;
#
#use List::Util qw(first max);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(format);
#
#sub firstidx (&@) {
#    my $f = shift;
#    foreach my $i ( 0 .. $#_ )
#        {
#            local *_ = \$_[$i];
#            return $i if $f->();
#        }
#    return -1;
#}
#
#sub _json {
#    state $json = do {
#        if    (eval { require Cpanel::JSON::XS; 1 })   { Cpanel::JSON::XS->new->canonical(1)->convert_blessed->allow_nonref }
#        elsif (eval { require JSON::Tiny::Subclassable; 1 }) { JSON::Tiny::Subclassable->new }
#        elsif (eval { require JSON::PP; 1 })   { JSON::PP->new->canonical(1)->convert_blessed->allow_nonref }
#        else { die "Can't find any JSON module" }
#    };
#    $json;
#};
#
#sub __cleanse {
#    state $cleanser = do {
#        eval { require Data::Clean::JSON; 1 };
#        if ($@) {
#            undef;
#        } else {
#            Data::Clean::JSON->get_cleanser;
#        }
#    };
#    if ($cleanser) {
#        $cleanser->clean_in_place($_[0]);
#    } else {
#        $_[0];
#    }
#}
#
#sub __gen_table {
#    my ($data, $header_row, $resmeta, $format) = @_;
#
#    $resmeta //= {};
#
#    my @columns;
#    if ($header_row) {
#        @columns = @{$data->[0]};
#    } else {
#        @columns = map {"col$_"} 0..@{$data->[0]}-1;
#    }
#
#    my $column_orders; 
#  SET_COLUMN_ORDERS: {
#
#        my $tcos;
#        if ($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS}) {
#            $tcos = _json->encode($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS});
#        } elsif (my $rfos = ($resmeta->{'cmdline.format_options'} //
#                                 $resmeta->{format_options})) {
#            my $rfo = $rfos->{'text-pretty'} // $rfos->{text} // $rfos->{any};
#            if ($rfo) {
#                $tcos = $rfo->{table_column_orders};
#            }
#        }
#        if ($tcos) {
#          COLS:
#            for my $cols (@$tcos) {
#                for my $col (@$cols) {
#                    next COLS unless first {$_ eq $col} @columns;
#                }
#                $column_orders = $cols;
#                last SET_COLUMN_ORDERS;
#            }
#        }
#
#        $column_orders = $resmeta->{'table.fields'};
#    }
#
#    if ($column_orders) {
#        my @map0 = sort {
#            my $idx_a = firstidx(sub {$_ eq $a->[1]},
#                                 @$column_orders) // 9999;
#            my $idx_b = firstidx(sub {$_ eq $b->[1]},
#                                 @$column_orders) // 9999;
#            $idx_a <=> $idx_b || $a->[1] cmp $b->[1];
#        } map {[$_, $columns[$_]]} 0..$#columns;
#        my @map;
#        for (0..$#map0) {
#            $map[$_] = $map0[$_][0];
#        }
#        my $newdata = [];
#        for my $row (@$data) {
#            my @newrow;
#            for (0..$#map) { $newrow[$_] = $row->[$map[$_]] }
#            push @$newdata, \@newrow;
#        }
#        $data = $newdata;
#        my @newcolumns;
#        for (@map) { push @newcolumns, $columns[$_] }
#        @columns = @newcolumns;
#    }
#
#    my @field_idxs; 
#    {
#        my $tff = $resmeta->{'table.fields'} or last;
#        for my $i (0..$#columns) {
#            $field_idxs[$i] = firstidx { $_ eq $columns[$i] } @$tff;
#        }
#    }
#
#    {
#        last unless $header_row && @$data;
#        my $tff = $resmeta->{'table.fields'} or last;
#        my $tfu = $resmeta->{'table.field_units'} or last;
#        for my $i (0..$#columns) {
#            my $field_idx = $field_idxs[$i];
#            next unless $field_idx >= 0;
#            next unless defined $tfu->[$field_idx];
#            $data->[0][$i] .= " ($tfu->[$field_idx])";
#        }
#    }
#
#    {
#        my $tff   = $resmeta->{'table.fields'} or last;
#        my $tffmt = $resmeta->{'table.field_formats'} or last;
#
#        my (@fmt_names, @fmt_opts); 
#        for my $i (0..$#columns) {
#            my $field_idx = $field_idxs[$i];
#            next unless $field_idx >= 0;
#            next unless defined $tffmt->[$field_idx];
#            if (ref($tffmt->[$field_idx]) eq 'ARRAY') {
#                $fmt_names[$i] = $tffmt->[$field_idx][0];
#                $fmt_opts [$i] = $tffmt->[$field_idx][1] // {};
#            } else {
#                $fmt_names[$i] = $tffmt->[$field_idx];
#                $fmt_opts [$i] = {};
#            }
#        }
#
#        my $nf;
#
#        for my $i (0..$#{$data}) {
#            next if $i==0 && $header_row;
#            my $row = $data->[$i];
#            for my $j (0..$#columns) {
#                next unless defined $row->[$j];
#                my $field_idx = $field_idxs[$j];
#                next unless $field_idx >= 0;
#                my $fmt_name = $fmt_names[$j];
#                next unless $fmt_name;
#                my $fmt_opts = $fmt_opts [$j];
#                if ($fmt_name eq 'iso8601_datetime' || $fmt_name eq 'iso8601_date') {
#                    if ($row->[$j] =~ /\A[0-9]+\z/) {
#                        my @t = gmtime($row->[$j]);
#                        if ($fmt_name eq 'iso8601_datetime') {
#                            $row->[$j] = sprintf(
#                                "%04d-%02d-%02dT%02d:%02d:%02dZ",
#                                $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);
#                        } else {
#                            $row->[$j] = sprintf(
#                                "%04d-%02d-%02d",
#                                $t[5]+1900, $t[4]+1, $t[3]);
#                        }
#                    }
#                } elsif ($fmt_name eq 'boolstr') {
#                    $row->[$j] = $row->[$j] ? "yes" : "no";
#                } elsif ($fmt_name eq 'sci2dec') {
#                    if ($row->[$j] =~ /\A(?:[+-]?)(?:\d+\.|\d*\.(\d+))[eE]([+-]?\d+)\z/) {
#                        my $n = length($1 || "") - $2; $n = 0 if $n < 0;
#                        $row->[$j] = sprintf("%.${n}f", $row->[$j]);
#                    }
#                } elsif ($fmt_name eq 'percent') {
#                    my $fmt = $fmt_opts->{sprintf} // '%.2f%%';
#                    $row->[$j] = sprintf($fmt, $row->[$j] * 100);
#                } elsif ($fmt_name eq 'number') {
#                    $nf //= do {
#                        require Number::Format;
#                        Number::Format->new(
#                            THOUSANDS_SEP => $fmt_opts->{thousands_sep} // ',',
#                            DECIMAL_POINT => $fmt_opts->{decimal_point} // '.',
#                            DECIMAL_FILL  => $fmt_opts->{decimal_fill} // 1,
#                        );
#                    };
#                    $row->[$j] = $nf->format_number(
#                        $row->[$j], $fmt_opts->{precision} // 0);
#                }
#            }
#        }
#    }
#
#    if ($format eq 'text-pretty') {
#        {
#            no warnings;
#
#            my $tfa = $resmeta->{'table.field_aligns'} or last;
#            last unless @$data;
#
#            for my $colidx (0..$#columns) {
#                my $field_idx = $field_idxs[$colidx];
#                next unless $field_idx >= 0;
#                my $align = $tfa->[$field_idx];
#                next unless $align;
#
#                my $maxw;
#                my ($maxw_bd, $maxw_d, $maxw_ad); 
#                if ($align eq 'number') {
#                    my (@w_bd, @w_d, @w_ad);
#                    for my $i (0..$#{$data}) {
#                        my $row = $data->[$i];
#                        if (@$row > $colidx) {
#                            my $cell = $row->[$colidx];
#                            if ($header_row && $i == 0) {
#                                my $w = length($cell);
#                                push @w_bd, 0;
#                                push @w_bd, 0;
#                                push @w_ad, 0;
#                            } elsif ($cell =~ /\A([+-]?\d+)(\.?)(\d*)\z/) {
#                                push @w_bd, length($1);
#                                push @w_d , length($2);
#                                push @w_ad, length($3);
#                            } elsif ($cell =~ /\A([+-]?\d+\.?\d*)([eE])([+-]?\d+)\z/) {
#                                push @w_bd, length($1);
#                                push @w_d , length($2);
#                                push @w_ad, length($3);
#                            } else {
#                                push @w_bd, length($cell);
#                                push @w_bd, 0;
#                                push @w_ad, 0;
#                            }
#                        } else {
#                            push @w_bd, 0;
#                            push @w_d , 0;
#                            push @w_ad, 0;
#                        }
#                    }
#                    $maxw_bd = max(@w_bd);
#                    $maxw_d  = max(@w_d);
#                    $maxw_ad = max(@w_ad);
#                    if ($header_row) {
#                        my $w = length($data->[0][$colidx]);
#                        if ($maxw_d == 0 && $maxw_ad == 0) {
#                            $maxw_bd = $w;
#                        }
#                    }
#                }
#
#                $maxw = max(map {
#                    @$_ > $colidx ? length($_->[$colidx]) : 0
#                } @$data);
#
#                for my $i (0..$#{$data}) {
#                    my $row = $data->[$i];
#                    for my $i (0..$#{$data}) {
#                        my $row = $data->[$i];
#                        next unless @$row > $colidx;
#                        my $cell = $row->[$colidx];
#                        next unless defined($cell);
#                        if ($align eq 'number') {
#                            my ($bd, $d, $ad);
#                            if ($header_row && $i == 0) {
#                            } elsif (($bd, $d, $ad) = $cell =~ /\A([+-]?\d+)(\.?)(\d*)\z/) {
#                                $cell = join(
#                                    '',
#                                    (' ' x ($maxw_bd - length($bd))), $bd,
#                                    $d , (' ' x ($maxw_d  - length($d ))),
#                                    $ad, (' ' x ($maxw_ad - length($ad))),
#                                );
#                            } elsif (($bd, $d, $ad) = $cell =~ /\A([+-]?\d+\.?\d*)([eE])([+-]?\d+)\z/) {
#                                $cell = join(
#                                    '',
#                                    (' ' x ($maxw_bd - length($bd))), $bd,
#                                    $d , (' ' x ($maxw_d  - length($d ))),
#                                    $ad, (' ' x ($maxw_ad - length($ad))),
#                                );
#                            }
#                            my $w = length($cell);
#                            $cell = (' ' x ($maxw - $w)) . $cell
#                                if $maxw > $w;
#                        } elsif ($align eq 'right') {
#                            $cell = (' ' x ($maxw - length($cell))) . $cell;
#                        } elsif ($align eq 'middle' || $align eq 'center') {
#                            my $w = length($cell);
#                            my $n = int(($maxw-$w)/2);
#                            $cell = (' ' x $n) . $cell . (' ' x ($maxw-$w-$n));
#                        } else {
#                            $cell .= (' ' x ($maxw - length($cell)));
#
#                        }
#                        $row->[$colidx] = $cell;
#                    }
#                }
#            } 
#        } 
#
#        my $fres;
#        if (my $backend = $ENV{FORMAT_PRETTY_TABLE_BACKEND}) {
#            require Text::Table::Any;
#            $fres = Text::Table::Any::table(rows=>$data, header_row=>$header_row, backend=>$backend);
#        } else {
#            require Text::Table::Tiny;
#            $fres = Text::Table::Tiny::table(rows=>$data, header_row=>$header_row);
#        }
#        $fres .= "\n" unless $fres =~ /\R\z/ || !length($fres);
#        $fres;
#    } elsif ($format eq 'csv') {
#        no warnings 'uninitialized';
#        join(
#            "",
#            map {
#                my $row = $_;
#                join(
#                    ",",
#                    map {
#                        my $cell = $_;
#                        $cell =~ s/(["\\])/\\$1/g;
#                        qq("$cell");
#                    } @$row)."\n";
#            } @$data
#        );
#    } elsif ($format eq 'html') {
#        no warnings 'uninitialized';
#        require HTML::Entities;
#
#        my $tfa = $resmeta->{'table.field_aligns'};
#
#        my @res;
#        push @res, "<table".($resmeta->{'table.html_class'} ?
#                                 " class=\"".HTML::Entities::encode_entities(
#                                     $resmeta->{'table.html_class'})."\"" : "").
#                                         ">\n";
#        for my $i (0..$#{$data}) {
#            my $data_elem = $i == 0 ? "th" : "td";
#            push @res, "<thead>\n" if $i == 0;
#            push @res, "<tbody>\n" if $i == 1;
#            push @res, " <tr>\n";
#            my $row = $data->[$i];
#            for my $j (0..$#{$row}) {
#                my $field_idx = $field_idxs[$j];
#                my $align;
#                if ($field_idx >= 0 && $tfa->[$field_idx]) {
#                    $align = $tfa->[$field_idx];
#                    $align = "right" if $align eq 'number';
#                    $align = "middle" if $align eq 'center';
#                }
#                push @res, "  <$data_elem",
#                    ($align ? " align=\"$align\"" : ""),
#                    ">", HTML::Entities::encode_entities($row->[$j]),
#                    "</$data_elem>\n";
#            }
#            push @res, " </tr>\n";
#            push @res, "</thead>\n" if $i == 0;
#        }
#        push @res, "</tbody>\n";
#        push @res, "</table>\n";
#        join '', @res;
#    } else {
#        no warnings 'uninitialized';
#        shift @$data if $header_row;
#        join("", map {join("\t", @$_)."\n"} @$data);
#    }
#}
#
#sub format {
#    my ($res, $format, $is_naked, $cleanse) = @_;
#
#    if ($format =~ /\A(text|text-simple|text-pretty|csv|html)\z/) {
#        $format = $format eq 'text' ?
#            ((-t STDOUT) ? 'text-pretty' : 'text-simple') : $format;
#        no warnings 'uninitialized';
#        if ($res->[0] !~ /^(2|304)/) {
#            my $fres = "ERROR $res->[0]: $res->[1]";
#            if (my $prev = $res->[3]{prev}) {
#                $fres .= " ($prev->[0]: $prev->[1])";
#            }
#            return "$fres\n";
#        } elsif ($res->[3] && $res->[3]{"x.hint.result_binary"}) {
#            return $res->[2];
#        } else {
#            require Data::Check::Structure;
#            my $data = $res->[2];
#            my $max = 5;
#            if (!ref($data)) {
#                $data //= "";
#                $data .= "\n" unless !length($data) || $data =~ /\n\z/;
#                return $data;
#            } elsif (ref($data) eq 'ARRAY' && !@$data) {
#                return "";
#            } elsif (Data::Check::Structure::is_aos($data, {max=>$max})) {
#                return join("", map {"$_\n"} @$data);
#            } elsif (Data::Check::Structure::is_aoaos($data, {max=>$max})) {
#                my $header_row = 0;
#                my $data = $data;
#                if ($res->[3]{'table.fields'}) {
#                    $data = [$res->[3]{'table.fields'}, @$data];
#                    $header_row = 1;
#                }
#                return __gen_table($data, $header_row, $res->[3], $format);
#            } elsif (Data::Check::Structure::is_hos($data, {max=>$max})) {
#                $data = [map {[$_, $data->{$_}]} sort keys %$data];
#                unshift @$data, ["key", "value"];
#                return __gen_table($data, 1, $res->[3], $format);
#            } elsif (Data::Check::Structure::is_aohos($data, {max=>$max})) {
#                my @fieldnames;
#                if ($res->[3] && $res->[3]{'table.fields'} &&
#                        $res->[3]{'table.hide_unknown_fields'}) {
#                    @fieldnames = @{ $res->[3]{'table.fields'} };
#                } else {
#                    my %fieldnames;
#                    for my $row (@$data) {
#                        $fieldnames{$_}++ for keys %$row;
#                    }
#                    @fieldnames = sort keys %fieldnames;
#                }
#                my $newdata = [];
#                for my $row (@$data) {
#                    push @$newdata, [map {$row->{$_}} @fieldnames];
#                }
#                unshift @$newdata, \@fieldnames;
#                return __gen_table($newdata, 1, $res->[3], $format);
#            } else {
#                $format = 'json-pretty';
#            }
#        }
#    }
#
#    my $tff = $res->[3]{'table.fields'};
#    $res = $res->[2] if $is_naked;
#
#    unless ($format =~ /\Ajson(-pretty)?\z/) {
#        warn "Unknown format '$format', fallback to json-pretty";
#        $format = 'json-pretty';
#    }
#    __cleanse($res) if ($cleanse//1);
#    if ($format =~ /json/) {
#        if ($tff && _json->can("sort_by") &&
#                eval { require Sort::ByExample; 1}) {
#            my $cmp = Sort::ByExample->cmp($tff);
#            _json->sort_by(sub { $cmp->($JSON::PP::a, $JSON::PP::b) });
#        }
#
#        if ($format eq 'json') {
#            return _json->encode($res) . "\n";
#        } else {
#            _json->pretty(1);
#            return _json->encode($res);
#        }
#    }
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Complete.pm ###
#package Perinci::Sub::Complete;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.92'; 
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Complete::Util qw(hashify_answer complete_array_elem complete_hash_key combine_answers modify_answer);
#use Complete::Common qw(:all);
#use Perinci::Sub::Util qw(gen_modified_sub);
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       complete_from_schema
#                       complete_arg_val
#                       complete_arg_index
#                       complete_arg_elem
#                       complete_cli_arg
#               );
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using Rinci metadata',
#};
#
#my %common_args_riap = (
#    riap_client => {
#        summary => 'Optional, to perform complete_arg_val to the server',
#        schema  => 'obj*',
#        description => <<'_',
#
#When the argument spec in the Rinci metadata contains `completion` key, this
#means there is custom completion code for that argument. However, if retrieved
#from a remote server, sometimes the `completion` key no longer contains the code
#(it has been cleansed into a string). Moreover, the completion code needs to run
#on the server.
#
#If supplied this argument and te `riap_server_url` argument, the function will
#try to request to the server (via Riap request `complete_arg_val`). Otherwise,
#the function will just give up/decline completing.
#
#_
#        },
#    riap_server_url => {
#        summary => 'Optional, to perform complete_arg_val to the server',
#        schema  => 'str*',
#        description => <<'_',
#
#See the `riap_client` argument.
#
#_
#    },
#    riap_uri => {
#        summary => 'Optional, to perform complete_arg_val to the server',
#        schema  => 'str*',
#        description => <<'_',
#
#See the `riap_client` argument.
#
#_
#    },
#);
#
#$SPEC{complete_from_schema} = {
#    v => 1.1,
#    summary => 'Complete a value from schema',
#    description => <<'_',
#
#Employ some heuristics to complete a value from Sah schema. For example, if
#schema is `[str => in => [qw/new open resolved rejected/]]`, then we can
#complete from the `in` clause. Or for something like `[int => between => [1,
#20]]` we can complete using values from 1 to 20.
#
#_
#    args => {
#        schema => {
#            summary => 'Must be normalized',
#            req => 1,
#        },
#        word => {
#            schema => [str => default => ''],
#            req => 1,
#        },
#    },
#};
#sub complete_from_schema {
#    my %args = @_;
#    my $sch  = $args{schema}; 
#    my $word = $args{word} // "";
#
#    my $fres;
#    log_trace("[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_trace("[comp][periscomp] retrieving schema from module %s, base type=%s", $pkg, $type);
#    }
#
#    my $static;
#    my $words;
#    eval {
#        if (my $xcomp = $cs->{'x.completion'}) {
#            require Module::Installed::Tiny;
#            my $comp;
#            if (ref($xcomp) eq 'CODE') {
#                $comp = $xcomp;
#            } else {
#                my ($submod, $xcargs);
#                if (ref($xcomp) eq 'ARRAY') {
#                    $submod = $xcomp->[0];
#                    $xcargs = $xcomp->[1];
#                } else {
#                    $submod = $xcomp;
#                    $xcargs = {};
#                }
#                my $mod = "Perinci::Sub::XCompletion::$submod";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[comp][periscomp] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    my $fref = \&{"$mod\::gen_completion"};
#                    $comp = $fref->(%$xcargs);
#                }
#            }
#            if ($comp) {
#                log_trace("[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_trace("[comp][periscomp] adding completion from schema's 'is' clause");
#            push @$words, $cs->{is};
#            $static++;
#            return; 
#        }
#        if ($cs->{in}) {
#            log_trace("[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_trace("[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_trace("[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_trace("[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_trace("[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_trace("[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_trace("[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_trace("[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_trace("[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_trace("[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_trace("[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_trace("[comp][periscomp] leaving complete_from_schema, result=%s", $fres);
#    $fres;
#}
#
#$SPEC{complete_arg_val} = {
#    v => 1.1,
#    summary => 'Given argument name and function metadata, complete value',
#    description => <<'_',
#
#Will attempt to complete using the completion routine specified in the argument
#specification (the `completion` property, or in the case of `complete_arg_elem`
#function, the `element_completion` property), or if that is not specified, from
#argument's schema using `complete_from_schema`.
#
#Completion routine will get `%args`, with the following keys:
#
#* `word` (str, the word to be completed)
#* `arg` (str, the argument name which value is currently being completed)
#* `index (int, only for the `complete_arg_elem` function, the index in the
#   argument array that is currently being completed, starts from 0)
#* `args` (hash, the argument hash to the function, so far)
#
#as well as extra keys from `extras` (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#<pm:Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata, must be normalized',
#            schema => 'hash*',
#            req => 1,
#        },
#        arg => {
#            summary => 'Argument name',
#            schema => 'str*',
#            req => 1,
#        },
#        word => {
#            summary => 'Word to be completed',
#            schema => ['str*', default => ''],
#        },
#        args => {
#            summary => 'Collected arguments so far, '.
#                'will be passed to completion routines',
#            schema  => 'hash',
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array', 
#    },
#};
#sub complete_arg_val {
#    my %args = @_;
#
#    log_trace("[comp][periscomp] entering complete_arg_val, arg=<%s>", $args{arg});
#    my $fres;
#
#    my $extras = $args{extras} // {};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { 
#
#        my $comp;
#      GET_COMP_ROUTINE:
#        {
#            $comp = $arg_spec->{completion};
#            if ($comp) {
#                log_trace("[comp][periscomp] using arg completion routine from arg spec's 'completion' property");
#                last GET_COMP_ROUTINE;
#            }
#            my $xcomp = $arg_spec->{'x.completion'};
#            if ($xcomp) {
#                if (ref($xcomp) eq 'CODE') {
#                    $comp = $xcomp;
#                } else {
#                    my ($submod, $xcargs);
#                    if (ref($xcomp) eq 'ARRAY') {
#                        $submod = $xcomp->[0];
#                        $xcargs = $xcomp->[1];
#                    } else {
#                        $submod = $xcomp;
#                        $xcargs = {};
#                    }
#                    my $mod = "Perinci::Sub::XCompletion::$submod";
#                    require Module::Installed::Tiny;
#                    if (Module::Installed::Tiny::module_installed($mod)) {
#                        log_trace("[comp][periscomp] loading module %s ...", $mod);
#                        my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                        require $mod_pm;
#                        my $fref = \&{"$mod\::gen_completion"};
#                        $comp = $fref->(%$xcargs);
#                    }
#                }
#                if ($comp) {
#                    log_trace("[comp][periscomp] using arg completion routine from arg spec's 'x.completion' attribute");
#                    last GET_COMP_ROUTINE;
#                }
#            }
#            my $ent = $arg_spec->{'x.schema.entity'};
#            if ($ent) {
#                require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::ArgEntity::$ent";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[comp][periscomp] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    if (defined &{"$mod\::complete_arg_val"}) {
#                        log_trace("[comp][periscomp] 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_trace("[comp][periscomp] invoking arg completion routine");
#                $fres = $comp->(
#                    %$extras,
#                    word=>$word, arg=>$arg, args=>$args{args});
#                return; 
#            } elsif (ref($comp) eq 'ARRAY') {
#                log_trace("[comp][periscomp] using array specified in arg completion routine: %s", $comp);
#                $fres = complete_array_elem(array=>$comp, word=>$word);
#                $static++;
#                return; 
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'completion' property is not a coderef or arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_val request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_val => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, word=>$word},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; 
#                }
#                $fres = $res->[2];
#                return; 
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; 
#        }
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            log_trace("[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_trace("[comp][periscomp] no completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_val, result=%s", $fres);
#    $fres;
#}
#
#gen_modified_sub(
#    output_name  => 'complete_arg_elem',
#    install_sub  => 0,
#    base_name    => 'complete_arg_val',
#    summary      => 'Given argument name and function metadata, '.
#        'complete array element',
#    add_args     => {
#        index => {
#            summary => 'Index of element to complete',
#            schema  => ['str*'],
#        },
#    },
#);
#sub complete_arg_elem {
#    require Data::Sah::Normalize;
#
#    my %args = @_;
#
#    my $fres;
#
#    log_trace("[comp][periscomp] entering complete_arg_elem, arg=<%s>, index=<%d>",
#                 $args{arg}, $args{index});
#
#    my $extras = $args{extras} // {};
#
#    my $ourextras = {arg=>$args{arg}, args=>$args{args}};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    defined(my $index = $args{index}) or do {
#        log_trace("[comp][periscomp] index is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { 
#
#        my $elcomp;
#      GET_ELCOMP_ROUTINE:
#        {
#            $elcomp = $arg_spec->{element_completion};
#            if ($elcomp) {
#                log_trace("[comp][periscomp] using arg element completion routine from 'element_completion' property");
#                last GET_ELCOMP_ROUTINE;
#            }
#            my $xelcomp = $arg_spec->{'x.element_completion'};
#            if ($xelcomp) {
#                if (ref($xelcomp) eq 'CODE') {
#                    $elcomp = $xelcomp;
#                } else {
#                    my ($submod, $xcargs);
#                    if (ref($xelcomp) eq 'ARRAY') {
#                        $submod = $xelcomp->[0];
#                        $xcargs = $xelcomp->[1];
#                    } else {
#                        $submod = $xelcomp;
#                        $xcargs = {};
#                    }
#                    my $mod = "Perinci::Sub::XCompletion::$submod";
#                    require Module::Installed::Tiny;
#                    if (Module::Installed::Tiny::module_installed($mod)) {
#                        log_trace("[comp][periscomp] loading module %s ...", $mod);
#                        my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                        require $mod_pm;
#                        my $fref = \&{"$mod\::gen_completion"};
#                        $elcomp = $fref->(%$xcargs);
#                    }
#                }
#                if ($elcomp) {
#                    log_trace("[comp][periscomp] using arg element completion routine from 'x.element_completion' attribute");
#                    last GET_ELCOMP_ROUTINE;
#                }
#            }
#            my $ent = $arg_spec->{'x.schema.element_entity'};
#            if ($ent) {
#                require Module::Installed::Tiny;
#                my $mod = "Perinci::Sub::ArgEntity::$ent";
#                if (Module::Installed::Tiny::module_installed($mod)) {
#                    log_trace("[comp][periscomp] loading module %s ...", $mod);
#                    my $mod_pm = $mod; $mod_pm =~ s!::!/!g; $mod_pm .= ".pm";
#                    require $mod_pm;
#                    if (defined &{"$mod\::complete_arg_val"}) {
#                        log_trace("[comp][periscomp] 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_trace("[comp][periscomp] invoking arg element completion routine");
#                $fres = $elcomp->(
#                    %$extras,
#                    %$ourextras,
#                    word=>$word);
#                return; 
#            } elsif (ref($elcomp) eq 'ARRAY') {
#                log_trace("[comp][periscomp] using array specified in arg element completion routine: %s", $elcomp);
#                $fres = complete_array_elem(array=>$elcomp, word=>$word);
#                $static = $word eq '';
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'element_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_elem request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_elem => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, args=>$args{args}, word=>$word,
#                     index=>$index},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; 
#                }
#                $fres = $res->[2];
#                return; 
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; 
#        } 
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            log_trace("[comp][periscomp] arg spec does not specify schema, declining");
#            return; 
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'array') {
#            log_trace("[comp][periscomp] can't complete element for non-array");
#            return; 
#        }
#
#        unless ($cs->{of}) {
#            log_trace("[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_trace("[comp][periscomp] no completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_elem, result=%s", $fres);
#    $fres;
#}
#
#$SPEC{complete_arg_index} = {
#    v => 1.1,
#    summary => 'Given argument name and function metadata, complete arg element index',
#    description => <<'_',
#
#This is only relevant for arguments which have `index_completion` property set
#(currently only `hash` type arguments). When that property is not set, will
#simply return undef.
#
#Completion routine will get `%args`, with the following keys:
#
#* `word` (str, the word to be completed)
#* `arg` (str, the argument name which value is currently being completed)
#* `args` (hash, the argument hash to the function, so far)
#
#as well as extra keys from `extras` (but these won't overwrite the above
#standard keys).
#
#Completion routine should return a completion answer structure (described in
#<pm:Complete>) which is either a hash or an array. The simplest form of answer
#is just to return an array of strings. Completion routine can also return undef
#to express declination.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata, must be normalized',
#            schema => 'hash*',
#            req => 1,
#        },
#        arg => {
#            summary => 'Argument name',
#            schema => 'str*',
#            req => 1,
#        },
#        word => {
#            summary => 'Word to be completed',
#            schema => ['str*', default => ''],
#        },
#        args => {
#            summary => 'Collected arguments so far, '.
#                'will be passed to completion routines',
#            schema  => 'hash',
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'array', 
#    },
#};
#sub complete_arg_index {
#    require Data::Sah::Normalize;
#
#    my %args = @_;
#
#    my $fres;
#
#    log_trace("[comp][periscomp] entering complete_arg_index, arg=<%s>",
#                 $args{arg});
#
#    my $extras = $args{extras} // {};
#
#    my $ourextras = {arg=>$args{arg}, args=>$args{args}};
#
#    my $meta = $args{meta} or do {
#        log_trace("[comp][periscomp] meta is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $arg  = $args{arg} or do {
#        log_trace("[comp][periscomp] arg is not supplied, declining");
#        goto RETURN_RES;
#    };
#    my $word = $args{word} // '';
#
#
#    my $args_prop = $meta->{args} // {};
#    my $arg_spec = $args_prop->{$arg} or do {
#        log_trace("[comp][periscomp] arg '$arg' is not specified in meta, declining");
#        goto RETURN_RES;
#    };
#
#    my $static;
#    eval { 
#
#        my $idxcomp;
#      GET_IDXCOMP_ROUTINE:
#        {
#            $idxcomp = $arg_spec->{index_completion};
#            if ($idxcomp) {
#                log_trace("[comp][periscomp] using arg element index completion routine from 'index_completion' property");
#                last GET_IDXCOMP_ROUTINE;
#            }
#        } 
#
#        if ($idxcomp) {
#            if (ref($idxcomp) eq 'CODE') {
#                log_trace("[comp][periscomp] invoking arg element index completion routine");
#                $fres = $idxcomp->(
#                    %$extras,
#                    %$ourextras,
#                    word=>$word);
#                return; 
#            } elsif (ref($idxcomp) eq 'ARRAY') {
#                log_trace("[comp][periscomp] using array specified in arg element index completion routine: %s", $idxcomp);
#                $fres = complete_array_elem(array=>$idxcomp, word=>$word);
#                $static = $word eq '';
#            }
#
#            log_trace("[comp][periscomp] arg spec's 'index_completion' property is not a coderef or ".
#                             "arrayref");
#            if ($args{riap_client} && $args{riap_server_url}) {
#                log_trace("[comp][periscomp] trying to perform complete_arg_index request to Riap server");
#                my $res = $args{riap_client}->request(
#                    complete_arg_index => $args{riap_server_url},
#                    {(uri=>$args{riap_uri}) x !!defined($args{riap_uri}),
#                     arg=>$arg, args=>$args{args}, word=>$word},
#                );
#                if ($res->[0] != 200) {
#                    log_trace("[comp][periscomp] Riap request failed (%s), declining", $res);
#                    return; 
#                }
#                $fres = $res->[2];
#                return; 
#            }
#
#            log_trace("[comp][periscomp] declining");
#            return; 
#        } 
#
#        my $sch = $arg_spec->{schema};
#        unless ($sch) {
#            log_trace("[comp][periscomp] arg spec does not specify schema, declining");
#            return; 
#        };
#
#        my $nsch = Data::Sah::Normalize::normalize_schema($sch);
#
#        my ($type, $cs) = @$nsch;
#        if ($type ne 'hash') {
#            log_trace("[comp][periscomp] can't complete element index for non-hash");
#            return; 
#        }
#
#        my %keys;
#        if ($cs->{keys}) {
#            $keys{$_}++ for keys %{ $cs->{keys} };
#        }
#        if ($cs->{indices}) {
#            $keys{$_}++ for keys %{ $cs->{indices} };
#        }
#        if ($cs->{req_keys}) {
#            $keys{$_}++ for @{ $cs->{req_keys} };
#        }
#        if ($cs->{allowed_keys}) {
#            $keys{$_}++ for @{ $cs->{allowed_keys} };
#        }
#
#        for (keys %{$args{args}{$arg} // {}}) {
#            delete $keys{$_};
#        }
#
#        $fres = complete_hash_key(word => $word, hash => \%keys);
#
#    }; 
#    log_debug("[comp][periscomp] completion died: $@") if $@;
#    unless ($fres) {
#        log_trace("[comp][periscomp] no index completion from metadata possible, declining");
#        goto RETURN_RES;
#    }
#
#    $fres = hashify_answer($fres);
#    $fres->{static} //= $static && $word eq '' ? 1:0;
#  RETURN_RES:
#    log_trace("[comp][periscomp] leaving complete_arg_index, result=%s", $fres);
#    $fres;
#}
#
#$SPEC{complete_cli_arg} = {
#    v => 1.1,
#    summary => 'Complete command-line argument using Rinci function metadata',
#    description => <<'_',
#
#This routine uses <pm:Perinci::Sub::GetArgs::Argv> to generate <pm:Getopt::Long>
#specification from arguments list in Rinci function metadata and common options.
#Then, it will use <pm:Complete::Getopt::Long> to complete option names, option
#values, as well as arguments.
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata',
#            schema => 'hash*',
#            req => 1,
#        },
#        words => {
#            summary => 'Command-line arguments',
#            schema => ['array*' => {of=>'str*'}],
#            req => 1,
#        },
#        cword => {
#            summary => 'On which argument cursor is located (zero-based)',
#            schema => 'int*',
#            req => 1,
#        },
#        completion => {
#            summary => 'Supply custom completion routine',
#            description => <<'_',
#
#If supplied, instead of the default completion routine, this code will be called
#instead. Will receive all arguments that <pm:Complete::Getopt::Long> will pass,
#and additionally:
#
#* `arg` (str, the name of function argument)
#* `args` (hash, the function arguments formed so far)
#* `index` (int, if completing argument element value)
#
#_
#            schema => 'code*',
#        },
#        per_arg_json => {
#            summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
#            schema  => 'bool',
#        },
#        per_arg_yaml => {
#            summary => 'Will be passed to Perinci::Sub::GetArgs::Argv',
#            schema  => 'bool',
#        },
#        common_opts => {
#            summary => 'Common options',
#            description => <<'_',
#
#A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
#option specification), `handler` (Getopt::Long handler). Will be passed to
#`get_args_from_argv()`. Example:
#
#    {
#        help => {
#            getopt  => 'help|h|?',
#            handler => sub { ... },
#            summary => 'Display help and exit',
#        },
#        version => {
#            getopt  => 'version|v',
#            handler => sub { ... },
#            summary => 'Display version and exit',
#        },
#    }
#
#_
#            schema => ['hash*'],
#        },
#        extras => {
#            summary => 'Add extra arguments to completion routine',
#            schema  => 'hash',
#            description => <<'_',
#
#The keys from this `extras` hash will be merged into the final `%args` passed to
#completion routines. Note that standard keys like `word`, `cword`, and so on as
#described in the function description will not be overwritten by this.
#
#_
#        },
#        func_arg_starts_at => {
#            schema  => 'int*',
#            default => 0,
#            description => <<'_',
#
#This is a (temporary?) workaround for <pm:Perinci::CmdLine>. In an application
#with subcommands (e.g. `cmd --verbose subcmd arg0 arg1 ...`), then `words` will
#still contain the subcommand name. Positional function arguments then start at 1
#not 0. This option allows offsetting function arguments.
#
#_
#        },
#        %common_args_riap,
#    },
#    result_naked => 1,
#    result => {
#        schema => 'hash*',
#        description => <<'_',
#
#You can use `format_completion` function in <pm:Complete::Bash> module to format
#the result of this function for bash.
#
#_
#    },
#};
#sub complete_cli_arg {
#    require Complete::Getopt::Long;
#    require Perinci::Sub::GetArgs::Argv;
#
#    my %args   = @_;
#    my $meta   = $args{meta} or die "Please specify meta";
#    my $words  = $args{words} or die "Please specify words";
#    my $cword  = $args{cword}; defined($cword) or die "Please specify cword";
#    my $copts  = $args{common_opts} // {};
#    my $comp   = $args{completion};
#    my $extras = {
#        %{ $args{extras} // {} },
#        words => $args{words},
#        cword => $args{cword},
#    };
#
#    my $fname = __PACKAGE__ . "::complete_cli_arg"; 
#    my $fres;
#
#    my $word   = $words->[$cword];
#    my $args_prop = $meta->{args} // {};
#
#    log_trace('[comp][periscomp] entering %s(), words=%s, cword=%d, word=<%s>',
#                 $fname, $words, $cword, $word);
#
#    my $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_trace("[comp][periscomp] entering completion routine (that we supply to Complete::Getopt::Long)");
#        my %cargs = @_;
#        my $type  = $cargs{type};
#        my $ospec = $cargs{ospec} // '';
#        my $word  = $cargs{word};
#
#        my $fres;
#
#        my %rargs = (
#            riap_server_url => $args{riap_server_url},
#            riap_uri        => $args{riap_uri},
#            riap_client     => $args{riap_client},
#        );
#
#        $extras->{parsed_opts} = $cargs{parsed_opts};
#
#        if (my $sm = $specmeta->{$ospec}) {
#            $cargs{type} = 'optval';
#            if ($sm->{arg}) {
#                log_trace("[comp][periscomp] completing option value for a known function argument, arg=<%s>, ospec=<%s>", $sm->{arg}, $ospec);
#                $cargs{arg} = $sm->{arg};
#                my $arg_spec = $args_prop->{$sm->{arg}} or goto RETURN_RES;
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $compres;
#                    eval { $compres = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    log_trace("[comp][periscomp] result from 'completion' routine: %s", $compres);
#                    if ($compres) {
#                        $fres = $compres;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($ospec =~ /\@$/) {
#                    $fres = complete_arg_elem(
#                        meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                        word=>$word, index=>$cargs{nth}, 
#                        extras=>$extras, %rargs);
#                    goto RETURN_RES;
#                } elsif ($ospec =~ /\%$/) {
#                    if ($word =~ /(.*?)=(.*)/s) {
#                        my $key = $1;
#                        my $val = $2;
#                        $fres = complete_arg_elem(
#                            meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                            word=>$val, index=>$key,
#                            extras=>$extras, %rargs);
#                        modify_answer(answer=>$fres, prefix=>"$key=");
#                        goto RETURN_RES;
#                    } else {
#                        $fres = complete_arg_index(
#                            meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                            word=>$word, extras=>$extras, %rargs);
#                        modify_answer(answer=>$fres, suffix=>"=");
#                        $fres->{path_sep} = "=";
#                        $fres->{esc_mode} = "none";
#                        goto RETURN_RES;
#                    }
#                } else {
#                    $fres = complete_arg_val(
#                        meta=>$meta, arg=>$sm->{arg}, args=>$gares->[2],
#                        word=>$word, extras=>$extras, %rargs);
#                    goto RETURN_RES;
#                }
#            } else {
#                log_trace("[comp][periscomp] completing option value for a common option, ospec=<%s>", $ospec);
#                $cargs{arg}  = undef;
#                my $codata = $copts_by_ospec->{$ospec};
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{completion}) {
#                    $cargs{arg}  = undef;
#                    log_trace("[comp][periscomp] completing with common option's 'completion' property");
#                    my $res;
#                    eval { $res = $codata->{completion}->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                if ($codata->{schema}) {
#                    require Data::Sah::Normalize;
#                    my $nsch = Data::Sah::Normalize::normalize_schema(
#                        $codata->{schema});
#                    log_trace("[comp][periscomp] completing with common option's schema");
#                    $fres = complete_from_schema(
#                        schema => $nsch, word=>$word);
#                    goto RETURN_RES;
#                }
#                goto RETURN_RES;
#            }
#        } elsif ($type eq 'arg') {
#            log_trace("[comp][periscomp] completing argument #%d", $cargs{argpos});
#            $cargs{type} = 'arg';
#
#            my $pos = $cargs{argpos};
#            my $fasa = $args{func_arg_starts_at} // 0;
#
#            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_trace("[comp][periscomp] this argument position is for non-greedy function argument <%s>", $an);
#                $cargs{arg} = $an;
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_val(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            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_trace("[comp][periscomp] this position is for greedy function argument <%s>'s element[%d]", $an, $index);
#                if ($comp) {
#                    log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                    my $res;
#                    eval { $res = $comp->(%cargs) };
#                    log_debug("[comp][periscomp] completion died: $@") if $@;
#                    if ($res) {
#                        $fres = $res;
#                        goto RETURN_RES;
#                    }
#                }
#                $fres = complete_arg_elem(
#                    meta=>$meta, arg=>$an, args=>$gares->[2],
#                    word=>$word, index=>$index, extras=>$extras, %rargs);
#                goto RETURN_RES;
#            }
#
#            log_trace("[comp][periscomp] there is no matching function argument at this position");
#            if ($comp) {
#                log_trace("[comp][periscomp] invoking routine supplied from 'completion' argument");
#                my $res;
#                eval { $res = $comp->(%cargs) };
#                log_debug("[comp][periscomp] completion died: $@") if $@;
#                if ($res) {
#                    $fres = $res;
#                    goto RETURN_RES;
#                }
#            }
#            goto RETURN_RES;
#        } else {
#            log_trace("[comp][periscomp] completing option value for an unknown/ambiguous option, declining ...");
#            goto RETURN_RES;
#        }
#      RETURN_RES:
#        log_trace("[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_trace('[comp][periscomp] leaving %s(), result=%s',
#                 $fname, $fres);
#    $fres;
#}
#
#1;
#
#__END__
#
### Perinci/Sub/ConvertArgs/Argv.pm ###
#package Perinci::Sub::ConvertArgs::Argv;
#
#our $DATE = '2016-12-12'; 
#our $VERSION = '0.10'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Util::Type qw(is_simple);
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(convert_args_to_argv);
#
#our %SPEC;
#
#sub _json {
#    require JSON;
#    state $json = JSON->new->allow_nonref;
#    $json->encode($_[0]);
#}
#
#sub _encode {
#    ref($_[0]) ? _json($_[0]) : $_[0];
#}
#
#$SPEC{convert_args_to_argv} = {
#    v => 1.1,
#    summary => 'Convert hash arguments to command-line options (and arguments)',
#    description => <<'_',
#
#Convert hash arguments to command-line arguments. This is the reverse of
#`Perinci::Sub::GetArgs::Argv::get_args_from_argv`.
#
#Note: currently the function expects schemas in metadata to be normalized
#already.
#
#_
#    args => {
#        args => {req=>1, schema=>'hash*', pos=>0},
#        meta => {req=>0, schema=>'hash*', pos=>1},
#        use_pos => {
#            summary => 'Whether to use positional arguments',
#            schema  => 'bool',
#            description => <<'_',
#
#For example, given this metadata:
#
#    {
#        v => 1.1,
#        args => {
#          arg1 => {pos=>0, req=>1},
#          arg2 => {pos=>1},
#          arg3 => {},
#        },
#    }
#
#then under `use_pos=0` the hash `{arg1=>1, arg2=>2, arg3=>'a b'}` will be
#converted to `['--arg1', 1, '--arg2', 2, '--arg3', 'a b']`. Meanwhile if
#`use_pos=1` the same hash will be converted to `[1, 2, '--arg3', 'a b']`.
#
#_
#        },
#    },
#};
#sub convert_args_to_argv {
#    my %fargs = @_;
#
#    my $iargs = $fargs{args} or return [400, "Please specify args"];
#    my $meta  = $fargs{meta} // {v=>1.1};
#    my $args_prop = $meta->{args} // {};
#
#    my $v = $meta->{v} // 1.0;
#    return [412, "Sorry, only metadata version 1.1 is supported (yours: $v)"]
#        unless $v == 1.1;
#
#    my @argv;
#    my %iargs = %$iargs; 
#
#    if ($fargs{use_pos}) {
#        for my $arg (sort {$args_prop->{$a}{pos} <=> $args_prop->{$b}{pos}}
#                         grep {defined $args_prop->{$_}{pos}} keys %iargs) {
#            my $pos = $args_prop->{$arg}{pos};
#            if ($args_prop->{$arg}{greedy}) {
#                my $sch = $args_prop->{$arg}{schema};
#                my $is_array_of_simple = $sch && $sch->[0] eq 'array' &&
#                    is_simple($sch->[1]{of} // $sch->[1]{each_elem});
#                for my $el (@{ $iargs{$arg} }) {
#                    $argv[$pos] = $is_array_of_simple ? $el : _encode($el);
#                    $pos++;
#                }
#            } else {
#                $argv[$pos] = _encode($iargs{$arg});
#            }
#            delete $iargs{$arg};
#        }
#    }
#
#    for (sort keys %iargs) {
#        my $sch = $args_prop->{$_}{schema};
#        my $is_bool = $sch && $sch->[0] eq 'bool';
#        my $is_array_of_simple = $sch && $sch->[0] eq 'array' &&
#            $sch->[1]{of} && is_simple($sch->[1]{of});
#        my $is_hash_of_simple = $sch && $sch->[0] eq 'hash' &&
#            is_simple($sch->[1]{of} // $sch->[1]{each_value} // $sch->[1]{each_elem});
#        my $can_be_comma_separated = $is_array_of_simple &&
#            $sch->[1]{of}[0] =~ /\A(int|float)\z/; 
#        my $opt = $_; $opt =~ s/_/-/g;
#        my $dashopt = length($opt) > 1 ? "--$opt" : "-$opt";
#        if ($is_bool) {
#            if ($iargs{$_}) {
#                push @argv, $dashopt;
#            } else {
#                push @argv, "--no$opt";
#            }
#        } elsif ($can_be_comma_separated) {
#            push @argv, "$dashopt", join(",", @{ $iargs{$_} });
#        } elsif ($is_array_of_simple) {
#            for (@{ $iargs{$_} }) {
#                push @argv, "$dashopt", $_;
#            }
#        } elsif ($is_hash_of_simple) {
#            my $arg = $iargs{$_};
#            for (sort keys %$arg) {
#                push @argv, "$dashopt", "$_=$arg->{$_}";
#            }
#        } else {
#            if (ref $iargs{$_}) {
#                push @argv, "$dashopt-json", _encode($iargs{$_});
#            } else {
#                push @argv, $dashopt, "$iargs{$_}";
#            }
#        }
#    }
#    [200, "OK", \@argv];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/ConvertArgs/Array.pm ###
#package Perinci::Sub::ConvertArgs::Array;
#
#our $DATE = '2015-12-29'; 
#our $VERSION = '0.08'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(convert_args_to_array);
#
#our %SPEC;
#
#$SPEC{convert_args_to_array} = {
#    v => 1.1,
#    summary => 'Convert hash arguments to array',
#    description => <<'_',
#
#Using information in 'args' property (particularly the 'pos' and 'greedy' of
#each argument spec), convert hash arguments to array.
#
#Example:
#
#    my $meta = {
#        v => 1.1,
#        summary => 'Multiply 2 numbers (a & b)',
#        args => {
#            a => ['num*' => {arg_pos=>0}],
#            b => ['num*' => {arg_pos=>1}],
#        }
#    }
#
#then 'convert_args_to_array(args=>{a=>2, b=>3}, meta=>$meta)' will produce:
#
#    [200, "OK", [2, 3]]
#
#_
#    args => {
#        args => {req=>1, schema=>'hash*', pos=>0},
#        meta => {req=>1, schema=>'hash*', pos=>1},
#    },
#};
#sub convert_args_to_array {
#    my %input_args   = @_;
#    my $args         = $input_args{args} or return [400, "Please specify args"];
#    my $meta         = $input_args{meta} or return [400, "Please specify meta"];
#    my $args_prop    = $meta->{args} // {};
#
#    my $v = $meta->{v} // 1.0;
#    return [412, "Sorry, only metadata version 1.1 is supported (yours: $v)"]
#        unless $v == 1.1;
#
#
#    my @array;
#
#    while (my ($k, $v) = each %$args) {
#        next if $k =~ /\A-/; 
#        my $as = $args_prop->{$k};
#        return [412, "Argument $k: Not specified in args property"] unless $as;
#        my $pos = $as->{pos};
#        return [412, "Argument $k: No pos specified in arg spec"]
#            unless defined $pos;
#        if ($as->{greedy}) {
#            $v = [$v] if ref($v) ne 'ARRAY';
#            for (@array .. $pos-1) {
#                $array[$_] = undef;
#            }
#            splice @array, $pos, 0, @$v;
#        } else {
#            $array[$pos] = $v;
#        }
#    }
#    [200, "OK", \@array];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/DepChecker.pm ###
#package Perinci::Sub::DepChecker;
#
#use 5.010001;
#use strict;
#use warnings;
#use experimental 'smartmatch';
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       check_deps
#                       dep_satisfy_rel
#                       list_mentioned_dep_clauses
#               );
#
#our $VERSION = '0.11'; 
#our $DATE = '2015-09-03'; 
#
#my $pa;
#
#sub check_deps {
#    my ($val) = @_;
#    for my $dname (keys %$val) {
#        my $dval = $val->{$dname};
#        unless (defined &{"checkdep_$dname"}) {
#            eval { require "Perinci/Sub/Dep/$dname.pm" };
#            return "Unknown dependency type: $dname"
#                unless defined &{"checkdep_$dname"};
#        }
#        my $check = \&{"checkdep_$dname"};
#        my $res = $check->($dval);
#        if ($res) {
#            $res = "$dname: $res";
#            return $res;
#        }
#    }
#    "";
#}
#
#sub checkdep_all {
#    my ($val) = @_;
#    for (@$val) {
#        my $res = check_deps($_);
#        return "Some dependencies not met: $res" if $res;
#    }
#    "";
#}
#
#sub checkdep_any {
#    my ($val) = @_;
#    my $nfail = 0;
#    for (@$val) {
#        return "" unless check_deps($_);
#        $nfail++;
#    }
#    $nfail ? "None of the dependencies are met" : "";
#}
#
#sub checkdep_none {
#    my ($val) = @_;
#    for (@$val) {
#        my $res = check_deps($_);
#        return "A dependency is met when it shouldn't: $res" unless $res;
#    }
#    "";
#}
#
#sub checkdep_env {
#    my ($cval) = @_;
#    $ENV{$cval} ? "" : "Environment variable $cval not set/true";
#}
#
#sub checkdep_code {
#    my ($cval) = @_;
#    $cval->() ? "" : "code doesn't return true value";
#}
#
#sub checkdep_prog {
#    my ($cval) = @_;
#
#    if ($cval =~ m!/!) {
#        return "Program $cval not executable" unless (-x $cval);
#    } else {
#        require File::Which;
#        return "Program $cval not found in PATH (".
#            join(":", File::Spec->path).")"
#                unless File::Which::which($cval);
#    }
#    "";
#}
#
#sub riap_client {
#    return $pa if $pa;
#    require Perinci::Access;
#    $pa = Perinci::Access->new;
#    $pa;
#}
#
#sub checkdep_pkg {
#    my ($cval) = @_;
#    my $res = riap_client->request(info => $cval);
#    $res->[0] == 200 or return "Can't perform 'info' Riap request on '$cval': ".
#        "$res->[0] $res->[1]";
#    $res->[2]{type} eq 'package' or return "$cval is not a Riap package";
#    "";
#}
#
#sub checkdep_func {
#    my ($cval) = @_;
#    my $res = riap_client->request(info => $cval);
#    $res->[0] == 200 or return "Can't perform 'info' Riap request on '$cval': ".
#        "$res->[0] $res->[1]";
#    $res->[2]{type} eq 'function' or return "$cval is not a Riap function";
#    "";
#}
#
#sub checkdep_exec { checkdep_prog(@_) }
#
#sub checkdep_tmp_dir { "" }
#
#sub checkdep_trash_dir { "" }
#
#sub checkdep_undo_trash_dir { "" }
#
#sub _all_elems_is {
#    my ($ary, $el) = @_;
#    (grep {$_ eq $el} @$ary) && !(grep {$_ ne $el} @$ary);
#}
#
#sub _all_nonblank_elems_is {
#    my ($ary, $el) = @_;
#    (grep {$_ eq $el} @$ary) && !(grep {$_ && $_ ne $el} @$ary);
#}
#
#sub dep_satisfy_rel {
#    my ($wanted, $deps) = @_;
#
#    my $res;
#    for my $dname (keys %$deps) {
#        my $dval = $deps->{$dname};
#
#        if ($dname eq 'all') {
#            my @r = map { dep_satisfy_rel($wanted, $_) } @$dval;
#            next unless @r;
#            return "impossible" if "impossible" ~~ @r;
#            return "impossible" if "must" ~~ @r && "must not" ~~ @r;
#            return "must"       if "must" ~~ @r;
#            return "must not"   if "must not" ~~ @r;
#            return "might"      if _all_nonblank_elems_is(\@r, "might");
#        } elsif ($dname eq 'any') {
#            my @r = map { dep_satisfy_rel($wanted, $_) } @$dval;
#            next unless @r;
#            return "impossible" if "impossible" ~~ @r;
#            return "must"       if _all_elems_is(\@r, "must");
#            return "must not"   if _all_elems_is(\@r, "must not");
#            next                if _all_elems_is(\@r, "");
#            return "might";
#        } elsif ($dname eq 'none') {
#            my @r = map { dep_satisfy_rel($wanted, $_) } @$dval;
#            next unless @r;
#            return "impossible" if "impossible" ~~ @r;
#            return "impossible" if "must" ~~ @r && "must not" ~~ @r;
#            return "must not"   if "must" ~~ @r;
#            return "must"       if "must not" ~~ @r;
#            return "might"      if _all_nonblank_elems_is(\@r, "might");
#        } else {
#            return "must" if $dname eq $wanted;
#        }
#    }
#    "";
#}
#
#sub list_mentioned_dep_clauses {
#    my ($deps, $res) = @_;
#    $res //= [];
#    for my $dname (keys %$deps) {
#        my $dval = $deps->{$dname};
#        push @$res, $dname unless $dname ~~ @$res;
#        if ($dname =~ /\A(?:all|any|none)\z/) {
#            list_mentioned_dep_clauses($_, $res) for @$dval;
#        }
#    }
#    $res;
#}
#
#1;
#
#__END__
#
### Perinci/Sub/GetArgs/Argv.pm ###
#package Perinci::Sub::GetArgs::Argv;
#
#our $DATE = '2017-07-22'; 
#our $VERSION = '0.82'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Normalize qw(normalize_schema);
#use Data::Sah::Util::Type qw(is_type is_simple);
#use Getopt::Long::Negate::EN qw(negations_for_option);
#use Getopt::Long::Util qw(parse_getopt_long_opt_spec);
#use List::Util qw(first);
#use Perinci::Sub::GetArgs::Array qw(get_args_from_array);
#use Perinci::Sub::Util qw(err);
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       gen_getopt_long_spec_from_meta
#                       get_args_from_argv
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Get subroutine arguments from command line arguments (@ARGV)',
#};
#
#sub _parse_json {
#    my $str = shift;
#
#    state $json = do {
#        require JSON::PP;
#        JSON::PP->new->allow_nonref;
#    };
#
#    state $cleanser = do {
#        if (eval { require Data::Clean::FromJSON; 1 }) {
#            Data::Clean::FromJSON->get_cleanser;
#        } else {
#            undef;
#        }
#    };
#
#    my $res;
#    eval { $res = $json->decode($str); $cleanser->clean_in_place($res) if $cleanser };
#    my $e = $@;
#    return (!$e, $e, $res);
#}
#
#sub _parse_yaml {
#    no warnings 'once';
#
#    state $yaml_xs_available = do {
#        if (eval { require YAML::XS; 1 }) {
#            1;
#        } else {
#            require YAML::Old;
#            0;
#        }
#    };
#
#    my $str = shift;
#
#    my $res;
#    eval {
#        if ($yaml_xs_available) {
#            $res = YAML::XS::Load($str);
#        } else {
#            $str = "--- $str" unless $str =~ /\A--- /;
#            $str .= "\n" unless $str =~ /\n\z/;
#            $res = YAML::Old::Load($str);
#        }
#    };
#    my $e = $@;
#    return (!$e, $e, $res);
#}
#
#sub _arg2opt {
#    my $opt = shift;
#    $opt =~ s/[^A-Za-z0-9-]+/-/g; 
#    $opt;
#}
#
#sub _is_coercible_from_simple {
#    my $nsch = shift;
#    my $cset = $nsch->[1] or return 0;
#    my $rules = $cset->{'x.perl.coerce_rules'} // $cset->{'x.coerce_rules'}
#        or return 0;
#    for my $rule (@$rules) {
#        next unless $rule =~ /\A([^_]+)_/;
#        return 1 if is_simple($1);
#    }
#    0;
#}
#
#sub _is_simple_or_coercible_from_simple {
#    my $nsch = shift;
#    is_simple($nsch) || _is_coercible_from_simple($nsch);
#}
#
#sub _is_simple_or_array_of_simple_or_hash_of_simple {
#    my $nsch = shift;
#
#    my $is_simple = 0;
#    my $is_array_of_simple = 0;
#    my $is_hash_of_simple = 0;
#    my $eltype;
#
#    my $type = $nsch->[0];
#    my $cset = $nsch->[1];
#
#    {
#        unless (is_type($nsch)) {
#            require Data::Sah::Resolve;
#            my $res = Data::Sah::Resolve::resolve_schema(
#                {merge_clause_sets => 0}, $nsch);
#            $type = $res->[0];
#            $cset = $res->[1][0] // {};
#        }
#
#        $is_simple = _is_simple_or_coercible_from_simple([$type, $cset]);
#        last if $is_simple;
#
#        if ($type eq 'array') {
#            my $elnsch = $cset->{of} // $cset->{each_elem};
#            last unless $elnsch;
#            $elnsch = normalize_schema($elnsch);
#            $eltype = $elnsch->[0];
#
#            unless (is_type($elnsch)) {
#                require Data::Sah::Resolve;
#                my $res = Data::Sah::Resolve::resolve_schema(
#                    {merge_clause_sets => 0}, $elnsch);
#                $elnsch = [$res->[0], $res->[1][0] // {}]; 
#                $eltype = $res->[0];
#            }
#
#            $is_array_of_simple = _is_simple_or_coercible_from_simple($elnsch);
#            last;
#        }
#
#        if ($type eq 'hash') {
#            my $elnsch = $cset->{of} // $cset->{each_value} // $cset->{each_elem};
#            last unless $elnsch;
#            $elnsch = normalize_schema($elnsch);
#            $eltype = $elnsch->[0];
#
#            unless (is_type($elnsch)) {
#                require Data::Sah::Resolve;
#                my $res = Data::Sah::Resolve::resolve_schema(
#                    {merge_clause_sets => 0}, $elnsch);
#                $elnsch = [$res->[0], $res->[1][0] // {}]; 
#                $eltype = $res->[0];
#            }
#
#            $is_hash_of_simple = _is_simple_or_coercible_from_simple($elnsch);
#            last;
#        }
#    }
#
#    ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype);
#}
#
#sub _opt2ospec {
#    my ($opt, $schema, $arg_spec) = @_;
#    my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
#        _is_simple_or_array_of_simple_or_hash_of_simple($schema);
#
#    my (@opts, @types, @isaos, @ishos);
#
#    if ($is_array_of_simple || $is_hash_of_simple) {
#        my $singular_opt;
#        if ($arg_spec && $arg_spec->{'x.name.is_plural'}) {
#            if ($arg_spec->{'x.name.singular'}) {
#                $singular_opt = _arg2opt($arg_spec->{'x.name.singular'});
#            } else {
#                require Lingua::EN::PluralToSingular;
#                $singular_opt = Lingua::EN::PluralToSingular::to_singular($opt);
#            }
#        } else {
#            $singular_opt = $opt;
#        }
#        push @opts , $singular_opt;
#        push @types, $eltype;
#        push @isaos, $is_array_of_simple ? 1:0;
#        push @ishos, $is_hash_of_simple  ? 1:0;
#    }
#
#    if ($is_simple || !@opts) {
#        push @opts , $opt;
#        push @types, $type;
#        push @isaos, 0;
#        push @ishos, 0;
#    }
#
#    my @res;
#
#    for my $i (0..$#opts) {
#        my $opt   = $opts[$i];
#        my $type  = $types[$i];
#        my $isaos = $isaos[$i];
#        my $ishos = $ishos[$i];
#
#        if ($type eq 'bool') {
#            if (length($opt) == 1 || $cset->{is}) {
#                push @res, ($opt, {opts=>[$opt]}), undef;
#            } else {
#                my @negs = negations_for_option($opt);
#                push @res, $opt, {opts=>[$opt]}, {is_neg=>0, neg_opts=>\@negs};
#                for (@negs) {
#                    push @res, $_, {opts=>[$_]}, {is_neg=>1, pos_opts=>[$opt]};
#                }
#            }
#        } elsif ($type eq 'buf') {
#            push @res, (
#                "$opt=s", {opts=>[$opt], desttype=>"", type=>"s"}, undef,
#                "$opt-base64=s", {opts=>["$opt-base64"], desttype=>"", type=>"s"}, {is_base64=>1},
#            );
#        } else {
#            my $t = ($type eq 'int' ? 'i' : $type eq 'float' ? 'f' : 's') .
#                ($isaos ? '@' : $ishos ? '%' : '');
#            push @res, ("$opt=$t", {opts=>[$opt], desttype=>"", type=>$t}, undef);
#        }
#    }
#
#    @res;
#}
#
#sub _args2opts {
#    my %args = @_;
#
#    my $argprefix        = $args{argprefix};
#    my $parent_args      = $args{parent_args};
#    my $meta             = $args{meta};
#    my $seen_opts        = $args{seen_opts};
#    my $seen_common_opts = $args{seen_common_opts};
#    my $seen_func_opts   = $args{seen_func_opts};
#    my $rargs            = $args{rargs};
#    my $go_spec          = $args{go_spec};
#    my $specmeta         = $args{specmeta};
#
#    my $args_prop = $meta->{args} // {};
#
#    for my $arg (keys %$args_prop) {
#        my $fqarg    = "$argprefix$arg";
#        my $arg_spec = $args_prop->{$arg};
#        next if grep { $_ eq 'hidden' || $_ eq 'hidden-cli' }
#            @{ $arg_spec->{tags} // [] };
#        my $sch      = $arg_spec->{schema} // ['any', {}];
#        my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
#            _is_simple_or_array_of_simple_or_hash_of_simple($sch);
#
#        if ($type eq 'array' && $cset->{of}) {
#            $cset->{of} = normalize_schema($cset->{of});
#        }
#        my $opt = _arg2opt($fqarg);
#        if ($seen_opts->{$opt}) {
#            my $i = 1;
#            my $opt2;
#            while (1) {
#                $opt2 = "$opt-arg" . ($i > 1 ? $i : '');
#                last unless $seen_opts->{$opt2};
#                $i++;
#            }
#            $opt = $opt2;
#        }
#
#        my $stash = {};
#
#
#        my $handler = sub {
#            my ($val, $val_set);
#
#            my $num_called = ++$stash->{called}{$arg};
#
#            my $rargs = do {
#                if (ref($rargs) eq 'ARRAY') {
#                    $rargs->[$num_called-1] //= {};
#                    $rargs->[$num_called-1];
#                } else {
#                    $rargs;
#                }
#            };
#
#            if ($is_simple) {
#                $val_set = 1; $val = $_[1];
#                $rargs->{$arg} = $val;
#            } elsif ($is_array_of_simple) {
#                $rargs->{$arg} //= [];
#                $val_set = 1; $val = $_[1];
#                push @{ $rargs->{$arg} }, $val;
#            } elsif ($is_hash_of_simple) {
#                $rargs->{$arg} //= {};
#                $val_set = 1; $val = $_[2];
#                $rargs->{$arg}{$_[1]} = $val;
#            } else {
#                {
#                    my ($success, $e, $decoded);
#                    ($success, $e, $decoded) = _parse_json($_[1]);
#                    if ($success) {
#                        $val_set = 1; $val = $decoded;
#                        $rargs->{$arg} = $val;
#                        last;
#                    }
#                    ($success, $e, $decoded) = _parse_yaml($_[1]);
#                    if ($success) {
#                        $val_set = 1; $val = $decoded;
#                        $rargs->{$arg} = $val;
#                        last;
#                    }
#                    die "Invalid YAML/JSON in arg '$fqarg'";
#                }
#            }
#            if ($val_set && $arg_spec->{cmdline_on_getopt}) {
#                $arg_spec->{cmdline_on_getopt}->(
#                    arg=>$arg, fqarg=>$fqarg, value=>$val, args=>$rargs,
#                    opt=>$opt,
#                );
#            }
#        }; 
#
#        my @triplets = _opt2ospec($opt, $sch, $arg_spec);
#        my $aliases_processed;
#        while (my ($ospec, $parsed, $extra) = splice @triplets, 0, 3) {
#            $extra //= {};
#            if ($extra->{is_neg}) {
#                $go_spec->{$ospec} = sub { $handler->($_[0], 0) };
#            } elsif (defined $extra->{is_neg}) {
#                $go_spec->{$ospec} = sub { $handler->($_[0], 1) };
#            } elsif ($extra->{is_base64}) {
#                $go_spec->{$ospec} = sub {
#                    require MIME::Base64;
#                    my $decoded = MIME::Base64::decode($_[1]);
#                    $handler->($_[0], $decoded);
#                };
#            } else {
#                $go_spec->{$ospec} = $handler;
#            }
#
#            $specmeta->{$ospec} = {arg=>$arg, fqarg=>$fqarg, parsed=>$parsed, %$extra};
#            for (@{ $parsed->{opts} }) {
#                $seen_opts->{$_}++; $seen_func_opts->{$_} = $fqarg;
#            }
#
#            if ($parent_args->{per_arg_json} && !$is_simple) {
#                my $jopt = "$opt-json";
#                if ($seen_opts->{$jopt}) {
#                    warn "Clash of option: $jopt, not added";
#                } else {
#                    my $jospec = "$jopt=s";
#                    my $parsed = {type=>"s", opts=>[$jopt]};
#                    $go_spec->{$jospec} = sub {
#                        my ($success, $e, $decoded);
#                        ($success, $e, $decoded) = _parse_json($_[1]);
#                        if ($success) {
#                            $rargs->{$arg} = $decoded;
#                        } else {
#                            die "Invalid JSON in option --$jopt: $_[1]: $e";
#                        }
#                    };
#                    $specmeta->{$jospec} = {arg=>$arg, fqarg=>$fqarg, is_json=>1, parsed=>$parsed, %$extra};
#                    $seen_opts->{$jopt}++; $seen_func_opts->{$jopt} = $fqarg;
#                }
#            }
#            if ($parent_args->{per_arg_yaml} && !$is_simple) {
#                my $yopt = "$opt-yaml";
#                if ($seen_opts->{$yopt}) {
#                    warn "Clash of option: $yopt, not added";
#                } else {
#                    my $yospec = "$yopt=s";
#                    my $parsed = {type=>"s", opts=>[$yopt]};
#                    $go_spec->{$yospec} = sub {
#                        my ($success, $e, $decoded);
#                        ($success, $e, $decoded) = _parse_yaml($_[1]);
#                        if ($success) {
#                            $rargs->{$arg} = $decoded;
#                        } else {
#                            die "Invalid YAML in option --$yopt: $_[1]: $e";
#                        }
#                    };
#                    $specmeta->{$yospec} = {arg=>$arg, fqarg=>$fqarg, is_yaml=>1, parsed=>$parsed, %$extra};
#                    $seen_opts->{$yopt}++; $seen_func_opts->{$yopt} = $fqarg;
#                }
#            }
#
#            if ($arg_spec->{cmdline_aliases} && !$aliases_processed++) {
#                for my $al (keys %{$arg_spec->{cmdline_aliases}}) {
#                    my $alspec = $arg_spec->{cmdline_aliases}{$al};
#                    my $alsch = $alspec->{schema} //
#                        $alspec->{is_flag} ? [bool=>{req=>1,is=>1}] : $sch;
#                    my $altype = $alsch->[0];
#                    my $alopt = _arg2opt("$argprefix$al");
#                    if ($seen_opts->{$alopt}) {
#                        warn "Clash of cmdline_alias option $al";
#                        next;
#                    }
#                    my $alcode = $alspec->{code};
#                    my $alospec;
#                    my $parsed;
#                    if ($alcode && $alsch->[0] eq 'bool') {
#                        $alospec = $alopt; 
#                        $parsed = {opts=>[$alopt]};
#                    } else {
#                        ($alospec, $parsed) = _opt2ospec($alopt, $alsch);
#                    }
#
#                    if ($alcode) {
#                        if ($alcode eq 'CODE') {
#                            if ($parent_args->{ignore_converted_code}) {
#                                $alcode = sub {};
#                            } else {
#                                return [
#                                    501,
#                                    join("",
#                                         "Code in cmdline_aliases for arg $fqarg ",
#                                         "got converted into string, probably ",
#                                         "because of JSON/YAML transport"),
#                                ];
#                            }
#                        }
#                        $go_spec->{$alospec} = sub {
#
#                            my $num_called = ++$stash->{called}{$arg};
#                            my $rargs = do {
#                                if (ref($rargs) eq 'ARRAY') {
#                                    $rargs->[$num_called-1] //= {};
#                                    $rargs->[$num_called-1];
#                                } else {
#                                    $rargs;
#                                }
#                            };
#
#                            $alcode->($rargs, $_[1]);
#                        };
#                    } else {
#                        $go_spec->{$alospec} = $handler;
#                    }
#                    $specmeta->{$alospec} = {
#                        alias     => $al,
#                        is_alias  => 1,
#                        alias_for => $ospec,
#                        arg       => $arg,
#                        fqarg     => $fqarg,
#                        is_code   => $alcode ? 1:0,
#                        parsed    => $parsed,
#                        %$extra,
#                    };
#                    push @{$specmeta->{$ospec}{($alcode ? '':'non').'code_aliases'}},
#                        $alospec;
#                    $seen_opts->{$alopt}++; $seen_func_opts->{$alopt} = $fqarg;
#                }
#            } 
#
#            if ($arg_spec->{meta}) {
#                $rargs->{$arg} = {};
#                my $res = _args2opts(
#                    %args,
#                    argprefix => "$argprefix$arg\::",
#                    meta      => $arg_spec->{meta},
#                    rargs     => $rargs->{$arg},
#                );
#                return $res if $res;
#            }
#
#            if ($arg_spec->{element_meta}) {
#                $rargs->{$arg} = [];
#                my $res = _args2opts(
#                    %args,
#                    argprefix => "$argprefix$arg\::",
#                    meta      => $arg_spec->{element_meta},
#                    rargs     => $rargs->{$arg},
#                );
#                return $res if $res;
#            }
#        } 
#
#    } 
#
#    undef;
#}
#
#$SPEC{gen_getopt_long_spec_from_meta} = {
#    v           => 1.1,
#    summary     => 'Generate Getopt::Long spec from Rinci function metadata',
#    description => <<'_',
#
#This routine will produce a <pm:Getopt::Long> specification from Rinci function
#metadata, as well as some more data structure in the result metadata to help
#producing a command-line help/usage message.
#
#Function arguments will be mapped to command-line options with the same name,
#with non-alphanumeric characters changed to `-` (`-` is preferred over `_`
#because it lets user avoid pressing Shift on popular keyboards). For example:
#`file_size` becomes `file-size`, `file_size.max` becomes `file-size-max`. If
#function argument option name clashes with command-line option or another
#existing option, it will be renamed to `NAME-arg` (or `NAME-arg2` and so on).
#For example: `help` will become `help-arg` (if `common_opts` contains `help`,
#that is).
#
#Each command-line alias (`cmdline_aliases` property) in the argument
#specification will also be added as command-line option, except if it clashes
#with an existing option, in which case this function will warn and skip adding
#the alias. For more information about `cmdline_aliases`, see `Rinci::function`.
#
#For arguments with type of `bool`, Getopt::Long will by default also
#automatically recognize `--noNAME` or `--no-NAME` in addition to `--name`. So
#this function will also check those names for clashes.
#
#For arguments with type array of simple scalar, `--NAME` can be specified more
#than once to append to the array.
#
#If `per_arg_json` setting is active, and argument's schema is not a "required
#simple scalar" (e.g. an array, or a nullable string), then `--NAME-json` will
#also be added to let users input undef (through `--NAME-json null`) or a
#non-scalar value (e.g. `--NAME-json '[1,2,3]'`). If this name conflicts with
#another existing option, a warning will be displayed and the option will not be
#added.
#
#If `per_arg_yaml` setting is active, and argument's schema is not a "required
#simple scalar" (e.g. an array, or a nullable string), then `--NAME-yaml` will
#also be added to let users input undef (through `--NAME-yaml '~'`) or a
#non-scalar value (e.g. `--NAME-yaml '[foo, bar]'`). If this name conflicts with
#another existing option, a warning will be displayed and the option will not be
#added. YAML can express a larger set of values, e.g. binary data, circular
#references, etc.
#
#Will produce a hash (Getopt::Long spec), with `func.specmeta`, `func.opts`,
#`func.common_opts`, `func.func_opts` that contain extra information
#(`func.specmeta` is a hash of getopt spec name and a hash of extra information
#while `func.*opts` lists all used option names).
#
#_
#    args => {
#        meta => {
#            summary => 'Rinci function metadata',
#            schema  => 'hash*',
#            req     => 1,
#        },
#        meta_is_normalized => {
#            schema => 'bool*',
#        },
#        args => {
#            summary => 'Reference to hash which will store the result',
#            schema  => 'hash*',
#        },
#        common_opts => {
#            summary => 'Common options',
#            description => <<'_',
#
#A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
#option specification), `handler` (Getopt::Long handler). Will be passed to
#`get_args_from_argv()`. Example:
#
#    {
#        help => {
#            getopt  => 'help|h|?',
#            handler => sub { ... },
#            summary => 'Display help and exit',
#        },
#        version => {
#            getopt  => 'version|v',
#            handler => sub { ... },
#            summary => 'Display version and exit',
#        },
#    }
#
#_
#            schema => ['hash*'],
#        },
#        per_arg_json => {
#            summary => 'Whether to add --NAME-json for non-simple arguments',
#            schema  => 'bool',
#            default => 0,
#            description => <<'_',
#
#Will also interpret command-line arguments as JSON if assigned to function
#arguments, if arguments' schema is not simple scalar.
#
#_
#        },
#        per_arg_yaml => {
#            summary => 'Whether to add --NAME-yaml for non-simple arguments',
#            schema  => 'bool',
#            default => 0,
#            description => <<'_',
#
#Will also interpret command-line arguments as YAML if assigned to function
#arguments, if arguments' schema is not simple scalar.
#
#_
#        },
#        ignore_converted_code => {
#            summary => 'Whether to ignore coderefs converted to string',
#            schema => 'bool',
#            default => 0,
#            description => <<'_',
#
#Across network through JSON encoding, coderef in metadata (e.g. in
#`cmdline_aliases` property) usually gets converted to string `CODE`. In some
#cases, like for tab completion, this is pretty harmless so you can turn this
#option on. For example, in the case of `cmdline_aliases`, the effect is just
#that command-line aliases code are not getting executed, but this is usually
#okay.
#
#_
#        },
#    },
#};
#sub gen_getopt_long_spec_from_meta {
#    my %fargs = @_;
#
#    my $meta       = $fargs{meta} or return [400, "Please specify meta"];
#    unless ($fargs{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
#    }
#    my $co           = $fargs{common_opts} // {};
#    my $per_arg_yaml = $fargs{per_arg_yaml} // 0;
#    my $per_arg_json = $fargs{per_arg_json} // 0;
#    my $ignore_converted_code = $fargs{ignore_converted_code};
#    my $rargs        = $fargs{args} // {};
#
#    my %go_spec;
#    my %specmeta; 
#    my %seen_opts;
#    my %seen_common_opts;
#    my %seen_func_opts;
#
#    for my $k (keys %$co) {
#        my $v = $co->{$k};
#        my $ospec   = $v->{getopt};
#        my $handler = $v->{handler};
#        my $res = parse_getopt_long_opt_spec($ospec)
#            or return [400, "Can't parse common opt spec '$ospec'"];
#        $go_spec{$ospec} = $handler;
#        $specmeta{$ospec} = {common_opt=>$k, arg=>undef, parsed=>$res};
#        for (@{ $res->{opts} }) {
#            return [412, "Clash of common opt '$_'"] if $seen_opts{$_};
#            $seen_opts{$_}++; $seen_common_opts{$_} = $ospec;
#            if ($res->{is_neg}) {
#                $seen_opts{"no$_"}++ ; $seen_common_opts{"no$_"}  = $ospec;
#                $seen_opts{"no-$_"}++; $seen_common_opts{"no-$_"} = $ospec;
#            }
#        }
#    }
#
#    my $res = _args2opts(
#        argprefix        => "",
#        parent_args      => \%fargs,
#        meta             => $meta,
#        seen_opts        => \%seen_opts,
#        seen_common_opts => \%seen_common_opts,
#        seen_func_opts   => \%seen_func_opts,
#        rargs            => $rargs,
#        go_spec          => \%go_spec,
#        specmeta         => \%specmeta,
#    );
#    return $res if $res;
#
#    my $opts        = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_opts)];
#    my $common_opts = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_common_opts)];
#    my $func_opts   = [sort(map {length($_)>1 ? "--$_":"-$_"} keys %seen_func_opts)];
#    my $opts_by_common = {};
#    for my $k (keys %$co) {
#        my $v = $co->{$k};
#        my $ospec = $v->{getopt};
#        my @opts;
#        for (keys %seen_common_opts) {
#            next unless $seen_common_opts{$_} eq $ospec;
#            push @opts, (length($_)>1 ? "--$_":"-$_");
#        }
#        $opts_by_common->{$ospec} = [sort @opts];
#    }
#
#    my $opts_by_arg = {};
#    for (keys %seen_func_opts) {
#        my $fqarg = $seen_func_opts{$_};
#        push @{ $opts_by_arg->{$fqarg} }, length($_)>1 ? "--$_":"-$_";
#    }
#    for (keys %$opts_by_arg) {
#        $opts_by_arg->{$_} = [sort @{ $opts_by_arg->{$_} }];
#    }
#
#    [200, "OK", \%go_spec,
#     {
#         "func.specmeta"       => \%specmeta,
#         "func.opts"           => $opts,
#         "func.common_opts"    => $common_opts,
#         "func.func_opts"      => $func_opts,
#         "func.opts_by_arg"    => $opts_by_arg,
#         "func.opts_by_common" => $opts_by_common,
#     }];
#}
#
#$SPEC{get_args_from_argv} = {
#    v => 1.1,
#    summary => 'Get subroutine arguments (%args) from command-line arguments '.
#        '(@ARGV)',
#    description => <<'_',
#
#Using information in Rinci function metadata's `args` property, parse command
#line arguments `@argv` into hash `%args`, suitable for passing into subroutines.
#
#Currently uses <pm:Getopt::Long>'s `GetOptions` to do the parsing.
#
#As with GetOptions, this function modifies its `argv` argument, so you might
#want to copy the original `argv` first (or pass a copy instead) if you want to
#preserve the original.
#
#See also: gen_getopt_long_spec_from_meta() which is the routine that generates
#the specification.
#
#_
#    args => {
#        argv => {
#            schema => ['array*' => {
#                of => 'str*',
#            }],
#            description => 'If not specified, defaults to @ARGV',
#        },
#        args => {
#            summary => 'Specify input args, with some arguments preset',
#            schema  => ['hash'],
#        },
#        meta => {
#            schema => ['hash*' => {}],
#            req => 1,
#        },
#        meta_is_normalized => {
#            summary => 'Can be set to 1 if your metadata is normalized, '.
#                'to avoid duplicate effort',
#            schema => 'bool',
#            default => 0,
#        },
#        strict => {
#            schema => ['bool' => {default=>1}],
#            summary => 'Strict mode',
#            description => <<'_',
#
#If set to 0, will still return parsed argv even if there are parsing errors
#(reported by Getopt::Long). If set to 1 (the default), will die upon error.
#
#Normally you would want to use strict mode, for more error checking. Setting off
#strict is used by, for example, Perinci::Sub::Complete during completion where
#the command-line might still be incomplete.
#
#Should probably be named `ignore_errors`. :-)
#
#_
#        },
#        per_arg_yaml => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Whether to recognize --ARGNAME-yaml',
#            description => <<'_',
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
#    % script.pl --name-yaml '~'
#
#See also: per_arg_json. You should enable just one instead of turning on both.
#
#_
#        },
#        per_arg_json => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Whether to recognize --ARGNAME-json',
#            description => <<'_',
#
#This is useful for example if you want to specify a value which is not
#expressible from the command-line, like 'undef'.
#
#    % script.pl --name-json 'null'
#
#But every other string will need to be quoted:
#
#    % script.pl --name-json '"foo"'
#
#See also: per_arg_yaml. You should enable just one instead of turning on both.
#
#_
#        },
#        common_opts => {
#            summary => 'Common options',
#            description => <<'_',
#
#A hash where the values are hashes containing these keys: `getopt` (Getopt::Long
#option specification), `handler` (Getopt::Long handler). Will be passed to
#`get_args_from_argv()`. Example:
#
#    {
#        help => {
#            getopt  => 'help|h|?',
#            handler => sub { ... },
#            summary => 'Display help and exit',
#        },
#        version => {
#            getopt  => 'version|v',
#            handler => sub { ... },
#            summary => 'Display version and exit',
#        },
#    }
#
#_
#            schema => ['hash*'],
#        },
#        allow_extra_elems => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Allow extra/unassigned elements in argv',
#            description => <<'_',
#
#If set to 1, then if there are array elements unassigned to one of the
#arguments, instead of generating an error, this function will just ignore them.
#
#This option will be passed to Perinci::Sub::GetArgs::Array's allow_extra_elems.
#
#_
#        },
#        on_missing_required_args => {
#            schema => 'code',
#            summary => 'Execute code when there is missing required args',
#            description => <<'_',
#
#This can be used to give a chance to supply argument value from other sources if
#not specified by command-line options. Perinci::CmdLine, for example, uses this
#hook to supply value from STDIN or file contents (if argument has `cmdline_src`
#specification key set).
#
#This hook will be called for each missing argument. It will be supplied hash
#arguments: (arg => $the_missing_argument_name, args =>
#$the_resulting_args_so_far, spec => $the_arg_spec).
#
#The hook can return true if it succeeds in making the missing situation
#resolved. In this case, this function will not report the argument as missing.
#
#_
#        },
#        ignore_converted_code => {
#            summary => 'Whether to ignore coderefs converted to string',
#            schema => 'bool',
#            default => 0,
#            description => <<'_',
#
#Across network through JSON encoding, coderef in metadata (e.g. in
#`cmdline_aliases` property) usually gets converted to string `CODE`. In some
#cases, like for tab completion, this is harmless so you can turn this option on.
#
#_
#        },
#        ggls_res => {
#            summary => 'Full result from gen_getopt_long_spec_from_meta()',
#            schema  => 'array*', 
#            description => <<'_',
#
#If you already call `gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
#here, to avoid calculating twice.
#
#_
#            tags => ['category:optimization'],
#        },
#    },
#    result => {
#        description => <<'_',
#
#Error codes:
#
#* 400 - Error in Getopt::Long option specification, e.g. in common_opts.
#
#* 500 - failure in GetOptions, meaning argv is not valid according to metadata
#  specification (only if 'strict' mode is enabled).
#
#* 501 - coderef in cmdline_aliases got converted into a string, probably because
#  the metadata was transported (e.g. through Riap::HTTP/Riap::Simple).
#
#_
#    },
#};
#sub get_args_from_argv {
#    require Getopt::Long;
#
#    my %fargs = @_;
#    my $argv       = $fargs{argv} // \@ARGV;
#    my $meta       = $fargs{meta} or return [400, "Please specify meta"];
#    unless ($fargs{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
#    }
#    my $strict            = $fargs{strict} // 1;
#    my $common_opts       = $fargs{common_opts} // {};
#    my $per_arg_yaml      = $fargs{per_arg_yaml} // 0;
#    my $per_arg_json      = $fargs{per_arg_json} // 0;
#    my $allow_extra_elems = $fargs{allow_extra_elems} // 0;
#    my $on_missing        = $fargs{on_missing_required_args};
#    my $ignore_converted_code = $fargs{ignore_converted_code};
#
#    my $rargs = $fargs{args} // {};
#
#    my $genres = $fargs{ggls_res} // gen_getopt_long_spec_from_meta(
#        meta => $meta, meta_is_normalized => 1,
#        args => $rargs,
#        common_opts  => $common_opts,
#        per_arg_json => $per_arg_json,
#        per_arg_yaml => $per_arg_yaml,
#        ignore_converted_code => $ignore_converted_code,
#    );
#    return err($genres->[0], "Can't generate Getopt::Long spec", $genres)
#        if $genres->[0] != 200;
#    my $go_spec = $genres->[2];
#
#    {
#        local $SIG{__WARN__} = sub{} if !$strict;
#        my $old_go_conf = Getopt::Long::Configure(
#            $strict ? "no_pass_through" : "pass_through",
#            "no_ignore_case", "permute", "no_getopt_compat", "gnu_compat", "bundling");
#        my $res = Getopt::Long::GetOptionsFromArray($argv, %$go_spec);
#        Getopt::Long::Configure($old_go_conf);
#        unless ($res) {
#            return [500, "GetOptions failed"] if $strict;
#        }
#    }
#
#
#    my $args_prop = $meta->{args};
#
#    if (@$argv) {
#        my $res = get_args_from_array(
#            array=>$argv, meta => $meta,
#            meta_is_normalized => 1,
#            allow_extra_elems => $allow_extra_elems,
#        );
#        if ($res->[0] != 200 && $strict) {
#            return err(500, "Get args from array failed", $res);
#        } elsif ($strict && $res->[0] != 200) {
#            return err("Can't get args from argv", $res);
#        } elsif ($res->[0] == 200) {
#            my $pos_args = $res->[2];
#            for my $name (keys %$pos_args) {
#                my $arg_spec = $args_prop->{$name};
#                my $val      = $pos_args->{$name};
#                if (exists $rargs->{$name}) {
#                    return [400, "You specified option --$name but also ".
#                                "argument #".$arg_spec->{pos}] if $strict;
#                }
#                my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
#                    _is_simple_or_array_of_simple_or_hash_of_simple($arg_spec->{schema});
#
#                if ($arg_spec->{greedy} && ref($val) eq 'ARRAY' &&
#                        !$is_array_of_simple && !$is_hash_of_simple) {
#                    my $i = 0;
#                    for (@$val) {
#                      TRY_PARSING_AS_JSON_YAML:
#                        {
#                            my ($success, $e, $decoded);
#                            if ($per_arg_json) {
#                                ($success, $e, $decoded) = _parse_json($_);
#                                if ($success) {
#                                    $_ = $decoded;
#                                    last TRY_PARSING_AS_JSON_YAML;
#                                } else {
#                                    warn "Failed trying to parse argv #$i as JSON: $e";
#                                }
#                            }
#                            if ($per_arg_yaml) {
#                                ($success, $e, $decoded) = _parse_yaml($_);
#                                if ($success) {
#                                    $_ = $decoded;
#                                    last TRY_PARSING_AS_JSON_YAML;
#                                } else {
#                                    warn "Failed trying to parse argv #$i as YAML: $e";
#                                }
#                            }
#                        }
#                        $i++;
#                    }
#                }
#                if (!$arg_spec->{greedy} && !$is_simple) {
#                  TRY_PARSING_AS_JSON_YAML:
#                    {
#                        my ($success, $e, $decoded);
#                        if ($per_arg_json) {
#                            ($success, $e, $decoded) = _parse_json($val);
#                            if ($success) {
#                                $val = $decoded;
#                                last TRY_PARSING_AS_JSON_YAML;
#                            } else {
#                                warn "Failed trying to parse argv #$arg_spec->{pos} as JSON: $e";
#                            }
#                        }
#                        if ($per_arg_yaml) {
#                            ($success, $e, $decoded) = _parse_yaml($val);
#                            if ($success) {
#                                $val = $decoded;
#                                last TRY_PARSING_AS_JSON_YAML;
#                            } else {
#                                warn "Failed trying to parse argv #$arg_spec->{pos} as YAML: $e";
#                            }
#                        }
#                    }
#                }
#                $rargs->{$name} = $val;
#                if ($arg_spec->{cmdline_on_getopt}) {
#                    if ($arg_spec->{greedy}) {
#                        $arg_spec->{cmdline_on_getopt}->(
#                            arg=>$name, fqarg=>$name, value=>$_, args=>$rargs,
#                            opt=>undef, 
#                        ) for @$val;
#                    } else {
#                        $arg_spec->{cmdline_on_getopt}->(
#                            arg=>$name, fqarg=>$name, value=>$val, args=>$rargs,
#                            opt=>undef, 
#                        );
#                    }
#                }
#            }
#        }
#    }
#
#
#    my %missing_args;
#    for my $arg (keys %$args_prop) {
#        my $arg_spec = $args_prop->{$arg};
#        if (!exists($rargs->{$arg})) {
#            next unless $arg_spec->{req};
#            if ($on_missing) {
#                next if $on_missing->(arg=>$arg, args=>$rargs, spec=>$arg_spec);
#            }
#            next if exists $rargs->{$arg};
#            $missing_args{$arg} = 1;
#        }
#    }
#
#    {
#        last unless $strict;
#
#        for my $arg (keys %$args_prop) {
#            my $arg_spec = $args_prop->{$arg};
#            next unless exists $rargs->{$arg};
#            next unless $arg_spec->{deps};
#            my $dep_arg = $arg_spec->{deps}{arg};
#            next unless $dep_arg;
#            return [400, "You specify '$arg', but don't specify '$dep_arg' ".
#                        "(upon which '$arg' depends)"]
#                unless exists $rargs->{$dep_arg};
#        }
#    }
#
#    [200, "OK", $rargs, {
#        "func.missing_args" => [sort keys %missing_args],
#        "func.gen_getopt_long_spec_result" => $genres,
#    }];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/GetArgs/Array.pm ###
#package Perinci::Sub::GetArgs::Array;
#
#our $DATE = '2016-12-10'; 
#our $VERSION = '0.16'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(get_args_from_array);
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#};
#
#$SPEC{get_args_from_array} = {
#    v => 1.1,
#    summary => 'Get subroutine arguments (%args) from array',
#    description => <<'_',
#
#Using information in metadata's `args` property (particularly the `pos` and
#`greedy` arg type clauses), extract arguments from an array into a hash
#`\%args`, suitable for passing into subs.
#
#Example:
#
#    my $meta = {
#        v => 1.1,
#        summary => 'Multiply 2 numbers (a & b)',
#        args => {
#            a => {schema=>'num*', pos=>0},
#            b => {schema=>'num*', pos=>1},
#        }
#    }
#
#then `get_args_from_array(array=>[2, 3], meta=>$meta)` will produce:
#
#    [200, "OK", {a=>2, b=>3}]
#
#_
#    args => {
#        array => {
#            schema => ['array*' => {}],
#            req => 1,
#            description => <<'_',
#
#NOTE: array will be modified/emptied (elements will be taken from the array as
#they are put into the resulting args). Copy your array first if you want to
#preserve its content.
#
#_
#        },
#        meta => {
#            schema => ['hash*' => {}],
#            req => 1,
#        },
#        meta_is_normalized => {
#            summary => 'Can be set to 1 if your metadata is normalized, '.
#                'to avoid duplicate effort',
#            schema => 'bool',
#            default => 0,
#        },
#        allow_extra_elems => {
#            schema => ['bool' => {default=>0}],
#            summary => 'Allow extra/unassigned elements in array',
#            description => <<'_',
#
#If set to 1, then if there are array elements unassigned to one of the arguments
#(due to missing `pos`, for example), instead of generating an error, the
#function will just ignore them.
#
#_
#        },
#    },
#};
#sub get_args_from_array {
#    my %fargs = @_;
#    my $ary  = $fargs{array} or return [400, "Please specify array"];
#    my $meta = $fargs{meta} or return [400, "Please specify meta"];
#    unless ($fargs{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata(
#            $meta);
#    }
#    my $allow_extra_elems = $fargs{allow_extra_elems} // 0;
#
#    my $rargs = {};
#
#    my $args_p = $meta->{args} // {};
#    for my $i (reverse 0..@$ary-1) {
#        while (my ($a, $as) = each %$args_p) {
#            my $o = $as->{pos};
#            if (defined($o) && $o == $i) {
#                if ($as->{greedy}) {
#                    my $type = $as->{schema}[0];
#                    my @elems = splice(@$ary, $i);
#                    if ($type eq 'array') {
#                        $rargs->{$a} = \@elems;
#                    } elsif ($type eq 'hash') {
#                        $rargs->{$a} = {};
#                        for my $j (0..$#elems) {
#                            my $elem = $elems[$j];
#                            unless ($elem =~ /(.*?)=(.*)/) {
#                                return [400, "Invalid key=value pair in element #$j"];
#                            }
#                            $rargs->{$a}{$1} = $2;
#                        }
#                    } else {
#                        $rargs->{$a} = join " ", @elems;
#                    }
#                } else {
#                    $rargs->{$a} = splice(@$ary, $i, 1);
#                }
#            }
#        }
#    }
#
#    return [400, "There are extra, unassigned elements in array: [".
#                join(", ", @$ary)."]"] if @$ary && !$allow_extra_elems;
#
#    [200, "OK", $rargs];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Normalize.pm ###
#package Perinci::Sub::Normalize;
#
#our $DATE = '2016-12-11'; 
#our $VERSION = '0.19'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       normalize_function_metadata
#               );
#
#sub _normalize{
#    my ($meta, $ver, $opts, $proplist, $nmeta, $prefix, $modprefix) = @_;
#
#    my $opt_aup = $opts->{allow_unknown_properties};
#    my $opt_nss = $opts->{normalize_sah_schemas};
#    my $opt_rip = $opts->{remove_internal_properties};
#
#    if (defined $ver) {
#        defined($meta->{v}) && $meta->{v} eq $ver
#            or die "$prefix: Metadata version must be $ver";
#    }
#
#  KEY:
#    for my $k (keys %$meta) {
#        die "Invalid prop/attr syntax '$k', must be word/dotted-word only"
#            unless $k =~ /\A(\w+)(?:\.(\w+(?:\.\w+)*))?(?:\((\w+)\))?\z/;
#
#        my ($prop, $attr);
#        if (defined $3) {
#            $prop = $1;
#            $attr = defined($2) ? "$2.alt.lang.$3" : "alt.lang.$3";
#        } else {
#            $prop = $1;
#            $attr = $2;
#        }
#
#        my $nk = "$prop" . (defined($attr) ? ".$attr" : "");
#
#        if ($prop =~ /\A_/ || defined($attr) && $attr =~ /\A_|\._/) {
#            unless ($opt_rip) {
#                $nmeta->{$nk} = $meta->{$k};
#            }
#            next KEY;
#        }
#
#        my $prop_proplist = $proplist->{$prop};
#
#        if (!$opt_aup && !$prop_proplist) {
#            $modprefix //= $prefix;
#            my $mod = "Perinci/Sub/Property$modprefix/$prop.pm";
#            eval { require $mod };
#            if ($@) {
#                die "Unknown property '$prefix/$prop' (and couldn't ".
#                    "load property module '$mod'): $@" if $@;
#            }
#            $prop_proplist = $proplist->{$prop};
#        }
#        die "Unknown property '$prefix/$prop'"
#            unless $opt_aup || $prop_proplist;
#
#        if ($prop_proplist && $prop_proplist->{_prop}) {
#            die "Property '$prefix/$prop' must be a hash"
#                unless ref($meta->{$k}) eq 'HASH';
#            $nmeta->{$nk} = {};
#            _normalize(
#                $meta->{$k},
#                $prop_proplist->{_ver},
#                $opts,
#                $prop_proplist->{_prop},
#                $nmeta->{$nk},
#                "$prefix/$prop",
#            );
#        } elsif ($prop_proplist && $prop_proplist->{_elem_prop}) {
#            die "Property '$prefix/$prop' must be an array"
#                unless ref($meta->{$k}) eq 'ARRAY';
#            $nmeta->{$nk} = [];
#            my $i = 0;
#            for (@{ $meta->{$k} }) {
#                my $href = {};
#                if (ref($_) eq 'HASH') {
#                    _normalize(
#                        $_,
#                        $prop_proplist->{_ver},
#                        $opts,
#                        $prop_proplist->{_elem_prop},
#                        $href,
#                        "$prefix/$prop/$i",
#                    );
#                    push @{ $nmeta->{$nk} }, $href;
#                } else {
#                    push @{ $nmeta->{$nk} }, $_;
#                }
#                $i++;
#            }
#        } elsif ($prop_proplist && $prop_proplist->{_value_prop}) {
#            die "Property '$prefix/$prop' must be a hash"
#                unless ref($meta->{$k}) eq 'HASH';
#            $nmeta->{$nk} = {};
#            for (keys %{ $meta->{$k} }) {
#                $nmeta->{$nk}{$_} = {};
#                die "Property '$prefix/$prop/$_' must be a hash"
#                    unless ref($meta->{$k}{$_}) eq 'HASH';
#                _normalize(
#                    $meta->{$k}{$_},
#                    $prop_proplist->{_ver},
#                    $opts,
#                    $prop_proplist->{_value_prop},
#                    $nmeta->{$nk}{$_},
#                    "$prefix/$prop/$_",
#                    ($prop eq 'args' ? "$prefix/arg" : undef),
#                );
#            }
#        } else {
#            if ($k eq 'schema' && $opt_nss) { 
#                require Data::Sah::Normalize;
#                $nmeta->{$nk} = Data::Sah::Normalize::normalize_schema(
#                    $meta->{$k});
#            } else {
#                $nmeta->{$nk} = $meta->{$k};
#            }
#        }
#    }
#
#    $nmeta;
#}
#
#sub normalize_function_metadata($;$) {
#    my ($meta, $opts) = @_;
#
#    $opts //= {};
#
#    $opts->{allow_unknown_properties}    //= 0;
#    $opts->{normalize_sah_schemas}       //= 1;
#    $opts->{remove_internal_properties}  //= 0;
#
#    require Sah::Schema::rinci::function_meta;
#    my $sch = $Sah::Schema::rinci::function_meta::schema;
#    my $sch_proplist = $sch->[1]{_prop}
#        or die "BUG: Rinci schema structure changed (1a)";
#
#    _normalize($meta, 1.1, $opts, $sch_proplist, {}, '');
#}
#
#1;
#
#__END__
#
### Perinci/Sub/To/CLIDocData.pm ###
#package Perinci::Sub::To::CLIDocData;
#
#our $DATE = '2016-10-27'; 
#our $VERSION = '0.28'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Perinci::Object;
#use Perinci::Sub::Util qw(err);
#
#our %SPEC;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(gen_cli_doc_data_from_meta);
#
#sub _has_cats {
#    for my $spec (@{ $_[0] }) {
#        for (@{ $spec->{tags} // [] }) {
#            my $tag_name = ref($_) ? $_->{name} : $_;
#            if ($tag_name =~ /^category:/) {
#                return 1;
#            }
#        }
#    }
#    0;
#}
#
#sub _add_category_from_spec {
#    my ($cats_spec, $thing, $spec, $noun, $has_cats) = @_;
#    my @cats;
#    for (@{ $spec->{tags} // [] }) {
#        my $tag_name = ref($_) ? $_->{name} : $_;
#        if ($tag_name =~ /^category(\d+)?:(.+)/) {
#            my $cat = ucfirst($2);
#            my $ordering = $1 // 50;
#            $cat =~ s/-/ /g;
#            $cat .= " " . $noun;
#            push @cats, [$cat, $ordering]; 
#        }
#    }
#    if (!@cats) {
#        @cats = [$has_cats ? "Other $noun" : ucfirst($noun), 99]; 
#    }
#
#    $thing->{category} = $cats[0][0];
#    $thing->{categories} = [map {$_->[0]} @cats];
#
#    $cats_spec->{$_->[0]}{order} //= $_->[1] for @cats;
#}
#
#sub _add_default_from_arg_spec {
#    my ($opt, $arg_spec) = @_;
#    if (exists $arg_spec->{default}) {
#        $opt->{default} = $arg_spec->{default};
#    } elsif ($arg_spec->{schema} && exists($arg_spec->{schema}[1]{default})) {
#        $opt->{default} = $arg_spec->{schema}[1]{default};
#    }
#}
#
#sub _dash_prefix {
#    length($_[0]) > 1 ? "--$_[0]" : "-$_[0]";
#}
#
#sub _fmt_opt {
#    my $spec = shift;
#    my @ospecs = @_;
#    my @res;
#    my $i = 0;
#    for my $ospec (@ospecs) {
#        my $j = 0;
#        my $parsed = $ospec->{parsed};
#        for (@{ $parsed->{opts} }) {
#            my $opt = _dash_prefix($_);
#            if ($i==0 && $j==0) {
#                if ($parsed->{type}) {
#                    if ($spec->{'x.schema.entity'}) {
#                        $opt .= "=".$spec->{'x.schema.entity'};
#                    } elsif ($spec->{'x.schema.element_entity'}) {
#                        $opt .= "=".$spec->{'x.schema.element_entity'};
#                    } else {
#                        $opt .= "=$parsed->{type}";
#                    }
#                }
#                $opt .= "*" if $spec->{req} && !$ospec->{is_base64} &&
#                    !$ospec->{is_json} && !$ospec->{is_yaml};
#            }
#            push @res, $opt;
#            $j++;
#        }
#        $i++;
#    }
#    join ", ", @res;
#}
#
#$SPEC{gen_cli_doc_data_from_meta} = {
#    v => 1.1,
#    summary => 'From Rinci function metadata, generate structure convenient '.
#        'for producing CLI documentation (help/usage/POD)',
#    description => <<'_',
#
#This function calls <pm:Perinci::Sub::GetArgs::Argv>'s
#`gen_getopt_long_spec_from_meta()` (or receive its result as an argument, if
#passed, to avoid calling the function twice) and post-processes it: produce
#command usage line, format the options, include information from metadata, group
#the options by category. It also selects examples in the `examples` property
#which are applicable to CLI environment and format them.
#
#The resulting data structure is convenient to use when one wants to produce a
#documentation for CLI program (including help/usage message and POD).
#
#_
#    args => {
#        meta => {
#            schema => 'hash*', 
#            req => 1,
#            pos => 0,
#        },
#        meta_is_normalized => {
#            schema => 'bool*',
#        },
#        common_opts => {
#            summary => 'Will be passed to gen_getopt_long_spec_from_meta()',
#            schema  => 'hash*',
#        },
#        ggls_res => {
#            summary => 'Full result from gen_getopt_long_spec_from_meta()',
#            schema  => 'array*', 
#            description => <<'_',
#
#If you already call <pm:Perinci::Sub::GetArgs::Argv>'s
#`gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
#here, to avoid calculating twice. What will be useful for the function is the
#extra result in result metadata (`func.*` keys in `$res->[3]` hash).
#
#_
#        },
#        per_arg_json => {
#            schema => 'bool',
#            summary => 'Pass per_arg_json=1 to Perinci::Sub::GetArgs::Argv',
#        },
#        per_arg_yaml => {
#            schema => 'bool',
#            summary => 'Pass per_arg_json=1 to Perinci::Sub::GetArgs::Argv',
#        },
#        lang => {
#            schema => 'str*',
#        },
#    },
#    result => {
#        schema => 'hash*',
#    },
#};
#sub gen_cli_doc_data_from_meta {
#    require Getopt::Long::Negate::EN;
#
#    my %args = @_;
#
#    my $lang = $args{lang};
#    my $meta = $args{meta} or return [400, 'Please specify meta'];
#    my $common_opts = $args{common_opts};
#    unless ($args{meta_is_normalized}) {
#        require Perinci::Sub::Normalize;
#        $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
#    }
#    my $ggls_res = $args{ggls_res} // do {
#        require Perinci::Sub::GetArgs::Argv;
#        Perinci::Sub::GetArgs::Argv::gen_getopt_long_spec_from_meta(
#            meta=>$meta, meta_is_normalized=>1, common_opts=>$common_opts,
#            per_arg_json => $args{per_arg_json},
#            per_arg_yaml => $args{per_arg_yaml},
#        );
#    };
#    $ggls_res->[0] == 200 or return $ggls_res;
#
#    my $args_prop = $meta->{args} // {};
#    my $clidocdata = {
#        option_categories => {},
#        example_categories => {},
#    };
#
#    {
#        my @args;
#        my %args_prop = %$args_prop; 
#        my $max_pos = -1;
#        for (values %args_prop) {
#            $max_pos = $_->{pos}
#                if defined($_->{pos}) && $_->{pos} > $max_pos;
#        }
#        my $pos = 0;
#        while ($pos <= $max_pos) {
#            my ($arg, $arg_spec);
#            for (keys %args_prop) {
#                $arg_spec = $args_prop{$_};
#                if (defined($arg_spec->{pos}) && $arg_spec->{pos}==$pos) {
#                    $arg = $_;
#                    last;
#                }
#            }
#            $pos++;
#            next unless defined($arg);
#            if ($arg_spec->{greedy}) {
#                $arg = $arg_spec->{'x.name.singular'}
#                    if $arg_spec->{'x.name.is_plural'} &&
#                    defined $arg_spec->{'x.name.singular'};
#            }
#            if ($arg_spec->{req}) {
#                push @args, "<$arg>";
#            } else {
#                push @args, "[$arg]";
#            }
#            $args[-1] .= " ..." if $arg_spec->{greedy};
#            delete $args_prop{$arg};
#        }
#        unshift @args, "[options]" if keys(%args_prop) || keys(%$common_opts); 
#        $clidocdata->{usage_line} = "[[prog]]".
#            (@args ? " ".join(" ", @args) : "");
#    }
#
#    my %opts;
#    {
#        my $ospecs = $ggls_res->[3]{'func.specmeta'};
#        my (@k, @k_aliases);
#      OSPEC1:
#        for (sort keys %$ospecs) {
#            my $ospec = $ospecs->{$_};
#            {
#                last unless $ospec->{is_alias};
#                next if $ospec->{is_code};
#                my $arg_spec = $args_prop->{$ospec->{arg}};
#                my $alias_spec = $arg_spec->{cmdline_aliases}{$ospec->{alias}};
#                next if $alias_spec->{summary};
#                push @k_aliases, $_;
#                next OSPEC1;
#            }
#            push @k, $_;
#        }
#
#        my %negs; 
#
#      OSPEC2:
#        while (@k) {
#            my $k = shift @k;
#            my $ospec = $ospecs->{$k};
#            my $opt;
#            my $optkey;
#
#            if ($ospec->{is_alias} || defined($ospec->{arg})) {
#                my $arg_spec;
#                my $alias_spec;
#
#                if ($ospec->{is_alias}) {
#
#                    $arg_spec = $args_prop->{ $ospec->{arg} };
#                    $alias_spec = $arg_spec->{cmdline_aliases}{$ospec->{alias}};
#                    my $rimeta = rimeta($alias_spec);
#                    $optkey = _fmt_opt($arg_spec, $ospec);
#                    $opt = {
#                        opt_parsed => $ospec->{parsed},
#                        orig_opt => $k,
#                        is_alias => 1,
#                        alias_for => $ospec->{alias_for},
#                        summary => $rimeta->langprop({lang=>$lang}, 'summary') //
#                            "Alias for "._dash_prefix($ospec->{parsed}{opts}[0]),
#                        description =>
#                            $rimeta->langprop({lang=>$lang}, 'description'),
#                    };
#                } else {
#
#                    $arg_spec = $args_prop->{$ospec->{arg}};
#                    my $rimeta = rimeta($arg_spec);
#                    $opt = {
#                        opt_parsed => $ospec->{parsed},
#                        orig_opt => $k,
#                    };
#
#                    if (defined($ospec->{is_neg})) {
#                        my $default = $arg_spec->{default} //
#                            $arg_spec->{schema}[1]{default};
#                        next OSPEC2 if  $default && !$ospec->{is_neg};
#                        next OSPEC2 if !$default &&  $ospec->{is_neg};
#                        if ($ospec->{is_neg}) {
#                            next OSPEC2 if $negs{$ospec->{arg}}++;
#                        }
#                    }
#
#                    if ($ospec->{is_neg}) {
#                        $opt->{summary} =
#                            $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.not');
#                    } elsif (defined $ospec->{is_neg}) {
#                        $opt->{summary} =
#                            $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.yes') //
#                                $rimeta->langprop({lang=>$lang}, 'summary');
#                    } elsif (($ospec->{parsed}{type}//'') eq 's@') {
#                        $opt->{summary} =
#                            $rimeta->langprop({lang=>$lang}, 'summary.alt.plurality.singular') //
#                                $rimeta->langprop({lang=>$lang}, 'summary');
#                    } else {
#                        $opt->{summary} =
#                            $rimeta->langprop({lang=>$lang}, 'summary');
#                    }
#                    $opt->{description} =
#                        $rimeta->langprop({lang=>$lang}, 'description');
#
#                    my @aliases;
#                    my $j = $#k_aliases;
#                    while ($j >= 0) {
#                        my $aospec = $ospecs->{ $k_aliases[$j] };
#                        {
#                            last unless $aospec->{arg} eq $ospec->{arg};
#                            push @aliases, $aospec;
#                            splice @k_aliases, $j, 1;
#                        }
#                        $j--;
#                    }
#
#                    $optkey = _fmt_opt($arg_spec, $ospec, @aliases);
#                }
#
#                $opt->{arg_spec} = $arg_spec;
#                $opt->{alias_spec} = $alias_spec if $alias_spec;
#
#                for (qw/arg fqarg is_base64 is_json is_yaml/) {
#                    $opt->{$_} = $ospec->{$_} if defined $ospec->{$_};
#                }
#
#                for (qw/req pos greedy is_password links tags/) {
#                    $opt->{$_} = $arg_spec->{$_} if defined $arg_spec->{$_};
#                }
#
#                {
#                    local $arg_spec->{tags} = ['category0:main']
#                        if !$arg_spec->{tags} || !@{$arg_spec->{tags}};
#                    _add_category_from_spec($clidocdata->{option_categories},
#                                            $opt, $arg_spec, "options", 1);
#                }
#                _add_default_from_arg_spec($opt, $arg_spec);
#
#            } else {
#
#                my $spec = $common_opts->{$ospec->{common_opt}};
#
#                my $show_neg = $ospec->{parsed}{is_neg} && $spec->{default};
#
#                local $ospec->{parsed}{opts} = do {
#                    my @opts = Getopt::Long::Negate::EN::negations_for_option(
#                        $ospec->{parsed}{opts}[0]);
#                    [ $opts[0] ];
#                } if $show_neg;
#
#                $optkey = _fmt_opt($spec, $ospec);
#                my $rimeta = rimeta($spec);
#                $opt = {
#                    opt_parsed => $ospec->{parsed},
#                    orig_opt => $k,
#                    common_opt => $ospec->{common_opt},
#                    common_opt_spec => $spec,
#                    summary => $show_neg ?
#                        $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.not') :
#                            $rimeta->langprop({lang=>$lang}, 'summary'),
#                    (schema => $spec->{schema}) x !!$spec->{schema},
#                    ('x.schema.entity' => $spec->{'x.schema.entity'}) x !!$spec->{'x.schema.entity'},
#                    ('x.schema.element_entity' => $spec->{'x.schema.element_entity'}) x !!$spec->{'x.schema.element_entity'},
#                    description =>
#                        $rimeta->langprop({lang=>$lang}, 'description'),
#                    (default => $spec->{default}) x !!(exists($spec->{default}) && !$show_neg),
#                };
#
#                _add_category_from_spec($clidocdata->{option_categories},
#                                        $opt, $spec, "options", 1);
#
#            }
#
#            $opts{$optkey} = $opt;
#        }
#
#      OPT1:
#        for my $k (keys %opts) {
#            my $opt = $opts{$k};
#            next unless $opt->{is_alias} || $opt->{is_base64} ||
#                $opt->{is_json} || $opt->{is_yaml};
#            for my $k2 (keys %opts) {
#                my $arg_opt = $opts{$k2};
#                next if $arg_opt->{is_alias} || $arg_opt->{is_base64} ||
#                    $arg_opt->{is_json} || $arg_opt->{is_yaml};
#                next unless defined($arg_opt->{arg}) &&
#                    $arg_opt->{arg} eq $opt->{arg};
#                $opt->{main_opt} = $k2;
#                next OPT1;
#            }
#        }
#
#    }
#    $clidocdata->{opts} = \%opts;
#
#    my @examples;
#    {
#        my $examples = $meta->{examples} // [];
#        my $has_cats = _has_cats($examples);
#
#        for my $eg (@$examples) {
#            my $rimeta = rimeta($eg);
#            my $argv;
#            my $cmdline;
#            if (defined($eg->{src})) {
#                if ($eg->{src_plang} =~ /^(sh|bash)$/) {
#                    $cmdline = $eg->{src};
#                } else {
#                    next;
#                }
#            } else {
#                require String::ShellQuote;
#                if ($eg->{argv}) {
#                    $argv = $eg->{argv};
#                } else {
#                    require Perinci::Sub::ConvertArgs::Argv;
#                    my $res = Perinci::Sub::ConvertArgs::Argv::convert_args_to_argv(
#                        args => $eg->{args}, meta => $meta, use_pos => 1);
#                    return err($res, 500, "Can't convert args to argv")
#                        unless $res->[0] == 200;
#                    $argv = $res->[2];
#                }
#                $cmdline = "[[prog]]";
#                for my $arg (@$argv) {
#                    my $qarg = String::ShellQuote::shell_quote($arg);
#                    $cmdline .= " $qarg"; 
#                }
#            }
#            my $egdata = {
#                cmdline      => $cmdline,
#                summary      => $rimeta->langprop({lang=>$lang}, 'summary'),
#                description  => $rimeta->langprop({lang=>$lang}, 'description'),
#                example_spec => $eg,
#            };
#            _add_category_from_spec($clidocdata->{example_categories},
#                                    $egdata, $eg, "examples", $has_cats);
#            push @examples, $egdata;
#        }
#    }
#    $clidocdata->{examples} = \@examples;
#
#    [200, "OK", $clidocdata];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Util.pm ###
#package Perinci::Sub::Util;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       err
#                       caller
#                       warn_err
#                       die_err
#                       gen_modified_sub
#                       gen_curried_sub
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Helper when writing functions',
#};
#
#our $STACK_TRACE;
#our @_c; 
#our $_i; 
#sub err {
#    require Scalar::Util;
#
#    my @caller = CORE::caller(1);
#    if (!@caller) {
#        @caller = ("main", "-e", 1, "program");
#    }
#
#    my ($status, $msg, $meta, $prev);
#
#    for (@_) {
#        my $ref = ref($_);
#        if ($ref eq 'ARRAY') { $prev = $_ }
#        elsif ($ref eq 'HASH') { $meta = $_ }
#        elsif (!$ref) {
#            if (Scalar::Util::looks_like_number($_)) {
#                $status = $_;
#            } else {
#                $msg = $_;
#            }
#        }
#    }
#
#    $status //= 500;
#    $msg  //= "$caller[3] failed";
#    $meta //= {};
#    $meta->{prev} //= $prev if $prev;
#
#    if (!$meta->{logs}) {
#
#        my $stack_trace;
#        {
#            no warnings;
#            last unless $STACK_TRACE // $INC{"Carp/Always.pm"};
#            last if $prev && ref($prev->[3]) eq 'HASH' &&
#                ref($prev->[3]{logs}) eq 'ARRAY' &&
#                    ref($prev->[3]{logs}[0]) eq 'HASH' &&
#                        $prev->[3]{logs}[0]{stack_trace};
#            $stack_trace = [];
#            $_i = 1;
#            while (1) {
#                {
#                    package DB;
#                    @_c = CORE::caller($_i);
#                    if (@_c) {
#                        $_c[4] = [@DB::args];
#                    }
#                }
#                last unless @_c;
#                push @$stack_trace, [@_c];
#                $_i++;
#            }
#        }
#        push @{ $meta->{logs} }, {
#            type    => 'create',
#            time    => time(),
#            package => $caller[0],
#            file    => $caller[1],
#            line    => $caller[2],
#            func    => $caller[3],
#            ( stack_trace => $stack_trace ) x !!$stack_trace,
#        };
#    }
#
#    [$status, $msg, undef, $meta];
#}
#
#sub warn_err {
#    require Carp;
#
#    my $res = err(@_);
#    Carp::carp("ERROR $res->[0]: $res->[1]");
#}
#
#sub die_err {
#    require Carp;
#
#    my $res = err(@_);
#    Carp::croak("ERROR $res->[0]: $res->[1]");
#}
#
#sub caller {
#    my $n0 = shift;
#    my $n  = $n0 // 0;
#
#    my $pkg = $Perinci::Sub::Wrapper::default_wrapped_package //
#        'Perinci::Sub::Wrapped';
#
#    my @r;
#    my $i =  0;
#    my $j = -1;
#    while ($i <= $n+1) { 
#        $j++;
#        @r = CORE::caller($j);
#        last unless @r;
#        if ($r[0] eq $pkg && $r[1] =~ /^\(eval /) {
#            next;
#        }
#        $i++;
#    }
#
#    return unless @r;
#    return defined($n0) ? @r : $r[0];
#}
#
#$SPEC{gen_modified_sub} = {
#    v => 1.1,
#    summary => 'Generate modified metadata (and subroutine) based on another',
#    description => <<'_',
#
#Often you'll want to create another sub (and its metadata) based on another, but
#with some modifications, e.g. add/remove/rename some arguments, change summary,
#add/remove some properties, and so on.
#
#Instead of cloning the Rinci metadata and modify it manually yourself, this
#routine provides some shortcuts.
#
#You can specify base sub/metadata using `base_name` (string, subroutine name,
#either qualified or not) or `base_code` (coderef) + `base_meta` (hash).
#
#_
#    args => {
#        base_name => {
#            summary => 'Subroutine name (either qualified or not)',
#            schema => 'str*',
#            description => <<'_',
#
#If not qualified with package name, will be searched in the caller's package.
#Rinci metadata will be searched in `%SPEC` package variable.
#
#Alternatively, you can also specify `base_code` and `base_meta`.
#
#_
#        },
#        base_code => {
#            summary => 'Base subroutine code',
#            schema  => 'code*',
#            description => <<'_',
#
#If you specify this, you'll also need to specify `base_meta`.
#
#Alternatively, you can specify `base_name` instead, to let this routine search
#the base subroutine from existing Perl package.
#
#_
#        },
#        base_meta => {
#            summary => 'Base Rinci metadata',
#            schema  => 'hash*', 
#        },
#        output_name => {
#            summary => 'Where to install the modified sub',
#            schema  => 'str*',
#            description => <<'_',
#
#Subroutine will be put in the specified name. If the name is not qualified with
#package name, will use caller's package. If no `output_code` is specified, the
#base subroutine reference will be assigned here.
#
#Note that this argument is optional.
#
#_
#        },
#        output_code => {
#            summary => 'Code for the modified sub',
#            schema  => 'code*',
#            description => <<'_',
#
#If not specified will use `base_code` (which will then be required).
#
#_
#        },
#        summary => {
#            summary => 'Summary for the mod subroutine',
#            schema  => 'str*',
#        },
#        description => {
#            summary => 'Description for the mod subroutine',
#            schema  => 'str*',
#        },
#        remove_args => {
#            summary => 'List of arguments to remove',
#            schema  => 'array*',
#        },
#        add_args => {
#            summary => 'Arguments to add',
#            schema  => 'hash*',
#        },
#        replace_args => {
#            summary => 'Arguments to add',
#            schema  => 'hash*',
#        },
#        rename_args => {
#            summary => 'Arguments to rename',
#            schema  => 'hash*',
#        },
#        modify_args => {
#            summary => 'Arguments to modify',
#            description => <<'_',
#
#For each argument you can specify a coderef. The coderef will receive the
#argument ($arg_spec) and is expected to modify the argument specification.
#
#_
#            schema  => 'hash*',
#        },
#        modify_meta => {
#            summary => 'Specify code to modify metadata',
#            schema  => 'code*',
#            description => <<'_',
#
#Code will be called with arguments ($meta) where $meta is the cloned Rinci
#metadata.
#
#_
#        },
#        install_sub => {
#            schema  => 'bool',
#            default => 1,
#        },
#    },
#    result => {
#        schema => ['hash*' => {
#            keys => {
#                code => ['code*'],
#                meta => ['hash*'], 
#            },
#        }],
#    },
#};
#sub gen_modified_sub {
#    require Function::Fallback::CoreOrPP;
#
#    my %args = @_;
#
#    my ($base_code, $base_meta);
#    if ($args{base_name}) {
#        my ($pkg, $leaf);
#        if ($args{base_name} =~ /(.+)::(.+)/) {
#            ($pkg, $leaf) = ($1, $2);
#        } else {
#            $pkg  = CORE::caller();
#            $leaf = $args{base_name};
#        }
#        no strict 'refs';
#        $base_code = \&{"$pkg\::$leaf"};
#        $base_meta = ${"$pkg\::SPEC"}{$leaf};
#        die "Can't find Rinci metadata for $pkg\::$leaf" unless $base_meta;
#    } elsif ($args{base_meta}) {
#        $base_meta = $args{base_meta};
#        $base_code = $args{base_code}
#            or die "Please specify base_code";
#    } else {
#        die "Please specify base_name or base_code+base_meta";
#    }
#
#    my $output_meta = Function::Fallback::CoreOrPP::clone($base_meta);
#    my $output_code = $args{output_code} // $base_code;
#
#    for (qw/summary description/) {
#        $output_meta->{$_} = $args{$_} if $args{$_};
#    }
#    if ($args{remove_args}) {
#        delete $output_meta->{args}{$_} for @{ $args{remove_args} };
#    }
#    if ($args{add_args}) {
#        for my $k (keys %{ $args{add_args} }) {
#            my $v = $args{add_args}{$k};
#            die "Can't add arg '$k' in mod sub: already exists"
#                if $output_meta->{args}{$k};
#            $output_meta->{args}{$k} = $v;
#        }
#    }
#    if ($args{replace_args}) {
#        for my $k (keys %{ $args{replace_args} }) {
#            my $v = $args{replace_args}{$k};
#            die "Can't replace arg '$k' in mod sub: doesn't exist"
#                unless $output_meta->{args}{$k};
#            $output_meta->{args}{$k} = $v;
#        }
#    }
#    if ($args{rename_args}) {
#        for my $old (keys %{ $args{rename_args} }) {
#            my $new = $args{rename_args}{$old};
#            my $as = $output_meta->{args}{$old};
#            die "Can't rename arg '$old' in mod sub: doesn't exist" unless $as;
#            die "Can't rename arg '$old'->'$new' in mod sub: ".
#                "new name already exist" if $output_meta->{args}{$new};
#            $output_meta->{args}{$new} = $as;
#            delete $output_meta->{args}{$old};
#        }
#    }
#    if ($args{modify_args}) {
#        for (keys %{ $args{modify_args} }) {
#            $args{modify_args}{$_}->($output_meta->{args}{$_});
#        }
#    }
#    if ($args{modify_meta}) {
#        $args{modify_meta}->($output_meta);
#    }
#
#    if ($args{output_name}) {
#        my ($pkg, $leaf);
#        if ($args{output_name} =~ /(.+)::(.+)/) {
#            ($pkg, $leaf) = ($1, $2);
#        } else {
#            $pkg  = CORE::caller();
#            $leaf = $args{output_name};
#        }
#        no strict 'refs';
#        no warnings 'redefine';
#        *{"$pkg\::$leaf"}       = $output_code if $args{install_sub} // 1;
#        ${"$pkg\::SPEC"}{$leaf} = $output_meta;
#    }
#
#    [200, "OK", {code=>$output_code, meta=>$output_meta}];
#}
#
#$SPEC{gen_curried_sub} = {
#    v => 1.1,
#    summary => 'Generate curried subroutine (and its metadata)',
#    description => <<'_',
#
#This is a more convenient helper than `gen_modified_sub` if you want to create a
#new subroutine that has some of its arguments preset (so they no longer need to
#be present in the new metadata).
#
#For more general needs of modifying a subroutine (e.g. add some arguments,
#modify some arguments, etc) use `gen_modified_sub`.
#
#_
#    args => {
#        base_name => {
#            summary => 'Subroutine name (either qualified or not)',
#            schema => 'str*',
#            description => <<'_',
#
#If not qualified with package name, will be searched in the caller's package.
#Rinci metadata will be searched in `%SPEC` package variable.
#
#_
#            req => 1,
#            pos => 0,
#        },
#        set_args => {
#            summary => 'Arguments to set',
#            schema  => 'hash*',
#        },
#        output_name => {
#            summary => 'Where to install the modified sub',
#            schema  => 'str*',
#            description => <<'_',
#
#Subroutine will be put in the specified name. If the name is not qualified with
#package name, will use caller's package.
#
#_
#            req => 1,
#            pos => 2,
#        },
#    },
#    args_as => 'array',
#    result_naked => 1,
#};
#sub gen_curried_sub {
#    my ($base_name, $set_args, $output_name) = @_;
#
#    my $caller = CORE::caller();
#
#    my ($base_pkg, $base_leaf);
#    if ($base_name =~ /(.+)::(.+)/) {
#        ($base_pkg, $base_leaf) = ($1, $2);
#    } else {
#        $base_pkg  = $caller;
#        $base_leaf = $base_name;
#    }
#
#    my ($output_pkg, $output_leaf);
#    if ($output_name =~ /(.+)::(.+)/) {
#        ($output_pkg, $output_leaf) = ($1, $2);
#    } else {
#        $output_pkg  = $caller;
#        $output_leaf = $output_name;
#    }
#
#    my $base_sub = \&{"$base_pkg\::$base_leaf"};
#
#    my $res = gen_modified_sub(
#        base_name   => "$base_pkg\::$base_leaf",
#        output_name => "$output_pkg\::$output_leaf",
#        output_code => sub {
#            no strict 'refs';
#            $base_sub->(@_, %$set_args);
#        },
#        remove_args => [keys %$set_args],
#        install => 1,
#    );
#
#    die "Can't generate curried sub: $res->[0] - $res->[1]"
#        unless $res->[0] == 200;
#
#    1;
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Util/Args.pm ###
#package Perinci::Sub::Util::Args;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#use 5.010001;
#use strict 'subs', 'vars';
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
#                       args_by_tag
#                       argnames_by_tag
#                       func_args_by_tag
#                       func_argnames_by_tag
#                       call_with_its_args
#);
#
#sub args_by_tag {
#    my ($meta, $args, $tag) = @_;
#
#    my @res;
#    my $args_prop = $meta->{args} or return ();
#    my $neg = $tag =~ s/\A!//;
#    for my $argname (keys %$args_prop) {
#        my $argspec = $args_prop->{$argname};
#        if ($neg) {
#            next unless !$argspec->{tags} ||
#                !(grep {$_ eq $tag} @{$argspec->{tags}});
#        } else {
#            next unless $argspec->{tags} &&
#                grep {$_ eq $tag} @{$argspec->{tags}};
#        }
#        push @res, $argname, $args->{$argname}
#            if exists $args->{$argname};
#    }
#    @res;
#}
#
#sub argnames_by_tag {
#    my ($meta, $tag) = @_;
#
#    my @res;
#    my $args_prop = $meta->{args} or return ();
#    my $neg = 1 if $tag =~ s/\A!//;
#    for my $argname (keys %$args_prop) {
#        my $argspec = $args_prop->{$argname};
#        if ($neg) {
#            next unless !$argspec->{tags} ||
#                !(grep {$_ eq $tag} @{$argspec->{tags}});
#        } else {
#            next unless $argspec->{tags} &&
#                grep {$_ eq $tag} @{$argspec->{tags}};
#        }
#        push @res, $argname;
#    }
#    sort @res;
#}
#
#sub _find_meta {
#    my $caller = shift;
#    my $func_name = shift;
#
#    if ($func_name =~ /(.+)::(.+)/) {
#        return ${"$1::SPEC"}{$2};
#    } else {
#        return ${"$caller->[0]::SPEC"}{$func_name};
#    }
#}
#
#sub func_args_by_tag {
#    my ($func_name, $args, $tag) = @_;
#    my $meta = _find_meta([caller(1)], $func_name)
#        or die "Can't find Rinci function metadata for $func_name";
#    args_by_tag($meta, $args, $tag);
#}
#
#sub func_argnames_by_tag {
#    my ($func_name, $tag) = @_;
#    my $meta = _find_meta([caller(1)], $func_name)
#        or die "Can't find Rinci function metadata for $func_name";
#    argnames_by_tag($meta, $tag);
#}
#
#sub call_with_its_args {
#    my ($func_name, $args) = @_;
#
#    my ($meta, $func);
#    if ($func_name =~ /(.+)::(.+)/) {
#        defined &{$func_name}
#            or die "Function $func_name not defined";
#        $func = \&{$func_name};
#        $meta = ${"$1::SPEC"}{$2};
#    } else {
#        my @caller = caller(1);
#        my $fullname = "$caller[0]::$func_name";
#        defined &{$fullname}
#            or die "Function $fullname not defined";
#        $func = \&{$fullname};
#        $meta = ${"$caller[0]::SPEC"}{$func_name};
#    }
#    $meta or die "Can't find Rinci function metadata for $func_name";
#
#    my @args;
#    if ($meta->{args}) {
#        for my $argname (keys %{ $meta->{args} }) {
#            push @args, $argname, $args->{$argname}
#                if exists $args->{$argname};
#        }
#    }
#    $func->(@args);
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Util/ResObj.pm ###
#package Perinci::Sub::Util::ResObj;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#use Carp;
#use overload
#    q("") => sub {
#        my $res = shift; "ERROR $err->[0]: $err->[1]\n" . Carp::longmess();
#    };
#
#1;
#
#__END__
#
### Perinci/Sub/Util/Sort.pm ###
#package Perinci::Sub::Util::Sort;
#
#our $DATE = '2017-01-31'; 
#our $VERSION = '0.46'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       sort_args
#               );
#
#our %SPEC;
#
#sub sort_args {
#    my $args = shift;
#    sort {
#        (($args->{$a}{pos} // 9999) <=> ($args->{$b}{pos} // 9999)) ||
#            $a cmp $b
#        } keys %$args;
#}
#
#1;
#
#__END__
#
### 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__
#
### Progress/Any.pm ###
#package Progress::Any;
#
#our $DATE = '2015-01-27'; 
#our $VERSION = '0.20'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Time::Duration qw();
#use Time::HiRes qw(time);
#
#sub import {
#    my ($self, @args) = @_;
#    my $caller = caller();
#    for (@args) {
#        if ($_ eq '$progress') {
#            my $progress = $self->get_indicator(task => '');
#            {
#                no strict 'refs';
#                my $v = "$caller\::progress";
#                *$v = \$progress;
#            }
#        } else {
#            die "Unknown import argument: $_";
#        }
#    }
#}
#
#our %indicators;  
#
#our %outputs;     
#
#our %output_data; 
#
#
#sub _init_indicator {
#    my ($class, $task) = @_;
#
#
#    return $indicators{$task} if $indicators{$task};
#
#    my $progress = bless({
#        task        => $task,
#        title       => $task,
#        target      => 0,
#        pos         => 0,
#        state       => 'stopped',
#
#        _remaining          => undef,
#        _set_remaining_time => undef,
#        _elapsed            => 0,
#        _start_time         => 0,
#    }, $class);
#    $indicators{$task} = $progress;
#
#    if ($task =~ s/\.?\w+\z//) {
#        $class->_init_indicator($task);
#    }
#
#    $progress;
#}
#
#sub get_indicator {
#    my ($class, %args) = @_;
#
#    my %oargs = %args;
#
#    my $task   = delete($args{task});
#    if (!defined($task)) {
#        my @caller = caller(0);
#        $task = $caller[0] eq '(eval)' ? 'main' : $caller[0];
#        $task =~ s/::/./g;
#        $task =~ s/[^.\w]+/_/g;
#    }
#    die "Invalid task syntax '$task', please only use dotted words"
#        unless $task =~ /\A(?:\w+(\.\w+)*)?\z/;
#
#    my %uargs;
#
#    my $p = $class->_init_indicator($task);
#    for my $an (qw/title target pos remaining state/) {
#        if (exists $args{$an}) {
#            $uargs{$an} = delete($args{$an});
#        }
#    }
#    die "Unknown argument(s) to get_indicator(): ".join(", ", keys(%args))
#        if keys(%args);
#    $p->_update(%uargs) if keys %uargs;
#
#    $p;
#}
#
#my %attrs = (
#    title     => {is => 'rw'},
#    target    => {is => 'rw'},
#    pos       => {is => 'rw'},
#    state     => {is => 'rw'},
#);
#
#for my $an (keys %attrs) {
#    next if $attrs{$an}{manual};
#    my $code;
#    if ($attrs{$an}{is} eq 'rw') {
#        $code = sub {
#            my $self = shift;
#            if (@_) {
#                $self->_update($an => shift);
#            }
#            $self->{$an};
#        };
#    } else {
#        $code = sub {
#            my $self = shift;
#            die "Can't set value, $an is an ro attribute" if @_;
#            $self->{$an};
#        };
#    }
#    no strict 'refs';
#    *{$an} = $code;
#}
#
#sub elapsed {
#    my $self = shift;
#
#    if ($self->{state} eq 'started') {
#        return $self->{_elapsed} + (time()-$self->{_start_time});
#    } else {
#        return $self->{_elapsed};
#    }
#}
#
#sub total_pos {
#    my $self = shift;
#
#    my $t = $self->{task};
#
#    my $res = $self->{pos};
#    for (keys %indicators) {
#        if ($t eq '') {
#            next if $_ eq '';
#        } else {
#            next unless index($_, "$t.") == 0;
#        }
#        $res += $indicators{$_}{pos};
#    }
#    $res;
#}
#
#sub total_target {
#    my $self = shift;
#
#    my $t = $self->{task};
#
#    my $res = $self->{target};
#    return undef unless defined($res);
#
#    for (keys %indicators) {
#        if ($t eq '') {
#            next if $_ eq '';
#        } else {
#            next unless index($_, "$t.") == 0;
#        }
#        return undef unless defined $indicators{$_}{target};
#        $res += $indicators{$_}{target};
#    }
#    $res;
#}
#
#sub percent_complete {
#    my $self = shift;
#
#    my $total_pos    = $self->total_pos;
#    my $total_target = $self->total_target;
#
#    return undef unless defined($total_target);
#    if ($total_target == 0) {
#        if ($self->{state} eq 'finished') {
#            return 100;
#        } else {
#            return 0;
#        }
#    } else {
#        return $total_pos / $total_target * 100;
#    }
#}
#
#sub remaining {
#    my $self = shift;
#
#    if (defined $self->{_remaining}) {
#        if ($self->{state} eq 'started') {
#            my $r = $self->{_remaining}-(time()-$self->{_set_remaining_time});
#            return $r > 0 ? $r : 0;
#        } else {
#            return $self->{_remaining};
#        }
#    } else {
#        if (defined $self->{target}) {
#            if ($self->{pos} == 0) {
#                return 0;
#            } else {
#                return ($self->{target} - $self->{pos})/$self->{pos} *
#                    $self->elapsed;
#            }
#        } else {
#            return undef;
#        }
#    }
#}
#
#sub total_remaining {
#    my $self = shift;
#
#    my $t = $self->{task};
#
#    my $res = $self->remaining;
#    return undef unless defined $res;
#
#    for (keys %indicators) {
#        if ($t eq '') {
#            next if $_ eq '';
#        } else {
#            next unless index($_, "$t.") == 0;
#        }
#        my $res2 = $indicators{$_}->remaining;
#        return undef unless defined $res2;
#        $res += $res2;
#    }
#    $res;
#}
#
#sub _update {
#    my ($self, %args) = @_;
#
#
#    my $now = time();
#
#    my $task = $self->{task};
#
#  SET_TITLE:
#    {
#        last unless exists $args{title};
#        my $val = $args{title};
#        die "Invalid value for title, must be defined"
#            unless defined($val);
#        $self->{title} = $val;
#    }
#
#  SET_TARGET:
#    {
#        last unless exists $args{target};
#        my $val = $args{target};
#        die "Invalid value for target, must be a positive number or undef"
#            unless !defined($val) || $val >= 0;
#        if (defined($val) && $self->{pos} > $val) {
#            $self->{pos} = $val;
#        }
#        $self->{target} = $val;
#        undef $self->{_remaining};
#    }
#
#  SET_POS:
#    {
#        last unless exists $args{pos};
#        my $val = $args{pos};
#        die "Invalid value for pos, must be a positive number"
#            unless defined($val) && $val >= 0;
#        if (defined($self->{target}) && $val > $self->{target}) {
#            $val = $self->{target};
#        }
#        $self->{pos} = $val;
#        undef $self->{_remaining};
#    }
#
#  SET_REMAINING:
#    {
#        last unless exists $args{remaining};
#        my $val = $args{remaining};
#        die "Invalid value for remaining, must be a positive number"
#            unless defined($val) && $val >= 0;
#        $self->{_remaining} = $val;
#        $self->{_set_remaining_time} = $now;
#    }
#
#  SET_STATE:
#    {
#        last unless exists $args{state};
#        my $old = $self->{state};
#        my $val = $args{state} // 'started';
#        die "Invalid value for state, must be stopped/started/finished"
#            unless $val =~ /\A(?:stopped|started|finished)\z/;
#        last if $old eq $val;
#        if ($val eq 'started') {
#            $self->{_start_time} = $now;
#
#            my @parents;
#            {
#                my $t = $task;
#                while (1) {
#                    last unless $t =~ s/\.\w+\z//;
#                    push @parents, $t;
#                }
#                push @parents, '';
#            }
#            for my $t (@parents) {
#                my $p = $indicators{$t};
#                if ($p->{state} ne 'started') {
#                    $p->{state}       = 'started';
#                    $p->{_start_time} = $now;
#                }
#            }
#        } else {
#            $self->{_elapsed} += $now - $self->{_start_time};
#            if ($val eq 'finished') {
#                die "BUG: Can't finish task '$task', pos is still < target"
#                    if defined($self->{target}) &&
#                        $self->{pos} < $self->{target};
#                $self->{_remaining} = 0;
#                $self->{_set_remaining_time} = $now;
#            }
#        }
#        $self->{state} = $val;
#    }
#
#  DONE:
#    return;
#}
#
#sub _should_update_output {
#    my ($self, $output, $now) = @_;
#
#    my $key = "$output";
#    $output_data{$key} //= {};
#    my $odata = $output_data{$key};
#    if (!defined($odata->{mtime})) {
#        return 1;
#    } elsif ($self->{state} eq 'finished') {
#        return 1;
#    } elsif ($odata->{force_update}) {
#        delete $odata->{force_update};
#        return 1;
#    } else {
#        if (!defined($odata->{freq})) {
#            $odata->{freq} = -0.5;
#        }
#        if ($odata->{freq} < 0) {
#            return 1 if $now >= $odata->{mtime} - $odata->{freq};
#        } else {
#            return 1 if abs($self->{pos} - $odata->{pos}) >= $odata->{freq};
#        }
#        return 0;
#    }
#}
#
#sub update {
#    my ($self, %args) = @_;
#
#    my $pos   = delete($args{pos}) // $self->{pos} + 1;
#    my $state = delete($args{state}) // 'started';
#    $self->_update(pos => $pos, state => $state);
#
#    my $message  = delete($args{message});
#    my $level    = delete($args{level});
#    die "Unknown argument(s) to update(): ".join(", ", keys(%args))
#        if keys(%args);
#
#    my $now = time();
#
#    {
#        my $task = $self->{task};
#        while (1) {
#            if ($outputs{$task}) {
#                for my $output (@{ $outputs{$task} }) {
#                    next unless $self->_should_update_output($output, $now);
#                    if (ref($message) eq 'CODE') {
#                        $message = $message->();
#                    }
#                    $output->update(
#                        indicator => $indicators{$task},
#                        message   => $message,
#                        level     => $level,
#                        time      => $now,
#                    );
#                    my $key = "$output";
#                    $output_data{$key}{mtime} = $now;
#                    $output_data{$key}{pos}   = $pos;
#                }
#            }
#            last unless $task =~ s/\.?\w+\z//;
#        }
#    }
#}
#
#sub start {
#    my $self = shift;
#    $self->_update(state => 'started');
#}
#
#sub stop {
#    my $self = shift;
#    $self->_update(state => 'stopped');
#}
#
#sub finish {
#    my ($self, %args) = @_;
#    $self->update(pos=>$self->{target}, state=>'finished', %args);
#}
#
#sub fill_template {
#    my ($self, $template, %args) = @_;
#
#
#    state $re = qr{( # all=1
#                       %
#                       ( #width=2
#                           -?\d+ )?
#                       ( #dot=3
#                           \.?)
#                       ( #prec=4
#                           \d+)?
#                       ( #conv=5
#                           [emnPpRrTt%])
#                   )}x;
#
#    state $sub = sub {
#        my %args = @_;
#
#        my ($all, $width, $dot, $prec, $conv) = ($1, $2, $3, $4, $5);
#
#        my $p = $args{indicator};
#
#        my ($fmt, $sconv, $data);
#        if ($conv eq 'n') {
#            $data = $p->{task};
#        } elsif ($conv eq 't') {
#            $data = $p->{title};
#        } elsif ($conv eq '%') {
#            $data = '%';
#        } elsif ($conv eq 'm') {
#            $data = $args{message} // '';
#        } elsif ($conv eq 'p') {
#            my $val = $p->percent_complete;
#            $width //= 3;
#            if (defined $val) {
#                $data = $val;
#                $prec //= 0;
#                $sconv = "f";
#            } else {
#                $data = '?';
#            }
#        } elsif ($conv eq 'P') {
#            $data = $p->total_pos;
#            $prec //= 0;
#            $sconv = "f";
#        } elsif ($conv eq 'T') {
#            my $val = $p->total_target;
#            if (defined $val) {
#                $data = $val;
#                $prec //= 0;
#                $sconv = "f";
#            } else {
#                $data = '?';
#            }
#        } elsif ($conv eq 'e') {
#            my $val = $p->elapsed;
#            $val = 1 if $val < 1; 
#            $data = Time::Duration::concise(Time::Duration::duration($val));
#            $width //= -8;
#        } elsif ($conv eq 'r') {
#            my $val = $p->total_remaining;
#            if (defined $val) {
#                $val = 1 if $val < 1; 
#                $data = Time::Duration::concise(Time::Duration::duration($val));
#            } else {
#                $data = '?';
#            }
#            $width //= -8;
#        } elsif ($conv eq 'R') {
#            my $val = $p->total_remaining;
#            if (defined $val) {
#                $val = 1 if $val < 1; 
#                $data = Time::Duration::concise(Time::Duration::duration($val)).
#                    " left"; 
#            } else {
#                $val = $p->elapsed;
#                $val = 1 if $val < 1; 
#                $data = Time::Duration::concise(Time::Duration::duration($val)).
#                    " elapsed"; 
#            }
#            $width //= -(8 + 1 + 7);
#        } else {
#            $fmt = '%s';
#            $data = $all;
#        }
#
#        $sconv //= 's';
#        $dot = "." if $sconv eq 'f';
#        $fmt //= join("", grep {defined} ("%", $width, $dot, $prec, $sconv));
#
#        sprintf $fmt, $data;
#
#    };
#    $template =~ s{$re}{$sub->(%args, indicator=>$self)}egox;
#
#    $template;
#}
#
#1;
#
#__END__
#
### Progress/Any/Output.pm ###
#package Progress::Any::Output;
#
#our $DATE = '2015-01-27'; 
#our $VERSION = '0.20'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Progress::Any;
#
#sub import {
#    my $self = shift;
#    __PACKAGE__->set(@_) if @_;
#}
#
#sub _set_or_add {
#    my $class = shift;
#    my $which = shift;
#
#    my $opts;
#    if (@_ && ref($_[0]) eq 'HASH') {
#        $opts = shift;
#    } else {
#        $opts = {};
#    }
#
#    my $output = shift or die "Please specify output name";
#    $output =~ /\A(?:\w+(::\w+)*)?\z/ or die "Invalid output syntax '$output'";
#
#    my $task = $opts->{task} // "";
#
#    my $outputo;
#    unless (ref $outputo) {
#        my $outputpm = $output; $outputpm =~ s!::!/!g; $outputpm .= ".pm";
#        require "Progress/Any/Output/$outputpm";
#        no strict 'refs';
#        $outputo = "Progress::Any::Output::$output"->new(@_);
#    }
#
#    if ($which eq 'set') {
#        $Progress::Any::outputs{$task} = [$outputo];
#    } else {
#        $Progress::Any::outputs{$task} //= [];
#        push @{ $Progress::Any::outputs{$task} }, $outputo;
#    }
#
#    $outputo;
#}
#
#sub set {
#    my $class = shift;
#    $class->_set_or_add('set', @_);
#}
#
#sub add {
#    my $class = shift;
#    $class->_set_or_add('add', @_);
#}
#
#1;
#
#__END__
#
### Progress/Any/Output/Null.pm ###
#package Progress::Any::Output::Null;
#
#use 5.010;
#use strict;
#use warnings;
#
#our $VERSION = '0.20'; 
#
#sub new {
#    my ($class, %args) = @_;
#    bless \%args, $class;
#}
#
#sub update {
#    1;
#}
#
#1;
#
#__END__
#
### Progress/Any/Output/TermProgressBarColor.pm ###
#package Progress::Any::Output::TermProgressBarColor;
#
#our $DATE = '2017-06-21'; 
#our $VERSION = '0.23'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Color::ANSI::Util qw(ansifg ansibg);
#require Win32::Console::ANSI if $^O =~ /Win/;
#
#$|++;
#
#my ($ph1, $ph2);
#
#sub _patch {
#    my $out = shift;
#
#    return if $ph1;
#    require Monkey::Patch::Action;
#    if (defined &{"Log::Any::Adapter::Screen::hook_before_log"}) {
#        $ph1 = Monkey::Patch::Action::patch_package(
#            'Log::Any::Adapter::Screen', 'hook_before_log', 'replace',
#            sub {
#                $out->cleanup;
#                $Progress::Any::output_data{"$out"}{force_update} = 1;
#            }
#        );
#    } elsif (defined  &{"Log::ger::Output::Screen::hook_before_log"}) {
#        $ph1 = Monkey::Patch::Action::patch_package(
#            'Log::ger::Output::Screen', 'hook_before_log', 'replace',
#            sub {
#                $out->cleanup;
#                $Progress::Any::output_data{"$out"}{force_update} = 1;
#            }
#        );
#    }
#
#    if (defined &{"Log::Any::Adapter::Screen::hook_after_log"}) {
#        $ph2 = Monkey::Patch::Action::patch_package(
#            'Log::Any::Adapter::Screen', 'hook_after_log', 'replace',
#            sub {
#                my ($self, $msg) = @_;
#                print { $self->{_fh} } "\n" unless $msg =~ /\R\z/;
#                $out->keep_delay_showing if $out->{show_delay};
#            }
#        );
#    } elsif (defined &{"Log::ger::Output::Screen::hook_after_log"}) {
#        $ph2 = Monkey::Patch::Action::patch_package(
#            'Log::ger::Output::Screen', 'hook_after_log', 'replace',
#            sub {
#                my ($ctx, $msg) = @_;
#                print { $ctx->{_fh} } "\n" unless $msg =~ /\R\z/;
#                $out->keep_delay_showing if $out->{show_delay};
#            }
#        );
#    }
#}
#
#sub _unpatch {
#    undef $ph1;
#    undef $ph2;
#}
#
#sub new {
#    my ($class, %args0) = @_;
#
#    my %args;
#
#    $args{width} = delete($args0{width});
#    if (!defined($args{width})) {
#        my ($cols, $rows);
#        if ($ENV{COLUMNS}) {
#            $cols = $ENV{COLUMNS};
#        } elsif (eval { require Term::Size; 1 }) {
#            ($cols, $rows) = Term::Size::chars();
#        } else {
#            $cols = 80;
#        }
#        $args{width} = $^O =~ /Win/ ? $cols-1 : $cols;
#    }
#
#    $args{fh} = delete($args0{fh});
#    $args{fh} //= \*STDOUT;
#
#    $args{show_delay} = delete($args0{show_delay});
#
#    $args{wide} = delete($args0{wide});
#
#    keys(%args0) and die "Unknown output parameter(s): ".
#        join(", ", keys(%args0));
#
#    $args{_last_hide_time} = time();
#
#    require Text::ANSI::Util;
#    if ($args{wide}) {
#        require Text::ANSI::WideUtil;
#    }
#
#    my $self = bless \%args, $class;
#    $self->_patch;
#    $self;
#}
#
#sub update {
#    my ($self, %args) = @_;
#
#    my $now = time();
#
#    if (defined $self->{show_delay}) {
#        return if $now - $self->{show_delay} < $self->{_last_hide_time};
#    }
#
#    my $ll = $self->{_lastlen};
#    if (defined $self->{_lastlen}) {
#        print { $self->{fh} } "\b" x $self->{_lastlen};
#        undef $self->{_lastlen};
#    }
#
#    my $p = $args{indicator};
#    my $tottgt = $p->total_target;
#    my $totpos = $p->total_pos;
#    my $is_complete = $p->{state} eq 'finished' ||
#        defined($tottgt) && $tottgt > 0 && $totpos == $tottgt;
#    if ($is_complete) {
#        if ($ll) {
#            my $fh = $self->{fh};
#            print $fh " " x $ll, "\b" x $ll;
#            $self->{_last_hide_time} = $now;
#        }
#        return;
#    }
#
#    my $bar;
#    my $bar_pct = $p->fill_template("%p%% ", %args);
#
#    my $bar_eta = $p->fill_template("%R", %args);
#
#    my $bar_bar = "";
#    my $bwidth = $self->{width} - length($bar_pct) - length($bar_eta) - 2;
#    if ($bwidth > 0) {
#        if ($tottgt) {
#            my $bfilled = int($totpos / $tottgt * $bwidth);
#            $bfilled = $bwidth if $bfilled > $bwidth;
#            $bar_bar = ("=" x $bfilled) . (" " x ($bwidth-$bfilled));
#
#            my $message = $args{message};
#        } else {
#            my $bfilled = int(0.15 * $bwidth);
#            $bfilled = 1 if $bfilled < 1;
#            $self->{_x}++;
#            if ($self->{_x} > $bwidth-$bfilled) {
#                $self->{_x} = 0;
#            }
#            $bar_bar = (" " x $self->{_x}) . ("=" x $bfilled) .
#                (" " x ($bwidth-$self->{_x}-$bfilled));
#        }
#
#        my $msg = $args{message};
#        if (defined $msg) {
#            if ($msg =~ m!</elspan!) {
#                require String::Elide::Parts;
#                $msg = String::Elide::Parts::elide($msg, $bwidth);
#            }
#            my $mwidth;
#            if ($self->{wide}) {
#                $msg = Text::ANSI::WideUtil::ta_mbtrunc($msg, $bwidth);
#                $mwidth = Text::ANSI::WideUtil::ta_mbswidth($msg);
#            } else {
#                $msg = Text::ANSI::Util::ta_trunc($msg, $bwidth);
#                $mwidth = Text::ANSI::Util::ta_length($msg);
#            }
#            $bar_bar = ansifg("808080") . $msg . ansifg("ff8000") .
#                substr($bar_bar, $mwidth);
#        }
#
#        $bar_bar = ansifg("ff8000") . $bar_bar;
#    }
#
#    $bar = join(
#        "",
#        ansifg("ffff00"), $bar_pct,
#        "[$bar_bar]",
#        ansifg("ffff00"), $bar_eta,
#        "\e[0m",
#    );
#    print { $self->{fh} } $bar;
#
#    $self->{_lastlen} = Text::ANSI::Util::ta_length($bar);
#}
#
#sub cleanup {
#    my ($self) = @_;
#
#
#    my $ll = $self->{_lastlen};
#    return unless $ll;
#    print { $self->{fh} } "\b" x $ll, " " x $ll, "\b" x $ll;
#}
#
#sub keep_delay_showing {
#    my $self = shift;
#
#    $self->{_last_hide_time} = time();
#}
#
#sub DESTROY {
#    my $self = shift;
#    $self->_unpatch;
#}
#
#1;
#
#__END__
#
### Regexp/Stringify.pm ###
#package Regexp::Stringify;
#
#our $DATE = '2016-10-29'; 
#our $VERSION = '0.06'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use re qw(regexp_pattern);
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(stringify_regexp);
#
#our %SPEC;
#
#$SPEC{stringify_regexp} = {
#    v => 1.1,
#    summary => 'Stringify a Regexp object',
#    description => <<'_',
#
#This routine is an alternative to Perl's default stringification of Regexp
#object (i.e.:`"$re"`) and has some features/options, e.g.: producing regexp
#string that is compatible with certain perl versions.
#
#If given a string (or other non-Regexp object), will return it as-is.
#
#_
#    args => {
#        regexp => {
#            schema => 're*',
#            req => 1,
#            pos => 0,
#        },
#        plver => {
#            summary => 'Target perl version',
#            schema => 'str*',
#            description => <<'_',
#
#Try to produce a regexp object compatible with a certain perl version (should at
#least be >= 5.10).
#
#For example, in perl 5.14 regex stringification changes, e.g. `qr/hlagh/i` would
#previously be stringified as `(?i-xsm:hlagh)`, but now it's stringified as
#`(?^i:hlagh)`. If you set `plver` to 5.10 or 5.12, then this routine will
#still produce the former. It will also ignore regexp modifiers that are
#introduced in newer perls.
#
#Note that not all regexp objects are translatable to older perls, e.g. if they
#contain constructs not known to older perls like `(?^...)` before perl 5.14.
#
#_
#        },
#        with_qr => {
#            schema  => 'bool',
#            description => <<'_',
#
#If you set this to 1, then `qr/a/i` will be stringified as `'qr/a/i'` instead as
#`'(?^i:a)'`. The resulting string can then be eval-ed to recreate the Regexp
#object.
#
#_
#        },
#    },
#    result_naked => 1,
#    result => {
#        schema => 'str*',
#    },
#};
#sub stringify_regexp {
#    my %args = @_;
#
#    my $re = $args{regexp};
#    return $re unless ref($re) eq 'Regexp';
#    my $plver = $args{plver} // $^V;
#
#    my ($pat, $mod) = regexp_pattern($re);
#
#    my $ge_5140 = version->parse($plver) >= version->parse('5.14.0');
#    unless ($ge_5140) {
#        $mod =~ s/[adlu]//g;
#    }
#
#    if ($args{with_qr}) {
#        return "qr($pat)$mod";
#    } else {
#        if ($ge_5140) {
#            return "(^$mod:$pat)";
#        } else {
#            return "(?:(?$mod-)$pat)";
#        }
#    }
#}
#
#1;
#
#__END__
#
### Role/Tiny.pm ###
#package Role::Tiny;
#
#sub _getglob { \*{$_[0]} }
#sub _getstash { \%{"$_[0]::"} }
#
#use strict;
#use warnings;
#
#our $VERSION = '2.000003';
#$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 croak {
#  require Carp;
#  no warnings 'redefine';
#  *croak = \&Carp::croak;
#  goto &Carp::croak;
#}
#
#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;
#  $me->_install_subs($target);
#  return if $me->is_role($target); 
#  $INFO{$target}{is_role} = 1;
#  my $stash = _getstash($target);
#  my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
#  @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
#  $APPLIED_TO{$target} = { $target => undef };
#  foreach my $hook (@ON_ROLE_CREATE) {
#    $hook->($target);
#  }
#}
#
#sub _install_subs {
#  my ($me, $target) = @_;
#  return if $me->is_role($target);
#  foreach my $type (qw(before after around)) {
#    *{_getglob "${target}::${type}"} = sub {
#      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;
#  };
#}
#
#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);
#
#  croak "This is apply_role_to_package" if ref($to);
#  croak "${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) = @_;
#  croak "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) = @_;
#
#  croak "No roles supplied!" unless @roles;
#
#  _load_module($superclass);
#  {
#    my %seen;
#    if (my @dupes = grep 1 == $seen{$_}++, @roles) {
#      croak "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);
#    croak "${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;
#    croak $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;
#    croak $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 {
#      croak "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) = @_;
#  croak "${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};
#  my $info = $INFO{$to};
#  my $existing = ($info ? $info->{modifiers} : $COMPOSED{modifiers}{$to}) ||= [];
#  my @modifiers = grep {
#    my $modifier = $_;
#    !grep $_ == $modifier, @$existing;
#  } @{$modifiers||[]};
#  push @$existing, @modifiers;
#
#  if (!$info) {
#    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 {
#      require Class::Method::Modifiers;
#      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} || $INFO{$role}{not_methods}));
#}
#
#1;
#__END__
#
### Role/Tiny/With.pm ###
#package Role::Tiny::With;
#
#use strict;
#use warnings;
#
#our $VERSION = '2.000003';
#$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-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Normalize ();
#use Sah::Schema::rinci::meta ();
#
#our $schema = [hash => {
#    summary => 'Rinci function metadata',
#
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        entity_v => {},
#        entity_date => {},
#        links => {},
#
#        is_func => {},
#        is_meth => {},
#        is_class_meth => {},
#        args => {
#            _value_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                links => {},
#
#                schema => {},
#                filters => {},
#                default => {},
#                req => {},
#                pos => {},
#                greedy => {},
#                partial => {},
#                stream => {},
#                is_password => {},
#                cmdline_aliases => {
#                    _value_prop => {
#                        summary => {},
#                        description => {},
#                        schema => {},
#                        code => {},
#                        is_flag => {},
#                    },
#                },
#                cmdline_on_getopt => {},
#                cmdline_prompt => {},
#                completion => {},
#                index_completion => {},
#                element_completion => {},
#                cmdline_src => {},
#                meta => 'fix',
#                element_meta => 'fix',
#                deps => {
#                    _keys => {
#                        arg => {},
#                        all => {},
#                        any => {},
#                        none => {},
#                    },
#                },
#            },
#        },
#        args_as => {},
#        args_rels => {},
#        result => {
#            _prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                schema => {},
#                statuses => {
#                    _value_prop => {
#                        summary => {},
#                        description => {},
#                        schema => {},
#                    },
#                },
#                partial => {},
#                stream => {},
#            },
#        },
#        result_naked => {},
#        examples => {
#            _elem_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                args => {},
#                argv => {},
#                src => {},
#                src_plang => {},
#                status => {},
#                result => {},
#                test => {},
#            },
#        },
#        features => {
#            _keys => {
#                reverse => {},
#                tx => {},
#                dry_run => {},
#                pure => {},
#                immutable => {},
#                idempotent => {},
#                check_arg => {},
#            },
#        },
#        deps => {
#            _keys => {
#                all => {},
#                any => {},
#                none => {},
#                env => {},
#                prog => {},
#                pkg => {},
#                func => {},
#                code => {},
#                tmp_dir => {},
#                trash_dir => {},
#            },
#        },
#    },
#}, {}];
#
#$schema->[1]{_prop}{args}{_value_prop}{meta} = $schema->[1];
#$schema->[1]{_prop}{args}{_value_prop}{element_meta} = $schema->[1];
#
#
#$schema = Data::Sah::Normalize::normalize_schema($schema);
#
#1;
#
#__END__
#
### Sah/Schema/rinci/meta.pm ###
#package Sah::Schema::rinci::meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#our %_dh_props = (
#    v => {},
#    defhash_v => {},
#    name => {},
#    caption => {},
#    summary => {},
#    description => {},
#    tags => {},
#    default_lang => {},
#    x => {},
#);
#
#our $schema = [hash => {
#    summary => 'Rinci metadata',
#    _ver => 1.1, 
#    _prop => {
#        %_dh_props,
#
#        entity_v => {},
#        entity_date => {},
#        links => {
#            _elem_prop => {
#                %_dh_props,
#
#                url => {},
#            },
#        },
#    },
#}, {}];
#
#1;
#
#__END__
#
### Sah/Schema/rinci/result_meta.pm ###
#package Sah::Schema::rinci::result_meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Sah::Schema::rinci::meta;
#
#our $schema = [hash => {
#    summary => 'Rinci envelope result metadata',
#
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        perm_err => {},
#        func => {}, 
#        cmdline => {}, 
#        logs => {},
#        prev => {},
#        results => {},
#        part_start => {},
#        part_len => {},
#        len => {},
#        stream => {},
#    },
#}, {}];
#
#1;
#
#__END__
#
### Sah/SchemaR/rinci/function_meta.pm ###
#package Sah::SchemaR::rinci::function_meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#our $rschema = do {
#  my $a = [
#    "hash",
#    [
#      {
#        _prop   => {
#                     args => {
#                       _value_prop => {
#                         caption => {},
#                         cmdline_aliases => {
#                           _value_prop => { code => {}, description => {}, is_flag => {}, schema => {}, summary => {} },
#                         },
#                         cmdline_on_getopt => {},
#                         cmdline_prompt => {},
#                         cmdline_src => {},
#                         completion => {},
#                         default => {},
#                         default_lang => {},
#                         defhash_v => {},
#                         deps => { _keys => { all => {}, any => {}, arg => {}, none => {} } },
#                         description => {},
#                         element_completion => {},
#                         element_meta => { _prop => 'fix', _ver => 1.1, summary => "Rinci function metadata" },
#                         filters => {},
#                         greedy => {},
#                         index_completion => {},
#                         is_password => {},
#                         links => {},
#                         meta => 'fix',
#                         name => {},
#                         partial => {},
#                         pos => {},
#                         req => {},
#                         schema => {},
#                         stream => {},
#                         summary => {},
#                         tags => {},
#                         v => {},
#                         x => {},
#                       },
#                     },
#                     args_as => {},
#                     args_rels => {},
#                     caption => 'fix',
#                     default_lang => 'fix',
#                     defhash_v => 'fix',
#                     deps => {
#                       _keys => {
#                         all       => {},
#                         any       => {},
#                         code      => {},
#                         env       => {},
#                         func      => {},
#                         none      => {},
#                         pkg       => {},
#                         prog      => {},
#                         tmp_dir   => {},
#                         trash_dir => {},
#                       },
#                     },
#                     description => 'fix',
#                     entity_date => {},
#                     entity_v => {},
#                     examples => {
#                       _elem_prop => {
#                         args => {},
#                         argv => {},
#                         caption => 'fix',
#                         default_lang => 'fix',
#                         defhash_v => 'fix',
#                         description => 'fix',
#                         name => 'fix',
#                         result => {},
#                         src => {},
#                         src_plang => {},
#                         status => {},
#                         summary => 'fix',
#                         tags => 'fix',
#                         test => {},
#                         v => 'fix',
#                         x => 'fix',
#                       },
#                     },
#                     features => {
#                       _keys => {
#                         check_arg => {},
#                         dry_run => {},
#                         idempotent => {},
#                         immutable => {},
#                         pure => {},
#                         reverse => {},
#                         tx => {},
#                       },
#                     },
#                     is_class_meth => {},
#                     is_func => {},
#                     is_meth => {},
#                     links => {},
#                     name => 'fix',
#                     result => {
#                       _prop => {
#                         caption => 'fix',
#                         default_lang => 'fix',
#                         defhash_v => 'fix',
#                         description => 'fix',
#                         name => 'fix',
#                         partial => {},
#                         schema => {},
#                         statuses => {
#                           _value_prop => { description => {}, schema => {}, summary => {} },
#                         },
#                         stream => {},
#                         summary => 'fix',
#                         tags => 'fix',
#                         v => 'fix',
#                         x => 'fix',
#                       },
#                     },
#                     result_naked => {},
#                     summary => 'fix',
#                     tags => 'fix',
#                     v => 'fix',
#                     x => 'fix',
#                   },
#        _ver    => 1.1,
#        summary => "Rinci function metadata",
#      },
#    ],
#    ["hash"],
#  ];
#  $a->[1][0]{_prop}{args}{_value_prop}{element_meta}{_prop} = $a->[1][0]{_prop};
#  $a->[1][0]{_prop}{args}{_value_prop}{meta} = $a->[1][0]{_prop}{args}{_value_prop}{element_meta};
#  $a->[1][0]{_prop}{caption} = $a->[1][0]{_prop}{args}{_value_prop}{caption};
#  $a->[1][0]{_prop}{default_lang} = $a->[1][0]{_prop}{args}{_value_prop}{default_lang};
#  $a->[1][0]{_prop}{defhash_v} = $a->[1][0]{_prop}{args}{_value_prop}{defhash_v};
#  $a->[1][0]{_prop}{description} = $a->[1][0]{_prop}{args}{_value_prop}{description};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{caption} = $a->[1][0]{_prop}{args}{_value_prop}{caption};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{default_lang} = $a->[1][0]{_prop}{args}{_value_prop}{default_lang};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{defhash_v} = $a->[1][0]{_prop}{args}{_value_prop}{defhash_v};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{description} = $a->[1][0]{_prop}{args}{_value_prop}{description};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{name} = $a->[1][0]{_prop}{args}{_value_prop}{name};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{summary} = $a->[1][0]{_prop}{args}{_value_prop}{summary};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{tags} = $a->[1][0]{_prop}{args}{_value_prop}{tags};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{v} = $a->[1][0]{_prop}{args}{_value_prop}{v};
#  $a->[1][0]{_prop}{examples}{_elem_prop}{x} = $a->[1][0]{_prop}{args}{_value_prop}{x};
#  $a->[1][0]{_prop}{name} = $a->[1][0]{_prop}{args}{_value_prop}{name};
#  $a->[1][0]{_prop}{result}{_prop}{caption} = $a->[1][0]{_prop}{args}{_value_prop}{caption};
#  $a->[1][0]{_prop}{result}{_prop}{default_lang} = $a->[1][0]{_prop}{args}{_value_prop}{default_lang};
#  $a->[1][0]{_prop}{result}{_prop}{defhash_v} = $a->[1][0]{_prop}{args}{_value_prop}{defhash_v};
#  $a->[1][0]{_prop}{result}{_prop}{description} = $a->[1][0]{_prop}{args}{_value_prop}{description};
#  $a->[1][0]{_prop}{result}{_prop}{name} = $a->[1][0]{_prop}{args}{_value_prop}{name};
#  $a->[1][0]{_prop}{result}{_prop}{summary} = $a->[1][0]{_prop}{args}{_value_prop}{summary};
#  $a->[1][0]{_prop}{result}{_prop}{tags} = $a->[1][0]{_prop}{args}{_value_prop}{tags};
#  $a->[1][0]{_prop}{result}{_prop}{v} = $a->[1][0]{_prop}{args}{_value_prop}{v};
#  $a->[1][0]{_prop}{result}{_prop}{x} = $a->[1][0]{_prop}{args}{_value_prop}{x};
#  $a->[1][0]{_prop}{summary} = $a->[1][0]{_prop}{args}{_value_prop}{summary};
#  $a->[1][0]{_prop}{tags} = $a->[1][0]{_prop}{args}{_value_prop}{tags};
#  $a->[1][0]{_prop}{v} = $a->[1][0]{_prop}{args}{_value_prop}{v};
#  $a->[1][0]{_prop}{x} = $a->[1][0]{_prop}{args}{_value_prop}{x};
#  $a;
#};
#
#1;
#
#__END__
#
### Sah/SchemaR/rinci/meta.pm ###
#package Sah::SchemaR::rinci::meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#our $rschema = do {
#  my $a = [
#    "hash",
#    [
#      {
#        _prop   => {
#                     caption => {},
#                     default_lang => {},
#                     defhash_v => {},
#                     description => {},
#                     entity_date => {},
#                     entity_v => {},
#                     links => {
#                       _elem_prop => {
#                         caption => 'fix',
#                         default_lang => 'fix',
#                         defhash_v => 'fix',
#                         description => 'fix',
#                         name => {},
#                         summary => {},
#                         tags => {},
#                         url => {},
#                         v => {},
#                         x => {},
#                       },
#                     },
#                     name => 'fix',
#                     summary => 'fix',
#                     tags => 'fix',
#                     v => 'fix',
#                     x => 'fix',
#                   },
#        _ver    => 1.1,
#        summary => "Rinci metadata",
#      },
#    ],
#    ["hash"],
#  ];
#  $a->[1][0]{_prop}{links}{_elem_prop}{caption} = $a->[1][0]{_prop}{caption};
#  $a->[1][0]{_prop}{links}{_elem_prop}{default_lang} = $a->[1][0]{_prop}{default_lang};
#  $a->[1][0]{_prop}{links}{_elem_prop}{defhash_v} = $a->[1][0]{_prop}{defhash_v};
#  $a->[1][0]{_prop}{links}{_elem_prop}{description} = $a->[1][0]{_prop}{description};
#  $a->[1][0]{_prop}{name} = $a->[1][0]{_prop}{links}{_elem_prop}{name};
#  $a->[1][0]{_prop}{summary} = $a->[1][0]{_prop}{links}{_elem_prop}{summary};
#  $a->[1][0]{_prop}{tags} = $a->[1][0]{_prop}{links}{_elem_prop}{tags};
#  $a->[1][0]{_prop}{v} = $a->[1][0]{_prop}{links}{_elem_prop}{v};
#  $a->[1][0]{_prop}{x} = $a->[1][0]{_prop}{links}{_elem_prop}{x};
#  $a;
#};
#
#1;
#
#__END__
#
### Sah/SchemaR/rinci/result_meta.pm ###
#package Sah::SchemaR::rinci::result_meta;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#our $rschema = [
#  "hash",
#  [
#    {
#      _prop   => {
#                   caption => {},
#                   cmdline => {},
#                   default_lang => {},
#                   defhash_v => {},
#                   description => {},
#                   func => {},
#                   len => {},
#                   logs => {},
#                   name => {},
#                   part_len => {},
#                   part_start => {},
#                   perm_err => {},
#                   prev => {},
#                   results => {},
#                   stream => {},
#                   summary => {},
#                   tags => {},
#                   v => {},
#                   x => {},
#                 },
#      _ver    => 1.1,
#      summary => "Rinci envelope result metadata",
#    },
#  ],
#  ["hash"],
#];
#
#1;
#
#__END__
#
### Sah/Schemas/Rinci.pm ###
#package Sah::Schemas::Rinci;
#
#our $DATE = '2016-12-26'; 
#our $VERSION = '1.1.82.2'; 
#
#1;
#
#__END__
#
### 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/Elide/Parts.pm ###
#package String::Elide::Parts;
#
#our $DATE = '2017-01-29'; 
#our $VERSION = '0.07'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(elide);
#
#sub _elide_part {
#    my ($str, $len, $marker, $truncate) = @_;
#
#    my $len_marker = length($marker);
#    if ($len <= $len_marker) {
#        return substr($marker, 0, $len);
#    }
#
#    if ($truncate eq 'left') {
#        return $marker . substr($str, length($str) - $len+$len_marker);
#    } elsif ($truncate eq 'middle') {
#        my $left  = substr($str, 0,
#                           ($len-$len_marker)/2);
#        my $right = substr($str,
#                           length($str) - ($len-$len_marker-length($left)));
#        return $left . $marker . $right;
#    } elsif ($truncate eq 'ends') {
#        if ($len <= 2*$len_marker) {
#            return substr($marker . $marker, 0, $len);
#        }
#        return $marker . substr($str, (length($str)-$len)/2 + $len_marker,
#                                $len-2*$len_marker) . $marker;
#    } else { 
#        return substr($str, 0, $len-$len_marker) . $marker;
#    }
#}
#
#sub elide {
#    my ($str, $len, $opts) = @_;
#
#    $opts //= {};
#    my $truncate  = $opts->{truncate} // 'right';
#    my $marker = $opts->{marker} // '..';
#    my $default_prio = $opts->{default_prio} // 1;
#
#    my @parts;
#    my @parts_attrs;
#    while ($str =~ m#<elspan([^>]*)>(.*?)</elspan>|(.*?)(?=<elspan)|(.*)#gs) {
#        if (defined $1) {
#            next unless length $2;
#            push @parts, $2;
#            push @parts_attrs, $1;
#        } elsif (defined $3) {
#            next unless length $3;
#            push @parts, $3;
#            push @parts_attrs, undef;
#        } elsif (defined $4) {
#            next unless length $4;
#            push @parts, $4;
#            push @parts_attrs, undef;
#        }
#    }
#    return "" unless @parts && $len > 0;
#    for my $i (0..@parts-1) {
#        if (defined $parts_attrs[$i]) {
#            my $attrs = {};
#            $attrs->{truncate} = $1 // $2
#                if $parts_attrs[$i] =~ /\btruncate=(?:"([^"]*)"|(\S+))/;
#            $attrs->{marker} = $1 // $2
#                if $parts_attrs[$i] =~ /\bmarker=(?:"([^"]*)"|(\S+))/;
#            $attrs->{prio} = $1 // $2
#                if $parts_attrs[$i] =~ /\bprio(?:rity)?=(?:"([^"]*)"|(\S+))/;
#            $parts_attrs[$i] = $attrs;
#        } else {
#            $parts_attrs[$i] = {prio=>$default_prio};
#        }
#    }
#
#
#  PRIO:
#    while (1) {
#        my $all_parts_len = 0;
#        $all_parts_len += length($_) for @parts;
#
#        if ($all_parts_len <= $len) {
#            return join("", @parts);
#        }
#
#        my $highest_prio;
#        for (@parts_attrs) {
#            $highest_prio = $_->{prio} if !defined($highest_prio) ||
#                $highest_prio < $_->{prio};
#        }
#        my @high_indexes;
#        my $high_parts_len = 0;
#        for my $i (0..$#parts_attrs) {
#            if ($parts_attrs[$i]{prio} == $highest_prio) {
#                $high_parts_len += length $parts[$i];
#                push @high_indexes, $i;
#            }
#        }
#
#        if ($all_parts_len - $high_parts_len >= $len) {
#            for (reverse @high_indexes) {
#                splice @parts, $_, 1;
#                splice @parts_attrs, $_, 1;
#                next PRIO;
#            }
#        }
#
#
#        my @must_elide_total_len_after_this;
#        my $tot_to_elide = $all_parts_len - $len;
#        for my $i (0..$#high_indexes) {
#            $must_elide_total_len_after_this[$i] =
#                int( ($i+1)/@high_indexes * $tot_to_elide );
#        }
#
#        my $tot_already_elided = 0;
#        my $tot_still_to_elide = 0;
#        for my $i (reverse 0..$#high_indexes) {
#            my $idx = $high_indexes[$i];
#            my $part_len = length $parts[$idx];
#            my $to_elide = $must_elide_total_len_after_this[$#high_indexes - $i] -
#                $tot_already_elided;
#            if ($to_elide <= 0) {
#            } elsif ($part_len <= $to_elide) {
#                splice @parts, $idx, 1;
#                splice @parts_attrs, $idx, 1;
#                $tot_already_elided += $part_len;
#                $tot_still_to_elide += ($to_elide - $part_len);
#            } else {
#                $parts[$idx] = _elide_part(
#                    $parts[$idx],
#                    $part_len - $to_elide,
#                    $parts_attrs[$idx]{marker} // $marker,
#                    $parts_attrs[$idx]{truncate} // $truncate,
#                );
#                $tot_already_elided += $to_elide;
#                $tot_still_to_elide = 0;
#            }
#        }
#
#    } 
#}
#
#1;
#
#__END__
#
### String/LineNumber.pm ###
#package String::LineNumber;
#
#our $DATE = '2014-12-10'; 
#our $VERSION = '0.01'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       linenum
#               );
#
#sub linenum {
#    my ($str, $opts) = @_;
#    $opts //= {};
#    $opts->{width}      //= 4;
#    $opts->{zeropad}    //= 0;
#    $opts->{skip_empty} //= 1;
#
#    my $i = 0;
#    $str =~ s/^(([\t ]*\S)?.*)/
#        sprintf(join("",
#                     "%",
#                     ($opts->{zeropad} && !($opts->{skip_empty}
#                                                && !defined($2)) ? "0" : ""),
#                     $opts->{width}, "s",
#                     "|%s"),
#                ++$i && $opts->{skip_empty} && !defined($2) ? "" : $i,
#                $1)/meg;
#
#    $str;
#}
#
#1;
#
#__END__
#
### String/PerlQuote.pm ###
#package String::PerlQuote;
#
#our $DATE = '2016-10-07'; 
#our $VERSION = '0.02'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       single_quote
#                       double_quote
#               );
#
#my %esc = (
#    "\a" => "\\a",
#    "\b" => "\\b",
#    "\t" => "\\t",
#    "\n" => "\\n",
#    "\f" => "\\f",
#    "\r" => "\\r",
#    "\e" => "\\e",
#);
#
#sub double_quote {
#  local($_) = $_[0];
#  s/([\\\"\@\$])/\\$1/g;
#  return qq("$_") unless /[^\040-\176]/;  
#
#  s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
#  s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
#  s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
#  s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
#  return qq("$_");
#}
#
#sub single_quote {
#  local($_) = $_[0];
#  s/([\\'])/\\$1/g;
#  return qq('$_');
#}
#1;
#
#__END__
#
### String/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__
#
### Sub/Delete.pm ###
#use 5.008003;
#
#package Sub::Delete;
#
#$VERSION = '1.00002';
#@EXPORT = delete_sub;
#
#use Exporter 5.57 'import';
#use constant point0 => 0+$] eq 5.01;
#
#sub strict_eval($) {
# local %^H if point0;
# local *@;
# use
#  strict 'vars';
# local $SIG{__WARN__} = sub {};
# eval shift
#}
#
#my %sigils = qw( SCALAR $  ARRAY @  HASH % );
#
#sub delete_sub {
#	my $sub = shift;
#	my($stashname, $key) = $sub =~ /(.*::)((?:(?!::).)*)\z/s
#		? ($1,$2) : (caller()."::", $sub);
#	exists +(my $stash = \%$stashname)->{$key} or return;
#	ref $stash->{$key} eq 'SCALAR' and  
#		delete $stash->{$key}, return;
#	my $globname = "$stashname$key"; 
#	my $glob = *$globname; 
#	defined *$glob{CODE} or return;  
#	my $check_importedness
#	 = $stashname =~ /^(?:(?!\d)\w*(?:::\w*)*)\z/
#	   && $key    =~ /^(?!\d)\w+\z/;
#	my %imported_slots;
#	my $package;
#	if($check_importedness) {
#		$package = substr $stashname, 0, -2;
#		for (qw "SCALAR ARRAY HASH") {
#			defined *$glob{$_} or next;
#			$imported_slots{$_} = strict_eval
#			  "package $package; 0 && $sigils{$_}$key; 1"
#		}
#	}
#        delete $stash->{$key};
#	keys %imported_slots == 1 and exists $imported_slots{SCALAR}
#	 and !$imported_slots{SCALAR} and Internals'SvREFCNT $$glob =>== 1
#	 and !defined *$glob{IO} and !defined *$glob{FORMAT}
#	 and return; 
#	my $newglob = \*$globname;
#	local *alias = *$newglob;
#	defined *$glob{$_} and (
#	 !$check_importedness || $imported_slots{$_}
#	  ? *$newglob
#	  : *alias
#	) = *$glob{$_}
#		for qw "SCALAR ARRAY HASH";
#	defined *$glob{$_} and *$newglob = *$glob{$_}
#		for qw "IO FORMAT";
#	return 
#}
#
#1;
#
#__END__
#
### Test/Config/IOD/Common.pm ###
#package Test::Config::IOD::Common;
#
#our $DATE = '2017-01-16'; 
#our $VERSION = '0.32'; 
#
#use 5.010;
#use strict;
#use warnings;
#
#use Test::More 0.98;
#
#our $CLASS = "Config::IOD::Reader";
#
#sub test_common_iod {
#
#    eval "require $CLASS"; die if $@;
#
#    subtest "opt: default_section" => sub {
#        test_read_iod(
#            args  => {default_section=>'bawaan'},
#            input => <<'_',
#a=1
#_
#            result => {bawaan=>{a=>1}},
#        );
#    };
#
#    subtest "opt: allow_directives" => sub {
#        test_read_iod(
#            args  => {allow_directives=>['merge']},
#            input => <<'_',
#;!noop
#_
#            dies  => 1,
#        );
#        test_read_iod(
#            args  => {allow_directives=>['noop']},
#            input => <<'_',
#;!noop
#_
#            result => {},
#        );
#    };
#
#    subtest "opt: disallow_directives" => sub {
#        test_read_iod(
#            args  => {disallow_directives=>['noop']},
#            input => <<'_',
#;!noop
#_
#            dies  => 1,
#        );
#        test_read_iod(
#            args  => {disallow_directives=>['merge']},
#            input => <<'_',
#;!noop
#_
#            result => {},
#        );
#    };
#
#    subtest "opt: allow_directives + disallow_directives" => sub {
#        test_read_iod(
#            args  => {
#                allow_directives    => ['noop'],
#                disallow_directives => ['noop'],
#            },
#            input => <<'_',
#;!noop
#_
#            dies  => 1,
#        );
#    };
#
#    subtest "opt: enable_quoting=0" => sub {
#        test_read_iod(
#            args  => {enable_quoting=>0},
#            input => <<'_',
#name="1\n2"
#_
#            result => {GLOBAL=>{name=>'"1\\n2"'}},
#        );
#    };
#
#    subtest "opt: enable_bracket=0" => sub {
#        test_read_iod(
#            args  => {enable_bracket=>0},
#            input => <<'_',
#name=[1,2,3]
#_
#            result => {GLOBAL=>{name=>'[1,2,3]'}},
#        );
#    };
#
#    subtest "opt: enable_brace=0" => sub {
#        test_read_iod(
#            args  => {enable_brace=>0},
#            input => <<'_',
#name={"a":1}
#_
#            result => {GLOBAL=>{name=>'{"a":1}'}},
#        );
#    };
#
#    subtest "opt: enable_encoding=0" => sub {
#        test_read_iod(
#            args  => {enable_encoding=>0},
#            input => <<'_',
#name=!hex 5e5e
#_
#            result => {GLOBAL=>{name=>'!hex 5e5e'}},
#        );
#    };
#
#    subtest "opt: allow_encodings" => sub {
#        test_read_iod(
#            args  => {allow_encodings=>['hex']},
#            input => <<'_',
#name=!json "1\n2"
#_
#            dies => 1,
#        );
#        test_read_iod(
#            args  => {allow_encodings=>['json']},
#            input => <<'_',
#name=!json "1\n2"
#name2=!j "3\n4"
#_
#            result => {GLOBAL=>{name=>"1\n2", name2=>"3\n4"}},
#        );
#    };
#
#    subtest "opt: disallow_encodings" => sub {
#        test_read_iod(
#            args  => {disallow_encodings=>['json']},
#            input => <<'_',
#name=!json "1\n2"
#_
#            dies => 1,
#        );
#        test_read_iod(
#            args  => {disallow_encodings=>['json']},
#            input => <<'_',
#name=!j "1\n2"
#_
#            dies => 1,
#        );
#        test_read_iod(
#            args  => {disallow_encodings=>['hex']},
#            input => <<'_',
#name=!json "1\n2"
#_
#            result => {GLOBAL=>{name=>"1\n2"}},
#        );
#    };
#
#    subtest "opt: allow_encodings + disallow_encodings" => sub {
#        test_read_iod(
#            args  => {
#                allow_encodings   =>['json'],
#                disallow_encodings=>['json'],
#            },
#            input => <<'_',
#name=!json "1\n2"
#_
#            dies => 1,
#        );
#    };
#
#    subtest "opt: allow_bang_only=0" => sub {
#        test_read_iod(
#            args  => {allow_bang_only=>0},
#            input => <<'_',
#a=1
#!noop
#_
#            dies => 1,
#        );
#    };
#
#    subtest "opt: allow_duplicate_key=0" => sub {
#        test_read_iod(
#            args  => {allow_duplicate_key=>0},
#            input => <<'_',
#a=1
#a=2
#_
#            dies => 1,
#        );
#    };
#
#    subtest "opt: ignore_unknown_directive=1" => sub {
#        test_read_iod(
#            args  => {ignore_unknown_directive=>1},
#            input => <<'_',
#;!foo bar
#_
#            result => {},
#        );
#    };
#
#    subtest "expr" => sub {
#        test_read_iod(
#            name  => "must be enabled first",
#            args  => {},
#            input => <<'_',
#a=!e 1+1
#_
#            dies => 1,
#        );
#        test_read_iod(
#            name  => "must be valid",
#            args  => {enable_expr=>1},
#            input => <<'_',
#a=!e 1+
#_
#            dies => 1,
#        );
#        test_read_iod(
#            args  => {enable_expr=>1},
#            input => <<'_',
#a=!e 1+1
#[sect]
#b=!e val("GLOBAL.a")*3
#c=!e val("b") x 3
#_
#            result => {GLOBAL=>{a=>2}, sect=>{b=>6, c=>666}},
#        );
#    };
#}
#
#sub test_read_iod {
#    my %args = @_;
#
#    my $parser_args = $args{args};
#    my $test_name = $args{name} //
#        "{". join(", ",
#                  (map {"$_=$parser_args->{$_}"}
#                       sort keys %$parser_args),
#              ) . "}";
#    subtest $test_name => sub {
#
#        my $parser = $CLASS->new(%$parser_args);
#
#        my $res;
#        eval {
#            if ($CLASS eq 'Config::IOD') {
#                $res = $parser->read_string($args{input})->dump;
#            } else {
#                $res = $parser->read_string($args{input});
#            }
#        };
#        my $err = $@;
#        if ($args{dies}) {
#            ok($err, "dies") or diag explain $res;
#            return;
#        } else {
#            ok(!$err, "doesn't die")
#                or do { diag explain "err=$err"; return };
#            is_deeply($res, $args{result}, 'result')
#                or diag explain $res;
#        }
#    };
#}
#
#1;
#
#__END__
#
### Test/Data/Sah.pm ###
#package Test::Data::Sah;
#
#our $DATE = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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 = '2017-07-10'; 
#our $VERSION = '0.88'; 
#
#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/ANSI/BaseUtil.pm ###
#package Text::ANSI::BaseUtil;
#
#our $DATE = '2016-03-11'; 
#our $VERSION = '0.22'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use List::Util qw(min max);
#
#our $re       = qr/\e\[[0-9;]+m/s;
#our $re_mult  = qr/(?:\e\[[0-9;]+m)+/s;
#
#sub ta_detect {
#    my $text = shift;
#    $text =~ $re ? 1:0;
#}
#
#sub ta_length {
#    my $text = shift;
#    length(ta_strip($text));
#}
#
#sub _ta_length_height {
#    my ($is_mb, $text) = @_;
#    my $num_lines = 0;
#    my @lens;
#    for my $e (split /(\r?\n)/, ta_strip($text)) {
#        if ($e =~ /\n/) {
#            $num_lines++;
#            next;
#        }
#        $num_lines = 1 if $num_lines == 0;
#        push @lens, $is_mb ? Text::WideChar::Util::mbswidth($e) : length($e);
#    }
#    [max(@lens) // 0, $num_lines];
#}
#
#sub ta_length_height {
#    _ta_length_height(0, @_);
#}
#
#sub ta_mbswidth_height {
#    _ta_length_height(1, @_);
#}
#
#sub ta_strip {
#    my $text = shift;
#    $text =~ s/$re//go;
#    $text;
#}
#
#sub ta_extract_codes {
#    my $text = shift;
#    my $res = "";
#    $res .= $1 while $text =~ /($re_mult)/go;
#    $res;
#}
#
#sub ta_split_codes {
#    my $text = shift;
#    return split(/($re_mult)/o, $text);
#}
#
#sub ta_split_codes_single {
#    my $text = shift;
#    return split(/($re)/o, $text);
#}
#
#sub _ta_mbswidth0 {
#    my $text = shift;
#    Text::WideChar::Util::mbswidth(ta_strip($text));
#}
#
#sub ta_mbswidth {
#    my $text = shift;
#    ta_mbswidth_height($text)->[0];
#}
#
#sub _ta_wrap {
#    my ($is_mb, $text, $width, $opts) = @_;
#    $width //= 80;
#    $opts  //= {};
#
#
#    my $_re1 = $is_mb ?
#        qr/($Text::WideChar::Util::re_cjk+)|(\S+)|(\s+)/ :
#        qr/()(\S+)|(\s+)/;
#
#    my $_re2 = $is_mb ?
#        qr/($Text::WideChar::Util::re_cjk_class+)|
#           ($Text::WideChar::Util::re_cjk_negclass+)/x : undef;
#
#    my @termst; 
#    my @terms;  
#    my @pterms; 
#    my @termsw; 
#    my @termsc; 
#    {
#        my @ch = ta_split_codes_single($text);
#        my $crcode = ""; 
#        my $term      = '';
#        my $pterm     = '';
#        my $prev_type = '';
#        while (my ($pt, $c) = splice(@ch, 0, 2)) {
#
#
#            my @s; 
#            while ($pt =~ /$_re1/g) {
#                if ($is_mb && $1) {
#                    push @s, $1, 'c';
#                } elsif ($3) {
#                    push @s, $3, 's';
#                } else {
#                    if ($is_mb) {
#                        my $pt2 = $2;
#                        while ($pt2 =~ /$_re2/g) {
#                            if ($1) {
#                                push @s, $1, 'c';
#                            } else {
#                                push @s, $2, 'w';
#                            }
#                        }
#                    } else {
#                        push @s, $2, 'w';
#                    }
#                }
#            }
#
#
#            my $only_code = 1 if !@s;
#            while (1) {
#                my ($s, $s_type) = splice @s, 0, 2;
#                $s_type //= '';
#                last unless $only_code || defined($s);
#                if ($only_code) {
#                    $s = "";
#                    $term .= $c if defined $c;
#                }
#
#                if ($s_type && $s_type ne 's') {
#                    if ($prev_type eq 's') {
#                        push @termst, 's';
#                        push @terms , $term;
#                        push @pterms, $pterm;
#                        push @termsw, undef;
#                        push @termsc, $crcode;
#                        $pterm = ''; $term = '';
#                    } elsif ($prev_type && $prev_type ne $s_type) {
#                        push @termst, $prev_type;
#                        push @terms , $term;
#                        push @pterms, $pterm;
#                        push @termsw, $is_mb ? Text::WideChar::Util::mbswidth($pterm):length($pterm);
#                        push @termsc, $crcode;
#                        $pterm = ''; $term = '';
#                    }
#                    $pterm .= $s;
#                    $term  .= $s; $term .= $c if defined($c) && !@s;
#                    if (!@s && !@ch) {
#                        push @termst, $s_type;
#                        push @terms , $term;
#                        push @pterms, "";
#                        push @termsw, $is_mb ? Text::WideChar::Util::mbswidth($pterm):length($pterm);
#                        push @termsc, $crcode;
#                    }
#                } elsif (length($s)) {
#                    if ($prev_type ne 's') {
#                        push @termst, $prev_type;
#                        push @terms , $term;
#                        push @pterms, "";
#                        push @termsw, $is_mb ? Text::WideChar::Util::mbswidth($pterm):length($pterm);
#                        push @termsc, $crcode;
#                        $pterm = ''; $term = '';
#                    }
#                    $pterm .= $s;
#                    $term  .= $c if defined($c) && !@s;
#                    if (!@s && !@ch) {
#                        push @termst, 's';
#                        push @terms , $term;
#                        push @pterms, $pterm;
#                        push @termsw, undef;
#                        push @termsc, $crcode;
#                    }
#                }
#                $prev_type = $s_type;
#
#                if (!@s) {
#                    if (defined($c) && $c =~ /m\z/) {
#                        if ($c eq "\e[0m") {
#                            $crcode = "";
#                        } elsif ($c =~ /m\z/) {
#                            $crcode .= $c;
#                        }
#                    }
#                    last if $only_code;
#                }
#
#            } 
#        } 
#    }
#
#    {
#        my $i = 0;
#        while ($i < @pterms) {
#            if ($termst[$i] eq 's') {
#                if ($pterms[$i] =~ /[ \t]*(\n(?:[ \t]*\n)+)([ \t]*)/) {
#                    $pterms[$i] = $1;
#                    $termst[$i] = 'p';
#                    if ($i < @pterms-1) {
#                        $terms [$i+1] = $terms[$i] . $terms [$i+1];
#                        $terms [$i] = "";
#                    }
#                    if (length $2) {
#                        splice @termst, $i+1, 0, "s";
#                        splice @terms , $i+1, 0, "";
#                        splice @pterms, $i+1, 0, $2;
#                        splice @termsw, $i+1, 0, undef;
#                        splice @termsc, $i+1, 0, $termsc[$i];
#                        $i += 2;
#                        next;
#                    }
#                }
#            }
#            $i++;
#        }
#    }
#
#
#
#    my ($maxww, $minww);
#
#
#    my @res;
#    {
#        my $tw = $opts->{tab_width} // 8;
#        die "Please specify a positive tab width" unless $tw > 0;
#        my $optfli  = $opts->{flindent};
#        my $optfliw = Text::WideChar::Util::_get_indent_width($is_mb, $optfli, $tw) if defined $optfli;
#        my $optsli  = $opts->{slindent};
#        my $optsliw = Text::WideChar::Util::_get_indent_width($is_mb, $optsli, $tw) if defined $optsli;
#        my $pad = $opts->{pad};
#        my $x = 0;
#        my $y = 0;
#        my ($fli, $sli, $fliw, $sliw);
#        my $is_parastart = 1;
#        my $line_has_word = 0;
#        my ($termt, $prev_t);
#      TERM:
#        for my $i (0..$#terms) {
#            $prev_t = $termt if $i;
#            $termt = $termst[$i];
#            my $term  = $terms[$i];
#            my $pterm = $pterms[$i];
#            my $termw = $termsw[$i];
#            my $crcode = $i > 0 ? $termsc[$i-1] : "";
#
#            if ($termt eq 'p') {
#                my $numnl = 0;
#                $numnl++ while $pterm =~ /\n/g;
#                for (1..$numnl) {
#                    push @res, "\e[0m" if $crcode && $_ == 1;
#                    push @res, " " x ($width-$x) if $pad;
#                    push @res, "\n";
#                    $x = 0;
#                    $y++;
#                }
#                $line_has_word = 0;
#                $x = 0;
#                $is_parastart = 1;
#                next TERM;
#            }
#
#            if ($is_parastart) {
#                if (defined $optfli) {
#                    $fli  = $optfli;
#                    $fliw = $optfliw;
#                } else {
#                    if ($termt eq 's') {
#                        $fli  = $pterm;
#                        $fliw = Text::WideChar::Util::_get_indent_width($is_mb, $fli, $tw);
#                    } else {
#                        $fli  = "";
#                        $fliw = 0;
#                    }
#                    my $j = $i;
#                    $sli = undef;
#                    while ($j < @terms && $termst[$j] ne 'p') {
#                        if ($termst[$j] eq 's') {
#                            if ($pterms[$j] =~ /\n([ \t]+)/) {
#                                $sli  = $1;
#                                $sliw = Text::WideChar::Util::_get_indent_width($is_mb, $sli, $tw);
#                                last;
#                            }
#                        }
#                        $j++;
#                    }
#                    if (!defined($sli)) {
#                        $sli  = "";
#                        $sliw = 0;
#                    }
#                    die "Subsequent indent must be less than width" if $sliw >= $width;
#                }
#
#                push @res, $fli;
#                $x += $fliw;
#            } 
#
#            $is_parastart = 0;
#
#            if ($termt eq 's') {
#                push @res, $term;
#
#                if ($pterm =~ /\n/ && $i == $#terms) {
#                    push @res, "\e[0m" if $crcode;
#                    push @res, " " x ($width-$x) if $pad;
#                    push @res, "\n";
#                    $line_has_word = 0;
#                }
#            }
#
#            if ($termt ne 's') {
#                my @words;
#                my @wordsw;
#                my @wordst; 
#                my @wordswsb; 
#                my $j = 0;
#                my $c = ""; 
#                while (1) {
#                    $j++;
#                    if ($termw <= $width-$sliw || $termt eq 'c') {
#                        push @words   , $c . $term;
#                        push @wordsw  , $termw;
#                        push @wordst  , $termt;
#                        push @wordswsb, ($prev_t && $prev_t eq 's')?1:0;
#                        last;
#                    }
#                    my $res = $is_mb ? ta_mbtrunc($term, $width-$sliw, 1) :
#                        ta_trunc($term, $width-$sliw, 1);
#
#                    my ($tword, $twordw);
#                    if ($j == 1) {
#                        $tword  = $res->[0];
#                        $twordw = $res->[1];
#                    } else {
#                        $tword  = ($crcode ? "\e[0m" . $crcode : "") .
#                            $c . $res->[0];
#                        $twordw = $res->[1];
#                    }
#                    $c .= ta_extract_codes(substr($term, 0, $res->[2]));
#
#                    push @words   , $tword;
#                    push @wordsw  , $twordw;
#                    push @wordst  , $termt;
#                    push @wordswsb, $j == 1 ? (($prev_t && $prev_t eq 's')?1:0) : 0;
#                    $term  = substr($term, $res->[2]);
#                    $termw = $is_mb ? _ta_mbswidth0($term) : ta_length($term);
#                }
#
#
#                for my $word (@words) {
#                    my $wordw = shift @wordsw;
#                    my $wordt = shift @wordst;
#                    my $ws_before = shift @wordswsb;
#
#                    $maxww = $wordw if !defined($maxww) || $maxww < $wordw;
#                    $minww = $wordw if !defined($minww) || $minww > $wordw;
#
#                    if ($x + ($line_has_word ? 1:0) + $wordw <= $width) {
#                        if ($line_has_word && $ws_before) {
#                            push @res, " ";
#                            $x++;
#                        }
#                        push @res, $word;
#                        $x += $wordw;
#                    } else {
#                        while (1) {
#                            if ($wordt eq 'c') {
#                                my $res;
#                                if ($ws_before) {
#                                    $res = ta_mbtrunc($word, $width-$x-1, 1);
#                                    push @res, " ", $res->[0];
#                                } else {
#                                    $res = ta_mbtrunc($word, $width-$x, 1);
#                                    push @res, $res->[0];
#                                }
#                                $word = $res->[3];
#                                $wordw = _ta_mbswidth0($res->[3]);
#                            } else {
#                                push @res, "\e[0m" if $crcode;
#                            }
#                            push @res, " " x ($width-$x) if $pad;
#                            push @res, "\n";
#                            $y++;
#                            push @res, $crcode;
#                            push @res, $sli;
#
#                            if ($sliw + $wordw <= $width) {
#                                push @res, $word;
#                                $x = $sliw + $wordw;
#                                last;
#                            } else {
#                                $x = $sliw;
#                            }
#                        }
#                    }
#                    $line_has_word++;
#                }
#
#            }
#        } 
#        push @res, " " x ($width-$x) if $line_has_word && $pad;
#    }
#
#    if ($opts->{return_stats}) {
#        return [join("", @res), {
#            max_word_width => $maxww,
#            min_word_width => $minww,
#        }];
#    } else {
#        return join("", @res);
#    }
#}
#
#sub ta_wrap {
#    _ta_wrap(0, @_);
#}
#
#sub ta_mbwrap {
#    _ta_wrap(1, @_);
#}
#
#sub _ta_pad {
#    my ($is_mb, $text, $width, $which, $padchar, $is_trunc) = @_;
#    if ($which) {
#        $which = substr($which, 0, 1);
#    } else {
#        $which = "r";
#    }
#    $padchar //= " ";
#
#    my $w = $is_mb ? _ta_mbswidth0($text) : ta_length($text);
#    if ($is_trunc && $w > $width) {
#        my $res = $is_mb ?
#            ta_mbtrunc($text, $width, 1) : ta_trunc($text, $width, 1);
#        $text = $res->[0] . ($padchar x ($width-$res->[1]));
#    } else {
#        if ($which eq 'l') {
#            $text = ($padchar x ($width-$w)) . $text;
#        } elsif ($which eq 'c') {
#            my $n = int(($width-$w)/2);
#            $text = ($padchar x $n) . $text . ($padchar x ($width-$w-$n));
#        } else {
#            $text .= ($padchar x ($width-$w)) if $width > $w;
#        }
#    }
#    $text;
#}
#
#sub ta_pad {
#    _ta_pad(0, @_);
#}
#
#sub ta_mbpad {
#    _ta_pad(1, @_);
#}
#
#sub _ta_trunc {
#    my ($is_mb, $text, $width, $return_extra) = @_;
#
#
#    my $w = $is_mb ? _ta_mbswidth0($text) : ta_length($text);
#    if ($w <= $width) {
#        return $return_extra ? [$text, $w, length($text), ''] : $text;
#    }
#    my @p = ta_split_codes_single($text);
#    my $res = '';
#    my $append = 1; 
#    my $code4rest = '';
#    my $rest = '';
#    $w = 0;
#    my $c = 0;
#    while (my ($t, $ansi) = splice @p, 0, 2) {
#        if ($append) {
#            my $tw = $is_mb ? Text::WideChar::Util::mbswidth($t) : length($t);
#            if ($w+$tw <= $width) {
#                $res .= $t;
#                $w += $tw;
#                $c += length($t);
#                $append = 0 if $w == $width;
#            } else {
#                my $tres = $is_mb ?
#                    Text::WideChar::Util::mbtrunc($t, $width-$w, 1) :
#                      [substr($t, 0, $width-$w), $width-$w, $width-$w];
#                $res .= $tres->[0];
#                $w += $tres->[1];
#                $c += $tres->[2];
#                $rest = substr($t, $tres->[2]);
#                $append = 0;
#            }
#        } else {
#            $rest .= $t;
#        }
#        if (defined $ansi) {
#            if ($append) {
#                if ($ansi eq "\e[0m") {
#                    $c = length($ansi);
#                    $code4rest = $ansi;
#                } else {
#                    $c += length($ansi);
#                    $code4rest .= $ansi;
#                }
#                $res .= $ansi;
#            } else {
#                $res .= $ansi;
#                $rest .= $ansi;
#            }
#        }
#    }
#
#
#    if ($return_extra) {
#        return [$res, $w, $c, $code4rest . $rest];
#    } else {
#        return $res;
#    }
#}
#
#sub _ta_prune_codes {
#    my $text = shift;
#    $text =~ s/($re_mult)\e\[0m/\e\[0m/g;
#    $text;
#}
#
#sub ta_trunc {
#    _ta_trunc(0, @_);
#}
#
#sub ta_mbtrunc {
#    _ta_trunc(1, @_);
#}
#
#sub _ta_highlight {
#    my ($is_all, $text, $needle, $color) = @_;
#
#    my (@chptext, @chcode, @chsavedc); 
#    my $sc = "";
#    my $plaintext = "";
#    my @ch = ta_split_codes_single($text);
#    while (my ($pt, $c) = splice(@ch, 0, 2)) {
#        push @chptext , $pt;
#        push @chcode  , $c;
#        push @chsavedc, $sc;
#        $plaintext .= $pt;
#        if (defined($c) && $c =~ /m\z/) {
#            if ($c eq "\e[0m") {
#                $sc = "";
#            } elsif ($c =~ /m\z/) {
#                $sc .= $c;
#            }
#        }
#    }
#
#    my (@needle, @npos);
#    if (ref($needle) eq 'Regexp') {
#        my @m = $plaintext =~ /$needle/g;
#        return $text unless @m;
#        my $pos = 0;
#        while ($pos < length($plaintext)) {
#            my @pt;
#            for (@m) {
#                my $p = index($plaintext, $_, $pos);
#                push @pt, [$p, $_] if $p >= 0;
#            }
#            last unless @pt;
#            my $pmin = $pt[0][0];
#            my $t = $pt[0][1];
#            for (@pt) {
#                if ($pmin > $_->[0] ||
#                        $pmin==$_->[0] && length($t) < length($_->[1])) {
#                    $pmin = $_->[0];
#                    $t = $_->[1];
#                }
#            }
#            push @needle, $t;
#            push @npos  , $pmin;
#            last unless $is_all;
#            $pos = $pmin + length($t);
#        }
#    } else {
#        my $pos = 0;
#        while (1) {
#            my $p = index($plaintext, $needle, $pos);
#            last if $p < 0;
#            push @needle, $needle;
#            push @npos  , $p;
#            last unless $is_all;
#            $pos = $p + length($needle);
#            last if $pos >= length($plaintext);
#        }
#        return $text unless @needle;
#    }
#
#    my @res;
#    my $found = 1;
#    my $pos = 0;
#    my $i = 0;
#    my $curneed = shift @needle;
#    my $npos    = shift @npos;
#  CHUNK:
#    while (1) {
#        last if $i >= @chptext;
#        my $pos2  = $pos+length($chptext[$i])-1;
#        my $npos2 = $npos+length($curneed)-1;
#        if ($pos > $npos2 || $pos2 < $npos || !$found) {
#            push @res, $chptext[$i];
#            push @res, $chcode[$i] if defined $chcode[$i];
#            goto L1;
#        }
#
#        if ($pos < $npos) {
#            my $pre = substr($chptext[$i], 0, $npos-$pos);
#            push @res, $pre;
#        }
#
#        my $npart = substr($curneed,
#                           max(0, $pos-$npos),
#                           min($pos2, $npos2)-max($pos, $npos)+1);
#        if (length($npart)) {
#            push @res, $color, $npart;
#            push @res, "\e[0m";
#            push @res, $chsavedc[$i];
#        }
#
#        if ($npos2 <= $pos2) {
#            my $post = substr($chptext[$i], $npos2-$pos+1);
#
#            if (@needle) {
#                $curneed = shift @needle;
#                $npos    = shift @npos;
#                $pos     = $npos2+1;
#                $chptext[$i] = $post;
#                $found = 1;
#                redo CHUNK;
#            } else {
#                $found = 0;
#            }
#
#            if (!$found) {
#                push @res, $post;
#                push @res, $chcode[$i] if defined $chcode[$i];
#            }
#        }
#
#      L1:
#        $pos = $pos2+1;
#        $i++;
#    }
#
#    join "", @res;
#}
#
#sub ta_highlight {
#    _ta_highlight(0, @_);
#}
#
#sub ta_highlight_all {
#    _ta_highlight(1, @_);
#}
#
#sub ta_add_color_resets {
#    my (@text) = @_;
#
#    my @res;
#    my $i = 0;
#    my $savedc = "";
#    for my $text (@text) {
#        $i++;
#        my $newt = $i > 1 && !$savedc ? "\e[0m" : $savedc;
#
#        my @ch = ta_split_codes_single($text);
#        while (my ($t, $c) = splice(@ch, 0, 2)) {
#            $newt .= $t;
#            if (defined($c) && $c =~ /m\z/) {
#                $newt .= $c;
#                if ($c eq "\e[0m") {
#                    $savedc = "";
#                } elsif ($c =~ /m\z/) {
#                    $savedc .= $c;
#                }
#            }
#        }
#
#        $newt .= "\e[0m" if $savedc && $i < @text;
#        push @res, $newt;
#    }
#
#    @res;
#}
#
#sub _ta_substr {
#    my $is_mb = shift;
#    my $str   = shift;
#    my $pos   = shift;
#    my $len   = shift;
#
#    my $res1 = _ta_trunc($is_mb, $str, $pos, 1);
#    my $res2 = _ta_trunc($is_mb, $res1->[3], $len, 1);
#
#    if (@_) {
#        return _ta_prune_codes($res1->[0] . $_[0] . $res2->[3]);
#    } else {
#        return _ta_prune_codes($res2->[0]);
#    }
#}
#
#sub ta_substr {
#    _ta_substr(0, @_);
#}
#
#sub ta_mbsubstr {
#    _ta_substr(1, @_);
#}
#
#
#1;
#
#__END__
#
### Text/ANSI/Util.pm ###
#package Text::ANSI::Util;
#
#our $DATE = '2016-03-11'; 
#our $VERSION = '0.22'; 
#
#use 5.010001;
#use strict 'subs', 'vars';
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       ta_add_color_resets
#                       ta_detect
#                       ta_extract_codes
#                       ta_highlight
#                       ta_highlight_all
#                       ta_length
#                       ta_length_height
#                       ta_pad
#                       ta_split_codes
#                       ta_split_codes_single
#                       ta_strip
#                       ta_substr
#                       ta_trunc
#                       ta_wrap
#               );
#
#use Text::ANSI::BaseUtil ();
#
#our $re = $Text::ANSI::BaseUtil::re;
#*{$_} = \&{"Text::ANSI::BaseUtil::$_"} for @EXPORT_OK;
#
#1;
#
#__END__
#
### Text/Table/Any.pm ###
#package Text::Table::Any;
#
#our $DATE = '2017-01-01'; 
#our $VERSION = '0.08'; 
#
#
#sub _encode {
#    my $val = shift;
#    $val =~ s/([\\"])/\\$1/g;
#    "\"$val\"";
#}
#
#sub table {
#    my %params = @_;
#
#    my $rows       = $params{rows} or die "Must provide rows!";
#    my $backend    = $params{backend} || 'Text::Table::Tiny';
#    my $header_row = $params{header_row} // 0;
#
#    if ($backend eq 'Text::Table::Tiny') {
#        require Text::Table::Tiny;
#        return Text::Table::Tiny::table(
#            rows => $rows, header_row => $header_row) . "\n";
#    } elsif ($backend eq 'Text::Table::TinyColor') {
#        require Text::Table::TinyColor;
#        return Text::Table::TinyColor::table(
#            rows => $rows, header_row => $header_row) . "\n";
#    } elsif ($backend eq 'Text::Table::TinyColorWide') {
#        require Text::Table::TinyColorWide;
#        return Text::Table::TinyColorWide::table(
#            rows => $rows, header_row => $header_row) . "\n";
#    } elsif ($backend eq 'Text::Table::TinyWide') {
#        require Text::Table::TinyWide;
#        return Text::Table::TinyWide::table(
#            rows => $rows, header_row => $header_row) . "\n";
#    } elsif ($backend eq 'Text::Table::Org') {
#        require Text::Table::Org;
#        return Text::Table::Org::table(
#            rows => $rows, header_row => $header_row);
#    } elsif ($backend eq 'Text::Table::CSV') {
#        require Text::Table::CSV;
#        return Text::Table::CSV::table(
#            rows => $rows);
#    } elsif ($backend eq 'Text::Table::HTML') {
#        require Text::Table::HTML;
#        return Text::Table::HTML::table(
#            rows => $rows, header_row => $header_row);
#    } elsif ($backend eq 'Text::Table::HTML::DataTables') {
#        require Text::Table::HTML::DataTables;
#        return Text::Table::HTML::DataTables::table(
#            rows => $rows, header_row => $header_row);
#    } elsif ($backend eq 'Text::Table::Paragraph') {
#        require Text::Table::Paragraph;
#        return Text::Table::Paragraph::table(
#            rows => $rows, header_row => $header_row);
#    } elsif ($backend eq 'Text::ANSITable') {
#        require Text::ANSITable;
#        my $t = Text::ANSITable->new(
#            use_utf8 => 0,
#            use_box_chars => 0,
#            use_color => 0,
#            border_style => 'Default::single_ascii',
#        );
#        if ($header_row) {
#            $t->columns($rows->[0]);
#            $t->add_row($rows->[$_]) for 1..@$rows-1;
#        } else {
#            $t->columns([ map {"col$_"} 0..$#{$rows->[0]} ]);
#            $t->add_row($_) for @$rows;
#        }
#        return $t->draw;
#    } elsif ($backend eq 'Text::ASCIITable') {
#        require Text::ASCIITable;
#        my $t = Text::ASCIITable->new();
#        if ($header_row) {
#            $t->setCols(@{ $rows->[0] });
#            $t->addRow(@{ $rows->[$_] }) for 1..@$rows-1;
#        } else {
#            $t->setCols(map { "col$_" } 0..$#{ $rows->[0] });
#            $t->addRow(@$_) for @$rows;
#        }
#        return "$t";
#    } elsif ($backend eq 'Text::FormatTable') {
#        require Text::FormatTable;
#        my $t = Text::FormatTable->new(join('|', ('l') x @{ $rows->[0] }));
#        $t->head(@{ $rows->[0] });
#        $t->row(@{ $rows->[$_] }) for 1..@$rows-1;
#        return $t->render;
#    } elsif ($backend eq 'Text::MarkdownTable') {
#        require Text::MarkdownTable;
#        my $out = "";
#        my $fields =  $header_row ?
#            $rows->[0] : [map {"col$_"} 0..$#{ $rows->[0] }];
#        my $t = Text::MarkdownTable->new(file => \$out, columns => $fields);
#        foreach (($header_row ? 1:0) .. $#{$rows}) {
#            my $row = $rows->[$_];
#            $t->add( {
#                map { $fields->[$_] => $row->[$_] } 0..@$fields-1
#            });
#        }
#        $t->done;
#        return $out;
#    } elsif ($backend eq 'Text::Table') {
#        require Text::Table;
#        my $t = Text::Table->new(@{ $rows->[0] });
#        $t->load(@{ $rows }[1..@$rows-1]);
#        return $t;
#    } elsif ($backend eq 'Text::TabularDisplay') {
#        require Text::TabularDisplay;
#        my $t = Text::TabularDisplay->new(@{ $rows->[0] });
#        $t->add(@{ $rows->[$_] }) for 1..@$rows-1;
#        return $t->render . "\n";
#    } else {
#        die "Unknown backend '$backend'";
#    }
#}
#
#1;
#
#__END__
#
### Text/Table/Tiny.pm ###
#use 5.006;
#use strict;
#use warnings;
#package Text::Table::Tiny;
#$Text::Table::Tiny::VERSION = '0.04';
#use parent 'Exporter';
#use List::Util qw();
#
#our @EXPORT_OK = qw/ generate_table /;
#
#
#
#our $COLUMN_SEPARATOR = '|';
#our $ROW_SEPARATOR = '-';
#our $CORNER_MARKER = '+';
#our $HEADER_ROW_SEPARATOR = '=';
#our $HEADER_CORNER_MARKER = 'O';
#
#sub generate_table {
#
#    my %params = @_;
#    my $rows = $params{rows} or die "Must provide rows!";
#
#    my $widths = _maxwidths($rows);
#    my $max_index = _max_array_index($rows);
#
#    my $format = _get_format($widths);
#    my $row_sep = _get_row_separator($widths);
#    my $head_row_sep = _get_header_row_separator($widths);
#
#    my @table;
#    push @table, $row_sep;
#
#    my $data_begins = 0;
#    if ( $params{header_row} ) {
#        my $header_row = $rows->[0];
#        $data_begins++;
#        push @table, sprintf(
#                         $format, 
#                         map { defined($header_row->[$_]) ? $header_row->[$_] : '' } (0..$max_index)
#                     );
#        push @table, $params{separate_rows} ? $head_row_sep : $row_sep;
#    }
#
#    foreach my $row ( @{ $rows }[$data_begins..$#$rows] ) {
#        push @table, sprintf(
#	    $format, 
#	    map { defined($row->[$_]) ? $row->[$_] : '' } (0..$max_index)
#	);
#        push @table, $row_sep if $params{separate_rows};
#    }
#
#    push @table, $row_sep unless $params{separate_rows};
#    return join("\n",grep {$_} @table);
#}
#
#sub _get_cols_and_rows ($) {
#    my $rows = shift;
#    return ( List::Util::max( map { scalar @$_ } @$rows), scalar @$rows);
#}
#
#sub _maxwidths {
#    my $rows = shift;
#    my $max_index = _max_array_index($rows);
#    my $widths = [];
#    for my $i (0..$max_index) {
#        my $max = List::Util::max(map {defined $$_[$i] ? length($$_[$i]) : 0} @$rows);
#        push @$widths, $max;
#    }
#    return $widths;
#}
#
#sub _max_array_index {
#    my $rows = shift;
#    return List::Util::max( map { $#$_ } @$rows );
#}
#
#sub _get_format {
#    my $widths = shift;
#    return "$COLUMN_SEPARATOR ".join(" $COLUMN_SEPARATOR ",map { "%-${_}s" } @$widths)." $COLUMN_SEPARATOR";
#}
#
#sub _get_row_separator {
#    my $widths = shift;
#    return "$CORNER_MARKER$ROW_SEPARATOR".join("$ROW_SEPARATOR$CORNER_MARKER$ROW_SEPARATOR",map { $ROW_SEPARATOR x $_ } @$widths)."$ROW_SEPARATOR$CORNER_MARKER";
#}
#
#sub _get_header_row_separator {
#    my $widths = shift;
#    return "$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR".join("$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR",map { $HEADER_ROW_SEPARATOR x $_ } @$widths)."$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER";
#}
#
#*table = \&generate_table;
#
#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__
#
### Time/Duration.pm ###
#package Time::Duration;
#$Time::Duration::VERSION = '1.20';
#use 5.006;
#use strict;
#use warnings;
#use constant DEBUG => 0;
#
#require Exporter;
#
#our @ISA         = ('Exporter');
#our @EXPORT      = qw( later later_exact earlier earlier_exact
#                       ago ago_exact from_now from_now_exact
#                       duration duration_exact
#                       concise
#                     );
#our @EXPORT_OK   = ('interval', @EXPORT);
#our $MILLISECOND = 0;
#
#
#
#sub concise ($) {
#  my $string = $_[0];
#  DEBUG and print "in : $string\n";
#  $string =~ tr/,//d;
#  $string =~ s/\band\b//;
#  $string =~ s/\b(year|day|hour|minute|second)s?\b/substr($1,0,1)/eg;
#  $string =~ s/\b(millisecond)s?\b/ms/g;
#  $string =~ s/\s*(\d+)\s*/$1/g;
#  return $string;
#}
#
#sub later {
#  interval(      $_[0], $_[1], ' earlier', ' later', 'right then'); }
#sub later_exact {
#  interval_exact($_[0], $_[1], ' earlier', ' later', 'right then'); }
#sub earlier {
#  interval(      $_[0], $_[1], ' later', ' earlier', 'right then'); }
#sub earlier_exact {
#  interval_exact($_[0], $_[1], ' later', ' earlier', 'right then'); }
#sub ago {
#  interval(      $_[0], $_[1], ' from now', ' ago', 'right now'); }
#sub ago_exact {
#  interval_exact($_[0], $_[1], ' from now', ' ago', 'right now'); }
#sub from_now {
#  interval(      $_[0], $_[1], ' ago', ' from now', 'right now'); }
#sub from_now_exact {
#  interval_exact($_[0], $_[1], ' ago', ' from now', 'right now'); }
#
#sub duration_exact {
#  my $span = $_[0];   
#  my $precision = int($_[1] || 0) || 2;  
#  return '0 seconds' unless $span;
#  _render('',
#          _separate(abs $span));
#}
#
#sub duration {
#  my $span = $_[0];   
#  my $precision = int($_[1] || 0) || 2;  
#  return '0 seconds' unless $span;
#  _render('',
#          _approximate($precision,
#                       _separate(abs $span)));
#}
#
#
#sub interval_exact {
#  my $span = $_[0];                    
#  my $direction = ($span < 0) ? $_[2]  
#                : ($span > 0) ? $_[3]  
#                : return        $_[4]; 
#  _render($direction,
#          _separate($span));
#}
#
#sub interval {
#  my $span = $_[0];                     
#  my $precision = int($_[1] || 0) || 2; 
#  my $direction = ($span < 0) ? $_[2]   
#                : ($span > 0) ? $_[3]   
#                : return        $_[4];  
#  _render($direction,
#          _approximate($precision,
#                       _separate($span)));
#}
#
#
#use constant MINUTE => 60;
#use constant HOUR => 3600;
#use constant DAY  => 24 * HOUR;
#use constant YEAR => 365 * DAY;
#
#sub _separate {
#  
#  my $remainder = abs $_[0]; 
#  my $this; 
#  my @wheel; 
#  
#  $this = int($remainder / (365 * 24 * 60 * 60));
#  push @wheel, ['year', $this, 1_000_000_000];
#  $remainder -= $this * (365 * 24 * 60 * 60);
#    
#  $this = int($remainder / (24 * 60 * 60));
#  push @wheel, ['day', $this, 365];
#  $remainder -= $this * (24 * 60 * 60);
#    
#  $this = int($remainder / (60 * 60));
#  push @wheel, ['hour', $this, 24];
#  $remainder -= $this * (60 * 60);
#  
#  $this = int($remainder / 60);
#  push @wheel, ['minute', $this, 60];
#  $remainder -= $this * 60;
#  
#  push @wheel, ['second', int($remainder), 60];
#
#	if ($MILLISECOND) {
#		$remainder -= int($remainder);
#		push @wheel, ['millisecond', sprintf("%0.f", $remainder * 1000), 1000];
#	}
#
#  return @wheel;
#}
#
#sub _approximate {
#  my($precision, @wheel) = @_;
#
# Fix:
#  {
#  
#    my $nonzero_count = 0;
#    my $improperly_expressed;
#
#    DEBUG and print join ' ', '#', (map "${$_}[1] ${$_}[0]",  @wheel), "\n";
#    for(my $i = 0; $i < @wheel; $i++) {
#      my $this = $wheel[$i];
#      next if $this->[1] == 0; 
#      ++$nonzero_count;
#      next if $i == 0; 
#      
#      if($nonzero_count > $precision) {
#        DEBUG and print '', $this->[0], " is one nonzero too many!\n";
#
#        if($this->[1] >= ($this->[-1] / 2)) {
#          DEBUG and printf "incrementing %s from %s to %s\n",
#           $wheel[$i-1][0], $wheel[$i-1][1], 1 + $wheel[$i-1][1], ;
#          ++$wheel[$i-1][1];
#        }
#
#        for(my $j = $i; $j < @wheel; $j++) { $wheel[$j][1] = 0 }
#        redo Fix; 
#      } elsif($this->[1] >= $this->[-1]) {
#        $improperly_expressed = $i;
#        DEBUG and print '', $this->[0], ' (', $this->[1], 
#           ") is improper!\n";
#      }
#    }
#    
#    if(defined $improperly_expressed) {
#      DEBUG and printf "incrementing %s from %s to %s\n",
#       $wheel[$improperly_expressed-1][0], $wheel[$improperly_expressed-1][1], 
#        1 + $wheel[$improperly_expressed-1][1], ;
#      ++$wheel[ $improperly_expressed - 1][1];
#      $wheel[ $improperly_expressed][1] = 0;
#      redo Fix; 
#    }
#    
#  }
#
#  return @wheel;
#}
#
#sub _render {
#
#  my $direction = shift @_;
#  my @wheel = map
#        {;
#            (  $_->[1] == 0) ? ()  
#            : ($_->[1] == 1) ? "${$_}[1] ${$_}[0]"  
#            :                  "${$_}[1] ${$_}[0]s" 
#        }
#        @_
#  ;
#  return "just now" unless @wheel; 
#  $wheel[-1] .= $direction;
#  return $wheel[0] if @wheel == 1;
#  return "$wheel[0] and $wheel[1]" if @wheel == 2;
#  $wheel[-1] = "and $wheel[-1]";
#  return join q{, }, @wheel;
#}
#
#1;
#
#__END__
#
#so "1y 0d 1h 50m 50s", N=3, so you round at minutes to "1y 0d 1h 51m 0s",
##That's okay, so fall thru.
#
#so "1y 1d 0h 59m 50s", N=3, so you round at minutes to "1y 1d 0h 60m 0s",
#but that's not improperly expressed, so you loop around and get
#"1y 1d 1h 0m 0s", which is short enough, and is properly expressed.
#
#
#
### URI.pm ###
#package URI;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#our ($ABS_REMOTE_LEADING_DOTS, $ABS_ALLOW_RELATIVE_SCHEME, $DEFAULT_QUERY_FORM_DELIMITER);
#
#my %implements;  
#
#
#our $reserved   = q(;/?:@&=+$,[]);
#our $mark       = q(-_.!~*'());                                    
#our $unreserved = "A-Za-z0-9\Q$mark\E";
#our $uric       = quotemeta($reserved) . $unreserved . "%";
#
#our $scheme_re  = '[a-zA-Z][a-zA-Z0-9.+\-]*';
#
#use Carp ();
#use URI::Escape ();
#
#use overload ('""'     => sub { ${$_[0]} },
#              '=='     => sub { _obj_eq(@_) },
#              '!='     => sub { !_obj_eq(@_) },
#              fallback => 1,
#             );
#
#sub _obj_eq {
#    return overload::StrVal($_[0]) eq overload::StrVal($_[1]);
#}
#
#sub new
#{
#    my($class, $uri, $scheme) = @_;
#
#    $uri = defined ($uri) ? "$uri" : "";   
#    $uri =~ s/^<(?:URL:)?(.*)>$/$1/;  
#    $uri =~ s/^"(.*)"$/$1/;
#    $uri =~ s/^\s+//;
#    $uri =~ s/\s+$//;
#
#    my $impclass;
#    if ($uri =~ m/^($scheme_re):/so) {
#	$scheme = $1;
#    }
#    else {
#	if (($impclass = ref($scheme))) {
#	    $scheme = $scheme->scheme;
#	}
#	elsif ($scheme && $scheme =~ m/^($scheme_re)(?::|$)/o) {
#	    $scheme = $1;
#        }
#    }
#    $impclass ||= implementor($scheme) ||
#	do {
#	    require URI::_foreign;
#	    $impclass = 'URI::_foreign';
#	};
#
#    return $impclass->_init($uri, $scheme);
#}
#
#
#sub new_abs
#{
#    my($class, $uri, $base) = @_;
#    $uri = $class->new($uri, $base);
#    $uri->abs($base);
#}
#
#
#sub _init
#{
#    my $class = shift;
#    my($str, $scheme) = @_;
#    $str = $class->_uric_escape($str);
#    $str = "$scheme:$str" unless $str =~ /^$scheme_re:/o ||
#                                 $class->_no_scheme_ok;
#    my $self = bless \$str, $class;
#    $self;
#}
#
#
#sub _uric_escape
#{
#    my($class, $str) = @_;
#    $str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
#    utf8::downgrade($str);
#    return $str;
#}
#
#my %require_attempted;
#
#sub implementor
#{
#    my($scheme, $impclass) = @_;
#    if (!$scheme || $scheme !~ /\A$scheme_re\z/o) {
#	require URI::_generic;
#	return "URI::_generic";
#    }
#
#    $scheme = lc($scheme);
#
#    if ($impclass) {
#        my $old = $implements{$scheme};
#        $impclass->_init_implementor($scheme);
#        $implements{$scheme} = $impclass;
#        return $old;
#    }
#
#    my $ic = $implements{$scheme};
#    return $ic if $ic;
#
#    $ic = "URI::$scheme";  
#
#    $ic =~ s/\+/_P/g;
#    $ic =~ s/\./_O/g;
#    $ic =~ s/\-/_/g;
#
#    no strict 'refs';
#    unless (@{"${ic}::ISA"}) {
#        if (not exists $require_attempted{$ic}) {
#            my $_old_error = $@;
#            eval "require $ic";
#            die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
#            $@ = $_old_error;
#        }
#        return undef unless @{"${ic}::ISA"};
#    }
#
#    $ic->_init_implementor($scheme);
#    $implements{$scheme} = $ic;
#    $ic;
#}
#
#
#sub _init_implementor
#{
#    my($class, $scheme) = @_;
#}
#
#
#sub clone
#{
#    my $self = shift;
#    my $other = $$self;
#    bless \$other, ref $self;
#}
#
#sub TO_JSON { ${$_[0]} }
#
#sub _no_scheme_ok { 0 }
#
#sub _scheme
#{
#    my $self = shift;
#
#    unless (@_) {
#	return undef unless $$self =~ /^($scheme_re):/o;
#	return $1;
#    }
#
#    my $old;
#    my $new = shift;
#    if (defined($new) && length($new)) {
#	Carp::croak("Bad scheme '$new'") unless $new =~ /^$scheme_re$/o;
#	$old = $1 if $$self =~ s/^($scheme_re)://o;
#	my $newself = URI->new("$new:$$self");
#	$$self = $$newself; 
#	bless $self, ref($newself);
#    }
#    else {
#	if ($self->_no_scheme_ok) {
#	    $old = $1 if $$self =~ s/^($scheme_re)://o;
#	    Carp::carp("Oops, opaque part now look like scheme")
#		if $^W && $$self =~ m/^$scheme_re:/o
#	}
#	else {
#	    $old = $1 if $$self =~ m/^($scheme_re):/o;
#	}
#    }
#
#    return $old;
#}
#
#sub scheme
#{
#    my $scheme = shift->_scheme(@_);
#    return undef unless defined $scheme;
#    lc($scheme);
#}
#
#sub has_recognized_scheme {
#    my $self = shift;
#    return ref($self) !~ /^URI::_(?:foreign|generic)\z/;
#}
#
#sub opaque
#{
#    my $self = shift;
#
#    unless (@_) {
#	$$self =~ /^(?:$scheme_re:)?([^\#]*)/o or die;
#	return $1;
#    }
#
#    $$self =~ /^($scheme_re:)?    # optional scheme
#	        ([^\#]*)          # opaque
#                (\#.*)?           # optional fragment
#              $/sx or die;
#
#    my $old_scheme = $1;
#    my $old_opaque = $2;
#    my $old_frag   = $3;
#
#    my $new_opaque = shift;
#    $new_opaque = "" unless defined $new_opaque;
#    $new_opaque =~ s/([^$uric])/ URI::Escape::escape_char($1)/ego;
#    utf8::downgrade($new_opaque);
#
#    $$self = defined($old_scheme) ? $old_scheme : "";
#    $$self .= $new_opaque;
#    $$self .= $old_frag if defined $old_frag;
#
#    $old_opaque;
#}
#
#sub path { goto &opaque }  
#
#
#sub fragment
#{
#    my $self = shift;
#    unless (@_) {
#	return undef unless $$self =~ /\#(.*)/s;
#	return $1;
#    }
#
#    my $old;
#    $old = $1 if $$self =~ s/\#(.*)//s;
#
#    my $new_frag = shift;
#    if (defined $new_frag) {
#	$new_frag =~ s/([^$uric])/ URI::Escape::escape_char($1) /ego;
#	utf8::downgrade($new_frag);
#	$$self .= "#$new_frag";
#    }
#    $old;
#}
#
#
#sub as_string
#{
#    my $self = shift;
#    $$self;
#}
#
#
#sub as_iri
#{
#    my $self = shift;
#    my $str = $$self;
#    if ($str =~ s/%([89a-fA-F][0-9a-fA-F])/chr(hex($1))/eg) {
#
#	require Encode;
#	my $enc = Encode::find_encoding("UTF-8");
#	my $u = "";
#	while (length $str) {
#	    $u .= $enc->decode($str, Encode::FB_QUIET());
#	    if (length $str) {
#		$u .= URI::Escape::escape_char(substr($str, 0, 1, ""));
#	    }
#	}
#	$str = $u;
#    }
#    return $str;
#}
#
#
#sub canonical
#{
#
#    my $self = shift;
#    my $scheme = $self->_scheme || "";
#    my $uc_scheme = $scheme =~ /[A-Z]/;
#    my $esc = $$self =~ /%[a-fA-F0-9]{2}/;
#    return $self unless $uc_scheme || $esc;
#
#    my $other = $self->clone;
#    if ($uc_scheme) {
#	$other->_scheme(lc $scheme);
#    }
#    if ($esc) {
#	$$other =~ s{%([0-9a-fA-F]{2})}
#	            { my $a = chr(hex($1));
#                      $a =~ /^[$unreserved]\z/o ? $a : "%\U$1"
#                    }ge;
#    }
#    return $other;
#}
#
#sub eq {
#    my($self, $other) = @_;
#    $self  = URI->new($self, $other) unless ref $self;
#    $other = URI->new($other, $self) unless ref $other;
#    ref($self) eq ref($other) &&                
#	$self->canonical->as_string eq $other->canonical->as_string;
#}
#
#sub abs { $_[0]; }
#sub rel { $_[0]; }
#
#sub secure { 0 }
#
#sub STORABLE_freeze {
#       my($self, $cloning) = @_;
#       return $$self;
#}
#
#sub STORABLE_thaw {
#       my($self, $cloning, $str) = @_;
#       $$self = $str;
#}
#
#1;
#
#__END__
#
### URI/Escape.pm ###
#package URI::Escape;
#
#use strict;
#use warnings;
#
#
#use Exporter 5.57 'import';
#our %escapes;
#our @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
#our @EXPORT_OK = qw(%escapes);
#our $VERSION = "3.31";
#
#use Carp ();
#
#for (0..255) {
#    $escapes{chr($_)} = sprintf("%%%02X", $_);
#}
#
#my %subst;  
#
#my %Unsafe = (
#    RFC2732 => qr/[^A-Za-z0-9\-_.!~*'()]/,
#    RFC3986 => qr/[^A-Za-z0-9\-\._~]/,
#);
#
#sub uri_escape {
#    my($text, $patn) = @_;
#    return undef unless defined $text;
#    if (defined $patn){
#        unless (exists  $subst{$patn}) {
#            (my $tmp = $patn) =~ s,/,\\/,g;
#            eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
#            Carp::croak("uri_escape: $@") if $@;
#        }
#        &{$subst{$patn}}($text);
#    } else {
#        $text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
#    }
#    $text;
#}
#
#sub _fail_hi {
#    my $chr = shift;
#    Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr));
#}
#
#sub uri_escape_utf8 {
#    my $text = shift;
#    utf8::encode($text);
#    return uri_escape($text, @_);
#}
#
#sub uri_unescape {
#    my $str = shift;
#    if (@_ && wantarray) {
#        my @str = ($str, @_);  
#        for (@str) {
#            s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
#        }
#        return @str;
#    }
#    $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
#    $str;
#}
#
#sub escape_char {
#    my $dummy = substr($_[0], 0, 0);
#
#    if (utf8::is_utf8($_[0])) {
#        my $s = shift;
#        utf8::encode($s);
#        unshift(@_, $s);
#    }
#
#    return join '', @URI::Escape::escapes{split //, $_[0]};
#}
#
#1;
### URI/Heuristic.pm ###
#package URI::Heuristic;
#
#
#use strict;
#use warnings;
#
#use Exporter 5.57 'import';
#our @EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr);
#our $VERSION = "4.20";
#
#our ($MY_COUNTRY, $DEBUG);
#
#sub MY_COUNTRY() {
#    for ($MY_COUNTRY) {
#	return $_ if defined;
#
#	$_ = $ENV{COUNTRY};
#	return $_ if defined;
#
#	my @srcs = ($ENV{LC_ALL}, $ENV{LANG});
#	if (my $httplang = $ENV{HTTP_ACCEPT_LANGUAGE}) {
#	    for $httplang (split(/\s*,\s*/, $httplang)) {
#		if ($httplang =~ /^\s*([a-zA-Z]+)[_-]([a-zA-Z]{2})\s*$/) {
#		    unshift(@srcs, "${1}_${2}");
#		    last;
#		}
#	    }
#	}
#	for (@srcs) {
#	    next unless defined;
#	    return lc($1) if /^[a-zA-Z]+_([a-zA-Z]{2})(?:[.@]|$)/;
#	}
#
#	require Net::Domain;
#	my $fqdn = Net::Domain::hostfqdn();
#	$_ = lc($1) if $fqdn =~ /\.([a-zA-Z]{2})$/;
#	return $_ if defined;
#
#	return ($_ = 0);
#    }
#}
#
#our %LOCAL_GUESSING =
#(
# 'us' => [qw(www.ACME.gov www.ACME.mil)],
# 'gb' => [qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],
# 'au' => [qw(www.ACME.com.au www.ACME.org.au www.ACME.edu.au)],
# 'il' => [qw(www.ACME.co.il www.ACME.org.il www.ACME.net.il)],
#);
#$LOCAL_GUESSING{uk} = $LOCAL_GUESSING{gb};
#
#
#sub uf_uristr ($)
#{
#    local($_) = @_;
#    print STDERR "uf_uristr: resolving $_\n" if $DEBUG;
#    return unless defined;
#
#    s/^\s+//;
#    s/\s+$//;
#
#    if (/^(www|web|home)[a-z0-9-]*(?:\.|$)/i) {
#	$_ = "http://$_";
#
#    } elsif (/^(ftp|gopher|news|wais|https|http)[a-z0-9-]*(?:\.|$)/i) {
#	$_ = lc($1) . "://$_";
#
#    } elsif ($^O ne "MacOS" && 
#	    (m,^/,      ||          
#	     m,^\.\.?/, ||          
#	     m,^[a-zA-Z]:[/\\],)    
#	    )
#    {
#	$_ = "file:$_";
#
#    } elsif ($^O eq "MacOS" && m/:/) {
#	unless (m/^(ftp|gopher|news|wais|http|https|mailto):/) {
#	    require URI::file;
#	    my $a = URI::file->new($_)->as_string;
#	    $_ = ($a =~ m/^file:/) ? $a : "file:$a";
#	}
#    } elsif (/^\w+([\.\-]\w+)*\@(\w+\.)+\w{2,3}$/) {
#	$_ = "mailto:$_";
#
#    } elsif (!/^[a-zA-Z][a-zA-Z0-9.+\-]*:/) {      
#	if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/) {
#	    my $host = $1;
#
#	    my $scheme = "http";
#	    if (/^:(\d+)\b/) {
#		if ($1 =~ /^[56789]?443$/) {
#		    $scheme = "https";
#		} elsif ($1 eq "21") {
#		    $scheme = "ftp";
#		}
#	    }
#
#	    if ($host !~ /\./ && $host ne "localhost") {
#		my @guess;
#		if (exists $ENV{URL_GUESS_PATTERN}) {
#		    @guess = map { s/\bACME\b/$host/; $_ }
#		             split(' ', $ENV{URL_GUESS_PATTERN});
#		} else {
#		    if (MY_COUNTRY()) {
#			my $special = $LOCAL_GUESSING{MY_COUNTRY()};
#			if ($special) {
#			    my @special = @$special;
#			    push(@guess, map { s/\bACME\b/$host/; $_ }
#                                               @special);
#			} else {
#			    push(@guess, "www.$host." . MY_COUNTRY());
#			}
#		    }
#		    push(@guess, map "www.$host.$_",
#			             "com", "org", "net", "edu", "int");
#		}
#
#
#		my $guess;
#		for $guess (@guess) {
#		    print STDERR "uf_uristr: gethostbyname('$guess.')..."
#		      if $DEBUG;
#		    if (gethostbyname("$guess.")) {
#			print STDERR "yes\n" if $DEBUG;
#			$host = $guess;
#			last;
#		    }
#		    print STDERR "no\n" if $DEBUG;
#		}
#	    }
#	    $_ = "$scheme://$host$_";
#
#	} else {
#
#	}
#    }
#    print STDERR "uf_uristr: ==> $_\n" if $DEBUG;
#
#    $_;
#}
#
#sub uf_uri ($)
#{
#    require URI;
#    URI->new(uf_uristr($_[0]));
#}
#
#*uf_urlstr = \*uf_uristr;
#
#sub uf_url ($)
#{
#    require URI::URL;
#    URI::URL->new(uf_uristr($_[0]));
#}
#
#1;
### URI/IRI.pm ###
#package URI::IRI;
#
#
#use strict;
#use warnings;
#use URI ();
#
#use overload '""' => sub { shift->as_string };
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub new {
#    my($class, $uri, $scheme) = @_;
#    utf8::upgrade($uri);
#    return bless {
#	uri => URI->new($uri, $scheme),
#    }, $class;
#}
#
#sub clone {
#    my $self = shift;
#    return bless {
#	uri => $self->{uri}->clone,
#    }, ref($self);
#}
#
#sub as_string {
#    my $self = shift;
#    return $self->{uri}->as_iri;
#}
#
#our $AUTOLOAD;
#sub AUTOLOAD
#{
#    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
#
#    no strict 'refs';
#    *$method = sub { shift->{uri}->$method(@_) };
#    goto &$method;
#}
#
#sub DESTROY {}   
#
#1;
### URI/QueryParam.pm ###
#package URI::QueryParam;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub URI::_query::query_param {
#    my $self = shift;
#    my @old = $self->query_form;
#
#    if (@_ == 0) {
#	my (%seen, $i);
#	return grep !($i++ % 2 || $seen{$_}++), @old;
#    }
#
#    my $key = shift;
#    my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old;
#
#    if (@_) {
#	my @new = @old;
#	my @new_i = @i;
#	my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
#
#	while (@new_i > @vals) {
#	    splice @new, pop @new_i, 2;
#	}
#	if (@vals > @new_i) {
#	    my $i = @new_i ? $new_i[-1] + 2 : @new;
#	    my @splice = splice @vals, @new_i, @vals - @new_i;
#
#	    splice @new, $i, 0, map { $key => $_ } @splice;
#	}
#	if (@vals) {
#	    @new[ map $_ + 1, @new_i ] = @vals;
#	}
#
#	$self->query_form(\@new);
#    }
#
#    return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef;
#}
#
#sub URI::_query::query_param_append {
#    my $self = shift;
#    my $key = shift;
#    my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_;
#    $self->query_form($self->query_form, $key => \@vals);  
#    return;
#}
#
#sub URI::_query::query_param_delete {
#    my $self = shift;
#    my $key = shift;
#    my @old = $self->query_form;
#    my @vals;
#
#    for (my $i = @old - 2; $i >= 0; $i -= 2) {
#	next if $old[$i] ne $key;
#	push(@vals, (splice(@old, $i, 2))[1]);
#    }
#    $self->query_form(\@old) if @vals;
#    return wantarray ? reverse @vals : $vals[-1];
#}
#
#sub URI::_query::query_form_hash {
#    my $self = shift;
#    my @old = $self->query_form;
#    if (@_) {
#	$self->query_form(@_ == 1 ? %{shift(@_)} : @_);
#    }
#    my %hash;
#    while (my($k, $v) = splice(@old, 0, 2)) {
#	if (exists $hash{$k}) {
#	    for ($hash{$k}) {
#		$_ = [$_] unless ref($_) eq "ARRAY";
#		push(@$_, $v);
#	    }
#	}
#	else {
#	    $hash{$k} = $v;
#	}
#    }
#    return \%hash;
#}
#
#1;
#
#__END__
#
### URI/Split.pm ###
#package URI::Split;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use Exporter 5.57 'import';
#our @EXPORT_OK = qw(uri_split uri_join);
#
#use URI::Escape ();
#
#sub uri_split {
#     return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
#}
#
#sub uri_join {
#    my($scheme, $auth, $path, $query, $frag) = @_;
#    my $uri = defined($scheme) ? "$scheme:" : "";
#    $path = "" unless defined $path;
#    if (defined $auth) {
#	$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
#	$uri .= "//$auth";
#	$path = "/$path" if length($path) && $path !~ m,^/,;
#    }
#    elsif ($path =~ m,^//,) {
#	$uri .= "//";  
#    }
#    unless (length $uri) {
#	$path =~ s,(:), URI::Escape::escape_char($1),e while $path =~ m,^[^:/?\#]+:,;
#    }
#    $path =~ s,([?\#]), URI::Escape::escape_char($1),eg;
#    $uri .= $path;
#    if (defined $query) {
#	$query =~ s,(\#), URI::Escape::escape_char($1),eg;
#	$uri .= "?$query";
#    }
#    $uri .= "#$frag" if defined $frag;
#    $uri;
#}
#
#1;
#
#__END__
#
### URI/URL.pm ###
#package URI::URL;
#
#use strict;
#use warnings;
#
#use parent 'URI::WithBase';
#
#our $VERSION = "5.04";
#
#
#use Exporter 5.57 'import';
#our @EXPORT = qw(url);
#
#sub url ($;$) { URI::URL->new(@_); }
#
#use URI::Escape qw(uri_unescape);
#
#sub new
#{
#    my $class = shift;
#    my $self = $class->SUPER::new(@_);
#    $self->[0] = $self->[0]->canonical;
#    $self;
#}
#
#sub newlocal
#{
#    my $class = shift;
#    require URI::file;
#    bless [URI::file->new_abs(shift)], $class;
#}
#
#{package URI::_foreign;
#    sub _init  
#    {
#	my $class = shift;
#	die "Unknown URI::URL scheme $_[1]:" if $URI::URL::STRICT;
#	$class->SUPER::_init(@_);
#    }
#}
#
#sub strict
#{
#    my $old = $URI::URL::STRICT;
#    $URI::URL::STRICT = shift if @_;
#    $old;
#}
#
#sub print_on
#{
#    my $self = shift;
#    require Data::Dumper;
#    print STDERR Data::Dumper::Dumper($self);
#}
#
#sub _try
#{
#    my $self = shift;
#    my $method = shift;
#    scalar(eval { $self->$method(@_) });
#}
#
#sub crack
#{
#    my $self = shift;
#    (scalar($self->scheme),
#     $self->_try("user"),
#     $self->_try("password"),
#     $self->_try("host"),
#     $self->_try("port"),
#     $self->_try("path"),
#     $self->_try("params"),
#     $self->_try("query"),
#     scalar($self->fragment),
#    )
#}
#
#sub full_path
#{
#    my $self = shift;
#    my $path = $self->path_query;
#    $path = "/" unless length $path;
#    $path;
#}
#
#sub netloc
#{
#    shift->authority(@_);
#}
#
#sub epath
#{
#    my $path = shift->SUPER::path(@_);
#    $path =~ s/;.*//;
#    $path;
#}
#
#sub eparams
#{
#    my $self = shift;
#    my @p = $self->path_segments;
#    return undef unless ref($p[-1]);
#    @p = @{$p[-1]};
#    shift @p;
#    join(";", @p);
#}
#
#sub params { shift->eparams(@_); }
#
#sub path {
#    my $self = shift;
#    my $old = $self->epath(@_);
#    return unless defined wantarray;
#    return '/' if !defined($old) || !length($old);
#    Carp::croak("Path components contain '/' (you must call epath)")
#	if $old =~ /%2[fF]/ and !@_;
#    $old = "/$old" if $old !~ m|^/| && defined $self->netloc;
#    return uri_unescape($old);
#}
#
#sub path_components {
#    shift->path_segments(@_);
#}
#
#sub query {
#    my $self = shift;
#    my $old = $self->equery(@_);
#    if (defined(wantarray) && defined($old)) {
#	if ($old =~ /%(?:26|2[bB]|3[dD])/) {  
#	    my $mess;
#	    for ($old) {
#		$mess = "Query contains both '+' and '%2B'"
#		  if /\+/ && /%2[bB]/;
#		$mess = "Form query contains escaped '=' or '&'"
#		  if /=/  && /%(?:3[dD]|26)/;
#	    }
#	    if ($mess) {
#		Carp::croak("$mess (you must call equery)");
#	    }
#	}
#	return uri_unescape($old);
#    }
#    undef;
#
#}
#
#sub abs
#{
#    my $self = shift;
#    my $base = shift;
#    my $allow_scheme = shift;
#    $allow_scheme = $URI::URL::ABS_ALLOW_RELATIVE_SCHEME
#	unless defined $allow_scheme;
#    local $URI::ABS_ALLOW_RELATIVE_SCHEME = $allow_scheme;
#    local $URI::ABS_REMOTE_LEADING_DOTS = $URI::URL::ABS_REMOTE_LEADING_DOTS;
#    $self->SUPER::abs($base);
#}
#
#sub frag { shift->fragment(@_); }
#sub keywords { shift->query_keywords(@_); }
#
#sub local_path { shift->file; }
#sub unix_path  { shift->file("unix"); }
#sub dos_path   { shift->file("dos");  }
#sub mac_path   { shift->file("mac");  }
#sub vms_path   { shift->file("vms");  }
#
#sub address { shift->to(@_); }
#sub encoded822addr { shift->to(@_); }
#sub URI::mailto::authority { shift->to(@_); }  
#
#sub groupart { shift->_group(@_); }
#sub article  { shift->message(@_); }
#
#1;
#
#__END__
#
### URI/WithBase.pm ###
#package URI::WithBase;
#
#use strict;
#use warnings;
#
#use URI;
#use Scalar::Util 'blessed';
#
#our $VERSION = "2.20";
#
#use overload '""' => "as_string", fallback => 1;
#
#sub as_string;  
#
#sub new
#{
#    my($class, $uri, $base) = @_;
#    my $ibase = $base;
#    if ($base && blessed($base) && $base->isa(__PACKAGE__)) {
#	$base = $base->abs;
#	$ibase = $base->[0];
#    }
#    bless [URI->new($uri, $ibase), $base], $class;
#}
#
#sub new_abs
#{
#    my $class = shift;
#    my $self = $class->new(@_);
#    $self->abs;
#}
#
#sub _init
#{
#    my $class = shift;
#    my($str, $scheme) = @_;
#    bless [URI->new($str, $scheme), undef], $class;
#}
#
#sub eq
#{
#    my($self, $other) = @_;
#    $other = $other->[0] if blessed($other) and $other->isa(__PACKAGE__);
#    $self->[0]->eq($other);
#}
#
#our $AUTOLOAD;
#sub AUTOLOAD
#{
#    my $self = shift;
#    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
#    return if $method eq "DESTROY";
#    $self->[0]->$method(@_);
#}
#
#sub can {                                  
#    my $self = shift;
#    $self->SUPER::can(@_) || (
#      ref($self)
#      ? $self->[0]->can(@_)
#      : undef
#    )
#}
#
#sub base {
#    my $self = shift;
#    my $base  = $self->[1];
#
#    if (@_) { 
#	my $new_base = shift;
#	$new_base = $new_base->abs if ref($new_base) && $new_base->isa(__PACKAGE__);
#	$self->[1] = $new_base;
#    }
#    return unless defined wantarray;
#
#    if (defined($base) && !ref($base)) {
#	$base = ref($self)->new($base);
#	$self->[1] = $base unless @_;
#    }
#    $base;
#}
#
#sub clone
#{
#    my $self = shift;
#    my $base = $self->[1];
#    $base = $base->clone if ref($base);
#    bless [$self->[0]->clone, $base], ref($self);
#}
#
#sub abs
#{
#    my $self = shift;
#    my $base = shift || $self->base || return $self->clone;
#    $base = $base->as_string if ref($base);
#    bless [$self->[0]->abs($base, @_), $base], ref($self);
#}
#
#sub rel
#{
#    my $self = shift;
#    my $base = shift || $self->base || return $self->clone;
#    $base = $base->as_string if ref($base);
#    bless [$self->[0]->rel($base, @_), $base], ref($self);
#}
#
#1;
#
#__END__
#
### URI/data.pm ###
#package URI::data;  
#
#use strict;
#use warnings;
#
#use parent 'URI';
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use MIME::Base64 qw(encode_base64 decode_base64);
#use URI::Escape  qw(uri_unescape);
#
#sub media_type
#{
#    my $self = shift;
#    my $opaque = $self->opaque;
#    $opaque =~ /^([^,]*),?/ or die;
#    my $old = $1;
#    my $base64;
#    $base64 = $1 if $old =~ s/(;base64)$//i;
#    if (@_) {
#	my $new = shift;
#	$new = "" unless defined $new;
#	$new =~ s/%/%25/g;
#	$new =~ s/,/%2C/g;
#	$base64 = "" unless defined $base64;
#	$opaque =~ s/^[^,]*,?/$new$base64,/;
#	$self->opaque($opaque);
#    }
#    return uri_unescape($old) if $old;  
#    "text/plain;charset=US-ASCII";      
#}
#
#sub data
#{
#    my $self = shift;
#    my($enc, $data) = split(",", $self->opaque, 2);
#    unless (defined $data) {
#	$data = "";
#	$enc  = "" unless defined $enc;
#    }
#    my $base64 = ($enc =~ /;base64$/i);
#    if (@_) {
#	$enc =~ s/;base64$//i if $base64;
#	my $new = shift;
#	$new = "" unless defined $new;
#	my $uric_count = _uric_count($new);
#	my $urienc_len = $uric_count + (length($new) - $uric_count) * 3;
#	my $base64_len = int((length($new)+2) / 3) * 4;
#	$base64_len += 7;  
#	if ($base64_len < $urienc_len || $_[0]) {
#	    $enc .= ";base64";
#	    $new = encode_base64($new, "");
#	} else {
#	    $new =~ s/%/%25/g;
#	}
#	$self->opaque("$enc,$new");
#    }
#    return unless defined wantarray;
#    $data = uri_unescape($data);
#    return $base64 ? decode_base64($data) : $data;
#}
#
#my $ENC = $URI::uric;
#$ENC =~ s/%//;
#
#eval <<EOT; die $@ if $@;
#sub _uric_count
#{
#    \$_[0] =~ tr/$ENC//;
#}
#EOT
#
#1;
#
#__END__
#
### URI/file.pm ###
#package URI::file;
#
#use strict;
#use warnings;
#
#use parent 'URI::_generic';
#our $VERSION = "4.21";
#
#use URI::Escape qw(uri_unescape);
#
#our $DEFAULT_AUTHORITY = "";
#
#our %OS_CLASS = (
#     os2     => "OS2",
#     mac     => "Mac",
#     MacOS   => "Mac",
#     MSWin32 => "Win32",
#     win32   => "Win32",
#     msdos   => "FAT",
#     dos     => "FAT",
#     qnx     => "QNX",
#);
#
#sub os_class
#{
#    my($OS) = shift || $^O;
#
#    my $class = "URI::file::" . ($OS_CLASS{$OS} || "Unix");
#    no strict 'refs';
#    unless (%{"$class\::"}) {
#	eval "require $class";
#	die $@ if $@;
#    }
#    $class;
#}
#
#sub host { uri_unescape(shift->authority(@_)) }
#
#sub new
#{
#    my($class, $path, $os) = @_;
#    os_class($os)->new($path);
#}
#
#sub new_abs
#{
#    my $class = shift;
#    my $file = $class->new(@_);
#    return $file->abs($class->cwd) unless $$file =~ /^file:/;
#    $file;
#}
#
#sub cwd
#{
#    my $class = shift;
#    require Cwd;
#    my $cwd = Cwd::cwd();
#    $cwd = VMS::Filespec::unixpath($cwd) if $^O eq 'VMS';
#    $cwd = $class->new($cwd);
#    $cwd .= "/" unless substr($cwd, -1, 1) eq "/";
#    $cwd;
#}
#
#sub canonical {
#    my $self = shift;
#    my $other = $self->SUPER::canonical;
#
#    my $scheme = $other->scheme;
#    my $auth = $other->authority;
#    return $other if !defined($scheme) && !defined($auth);  
#
#    if (!defined($auth) ||
#	$auth eq "" ||
#	lc($auth) eq "localhost" ||
#	(defined($DEFAULT_AUTHORITY) && lc($auth) eq lc($DEFAULT_AUTHORITY))
#       )
#    {
#	if ((defined($auth) || defined($DEFAULT_AUTHORITY)) &&
#	    (!defined($auth) || !defined($DEFAULT_AUTHORITY) || $auth ne $DEFAULT_AUTHORITY)
#	   )
#	{
#	    $other = $other->clone if $self == $other;
#	    $other->authority($DEFAULT_AUTHORITY);
#        }
#    }
#
#    $other;
#}
#
#sub file
#{
#    my($self, $os) = @_;
#    os_class($os)->file($self);
#}
#
#sub dir
#{
#    my($self, $os) = @_;
#    os_class($os)->dir($self);
#}
#
#1;
#
#__END__
#
#
#
#RFC 1630
#
#   [...]
#
#   There is clearly a danger of confusion that a link made to a local
#   file should be followed by someone on a different system, with
#   unexpected and possibly harmful results.  Therefore, the convention
#   is that even a "file" URL is provided with a host part.  This allows
#   a client on another system to know that it cannot access the file
#   system, or perhaps to use some other local mechanism to access the
#   file.
#
#   The special value "localhost" is used in the host field to indicate
#   that the filename should really be used on whatever host one is.
#   This for example allows links to be made to files which are
#   distributed on many machines, or to "your unix local password file"
#   subject of course to consistency across the users of the data.
#
#   A void host field is equivalent to "localhost".
#
### URI/file/Base.pm ###
#package URI::file::Base;
#
#use strict;
#use warnings;
#
#use URI::Escape qw();
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub new
#{
#    my $class = shift;
#    my $path  = shift;
#    $path = "" unless defined $path;
#
#    my($auth, $escaped_auth, $escaped_path);
#
#    ($auth, $escaped_auth) = $class->_file_extract_authority($path);
#    ($path, $escaped_path) = $class->_file_extract_path($path);
#
#    if (defined $auth) {
#	$auth =~ s,%,%25,g unless $escaped_auth;
#	$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
#	$auth = "//$auth";
#	if (defined $path) {
#	    $path = "/$path" unless substr($path, 0, 1) eq "/";
#	} else {
#	    $path = "";
#	}
#    } else {
#	return undef unless defined $path;
#	$auth = "";
#    }
#
#    $path =~ s,([%;?]), URI::Escape::escape_char($1),eg unless $escaped_path;
#    $path =~ s/\#/%23/g;
#
#    my $uri = $auth . $path;
#    $uri = "file:$uri" if substr($uri, 0, 1) eq "/";
#
#    URI->new($uri, "file");
#}
#
#sub _file_extract_authority
#{
#    my($class, $path) = @_;
#    return undef unless $class->_file_is_absolute($path);
#    return $URI::file::DEFAULT_AUTHORITY;
#}
#
#sub _file_extract_path
#{
#    return undef;
#}
#
#sub _file_is_absolute
#{
#    return 0;
#}
#
#sub _file_is_localhost
#{
#    shift; 
#    my $host = lc(shift);
#    return 1 if $host eq "localhost";
#    eval {
#	require Net::Domain;
#	lc(Net::Domain::hostfqdn()) eq $host ||
#	lc(Net::Domain::hostname()) eq $host;
#    };
#}
#
#sub file
#{
#    undef;
#}
#
#sub dir
#{
#    my $self = shift;
#    $self->file(@_);
#}
#
#1;
### URI/file/FAT.pm ###
#package URI::file::FAT;
#
#use strict;
#use warnings;
#
#use parent 'URI::file::Win32';
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub fix_path
#{
#    shift; 
#    for (@_) {
#	my @p = map uc, split(/\./, $_, -1);
#	return if @p > 2;     
#	@p = ("") unless @p;  
#	$_ = substr($p[0], 0, 8);
#        if (@p > 1) {
#	    my $ext = substr($p[1], 0, 3);
#	    $_ .= ".$ext" if length $ext;
#	}
#    }
#    1;  
#}
#
#1;
### URI/file/Mac.pm ###
#package URI::file::Mac;
#
#use strict;
#use warnings;
#
#use parent 'URI::file::Base';
#
#use URI::Escape qw(uri_unescape);
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub _file_extract_path
#{
#    my $class = shift;
#    my $path = shift;
#
#    my @pre;
#    if ($path =~ s/^(:+)//) {
#	if (length($1) == 1) {
#	    @pre = (".") unless length($path);
#	} else {
#	    @pre = ("..") x (length($1) - 1);
#	}
#    } else { 
#	$pre[0] = "";
#    }
#
#    my $isdir = ($path =~ s/:$//);
#    $path =~ s,([%/;]), URI::Escape::escape_char($1),eg;
#
#    my @path = split(/:/, $path, -1);
#    for (@path) {
#	if ($_ eq "." || $_ eq "..") {
#	    $_ = "%2E" x length($_);
#	}
#	$_ = ".." unless length($_);
#    }
#    push (@path,"") if $isdir;
#    (join("/", @pre, @path), 1);
#}
#
#
#sub file
#{
#    my $class = shift;
#    my $uri = shift;
#    my @path;
#
#    my $auth = $uri->authority;
#    if (defined $auth) {
#	if (lc($auth) ne "localhost" && $auth ne "") {
#	    my $u_auth = uri_unescape($auth);
#	    if (!$class->_file_is_localhost($u_auth)) {
#		@path = ("", $auth);
#	    }
#	}
#    }
#    my @ps = split("/", $uri->path, -1);
#    shift @ps if @path;
#    push(@path, @ps);
#
#    my $pre = "";
#    if (!@path) {
#	return;  
#    } elsif ($path[0] eq "") {
#	shift(@path);
#	if (@path == 1) {
#	    return if $path[0] eq "";  
#	    push(@path, "");           
#	}
#	@ps = @path;
#	@path = ();
#        my $part;
#	for (@ps) {  
#	    next if $_ eq ".";
#	    $part = $_ eq ".." ? "" : $_;
#	    push(@path,$part);
#	}
#	if ($ps[-1] eq "..") {  
#	    push(@path,"");
#	}
#	
#    } else {
#	$pre = ":";
#	@ps = @path;
#	@path = ();
#        my $part;
#	for (@ps) {  
#	    next if $_ eq ".";
#	    $part = $_ eq ".." ? "" : $_;
#	    push(@path,$part);
#	}
#	if ($ps[-1] eq "..") {  
#	    push(@path,"");
#	}
#	
#    }
#    return unless $pre || @path;
#    for (@path) {
#	s/;.*//;  
#	$_ = uri_unescape($_);
#	return if /\0/;
#	return if /:/;  
#    }
#    $pre . join(":", @path);
#}
#
#sub dir
#{
#    my $class = shift;
#    my $path = $class->file(@_);
#    return unless defined $path;
#    $path .= ":" unless $path =~ /:$/;
#    $path;
#}
#
#1;
### URI/file/OS2.pm ###
#package URI::file::OS2;
#
#use strict;
#use warnings;
#
#use parent 'URI::file::Win32';
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#
#sub _file_extract_authority
#{
#    my $class = shift;
#    return $1 if $_[0] =~ s,^\\\\([^\\]+),,;  
#    return $1 if $_[0] =~ s,^//([^/]+),,;     
#
#    if ($_[0] =~ m#^[a-zA-Z]{1,2}:#) {	      
#	return "";
#    }
#    return;
#}
#
#sub file {
#  my $p = &URI::file::Win32::file;
#  return unless defined $p;
#  $p =~ s,\\,/,g;
#  $p;
#}
#
#1;
### URI/file/QNX.pm ###
#package URI::file::QNX;
#
#use strict;
#use warnings;
#
#use parent 'URI::file::Unix';
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub _file_extract_path
#{
#    my($class, $path) = @_;
#    $path =~ s,(.)//+,$1/,g; 
#    $path =~ s,(/\.)+/,/,g;
#    $path = "./$path" if $path =~ m,^[^:/]+:,,; 
#    $path;
#}
#
#1;
### URI/file/Unix.pm ###
#package URI::file::Unix;
#
#use strict;
#use warnings;
#
#use parent 'URI::file::Base';
#
#use URI::Escape qw(uri_unescape);
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub _file_extract_path
#{
#    my($class, $path) = @_;
#
#    $path =~ s,//+,/,g;
#    $path =~ s,(/\.)+/,/,g;
#    $path = "./$path" if $path =~ m,^[^:/]+:,,; 
#
#    return $path;
#}
#
#sub _file_is_absolute {
#    my($class, $path) = @_;
#    return $path =~ m,^/,;
#}
#
#sub file
#{
#    my $class = shift;
#    my $uri = shift;
#    my @path;
#
#    my $auth = $uri->authority;
#    if (defined($auth)) {
#	if (lc($auth) ne "localhost" && $auth ne "") {
#	    $auth = uri_unescape($auth);
#	    unless ($class->_file_is_localhost($auth)) {
#		push(@path, "", "", $auth);
#	    }
#	}
#    }
#
#    my @ps = $uri->path_segments;
#    shift @ps if @path;
#    push(@path, @ps);
#
#    for (@path) {
#	return undef if /\0/;
#	return undef if /\//;  
#    }
#
#    return join("/", @path);
#}
#
#1;
### URI/file/Win32.pm ###
#package URI::file::Win32;
#
#use strict;
#use warnings;
#
#use parent 'URI::file::Base';
#
#use URI::Escape qw(uri_unescape);
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub _file_extract_authority
#{
#    my $class = shift;
#
#    return $class->SUPER::_file_extract_authority($_[0])
#	if defined $URI::file::DEFAULT_AUTHORITY;
#
#    return $1 if $_[0] =~ s,^\\\\([^\\]+),,;  
#    return $1 if $_[0] =~ s,^//([^/]+),,;     
#
#    if ($_[0] =~ s,^([a-zA-Z]:),,) {
#	my $auth = $1;
#	$auth .= "relative" if $_[0] !~ m,^[\\/],;
#	return $auth;
#    }
#    return undef;
#}
#
#sub _file_extract_path
#{
#    my($class, $path) = @_;
#    $path =~ s,\\,/,g;
#    $path =~ s,(/\.)+/,/,g;
#
#    if (defined $URI::file::DEFAULT_AUTHORITY) {
#	$path =~ s,^([a-zA-Z]:),/$1,;
#    }
#
#    return $path;
#}
#
#sub _file_is_absolute {
#    my($class, $path) = @_;
#    return $path =~ m,^[a-zA-Z]:, || $path =~ m,^[/\\],;
#}
#
#sub file
#{
#    my $class = shift;
#    my $uri = shift;
#    my $auth = $uri->authority;
#    my $rel; 
#    if (defined $auth) {
#        $auth = uri_unescape($auth);
#	if ($auth =~ /^([a-zA-Z])[:|](relative)?/) {
#	    $auth = uc($1) . ":";
#	    $rel++ if $2;
#	} elsif (lc($auth) eq "localhost") {
#	    $auth = "";
#	} elsif (length $auth) {
#	    $auth = "\\\\" . $auth;  
#	}
#    } else {
#	$auth = "";
#    }
#
#    my @path = $uri->path_segments;
#    for (@path) {
#	return undef if /\0/;
#	return undef if /\//;
#    }
#    return undef unless $class->fix_path(@path);
#
#    my $path = join("\\", @path);
#    $path =~ s/^\\// if $rel;
#    $path = $auth . $path;
#    $path =~ s,^\\([a-zA-Z])[:|],\u$1:,;
#
#    return $path;
#}
#
#sub fix_path { 1; }
#
#1;
### URI/ftp.pm ###
#package URI::ftp;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent qw(URI::_server URI::_userpass);
#
#sub default_port { 21 }
#
#sub path { shift->path_query(@_) }  
#
#sub _user     { shift->SUPER::user(@_);     }
#sub _password { shift->SUPER::password(@_); }
#
#sub user
#{
#    my $self = shift;
#    my $user = $self->_user(@_);
#    $user = "anonymous" unless defined $user;
#    $user;
#}
#
#sub password
#{
#    my $self = shift;
#    my $pass = $self->_password(@_);
#    unless (defined $pass) {
#	my $user = $self->user;
#	if ($user eq 'anonymous' || $user eq 'ftp') {
#	    $pass = 'anonymous@';
#	}
#    }
#    $pass;
#}
#
#1;
### URI/gopher.pm ###
#package URI::gopher;  
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_server';
#
#use URI::Escape qw(uri_unescape);
#
#
#sub default_port { 70 }
#
#sub _gopher_type
#{
#    my $self = shift;
#    my $path = $self->path_query;
#    $path =~ s,^/,,;
#    my $gtype = $1 if $path =~ s/^(.)//s;
#    if (@_) {
#	my $new_type = shift;
#	if (defined($new_type)) {
#	    Carp::croak("Bad gopher type '$new_type'")
#               unless length($new_type) == 1;
#	    substr($path, 0, 0) = $new_type;
#	    $self->path_query($path);
#	} else {
#	    Carp::croak("Can't delete gopher type when selector is present")
#		if length($path);
#	    $self->path_query(undef);
#	}
#    }
#    return $gtype;
#}
#
#sub gopher_type
#{
#    my $self = shift;
#    my $gtype = $self->_gopher_type(@_);
#    $gtype = "1" unless defined $gtype;
#    $gtype;
#}
#
#sub gtype { goto &gopher_type }  
#
#sub selector { shift->_gfield(0, @_) }
#sub search   { shift->_gfield(1, @_) }
#sub string   { shift->_gfield(2, @_) }
#
#sub _gfield
#{
#    my $self = shift;
#    my $fno  = shift;
#    my $path = $self->path_query;
#
#    $path =~ s/\?/\t/;
#    $path = uri_unescape($path);
#    $path =~ s,^/,,;
#    my $gtype = $1 if $path =~ s,^(.),,s;
#    my @path = split(/\t/, $path, 3);
#    if (@_) {
#	my $new = shift;
#	$path[$fno] = $new;
#	pop(@path) while @path && !defined($path[-1]);
#	for (@path) { $_="" unless defined }
#	$path = $gtype;
#	$path = "1" unless defined $path;
#	$path .= join("\t", @path);
#	$self->path_query($path);
#    }
#    $path[$fno];
#}
#
#1;
### URI/http.pm ###
#package URI::http;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_server';
#
#sub default_port { 80 }
#
#sub canonical
#{
#    my $self = shift;
#    my $other = $self->SUPER::canonical;
#
#    my $slash_path = defined($other->authority) &&
#        !length($other->path) && !defined($other->query);
#
#    if ($slash_path) {
#	$other = $other->clone if $other == $self;
#	$other->path("/");
#    }
#    $other;
#}
#
#1;
### URI/https.pm ###
#package URI::https;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::http';
#
#sub default_port { 443 }
#
#sub secure { 1 }
#
#1;
### URI/ldap.pm ###
#
#package URI::ldap;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent qw(URI::_ldap URI::_server);
#
#sub default_port { 389 }
#
#sub _nonldap_canonical {
#    my $self = shift;
#    $self->URI::_server::canonical(@_);
#}
#
#1;
#
#__END__
#
### URI/ldapi.pm ###
#package URI::ldapi;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent qw(URI::_ldap URI::_generic);
#
#require URI::Escape;
#
#sub un_path {
#    my $self = shift;
#    my $old = URI::Escape::uri_unescape($self->authority);
#    if (@_) {
#	my $p = shift;
#	$p =~ s/:/%3A/g;
#	$p =~ s/\@/%40/g;
#	$self->authority($p);
#    }
#    return $old;
#}
#
#sub _nonldap_canonical {
#    my $self = shift;
#    $self->URI::_generic::canonical(@_);
#}
#
#1;
### URI/ldaps.pm ###
#package URI::ldaps;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::ldap';
#
#sub default_port { 636 }
#
#sub secure { 1 }
#
#1;
### URI/mailto.pm ###
#package URI::mailto;  
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent qw(URI URI::_query);
#
#sub to
#{
#    my $self = shift;
#    my @old = $self->headers;
#    if (@_) {
#	my @new = @old;
#	for (my $i = 0; $i < @new; $i += 2) {
#	    if (lc($new[$i] || '') eq "to") {
#		splice(@new, $i, 2);
#		redo;
#	    }
#	}
#
#	my $to = shift;
#	$to = "" unless defined $to;
#	unshift(@new, "to" => $to);
#	$self->headers(@new);
#    }
#    return unless defined wantarray;
#
#    my @to;
#    while (@old) {
#	my $h = shift @old;
#	my $v = shift @old;
#	push(@to, $v) if lc($h) eq "to";
#    }
#    join(",", @to);
#}
#
#
#sub headers
#{
#    my $self = shift;
#
#    my $opaque = "to=" . $self->opaque;
#    $opaque =~ s/\?/&/;
#
#    if (@_) {
#	my @new = @_;
#
#	my @to;
#	for (my $i=0; $i < @new; $i += 2) {
#	    if (lc($new[$i] || '') eq "to") {
#		push(@to, (splice(@new, $i, 2))[1]);  
#		redo;
#	    }
#	}
#
#	my $new = join(",",@to);
#	$new =~ s/%/%25/g;
#	$new =~ s/\?/%3F/g;
#	$self->opaque($new);
#	$self->query_form(@new) if @new;
#    }
#    return unless defined wantarray;
#
#    URI->new("mailto:?$opaque")->query_form;
#}
#
#1;
### URI/mms.pm ###
#package URI::mms;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::http';
#
#sub default_port { 1755 }
#
#1;
### URI/news.pm ###
#package URI::news;  
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_server';
#
#use URI::Escape qw(uri_unescape);
#use Carp ();
#
#sub default_port { 119 }
#
#
#sub _group
#{
#    my $self = shift;
#    my $old = $self->path;
#    if (@_) {
#	my($group,$from,$to) = @_;
#	if ($group =~ /\@/) {
#            $group =~ s/^<(.*)>$/$1/;  
#	}
#	$group =~ s,%,%25,g;
#	$group =~ s,/,%2F,g;
#	my $path = $group;
#	if (defined $from) {
#	    $path .= "/$from";
#	    $path .= "-$to" if defined $to;
#	}
#	$self->path($path);
#    }
#
#    $old =~ s,^/,,;
#    if ($old !~ /\@/ && $old =~ s,/(.*),, && wantarray) {
#	my $extra = $1;
#	return (uri_unescape($old), split(/-/, $extra));
#    }
#    uri_unescape($old);
#}
#
#
#sub group
#{
#    my $self = shift;
#    if (@_) {
#	Carp::croak("Group name can't contain '\@'") if $_[0] =~ /\@/;
#    }
#    my @old = $self->_group(@_);
#    return if $old[0] =~ /\@/;
#    wantarray ? @old : $old[0];
#}
#
#sub message
#{
#    my $self = shift;
#    if (@_) {
#	Carp::croak("Message must contain '\@'") unless $_[0] =~ /\@/;
#    }
#    my $old = $self->_group(@_);
#    return undef unless $old =~ /\@/;
#    return $old;
#}
#
#1;
### URI/nntp.pm ###
#package URI::nntp;  
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::news';
#
#1;
### URI/pop.pm ###
#package URI::pop;   
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_server';
#
#use URI::Escape qw(uri_unescape);
#
#sub default_port { 110 }
#
#
#sub user
#{
#    my $self = shift;
#    my $old = $self->userinfo;
#
#    if (@_) {
#	my $new_info = $old;
#	$new_info = "" unless defined $new_info;
#	$new_info =~ s/^[^;]*//;
#
#	my $new = shift;
#	if (!defined($new) && !length($new_info)) {
#	    $self->userinfo(undef);
#	} else {
#	    $new = "" unless defined $new;
#	    $new =~ s/%/%25/g;
#	    $new =~ s/;/%3B/g;
#	    $self->userinfo("$new$new_info");
#	}
#    }
#
#    return undef unless defined $old;
#    $old =~ s/;.*//;
#    return uri_unescape($old);
#}
#
#sub auth
#{
#    my $self = shift;
#    my $old = $self->userinfo;
#
#    if (@_) {
#	my $new = $old;
#	$new = "" unless defined $new;
#	$new =~ s/(^[^;]*)//;
#	my $user = $1;
#	$new =~ s/;auth=[^;]*//i;
#
#	
#	my $auth = shift;
#	if (defined $auth) {
#	    $auth =~ s/%/%25/g;
#	    $auth =~ s/;/%3B/g;
#	    $new = ";AUTH=$auth$new";
#	}
#	$self->userinfo("$user$new");
#	
#    }
#
#    return undef unless defined $old;
#    $old =~ s/^[^;]*//;
#    return uri_unescape($1) if $old =~ /;auth=(.*)/i;
#    return;
#}
#
#1;
### URI/rlogin.pm ###
#package URI::rlogin;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_login';
#
#sub default_port { 513 }
#
#1;
### URI/rsync.pm ###
#package URI::rsync;  
#
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent qw(URI::_server URI::_userpass);
#
#sub default_port { 873 }
#
#1;
### URI/rtsp.pm ###
#package URI::rtsp;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::http';
#
#sub default_port { 554 }
#
#1;
### URI/rtspu.pm ###
#package URI::rtspu;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::rtsp';
#
#sub default_port { 554 }
#
#1;
### URI/sftp.pm ###
#package URI::sftp;
#
#use strict;
#use warnings;
#
#use parent 'URI::ssh';
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#1;
### URI/sip.pm ###
#
#package URI::sip;
#
#use strict;
#use warnings;
#
#use parent qw(URI::_server URI::_userpass);
#
#use URI::Escape qw(uri_unescape);
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#sub default_port { 5060 }
#
#sub authority
#{
#    my $self = shift;
#    $$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;
#    my $old = $2;
#
#    if (@_) {
#        my $auth = shift;
#        $$self = defined($1) ? $1 : "";
#        my $rest = $3;
#        if (defined $auth) {
#            $auth =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
#            $$self .= "$auth";
#        }
#        $$self .= $rest;
#    }
#    $old;
#}
#
#sub params_form
#{
#    my $self = shift;
#    $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
#    my $paramstr = $3;
#
#    if (@_) {
#    	my @args = @_; 
#        $$self = $1 . $2;
#        my $rest = $4;
#	my @new;
#	for (my $i=0; $i < @args; $i += 2) {
#	    push(@new, "$args[$i]=$args[$i+1]");
#	}
#	$paramstr = join(";", @new);
#	$$self .= ";" . $paramstr . $rest;
#    }
#    $paramstr =~ s/^;//o;
#    return split(/[;=]/, $paramstr);
#}
#
#sub params
#{
#    my $self = shift;
#    $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
#    my $paramstr = $3;
#
#    if (@_) {
#    	my $new = shift; 
#        $$self = $1 . $2;
#        my $rest = $4;
#	$$self .= $paramstr . $rest;
#    }
#    $paramstr =~ s/^;//o;
#    return $paramstr;
#}
#
#sub path {}
#sub path_query {}
#sub path_segments {}
#sub abs { shift }
#sub rel { shift }
#sub query_keywords {}
#
#1;
### URI/sips.pm ###
#package URI::sips;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::sip';
#
#sub default_port { 5061 }
#
#sub secure { 1 }
#
#1;
### URI/snews.pm ###
#package URI::snews;  
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::news';
#
#sub default_port { 563 }
#
#sub secure { 1 }
#
#1;
### URI/ssh.pm ###
#package URI::ssh;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_login';
#
#
#sub default_port { 22 }
#
#sub secure { 1 }
#
#1;
### URI/telnet.pm ###
#package URI::telnet;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_login';
#
#sub default_port { 23 }
#
#1;
### URI/tn3270.pm ###
#package URI::tn3270;
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::_login';
#
#sub default_port { 23 }
#
#1;
### URI/urn.pm ###
#package URI::urn;  
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI';
#
#use Carp qw(carp);
#
#my %implementor;
#my %require_attempted;
#
#sub _init {
#    my $class = shift;
#    my $self = $class->SUPER::_init(@_);
#    my $nid = $self->nid;
#
#    my $impclass = $implementor{$nid};
#    return $impclass->_urn_init($self, $nid) if $impclass;
#
#    $impclass = "URI::urn";
#    if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/) {
#	my $id = $nid;
#	$id =~ s/-/_/g;
#	$id = "_$id" if $id =~ /^\d/;
#
#	$impclass = "URI::urn::$id";
#	no strict 'refs';
#	unless (@{"${impclass}::ISA"}) {
#            if (not exists $require_attempted{$impclass}) {
#                my $_old_error = $@;
#                eval "require $impclass";
#                die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
#                $@ = $_old_error;
#            }
#	    $impclass = "URI::urn" unless @{"${impclass}::ISA"};
#	}
#    }
#    else {
#	carp("Illegal namespace identifier '$nid' for URN '$self'") if $^W;
#    }
#    $implementor{$nid} = $impclass;
#
#    return $impclass->_urn_init($self, $nid);
#}
#
#sub _urn_init {
#    my($class, $self, $nid) = @_;
#    bless $self, $class;
#}
#
#sub _nid {
#    my $self = shift;
#    my $opaque = $self->opaque;
#    if (@_) {
#	my $v = $opaque;
#	my $new = shift;
#	$v =~ s/[^:]*/$new/;
#	$self->opaque($v);
#    }
#    $opaque =~ s/:.*//s;
#    return $opaque;
#}
#
#sub nid {  
#    my $self = shift;
#    my $nid = $self->_nid(@_);
#    $nid = lc($nid) if defined($nid);
#    return $nid;
#}
#
#sub nss {  
#    my $self = shift;
#    my $opaque = $self->opaque;
#    if (@_) {
#	my $v = $opaque;
#	my $new = shift;
#	if (defined $new) {
#	    $v =~ s/(:|\z).*/:$new/;
#	}
#	else {
#	    $v =~ s/:.*//s;
#	}
#	$self->opaque($v);
#    }
#    return undef unless $opaque =~ s/^[^:]*://;
#    return $opaque;
#}
#
#sub canonical {
#    my $self = shift;
#    my $nid = $self->_nid;
#    my $new = $self->SUPER::canonical;
#    return $new if $nid !~ /[A-Z]/ || $nid =~ /%/;
#    $new = $new->clone if $new == $self;
#    $new->nid(lc($nid));
#    return $new;
#}
#
#1;
### URI/urn/isbn.pm ###
#package URI::urn::isbn;  
#
#use strict;
#use warnings;
#
#use parent 'URI::urn';
#
#use Carp qw(carp);
#
#BEGIN {
#    require Business::ISBN;
#    
#    local $^W = 0; 
#    warn "Using Business::ISBN version " . Business::ISBN->VERSION . 
#        " which is deprecated.\nUpgrade to Business::ISBN version 2\n"
#        if Business::ISBN->VERSION < 2;
#    }
#    
#sub _isbn {
#    my $nss = shift;
#    $nss = $nss->nss if ref($nss);
#    my $isbn = Business::ISBN->new($nss);
#    $isbn = undef if $isbn && !$isbn->is_valid;
#    return $isbn;
#}
#
#sub _nss_isbn {
#    my $self = shift;
#    my $nss = $self->nss(@_);
#    my $isbn = _isbn($nss);
#    $isbn = $isbn->as_string if $isbn;
#    return($nss, $isbn);
#}
#
#sub isbn {
#    my $self = shift;
#    my $isbn;
#    (undef, $isbn) = $self->_nss_isbn(@_);
#    return $isbn;
#}
#
#sub isbn_publisher_code {
#    my $isbn = shift->_isbn || return undef;
#    return $isbn->publisher_code;
#}
#
#BEGIN {
#my $group_method = do {
#    local $^W = 0; 
#    Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code';
#    };
#
#sub isbn_group_code {
#    my $isbn = shift->_isbn || return undef;
#    return $isbn->$group_method;
#}
#}
#
#sub isbn_country_code {
#    my $name = (caller(0))[3]; $name =~ s/.*:://;
#    carp "$name is DEPRECATED. Use isbn_group_code instead";
#    
#    no strict 'refs';
#    &isbn_group_code;
#}
#
#BEGIN {
#my $isbn13_method = do {
#    local $^W = 0; 
#    Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean';
#    };
#
#sub isbn13 {
#    my $isbn = shift->_isbn || return undef;
#    
#    my $thingy = $isbn->$isbn13_method;
#    return eval { $thingy->can( 'as_string' ) } ? $thingy->as_string([]) : $thingy;
#}
#}
#
#sub isbn_as_ean {
#    my $name = (caller(0))[3]; $name =~ s/.*:://;
#    carp "$name is DEPRECATED. Use isbn13 instead";
#
#    no strict 'refs';
#    &isbn13;
#}
#
#sub canonical {
#    my $self = shift;
#    my($nss, $isbn) = $self->_nss_isbn;
#    my $new = $self->SUPER::canonical;
#    return $new unless $nss && $isbn && $nss ne $isbn;
#    $new = $new->clone if $new == $self;
#    $new->nss($isbn);
#    return $new;
#}
#
#1;
### URI/urn/oid.pm ###
#package URI::urn::oid;  
#
#use strict;
#use warnings;
#
#our $VERSION = '1.71';
#$VERSION = eval $VERSION;
#
#use parent 'URI::urn';
#
#sub oid {
#    my $self = shift;
#    my $old = $self->nss;
#    if (@_) {
#	$self->nss(join(".", @_));
#    }
#    return split(/\./, $old) if wantarray;
#    return $old;
#}
#
#1;
### YAML/Old.pm ###
#use strict; use warnings;
#package YAML::Old;
#our $VERSION = '1.07';
#
#use YAML::Old::Mo;
#
#use Exporter;
#push @YAML::Old::ISA, 'Exporter';
#our @EXPORT = qw{ Dump Load };
#our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
#
#use YAML::Old::Node; 
#
#{
#    package
#    YAML;
#    use constant VALUE => "\x07YAML\x07VALUE\x07";
#}
#
#has dumper_class => default => sub {'YAML::Old::Dumper'};
#has loader_class => default => sub {'YAML::Old::Loader'};
#has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
#has loader_object => default => sub {$_[0]->init_action_object("loader")};
#
#sub Dump {
#    my $yaml = YAML::Old->new;
#    $yaml->dumper_class($YAML::Old::DumperClass)
#        if $YAML::Old::DumperClass;
#    return $yaml->dumper_object->dump(@_);
#}
#
#sub Load {
#    my $yaml = YAML::Old->new;
#    $yaml->loader_class($YAML::Old::LoaderClass)
#        if $YAML::Old::LoaderClass;
#    return $yaml->loader_object->load(@_);
#}
#
#{
#    no warnings 'once';
#    *freeze = \ &Dump;
#    *thaw   = \ &Load;
#}
#
#sub DumpFile {
#    my $OUT;
#    my $filename = shift;
#    if (ref $filename eq 'GLOB') {
#        $OUT = $filename;
#    }
#    else {
#        my $mode = '>';
#        if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
#            ($mode, $filename) = ($1, $2);
#        }
#        open $OUT, $mode, $filename
#          or YAML::Old::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!);
#    }
#    binmode $OUT, ':utf8';  
#    local $/ = "\n"; 
#    print $OUT Dump(@_);
#}
#
#sub LoadFile {
#    my $IN;
#    my $filename = shift;
#    if (ref $filename eq 'GLOB') {
#        $IN = $filename;
#    }
#    else {
#        open $IN, '<', $filename
#          or YAML::Old::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
#    }
#    binmode $IN, ':utf8';  
#    return Load(do { local $/; <$IN> });
#}
#
#sub init_action_object {
#    my $self = shift;
#    my $object_class = (shift) . '_class';
#    my $module_name = $self->$object_class;
#    eval "require $module_name";
#    $self->die("Error in require $module_name - $@")
#        if $@ and "$@" !~ /Can't locate/;
#    my $object = $self->$object_class->new;
#    $object->set_global_options;
#    return $object;
#}
#
#my $global = {};
#sub Bless {
#    require YAML::Old::Dumper::Base;
#    YAML::Old::Dumper::Base::bless($global, @_)
#}
#sub Blessed {
#    require YAML::Old::Dumper::Base;
#    YAML::Old::Dumper::Base::blessed($global, @_)
#}
#sub global_object { $global }
#
#1;
### YAML/Old/Dumper.pm ###
#package YAML::Old::Dumper;
#
#use YAML::Old::Mo;
#extends 'YAML::Old::Dumper::Base';
#
#use YAML::Old::Dumper::Base;
#use YAML::Old::Node;
#use YAML::Old::Types;
#
#use constant KEY       => 3;
#use constant BLESSED   => 4;
#use constant FROMARRAY => 5;
#use constant VALUE     => "\x07YAML\x07VALUE\x07";
#
#my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
#my $LIT_CHAR    = '|';
#
#sub dump {
#    my $self = shift;
#    $self->stream('');
#    $self->document(0);
#    for my $document (@_) {
#        $self->{document}++;
#        $self->transferred({});
#        $self->id_refcnt({});
#        $self->id_anchor({});
#        $self->anchor(1);
#        $self->level(0);
#        $self->offset->[0] = 0 - $self->indent_width;
#        $self->_prewalk($document);
#        $self->_emit_header($document);
#        $self->_emit_node($document);
#    }
#    return $self->stream;
#}
#
#sub _emit_header {
#    my $self = shift;
#    my ($node) = @_;
#    if (not $self->use_header and
#        $self->document == 1
#       ) {
#        $self->die('YAML_DUMP_ERR_NO_HEADER')
#          unless ref($node) =~ /^(HASH|ARRAY)$/;
#        $self->die('YAML_DUMP_ERR_NO_HEADER')
#          if ref($node) eq 'HASH' and keys(%$node) == 0;
#        $self->die('YAML_DUMP_ERR_NO_HEADER')
#          if ref($node) eq 'ARRAY' and @$node == 0;
#        $self->headless(1);
#        return;
#    }
#    $self->{stream} .= '---';
#    if ($self->use_version) {
#    }
#}
#
#sub _prewalk {
#    my $self = shift;
#    my $stringify = $self->stringify;
#    my ($class, $type, $node_id) = $self->node_info(\$_[0], $stringify);
#
#    if ($type eq 'GLOB') {
#        $self->transferred->{$node_id} =
#          YAML::Old::Type::glob->yaml_dump($_[0]);
#        $self->_prewalk($self->transferred->{$node_id});
#        return;
#    }
#
#    if (ref($_[0]) eq 'Regexp') {
#        return;
#    }
#
#    if (not ref $_[0]) {
#        $self->{id_refcnt}{$node_id}++ if $self->purity;
#        return;
#    }
#
#    my $value = $_[0];
#    ($class, $type, $node_id) = $self->node_info($value, $stringify);
#
#    return if (ref($value) and not $type);
#
#    if ($self->transferred->{$node_id}) {
#        (undef, undef, $node_id) = (ref $self->transferred->{$node_id})
#          ? $self->node_info($self->transferred->{$node_id}, $stringify)
#          : $self->node_info(\ $self->transferred->{$node_id}, $stringify);
#        $self->{id_refcnt}{$node_id}++;
#        return;
#    }
#
#    if ($type eq 'CODE') {
#        $self->transferred->{$node_id} = 'placeholder';
#        YAML::Old::Type::code->yaml_dump(
#            $self->dump_code,
#            $_[0],
#            $self->transferred->{$node_id}
#        );
#        ($class, $type, $node_id) =
#          $self->node_info(\ $self->transferred->{$node_id}, $stringify);
#        $self->{id_refcnt}{$node_id}++;
#        return;
#    }
#
#    if (defined $class) {
#        if ($value->can('yaml_dump')) {
#            $value = $value->yaml_dump;
#        }
#        elsif ($type eq 'SCALAR') {
#            $self->transferred->{$node_id} = 'placeholder';
#            YAML::Old::Type::blessed->yaml_dump
#              ($_[0], $self->transferred->{$node_id});
#            ($class, $type, $node_id) =
#              $self->node_info(\ $self->transferred->{$node_id}, $stringify);
#            $self->{id_refcnt}{$node_id}++;
#            return;
#        }
#        else {
#            $value = YAML::Old::Type::blessed->yaml_dump($value);
#        }
#        $self->transferred->{$node_id} = $value;
#        (undef, $type, $node_id) = $self->node_info($value, $stringify);
#    }
#
#    require YAML::Old;
#    if (defined YAML::Old->global_object()->{blessed_map}{$node_id}) {
#        $value = YAML::Old->global_object()->{blessed_map}{$node_id};
#        $self->transferred->{$node_id} = $value;
#        ($class, $type, $node_id) = $self->node_info($value, $stringify);
#        $self->_prewalk($value);
#        return;
#    }
#
#    if ($type eq 'REF' or $type eq 'SCALAR') {
#        $value = YAML::Old::Type::ref->yaml_dump($value);
#        $self->transferred->{$node_id} = $value;
#        (undef, $type, $node_id) = $self->node_info($value, $stringify);
#    }
#
#    elsif ($type eq 'GLOB') {
#        my $ref_ynode = $self->transferred->{$node_id} =
#          YAML::Old::Type::ref->yaml_dump($value);
#
#        my $glob_ynode = $ref_ynode->{&VALUE} =
#          YAML::Old::Type::glob->yaml_dump($$value);
#
#        (undef, undef, $node_id) = $self->node_info($glob_ynode, $stringify);
#        $self->transferred->{$node_id} = $glob_ynode;
#        $self->_prewalk($glob_ynode);
#        return;
#    }
#
#    return if ++($self->{id_refcnt}{$node_id}) > 1;
#
#    if ($type eq 'HASH') {
#        $self->_prewalk($value->{$_})
#            for keys %{$value};
#        return;
#    }
#    elsif ($type eq 'ARRAY') {
#        $self->_prewalk($_)
#            for @{$value};
#        return;
#    }
#
#    $self->warn(<<"...");
#YAML::Old::Dumper can't handle dumping this type of data.
#Please report this to the author.
#
#id:    $node_id
#type:  $type
#class: $class
#value: $value
#
#...
#
#    return;
#}
#
#sub _emit_node {
#    my $self = shift;
#    my ($type, $node_id);
#    my $ref = ref($_[0]);
#    if ($ref) {
#        if ($ref eq 'Regexp') {
#            $self->_emit(' !!perl/regexp');
#            $self->_emit_str("$_[0]");
#            return;
#        }
#        (undef, $type, $node_id) = $self->node_info($_[0], $self->stringify);
#    }
#    else {
#        $type = $ref || 'SCALAR';
#        (undef, undef, $node_id) = $self->node_info(\$_[0], $self->stringify);
#    }
#
#    my ($ynode, $tag) = ('') x 2;
#    my ($value, $context) = (@_, 0);
#
#    if (defined $self->transferred->{$node_id}) {
#        $value = $self->transferred->{$node_id};
#        $ynode = ynode($value);
#        if (ref $value) {
#            $tag = defined $ynode ? $ynode->tag->short : '';
#            (undef, $type, $node_id) =
#              $self->node_info($value, $self->stringify);
#        }
#        else {
#            $ynode = ynode($self->transferred->{$node_id});
#            $tag = defined $ynode ? $ynode->tag->short : '';
#            $type = 'SCALAR';
#            (undef, undef, $node_id) =
#              $self->node_info(
#                  \ $self->transferred->{$node_id},
#                  $self->stringify
#              );
#        }
#    }
#    elsif ($ynode = ynode($value)) {
#        $tag = $ynode->tag->short;
#    }
#
#    if ($self->use_aliases) {
#        $self->{id_refcnt}{$node_id} ||= 0;
#        if ($self->{id_refcnt}{$node_id} > 1) {
#            if (defined $self->{id_anchor}{$node_id}) {
#                $self->{stream} .= ' *' . $self->{id_anchor}{$node_id} . "\n";
#                return;
#            }
#            my $anchor = $self->anchor_prefix . $self->{anchor}++;
#            $self->{stream} .= ' &' . $anchor;
#            $self->{id_anchor}{$node_id} = $anchor;
#        }
#    }
#
#    return $self->_emit_str("$value")   
#      if ref($value) and not $type;
#    return $self->_emit_scalar($value, $tag)
#      if $type eq 'SCALAR' and $tag;
#    return $self->_emit_str($value)
#      if $type eq 'SCALAR';
#    return $self->_emit_mapping($value, $tag, $node_id, $context)
#      if $type eq 'HASH';
#    return $self->_emit_sequence($value, $tag)
#      if $type eq 'ARRAY';
#    $self->warn('YAML_DUMP_WARN_BAD_NODE_TYPE', $type);
#    return $self->_emit_str("$value");
#}
#
#sub _emit_mapping {
#    my $self = shift;
#    my ($value, $tag, $node_id, $context) = @_;
#    $self->{stream} .= " !$tag" if $tag;
#
#    my $empty_hash = not(eval {keys %$value});
#    $self->warn('YAML_EMIT_WARN_KEYS', $@) if $@;
#    return ($self->{stream} .= " {}\n") if $empty_hash;
#
#    if ($context == FROMARRAY and
#        $self->compress_series and
#        not (defined $self->{id_anchor}{$node_id} or $tag or $empty_hash)
#       ) {
#        $self->{stream} .= ' ';
#        $self->offset->[$self->level+1] = $self->offset->[$self->level] + 2;
#    }
#    else {
#        $context = 0;
#        $self->{stream} .= "\n"
#          unless $self->headless && not($self->headless(0));
#        $self->offset->[$self->level+1] =
#          $self->offset->[$self->level] + $self->indent_width;
#    }
#
#    $self->{level}++;
#    my @keys;
#    if ($self->sort_keys == 1) {
#        if (ynode($value)) {
#            @keys = keys %$value;
#        }
#        else {
#            @keys = sort keys %$value;
#        }
#    }
#    elsif ($self->sort_keys == 2) {
#        @keys = sort keys %$value;
#    }
#    elsif (ref($self->sort_keys) eq 'ARRAY') {
#        my $i = 1;
#        my %order = map { ($_, $i++) } @{$self->sort_keys};
#        @keys = sort {
#            (defined $order{$a} and defined $order{$b})
#              ? ($order{$a} <=> $order{$b})
#              : ($a cmp $b);
#        } keys %$value;
#    }
#    else {
#        @keys = keys %$value;
#    }
#    if (exists $value->{&VALUE}) {
#        for (my $i = 0; $i < @keys; $i++) {
#            if ($keys[$i] eq &VALUE) {
#                splice(@keys, $i, 1);
#                push @keys, &VALUE;
#                last;
#            }
#        }
#    }
#
#    for my $key (@keys) {
#        $self->_emit_key($key, $context);
#        $context = 0;
#        $self->{stream} .= ':';
#        $self->_emit_node($value->{$key});
#    }
#    $self->{level}--;
#}
#
#sub _emit_sequence {
#    my $self = shift;
#    my ($value, $tag) = @_;
#    $self->{stream} .= " !$tag" if $tag;
#
#    return ($self->{stream} .= " []\n") if @$value == 0;
#
#    $self->{stream} .= "\n"
#      unless $self->headless && not($self->headless(0));
#
#    if ($self->inline_series and
#        @$value <= $self->inline_series and
#        not (scalar grep {ref or /\n/} @$value)
#       ) {
#        $self->{stream} =~ s/\n\Z/ /;
#        $self->{stream} .= '[';
#        for (my $i = 0; $i < @$value; $i++) {
#            $self->_emit_str($value->[$i], KEY);
#            last if $i == $#{$value};
#            $self->{stream} .= ', ';
#        }
#        $self->{stream} .= "]\n";
#        return;
#    }
#
#    $self->offset->[$self->level + 1] =
#      $self->offset->[$self->level] + $self->indent_width;
#    $self->{level}++;
#    for my $val (@$value) {
#        $self->{stream} .= ' ' x $self->offset->[$self->level];
#        $self->{stream} .= '-';
#        $self->_emit_node($val, FROMARRAY);
#    }
#    $self->{level}--;
#}
#
#sub _emit_key {
#    my $self = shift;
#    my ($value, $context) = @_;
#    $self->{stream} .= ' ' x $self->offset->[$self->level]
#      unless $context == FROMARRAY;
#    $self->_emit_str($value, KEY);
#}
#
#sub _emit_scalar {
#    my $self = shift;
#    my ($value, $tag) = @_;
#    $self->{stream} .= " !$tag";
#    $self->_emit_str($value, BLESSED);
#}
#
#sub _emit {
#    my $self = shift;
#    $self->{stream} .= join '', @_;
#}
#
#sub _emit_str {
#    my $self = shift;
#    my $type = $_[1] || 0;
#
#    $self->offset->[$self->level + 1] =
#      $self->offset->[$self->level] + $self->indent_width;
#    $self->{level}++;
#
#    my $sf = $type == KEY ? '' : ' ';
#    my $sb = $type == KEY ? '? ' : ' ';
#    my $ef = $type == KEY ? '' : "\n";
#    my $eb = "\n";
#
#    while (1) {
#        $self->_emit($sf),
#        $self->_emit_plain($_[0]),
#        $self->_emit($ef), last
#          if not defined $_[0];
#        $self->_emit($sf, '=', $ef), last
#          if $_[0] eq VALUE;
#        $self->_emit($sf),
#        $self->_emit_double($_[0]),
#        $self->_emit($ef), last
#          if $_[0] =~ /$ESCAPE_CHAR/;
#        if ($_[0] =~ /\n/) {
#            $self->_emit($sb),
#            $self->_emit_block($LIT_CHAR, $_[0]),
#            $self->_emit($eb), last
#              if $self->use_block;
#              Carp::cluck "[YAML] \$UseFold is no longer supported"
#              if $self->use_fold;
#            $self->_emit($sf),
#            $self->_emit_double($_[0]),
#            $self->_emit($ef), last
#              if length $_[0] <= 30;
#            $self->_emit($sf),
#            $self->_emit_double($_[0]),
#            $self->_emit($ef), last
#              if $_[0] !~ /\n\s*\S/;
#            $self->_emit($sb),
#            $self->_emit_block($LIT_CHAR, $_[0]),
#            $self->_emit($eb), last;
#        }
#        $self->_emit($sf),
#        $self->_emit_plain($_[0]),
#        $self->_emit($ef), last
#          if $self->is_valid_plain($_[0]);
#        $self->_emit($sf),
#        $self->_emit_double($_[0]),
#        $self->_emit($ef), last
#          if $_[0] =~ /'/;
#        $self->_emit($sf),
#        $self->_emit_single($_[0]),
#        $self->_emit($ef);
#        last;
#    }
#
#    $self->{level}--;
#
#    return;
#}
#
#sub is_valid_plain {
#    my $self = shift;
#    return 0 unless length $_[0];
#    return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;
#    return 0 if $_[0] =~ /[\{\[\]\},]/;
#    return 0 if $_[0] =~ /[:\-\?]\s/;
#    return 0 if $_[0] =~ /\s#/;
#    return 0 if $_[0] =~ /\:(\s|$)/;
#    return 0 if $_[0] =~ /[\s\|\>]$/;
#    return 0 if $_[0] eq '-';
#    return 1;
#}
#
#sub _emit_block {
#    my $self = shift;
#    my ($indicator, $value) = @_;
#    $self->{stream} .= $indicator;
#    $value =~ /(\n*)\Z/;
#    my $chomp = length $1 ? (length $1 > 1) ? '+' : '' : '-';
#    $value = '~' if not defined $value;
#    $self->{stream} .= $chomp;
#    $self->{stream} .= $self->indent_width if $value =~ /^\s/;
#    $self->{stream} .= $self->indent($value);
#}
#
#sub _emit_plain {
#    my $self = shift;
#    $self->{stream} .= defined $_[0] ? $_[0] : '~';
#}
#
#sub _emit_double {
#    my $self = shift;
#    (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
#    $self->{stream} .= qq{"$escaped"};
#}
#
#sub _emit_single {
#    my $self = shift;
#    my $item = shift;
#    $item =~ s{'}{''}g;
#    $self->{stream} .= "'$item'";
#}
#
#
#sub indent {
#    my $self = shift;
#    my ($text) = @_;
#    return $text unless length $text;
#    $text =~ s/\n\Z//;
#    my $indent = ' ' x $self->offset->[$self->level];
#    $text =~ s/^/$indent/gm;
#    $text = "\n$text";
#    return $text;
#}
#
#my @escapes = qw(\0   \x01 \x02 \x03 \x04 \x05 \x06 \a
#                 \x08 \t   \n   \v   \f   \r   \x0e \x0f
#                 \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17
#                 \x18 \x19 \x1a \e   \x1c \x1d \x1e \x1f
#                );
#
#sub escape {
#    my $self = shift;
#    my ($text) = @_;
#    $text =~ s/\\/\\\\/g;
#    $text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;
#    return $text;
#}
#
#1;
### YAML/Old/Dumper/Base.pm ###
#package YAML::Old::Dumper::Base;
#
#use YAML::Old::Mo;
#
#use YAML::Old::Node;
#
#has spec_version    => default => sub {'1.0'};
#has indent_width    => default => sub {2};
#has use_header      => default => sub {1};
#has use_version     => default => sub {0};
#has sort_keys       => default => sub {1};
#has anchor_prefix   => default => sub {''};
#has dump_code       => default => sub {0};
#has use_block       => default => sub {0};
#has use_fold        => default => sub {0};
#has compress_series => default => sub {1};
#has inline_series   => default => sub {0};
#has use_aliases     => default => sub {1};
#has purity          => default => sub {0};
#has stringify       => default => sub {0};
#
#has stream      => default => sub {''};
#has document    => default => sub {0};
#has transferred => default => sub {{}};
#has id_refcnt   => default => sub {{}};
#has id_anchor   => default => sub {{}};
#has anchor      => default => sub {1};
#has level       => default => sub {0};
#has offset      => default => sub {[]};
#has headless    => default => sub {0};
#has blessed_map => default => sub {{}};
#
#sub set_global_options {
#    my $self = shift;
#    $self->spec_version($YAML::SpecVersion)
#      if defined $YAML::SpecVersion;
#    $self->indent_width($YAML::Indent)
#      if defined $YAML::Indent;
#    $self->use_header($YAML::UseHeader)
#      if defined $YAML::UseHeader;
#    $self->use_version($YAML::UseVersion)
#      if defined $YAML::UseVersion;
#    $self->sort_keys($YAML::SortKeys)
#      if defined $YAML::SortKeys;
#    $self->anchor_prefix($YAML::AnchorPrefix)
#      if defined $YAML::AnchorPrefix;
#    $self->dump_code($YAML::DumpCode || $YAML::UseCode)
#      if defined $YAML::DumpCode or defined $YAML::UseCode;
#    $self->use_block($YAML::UseBlock)
#      if defined $YAML::UseBlock;
#    $self->use_fold($YAML::UseFold)
#      if defined $YAML::UseFold;
#    $self->compress_series($YAML::CompressSeries)
#      if defined $YAML::CompressSeries;
#    $self->inline_series($YAML::InlineSeries)
#      if defined $YAML::InlineSeries;
#    $self->use_aliases($YAML::UseAliases)
#      if defined $YAML::UseAliases;
#    $self->purity($YAML::Purity)
#      if defined $YAML::Purity;
#    $self->stringify($YAML::Stringify)
#      if defined $YAML::Stringify;
#}
#
#sub dump {
#    my $self = shift;
#    $self->die('dump() not implemented in this class.');
#}
#
#sub blessed {
#    my $self = shift;
#    my ($ref) = @_;
#    $ref = \$_[0] unless ref $ref;
#    my (undef, undef, $node_id) = YAML::Old::Mo::Object->node_info($ref);
#    $self->{blessed_map}->{$node_id};
#}
#
#sub bless {
#    my $self = shift;
#    my ($ref, $blessing) = @_;
#    my $ynode;
#    $ref = \$_[0] unless ref $ref;
#    my (undef, undef, $node_id) = YAML::Old::Mo::Object->node_info($ref);
#    if (not defined $blessing) {
#        $ynode = YAML::Old::Node->new($ref);
#    }
#    elsif (ref $blessing) {
#        $self->die() unless ynode($blessing);
#        $ynode = $blessing;
#    }
#    else {
#        no strict 'refs';
#        my $transfer = $blessing . "::yaml_dump";
#        $self->die() unless defined &{$transfer};
#        $ynode = &{$transfer}($ref);
#        $self->die() unless ynode($ynode);
#    }
#    $self->{blessed_map}->{$node_id} = $ynode;
#    my $object = ynode($ynode) or $self->die();
#    return $object;
#}
#
#1;
### YAML/Old/Error.pm ###
#package YAML::Old::Error;
#
#use YAML::Old::Mo;
#
#has 'code';
#has 'type' => default => sub {'Error'};
#has 'line';
#has 'document';
#has 'arguments' => default => sub {[]};
#
#my ($error_messages, %line_adjust);
#
#sub format_message {
#    my $self = shift;
#    my $output = 'YAML ' . $self->type . ': ';
#    my $code = $self->code;
#    if ($error_messages->{$code}) {
#        $code = sprintf($error_messages->{$code}, @{$self->arguments});
#    }
#    $output .= $code . "\n";
#
#    $output .= '   Code: ' . $self->code . "\n"
#        if defined $self->code;
#    $output .= '   Line: ' . $self->line . "\n"
#        if defined $self->line;
#    $output .= '   Document: ' . $self->document . "\n"
#        if defined $self->document;
#    return $output;
#}
#
#sub error_messages {
#    $error_messages;
#}
#
#%$error_messages = map {s/^\s+//;$_} split "\n", <<'...';
#YAML_PARSE_ERR_BAD_CHARS
#  Invalid characters in stream. This parser only supports printable ASCII
#YAML_PARSE_ERR_NO_FINAL_NEWLINE
#  Stream does not end with newline character
#YAML_PARSE_ERR_BAD_MAJOR_VERSION
#  Can't parse a %s document with a 1.0 parser
#YAML_PARSE_WARN_BAD_MINOR_VERSION
#  Parsing a %s document with a 1.0 parser
#YAML_PARSE_WARN_MULTIPLE_DIRECTIVES
#  '%s directive used more than once'
#YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
#  No text allowed after indicator
#YAML_PARSE_ERR_NO_ANCHOR
#  No anchor for alias '*%s'
#YAML_PARSE_ERR_NO_SEPARATOR
#  Expected separator '---'
#YAML_PARSE_ERR_SINGLE_LINE
#  Couldn't parse single line value
#YAML_PARSE_ERR_BAD_ANCHOR
#  Invalid anchor
#YAML_DUMP_ERR_INVALID_INDENT
#  Invalid Indent width specified: '%s'
#YAML_LOAD_USAGE
#  usage: YAML::Old::Load($yaml_stream_scalar)
#YAML_PARSE_ERR_BAD_NODE
#  Can't parse node
#YAML_PARSE_ERR_BAD_EXPLICIT
#  Unsupported explicit transfer: '%s'
#YAML_DUMP_USAGE_DUMPCODE
#  Invalid value for DumpCode: '%s'
#YAML_LOAD_ERR_FILE_INPUT
#  Couldn't open %s for input:\n%s
#YAML_DUMP_ERR_FILE_CONCATENATE
#  Can't concatenate to YAML file %s
#YAML_DUMP_ERR_FILE_OUTPUT
#  Couldn't open %s for output:\n%s
#YAML_DUMP_ERR_NO_HEADER
#  With UseHeader=0, the node must be a plain hash or array
#YAML_DUMP_WARN_BAD_NODE_TYPE
#  Can't perform serialization for node type: '%s'
#YAML_EMIT_WARN_KEYS
#  Encountered a problem with 'keys':\n%s
#YAML_DUMP_WARN_DEPARSE_FAILED
#  Deparse failed for CODE reference
#YAML_DUMP_WARN_CODE_DUMMY
#  Emitting dummy subroutine for CODE reference
#YAML_PARSE_ERR_MANY_EXPLICIT
#  More than one explicit transfer
#YAML_PARSE_ERR_MANY_IMPLICIT
#  More than one implicit request
#YAML_PARSE_ERR_MANY_ANCHOR
#  More than one anchor
#YAML_PARSE_ERR_ANCHOR_ALIAS
#  Can't define both an anchor and an alias
#YAML_PARSE_ERR_BAD_ALIAS
#  Invalid alias
#YAML_PARSE_ERR_MANY_ALIAS
#  More than one alias
#YAML_LOAD_ERR_NO_CONVERT
#  Can't convert implicit '%s' node to explicit '%s' node
#YAML_LOAD_ERR_NO_DEFAULT_VALUE
#  No default value for '%s' explicit transfer
#YAML_LOAD_ERR_NON_EMPTY_STRING
#  Only the empty string can be converted to a '%s'
#YAML_LOAD_ERR_BAD_MAP_TO_SEQ
#  Can't transfer map as sequence. Non numeric key '%s' encountered.
#YAML_DUMP_ERR_BAD_GLOB
#  '%s' is an invalid value for Perl glob
#YAML_DUMP_ERR_BAD_REGEXP
#  '%s' is an invalid value for Perl Regexp
#YAML_LOAD_ERR_BAD_MAP_ELEMENT
#  Invalid element in map
#YAML_LOAD_WARN_DUPLICATE_KEY
#  Duplicate map key found. Ignoring.
#YAML_LOAD_ERR_BAD_SEQ_ELEMENT
#  Invalid element in sequence
#YAML_PARSE_ERR_INLINE_MAP
#  Can't parse inline map
#YAML_PARSE_ERR_INLINE_SEQUENCE
#  Can't parse inline sequence
#YAML_PARSE_ERR_BAD_DOUBLE
#  Can't parse double quoted string
#YAML_PARSE_ERR_BAD_SINGLE
#  Can't parse single quoted string
#YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
#  Can't parse inline implicit value '%s'
#YAML_PARSE_ERR_BAD_IMPLICIT
#  Unrecognized implicit value '%s'
#YAML_PARSE_ERR_INDENTATION
#  Error. Invalid indentation level
#YAML_PARSE_ERR_INCONSISTENT_INDENTATION
#  Inconsistent indentation level
#YAML_LOAD_WARN_UNRESOLVED_ALIAS
#  Can't resolve alias *%s
#YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
#  No 'REGEXP' element for Perl regexp
#YAML_LOAD_WARN_BAD_REGEXP_ELEM
#  Unknown element '%s' in Perl regexp
#YAML_LOAD_WARN_GLOB_NAME
#  No 'NAME' element for Perl glob
#YAML_LOAD_WARN_PARSE_CODE
#  Couldn't parse Perl code scalar: %s
#YAML_LOAD_WARN_CODE_DEPARSE
#  Won't parse Perl code unless $YAML::LoadCode is set
#YAML_EMIT_ERR_BAD_LEVEL
#  Internal Error: Bad level detected
#YAML_PARSE_WARN_AMBIGUOUS_TAB
#  Amibiguous tab converted to spaces
#YAML_LOAD_WARN_BAD_GLOB_ELEM
#  Unknown element '%s' in Perl glob
#YAML_PARSE_ERR_ZERO_INDENT
#  Can't use zero as an indentation width
#YAML_LOAD_WARN_GLOB_IO
#  Can't load an IO filehandle. Yet!!!
#...
#
#%line_adjust = map {($_, 1)}
#  qw(YAML_PARSE_ERR_BAD_MAJOR_VERSION
#     YAML_PARSE_WARN_BAD_MINOR_VERSION
#     YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
#     YAML_PARSE_ERR_NO_ANCHOR
#     YAML_PARSE_ERR_MANY_EXPLICIT
#     YAML_PARSE_ERR_MANY_IMPLICIT
#     YAML_PARSE_ERR_MANY_ANCHOR
#     YAML_PARSE_ERR_ANCHOR_ALIAS
#     YAML_PARSE_ERR_BAD_ALIAS
#     YAML_PARSE_ERR_MANY_ALIAS
#     YAML_LOAD_ERR_NO_CONVERT
#     YAML_LOAD_ERR_NO_DEFAULT_VALUE
#     YAML_LOAD_ERR_NON_EMPTY_STRING
#     YAML_LOAD_ERR_BAD_MAP_TO_SEQ
#     YAML_LOAD_ERR_BAD_STR_TO_INT
#     YAML_LOAD_ERR_BAD_STR_TO_DATE
#     YAML_LOAD_ERR_BAD_STR_TO_TIME
#     YAML_LOAD_WARN_DUPLICATE_KEY
#     YAML_PARSE_ERR_INLINE_MAP
#     YAML_PARSE_ERR_INLINE_SEQUENCE
#     YAML_PARSE_ERR_BAD_DOUBLE
#     YAML_PARSE_ERR_BAD_SINGLE
#     YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
#     YAML_PARSE_ERR_BAD_IMPLICIT
#     YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
#     YAML_LOAD_WARN_BAD_REGEXP_ELEM
#     YAML_LOAD_WARN_REGEXP_CREATE
#     YAML_LOAD_WARN_GLOB_NAME
#     YAML_LOAD_WARN_PARSE_CODE
#     YAML_LOAD_WARN_CODE_DEPARSE
#     YAML_LOAD_WARN_BAD_GLOB_ELEM
#     YAML_PARSE_ERR_ZERO_INDENT
#    );
#
#package YAML::Old::Warning;
#
#our @ISA = 'YAML::Old::Error';
#
#1;
### YAML/Old/Loader.pm ###
#package YAML::Old::Loader;
#
#use YAML::Old::Mo;
#extends 'YAML::Old::Loader::Base';
#
#use YAML::Old::Loader::Base;
#use YAML::Old::Types;
#
#use constant LEAF       => 1;
#use constant COLLECTION => 2;
#use constant VALUE      => "\x07YAML\x07VALUE\x07";
#use constant COMMENT    => "\x07YAML\x07COMMENT\x07";
#
#my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
#my $FOLD_CHAR   = '>';
#my $LIT_CHAR    = '|';
#my $LIT_CHAR_RX = "\\$LIT_CHAR";
#
#sub load {
#    my $self = shift;
#    $self->stream($_[0] || '');
#    return $self->_parse();
#}
#
#sub _parse {
#    my $self = shift;
#    my (%directives, $preface);
#    $self->{stream} =~ s|\015\012|\012|g;
#    $self->{stream} =~ s|\015|\012|g;
#    $self->line(0);
#    $self->die('YAML_PARSE_ERR_BAD_CHARS')
#      if $self->stream =~ /$ESCAPE_CHAR/;
#    $self->die('YAML_PARSE_ERR_NO_FINAL_NEWLINE')
#      if length($self->stream) and
#         $self->{stream} !~ s/(.)\n\Z/$1/s;
#    $self->lines([split /\x0a/, $self->stream, -1]);
#    $self->line(1);
#    $self->_parse_throwaway_comments();
#    $self->document(0);
#    $self->documents([]);
#    if (not $self->eos) {
#        if ($self->lines->[0] !~ /^---(\s|$)/) {
#            unshift @{$self->lines}, '---';
#            $self->{line}--;
#        }
#    }
#
#    while (not $self->eos) {
#        $self->anchor2node({});
#        $self->{document}++;
#        $self->done(0);
#        $self->level(0);
#        $self->offset->[0] = -1;
#
#        if ($self->lines->[0] =~ /^---\s*(.*)$/) {
#            my @words = split /\s+/, $1;
#            %directives = ();
#            while (@words && $words[0] =~ /^#(\w+):(\S.*)$/) {
#                my ($key, $value) = ($1, $2);
#                shift(@words);
#                if (defined $directives{$key}) {
#                    $self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',
#                      $key, $self->document);
#                    next;
#                }
#                $directives{$key} = $value;
#            }
#            $self->preface(join ' ', @words);
#        }
#        else {
#            $self->die('YAML_PARSE_ERR_NO_SEPARATOR');
#        }
#
#        if (not $self->done) {
#            $self->_parse_next_line(COLLECTION);
#        }
#        if ($self->done) {
#            $self->{indent} = -1;
#            $self->content('');
#        }
#
#        $directives{YAML} ||= '1.0';
#        $directives{TAB} ||= 'NONE';
#        ($self->{major_version}, $self->{minor_version}) =
#          split /\./, $directives{YAML}, 2;
#        $self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION', $directives{YAML})
#          if $self->major_version ne '1';
#        $self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION', $directives{YAML})
#          if $self->minor_version ne '0';
#        $self->die('Unrecognized TAB policy')
#          unless $directives{TAB} =~ /^(NONE|\d+)(:HARD)?$/;
#
#        push @{$self->documents}, $self->_parse_node();
#    }
#    return wantarray ? @{$self->documents} : $self->documents->[-1];
#}
#
#sub _parse_node {
#    my $self = shift;
#    my $preface = $self->preface;
#    $self->preface('');
#    my ($node, $type, $indicator, $escape, $chomp) = ('') x 5;
#    my ($anchor, $alias, $explicit, $implicit, $class) = ('') x 5;
#    ($anchor, $alias, $explicit, $implicit, $preface) =
#      $self->_parse_qualifiers($preface);
#    if ($anchor) {
#        $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
#    }
#    $self->inline('');
#    while (length $preface) {
#        my $line = $self->line - 1;
#        if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
#            $indicator = $1;
#            $chomp = $2 if defined($2);
#        }
#        else {
#            $self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR') if $indicator;
#            $self->inline($preface);
#            $preface = '';
#        }
#    }
#    if ($alias) {
#        $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
#          unless defined $self->anchor2node->{$alias};
#        if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
#            $node = $self->anchor2node->{$alias};
#        }
#        else {
#            $node = do {my $sv = "*$alias"};
#            push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
#        }
#    }
#    elsif (length $self->inline) {
#        $node = $self->_parse_inline(1, $implicit, $explicit);
#        if (length $self->inline) {
#            $self->die('YAML_PARSE_ERR_SINGLE_LINE');
#        }
#    }
#    elsif ($indicator eq $LIT_CHAR) {
#        $self->{level}++;
#        $node = $self->_parse_block($chomp);
#        $node = $self->_parse_implicit($node) if $implicit;
#        $self->{level}--;
#    }
#    elsif ($indicator eq $FOLD_CHAR) {
#        $self->{level}++;
#        $node = $self->_parse_unfold($chomp);
#        $node = $self->_parse_implicit($node) if $implicit;
#        $self->{level}--;
#    }
#    else {
#        $self->{level}++;
#        $self->offset->[$self->level] ||= 0;
#        if ($self->indent == $self->offset->[$self->level]) {
#            if ($self->content =~ /^-( |$)/) {
#                $node = $self->_parse_seq($anchor);
#            }
#            elsif ($self->content =~ /(^\?|\:( |$))/) {
#                $node = $self->_parse_mapping($anchor);
#            }
#            elsif ($preface =~ /^\s*$/) {
#                $node = $self->_parse_implicit('');
#            }
#            else {
#                $self->die('YAML_PARSE_ERR_BAD_NODE');
#            }
#        }
#        else {
#            $node = undef;
#        }
#        $self->{level}--;
#    }
#    $#{$self->offset} = $self->level;
#
#    if ($explicit) {
#        if ($class) {
#            if (not ref $node) {
#                my $copy = $node;
#                undef $node;
#                $node = \$copy;
#            }
#            CORE::bless $node, $class;
#        }
#        else {
#            $node = $self->_parse_explicit($node, $explicit);
#        }
#    }
#    if ($anchor) {
#        if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
#            for my $ref (@{$self->anchor2node->{$anchor}}) {
#                ${$ref->[0]} = $node;
#                $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
#                    $anchor, $ref->[1]);
#            }
#        }
#        $self->anchor2node->{$anchor} = $node;
#    }
#    return $node;
#}
#
#sub _parse_qualifiers {
#    my $self = shift;
#    my ($preface) = @_;
#    my ($anchor, $alias, $explicit, $implicit, $token) = ('') x 5;
#    $self->inline('');
#    while ($preface =~ /^[&*!]/) {
#        my $line = $self->line - 1;
#        if ($preface =~ s/^\!(\S+)\s*//) {
#            $self->die('YAML_PARSE_ERR_MANY_EXPLICIT') if $explicit;
#            $explicit = $1;
#        }
#        elsif ($preface =~ s/^\!\s*//) {
#            $self->die('YAML_PARSE_ERR_MANY_IMPLICIT') if $implicit;
#            $implicit = 1;
#        }
#        elsif ($preface =~ s/^\&([^ ,:]+)\s*//) {
#            $token = $1;
#            $self->die('YAML_PARSE_ERR_BAD_ANCHOR')
#              unless $token =~ /^[a-zA-Z0-9]+$/;
#            $self->die('YAML_PARSE_ERR_MANY_ANCHOR') if $anchor;
#            $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $alias;
#            $anchor = $token;
#        }
#        elsif ($preface =~ s/^\*([^ ,:]+)\s*//) {
#            $token = $1;
#            $self->die('YAML_PARSE_ERR_BAD_ALIAS')
#              unless $token =~ /^[a-zA-Z0-9]+$/;
#            $self->die('YAML_PARSE_ERR_MANY_ALIAS') if $alias;
#            $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $anchor;
#            $alias = $token;
#        }
#    }
#    return ($anchor, $alias, $explicit, $implicit, $preface);
#}
#
#sub _parse_explicit {
#    my $self = shift;
#    my ($node, $explicit) = @_;
#    my ($type, $class);
#    if ($explicit =~ /^\!?perl\/(hash|array|ref|scalar)(?:\:(\w(\w|\:\:)*)?)?$/) {
#        ($type, $class) = (($1 || ''), ($2 || ''));
#
#
#        if ( $type eq "ref" ) {
#            $self->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'XXX', $explicit)
#            unless exists $node->{VALUE()} and scalar(keys %$node) == 1;
#
#            my $value = $node->{VALUE()};
#            $node = \$value;
#        }
#
#        if ( $type eq "scalar" and length($class) and !ref($node) ) {
#            my $value = $node;
#            $node = \$value;
#        }
#
#        if ( length($class) ) {
#            CORE::bless($node, $class);
#        }
#
#        return $node;
#    }
#    if ($explicit =~ m{^!?perl/(glob|regexp|code)(?:\:(\w(\w|\:\:)*)?)?$}) {
#        ($type, $class) = (($1 || ''), ($2 || ''));
#        my $type_class = "YAML::Old::Type::$type";
#        no strict 'refs';
#        if ($type_class->can('yaml_load')) {
#            return $type_class->yaml_load($node, $class, $self);
#        }
#        else {
#            $self->die('YAML_LOAD_ERR_NO_CONVERT', 'XXX', $explicit);
#        }
#    }
#    elsif ($YAML::Old::TagClass->{$explicit} ||
#           $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}
#          ) {
#        $class = $YAML::Old::TagClass->{$explicit} || $2;
#        if ($class->can('yaml_load')) {
#            require YAML::Old::Node;
#            return $class->yaml_load(YAML::Old::Node->new($node, $explicit));
#        }
#        else {
#            if (ref $node) {
#                return CORE::bless $node, $class;
#            }
#            else {
#                return CORE::bless \$node, $class;
#            }
#        }
#    }
#    elsif (ref $node) {
#        require YAML::Old::Node;
#        return YAML::Old::Node->new($node, $explicit);
#    }
#    else {
#        return $node;
#    }
#}
#
#sub _parse_mapping {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $mapping = {};
#    $self->anchor2node->{$anchor} = $mapping;
#    my $key;
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        if ($self->{content} =~ s/^\?\s*//) {
#            $self->preface($self->content);
#            $self->_parse_next_line(COLLECTION);
#            $key = $self->_parse_node();
#            $key = "$key";
#        }
#        elsif ($self->{content} =~ s/^\=\s*//) {
#            $key = VALUE;
#        }
#        elsif ($self->{content} =~ s/^\=\s*//) {
#            $key = COMMENT;
#        }
#        else {
#            $self->inline($self->content);
#            $key = $self->_parse_inline();
#            $key = "$key";
#            $self->content($self->inline);
#            $self->inline('');
#        }
#
#        unless ($self->{content} =~ s/^:\s*//) {
#            $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
#        }
#        $self->preface($self->content);
#        my $line = $self->line;
#        $self->_parse_next_line(COLLECTION);
#        my $value = $self->_parse_node();
#        if (exists $mapping->{$key}) {
#            $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
#        }
#        else {
#            $mapping->{$key} = $value;
#        }
#    }
#    return $mapping;
#}
#
#sub _parse_seq {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $seq = [];
#    $self->anchor2node->{$anchor} = $seq;
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        if ($self->content =~ /^-(?: (.*))?$/) {
#            $self->preface(defined($1) ? $1 : '');
#        }
#        else {
#            $self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT');
#        }
#        if ($self->preface =~ /^(\s*)(\w.*\:(?: |$).*)$/) {
#            $self->indent($self->offset->[$self->level] + 2 + length($1));
#            $self->content($2);
#            $self->level($self->level + 1);
#            $self->offset->[$self->level] = $self->indent;
#            $self->preface('');
#            push @$seq, $self->_parse_mapping('');
#            $self->{level}--;
#            $#{$self->offset} = $self->level;
#        }
#        else {
#            $self->_parse_next_line(COLLECTION);
#            push @$seq, $self->_parse_node();
#        }
#    }
#    return $seq;
#}
#
#sub _parse_inline {
#    my $self = shift;
#    my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
#    $self->{inline} =~ s/^\s*(.*)\s*$/$1/; 
#    my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
#    ($anchor, $alias, $explicit, $implicit, $self->{inline}) =
#      $self->_parse_qualifiers($self->inline);
#    if ($anchor) {
#        $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
#    }
#    $implicit ||= $top_implicit;
#    $explicit ||= $top_explicit;
#    ($top_implicit, $top_explicit) = ('', '');
#    if ($alias) {
#        $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
#          unless defined $self->anchor2node->{$alias};
#        if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
#            $node = $self->anchor2node->{$alias};
#        }
#        else {
#            $node = do {my $sv = "*$alias"};
#            push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
#        }
#    }
#    elsif ($self->inline =~ /^\{/) {
#        $node = $self->_parse_inline_mapping($anchor);
#    }
#    elsif ($self->inline =~ /^\[/) {
#        $node = $self->_parse_inline_seq($anchor);
#    }
#    elsif ($self->inline =~ /^"/) {
#        $node = $self->_parse_inline_double_quoted();
#        $node = $self->_unescape($node);
#        $node = $self->_parse_implicit($node) if $implicit;
#    }
#    elsif ($self->inline =~ /^'/) {
#        $node = $self->_parse_inline_single_quoted();
#        $node = $self->_parse_implicit($node) if $implicit;
#    }
#    else {
#        if ($top) {
#            $node = $self->inline;
#            $self->inline('');
#        }
#        else {
#            $node = $self->_parse_inline_simple();
#        }
#        $node = $self->_parse_implicit($node) unless $explicit;
#    }
#    if ($explicit) {
#        $node = $self->_parse_explicit($node, $explicit);
#    }
#    if ($anchor) {
#        if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
#            for my $ref (@{$self->anchor2node->{$anchor}}) {
#                ${$ref->[0]} = $node;
#                $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
#                    $anchor, $ref->[1]);
#            }
#        }
#        $self->anchor2node->{$anchor} = $node;
#    }
#    return $node;
#}
#
#sub _parse_inline_mapping {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $node = {};
#    $self->anchor2node->{$anchor} = $node;
#
#    $self->die('YAML_PARSE_ERR_INLINE_MAP')
#      unless $self->{inline} =~ s/^\{\s*//;
#    while (not $self->{inline} =~ s/^\s*\}//) {
#        my $key = $self->_parse_inline();
#        $self->die('YAML_PARSE_ERR_INLINE_MAP')
#          unless $self->{inline} =~ s/^\: \s*//;
#        my $value = $self->_parse_inline();
#        if (exists $node->{$key}) {
#            $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
#        }
#        else {
#            $node->{$key} = $value;
#        }
#        next if $self->inline =~ /^\s*\}/;
#        $self->die('YAML_PARSE_ERR_INLINE_MAP')
#          unless $self->{inline} =~ s/^\,\s*//;
#    }
#    return $node;
#}
#
#sub _parse_inline_seq {
#    my $self = shift;
#    my ($anchor) = @_;
#    my $node = [];
#    $self->anchor2node->{$anchor} = $node;
#
#    $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
#      unless $self->{inline} =~ s/^\[\s*//;
#    while (not $self->{inline} =~ s/^\s*\]//) {
#        my $value = $self->_parse_inline();
#        push @$node, $value;
#        next if $self->inline =~ /^\s*\]/;
#        $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
#          unless $self->{inline} =~ s/^\,\s*//;
#    }
#    return $node;
#}
#
#sub _parse_inline_double_quoted {
#    my $self = shift;
#    my $node;
#    if ($self->inline =~ /^"((?:(?:\\"|[^"]){0,32766}){0,32766})"\s*(.*)$/) {
#        $node = $1;
#        $self->inline($2);
#        $node =~ s/\\"/"/g;
#    }
#    else {
#        $self->die('YAML_PARSE_ERR_BAD_DOUBLE');
#    }
#    return $node;
#}
#
#
#sub _parse_inline_single_quoted {
#    my $self = shift;
#    my $node;
#    if ($self->inline =~ /^'((?:(?:''|[^']){0,32766}){0,32766})'\s*(.*)$/) {
#        $node = $1;
#        $self->inline($2);
#        $node =~ s/''/'/g;
#    }
#    else {
#        $self->die('YAML_PARSE_ERR_BAD_SINGLE');
#    }
#    return $node;
#}
#
#sub _parse_inline_simple {
#    my $self = shift;
#    my $value;
#    if ($self->inline =~ /^(|[^!@#%^&*].*?)(?=[\[\]\{\},]|, |: |- |:\s*$|$)/) {
#        $value = $1;
#        substr($self->{inline}, 0, length($1)) = '';
#    }
#    else {
#        $self->die('YAML_PARSE_ERR_BAD_INLINE_IMPLICIT', $value);
#    }
#    return $value;
#}
#
#sub _parse_implicit {
#    my $self = shift;
#    my ($value) = @_;
#    $value =~ s/\s*$//;
#    return $value if $value eq '';
#    return undef if $value =~ /^~$/;
#    return $value
#      unless $value =~ /^[\@\`\^]/ or
#             $value =~ /^[\-\?]\s/;
#    $self->die('YAML_PARSE_ERR_BAD_IMPLICIT', $value);
#}
#
#sub _parse_unfold {
#    my $self = shift;
#    my ($chomp) = @_;
#    my $node = '';
#    my $space = 0;
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        $node .= $self->content. "\n";
#        $self->_parse_next_line(LEAF);
#    }
#    $node =~ s/^(\S.*)\n(?=\S)/$1 /gm;
#    $node =~ s/^(\S.*)\n(\n+\S)/$1$2/gm;
#    $node =~ s/\n*\Z// unless $chomp eq '+';
#    $node .= "\n" unless $chomp;
#    return $node;
#}
#
#sub _parse_block {
#    my $self = shift;
#    my ($chomp) = @_;
#    my $node = '';
#    while (not $self->done and $self->indent == $self->offset->[$self->level]) {
#        $node .= $self->content . "\n";
#        $self->_parse_next_line(LEAF);
#    }
#    return $node if '+' eq $chomp;
#    $node =~ s/\n*\Z/\n/;
#    $node =~ s/\n\Z// if $chomp eq '-';
#    return $node;
#}
#
#sub _parse_throwaway_comments {
#    my $self = shift;
#    while (@{$self->lines} and
#           $self->lines->[0] =~ m{^\s*(\#|$)}
#          ) {
#        shift @{$self->lines};
#        $self->{line}++;
#    }
#    $self->eos($self->{done} = not @{$self->lines});
#}
#
#sub _parse_next_line {
#    my $self = shift;
#    my ($type) = @_;
#    my $level = $self->level;
#    my $offset = $self->offset->[$level];
#    $self->die('YAML_EMIT_ERR_BAD_LEVEL') unless defined $offset;
#    shift @{$self->lines};
#    $self->eos($self->{done} = not @{$self->lines});
#    return if $self->eos;
#    $self->{line}++;
#
#    if ($self->preface =~
#        qr/(?:^|\s)(?:$FOLD_CHAR|$LIT_CHAR_RX)(?:-|\+)?(\d*)\s*$/
#       ) {
#        $self->die('YAML_PARSE_ERR_ZERO_INDENT')
#          if length($1) and $1 == 0;
#        $type = LEAF;
#        if (length($1)) {
#            $self->offset->[$level + 1] = $offset + $1;
#        }
#        else {
#            while (@{$self->lines} && ($self->lines->[0] =~ /^\s*#/)) {
#                $self->lines->[0] =~ /^( *)/ or die;
#                last unless length($1) <= $offset;
#                shift @{$self->lines};
#                $self->{line}++;
#            }
#            $self->eos($self->{done} = not @{$self->lines});
#            return if $self->eos;
#            if ($self->lines->[0] =~ /^( *)\S/ and length($1) > $offset) {
#                $self->offset->[$level+1] = length($1);
#            }
#            else {
#                $self->offset->[$level+1] = $offset + 1;
#            }
#        }
#        $offset = $self->offset->[++$level];
#    }
#    elsif ($type == COLLECTION and
#           $self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/) {
#        $self->_parse_throwaway_comments();
#        if ($self->eos) {
#            $self->offset->[$level+1] = $offset + 1;
#            return;
#        }
#        else {
#            $self->lines->[0] =~ /^( *)\S/ or die;
#            if (length($1) > $offset) {
#                $self->offset->[$level+1] = length($1);
#            }
#            else {
#                $self->offset->[$level+1] = $offset + 1;
#            }
#        }
#        $offset = $self->offset->[++$level];
#    }
#
#    if ($type == LEAF) {
#        while (@{$self->lines} and
#               $self->lines->[0] =~ m{^( *)(\#)} and
#               length($1) < $offset
#              ) {
#            shift @{$self->lines};
#            $self->{line}++;
#        }
#        $self->eos($self->{done} = not @{$self->lines});
#    }
#    else {
#        $self->_parse_throwaway_comments();
#    }
#    return if $self->eos;
#
#    if ($self->lines->[0] =~ /^---(\s|$)/) {
#        $self->done(1);
#        return;
#    }
#    if ($type == LEAF and
#        $self->lines->[0] =~ /^ {$offset}(.*)$/
#       ) {
#        $self->indent($offset);
#        $self->content($1);
#    }
#    elsif ($self->lines->[0] =~ /^\s*$/) {
#        $self->indent($offset);
#        $self->content('');
#    }
#    else {
#        $self->lines->[0] =~ /^( *)(\S.*)$/;
#        while ($self->offset->[$level] > length($1)) {
#            $level--;
#        }
#        $self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
#          if $self->offset->[$level] != length($1);
#        $self->indent(length($1));
#        $self->content($2);
#    }
#    $self->die('YAML_PARSE_ERR_INDENTATION')
#      if $self->indent - $offset > 1;
#}
#
#
#my %unescapes = (
#   0 => "\x00",
#   a => "\x07",
#   t => "\x09",
#   n => "\x0a",
#   'v' => "\x0b", 
#   f => "\x0c",
#   r => "\x0d",
#   e => "\x1b",
#   '\\' => '\\',
#  );
#
#sub _unescape {
#    my $self = shift;
#    my ($node) = @_;
#    $node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/
#              (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;
#    return $node;
#}
#
#1;
### YAML/Old/Loader/Base.pm ###
#package YAML::Old::Loader::Base;
#
#use YAML::Old::Mo;
#
#has load_code     => default => sub {0};
#has stream        => default => sub {''};
#has document      => default => sub {0};
#has line          => default => sub {0};
#has documents     => default => sub {[]};
#has lines         => default => sub {[]};
#has eos           => default => sub {0};
#has done          => default => sub {0};
#has anchor2node   => default => sub {{}};
#has level         => default => sub {0};
#has offset        => default => sub {[]};
#has preface       => default => sub {''};
#has content       => default => sub {''};
#has indent        => default => sub {0};
#has major_version => default => sub {0};
#has minor_version => default => sub {0};
#has inline        => default => sub {''};
#
#sub set_global_options {
#    my $self = shift;
#    $self->load_code($YAML::LoadCode || $YAML::UseCode)
#      if defined $YAML::LoadCode or defined $YAML::UseCode;
#}
#
#sub load {
#    die 'load() not implemented in this class.';
#}
#
#1;
### YAML/Old/Marshall.pm ###
#use strict; use warnings;
#package YAML::Old::Marshall;
#
#use YAML::Old::Node ();
#
#sub import {
#    my $class = shift;
#    no strict 'refs';
#    my $package = caller;
#    unless (grep { $_ eq $class} @{$package . '::ISA'}) {
#        push @{$package . '::ISA'}, $class;
#    }
#
#    my $tag = shift;
#    if ( $tag ) {
#        no warnings 'once';
#        $YAML::Old::TagClass->{$tag} = $package;
#        ${$package . "::YamlTag"} = $tag;
#    }
#}
#
#sub yaml_dump {
#    my $self = shift;
#    no strict 'refs';
#    my $tag = ${ref($self) . "::YamlTag"} || 'perl/' . ref($self);
#    $self->yaml_node($self, $tag);
#}
#
#sub yaml_load {
#    my ($class, $node) = @_;
#    if (my $ynode = $class->yaml_ynode($node)) {
#        $node = $ynode->{NODE};
#    }
#    bless $node, $class;
#}
#
#sub yaml_node {
#    shift;
#    YAML::Old::Node->new(@_);
#}
#
#sub yaml_ynode {
#    shift;
#    YAML::Old::Node::ynode(@_);
#}
#
#1;
### YAML/Old/Mo.pm ###
#package YAML::Old::Mo;
#
#no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{bless{@_[1..$#_]},$_[0]};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;$a{default}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$a{default}->(@_):$m->(@_)}}};my$i=\&import;*{$M.import}=sub{(@_==2 and not $_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};@f=qw[builder default import];use strict;use warnings;
#
#our $DumperModule = 'Data::Dumper';
#
#my ($_new_error, $_info, $_scalar_info);
#
#no strict 'refs';
#*{$M.'Object::die'} = sub {
#    my $self = shift;
#    my $error = $self->$_new_error(@_);
#    $error->type('Error');
#    Carp::croak($error->format_message);
#};
#
#*{$M.'Object::warn'} = sub {
#    my $self = shift;
#    return unless $^W;
#    my $error = $self->$_new_error(@_);
#    $error->type('Warning');
#    Carp::cluck($error->format_message);
#};
#
#*{$M.'Object::node_info'} = sub {
#    my $self = shift;
#    my $stringify = $_[1] || 0;
#    my ($class, $type, $id) =
#        ref($_[0])
#        ? $stringify
#          ? &$_info("$_[0]")
#          : do {
#              require overload;
#              my @info = &$_info(overload::StrVal($_[0]));
#              if (ref($_[0]) eq 'Regexp') {
#                  @info[0, 1] = (undef, 'REGEXP');
#              }
#              @info;
#          }
#        : &$_scalar_info($_[0]);
#    ($class, $type, $id) = &$_scalar_info("$_[0]")
#        unless $id;
#    return wantarray ? ($class, $type, $id) : $id;
#};
#
#$_info = sub {
#    return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o);
#};
#
#$_scalar_info = sub {
#    my $id = 'undef';
#    if (defined $_[0]) {
#        \$_[0] =~ /\((\w+)\)$/o or CORE::die();
#        $id = "$1-S";
#    }
#    return (undef, undef, $id);
#};
#
#$_new_error = sub {
#    require Carp;
#    my $self = shift;
#    require YAML::Old::Error;
#
#    my $code = shift || 'unknown error';
#    my $error = YAML::Old::Error->new(code => $code);
#    $error->line($self->line) if $self->can('line');
#    $error->document($self->document) if $self->can('document');
#    $error->arguments([@_]);
#    return $error;
#};
#
#1;
### YAML/Old/Node.pm ###
#use strict; use warnings;
#package YAML::Old::Node;
#
#use YAML::Old::Tag;
#require YAML::Old::Mo;
#
#use Exporter;
#our @ISA     = qw(Exporter YAML::Old::Mo::Object);
#our @EXPORT  = qw(ynode);
#
#sub ynode {
#    my $self;
#    if (ref($_[0]) eq 'HASH') {
#        $self = tied(%{$_[0]});
#    }
#    elsif (ref($_[0]) eq 'ARRAY') {
#        $self = tied(@{$_[0]});
#    }
#    elsif (ref(\$_[0]) eq 'GLOB') {
#        $self = tied(*{$_[0]});
#    }
#    else {
#        $self = tied($_[0]);
#    }
#    return (ref($self) =~ /^yaml_/) ? $self : undef;
#}
#
#sub new {
#    my ($class, $node, $tag) = @_;
#    my $self;
#    $self->{NODE} = $node;
#    my (undef, $type) = YAML::Old::Mo::Object->node_info($node);
#    $self->{KIND} = (not defined $type) ? 'scalar' :
#                    ($type eq 'ARRAY') ? 'sequence' :
#                    ($type eq 'HASH') ? 'mapping' :
#                    $class->die("Can't create YAML::Old::Node from '$type'");
#    tag($self, ($tag || ''));
#    if ($self->{KIND} eq 'scalar') {
#        yaml_scalar->new($self, $_[1]);
#        return \ $_[1];
#    }
#    my $package = "yaml_" . $self->{KIND};
#    $package->new($self)
#}
#
#sub node { $_->{NODE} }
#sub kind { $_->{KIND} }
#sub tag {
#    my ($self, $value) = @_;
#    if (defined $value) {
#               $self->{TAG} = YAML::Old::Tag->new($value);
#        return $self;
#    }
#    else {
#       return $self->{TAG};
#    }
#}
#sub keys {
#    my ($self, $value) = @_;
#    if (defined $value) {
#               $self->{KEYS} = $value;
#        return $self;
#    }
#    else {
#       return $self->{KEYS};
#    }
#}
#
#package
#yaml_scalar;
#
#@yaml_scalar::ISA = qw(YAML::Old::Node);
#
#sub new {
#    my ($class, $self) = @_;
#    tie $_[2], $class, $self;
#}
#
#sub TIESCALAR {
#    my ($class, $self) = @_;
#    bless $self, $class;
#    $self
#}
#
#sub FETCH {
#    my ($self) = @_;
#    $self->{NODE}
#}
#
#sub STORE {
#    my ($self, $value) = @_;
#    $self->{NODE} = $value
#}
#
#package
#yaml_sequence;
#
#@yaml_sequence::ISA = qw(YAML::Old::Node);
#
#sub new {
#    my ($class, $self) = @_;
#    my $new;
#    tie @$new, $class, $self;
#    $new
#}
#
#sub TIEARRAY {
#    my ($class, $self) = @_;
#    bless $self, $class
#}
#
#sub FETCHSIZE {
#    my ($self) = @_;
#    scalar @{$self->{NODE}};
#}
#
#sub FETCH {
#    my ($self, $index) = @_;
#    $self->{NODE}[$index]
#}
#
#sub STORE {
#    my ($self, $index, $value) = @_;
#    $self->{NODE}[$index] = $value
#}
#
#sub undone {
#    die "Not implemented yet"; 
#}
#
#*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
#*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
#*undone; 
#
#package
#yaml_mapping;
#
#@yaml_mapping::ISA = qw(YAML::Old::Node);
#
#sub new {
#    my ($class, $self) = @_;
#    @{$self->{KEYS}} = sort keys %{$self->{NODE}};
#    my $new;
#    tie %$new, $class, $self;
#    $new
#}
#
#sub TIEHASH {
#    my ($class, $self) = @_;
#    bless $self, $class
#}
#
#sub FETCH {
#    my ($self, $key) = @_;
#    if (exists $self->{NODE}{$key}) {
#        return (grep {$_ eq $key} @{$self->{KEYS}})
#               ? $self->{NODE}{$key} : undef;
#    }
#    return $self->{HASH}{$key};
#}
#
#sub STORE {
#    my ($self, $key, $value) = @_;
#    if (exists $self->{NODE}{$key}) {
#        $self->{NODE}{$key} = $value;
#    }
#    elsif (exists $self->{HASH}{$key}) {
#        $self->{HASH}{$key} = $value;
#    }
#    else {
#        if (not grep {$_ eq $key} @{$self->{KEYS}}) {
#            push(@{$self->{KEYS}}, $key);
#        }
#        $self->{HASH}{$key} = $value;
#    }
#    $value
#}
#
#sub DELETE {
#    my ($self, $key) = @_;
#    my $return;
#    if (exists $self->{NODE}{$key}) {
#        $return = $self->{NODE}{$key};
#    }
#    elsif (exists $self->{HASH}{$key}) {
#        $return = delete $self->{NODE}{$key};
#    }
#    for (my $i = 0; $i < @{$self->{KEYS}}; $i++) {
#        if ($self->{KEYS}[$i] eq $key) {
#            splice(@{$self->{KEYS}}, $i, 1);
#        }
#    }
#    return $return;
#}
#
#sub CLEAR {
#    my ($self) = @_;
#    @{$self->{KEYS}} = ();
#    %{$self->{HASH}} = ();
#}
#
#sub FIRSTKEY {
#    my ($self) = @_;
#    $self->{ITER} = 0;
#    $self->{KEYS}[0]
#}
#
#sub NEXTKEY {
#    my ($self) = @_;
#    $self->{KEYS}[++$self->{ITER}]
#}
#
#sub EXISTS {
#    my ($self, $key) = @_;
#    exists $self->{NODE}{$key}
#}
#
#1;
### YAML/Old/Tag.pm ###
#use strict; use warnings;
#package YAML::Old::Tag;
#
#use overload '""' => sub { ${$_[0]} };
#
#sub new {
#    my ($class, $self) = @_;
#    bless \$self, $class
#}
#
#sub short {
#    ${$_[0]}
#}
#
#sub canonical {
#    ${$_[0]}
#}
#
#1;
### YAML/Old/Types.pm ###
#package YAML::Old::Types;
#
#use YAML::Old::Mo;
#use YAML::Old::Node;
#
#package YAML::Old::Type::blessed;
#
#use YAML::Old::Mo; 
#
#sub yaml_dump {
#    my $self = shift;
#    my ($value) = @_;
#    my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
#    no strict 'refs';
#    my $kind = lc($type) . ':';
#    my $tag = ${$class . '::ClassTag'} ||
#              "!perl/$kind$class";
#    if ($type eq 'REF') {
#        YAML::Old::Node->new(
#            {(&YAML::VALUE, ${$_[0]})}, $tag
#        );
#    }
#    elsif ($type eq 'SCALAR') {
#        $_[1] = $$value;
#        YAML::Old::Node->new($_[1], $tag);
#    } else {
#        YAML::Old::Node->new($value, $tag);
#    }
#}
#
#package YAML::Old::Type::undef;
#
#sub yaml_dump {
#    my $self = shift;
#}
#
#sub yaml_load {
#    my $self = shift;
#}
#
#package YAML::Old::Type::glob;
#
#sub yaml_dump {
#    my $self = shift;
#    my $ynode = YAML::Old::Node->new({}, '!perl/glob:');
#    for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
#        my $value = *{$_[0]}{$type};
#        $value = $$value if $type eq 'SCALAR';
#        if (defined $value) {
#            if ($type eq 'IO') {
#                my @stats = qw(device inode mode links uid gid rdev size
#                               atime mtime ctime blksize blocks);
#                undef $value;
#                $value->{stat} = YAML::Old::Node->new({});
#                if ($value->{fileno} = fileno(*{$_[0]})) {
#                    local $^W;
#                    map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
#                    $value->{tell} = tell(*{$_[0]});
#                }
#            }
#            $ynode->{$type} = $value;
#        }
#    }
#    return $ynode;
#}
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class, $loader) = @_;
#    my ($name, $package);
#    if (defined $node->{NAME}) {
#        $name = $node->{NAME};
#        delete $node->{NAME};
#    }
#    else {
#        $loader->warn('YAML_LOAD_WARN_GLOB_NAME');
#        return undef;
#    }
#    if (defined $node->{PACKAGE}) {
#        $package = $node->{PACKAGE};
#        delete $node->{PACKAGE};
#    }
#    else {
#        $package = 'main';
#    }
#    no strict 'refs';
#    if (exists $node->{SCALAR}) {
#        *{"${package}::$name"} = \$node->{SCALAR};
#        delete $node->{SCALAR};
#    }
#    for my $elem (qw(ARRAY HASH CODE IO)) {
#        if (exists $node->{$elem}) {
#            if ($elem eq 'IO') {
#                $loader->warn('YAML_LOAD_WARN_GLOB_IO');
#                delete $node->{IO};
#                next;
#            }
#            *{"${package}::$name"} = $node->{$elem};
#            delete $node->{$elem};
#        }
#    }
#    for my $elem (sort keys %$node) {
#        $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem);
#    }
#    return *{"${package}::$name"};
#}
#
#package YAML::Old::Type::code;
#
#my $dummy_warned = 0;
#my $default = '{ "DUMMY" }';
#
#sub yaml_dump {
#    my $self = shift;
#    my $code;
#    my ($dumpflag, $value) = @_;
#    my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
#    my $tag = "!perl/code";
#    $tag .= ":$class" if defined $class;
#    if (not $dumpflag) {
#        $code = $default;
#    }
#    else {
#        bless $value, "CODE" if $class;
#        eval { use B::Deparse };
#        return if $@;
#        my $deparse = B::Deparse->new();
#        eval {
#            local $^W = 0;
#            $code = $deparse->coderef2text($value);
#        };
#        if ($@) {
#            warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED() if $^W;
#            $code = $default;
#        }
#        bless $value, $class if $class;
#        chomp $code;
#        $code .= "\n";
#    }
#    $_[2] = $code;
#    YAML::Old::Node->new($_[2], $tag);
#}
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class, $loader) = @_;
#    if ($loader->load_code) {
#        my $code = eval "package main; sub $node";
#        if ($@) {
#            $loader->warn('YAML_LOAD_WARN_PARSE_CODE', $@);
#            return sub {};
#        }
#        else {
#            CORE::bless $code, $class if $class;
#            return $code;
#        }
#    }
#    else {
#        return CORE::bless sub {}, $class if $class;
#        return sub {};
#    }
#}
#
#package YAML::Old::Type::ref;
#
#sub yaml_dump {
#    my $self = shift;
#    YAML::Old::Node->new({(&YAML::VALUE, ${$_[0]})}, '!perl/ref')
#}
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class, $loader) = @_;
#    $loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'ptr')
#      unless exists $node->{&YAML::VALUE};
#    return \$node->{&YAML::VALUE};
#}
#
#package YAML::Old::Type::regexp;
#
#sub yaml_dump {
#    die "YAML::Old::Type::regexp::yaml_dump not currently implemented";
#}
#
#use constant _QR_TYPES => {
#    '' => sub { qr{$_[0]} },
#    x => sub { qr{$_[0]}x },
#    i => sub { qr{$_[0]}i },
#    s => sub { qr{$_[0]}s },
#    m => sub { qr{$_[0]}m },
#    ix => sub { qr{$_[0]}ix },
#    sx => sub { qr{$_[0]}sx },
#    mx => sub { qr{$_[0]}mx },
#    si => sub { qr{$_[0]}si },
#    mi => sub { qr{$_[0]}mi },
#    ms => sub { qr{$_[0]}sm },
#    six => sub { qr{$_[0]}six },
#    mix => sub { qr{$_[0]}mix },
#    msx => sub { qr{$_[0]}msx },
#    msi => sub { qr{$_[0]}msi },
#    msix => sub { qr{$_[0]}msix },
#};
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class) = @_;
#    return qr{$node} unless $node =~ /^\(\?([\^\-xism]*):(.*)\)\z/s;
#    my ($flags, $re) = ($1, $2);
#    $flags =~ s/-.*//;
#    $flags =~ s/^\^//;
#    my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
#    my $qr = &$sub($re);
#    bless $qr, $class if length $class;
#    return $qr;
#}
#
#1;
### experimental.pm ###
#package experimental;
#$experimental::VERSION = '0.016';
#use strict;
#use warnings;
#use version ();
#
#use feature ();
#use Carp qw/croak carp/;
#
#my %warnings = map { $_ => 1 } grep { /^experimental::/ } keys %warnings::Offsets;
#my %features = map { $_ => 1 } $] > 5.015006 ? keys %feature::feature : do {
#	my @features;
#	if ($] >= 5.010) {
#		push @features, qw/switch say state/;
#		push @features, 'unicode_strings' if $] > 5.011002;
#	}
#	@features;
#};
#
#my %min_version = (
#	array_base      => '5',
#	autoderef       => '5.14.0',
#	bitwise         => '5.22.0',
#	current_sub     => '5.16.0',
#	evalbytes       => '5.16.0',
#	fc              => '5.16.0',
#	lexical_topic   => '5.10.0',
#	lexical_subs    => '5.18.0',
#	postderef       => '5.20.0',
#	postderef_qq    => '5.20.0',
#	refaliasing     => '5.22.0',
#	regex_sets      => '5.18.0',
#	say             => '5.10.0',
#	smartmatch      => '5.10.0',
#	signatures      => '5.20.0',
#	state           => '5.10.0',
#	switch          => '5.10.0',
#	unicode_eval    => '5.16.0',
#	unicode_strings => '5.12.0',
#);
#my %max_version = (
#	lexical_topic   => '5.23.4',
#);
#
#$_ = version->new($_) for values %min_version;
#$_ = version->new($_) for values %max_version;
#
#my %additional = (
#	postderef  => ['postderef_qq'],
#	switch     => ['smartmatch'],
#);
#
#sub _enable {
#	my $pragma = shift;
#	if ($warnings{"experimental::$pragma"}) {
#		warnings->unimport("experimental::$pragma");
#		feature->import($pragma) if exists $features{$pragma};
#		_enable(@{ $additional{$pragma} }) if $additional{$pragma};
#	}
#	elsif ($features{$pragma}) {
#		feature->import($pragma);
#		_enable(@{ $additional{$pragma} }) if $additional{$pragma};
#	}
#	elsif (not exists $min_version{$pragma}) {
#		croak "Can't enable unknown feature $pragma";
#	}
#	elsif ($] < $min_version{$pragma}) {
#		my $stable = $min_version{$pragma};
#		if ($stable->{version}[1] % 2) {
#			$stable = version->new(
#				"5.".($stable->{version}[1]+1).'.0'
#			);
#		}
#		croak "Need perl $stable or later for feature $pragma";
#	}
#	elsif ($] >= ($max_version{$pragma} || 7)) {
#		croak "Experimental feature $pragma has been removed from perl in version $max_version{$pragma}";
#	}
#}
#
#sub import {
#	my ($self, @pragmas) = @_;
#
#	for my $pragma (@pragmas) {
#		_enable($pragma);
#	}
#	return;
#}
#
#sub _disable {
#	my $pragma = shift;
#	if ($warnings{"experimental::$pragma"}) {
#		warnings->import("experimental::$pragma");
#		feature->unimport($pragma) if exists $features{$pragma};
#		_disable(@{ $additional{$pragma} }) if $additional{$pragma};
#	}
#	elsif ($features{$pragma}) {
#		feature->unimport($pragma);
#		_disable(@{ $additional{$pragma} }) if $additional{$pragma};
#	}
#	elsif (not exists $min_version{$pragma}) {
#		carp "Can't disable unknown feature $pragma, ignoring";
#	}
#}
#
#sub unimport {
#	my ($self, @pragmas) = @_;
#
#	for my $pragma (@pragmas) {
#		_disable($pragma);
#	}
#	return;
#}
#
#1;
#
#
#__END__
#
