#!perl

### code_after_shebang
# Note: This script is a CLI for Riap function /App/ZodiacUtils/chinese_zodiac_of
# and generated automatically using Perinci::CmdLine::Gen version 0.491

# PERICMD_INLINE_SCRIPT: {"allow_prereq":["DateTime"],"code_after_shebang":"...","config_dirs":null,"config_filename":"chinese-zodiac-of.conf","env_name":"CHINESE_ZODIAC_OF_OPT","include":null,"log":null,"pack_deps":1,"pod":0,"read_config":1,"read_env":1,"script_name":"chinese-zodiac-of","script_summary":null,"script_version":"0.113","shebang":"perl","skip_format":0,"subcommands":null,"url":"/App/ZodiacUtils/chinese_zodiac_of","use_cleanser":1,"validate_args":1}

my $_pci_metas = {""=>{args=>{dates=>{greedy=>1,pos=>0,req=>1,schema=>["array",{min_len=>1,of=>["date",{req=>1,"x.perl.coerce_rules"=>["From_str::natural"],"x.perl.coerce_to"=>"DateTime"},{}],req=>1},{}],summary=>"Dates","x.name.is_plural"=>1}},examples=>[{args=>{dates=>["1980-02-17"]},result=>"monkey (metal)"},{args=>{dates=>["2015-12-17","2016-12-17"]},result=>[["2015-12-17","goat (wood)"],["2016-12-17","monkey (fire)"]],summary=>"Multiple dates",test=>0}],result=>{},result_naked=>1,summary=>"Show Chinese zodiac for a date",v=>1.1}};

# This script is generated by Perinci::CmdLine::Inline version 0.545 on Fri Jan 31 11:36:32 2020.

# Rinci metadata taken from these modules: App::ZodiacUtils (no version)

# You probably should not manually edit this file.

our $DATE = '2020-01-31'; # DATE
our $VERSION = '0.113'; # VERSION
# PODNAME: chinese-zodiac-of
# ABSTRACT: Show Chinese zodiac for a date

# 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

package main;
use 5.010001;
use strict;
#use warnings;

# modules


### declare global variables

our $_pci_meta_result_stream = 0;
our $_pci_meta_result_type;
our $_pci_meta_result_type_is_simple;
our $_pci_meta_skip_format = 0;
our $_pci_r = {naked_res=>0,read_config=>1,read_env=>1,subcommand_name=>""};
our %_pci_args;

### declare subroutines

sub _pci_err {
    my $res = shift;
    print STDERR "ERROR $res->[0]: $res->[1]\n";
    exit $res->[0]-300;
}

sub _pci_json {
    state $json = do {
        if (eval { require JSON::XS; 1 }) { JSON::XS->new->canonical(1)->allow_nonref }
        else { require JSON::PP; JSON::PP->new->canonical(1)->allow_nonref }
    };
    $json;
}

### get arguments (from config file, env, command-line args

{
my %mentioned_args;
require Getopt::Long::EvenLess;
my $go_spec1 = {
    'config-path=s@' => sub { $_pci_r->{config_paths} //= []; push @{ $_pci_r->{config_paths} }, $_[1]; },
    'config-profile=s' => sub { $_pci_r->{config_profile} = $_[1]; },
    'format=s' => sub { $_pci_r->{format} = $_[1]; },
    'help|h|?' => sub { print "chinese-zodiac-of - Show Chinese zodiac for a date\n\nUsage:\n  chinese-zodiac-of --help (or -h, -?)\n  chinese-zodiac-of --version (or -v)\n  chinese-zodiac-of [options] <dates> ...\n\nExamples:\n\n  % chinese-zodiac-of 1980-02-17\n\n  Multiple dates:\n  % chinese-zodiac-of 2015-12-17 2016-12-17\n\nMain options:\n  --date=s\@*  Dates (=arg[0-])\n\nConfiguration options:\n  --config-path=s     Set path to configuration file\n  --config-profile=s  Set configuration profile to use\n  --no-config         Do not use any configuration file\n\nEnvironment options:\n  --no-env  Do not read environment for default options\n\nOutput options:\n  --format=s  Choose output format, e.g. json, text\n  --json      Set output format to json\n\nOther options:\n  --help, -h, -?                 Display help message and exit\n  --naked-res                    When outputing as JSON, strip result envelope\n  --no-naked-res, --nonaked-res  When outputing as JSON, don't strip result envelope\n  --version, -v                  Display program's version and exit\n"; exit 0; },
    'json' => sub { $_pci_r->{format} = (-t STDOUT) ? "json-pretty" : "json"; },
    'naked-res' => sub { $_pci_r->{naked_res} = 1; },
    'no-config' => sub { $_pci_r->{read_config} = 0; },
    'no-env' => sub { $_pci_r->{read_env} = 0; },
    'no-naked-res|nonaked-res' => sub { $_pci_r->{naked_res} = 0; },
    'version|v' => sub { no warnings 'once'; require App::ZodiacUtils; print "chinese-zodiac-of version ", "0.113", ($App::ZodiacUtils::DATE ? " ($App::ZodiacUtils::DATE)" : ''), "\n"; print "  Generated by Perinci::CmdLine::Inline version 0.545 (2019-04-15)\n"; exit 0 },
};
my $go_spec2 = {
    'config-path=s@' => sub {  },
    'config-profile=s' => sub {  },
    'date=s@' => sub {         if ($mentioned_args{'dates'}++) { push @{ $_pci_args{'dates'} }, $_[1] } else { $_pci_args{'dates'} = [$_[1]] }
 },
    'dates-json=s' => sub {         $_pci_args{'dates'} = _pci_json()->decode($_[1]);
 },
    'format=s' => sub {  },
    'help|h|?' => sub {  },
    'json' => sub {  },
    'naked-res' => sub {  },
    'no-config' => sub {  },
    'no-env' => sub {  },
    'no-naked-res|nonaked-res' => sub {  },
    'version|v' => sub {  },
};
my $old_conf = Getopt::Long::EvenLess::Configure("pass_through");
Getopt::Long::EvenLess::GetOptions(%$go_spec1);
Getopt::Long::EvenLess::Configure($old_conf);
{
  last unless $_pci_r->{read_env};
  my $env = $ENV{"CHINESE_ZODIAC_OF_OPT"};
  last unless defined $env;
  require Complete::Bash;
  my ($words, undef) = @{ Complete::Bash::parse_cmdline($env, 0) };
  unshift @ARGV, @$words;
}
if ($_pci_r->{read_config}) {
  require Perinci::CmdLine::Util::Config;

  my $res = Perinci::CmdLine::Util::Config::read_config(
    config_paths     => $_pci_r->{config_paths},
    config_filename  => "chinese-zodiac-of.conf",
    config_dirs      => undef // ["$ENV{HOME}/.config", $ENV{HOME}, "/etc"],
    program_name     => "chinese-zodiac-of",
  );
  _pci_err($res) unless $res->[0] == 200;
  $_pci_r->{config} = $res->[2];
  $_pci_r->{read_config_files} = $res->[3]{"func.read_files"};
  $_pci_r->{_config_section_read_order} = $res->[3]{"func.section_read_order"}; # we currently dont want to publish this request key

  $res = Perinci::CmdLine::Util::Config::get_args_from_config(
    r                  => $_pci_r,
    config             => $_pci_r->{config},
    args               => \%_pci_args,
    program_name       => "chinese-zodiac-of",
    subcommand_name    => $_pci_r->{subcommand_name},
    config_profile     => $_pci_r->{config_profile},
    common_opts        => {},
    meta               => $_pci_metas->{ $_pci_r->{subcommand_name} },
    meta_is_normalized => 1,
  );
  die $res unless $res->[0] == 200;
  my $found = $res->[3]{"func.found"};
  if (defined($_pci_r->{config_profile}) && !$found && defined($_pci_r->{read_config_files}) && @{$_pci_r->{read_config_files}} && !$_pci_r->{ignore_missing_config_profile_section}) {
    _pci_err([412, "Profile '$_pci_r->{config_profile}' not found in configuration file"]);
  }
}
my $res = Getopt::Long::EvenLess::GetOptions(%$go_spec2);
_pci_err([500, "GetOptions failed"]) unless $res;
}

### check arguments

{
require Local::_pci_check_args; my $res = _pci_check_args(\%_pci_args);
_pci_err($res) if $res->[0] != 200;
$_pci_r->{args} = \%_pci_args;
}

### call function

{
my $sc_name = $_pci_r->{subcommand_name};
if ($sc_name eq "") {
    $_pci_meta_result_type = "";
    require App::ZodiacUtils;
    eval { $_pci_r->{res} = App::ZodiacUtils::chinese_zodiac_of(%_pci_args) };
    if ($@) { $_pci_r->{res} = [500, "Function died: $@"] }
    $_pci_r->{res} = [200, "OK (envelope added by Perinci::CmdLine::Inline)", $_pci_r->{res}];
}
}

### format & display result

{
my $fres;
my $save_res; if (exists $_pci_r->{res}[3]{"cmdline.result"}) { $save_res = $_pci_r->{res}[2]; $_pci_r->{res}[2] = $_pci_r->{res}[3]{"cmdline.result"} }
my $is_success = $_pci_r->{res}[0] =~ /\A2/ || $_pci_r->{res}[0] == 304;
my $is_stream = $_pci_r->{res}[3]{stream} // $_pci_meta_result_stream // 0;
if ($is_success && (0 || $_pci_meta_skip_format || $_pci_r->{res}[3]{"cmdline.skip_format"})) { $fres = $_pci_r->{res}[2] }
elsif ($is_success && $is_stream) {}
else { require Local::_pci_clean_json; require Perinci::Result::Format::Lite; $is_stream=0; _pci_clean_json($_pci_r->{res}); $fres = Perinci::Result::Format::Lite::format($_pci_r->{res}, ($_pci_r->{format} // $_pci_r->{res}[3]{"cmdline.default_format"} // "text"), $_pci_r->{naked_res}, 0) }

my $use_utf8 = $_pci_r->{res}[3]{"x.hint.result_binary"} ? 0 : 0;
if ($use_utf8) { binmode STDOUT, ":encoding(utf8)" }
if ($is_stream) {
    my $code = $_pci_r->{res}[2]; if (ref($code) ne "CODE") { die "Result is a stream but no coderef provided" } if ($_pci_meta_result_type_is_simple) { while(defined(my $l=$code->())) { print $l; print "\n" unless $_pci_meta_result_type eq "buf"; } } else { while (defined(my $rec=$code->())) { print _pci_json()->encode($rec),"\n" } }
} else {
    print $fres;
}
if (defined $save_res) { $_pci_r->{res}[2] = $save_res }
}

### exit

{
my $status = $_pci_r->{res}[0];
my $exit_code = $_pci_r->{res}[3]{"cmdline.exit_code"} // ($status =~ /200|304/ ? 0 : ($status-300));
exit($exit_code);
}

=pod

=encoding UTF-8

=head1 NAME

chinese-zodiac-of - Show Chinese zodiac for a date

=head1 VERSION

This document describes version 0.113 of main (from Perl distribution App-ZodiacUtils), released on 2020-01-31.

=head1 SYNOPSIS

Usage:

 % chinese-zodiac-of [options] <dates> ...

Examples:

 % chinese-zodiac-of 1980-02-17
 monkey (metal)

Multiple dates:

 % chinese-zodiac-of 2015-12-17 2016-12-17
 +------------+---------------+
 | 2015-12-17 | goat (wood)   |
 | 2016-12-17 | monkey (fire) |
 +------------+---------------+

=head1 OPTIONS

C<*> marks required options.

=head2 Main options

=over

=item B<--date>=I<s@>*

Dates.

Can be specified multiple times.

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

Dates (JSON-encoded).

See C<--date>.

=back

=head2 Configuration options

=over

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

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 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]


=item B<--page-result>

Filter output through a pager.

=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

The script comes with a companion shell completer script (L<_chinese-zodiac-of>)
for this script.

=head2 bash

To activate bash completion for this script, put:

 complete -C _chinese-zodiac-of chinese-zodiac-of

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 chinese-zodiac-of 'p/*/`chinese-zodiac-of`/'

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/chinese-zodiac-of.conf>, F<~/chinese-zodiac-of.conf>, or F</etc/chinese-zodiac-of.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:

 dates (see --date)
 format (see --format)
 naked_res (see --naked-res)

=head1 ENVIRONMENT

=head2 CHINESE_ZODIAC_OF_OPT => str

Specify additional command-line options.

=head1 FILES

F<~/.config/chinese-zodiac-of.conf>

F<~/chinese-zodiac-of.conf>

F</etc/chinese-zodiac-of.conf>

=head1 HOMEPAGE

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

=head1 SOURCE

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

=head1 BUGS

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

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

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2020, 2019, 2016, 2015 by perlancar@cpan.org.

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

=cut

__DATA__
Data::Section::Seekable v1
Clone/PP.pm,20,6331,0;0
Complete/Bash.pm,6376,39376,1;193
Config/IOD/Base.pm,45779,23603,2;1427
Config/IOD/Reader.pm,69411,17366,3;2237
Data/Check/Structure.pm,86809,8606,4;2796
Data/Sah/Normalize.pm,95445,9038,5;3132
Getopt/Long/EvenLess.pm,104515,11364,6;3406
Local/_pci_check_args.pm,115912,4953,7;3788
Local/_pci_clean_json.pm,120898,4414,8;3851
Log/ger.pm,125331,9776,9;3913
Perinci/CmdLine/Util/Config.pm,135146,15677,10;4212
Perinci/Result/Format/Lite.pm,150861,22687,11;4710
Perinci/Sub/Normalize.pm,173581,7303,12;5308
Sah/Schema/rinci/function_meta.pm,180926,5179,13;5543
Text/Table/Tiny.pm,186132,8117,14;5730

### Clone/PP.pm ###
#package Clone::PP;
#
#use 5.006;
#use strict;
#use warnings;
#use vars qw($VERSION @EXPORT_OK);
#use Exporter;
#
#$VERSION = 1.07;
#
#@EXPORT_OK = qw( clone );
#sub import { goto &Exporter::import } # lazy Exporter
#
## These methods can be temporarily overridden to work with a given class.
#use vars qw( $CloneSelfMethod $CloneInitMethod );
#$CloneSelfMethod ||= 'clone_self';
#$CloneInitMethod ||= 'clone_init';
#
## Used to detect looped networks and avoid infinite recursion. 
#use vars qw( %CloneCache );
#
## Generic cloning function
#sub clone {
#  my $source = shift;
#
#  return undef if not defined($source);
#  
#  # Optional depth limit: after a given number of levels, do shallow copy.
#  my $depth = shift;
#  return $source if ( defined $depth and $depth -- < 1 );
#  
#  # Maintain a shared cache during recursive calls, then clear it at the end.
#  local %CloneCache = ( undef => undef ) unless ( exists $CloneCache{undef} );
#  
#  return $CloneCache{ $source } if ( defined $CloneCache{ $source } );
#  
#  # Non-reference values are copied shallowly
#  my $ref_type = ref $source or return $source;
#  
#  # Extract both the structure type and the class name of referent
#  my $class_name;
#  if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
#    $class_name = $ref_type;
#    $ref_type = $1;
#    # Some objects would prefer to clone themselves; check for clone_self().
#    return $CloneCache{ $source } = $source->$CloneSelfMethod() 
#				  if $source->can($CloneSelfMethod);
#  }
#  
#  # To make a copy:
#  # - Prepare a reference to the same type of structure;
#  # - Store it in the cache, to avoid looping if it refers to itself;
#  # - Tie in to the same class as the original, if it was tied;
#  # - Assign a value to the reference by cloning each item in the original;
#  
#  my $copy;
#  if ($ref_type eq 'HASH') {
#    $CloneCache{ $source } = $copy = {};
#    if ( my $tied = tied( %$source ) ) { tie %$copy, ref $tied }
#    %$copy = map { ! ref($_) ? $_ : clone($_, $depth) } %$source;
#  } elsif ($ref_type eq 'ARRAY') {
#    $CloneCache{ $source } = $copy = [];
#    if ( my $tied = tied( @$source ) ) { tie @$copy, ref $tied }
#    @$copy = map { ! ref($_) ? $_ : clone($_, $depth) } @$source;
#  } elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
#    $CloneCache{ $source } = $copy = \( my $var = "" );
#    if ( my $tied = tied( $$source ) ) { tie $$copy, ref $tied }
#    $$copy = clone($$source, $depth);
#  } else {
#    # Shallow copy anything else; this handles a reference to code, glob, regex
#    $CloneCache{ $source } = $copy = $source;
#  }
#  
#  # - Bless it into the same class as the original, if it was blessed;
#  # - If it has a post-cloning initialization method, call it.
#  if ( $class_name ) {
#    bless $copy, $class_name;
#    $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
#  }
#  
#  return $copy;
#}
#
#1;
#
#__END__
#
#=head1 NAME
#
#Clone::PP - Recursively copy Perl datatypes
#
#=head1 SYNOPSIS
#
#  use Clone::PP qw(clone);
#  
#  $item = { 'foo' => 'bar', 'move' => [ 'zig', 'zag' ]  };
#  $copy = clone( $item );
#
#  $item = [ 'alpha', 'beta', { 'gamma' => 'vlissides' } ];
#  $copy = clone( $item );
#
#  $item = Foo->new();
#  $copy = clone( $item );
#
#Or as an object method:
#
#  require Clone::PP;
#  push @Foo::ISA, 'Clone::PP';
#  
#  $item = Foo->new();
#  $copy = $item->clone();
#
#=head1 DESCRIPTION
#
#This module provides a general-purpose clone function to make deep
#copies of Perl data structures. It calls itself recursively to copy
#nested hash, array, scalar and reference types, including tied
#variables and objects.
#
#The clone() function takes a scalar argument to copy. To duplicate
#arrays or hashes, pass them in by reference:
#
#  my $copy = clone(\@array);    my @copy = @{ clone(\@array) };
#  my $copy = clone(\%hash);     my %copy = %{ clone(\%hash) };
#
#The clone() function also accepts an optional second parameter that
#can be used to limit the depth of the copy. If you pass a limit of
#0, clone will return the same value you supplied; for a limit of
#1, a shallow copy is constructed; for a limit of 2, two layers of
#copying are done, and so on.
#
#  my $shallow_copy = clone( $item, 1 );
#
#To allow objects to intervene in the way they are copied, the
#clone() function checks for a couple of optional methods. If an
#object provides a method named C<clone_self>, it is called and the
#result returned without further processing. Alternately, if an
#object provides a method named C<clone_init>, it is called on the
#copied object before it is returned.
#
#=head1 BUGS
#
#Some data types, such as globs, regexes, and code refs, are always copied shallowly.
#
#References to hash elements are not properly duplicated. (This is why two tests in t/dclone.t that are marked "todo".) For example, the following test should succeed but does not:
#
#  my $hash = { foo => 1 }; 
#  $hash->{bar} = \{ $hash->{foo} }; 
#  my $copy = clone( \%hash ); 
#  $hash->{foo} = 2; 
#  $copy->{foo} = 2; 
#  ok( $hash->{bar} == $copy->{bar} );
#
#To report bugs via the CPAN web tracking system, go to 
#C<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Clone-PP> or send mail 
#to C<Dist=Clone-PP#rt.cpan.org>, replacing C<#> with C<@>.
#
#=head1 SEE ALSO
#
#L<Clone> - a baseclass which provides a C<clone()> method.
#
#L<MooseX::Clone> - find-grained cloning for Moose objects.
#
#The C<dclone()> function in L<Storable>.
#
#L<Data::Clone> -
#polymorphic data cloning (see its documentation for what that means).
#
#L<Clone::Any> - use whichever of the cloning methods is available.
#
#=head1 REPOSITORY
#
#L<https://github.com/neilbowers/Clone-PP>
#
#=head1 AUTHOR AND CREDITS
#
#Developed by Matthew Simon Cavalletto at Evolution Softworks. 
#More free Perl software is available at C<www.evoscript.org>.
#
#
#=head1 COPYRIGHT AND LICENSE
#
#Copyright 2003 Matthew Simon Cavalletto. You may contact the author
#directly at C<evo@cpan.org> or C<simonm@cavalletto.org>.
#
#Code initially derived from Ref.pm. Portions Copyright 1994 David Muir Sharnoff.
#
#Interface based by Clone by Ray Finch with contributions from chocolateboy.
#Portions Copyright 2001 Ray Finch. Portions Copyright 2001 chocolateboy. 
#
#You may use, modify, and distribute this software under the same terms as Perl.
#
#=cut
### Complete/Bash.pm ###
#package Complete::Bash;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-01-28'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.334'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       point
#                       parse_cmdline
#                       join_wordbreak_words
#                       format_completion
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
#    my ($user, $slash) = @_;
#    my @ent;
#    if (length $user) {
#        @ent = getpwnam($user);
#    } else {
#        @ent = getpwuid($>);
#        $user = $ent[0];
#    }
#    return $ent[7] . $slash if @ent;
#    "~$user$slash"; # return as-is when failed
#}
#
#sub _add_unquoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word, $after_ws) = @_;
#
#    #say "D:add_unquoted word=$word is_cur_word=$is_cur_word after_ws=$after_ws";
#
#    $word =~ s!^(~)(\w*)(/|\z) |  # 1) tilde  2) username  3) optional slash
#               \\(.)           |  # 4) escaped char
#               \$(\w+)            # 5) variable name
#              !
#                  $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
#                      $4 ? $4 :
#                          ($is_cur_word ? "\$$5" : $ENV{$5})
#                              !egx;
#    $word;
#}
#
#sub _add_double_quoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word) = @_;
#
#    $word =~ s!\\(.)           |  # 1) escaped char
#               \$(\w+)            # 2) variable name
#              !
#                  $1 ? $1 :
#                      ($is_cur_word ? "\$$2" : $ENV{$2})
#                          !egx;
#    $word;
#}
#
#sub _add_single_quoted {
#    my $word = shift;
#    $word =~ s/\\(.)/$1/g;
#    $word;
#}
#
#$SPEC{point} = {
#    v => 1.1,
#    summary => 'Return line with point marked by a marker',
#    description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
#    point("^foo") # => ("foo", 0)
#    point("fo^o") # => ("foo", 2)
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line which contains a marker character',
#            schema => 'str*',
#            pos => 0,
#        },
#        marker => {
#            summary => 'Marker character',
#            schema => ['str*', len=>1],
#            default => '^',
#            pos => 1,
#        },
#    },
#    result_naked => 1,
#};
#sub point {
#    my ($line, $marker) = @_;
#    $marker //= '^';
#
#    my $point = index($line, $marker);
#    die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
#    $line =~ s/\Q$marker\E//;
#    ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
#    v => 1.1,
#    summary => 'Parse shell command-line for processing by completion routines',
#    description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
#    command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
#    ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
#    ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
#   variable substitution for `COMP_WORDS`). However, note that special shell
#   variables that are not environment variables like `$0`, `$_`, `$IFS` will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
#  By default `COMP_WORDBREAKS` is:
#
#    "'@><=;|&(:
#
#  So if raw command-line is:
#
#    command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#  then the parse result will be:
#
#    ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#  which is annoying sometimes. But we follow bash here so we can more easily
#  accept input from a joined `COMP_WORDS` if we write completion bash functions,
#  e.g. (in the example, `foo` is a Perl script):
#
#    _foo ()
#    {
#        local words=(${COMP_CWORDS[@]})
#        # add things to words, etc
#        local point=... # calculate the new point
#        COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
#    }
#
#  To avoid these word-breaking characters to be split/grouped, we can escape
#  them with backslash or quote them, e.g.:
#
#    command "http://example.com:80" Foo\:\:Bar
#
#  which bash will parse as:
#
#    ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
#  and we parse as:
#
#    ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
#  equivalent:
#
#    % cmd --foo=bar
#    % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line, defaults to COMP_LINE environment',
#            schema => 'str*',
#            pos => 0,
#        },
#        point => {
#            summary => 'Point/position to complete in command-line, '.
#                'defaults to COMP_POINT',
#            schema => 'int*',
#            pos => 1,
#        },
#        opts => {
#            summary => 'Options',
#            schema => 'hash*',
#            description => <<'_',
#
#Optional. Known options:
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
#  position of cursor, for example (`^` marks the position of cursor):
#  `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
#  doing tab completion.
#
#_
#            schema => 'hash*',
#            pos => 2,
#        },
#    },
#    result => {
#        schema => ['array*', len=>2],
#        description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in `@ARGV`), you need to strip the first element from
#`$words` and reduce `$cword` by 1.
#
#
#_
#    },
#    result_naked => 1,
#    links => [
#    ],
#};
#sub parse_cmdline {
#    no warnings 'uninitialized';
#    my ($line, $point, $opts) = @_;
#
#    $line  //= $ENV{COMP_LINE};
#    $point //= $ENV{COMP_POINT} // 0;
#
#    die "$0: COMP_LINE not set, make sure this script is run under ".
#        "bash completion (e.g. through complete -C)\n" unless defined $line;
#
#    log_trace "[compbash] line=<$line> point=<$point>"
#        if $ENV{COMPLETE_BASH_TRACE};
#
#    my @words;
#    my $cword;
#    my $pos = 0;
#    my $pos_min_ws = 0;
#    my $after_ws = 1; # XXX what does this variable mean?
#    my $chunk;
#    my $add_blank;
#    my $is_cur_word;
#    $line =~ s!(                                                         # 1) everything
#                  (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*)               |  #  2) open "  3) content  4) space after
#                  (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*)               |  #  5) open '  6) content  7) space after
#                  ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) |  #  8) unquoted word  9) space after
#                  ([\@><=|&\(:]+) |                                      #  10) non-whitespace word-breaking characters
#                  \s+
#              )!
#                  $pos += length($1);
#                  #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
#                  #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
#                  if ($2 || $5 || defined($8)) {
#                      # double-quoted/single-quoted/unquoted chunk
#
#                      if (not(defined $cword)) {
#                          $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
#                          #say "D:pos_min_ws=$pos_min_ws";
#                          if ($point <= $pos_min_ws) {
#                              $cword = @words - ($after_ws ? 0 : 1);
#                          } elsif ($point < $pos) {
#                              $cword = @words + 1 - ($after_ws ? 0 : 1);
#                              $add_blank = 1;
#                          }
#                      }
#
#                      if ($after_ws) {
#                          $is_cur_word = defined($cword) && $cword==@words;
#                      } else {
#                          $is_cur_word = defined($cword) && $cword==@words-1;
#                      }
#                      #say "D:is_cur_word=$is_cur_word";
#                      $chunk =
#                          $2 ? _add_double_quoted($3, $is_cur_word) :
#                              $5 ? _add_single_quoted($6) :
#                              _add_unquoted($8, $is_cur_word, $after_ws);
#                      if ($opts && $opts->{truncate_current_word} &&
#                              $is_cur_word && $pos > $point) {
#                          $chunk = substr(
#                              $chunk, 0, length($chunk)-($pos_min_ws-$point));
#                          #say "D:truncating current word to <$chunk>";
#                      }
#                      if ($after_ws) {
#                          push @words, $chunk;
#                      } else {
#                          $words[-1] .= $chunk;
#                      }
#                      if ($add_blank) {
#                          push @words, '';
#                          $add_blank = 0;
#                      }
#                      $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
#
#                  } elsif ($10) {
#                      # non-whitespace word-breaking characters
#                      push @words, $10;
#                      $after_ws = 1;
#                  } else {
#                      # whitespace
#                      $after_ws = 1;
#                  }
#    !egx;
#
#    $cword //= @words;
#    $words[$cword] //= '';
#
#    log_trace "[compbash] words=%s, cword=%s", \@words, $cword
#        if $ENV{COMPLETE_BASH_TRACE};
#
#    [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
#    v => 1.1,
#    summary => 'Post-process parse_cmdline() result by joining some words',
#    description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
#    "'@><=;|&(:
#
#So if command-line is:
#
#    command -MData::Dump bob@example.org
#
#then they will be parsed as:
#
#    ["command", "-MData", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
#    ["command", "-MData::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
#    my ($words, $cword) = @_;
#    my $new_words = [];
#    my $i = -1;
#    while (++$i < @$words) {
#        my $w = $words->[$i];
#        if ($w =~ /\A[\@=:]+\z/) {
#            if (@$new_words and $#$new_words != $cword) {
#                $new_words->[-1] .= $w;
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            } else {
#                push @$new_words, $w;
#            }
#            if ($i+1 < @$words) {
#                $i++;
#                $new_words->[-1] .= $words->[$i];
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            }
#        } else {
#            push @$new_words, $w;
#        }
#    }
#    [$new_words, $cword];
#}
#
#sub _terminal_width {
#    # XXX need to cache?
#    if (eval { require Term::Size; 1 }) {
#        my ($cols, undef) = Term::Size::chars(*STDOUT{IO});
#        $cols // 80;
#    } else {
#        $ENV{COLUMNS} // 80;
#    }
#}
#
## given terminal width & number of columns, calculate column width
#sub _column_width {
#    my ($terminal_width, $num_columns) = @_;
#    if (defined $num_columns && $num_columns > 0) {
#        int( ($terminal_width - ($num_columns-1)*2) / $num_columns ) - 1;
#    } else {
#        undef;
#    }
#}
#
## given terminal width & column width, calculate number of columns
#sub _num_columns {
#    my ($terminal_width, $column_width) = @_;
#    my $n = int( ($terminal_width+2) / ($column_width+2) );
#    $n >= 1 ? $n : 1;
#}
#
#$SPEC{format_completion} = {
#    v => 1.1,
#    summary => 'Format completion for output (for shell)',
#    description => <<'_',
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the `Complete`
#POD. Aside from `words`, this function also recognizes these keys:
#
#_
#    args_as => 'array',
#    args => {
#        completion => {
#            summary => 'Completion answer structure',
#            description => <<'_',
#
#Either an array or hash. See function description for more details.
#
#_
#            schema=>['any*' => of => ['hash*', 'array*']],
#            req=>1,
#            pos=>0,
#        },
#        opts => {
#            summary => 'Specify options',
#            schema=>'hash*',
#            pos=>1,
#            description => <<'_',
#
#Known options:
#
#* as
#
#  Either `string` (the default) or `array` (to return array of lines instead of
#  the lines joined together). Returning array is useful if you are doing
#  completion inside `Term::ReadLine`, for example, where the library expects an
#  array.
#
#* esc_mode
#
#  Escaping mode for entries. Either `default` (most nonalphanumeric characters
#  will be escaped), `shellvar` (like `default`, but dollar sign `$` will also be
#  escaped, convenient when completing environment variables for example),
#  `filename` (currently equals to `default`), `option` (currently equals to
#  `default`), or `none` (no escaping will be done).
#
#* word
#
#  A workaround. String. For now, see source code for more details.
#
#* show_summaries
#
#  Whether to show item's summaries. Boolean, default is from
#  COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
#  An answer item contain summary, which is a short description about the item,
#  e.g.:
#
#      [{word=>"-a"    , summary=>"Show hidden files"},
#       {word=>"-l"    , summary=>"Show details"},
#       {word=>"--sort", summary=>"Specify sort order"}],
#
#  When summaries are not shown, user will just be seeing something like:
#
#      -a
#      -l
#      --sort
#
#  But when summaries are shown, user will see:
#
#      -a         -- Show hidden files
#      -l         -- Show details
#      --sort     -- Specify sort order
#
#  which is quite helpful.
#
#* workaround_with_wordbreaks
#
#  Boolean. Default is true. See source code for more details.
#
#_
#
#        },
#    },
#    result => {
#        summary => 'Formatted string (or array, if `as` is set to `array`)',
#        schema => ['any*' => of => ['str*', 'array*']],
#    },
#    result_naked => 1,
#};
#sub format_completion {
#    my ($hcomp, $opts) = @_;
#
#    $opts //= {};
#
#    $hcomp = {words=>$hcomp} unless ref($hcomp) eq 'HASH';
#    my $words    = $hcomp->{words};
#    my $as       = $opts->{as} // 'string';
#    # 'escmode' key is deprecated (Complete 0.11-) and will be removed later
#    my $esc_mode = $opts->{esc_mode} // $ENV{COMPLETE_BASH_DEFAULT_ESC_MODE} //
#        'default';
#    my $path_sep = $hcomp->{path_sep};
#
#    # we keep the original words (before formatted with summaries) when we want
#    # to use fzf instead of passing to bash directly
#    my @words;
#    my @summaries;
#    my @res;
#    my $has_summary;
#
#    my $code_return_message = sub {
#        # display a message instead of list of words. we send " " (ASCII space)
#        # which bash does not display, so we can display a line of message while
#        # the user does not get the message as the completion. I've also tried
#        # \000 to \037 instead of space (\040) but nothing works better.
#        my $msg = shift;
#        if ($msg =~ /\A /) {
#            $msg =~ s/\A +//;
#            $msg = " (empty message)" unless length $msg;
#        }
#        return (sprintf("%-"._terminal_width()."s", $msg), " ");
#    };
#
#  FORMAT_MESSAGE:
#    # display a message instead of list of words. we send " " (ASCII space)
#    # which bash does not display, so we can display a line of message while the
#    # user does not get the message as the completion. I've also tried \000 to
#    # \037 instead of space (\040) but nothing works better.
#    if (defined $hcomp->{message}) {
#        @res = $code_return_message->($hcomp->{message});
#        goto RETURN_RES;
#    }
#
#  WORKAROUND_PREVENT_BASH_FROM_INSERTING_SPACE:
#    {
#        last unless @$words == 1;
#        if (defined $path_sep) {
#            my $re = qr/\Q$path_sep\E\z/;
#            my $word;
#            if (ref $words->[0] eq 'HASH') {
#                $words = [$words->[0], {word=>"$words->[0]{word} "}] if
#                    $words->[0]{word} =~ $re;
#            } else {
#                $words = [$words->[0], "$words->[0] "]
#                    if $words->[0] =~ $re;
#            }
#            last;
#        }
#
#        if ($hcomp->{is_partial} ||
#                ref $words->[0] eq 'HASH' && $words->[0]{is_partial}) {
#            if (ref $words->[0] eq 'HASH') {
#                $words = [$words->[0], {word=>"$words->[0]{word} "}];
#            } else {
#                $words = [$words->[0], "$words->[0] "];
#            }
#            last;
#        }
#    }
#
#  WORKAROUND_WITH_WORDBREAKS:
#    # this is a workaround. since bash breaks words using characters in
#    # $COMP_WORDBREAKS, which by default is "'@><=;|&(: this presents a problem
#    # we often encounter: if we want to provide with a list of strings
#    # containing say ':', most often Perl modules/packages, if user types e.g.
#    # "Text::AN" and we provide completion ["Text::ANSI"] then bash will change
#    # the word at cursor to become "Text::Text::ANSI" since it sees the current
#    # word as "AN" and not "Text::AN". the workaround is to chop /^Text::/ from
#    # completion answers. btw, we actually chop /^text::/i to handle
#    # case-insensitive matching, although this does not have the ability to
#    # replace the current word (e.g. if we type 'text::an' then bash can only
#    # replace the current word 'an' with 'ANSI).
#    {
#        last unless $opts->{workaround_with_wordbreaks} // 1;
#        last unless defined $opts->{word};
#
#        if ($opts->{word} =~ s/(.+[\@><=;|&\(:])//) {
#            my $prefix = $1;
#            for (@$words) {
#                if (ref($_) eq 'HASH') {
#                    $_->{word} =~ s/\A\Q$prefix\E//i;
#                } else {
#                    s/\A\Q$prefix\E//i;
#                }
#            }
#        }
#    }
#
#  ESCAPE_WORDS:
#    for my $entry (@$words) {
#        my $word    = ref($entry) eq 'HASH' ? $entry->{word}    : $entry;
#        my $summary = (ref($entry) eq 'HASH' ? $entry->{summary} : undef) // '';
#        if ($esc_mode eq 'shellvar') {
#            # escape $ also
#            $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
#        } elsif ($esc_mode eq 'none') {
#            # no escaping
#        } else {
#            # default
#            $word =~ s!([^A-Za-z0-9,+._/:\$~-])!\\$1!g;
#        }
#        push @words, $word;
#        push @summaries, $summary;
#        $has_summary = 1 if length $summary;
#    }
#
#    my $summary_align = $ENV{COMPLETE_BASH_SUMMARY_ALIGN} // 'left';
#    my $max_columns = $ENV{COMPLETE_BASH_MAX_COLUMNS} // 0;
#    my $terminal_width = _terminal_width();
#    my $column_width = _column_width($terminal_width, $max_columns);
#
#    #warn "terminal_width=$terminal_width, column_width=".($column_width // 'undef')."\n";
#
#  FORMAT_SUMMARIES: {
#        @res = @words;
#        last if @words <= 1;
#        last unless $has_summary;
#        last unless $opts->{show_summaries} //
#            $ENV{COMPLETE_BASH_SHOW_SUMMARIES} // 1;
#        my $max_entry_width   = 8;
#        my $max_summ_width = 0;
#        for (0..$#words) {
#            $max_entry_width = length $words[$_]
#                if $max_entry_width < length $words[$_];
#            $max_summ_width = length $summaries[$_]
#                if $max_summ_width < length $summaries[$_];
#        }
#        #warn "max_entry_width=$max_entry_width, max_summ_width=$max_summ_width\n";
#        if ($summary_align eq 'right') {
#            # if we are aligning summary to the right, we want to fill column
#            # width width
#            if ($max_columns <= 0) {
#                $max_columns = _num_columns(
#                    $terminal_width, ($max_entry_width + 2 + $max_summ_width));
#            }
#            $column_width = _column_width($terminal_width, $max_columns);
#            my $new_max_summ_width = $column_width - 2 - $max_entry_width;
#            $max_summ_width = $new_max_summ_width
#                if $max_summ_width < $new_max_summ_width;
#            #warn "max_columns=$max_columns, column_width=$column_width, max_summ_width=$max_summ_width\n";
#        }
#
#        for (0..$#words) {
#            my $summary = $summaries[$_];
#            if (length $summary) {
#                $res[$_] = sprintf(
#                    "%-${max_entry_width}s |%".
#                        ($summary_align eq 'right' ? $max_summ_width : '')."s",
#                    $words[$_], $summary);
#            }
#        }
#    } # FORMAT_SUMMARIES
#
#  MAX_COLUMNS: {
#        last unless $max_columns > 0;
#        my $max_entry_width = 0;
#        for (@res) {
#            $max_entry_width = length if $max_entry_width < length;
#        }
#        last if $max_entry_width >= $column_width;
#        for (@res) {
#            $_ .= " " x ($column_width - length) if $column_width > length;
#        }
#    }
#
#  PASS_TO_FZF: {
#        last unless $ENV{COMPLETE_BASH_FZF};
#        my $items = $ENV{COMPLETE_BASH_FZF_ITEMS} // 100;
#        last unless @words >= $items;
#
#        require File::Which;
#        unless (File::Which::which("fzf")) {
#            #@res = $code_return_message->("Cannot find fzf to filter ".
#            #                                  scalar(@words)." items");
#            goto RETURN_RES;
#        }
#
#        require IPC::Open2;
#        local *CHLD_OUT;
#        local *CHLD_IN;
#        my $pid = IPC::Open2::open2(
#            \*CHLD_OUT, \*CHLD_IN, "fzf", "-m", "-d:", "--with-nth=2..")
#            or do {
#                @res = $code_return_message->("Cannot open fzf to filter ".
#                                                  scalar(@words)." items");
#                goto RETURN_RES;
#            };
#
#        print CHLD_IN map { "$_:$res[$_]\n" } 0..$#res;
#        close CHLD_IN;
#
#        my @res_words;
#        while (<CHLD_OUT>) {
#            my ($index) = /\A([0-9]+)\:/ or next;
#            push @res_words, $words[$index];
#        }
#        if (@res_words) {
#            @res = join(" ", @res_words);
#        } else {
#            @res = ();
#        }
#        waitpid($pid, 0);
#    }
#
#  RETURN_RES:
#    #use Data::Dump; warn Data::Dump::dump(\@res);
#    if ($as eq 'array') {
#        return \@res;
#    } else {
#        return join("", map {($_, "\n")} @res);
#    }
#}
#
#1;
## ABSTRACT: Completion routines for bash shell
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Bash - Completion routines for bash shell
#
#=head1 VERSION
#
#This document describes version 0.334 of Complete::Bash (from Perl distribution Complete-Bash), released on 2020-01-28.
#
#=head1 DESCRIPTION
#
#This module provides routines related to tab completion in bash shell.
#
#=head2 About programmable completion in bash
#
#Bash allows completion to come from various sources. The simplest is from a list
#of words (C<-W>):
#
# % complete -W "one two three four" somecmd
# % somecmd t<Tab>
# two  three
#
#Another source is from a bash function (C<-F>). The function will receive input
#in two variables: C<COMP_WORDS> (array, command-line chopped into words) and
#C<COMP_CWORD> (integer, index to the array of words indicating the cursor
#position). It must set an array variable C<COMPREPLY> that contains the list of
#possible completion:
#
# % _foo()
# {
#   local cur
#   COMPREPLY=()
#   cur=${COMP_WORDS[COMP_CWORD]}
#   COMPREPLY=($( compgen -W '--help --verbose --version' -- $cur ) )
# }
# % complete -F _foo foo
# % foo <Tab>
# --help  --verbose  --version
#
#And yet another source is an external command (C<-C>) including, from a Perl
#script. The command receives two environment variables: C<COMP_LINE> (string,
#raw command-line) and C<COMP_POINT> (integer, cursor location). Program must
#split C<COMP_LINE> into words, find the word to be completed, complete that, and
#return the list of words one per-line to STDOUT. An example:
#
# % cat foo-complete
# #!/usr/bin/perl
# use Complete::Bash qw(parse_cmdline format_completion);
# use Complete::Util qw(complete_array_elem);
# my ($words, $cword) = @{ parse_cmdline() };
# my $res = complete_array_elem(array=>[qw/--help --verbose --version/], word=>$words->[$cword]);
# print format_completion($res);
#
# % complete -C foo-complete foo
# % foo --v<Tab>
# --verbose --version
#
#=head2 About the routines in this module
#
#First of all, C<parse_cmdline()> is the function to parse raw command-line (such
#as what you get from bash in C<COMP_LINE> environment variable) into words. This
#makes it easy for the other functions to generate completion answer. See the
#documentation for that function for more details.
#
#C<format_completion()> is what you use to format completion answer structure for
#bash.
#
#=head1 FUNCTIONS
#
#
#=head2 format_completion
#
#Usage:
#
# format_completion($completion, $opts) -> str|array
#
#Format completion for output (for shell).
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the C<Complete>
#POD. Aside from C<words>, this function also recognizes these keys:
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$completion>* => I<hash|array>
#
#Completion answer structure.
#
#Either an array or hash. See function description for more details.
#
#=item * B<$opts> => I<hash>
#
#Specify options.
#
#Known options:
#
#=over
#
#=item * as
#
#Either C<string> (the default) or C<array> (to return array of lines instead of
#the lines joined together). Returning array is useful if you are doing
#completion inside C<Term::ReadLine>, for example, where the library expects an
#array.
#
#=item * esc_mode
#
#Escaping mode for entries. Either C<default> (most nonalphanumeric characters
#will be escaped), C<shellvar> (like C<default>, but dollar sign C<$> will also be
#escaped, convenient when completing environment variables for example),
#C<filename> (currently equals to C<default>), C<option> (currently equals to
#C<default>), or C<none> (no escaping will be done).
#
#=item * word
#
#A workaround. String. For now, see source code for more details.
#
#=item * show_summaries
#
#Whether to show item's summaries. Boolean, default is from
#COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
#An answer item contain summary, which is a short description about the item,
#e.g.:
#
#  [{word=>"-a"    , summary=>"Show hidden files"},
#   {word=>"-l"    , summary=>"Show details"},
#   {word=>"--sort", summary=>"Specify sort order"}],
#
#When summaries are not shown, user will just be seeing something like:
#
#  -a
#  -l
#  --sort
#
#But when summaries are shown, user will see:
#
#  -a         -- Show hidden files
#  -l         -- Show details
#  --sort     -- Specify sort order
#
#which is quite helpful.
#
#=item * workaround_with_wordbreaks
#
#Boolean. Default is true. See source code for more details.
#
#=back
#
#=back
#
#Return value: Formatted string (or array, if `as` is set to `array`) (str|array)
#
#
#
#=head2 join_wordbreak_words
#
#Usage:
#
# join_wordbreak_words() -> [status, msg, payload, meta]
#
#Post-process parse_cmdline() result by joining some words.
#
#C<parse_cmdline()>, like bash, splits some characters that are considered as
#word-breaking characters:
#
# "'@><=;|&(:
#
#So if command-line is:
#
# command -MData::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "-MData", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want C<:>, C<@> to be part of word. So this
#routine will convert the above into:
#
# ["command", "-MData::Dump", 'bob@example.org']
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#
#
#=head2 parse_cmdline
#
#Usage:
#
# parse_cmdline($cmdline, $point, $opts) -> array
#
#Parse shell command-line for processing by completion routines.
#
#This function basically converts C<COMP_LINE> (str) and C<COMP_POINT> (int) into
#something like (but not exactly the same as) C<COMP_WORDS> (array) and
#C<COMP_CWORD> (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's C<COMP_WORDS> contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (C<COMP_WORDS[COMP_CWORD]>) (bash does not perform
#   variable substitution for C<COMP_WORDS>). However, note that special shell
#   variables that are not environment variables like C<$0>, C<$_>, C<$IFS> will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (C<~>) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for C<COMP_WORDS>);
#
#Caveats:
#
#=over
#
#=item * Like bash, we group non-whitespace word-breaking characters into its own word.
#By default C<COMP_WORDBREAKS> is:
#
#"'@><=;|&(:
#
#So if raw command-line is:
#
#command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#then the parse result will be:
#
#["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#which is annoying sometimes. But we follow bash here so we can more easily
#accept input from a joined C<COMP_WORDS> if we write completion bash functions,
#e.g. (in the example, C<foo> is a Perl script):
#
#I<foo ()
#{
#    local words=(${COMP>CWORDS[@]})
#    # add things to words, etc
#    local point=... # calculate the new point
#    COMPREPLY=( C<COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo> )
#}
#
#To avoid these word-breaking characters to be split/grouped, we can escape
#them with backslash or quote them, e.g.:
#
#command "http://example.com:80" Foo\:\:Bar
#
#which bash will parse as:
#
#["command", "\"http://example.com:80\"", "Foo\:\:Bar"]
#
#and we parse as:
#
#["command", "http://example.com:80", "Foo::Bar"]
#
#=item * Due to the way bash parses the command line (see above), the two below are
#equivalent:
#
#% cmd --foo=bar
#% cmd --foo = bar
#
#=back
#
#Because they both expand to C<['--foo', '=', 'bar']>. But obviously
#L<Getopt::Long> does not regard the two as equivalent.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line, defaults to COMP_LINE environment.
#
#=item * B<$opts> => I<hash>
#
#Options.
#
#Optional. Known options:
#
#=over
#
#=item * C<truncate_current_word> (bool). If set to 1, will truncate current word to the
#position of cursor, for example (C<^> marks the position of cursor):
#C<--vers^oo> to C<--vers> instead of C<--versoo>. This is more convenient when
#doing tab completion.
#
#=back
#
#=item * B<$point> => I<int>
#
#Point/position to complete in command-line, defaults to COMP_POINT.
#
#=back
#
#Return value:  (array)
#
#
#Return a 2-element array: C<[$words, $cword]>. C<$words> is array of str,
#equivalent to C<COMP_WORDS> provided by bash to shell functions. C<$cword> is an
#integer, roughly equivalent to C<COMP_CWORD> provided by bash to shell functions.
#The word to be completed is at C<< $words-E<gt>[$cword] >>.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in C<@ARGV>), you need to strip the first element from
#C<$words> and reduce C<$cword> by 1.
#
#
#
#=head2 point
#
#Usage:
#
# point($cmdline, $marker) -> any
#
#Return line with point marked by a marker.
#
#This is a utility function useful for testing/debugging. C<parse_cmdline()>
#expects a command-line and a cursor position (C<$line>, C<$point>). This routine
#expects C<$line> with a marker character (by default it's the caret, C<^>) and
#return (C<$line>, C<$point>) to feed to C<parse_cmdline()>.
#
#Example:
#
# point("^foo") # => ("foo", 0)
# point("fo^o") # => ("foo", 2)
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line which contains a marker character.
#
#=item * B<$marker> => I<str> (default: "^")
#
#Marker character.
#
#=back
#
#Return value:  (any)
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_BASH_DEFAULT_ESC_MODE
#
#Str. To provide default for the C<esc_mode> option in L</format_completion>.
#
#=head2 COMPLETE_BASH_FZF
#
#Bool. Whether to pass large completion answer to fzf instead of directly passing
#it to bash and letting bash page it with a simpler more-like internal pager. By
#default, large is defined as having at least 100 items (same bash's
#C<completion-query-items> setting). This can be configured via
#L</COMPLETE_BASH_FZF_ITEMS>.
#
#=head2 COMPLETE_BASH_FZF_ITEMS
#
#Uint. Default 100. The minimum number of items to trigger passing completion
#answer to fzf. See also: L</COMPLETE_BASH_FZF>.
#
#=head2 COMPLETE_BASH_MAX_COLUMNS
#
#Uint.
#
#Bash will show completion entries in one or several columns, depending on the
#terminal width and the length of the entries (much like a standard non-long
#`ls`). If you prefer completion entries to be shown in a single column no matter
#how wide your terminal is, or how short the entries are, you can set the value
#of this variable to 1. If you prefer a maximum of two columns, set to 2, and so
#on. L</format_completion> will pad the entries with sufficient spaces to limit
#the number of columns.
#
#=head2 COMPLETE_BASH_SHOW_SUMMARIES
#
#Bool. Will set the default for C<show_summaries> option in
#L</format_completion>.
#
#=head2 COMPLETE_BASH_SUMMARY_ALIGN
#
#String. Either C<left> (the default) or C<right>.
#
#The C<left> align looks something like this:
#
# --bar      Summary about the bar option
# --baz      Summary about the baz option
# --foo      Summary about the foo option
# --schapen  Summary about the schapen option
#
#The C<right> align will make the completion answer look like what you see in the
#B<fish> shell:
#
# --bar                        Summary about the bar option
# --baz                        Summary about the baz option
# --foo                        Summary about the foo option
# --schapen                Summary about the schapen option
#
#=head2 COMPLETE_BASH_TRACE
#
#Bool. If set to true, will produce more log statements to L<Log::ger>.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Bash>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Bash>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Bash>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Complete>, the convention that this module follows.
#
#Some higher-level modules that use this module (so you don't have to use this
#module directly): L<Getopt::Long::Complete> (via L<Complete::Getopt::Long>),
#L<Getopt::Long::Subcommand>, L<Perinci::CmdLine> (via
#L<Perinci::Sub::Complete>).
#
#Other modules related to bash shell tab completion: L<Bash::Completion>,
#L<Getopt::Complete>, L<Term::Bash::Completion::Generator>.
#
#Programmable Completion section in Bash manual:
#L<https://www.gnu.org/software/bash/manual/html_node/Programmable-Completion.html>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2016, 2015, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Config/IOD/Base.pm ###
#package Config::IOD::Base;
#
#our $DATE = '2019-01-17'; # DATE
#our $VERSION = '0.342'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
##use Carp; # avoided to shave a bit of startup time
#
#use constant +{
#    COL_V_ENCODING => 0, # either "!j"... or '"', '[', '{', '~'
#    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_directive} //= 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{expr_vars}       //= {};
#    $attrs{ignore_unknown_directive} //= 0;
#    # allow_encodings
#    # disallow_encodings
#    # allow_directives
#    # disallow_directives
#    bless \%attrs, $class;
#}
#
## borrowed from Parse::CommandLine. differences: returns arrayref. return undef
## on error (instead of dying).
#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;
#}
#
## return ($err, $res, $decoded_val)
#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; $res = [
#            "!$enc", # COL_V_ENCODING
#            $ws1, # COL_V_WS1
#            $1, # COL_V_VALUE
#            $2, # COL_V_WS2
#            $3, # COL_V_COMMENT_CHAR
#            $4, # COL_V_COMMENT
#        ] if $needs_res;
#
#        # canonicalize shorthands
#        $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') {
#
#            # XXX imperfect regex for simplicity, comment should not contain
#            # "]", '"', or '}' or it will be gobbled up as value by greedy regex
#            # quantifier
#            $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};
#            # XXX imperfect regex, expression can't contain # and ; because it
#            # will be assumed as comment
#            $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; $res = [
#            '"', # COL_V_ENCODING
#            '', # COL_V_WS1
#            $1, # VOL_V_VALUE
#            $2, # COL_V_WS2
#            $3, # COL_V_COMMENT_CHAR
#            $4, # COL_V_COMMENT
#        ] 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}) {
#
#        # XXX imperfect regex for simplicity, comment should not contain "]" or
#        # it will be gobbled up as value by greedy regex quantifier
#        $val =~ /\A
#                 \[(.*)\]
#                 (?:
#                     (\s*)
#                     ([#;])(.*)
#                 )?
#                 \z/x or return ("Invalid syntax in bracketed array value");
#        my $res; $res = [
#            '[', # COL_V_ENCODING
#            '', # COL_V_WS1
#            $1, # VOL_V_VALUE
#            $2, # COL_V_WS2
#            $3, # COL_V_COMMENT_CHAR
#            $4, # COL_V_COMMENT
#        ] 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}) {
#
#        # XXX imperfect regex for simplicity, comment should not contain "}" or
#        # it will be gobbled up as value by greedy regex quantifier
#        $val =~ /\A
#                 \{(.*)\}
#                 (?:
#                     (\s*)
#                     ([#;])(.*)
#                 )?
#                 \z/x or return ("Invalid syntax in braced hash value");
#        my $res; $res = [
#            '{', # COL_V_ENCODING
#            '', # COL_V_WS1
#            $1, # VOL_V_VALUE
#            $2, # COL_V_WS2
#            $3, # COL_V_COMMENT_CHAR
#            $4, # COL_V_COMMENT
#        ] 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; $res = [
#            '~', # COL_V_ENCODING
#            '', # COL_V_WS1
#            $1, # VOL_V_VALUE
#            $2, # COL_V_WS2
#            $3, # COL_V_COMMENT_CHAR
#            $4, # COL_V_COMMENT
#        ] 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"); # shouldn't happen, regex should match any string
#        my $res; $res = [
#            '', # COL_V_ENCODING
#            '', # COL_V_WS1
#            $1, # VOL_V_VALUE
#            $2, # COL_V_WS2
#            $3, # COL_V_COMMENT_CHAR
#            $4, # COL_V_COMMENT
#        ] if $needs_res;
#        return (undef, $res, $1);
#
#    }
#    # should not be reached
#}
#
#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;
#    }
#}
#
## borrowed from PERLANCAR::File::HomeDir 0.04
#sub _get_my_home_dir {
#    if ($^O eq 'MSWin32') {
#        # File::HomeDir always uses exists($ENV{x}) first, does it want to avoid
#        # accidentally creating env vars?
#        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";
#}
#
## borrowed from PERLANCAR::File::HomeDir 0.05, with some modifications
#sub _get_user_home_dir {
#    my ($name) = @_;
#
#    if ($^O eq 'MSWin32') {
#        # not yet implemented
#        return undef;
#    } else {
#        # IF and only if we have getpwuid support, and the name of the user is
#        # our own, shortcut to my_home. This is needed to handle HOME
#        # environment settings.
#        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_user_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::_Compiled::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) = @_;
#
#    # included file's path is based on the main (topmost) file
#    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} = [];
#
#    # set expr variables
#    {
#        last unless $self->{enable_expr};
#        no strict 'refs';
#        my $pkg = \%{"Config::IOD::Expr::_Compiled::"};
#        undef ${"Config::IOD::Expr::_Compiled::$_"} for keys %$pkg;
#        my $vars = $self->{expr_vars};
#        ${"Config::IOD::Expr::_Compiled::$_"} = $vars->{$_} for keys %$vars;
#    }
#}
#
#sub _read_file {
#    my ($self, $filename) = @_;
#    open my $fh, "<", $filename
#        or die "Can't open file '$filename': $!";
#    binmode($fh, ":encoding(utf8)");
#    local $/;
#    my $res = scalar <$fh>;
#    close $fh;
#    $res;
#}
#
#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;
## ABSTRACT: Base class for Config::IOD and Config::IOD::Reader
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Config::IOD::Base - Base class for Config::IOD and Config::IOD::Reader
#
#=head1 VERSION
#
#This document describes version 0.342 of Config::IOD::Base (from Perl distribution Config-IOD-Reader), released on 2019-01-17.
#
#=head1 EXPRESSION
#
#=for BEGIN_BLOCK: expression
#
#Expression allows you to do things like:
#
# [section1]
# foo=1
# bar="monkey"
#
# [section2]
# baz =!e 1+1
# qux =!e "grease" . val("section1.bar")
# quux=!e val("qux") . " " . val('baz')
#
#And the result will be:
#
# {
#     section1 => {foo=>1, bar=>"monkey"},
#     section2 => {baz=>2, qux=>"greasemonkey", quux=>"greasemonkey 2"},
# }
#
#For safety, you'll need to set C<enable_expr> attribute to 1 first to enable
#this feature.
#
#The syntax of the expression (the C<expr> encoding) is not officially specified
#yet in the L<IOD> specification. It will probably be Expr (see
#L<Language::Expr::Manual::Syntax>). At the moment, this module implements a very
#limited subset that is compatible (lowest common denominator) with Perl syntax
#and uses C<eval()> to evaluate the expression. However, only the limited subset
#is allowed (checked by Perl 5.10 regular expression).
#
#The supported terms:
#
# number
# string (double-quoted and single-quoted)
# undef literal
# simple variable ($abc, no namespace, no array/hash sigil, no special variables)
# function call (only the 'val' function is supported)
# grouping (parenthesis)
#
#The supported operators are:
#
# + - .
# * / % x
# **
# unary -, unary +, !, ~
#
#The C<val()> function refers to the configuration key. If the argument contains
#".", it will be assumed as C<SECTIONNAME.KEYNAME>, otherwise it will access the
#current section's key. Since parsing is done in a single pass, you can only
#refer to the already mentioned key.
#
#Code will be compiled using Perl's C<eval()> in the
#C<Config::IOD::Expr::_Compiled> namespace, with C<no strict>, C<no warnings>.
#
#=for END_BLOCK: expression
#
#=head1 ATTRIBUTES
#
#=for BEGIN_BLOCK: attributes
#
#=head2 default_section => str (default: C<GLOBAL>)
#
#If a key line is specified before any section line, this is the section that the
#key will be put in.
#
#=head2 enable_directive => bool (default: 1)
#
#If set to false, then directives will not be parsed. Lines such as below will be
#considered a regular comment:
#
# ;!include foo.ini
#
#and lines such as below will be considered a syntax error (B<regardless> of the
#C<allow_bang_only> setting):
#
# !include foo.ini
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_encoding => bool (default: 1)
#
#If set to false, then encoding notation will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = !json null
#
#With C<enable_encoding> turned off, value will not be undef but will be string
#with the value of (as Perl literal) C<"!json null">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_quoting => bool (default: 1)
#
#If set to false, then quotes on key value will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = "line 1\nline2"
#
#With C<enable_quoting> turned off, value will not be a two-line string, but will
#be a one line string with the value of (as Perl literal) C<"line 1\\nline2">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_bracket => bool (default: 1)
#
#If set to false, then JSON literal array will be parsed as verbatim. Example:
#
# name = [1,2,3]
#
#With C<enable_bracket> turned off, value will not be a three-element array, but
#will be a string with the value of (as Perl literal) C<"[1,2,3]">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_brace => bool (default: 1)
#
#If set to false, then JSON literal object (hash) will be parsed as verbatim.
#Example:
#
# name = {"a":1,"b":2}
#
#With C<enable_brace> turned off, value will not be a hash with two pairs, but
#will be a string with the value of (as Perl literal) C<'{"a":1,"b":2}'>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_tilde => bool (default: 1)
#
#If set to true (the default), then value that starts with C<~> (tilde) will be
#assumed to use !path encoding, unless an explicit encoding has been otherwise
#specified.
#
#Example:
#
# log_dir = ~/logs  ; ~ will be resolved to current user's home directory
#
#With C<enable_tilde> turned off, value will still be literally C<~/logs>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 allow_encodings => array
#
#If defined, set list of allowed encodings. Note that if C<disallow_encodings> is
#also set, an encoding must also not be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 disallow_encodings => array
#
#If defined, set list of disallowed encodings. Note that if C<allow_encodings> is
#also set, an encoding must also be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 enable_expr => bool (default: 0)
#
#Whether to enable C<expr> encoding. By default this is turned on, for safety.
#Please see L</"EXPRESSION"> for more details.
#
#=head2 allow_directives => array
#
#If defined, only directives listed here are allowed. Note that if
#C<disallow_directives> is also set, a directive must also not be in that list.
#
#=head2 disallow_directives => array
#
#If defined, directives listed here are not allowed. Note that if
#C<allow_directives> is also set, a directive must also be in that list.
#
#=head2 allow_bang_only => bool (default: 1)
#
#Since the mistake of specifying a directive like this:
#
# !foo
#
#instead of the correct:
#
# ;!foo
#
#is very common, the spec allows it. This reader, however, can be configured to
#be more strict.
#
#=head2 allow_duplicate_key => bool (default: 1)
#
#If set to 0, you can forbid duplicate key, e.g.:
#
# [section]
# a=1
# a=2
#
#or:
#
# [section]
# a=1
# b=2
# c=3
# a=10
#
#In traditional INI file, to specify an array you specify multiple keys. But when
#there is only a single key, it is unclear if the value is a single-element array
#or a scalar. You can use this setting to avoid this array/scalar ambiguity in
#config file and force user to use JSON encoding or bracket to specify array:
#
# [section]
# a=[1,2]
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 ignore_unknown_directive => bool (default: 0)
#
#If set to true, will not die if an unknown directive is encountered. It will
#simply be ignored as a regular comment.
#
#B<NOTE: Turning this setting on violates IOD specification.>
#
#=for END_BLOCK: attributes
#
#=head1 METHODS
#
#=for BEGIN_BLOCK: methods
#
#=head2 new(%attrs) => obj
#
#=head2 $reader->read_file($filename)
#
#Read IOD configuration from a file. Die on errors.
#
#=head2 $reader->read_string($str)
#
#Read IOD configuration from a string. Die on errors.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Config-IOD-Reader>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Config-IOD-Reader>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Config-IOD-Reader>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2017, 2016, 2015, 2014 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
### Config/IOD/Reader.pm ###
#package Config::IOD::Reader;
#
#our $DATE = '2019-01-17'; # DATE
#our $VERSION = '0.342'; # VERSION
#
#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) {
#            # ignore merging self
#            next;
#            #local $self->{_linum} = $self->{_linum}-1;
#            #$self->_err("Can't merge section '$msect' to '$section': ".
#            #                "Same section");
#        }
#        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; # only to provide to callback
#
#    my @lines = split /^/, $str;
#    local $self->{_linum} = 0;
#  LINE:
#    for my $line (@lines) {
#        $self->{_linum}++;
#
#        # blank line
#        if ($line !~ /\S/) {
#            next LINE;
#        }
#
#        # directive line
#        if ($self->{enable_directive} && $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), $cb);
#                $self->_pop_include_stack;
#            } elsif ($directive eq 'merge') {
#                $self->{_merge} = @$args ? $args : undef;
#            } elsif ($directive eq 'noop') {
#            } else {
#                if ($self->{ignore_unknown_directive}) {
#                    # assume a regular comment
#                    next LINE;
#                } else {
#                    $self->_err("Unknown directive '$directive'");
#                }
#            }
#            next LINE;
#        }
#
#        # comment line
#        if ($line =~ /^\s*[;#]/) {
#
#            if ($cb) {
#                $cb->(
#                    event => 'comment',
#                    linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
#                );
#            }
#
#            next LINE;
#        }
#
#        # section 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}++;
#
#            # previous section exists? do merging for previous section
#            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;
#        }
#
#        # key line
#        if ($line =~ /^\s*([^=]+?)\s*=\s*(.*)/) {
#            my $key = $1;
#            my $val = $2;
#
#            # the common case is that value are not decoded or
#            # quoted/bracketed/braced, so we avoid calling _parse_raw_value here
#            # to avoid overhead
#            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*[#;].*//; # strip comment
#            }
#
#            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;
## ABSTRACT: Read IOD/INI configuration files
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Config::IOD::Reader - Read IOD/INI configuration files
#
#=head1 VERSION
#
#This document describes version 0.342 of Config::IOD::Reader (from Perl distribution Config-IOD-Reader), released on 2019-01-17.
#
#=head1 SYNOPSIS
#
# use Config::IOD::Reader;
# my $reader = Config::IOD::Reader->new(
#     # list of known attributes, with their default values
#     # default_section     => 'GLOBAL',
#     # enable_directive    => 1,
#     # enable_encoding     => 1,
#     # enable_quoting      => 1,
#     # enable_backet       => 1,
#     # enable_brace        => 1,
#     # allow_encodings     => undef, # or ['base64','json',...]
#     # disallow_encodings  => undef, # or ['base64','json',...]
#     # allow_directives    => undef, # or ['include','merge',...]
#     # disallow_directives => undef, # or ['include','merge',...]
#     # allow_bang_only     => 1,
#     # enable_expr         => 0,
#     # allow_duplicate_key => 1,
#     # ignore_unknown_directive => 0,
# );
# my $config_hash = $reader->read_file('config.iod');
#
#=head1 DESCRIPTION
#
#This module reads L<IOD> configuration files (IOD is an INI-like format with
#more precise specification, some extra features, and 99% compatible with typical
#INI format). It is a minimalist alternative to the more fully-featured
#L<Config::IOD>. It cannot write IOD files and is optimized for low startup
#overhead.
#
#=head1 EXPRESSION
#
#Expression allows you to do things like:
#
# [section1]
# foo=1
# bar="monkey"
#
# [section2]
# baz =!e 1+1
# qux =!e "grease" . val("section1.bar")
# quux=!e val("qux") . " " . val('baz')
#
#And the result will be:
#
# {
#     section1 => {foo=>1, bar=>"monkey"},
#     section2 => {baz=>2, qux=>"greasemonkey", quux=>"greasemonkey 2"},
# }
#
#For safety, you'll need to set C<enable_expr> attribute to 1 first to enable
#this feature.
#
#The syntax of the expression (the C<expr> encoding) is not officially specified
#yet in the L<IOD> specification. It will probably be Expr (see
#L<Language::Expr::Manual::Syntax>). At the moment, this module implements a very
#limited subset that is compatible (lowest common denominator) with Perl syntax
#and uses C<eval()> to evaluate the expression. However, only the limited subset
#is allowed (checked by Perl 5.10 regular expression).
#
#The supported terms:
#
# number
# string (double-quoted and single-quoted)
# undef literal
# simple variable ($abc, no namespace, no array/hash sigil, no special variables)
# function call (only the 'val' function is supported)
# grouping (parenthesis)
#
#The supported operators are:
#
# + - .
# * / % x
# **
# unary -, unary +, !, ~
#
#The C<val()> function refers to the configuration key. If the argument contains
#".", it will be assumed as C<SECTIONNAME.KEYNAME>, otherwise it will access the
#current section's key. Since parsing is done in a single pass, you can only
#refer to the already mentioned key.
#
#Code will be compiled using Perl's C<eval()> in the
#C<Config::IOD::Expr::_Compiled> namespace, with C<no strict>, C<no warnings>.
#
#=head1 ATTRIBUTES
#
#=head2 default_section => str (default: C<GLOBAL>)
#
#If a key line is specified before any section line, this is the section that the
#key will be put in.
#
#=head2 enable_directive => bool (default: 1)
#
#If set to false, then directives will not be parsed. Lines such as below will be
#considered a regular comment:
#
# ;!include foo.ini
#
#and lines such as below will be considered a syntax error (B<regardless> of the
#C<allow_bang_only> setting):
#
# !include foo.ini
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_encoding => bool (default: 1)
#
#If set to false, then encoding notation will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = !json null
#
#With C<enable_encoding> turned off, value will not be undef but will be string
#with the value of (as Perl literal) C<"!json null">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_quoting => bool (default: 1)
#
#If set to false, then quotes on key value will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = "line 1\nline2"
#
#With C<enable_quoting> turned off, value will not be a two-line string, but will
#be a one line string with the value of (as Perl literal) C<"line 1\\nline2">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_bracket => bool (default: 1)
#
#If set to false, then JSON literal array will be parsed as verbatim. Example:
#
# name = [1,2,3]
#
#With C<enable_bracket> turned off, value will not be a three-element array, but
#will be a string with the value of (as Perl literal) C<"[1,2,3]">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_brace => bool (default: 1)
#
#If set to false, then JSON literal object (hash) will be parsed as verbatim.
#Example:
#
# name = {"a":1,"b":2}
#
#With C<enable_brace> turned off, value will not be a hash with two pairs, but
#will be a string with the value of (as Perl literal) C<'{"a":1,"b":2}'>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_tilde => bool (default: 1)
#
#If set to true (the default), then value that starts with C<~> (tilde) will be
#assumed to use !path encoding, unless an explicit encoding has been otherwise
#specified.
#
#Example:
#
# log_dir = ~/logs  ; ~ will be resolved to current user's home directory
#
#With C<enable_tilde> turned off, value will still be literally C<~/logs>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 allow_encodings => array
#
#If defined, set list of allowed encodings. Note that if C<disallow_encodings> is
#also set, an encoding must also not be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 disallow_encodings => array
#
#If defined, set list of disallowed encodings. Note that if C<allow_encodings> is
#also set, an encoding must also be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 enable_expr => bool (default: 0)
#
#Whether to enable C<expr> encoding. By default this is turned on, for safety.
#Please see L</"EXPRESSION"> for more details.
#
#=head2 allow_directives => array
#
#If defined, only directives listed here are allowed. Note that if
#C<disallow_directives> is also set, a directive must also not be in that list.
#
#=head2 disallow_directives => array
#
#If defined, directives listed here are not allowed. Note that if
#C<allow_directives> is also set, a directive must also be in that list.
#
#=head2 allow_bang_only => bool (default: 1)
#
#Since the mistake of specifying a directive like this:
#
# !foo
#
#instead of the correct:
#
# ;!foo
#
#is very common, the spec allows it. This reader, however, can be configured to
#be more strict.
#
#=head2 allow_duplicate_key => bool (default: 1)
#
#If set to 0, you can forbid duplicate key, e.g.:
#
# [section]
# a=1
# a=2
#
#or:
#
# [section]
# a=1
# b=2
# c=3
# a=10
#
#In traditional INI file, to specify an array you specify multiple keys. But when
#there is only a single key, it is unclear if the value is a single-element array
#or a scalar. You can use this setting to avoid this array/scalar ambiguity in
#config file and force user to use JSON encoding or bracket to specify array:
#
# [section]
# a=[1,2]
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 ignore_unknown_directive => bool (default: 0)
#
#If set to true, will not die if an unknown directive is encountered. It will
#simply be ignored as a regular comment.
#
#B<NOTE: Turning this setting on violates IOD specification.>
#
#=head1 METHODS
#
#=head2 new(%attrs) => obj
#
#=head2 $reader->read_file($filename[ , $callback ]) => hash
#
#Read IOD configuration from a file. Die on errors.
#
#See C<read_string> for more information on C<$callback> argument.
#
#=head2 $reader->read_string($str[ , $callback ]) => hash
#
#Read IOD configuration from a string. Die on errors.
#
#C<$callback> is an optional coderef argument that will be called during various
#stages. It can be useful if you want more information (especially ordering). It
#will be called with hash argument C<%args>
#
#=over
#
#=item * Found a directive line
#
#Arguments passed: C<event> (str, has the value of 'directive'), C<linum> (int,
#line number, starts from 1), C<line> (str, raw line), C<directive> (str,
#directive name), C<cur_section> (str, current section name), C<args> (array,
#directive arguments).
#
#=item * Found a comment line
#
#Arguments passed: C<event> (str, 'comment'), C<linum>, C<line>, C<cur_section>.
#
#=item * Found a section line
#
#Arguments passed: C<event> (str, 'section'), C<linum>, C<line>, C<cur_section>,
#C<section> (str, section name).
#
#=item * Found a key line
#
#Arguments passed: C<event> (str, 'section'), C<linum>, C<line>, C<cur_section>,
#C<key> (str, key name), C<val> (any, value name, already decoded if encoded),
#C<raw_val> (str, raw value).
#
#=back
#
#TODO: callback when there is merging.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Config-IOD-Reader>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Config-IOD-Reader>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Config-IOD-Reader>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<IOD> - specification
#
#L<Config::IOD> - round-trip parser for reading as well as writing IOD documents
#
#L<IOD::Examples> - sample documents
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2017, 2016, 2015, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Data/Check/Structure.pm ###
#package Data::Check::Structure;
#
#our $DATE = '2017-07-18'; # DATE
#our $VERSION = '0.04'; # VERSION
#
#use strict;
##use warnings;
#
#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;
## ABSTRACT: Check structure of data
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Check::Structure - Check structure of data
#
#=head1 VERSION
#
#This document describes version 0.04 of Data::Check::Structure (from Perl distribution Data-Check-Structure), released on 2017-07-18.
#
#=head1 SYNOPSIS
#
#=head1 DESCRIPTION
#
#This small module provides several simple routines to check the structure of
#data, e.g. whether data is an array of arrays ("aoa"), array of scalars ("aos"),
#and so on.
#
#=head1 FUNCTIONS
#
#None exported by default, but they are exportable.
#
#=head2 is_aos($data[, \%opts]) => bool
#
#Check that data is an array of scalars. Examples:
#
# is_aos([]);                     # true
# is_aos(['a', 'b']);             # true
# is_aos(['a', []]);              # false
# is_aos([1,2,3, []], {max=>3});  # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aoa($data[, \%opts]) => bool
#
#Check that data is an array of arrays. Examples:
#
# is_aoa([]);                          # true
# is_aoa([[1], [2]]);                  # true
# is_aoa([[1], 'a']);                  # false
# is_aoa([[1],[],[], 'a'], {max=>3});  # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aoaos($data[, \%opts]) => bool
#
#Check that data is an array of arrays of scalars. Examples:
#
# is_aoaos([]);                           # true
# is_aoaos([[1], [2]]);                   # true
# is_aoaos([[1], [{}]]);                  # false
# is_aoaos([[1],[],[], [{}]], {max=>3});  # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aoh($data[, \%opts]) => bool
#
#Check that data is an array of hashes. Examples:
#
# is_aoh([]);                             # true
# is_aoh([{}, {a=>1}]);                   # true
# is_aoh([{}, 'a']);                      # false
# is_aoh([{},{},{a=>1}, 'a'], {max=>3});  # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aohos($data[, \%opts]) => bool
#
#Check that data is an array of hashes of scalars. Examples:
#
# is_aohos([]);                                 # true
# is_aohos([{a=>1}, {}]);                       # true
# is_aohos([{a=>1}, {b=>[]}]);                  # false
# is_aohos([{a=>1},{},{}, {b=>[]}], {max=>3});  # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_hos($data[, \%opts]) => bool
#
#Check that data is a hash of scalars. Examples:
#
# is_hos({});                                   # true
# is_hos({a=>1, b=>2});                         # true
# is_hos({a=>1, b=>[]});                        # false
# is_hos({a=>1, b=>2, c=>3, d=>[]}, {max=>3});  # true (or false, depending on random hash key ordering)
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_hoa($data[, \%opts]) => bool
#
#Check that data is a hash of arrays. Examples:
#
# is_hoa({}) );       # true
# is_hoa({a=>[]}) );  # true
# is_hoa({a=>1}) );   # false
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_hoaos($data[, \%opts]) => bool
#
#Check that data is a hash of arrays of scalars. Examples:
#
# is_hoaos({}) );         # true
# is_hoaos({a=>[]}) );    # true
# is_hoaos({a=>[1]}) );   # true
# is_hoaos({a=>1}) );     # false
# is_hoaos({a=>[{}]}) );  # false
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_hoh($data[, \%opts]) => bool
#
#Check that data is a hash of hashes. Examples:
#
# is_hoh({}) );       # true
# is_hoh({a=>{}}) );  # true
# is_hoh({a=>1}) );   # false
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_hohos($data[, \%opts]) => bool
#
#Check that data is a hash of hashes of scalrs. Examples:
#
# is_hohos({}) );            # true
# is_hohos({a=>{}}) );       # true
# is_hohos({a=>{b=>1}}) );   # true
# is_hohos({a=>1}) );        # false
# is_hohos({a=>{b=>[]}}) );  # false
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Check-Structure>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Check-Structure>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Check-Structure>
#
#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, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Data/Sah/Normalize.pm ###
#package Data::Sah::Normalize;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $DATE = '2018-09-10'; # DATE
#our $VERSION = '0.050'; # VERSION
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       normalize_clset
#                       normalize_schema
#
#                       $type_re
#                       $clause_name_re
#                       $clause_re
#                       $attr_re
#                       $funcset_re
#                       $compiler_re
#               );
#
#our $type_re        = qr/\A(?:[A-Za-z_]\w*::)*[A-Za-z_]\w*\z/;
#our $clause_name_re = qr/\A[A-Za-z_]\w*\z/;
#our $clause_re      = qr/\A[A-Za-z_]\w*(?:\.[A-Za-z_]\w*)*\z/;
#our $attr_re        = $clause_re;
#our $funcset_re     = qr/\A(?:[A-Za-z_]\w*::)*[A-Za-z_]\w*\z/;
#our $compiler_re    = qr/\A[A-Za-z_]\w*\z/;
#our $clause_attr_on_empty_clause_re = qr/\A(?:\.[A-Za-z_]\w*)+\z/;
#
#sub normalize_clset($;$) {
#    my ($clset0, $opts) = @_;
#    $opts //= {};
#
#    my $clset = {};
#    for my $c (sort keys %$clset0) {
#        my $c0 = $c;
#
#        my $v = $clset0->{$c};
#
#        # ignore expression
#        my $expr;
#        if ($c =~ s/=\z//) {
#            $expr++;
#            # XXX currently can't disregard merge prefix when checking
#            # conflict
#            die "Conflict between '$c=' and '$c'" if exists $clset0->{$c};
#            $clset->{"$c.is_expr"} = 1;
#            }
#
#        my $sc = "";
#        my $cn;
#        {
#            my $errp = "Invalid clause name syntax '$c0'"; # error prefix
#            if (!$expr && $c =~ s/\A!(?=.)//) {
#                die "$errp, syntax should be !CLAUSE"
#                    unless $c =~ $clause_name_re;
#                $sc = "!";
#            } elsif (!$expr && $c =~ s/(?<=.)\|\z//) {
#                die "$errp, syntax should be CLAUSE|"
#                    unless $c =~ $clause_name_re;
#                $sc = "|";
#            } elsif (!$expr && $c =~ s/(?<=.)\&\z//) {
#                die "$errp, syntax should be CLAUSE&"
#                    unless $c =~ $clause_name_re;
#                $sc = "&";
#            } elsif (!$expr && $c =~ /\A([^.]+)(?:\.(.+))?\((\w+)\)\z/) {
#                my ($c2, $a, $lang) = ($1, $2, $3);
#                die "$errp, syntax should be CLAUSE(LANG) or C.ATTR(LANG)"
#                    unless $c2 =~ $clause_name_re &&
#                        (!defined($a) || $a =~ $attr_re);
#                $sc = "(LANG)";
#                $cn = $c2 . (defined($a) ? ".$a" : "") . ".alt.lang.$lang";
#            } elsif ($c !~ $clause_re &&
#                         $c !~ $clause_attr_on_empty_clause_re) {
#                die "$errp, please use letter/digit/underscore only";
#            }
#        }
#
#        # XXX can't disregard merge prefix when checking conflict
#        if ($sc eq '!') {
#            die "Conflict between clause shortcuts '!$c' and '$c'"
#                if exists $clset0->{$c};
#            die "Conflict between clause shortcuts '!$c' and '$c|'"
#                if exists $clset0->{"$c|"};
#            die "Conflict between clause shortcuts '!$c' and '$c&'"
#                if exists $clset0->{"$c&"};
#            $clset->{$c} = $v;
#            $clset->{"$c.op"} = "not";
#        } elsif ($sc eq '&') {
#            die "Conflict between clause shortcuts '$c&' and '$c'"
#                if exists $clset0->{$c};
#            die "Conflict between clause shortcuts '$c&' and '$c|'"
#                if exists $clset0->{"$c|"};
#            die "Clause 'c&' value must be an array"
#                unless ref($v) eq 'ARRAY';
#            $clset->{$c} = $v;
#            $clset->{"$c.op"} = "and";
#        } elsif ($sc eq '|') {
#            die "Conflict between clause shortcuts '$c|' and '$c'"
#                if exists $clset0->{$c};
#            die "Clause 'c|' value must be an array"
#                unless ref($v) eq 'ARRAY';
#            $clset->{$c} = $v;
#            $clset->{"$c.op"} = "or";
#        } elsif ($sc eq '(LANG)') {
#            die "Conflict between clause '$c' and '$cn'"
#                if exists $clset0->{$cn};
#            $clset->{$cn} = $v;
#        } else {
#            $clset->{$c} = $v;
#        }
#
#    }
#    $clset->{req} = 1 if $opts->{has_req};
#
#    # XXX option to recursively normalize clset, any's of, all's of, ...
#    #if ($clset->{clset}) {
#    #    local $opts->{has_req};
#    #    if ($clset->{'clset.op'} && $clset->{'clset.op'} =~ /and|or/) {
#    #        # multiple clause sets
#    #        $clset->{clset} = map { $self->normalize_clset($_, $opts) }
#    #            @{ $clset->{clset} };
#    #    } else {
#    #        $clset->{clset} = $self->normalize_clset($_, $opts);
#    #    }
#    #}
#
#    $clset;
#}
#
#sub normalize_schema($) {
#    my $s = shift;
#
#    my $ref = ref($s);
#    if (!defined($s)) {
#
#        die "Schema is missing";
#
#    } elsif (!$ref) {
#
#        my $has_req = $s =~ s/\*\z//;
#        $s =~ $type_re or die "Invalid type syntax $s, please use ".
#            "letter/digit/underscore only";
#        return [$s, $has_req ? {req=>1} : {}, {}];
#
#    } elsif ($ref eq 'ARRAY') {
#
#        my $t = $s->[0];
#        my $has_req = $t && $t =~ s/\*\z//;
#        if (!defined($t)) {
#            die "For array form, at least 1 element is needed for type";
#        } elsif (ref $t) {
#            die "For array form, first element must be a string";
#        }
#        $t =~ $type_re or die "Invalid type syntax $s, please use ".
#            "letter/digit/underscore only";
#
#        my $clset0;
#        my $extras;
#        if (defined($s->[1])) {
#            if (ref($s->[1]) eq 'HASH') {
#                $clset0 = $s->[1];
#                $extras = $s->[2];
#                die "For array form, there should not be more than 3 elements"
#                    if @$s > 3;
#            } else {
#                # flattened clause set [t, c=>1, c2=>2, ...]
#                die "For array in the form of [t, c1=>1, ...], there must be ".
#                    "3 elements (or 5, 7, ...)"
#                        unless @$s % 2;
#                $clset0 = { @{$s}[1..@$s-1] };
#            }
#        } else {
#            $clset0 = {};
#        }
#
#        # check clauses and parse shortcuts (!c, c&, c|, c=)
#        my $clset = normalize_clset($clset0, {has_req=>$has_req});
#        if (defined $extras) {
#            die "For array form with 3 elements, extras must be hash"
#                unless ref($extras) eq 'HASH';
#            die "'def' in extras must be a hash"
#                if exists $extras->{def} && ref($extras->{def}) ne 'HASH';
#            return [$t, $clset, { %{$extras} }];
#        } else {
#            return [$t, $clset, {}];
#        }
#    }
#
#    die "Schema must be a string or arrayref (not $ref)";
#}
#
#1;
## ABSTRACT: Normalize Sah schema
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Sah::Normalize - Normalize Sah schema
#
#=head1 VERSION
#
#This document describes version 0.050 of Data::Sah::Normalize (from Perl distribution Data-Sah-Normalize), released on 2018-09-10.
#
#=head1 SYNOPSIS
#
# use Data::Sah::Normalize qw(normalize_clset normalize_schema);
#
# my $nclset = normalize_clset({'!a'=>1}); # -> {a=>1, 'a.op'=>'not'}
# my $nsch   = normalize_schema("int");    # -> ["int", {}, {}]
#
#=head1 DESCRIPTION
#
#This often-needed functionality is split from the main L<Data::Sah> to keep it
#in a small and minimal-dependencies package.
#
#=head1 FUNCTIONS
#
#=head2 normalize_clset($clset) => HASH
#
#Normalize a clause set (hash). Return a shallow copy of the original hash. Die
#on failure.
#
#TODO: option to recursively normalize clause which contains sah clauses (e.g.
#C<of>).
#
#=head2 normalize_schema($sch) => ARRAY
#
#Normalize a Sah schema (scalar or array). Return an array. Produce a 2-level
#copy of schema, so it's safe to add/delete/modify the normalized schema's clause
#set and extras (but clause set's and extras' values are still references to the
#original). Die on failure.
#
#TODO: recursively normalize clause which contains sah clauses (e.g. C<of>).
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Normalize>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Normalize>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-Normalize>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Sah>, L<Data::Sah>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2018, 2015, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Getopt/Long/EvenLess.pm ###
#package Getopt::Long::EvenLess;
#
#our $DATE = '2019-02-02'; # DATE
#our $VERSION = '0.112'; # VERSION
#
## IFUNBUILT
## # use strict 'subs', 'vars';
## # use warnings;
## END IFUNBUILT
#
#our @EXPORT   = qw(GetOptions);
#our @EXPORT_OK = qw(GetOptionsFromArray);
#
#my $config = {
#    pass_through => 0,
#    auto_abbrev => 1,
#};
#
#sub Configure {
#    my $old_config = { %$config };
#
#    if (ref($_[0]) eq 'HASH') {
#        for (keys %{$_[0]}) {
#            $config->{$_} = $_[0]{$_};
#        }
#    } else {
#        for (@_) {
#            if ($_ eq 'pass_through') {
#                $config->{pass_through} = 1;
#            } elsif ($_ eq 'no_pass_through') {
#                $config->{pass_through} = 0;
#            } elsif ($_ eq 'auto_abbrev') {
#                $config->{auto_abbrev} = 1;
#            } elsif ($_ eq 'no_auto_abbrev') {
#                $config->{auto_abbrev} = 0;
#            } elsif ($_ =~ /\A(no_ignore_case|no_getopt_compat|gnu_compat|bundling|permute)\z/) {
#                # ignore, already behaves that way
#            } else {
#                die "Unknown configuration '$_'";
#            }
#        }
#    }
#    $old_config;
#}
#
#sub import {
#    my $pkg = shift;
#    my $caller = caller;
#    my @imp = @_ ? @_ : @EXPORT;
#    for my $imp (@imp) {
#        if (grep {$_ eq $imp} (@EXPORT, @EXPORT_OK)) {
#            *{"$caller\::$imp"} = \&{$imp};
#        } else {
#            die "$imp is not exported by ".__PACKAGE__;
#        }
#    }
#}
#
#sub GetOptionsFromArray {
#    my ($argv, %spec) = @_;
#
#    my $success = 1;
#
#    my %spec_by_opt_name;
#    for (keys %spec) {
#        my $orig = $_;
#        s/=[fios][@%]?\z//;
#        s/\|.+//;
#        $spec_by_opt_name{$_} = $orig;
#    }
#
#    my $code_find_opt = sub {
#        my ($wanted, $short_mode) = @_;
#        my @candidates;
#      OPT_SPEC:
#        for my $spec (keys %spec) {
#            $spec =~ s/=[fios][@%]?\z//;
#            my @opts = split /\|/, $spec;
#            for my $o (@opts) {
#                next if $short_mode && length($o) > 1;
#                if ($o eq $wanted) {
#                    # perfect match, we immediately go with this one
#                    @candidates = ($opts[0]);
#                    last OPT_SPEC;
#                } elsif ($config->{auto_abbrev} && index($o, $wanted) == 0) {
#                    # prefix match, collect candidates first
#                    push @candidates, $opts[0];
#                    next OPT_SPEC;
#                }
#            }
#        }
#        if (!@candidates) {
#            unless ($config->{pass_through}) {
#                warn "Unknown option: $wanted\n";
#                $success = 0;
#            }
#            return undef; # means unknown
#        } elsif (@candidates > 1) {
#            unless ($config->{pass_through}) {
#                warn "Option $wanted is ambiguous (" .
#                    join(", ", @candidates) . ")\n";
#                $success = 0;
#            }
#            return ''; # means ambiguous
#        }
#        return $candidates[0];
#    };
#
#    my $code_set_val = sub {
#        my $name = shift;
#
#        my $spec_key = $spec_by_opt_name{$name};
#        my $destination = $spec{$spec_key};
#
#        $destination->({name=>$name}, @_ ? $_[0] : 1);
#    };
#
#    my $i = -1;
#    my @remaining;
#  ELEM:
#    while (++$i < @$argv) {
#        if ($argv->[$i] eq '--') {
#
#            push @remaining, @{$argv}[$i+1 .. @$argv-1];
#            last ELEM;
#
#        } elsif ($argv->[$i] =~ /\A--(.+?)(?:=(.*))?\z/) {
#
#            my ($used_name, $val_in_opt) = ($1, $2);
#            my $opt = $code_find_opt->($used_name);
#            if (!defined($opt)) {
#                # unknown option
#                push @remaining, $argv->[$i];
#                next ELEM;
#            } elsif (!length($opt)) {
#                push @remaining, $argv->[$i];
#                next ELEM; # ambiguous
#            }
#
#            my $spec = $spec_by_opt_name{$opt};
#            # check whether option requires an argument
#            if ($spec =~ /=[fios][@%]?\z/) {
#                if (defined $val_in_opt) {
#                    # argument is taken after =
#                    $code_set_val->($opt, $val_in_opt);
#                } else {
#                    if ($i+1 >= @$argv) {
#                        # we are the last element
#                        warn "Option $used_name requires an argument\n";
#                        $success = 0;
#                        last ELEM;
#                    }
#                    $i++;
#                    $code_set_val->($opt, $argv->[$i]);
#                }
#            } else {
#                $code_set_val->($opt);
#            }
#
#        } elsif ($argv->[$i] =~ /\A-(.*)/) {
#
#            my $str = $1;
#            my $remaining_pushed;
#          SHORT_OPT:
#            while ($str =~ s/(.)//) {
#                my $used_name = $1;
#                my $short_opt = $1;
#                my $opt = $code_find_opt->($short_opt, 'short');
#                if (!defined $opt) {
#                    # unknown short option
#                    push @remaining, "-" unless $remaining_pushed++;
#                    $remaining[-1] .= $short_opt;
#                    next SHORT_OPT;
#                } elsif (!length $opt) {
#                    # ambiguous short option
#                    push @remaining, "-" unless $remaining_pushed++;
#                    $remaining[-1] .= $short_opt;
#                }
#
#                my $spec = $spec_by_opt_name{$opt};
#                # check whether option requires an argument
#                if ($spec =~ /=[fios][@%]?\z/) {
#                    if (length $str) {
#                        # argument is taken from $str
#                        $code_set_val->($opt, $str);
#                        next ELEM;
#                    } else {
#                        if ($i+1 >= @$argv) {
#                            # we are the last element
#                            unless ($config->{pass_through}) {
#                                warn "Option $used_name requires an argument\n";
#                                $success = 0;
#                            }
#                            last ELEM;
#                        }
#                        # take the next element as argument
#                        $i++;
#                        $code_set_val->($opt, $argv->[$i]);
#                    }
#                } else {
#                    $code_set_val->($opt);
#                }
#            }
#
#        } else { # argument
#
#            push @remaining, $argv->[$i];
#            next;
#
#        }
#    }
#
#  RETURN:
#    splice @$argv, 0, ~~@$argv, @remaining; # replace with remaining elements
#    return $success;
#}
#
#sub GetOptions {
#    GetOptionsFromArray(\@ARGV, @_);
#}
#
#1;
## ABSTRACT: Like Getopt::Long::Less, but with even less features
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Getopt::Long::EvenLess - Like Getopt::Long::Less, but with even less features
#
#=head1 VERSION
#
#This document describes version 0.112 of Getopt::Long::EvenLess (from Perl distribution Getopt-Long-EvenLess), released on 2019-02-02.
#
#=head1 DESCRIPTION
#
#This module (GLEL for short) is a reimplementation of L<Getopt::Long> (GL for
#short), but with much less features. It's an even more stripped down version of
#L<Getopt::Long::Less> (GLL for short) and is perhaps less convenient to use for
#day-to-day scripting work.
#
#The main goal is minimum amount of code and small startup overhead. This module
#is an experiment of how little code I can use to support the stuffs I usually do
#with GL.
#
#Compared to GL and GLL, it:
#
#=over
#
#=item * has minimum Configure() support
#
#Only these configurations are known: pass_through, no_pass_through (default).
#
#GLEL is equivalent to GL in this mode: bundling, no_ignore_case,
#no_getopt_compat, gnu_compat, permute.
#
#No support for configuring via import options e.g.:
#
# use Getopt::Long qw(:config pass_through);
#
#=item * does not support increment (C<foo+>)
#
#=item * no type checking (C<foo=i>, C<foo=f>, C<foo=s> all accept any string)
#
#=item * does not support optional value (C<foo:s>), only no value (C<foo>) or required value (C<foo=s>)
#
#=item * does not support desttypes (C<foo=s@>)
#
#=item * does not support destination other than coderef (so no C<< "foo=s" => \$scalar >>, C<< "foo=s" => \@ary >>, no C<< "foo=s" => \%hash >>, only C<< "foo=s" => sub { ... } >>)
#
#Also, in coderef destination, code will get a simple hash instead of a
#"callback" object as its first argument.
#
#=item * does not support hashref as first argument
#
#=item * does not support bool/negation (no C<foo!>, so you have to declare both C<foo> and C<no-foo> manually)
#
#=back
#
#The result?
#
#B<Amount of code>. GLEL 0.07 is about 175 lines of code, while GL is about 1500.
#Sure, if you I<really> want to be minimalistic, you can use this single line of
#code to get options:
#
# @ARGV = grep { /^--([^=]+)(=(.*))?/ ? ($opts{$1} = $2 ? $3 : 1, 0) : 1 } @ARGV;
#
#and you're already able to extract C<--flag> or C<--opt=val> from C<@ARGV> but
#you also lose a lot of stuffs like autoabbreviation, C<--opt val> syntax support
#syntax (which is more common, but requires you specify an option spec), custom
#destination, etc.
#
#=head1 FUNCTIONS
#
#=head2 Configure(@configs | \%config) => hash
#
#Set configuration. Known configurations:
#
#=over
#
#=item * pass_through
#
#Ignore errors (unknown/ambiguous option) and still make GetOptions return true.
#
#=item * no_pass_through (default)
#
#=item * no_auto_abbrev
#
#=item * auto_abbrev (default)
#
#=item * no_ignore_case
#
#=item * no_getopt_compat
#
#=item * gnu_compat
#
#=item * bundling
#
#=item * permute
#
#=back
#
#Return old configuration data. To restore old configuration data you can pass it
#back to C<Configure()>, e.g.:
#
# my $orig_conf = Getopt::Long::EvenLess::Configure("pass_through");
# # ...
# Getopt::Long::EvenLess::Configure($orig_conf);
#
#=head2 GetOptions(%spec) => bool
#
#Shortcut for:
#
# GetOptionsFromArray(\@ARGV, %spec)
#
#=head2 GetOptionsFromArray(\@ary, %spec) => bool
#
#Get (and strip) options from C<@ary>. Return true on success or false on failure
#(unknown option, etc).
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Getopt-Long-EvenLess>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Getopt-Long-EvenLess>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Getopt-Long-EvenLess>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Getopt::Long>
#
#L<Getopt::Long::Less>
#
#If you want I<more> features intead of less, try L<Getopt::Long::More>.
#
#Benchmarks in L<Bencher::Scenario::GetoptModules>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2017, 2016, 2015 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Local/_pci_check_args.pm ###
#sub _pci_check_args {
#    my ($args) = @_;
#    my $sc_name = $_pci_r->{subcommand_name};
#    if ($sc_name eq "") {
#      FILL_FROM_POS: {
#            1;
#            if (@ARGV > 0) { if (exists $args->{"dates"}) { return [400, "You specified --date but also argument #0"]; } else { $args->{"dates"} = [splice(@ARGV, 0)]; } }
#        }
#        my @check_argv = @ARGV;
#        # fill from cmdline_src
#
#        # fill defaults from "default" property and check against schema
#        no warnings ('void');
#        require List::Util;
#        require Scalar::Util;
#        require DateTime::Format::Natural;
#        require DateTime;
#        my $_sahv_dpath;
#        my $_sahv_err;
#        if (exists $args->{"dates"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"dates"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'array'
#            ((ref($args->{"dates"}) eq 'ARRAY') ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type array"),0))
#            
#            &&
#            
#            (# clause: min_len
#            ((@{$args->{"dates"}} >= 1) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Length must be at least 1"),0)))
#            
#            &&
#            
#            ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
#            ((!defined(List::Util::first(sub {!(
#                        ($_sahv_dpath->[-1] = $_),
#                        # req #0
#                        ((defined($args->{"dates"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#                        
#                        &&
#                        
#                        # coerce rule(s): From_float::epoch, From_obj::datetime, From_obj::time_moment, From_str::iso8601, From_str::natural # coerce to: DateTime
#                        (($args->{"dates"}->[$_] = (!ref($args->{"dates"}->[$_]) && $args->{"dates"}->[$_] =~ /\A[0-9]{8,10}(?:.[0-9]+)?\z/ && $args->{"dates"}->[$_] >= 10**8 && $args->{"dates"}->[$_] <= 2**31) ? [undef,DateTime->from_epoch(epoch => $args->{"dates"}->[$_])] : ((Scalar::Util::blessed($args->{"dates"}->[$_]) && $args->{"dates"}->[$_]->isa('DateTime')) ? [undef,$args->{"dates"}->[$_]] : ((Scalar::Util::blessed($args->{"dates"}->[$_]) && $args->{"dates"}->[$_]->isa('Time::Moment')) ? [undef,DateTime->from_epoch(epoch => $args->{"dates"}->[$_]->epoch, time_zone => sprintf('%s%04d', $args->{"dates"}->[$_]->offset >= 0 ? '+':'-', abs(int($args->{"dates"}->[$_]->offset / 60)*100) + abs(int($args->{"dates"}->[$_]->offset % 60))))] : ((!ref($args->{"dates"}->[$_]) && $args->{"dates"}->[$_] =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})(?:([T ])([0-9]{2}):([0-9]{2}):([0-9]{2})(Z?))?\z/) ? (do { my $time; eval { $time = DateTime->new(year=>$1, month=>$2, day=>$3, ((hour=>$5, minute=>$6, second=>$7) x !!$4), time_zone => $8 ? 'UTC' : 'local') };                                                              my $err = $@; if ($err) { $err =~ s/ at .+//s; ["Invalid date/time: $err"] } else { [undef, $time] } }) : ((!ref($args->{"dates"}->[$_])) ? (do { my $p = DateTime::Format::Natural->new(time_zone => "UTC"); my $datetime = $p->parse_datetime($args->{"dates"}->[$_]); if (!$p->success) { [$p->error] } else { [undef, $datetime] } }) : [undef,$args->{"dates"}->[$_]]))))), defined($args->{"dates"}->[$_]->[0]) ? (($_sahv_err //= $args->{"dates"}->[$_]->[0]), ($args->{"dates"}->[$_] = $args->{"dates"}->[$_]->[1]), '') : (($args->{"dates"}->[$_] = $args->{"dates"}->[$_]->[1]), 1))
#                        
#                        &&
#                        
#                        # check type 'date'
#                        ((Scalar::Util::blessed($args->{"dates"}->[$_]) && $args->{"dates"}->[$_]->isa('DateTime')) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type date"),0))
#                        )}, 0..@{$args->{"dates"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type date"),0))), pop(@{$_sahv_dpath})]->[1])
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#
#        # check required args
#        return [400, "Missing required argument: dates"] unless exists $args->{"dates"};
#        return [400, "Missing required value for argument: dates"] if exists($args->{"dates"}) && !defined($args->{"dates"});
#        _pci_err([500, "Extraneous command-line argument(s): ".join(", ", @check_argv)]) if @check_argv;
#        [200];
#    } else { _pci_err([500, "Unknown subcommand1: $sc_name"]); }
#}
#1;
### Local/_pci_clean_json.pm ###
#sub _pci_clean_json { require Scalar::Util; require Clone::PP;  use feature 'state'; state $cleanser = sub {
#my $data = shift;
#state %refs;
#state $ctr_circ;
#state $process_array;
#state $process_hash;
#if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { my $ref=ref($e);
#    if ($ref && $refs{ $e }++) { if (++$ctr_circ <= 1) { $e = Clone::PP::clone($e); redo } else { $e = 'CIRCULAR'; $ref = '' } }
#    elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $e = $e ? 1:0; $ref = '' }
#    elsif ($ref eq 'DateTime') { $e = $e->epoch; $ref = ref($e) }
#    elsif ($ref eq 'JSON::PP::Boolean') { $e = $e ? 1:0; $ref = '' }
#    elsif ($ref eq 'JSON::XS::Boolean') { $e = $e ? 1:0; $ref = '' }
#    elsif ($ref eq 'Math::BigInt') { $e = $e->bstr; $ref = ref($e) }
#    elsif ($ref eq 'Regexp') { $e = "$e"; $ref = "" }
#    elsif ($ref eq 'SCALAR') { $e = ${ $e }; $ref = ref($e) }
#    elsif ($ref eq 'Time::Moment') { $e = $e->epoch; $ref = ref($e) }
#    elsif ($ref eq 'version') { $e = "$e"; $ref = "" }
#    elsif (Scalar::Util::blessed($e)) { my $reftype = Scalar::Util::reftype($e); $e = $reftype eq "HASH" ? {%{ $e }} : $reftype eq "ARRAY" ? [@{ $e }] : $reftype eq "SCALAR" ? \(my $copy = ${ $e }) : $reftype eq "CODE" ? sub { goto &{ $e } } :(die "Cannot unbless object with type $ref") }
#    my $reftype=Scalar::Util::reftype($e)//"";
#    if ($reftype eq "ARRAY") { $process_array->($e) }
#    elsif ($reftype eq "HASH") { $process_hash->($e) }
#    elsif ($ref) { $e = $ref; $ref = "" }
#} } }
#if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { my $ref=ref($h->{$k});
#    if ($ref && $refs{ $h->{$k} }++) { if (++$ctr_circ <= 1) { $h->{$k} = Clone::PP::clone($h->{$k}); redo } else { $h->{$k} = 'CIRCULAR'; $ref = '' } }
#    elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
#    elsif ($ref eq 'DateTime') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'JSON::PP::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
#    elsif ($ref eq 'JSON::XS::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
#    elsif ($ref eq 'Math::BigInt') { $h->{$k} = $h->{$k}->bstr; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'Regexp') { $h->{$k} = "$h->{$k}"; $ref = "" }
#    elsif ($ref eq 'SCALAR') { $h->{$k} = ${ $h->{$k} }; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'Time::Moment') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'version') { $h->{$k} = "$h->{$k}"; $ref = "" }
#    elsif (Scalar::Util::blessed($h->{$k})) { my $reftype = Scalar::Util::reftype($h->{$k}); $h->{$k} = $reftype eq "HASH" ? {%{ $h->{$k} }} : $reftype eq "ARRAY" ? [@{ $h->{$k} }] : $reftype eq "SCALAR" ? \(my $copy = ${ $h->{$k} }) : $reftype eq "CODE" ? sub { goto &{ $h->{$k} } } :(die "Cannot unbless object with type $ref") }
#    my $reftype=Scalar::Util::reftype($h->{$k})//"";
#    if ($reftype eq "ARRAY") { $process_array->($h->{$k}) }
#    elsif ($reftype eq "HASH") { $process_hash->($h->{$k}) }
#    elsif ($ref) { $h->{$k} = $ref; $ref = "" }
#} } }
#%refs = (); $ctr_circ=0;
#for ($data) { my $ref=ref($_);
#    if ($ref && $refs{ $_ }++) { if (++$ctr_circ <= 1) { $_ = Clone::PP::clone($_); redo } else { $_ = 'CIRCULAR'; $ref = '' } }
#    elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $_ = $_ ? 1:0; $ref = '' }
#    elsif ($ref eq 'DateTime') { $_ = $_->epoch; $ref = ref($_) }
#    elsif ($ref eq 'JSON::PP::Boolean') { $_ = $_ ? 1:0; $ref = '' }
#    elsif ($ref eq 'JSON::XS::Boolean') { $_ = $_ ? 1:0; $ref = '' }
#    elsif ($ref eq 'Math::BigInt') { $_ = $_->bstr; $ref = ref($_) }
#    elsif ($ref eq 'Regexp') { $_ = "$_"; $ref = "" }
#    elsif ($ref eq 'SCALAR') { $_ = ${ $_ }; $ref = ref($_) }
#    elsif ($ref eq 'Time::Moment') { $_ = $_->epoch; $ref = ref($_) }
#    elsif ($ref eq 'version') { $_ = "$_"; $ref = "" }
#    elsif (Scalar::Util::blessed($_)) { my $reftype = Scalar::Util::reftype($_); $_ = $reftype eq "HASH" ? {%{ $_ }} : $reftype eq "ARRAY" ? [@{ $_ }] : $reftype eq "SCALAR" ? \(my $copy = ${ $_ }) : $reftype eq "CODE" ? sub { goto &{ $_ } } :(die "Cannot unbless object with type $ref") }
#    my $reftype=Scalar::Util::reftype($_)//"";
#    if ($reftype eq "ARRAY") { $process_array->($_) }
#    elsif ($reftype eq "HASH") { $process_hash->($_) }
#    elsif ($ref) { $_ = $ref; $ref = "" }
#}
#$data
#}
#;; $cleanser->(shift) }
#1;
### Log/ger.pm ###
#package Log::ger;
#
#our $DATE = '2019-05-06'; # DATE
#our $VERSION = '0.028'; # VERSION
#
##IFUNBUILT
## use strict 'subs', 'vars';
## use warnings;
##END IFUNBUILT
#
#our $re_addr = qr/\(0x([0-9a-f]+)/o;
#
#our %Levels = (
#    fatal   => 10,
#    error   => 20,
#    warn    => 30,
#    info    => 40,
#    debug   => 50,
#    trace   => 60,
#);
#
#our %Level_Aliases = (
#    off     => 0,
#    warning => 30,
#);
#
#our $Current_Level = 30;
#
#our $Caller_Depth_Offset = 0;
#
## a flag that can be used by null output to skip using formatter
#our $_logger_is_null;
#
#our $_dumper;
#
#our %Global_Hooks;
#
## in Log/ger/Heavy.pm
## our %Default_Hooks = (
#
#our %Package_Targets; # key = package name, value = \%init_args
#our %Per_Package_Hooks; # key = package name, value = { phase => hooks, ... }
#
#our %Hash_Targets; # key = hash address, value = [$hashref, \%init_args]
#our %Per_Hash_Hooks; # key = hash address, value = { phase => hooks, ... }
#
#our %Object_Targets; # key = object address, value = [$obj, \%init_args]
#our %Per_Object_Hooks; # key = object address, value = { phase => hooks, ... }
#
#my $sub0 = sub {0};
#my $sub1 = sub {1};
#my $default_null_routines;
#
#sub install_routines {
#    my ($target, $target_arg, $routines, $name_routines) = @_;
#
#    if ($name_routines && !defined &subname) {
#        if (eval { require Sub::Name; 1 }) {
#            *subname = \&Sub::Name::subname;
#        } else {
#            *subname = sub {};
#        }
#    }
#
#    if ($target eq 'package') {
##IFUNBUILT
##         no warnings 'redefine';
##END IFUNBUILT
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            #print "D:installing $name to package $target_arg\n";
#            *{"$target_arg\::$name"} = $code;
#            subname("$target_arg\::$name", $code) if $name_routines;
#        }
#    } elsif ($target eq 'object') {
##IFUNBUILT
##         no warnings 'redefine';
##END IFUNBUILT
#        my $pkg = ref $target_arg;
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_method\z/;
#            *{"$pkg\::$name"} = $code;
#            subname("$pkg\::$name", $code) if $name_routines;
#        }
#    } elsif ($target eq 'hash') {
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            $target_arg->{$name} = $code;
#        }
#    }
#}
#
#sub add_target {
#    my ($target, $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 _set_default_null_routines {
#    $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 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 {
#        # if we haven't added any hooks etc, skip init_target() process and use
#        # this preconstructed routines as shortcut, to save startup overhead
#        _set_default_null_routines();
#        install_routines(object => $obj, $default_null_routines, 0);
#    }
#    $obj; # XXX add DESTROY to remove from list of targets
#}
#
#sub import {
#    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 {
#        # if we haven't added any hooks etc, skip init_target() process and use
#        # this preconstructed routines as shortcut, to save startup overhead
#        _set_default_null_routines();
#        install_routines(package => $caller, $default_null_routines, 0);
#    }
#}
#
#1;
## ABSTRACT: A lightweight, flexible logging framework
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger - A lightweight, flexible logging framework
#
#=head1 VERSION
#
#version 0.028
#
#=head1 SYNOPSIS
#
#In your module (producer):
#
# package Foo;
# use Log::ger; # will import some logging methods e.g. log_warn, log_error
#
# sub foo {
#     ...
#     # produce some logs
#     log_error "an error occurred: %03d - %s", $errcode, $errmsg;
#     ...
#     log_debug "http response: %s", $http; # automatic dumping of data
# }
# 1;
#
#In your application (consumer/listener):
#
# use Foo;
# use Log::ger::Output 'Screen';
#
# foo();
#
#=head1 DESCRIPTION
#
#Log::ger is yet another logging framework with the following features:
#
#=over
#
#=item * Separation of producers and consumers/listeners
#
#Like L<Log::Any>, this offers a very easy way for modules to produce some logs
#without having to configure anything. Configuring output, level, etc can be done
#in the application as log consumers/listeners. To read more about this, see the
#documentation of L<Log::Any> or L<Log::ger::Manual> (but nevertheless see
#L<Log::ger::Manual> on why you might prefer Log::ger to Log::Any).
#
#=item * Lightweight and fast
#
#B<Slim distribution.> No non-core dependencies, extra functionalities are
#provided in separate distributions to be pulled as needed.
#
#B<Low startup overhead.> Only ~0.5-1ms. For comparison, L<strict> ~0.2-0.5ms,
#L<warnings> ~2ms, L<Log::Any> 0.15 ~2-3ms, Log::Any 1.049 ~8-10ms,
#L<Log::Log4perl> ~35ms. This is measured on a 2014-2015 PC and before doing any
#output configuration. I strive to make C<use Log::ger;> statement to be roughly
#as light as C<use strict;> or C<use warnings;> so the impact of adding the
#statement is really minimal and you can just add logging without much thought to
#most of your modules. This is important to me because I want logging to be
#pervasive.
#
#To test for yourself, try e.g. with L<bencher-code>:
#
# % bencher-code 'use Log::ger' 'use Log::Any' --startup
#
#B<Fast>. Low null-/stealth-logging overhead, about 1.5x faster than Log::Any, 3x
#faster than Log4perl, 5x faster than L<Log::Fast>, ~40x faster than
#L<Log::Contextual>, and ~100x faster than L<Log::Dispatch>.
#
#For more benchmarks, see L<Bencher::Scenarios::LogGer>.
#
#B<Conditional compilation.> There is a plugin to optimize away unneeded logging
#statements, like assertion/conditional compilation, so they have zero runtime
#performance cost. See L<Log::ger::Plugin::OptAway>.
#
#Being lightweight means the module can be used more universally, from CLI to
#long-running daemons to inside routines with tight loops.
#
#=item * Flexible
#
#B<Customizable levels and routine/method names.> Can be used in a procedural or
#OO style. Log::ger can mimic the interface of L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, or some other popular logging frameworks, to ease migration or
#adjust with your personal style.
#
#B<Per-package settings.> Each importer package can use its own format/layout,
#output. For example, a module that is migrated from Log::Any uses Log::Any-style
#logging, while another uses native Log::ger style, and yet some other uses block
#formatting like Log::Contextual. This eases code migration and teamwork. Each
#module author can preserve her own logging style, if wanted, and all the modules
#still use the same framework.
#
#B<Dynamic.> Outputs and levels can be changed anytime during run-time and
#logging routines will be updated automatically. This is useful in situation like
#a long-running server application: you can turn on tracing logs temporarily to
#debug problems, then turn them off again, without restarting your server.
#
#B<Interoperability.> There are modules to interop with Log::Any, either consume
#Log::Any logs (see L<Log::Any::Adapter::LogGer>) or produce logs to be consumed
#by Log::Any (see L<Log::ger::Output::LogAny>).
#
#B<Many output modules and plugins.> See C<Log::ger::Output::*>,
#C<Log::ger::Format::*>, C<Log::ger::Layout::*>, C<Log::ger::Plugin::*>. Writing
#an output module in Log::ger is easier than writing a Log::Any::Adapter::*.
#
#=back
#
#For more documentation, start with L<Log::ger::Manual>.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#Some other popular logging frameworks: L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, L<Log::Dispatch>, L<Log::Dispatchouli>.
#
#If you still prefer debugging using the good old C<print()>, there's
#L<Debug::Print>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2017 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Perinci/CmdLine/Util/Config.pm ###
#package Perinci::CmdLine::Util::Config;
#
#our $DATE = '2019-05-29'; # DATE
#our $VERSION = '1.722'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter qw(import);
#our @EXPORT_OK = (
#    'get_default_config_dirs',
#    'read_config',
#    'get_args_from_config',
#);
#
#our %SPEC;
#
## from PERLANCAR::File::HomeDir 0.03, with minor modification
#sub _get_my_home_dir {
#    if ($^O eq 'MSWin32') {
#        # File::HomeDir always uses exists($ENV{x}) first, does it want to avoid
#        # accidentally creating env vars?
#        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;
#    #local $PERLANCAR::File::HomeDir::DIE_ON_FAILURE = 1;
#    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    => {},
#        # TODO: hook_file
#        hook_section    => {},
#        # TODO: hook_param?
#    },
#};
#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;
#  FILE:
#    for my $i (0..$#{$paths}) {
#        my $path           = $paths->[$i];
#        my $filename = $path; $filename =~ s!.*[/\\]!!;
#        my $wanted_section = $section_config_filename_map{$filename};
#        log_trace "[pericmd] Reading config file '%s' ...", $path;
#        my $j = 0;
#        $section_read_order{GLOBAL} = [$i, $j++];
#        my @file_sections = ("GLOBAL");
#        my $hoh = $reader->read_file(
#            $path,
#            sub {
#                my %args = @_;
#                return unless $args{event} eq 'section';
#                my $section = $args{section};
#                push @file_sections, $section
#                    unless grep {$section eq $_} @file_sections;
#                $section_read_order{$section} = [$i, $j++];
#            },
#        );
#        push @read, $path;
#      SECTION:
#        for my $section (@file_sections) {
#            my $hash = $hoh->{$section};
#
#            my $s = $section; $s =~ s/\s*\S*=.*\z//; # strip key=value pairs
#            $s = 'GLOBAL' if $s eq '';
#
#            if ($args{hook_section}) {
#                my $res = $args{hook_section}->($section, $hash);
#                if ($res->[0] == 204) {
#                    log_trace "[pericmd] Skipped config section '$section' ".
#                        "in file '$path': hook_section returns 204";
#                    next SECTION;
#                } elsif ($res->[0] >= 400 && $res->[0] <= 599) {
#                    return [$res->[0], "Error when reading config file '$path'".
#                                ": $res->[1]"];
#                }
#            }
#
#            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 {
#        # sort according to the order the section is seen in the file
#        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 debugging message
#    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 there is a subcommand name, use section with no subcommand=... or
#        # the matching subcommand
#        if (length $scn) {
#            if (length($sect_scn) && $sect_scn ne $scn) {
#                log_trace(
#                    "[pericmd] Skipped config section '%s' (%s)",
#                    $section0, "subcommand does not match '$scn'",
#                );
#                next;
#            }
#        } else {
#            if (length $sect_scn) {
#                log_trace(
#                    "[pericmd] Skipped config section '%s' (%s)",
#                    $section0, "only for a certain subcommand",
#                );
#                next;
#            }
#        }
#
#        # if user chooses a profile, only use section with no profile=... or the
#        # matching profile
#        if (defined $profile) {
#            if (defined($sect_profile) && $sect_profile ne $profile) {
#                log_trace(
#                    "[pericmd] Skipped config section '%s' (%s)",
#                    $section0, "profile does not match '$profile'",
#                );
#                next;
#            }
#            $found = 1 if defined($sect_profile) && $sect_profile eq $profile;
#        } else {
#            if (defined($sect_profile)) {
#                log_trace(
#                    "[pericmd] Skipped config section '%s' (%s)",
#                    $section0, "only for a certain profile",
#                );
#                next;
#            }
#        }
#
#        # only use section marked with program=... if the program name matches
#        if (defined($progn) && defined($keyvals{program})) {
#            if ($progn ne $keyvals{program}) {
#                log_trace(
#                    "[pericmd] Skipped config section '%s' (%s)",
#                    $section0, "program does not match '$progn'",
#                );
#                next;
#            }
#        }
#
#        # if user specifies env=... then apply filtering by ENV variable
#        if (defined(my $env = $keyvals{env})) {
#            my ($var, $val);
#            if (($var, $val) = $env =~ /\A(\w+)=(.*)\z/) {
#                if (($ENV{$var} // '') ne $val) {
#                    log_trace(
#                        "[pericmd] Skipped config section '%s' (%s)",
#                        $section0, "env $var has non-matching value '".
#                            ($ENV{$var} // '')."'",
#                    );
#                    next;
#                }
#            } elsif (($var, $val) = $env =~ /\A(\w+)!=(.*)\z/) {
#                if (($ENV{$var} // '') eq $val) {
#                    log_trace(
#                        "[pericmd] Skipped config section '%s' (%s)",
#                        $section0, "env $var has that value",
#                    );
#                    next;
#                }
#            } elsif (($var, $val) = $env =~ /\A(\w+)\*=(.*)\z/) {
#                if (index(($ENV{$var} // ''), $val) < 0) {
#                    log_trace(
#                        "[pericmd] Skipped config section '%s' (%s)",
#                        $section0, "env $var has value '".
#                            ($ENV{$var} // '')."' which does not contain the ".
#                                "requested string"
#                    );
#                    next;
#                }
#            } else {
#                if (!$ENV{$env}) {
#                    log_trace(
#                        "[pericmd] Skipped config section '%s' (%s)",
#                        $section0, "env $env is not set/true",
#                    );
#                    next;
#                }
#            }
#        }
#
#        log_trace("[pericmd] Reading config section '%s'", $section0);
#
#        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);
#                    # since IOD might return a scalar or an array (depending on
#                    # whether there is a single param=val or multiple param=
#                    # lines), we need to arrayify the value if the argument is
#                    # expected to be an array.
#                    if (ref($v) ne 'ARRAY' && $sch->[0] eq 'array') {
#                        $v = [$v];
#                    }
#                }
#                $copts->{$k}{handler}->(undef, $v, $r);
#            } else {
#                # when common option clashes with function argument name, user
#                # can use NAME.arg to refer to function argument.
#                $k =~ s/\.arg\z//;
#
#                # since IOD might return a scalar or an array (depending on
#                # whether there is a single param=val or multiple param= lines),
#                # we need to arrayify the value if the argument is expected to
#                # be an array.
#                if (ref($v) ne 'ARRAY' && $as->{$k} && $as->{$k}{schema} &&
#                        $as->{$k}{schema}[0] eq 'array') {
#                    $v = [$v];
#                }
#                $args->{$k} = $v;
#            }
#        }
#    }
#    log_trace("[pericmd] Seen config profiles: %s",
#              [sort keys %seen_profiles]);
#
#    [200, "OK", $args, {'func.found'=>$found}];
#}
#
#1;
## ABSTRACT: Utility routines related to config files
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::CmdLine::Util::Config - Utility routines related to config files
#
#=head1 VERSION
#
#This document describes version 1.722 of Perinci::CmdLine::Util::Config (from Perl distribution Perinci-CmdLine-Util-Config), released on 2019-05-29.
#
#=head1 FUNCTIONS
#
#
#=head2 get_args_from_config
#
#Usage:
#
# get_args_from_config(%args) -> [status, msg, payload, meta]
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<args> => I<any>
#
#=item * B<common_opts> => I<any>
#
#=item * B<config> => I<any>
#
#=item * B<config_profile> => I<any>
#
#=item * B<meta> => I<any>
#
#=item * B<meta_is_normalized> => I<any>
#
#=item * B<r> => I<any>
#
#=item * B<subcommand_name> => I<any>
#
#=back
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#
#=head2 get_default_config_dirs
#
#Usage:
#
# get_default_config_dirs() -> [status, msg, payload, meta]
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#
#=head2 read_config
#
#Usage:
#
# read_config(%args) -> [status, msg, payload, meta]
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<config_dirs> => I<any>
#
#=item * B<config_filename> => I<any>
#
#=item * B<config_paths> => I<any>
#
#=item * B<hook_section> => I<any>
#
#=item * B<program_name> => I<any>
#
#=back
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-CmdLine-Util-Config>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-CmdLine-Util-Config>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-CmdLine-Util-Config>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2017 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Perinci/Result/Format/Lite.pm ###
#package Perinci::Result::Format::Lite;
#
#our $DATE = '2018-07-04'; # DATE
#our $VERSION = '0.274'; # VERSION
#
#use 5.010001;
##IFUNBUILT
## use strict;
## use warnings;
##END IFUNBUILT
#
#use List::Util qw(first max);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(format);
#
## copy-pasted from List::MoreUtils::PP
#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 //= {};
#
#    # column names
#    my @columns;
#    if ($header_row) {
#        @columns = @{$data->[0]};
#    } else {
#        @columns = map {"col$_"} 0..@{$data->[0]}-1;
#    }
#
#    my $column_orders; # e.g. [col2, col1, col3, ...]
#  SET_COLUMN_ORDERS: {
#
#        # find column orders from 'table_column_orders' in result metadata (or
#        # from env)
#        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) {
#            # find an entry in tcos that @columns contains all the columns of
#          COLS:
#            for my $cols (@$tcos) {
#                for my $col (@$cols) {
#                    next COLS unless first {$_ eq $col} @columns;
#                }
#                $column_orders = $cols;
#                last SET_COLUMN_ORDERS;
#            }
#        }
#
#        if ($resmeta->{'table.field_orders'}) {
#            $column_orders = $resmeta->{'table.field_orders'};
#            last SET_COLUMN_ORDERS;
#        }
#
#        # find column orders from table spec
#        $column_orders = $resmeta->{'table.fields'};
#    }
#
#    # reorder each row according to requested column order
#    if ($column_orders) {
#        require Sort::BySpec;
#        my $cmp = Sort::BySpec::cmp_by_spec(spec => $column_orders);
#        # 0->2, 1->0, ... (map column position from unordered to ordered)
#        my @map0 = sort { $cmp->($a->[1], $b->[1]) }
#            map {[$_, $columns[$_]]} 0..$#columns;
#        #use DD; dd \@map0;
#        my @map;
#        for (0..$#map0) {
#            $map[$_] = $map0[$_][0];
#        }
#        #use DD; dd \@map;
#        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; # map column to index in table.fields
#    {
#        my $tff = $resmeta->{'table.fields'} or last;
#        for my $i (0..$#columns) {
#            $field_idxs[$i] = firstidx { $_ eq $columns[$i] } @$tff;
#        }
#    }
#
#    # determine field labels
#    {
#        last unless $header_row && @$data;
#        my $tff = $resmeta->{'table.fields'} or last;
#        my $tfl = $resmeta->{'table.field_labels'};
#        my $tfu = $resmeta->{'table.field_units'};
#        for my $i (0..$#columns) {
#            my $field_idx = $field_idxs[$i];
#            next unless $field_idx >= 0;
#            if ($tfl && defined $tfl->[$field_idx]) {
#                $data->[0][$i] = $tfl->[$field_idx];
#            } elsif ($tfu && defined $tfu->[$field_idx]) {
#                # add field units as label suffix to header (" (UNIT)")
#                $data->[0][$i] .= " ($tfu->[$field_idx])";
#            }
#        }
#    }
#
#  FORMAT_CELLS:
#    {
#        my $tffmt         = $resmeta->{'table.field_formats'};
#        my $tffmt_code    = $resmeta->{'table.field_format_code'};
#        my $tffmt_default = $resmeta->{'table.default_field_format'};
#        last unless $tffmt || $tffmt_code || $tffmt_default;
#
#        my (@fmt_names, @fmt_opts); # key: column index
#        for my $i (0..$#columns) {
#            my $field_idx = $field_idxs[$i];
#            my $fmt = $tffmt_code ? $tffmt_code->($columns[$i]) : undef;
#            $fmt //= $tffmt->[$field_idx] if $field_idx >= 0;
#            $fmt //= $tffmt_default;
#            if (ref $fmt eq 'ARRAY') {
#                $fmt_names[$i] = $fmt->[0];
#                $fmt_opts [$i] = $fmt->[1] // {};
#            } else {
#                $fmt_names[$i] = $fmt;
#                $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 $fmt_name = $fmt_names[$j];
#                #say "D:j=$j fmt_name=$fmt_name";
#                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]+(\.[0-9]*)?\z/) {
#                        my $frac = $1 ? "0$1"+0 : 0;
#                        my @t = gmtime($row->[$j]);
#                        if ($fmt_name eq 'iso8601_datetime') {
#                            $row->[$j] = sprintf(
#                                "%04d-%02d-%02dT%02d:%02d:".($frac ? "%06.3f" : "%02d")."Z",
#                                $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]+$frac);
#                        } 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') {
#                    require Number::Format::BigFloat;
#                    $row->[$j] = Number::Format::BigFloat::format_number(
#                        $row->[$j], {
#                            thousands_sep  => $fmt_opts->{thousands_sep} // ',',
#                            decimal_point  => $fmt_opts->{decimal_point} // '.',
#                            decimal_digits => $fmt_opts->{precision} // 0,
#                            # XXX decimal_fill
#                        });
#                }
#            }
#        }
#    }
#
#    if ($format eq 'text-pretty') {
#      ALIGN_COLUMNS:
#        {
#            # XXX we just want to turn off 'uninitialized' and 'negative repeat
#            # count does nothing' from the operator x
#            no warnings;
#
#            my $tfa         = $resmeta->{'table.field_aligns'};
#            my $tfa_code    = $resmeta->{'table.field_align_code'};
#            my $tfa_default = $resmeta->{'table.default_field_align'};
#            last unless $tfa || $tfa_code || $tfa_default;
#            last unless @$data;
#
#            for my $colidx (0..$#columns) {
#                my $field_idx = $field_idxs[$colidx];
#                my $align = $tfa_code ? $tfa_code->($columns[$colidx]) : undef;
#                $align //= $tfa->[$field_idx] if $field_idx >= 0;
#                $align //= $tfa_default;
#                next unless $align;
#
#                # determine max widths
#                my $maxw;
#                my ($maxw_bd, $maxw_d, $maxw_ad); # before digit, digit, after d
#                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/) {
#                                # decimal notation number
#                                push @w_bd, length($1);
#                                push @w_d , length($2);
#                                push @w_ad, length($3);
#                            } elsif ($cell =~ /\A([+-]?\d+\.?\d*)([eE])([+-]?\d+)\z/) {
#                                # scientific notation number
#                                push @w_bd, length($1);
#                                push @w_d , length($2);
#                                push @w_ad, length($3);
#                            } else {
#                                # not a number
#                                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);
#
#                # do the alignment
#                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 {
#                            # assumed left
#                            $cell .= (' ' x ($maxw - length($cell)));
#
#                        }
#                        $row->[$colidx] = $cell;
#                    }
#                }
#            } # for $colidx
#        } # END align columns
#
#        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})) {
#                # collect all mentioned fields
#                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;
#
#    if ($format eq 'perl') {
#        my $use_color = $ENV{COLOR} // (-t STDOUT);
#        if ($use_color && eval { require Data::Dump::Color; 1 }) {
#            return Data::Dump::Color::dump($res);
#        } elsif (eval { require Data::Dump; 1 }) {
#            return Data::Dump::dump($res);
#        } else {
#            no warnings 'once';
#            require Data::Dumper;
#            local $Data::Dumper::Terse = 1;
#            local $Data::Dumper::Indent = 1;
#            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;
#            return Data::Dumper::Dumper($res);
#        }
#    }
#
#    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;
## ABSTRACT: Format enveloped result
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Result::Format::Lite - Format enveloped result
#
#=head1 VERSION
#
#This document describes version 0.274 of Perinci::Result::Format::Lite (from Perl distribution Perinci-Result-Format-Lite), released on 2018-07-04.
#
#=head1 SYNOPSIS
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(firstidx)$
#
#=head1 FUNCTIONS
#
#=head2 format($res, $format[ , $is_naked=0, $cleanse=1 ]) => str
#
#=head1 ENVIRONMENT
#
#=head2 FORMAT_PRETTY_TABLE_BACKEND => str
#
#If this is set, will render text table using L<Text::Table::Any> (with
#C<backend> set to the value of this environment variable) instead of the default
#L<Text::Table::Tiny>. This is useful if you want to output text table in a
#different format, for example to generate Org tables (make sure
#L<Text::Table::Org> backend is already installed):
#
# % FORMAT_PRETTY_TABLE_BACKEND=Text::Table::Org lcpan rdeps Getopt::Lucid
#
#=head2 FORMAT_PRETTY_TABLE_COLUMN_ORDERS => array (json)
#
#Set the default of C<table_column_orders> in C<format_options> in result
#metadata, similar to what's implemented in L<Perinci::Result::Format> and
#L<Data::Format::Pretty::Console>.
#
#=head2 COLOR => bool
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Result-Format-Lite>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Result-Format-Lite>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Result-Format-Lite>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Perinci::Result::Format>, a more heavyweight version of this module.
#
#L<Perinci::CmdLine::Lite> uses this module to format enveloped result.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2018, 2017, 2016, 2015 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Perinci/Sub/Normalize.pm ###
#package Perinci::Sub::Normalize;
#
#our $DATE = '2018-09-10'; # DATE
#our $VERSION = '0.200'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       normalize_function_metadata
#               );
#
#sub _normalize{
#    my ($meta, $ver, $opts, $proplist, $nmeta, $prefix, $modprefix) = @_;
#
#    my $opt_aup = $opts->{allow_unknown_properties};
#    my $opt_nss = $opts->{normalize_sah_schemas};
#    my $opt_rip = $opts->{remove_internal_properties};
#
#    if (defined $ver) {
#        defined($meta->{v}) && $meta->{v} eq $ver
#            or die "$prefix: Metadata version must be $ver";
#    }
#
#  KEY:
#    for my $k (keys %$meta) {
#        die "Invalid prop/attr syntax '$k', must be word/dotted-word only"
#            unless $k =~ /\A(\w+)(?:\.(\w+(?:\.\w+)*))?(?:\((\w+)\))?\z/;
#
#        my ($prop, $attr);
#        if (defined $3) {
#            $prop = $1;
#            $attr = defined($2) ? "$2.alt.lang.$3" : "alt.lang.$3";
#        } else {
#            $prop = $1;
#            $attr = $2;
#        }
#
#        my $nk = "$prop" . (defined($attr) ? ".$attr" : "");
#
#        # strip property/attr started with _
#        if ($prop =~ /\A_/ || defined($attr) && $attr =~ /\A_|\._/) {
#            unless ($opt_rip) {
#                $nmeta->{$nk} = $meta->{$k};
#            }
#            next KEY;
#        }
#
#        my $prop_proplist = $proplist->{$prop};
#
#        # try to load module that declare new props first
#        if (!$opt_aup && !$prop_proplist) {
#            $modprefix //= $prefix;
#            my $mod = "Perinci/Sub/Property$modprefix/$prop.pm";
#            eval { require $mod };
#            # hide technical error message from require()
#            if ($@) {
#                die "Unknown property '$prefix/$prop' (and couldn't ".
#                    "load property module '$mod'): $@" if $@;
#            }
#            $prop_proplist = $proplist->{$prop};
#        }
#        die "Unknown property '$prefix/$prop'"
#            unless $opt_aup || $prop_proplist;
#
#        if ($prop_proplist && $prop_proplist->{_prop}) {
#            die "Property '$prefix/$prop' must be a hash"
#                unless ref($meta->{$k}) eq 'HASH';
#            $nmeta->{$nk} = {};
#            _normalize(
#                $meta->{$k},
#                $prop_proplist->{_ver},
#                $opts,
#                $prop_proplist->{_prop},
#                $nmeta->{$nk},
#                "$prefix/$prop",
#            );
#        } elsif ($prop_proplist && $prop_proplist->{_elem_prop}) {
#            die "Property '$prefix/$prop' must be an array"
#                unless ref($meta->{$k}) eq 'ARRAY';
#            $nmeta->{$nk} = [];
#            my $i = 0;
#            for (@{ $meta->{$k} }) {
#                my $href = {};
#                if (ref($_) eq 'HASH') {
#                    _normalize(
#                        $_,
#                        $prop_proplist->{_ver},
#                        $opts,
#                        $prop_proplist->{_elem_prop},
#                        $href,
#                        "$prefix/$prop/$i",
#                    );
#                    push @{ $nmeta->{$nk} }, $href;
#                } else {
#                    push @{ $nmeta->{$nk} }, $_;
#                }
#                $i++;
#            }
#        } elsif ($prop_proplist && $prop_proplist->{_value_prop}) {
#            die "Property '$prefix/$prop' must be a hash"
#                unless ref($meta->{$k}) eq 'HASH';
#            $nmeta->{$nk} = {};
#            for (keys %{ $meta->{$k} }) {
#                $nmeta->{$nk}{$_} = {};
#                die "Property '$prefix/$prop/$_' must be a hash"
#                    unless ref($meta->{$k}{$_}) eq 'HASH';
#                _normalize(
#                    $meta->{$k}{$_},
#                    $prop_proplist->{_ver},
#                    $opts,
#                    $prop_proplist->{_value_prop},
#                    $nmeta->{$nk}{$_},
#                    "$prefix/$prop/$_",
#                    ($prop eq 'args' ? "$prefix/arg" : undef),
#                );
#            }
#        } else {
#            if ($k eq 'schema' && $opt_nss) { # XXX currently hardcoded
#                require Data::Sah::Normalize;
#                $nmeta->{$nk} = Data::Sah::Normalize::normalize_schema(
#                    $meta->{$k});
#            } else {
#                $nmeta->{$nk} = $meta->{$k};
#            }
#        }
#    }
#
#    $nmeta;
#}
#
#sub normalize_function_metadata($;$) {
#    my ($meta, $opts) = @_;
#
#    $opts //= {};
#
#    $opts->{allow_unknown_properties}    //= 0;
#    $opts->{normalize_sah_schemas}       //= 1;
#    $opts->{remove_internal_properties}  //= 0;
#
#    require Sah::Schema::rinci::function_meta;
#    my $sch = $Sah::Schema::rinci::function_meta::schema;
#    my $sch_proplist = $sch->[1]{_prop}
#        or die "BUG: Rinci schema structure changed (1a)";
#
#    _normalize($meta, 1.1, $opts, $sch_proplist, {}, '');
#}
#
#1;
## ABSTRACT: Normalize Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Normalize - Normalize Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 0.200 of Perinci::Sub::Normalize (from Perl distribution Perinci-Sub-Normalize), released on 2018-09-10.
#
#=head1 SYNOPSIS
#
# use Perinci::Sub::Normalize qw(normalize_function_metadata);
#
# my $nmeta = normalize_function_metadata($meta);
#
#=head1 FUNCTIONS
#
#=head2 normalize_function_metadata($meta[ , \%opts ]) => HASH
#
#Normalize and check L<Rinci> function metadata C<$meta>. Return normalized
#metadata, which is a shallow copy of C<$meta>. Die on error.
#
#Available options:
#
#=over
#
#=item * allow_unknown_properties => BOOL (default: 0)
#
#If set to true, will die if there are unknown properties.
#
#=item * normalize_sah_schemas => BOOL (default: 1)
#
#By default, L<Sah> schemas e.g. in C<result/schema> or C<args/*/schema> property
#is normalized using L<Data::Sah>'s C<normalize_schema>. Set this to 0 if you
#don't want this.
#
#=item * remove_internal_properties => BOOL (default: 0)
#
#If set to 1, all properties and attributes starting with underscore (C<_>) with
#will be stripped. According to L<DefHash> specification, they are ignored and
#usually contain notes/comments/extra information.
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Normalize>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Normalize>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Normalize>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Rinci::function>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2018, 2016, 2015, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Sah/Schema/rinci/function_meta.pm ###
#package Sah::Schema::rinci::function_meta;
#
#our $DATE = '2019-05-24'; # DATE
#our $VERSION = '1.1.90.0'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Normalize ();
#use Sah::Schema::rinci::meta ();
#
#our $schema = [hash => {
#    summary => 'Rinci function metadata',
#
#    # tmp
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        # from common rinci metadata
#        entity_v => {},
#        entity_date => {},
#        links => {},
#
#        is_func => {},
#        is_meth => {},
#        is_class_meth => {},
#        args => {
#            _value_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                # common rinci metadata
#                links => {},
#
#                schema => {},
#                filters => {},
#                default => {},
#                req => {},
#                pos => {},
#                slurpy => {},
#                greedy => {}, # old alias for slurpy, will be removed in Rinci 1.2
#                partial => {},
#                stream => {},
#                is_password => {},
#                cmdline_aliases => {
#                    _value_prop => {
#                        summary => {},
#                        description => {},
#                        schema => {},
#                        code => {},
#                        is_flag => {},
#                    },
#                },
#                cmdline_on_getopt => {},
#                cmdline_prompt => {},
#                completion => {},
#                index_completion => {},
#                element_completion => {},
#                cmdline_src => {},
#                meta => 'fix',
#                element_meta => 'fix',
#                deps => {
#                    _keys => {
#                        arg => {},
#                        all => {},
#                        any => {},
#                        none => {},
#                    },
#                },
#                examples => {},
#            },
#        },
#        args_as => {},
#        args_rels => {},
#        result => {
#            _prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                schema => {},
#                statuses => {
#                    _value_prop => {
#                        # from defhash
#                        summary => {},
#                        description => {},
#                        schema => {},
#                    },
#                },
#                partial => {},
#                stream => {},
#            },
#        },
#        result_naked => {},
#        examples => {
#            _elem_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                args => {},
#                argv => {},
#                src => {},
#                src_plang => {},
#                status => {},
#                result => {},
#                test => {},
#            },
#        },
#        features => {
#            _keys => {
#                reverse => {},
#                tx => {},
#                dry_run => {},
#                pure => {},
#                immutable => {},
#                idempotent => {},
#                check_arg => {},
#            },
#        },
#        deps => {
#            _keys => {
#                all => {},
#                any => {},
#                none => {},
#                env => {},
#                prog => {},
#                pkg => {},
#                func => {},
#                code => {},
#                tmp_dir => {},
#                trash_dir => {},
#            },
#        },
#    },
#}, {}];
#
#$schema->[1]{_prop}{args}{_value_prop}{meta} = $schema->[1];
#$schema->[1]{_prop}{args}{_value_prop}{element_meta} = $schema->[1];
#
## just so the dzil plugin won't complain about schema not being normalized.
## because this is a circular structure and normalizing creates a shallow copy.
#
#$schema = Data::Sah::Normalize::normalize_schema($schema);
#
#1;
## ABSTRACT: Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schema::rinci::function_meta - Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 1.1.90.0 of Sah::Schema::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2019-05-24.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2016 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Text/Table/Tiny.pm ###
#use 5.006;
#use strict;
#use warnings;
#package Text::Table::Tiny;
#$Text::Table::Tiny::VERSION = '0.05';
#use parent 'Exporter';
#use List::Util qw();
#use Carp qw/ croak /;
#
#our @EXPORT_OK = qw/ generate_table /;
#
## ABSTRACT: makes simple tables from two-dimensional arrays, with limited templating options
#
#
#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 croak "generate_table(): you must pass the 'rows' argument!";
#
#    # foreach col, get the biggest width
#    my $widths = _maxwidths($rows);
#    my $max_index = _max_array_index($rows);
#
#    # use that to get the field format and separators
#    my $format = _get_format($widths);
#    my $row_sep = _get_row_separator($widths);
#    my $head_row_sep = _get_header_row_separator($widths);
#
#    # here we go...
#    my @table;
#    push(@table, $row_sep) unless $params{top_and_tail};
#
#    # if the first row's a header:
#    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;
#    }
#
#    # then the data
#    my $row_number = 0;
#    my $last_line_number = int(@$rows);
#    $last_line_number-- if $params{header_row};
#    foreach my $row ( @{ $rows }[$data_begins..$#$rows] ) {
#        $row_number++;
#        push(@table, sprintf(
#                             $format, 
#                             map { defined($row->[$_]) ? $row->[$_] : '' } (0..$max_index)
#                            ));
#
#        push(@table, $row_sep) if $params{separate_rows} && (!$params{top_and_tail} || $row_number < $last_line_number);
#
#    }
#
#    # this will have already done the bottom if called explicitly
#    push(@table, $row_sep) unless $params{separate_rows} || $params{top_and_tail};
#    return join("\n",grep {$_} @table);
#}
#
#
#sub _maxwidths {
#    my $rows = shift;
#    # what's the longest array in this list of arrays?
#    my $max_index = _max_array_index($rows);
#    my $widths = [];
#    for my $i (0..$max_index) {
#        # go through the $i-th element of each array, find the longest
#        my $max = List::Util::max(map {defined $$_[$i] ? length($$_[$i]) : 0} @$rows);
#        push @$widths, $max;
#    }
#    return $widths;
#}
#
## return highest top-index from all rows in case they're different lengths
#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";
#}
#
## Back-compat: 'table' is an alias for 'generate_table', but isn't exported
#*table = \&generate_table;
#
#1;
#
#__END__
#
#=pod
#
#=head1 NAME
#
#Text::Table::Tiny - simple text tables from 2D arrays, with limited templating options
#
#=head1 SYNOPSIS
#
#    use Text::Table::Tiny 0.04 qw/ generate_table /;
#
#    my $rows = [
#        # header row
#        ['Name', 'Rank', 'Serial'],
#        # rows
#        ['alice', 'pvt', '123456'],
#        ['bob',   'cpl', '98765321'],
#        ['carol', 'brig gen', '8745'],
#    ];
#    print generate_table(rows => $rows, header_row => 1);
#
#
#=head1 DESCRIPTION
#
#This module provides a single function, C<generate_table>, which formats
#a two-dimensional array of data as a text table.
#
#The example shown in the SYNOPSIS generates the following table:
#
#    +-------+----------+----------+
#    | Name  | Rank     | Serial   |
#    +-------+----------+----------+
#    | alice | pvt      | 123456   |
#    | bob   | cpl      | 98765321 |
#    | carol | brig gen | 8745     |
#    +-------+----------+----------+
#
#B<NOTE>: the interface changed with version 0.04, so if you
#use the C<generate_table()> function illustrated above,
#then you need to require at least version 0.04 of this module,
#as shown in the SYNOPSIS.
#
#
#=head2 generate_table()
#
#The C<generate_table> function understands three arguments,
#which are passed as a hash.
#
#=over 4
#
#
#=item *
#
#rows
#
#Takes an array reference which should contain one or more rows
#of data, where each row is an array reference.
#
#
#=item *
#
#header_row
#
#If given a true value, the first row in the data will be interpreted
#as a header row, and separated from the rest of the table with a ruled line.
#
#
#=item *
#
#separate_rows
#
#If given a true value, a separator line will be drawn between every row in
#the table,
#and a thicker line will be used for the header separator.
#
#=item *
#
#top_and_tail
#
#If given a true value, then the top and bottom border lines will be skipped.
#This reduces the vertical height of the generated table.
#
#=back
#
#
#=head2 EXAMPLES
#
#If you just pass the data and no other options:
#
# generate_table(rows => $rows);
#
#You get minimal ruling:
#
#    +-------+----------+----------+
#    | Name  | Rank     | Serial   |
#    | alice | pvt      | 123456   |
#    | bob   | cpl      | 98765321 |
#    | carol | brig gen | 8745     |
#    +-------+----------+----------+
#
#If you want lines between every row, and also want a separate header:
#
# generate_table(rows => $rows, header_row => 1, separate_rows => 1);
#
#You get the maximally ornate:
#
#    +-------+----------+----------+
#    | Name  | Rank     | Serial   |
#    O=======O==========O==========O
#    | alice | pvt      | 123456   |
#    +-------+----------+----------+
#    | bob   | cpl      | 98765321 |
#    +-------+----------+----------+
#    | carol | brig gen | 8745     |
#    +-------+----------+----------+
#
#=head1 FORMAT VARIABLES
#
#You can set a number of package variables inside the C<Text::Table::Tiny> package
#to configure the appearance of the table.
#This interface is likely to be deprecated in the future,
#and some other mechanism provided.
#
#=over 4
#
#=item *
#
#$Text::Table::Tiny::COLUMN_SEPARATOR = '|';
#
#=item *
#
#$Text::Table::Tiny::ROW_SEPARATOR = '-';
#
#=item *
#
#$Text::Table::Tiny::CORNER_MARKER = '+';
#
#=item *
#
#$Text::Table::Tiny::HEADER_ROW_SEPARATOR = '=';
#
#=item *
#
#$Text::Table::Tiny::HEADER_CORNER_MARKER = 'O';
#
#=back
#
#
#=head1 PREVIOUS INTERFACE
#
#Prior to version 0.04 this module provided a function called C<table()>,
#which wasn't available for export. It took exactly the same arguments:
#
# use Text::Table::Tiny;
# my $rows = [ ... ];
# print Text::Table::Tiny::table(rows => $rows, separate_rows => 1, header_row => 1);
#
#For backwards compatibility this interface is still supported.
#The C<table()> function isn't available for export though.
#
#
#=head1 SEE ALSO
#
#There are many modules for formatting text tables on CPAN.
#A good number of them are listed in the
#L<See Also|https://metacpan.org/pod/Text::Table::Manifold#See-Also>
#section of the documentation for L<Text::Table::Manifold>.
#
#
#=head1 REPOSITORY
#
#L<https://github.com/neilb/Text-Table-Tiny>
#
#
#=head1 AUTHOR
#
#Creighton Higgins <chiggins@chiggins.com>
#
#Now maintained by Neil Bowers <neilb@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2012 by Creighton Higgins.
#
#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
#