#!perl

### begin code_after_shebang
# Note: This script is a CLI for Riap function /Acme/ID/CompanyName/gen_generic_ind_company_names
# and generated automatically using Perinci::CmdLine::Gen version 0.498

### end code_after_shebang
# PERICMD_INLINE_SCRIPT: {"code_after_shebang":"...","config_dirs":null,"config_filename":"gen-generic-ind-company-names.conf","env_name":"GEN_GENERIC_IND_COMPANY_NAMES_OPT","include":null,"log":null,"pack_deps":1,"pod":0,"read_config":1,"read_env":1,"script_name":"gen-generic-ind-company-names","script_summary":null,"script_version":"0.007","shebang":"perl","skip_format":0,"subcommands":null,"url":"/Acme/ID/CompanyName/gen_generic_ind_company_names","use_cleanser":1,"validate_args":1}

my $_pci_metas = {""=>{args=>{add_prefixes=>{default=>1,schema=>["bool",{req=>1},{}]},add_suffixes=>{default=>1,schema=>["bool",{req=>1},{}]},desired_initials=>{schema=>["str",{match=>qr(\A[A-Za-z]+\z),min_len=>1,req=>1},{}]},num_names=>{cmdline_aliases=>{n=>{}},default=>1,pos=>0,schema=>["int",{min=>0,req=>1},{}]},num_words=>{cmdline_aliases=>{w=>{}},default=>3,schema=>["int",{min=>1,req=>1},{}]},type=>{cmdline_aliases=>{t=>{}},default=>"PT",schema=>["str",{req=>1},{}],summary=>"Just a string to be prepended before the name"}},examples=>[{argv=>[5],summary=>"Generate five random PT names",test=>0},{argv=>["-n3","--desired-initials","ACME"],summary=>"Generate three PT names with desired initials \"ACME\"",test=>0}],result=>{},result_naked=>1,summary=>"Generate nice-sounding, generic Indonesian company names",v=>1.1}};

# This script is generated by Perinci::CmdLine::Inline version 0.551 on Fri May  7 20:03:14 2021.

# Rinci metadata taken from these modules: Acme::ID::CompanyName (no version)

# You probably should not manually edit this file.

our $DATE = '2021-05-07'; # DATE
our $VERSION = '0.007'; # VERSION
# PODNAME: gen-generic-ind-company-names
# ABSTRACT: Generate nice-sounding, generic Indonesian company names

# 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;

# load 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;
}

### begin code_before_parse_cmdline_options
### end code_before_parse_cmdline_options
### 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 "gen-generic-ind-company-names - Generate nice-sounding, generic Indonesian company names\n\nUsage:\n  gen-generic-ind-company-names --help (or -h, -?)\n  gen-generic-ind-company-names --version (or -v)\n  gen-generic-ind-company-names [--add-prefixes] [--add-suffixes]\n    [--config-path=path+] [--config-profile=profile] [--desired-initials=s]\n    [--format=name] [--json] [--naked-res] [--no-add-prefixes]\n    [--no-add-suffixes] [--no-config] [--no-env] [--no-naked-res |\n    --nonaked-res] [--noadd-prefixes] [--noadd-suffixes] [--num-words=s]\n    [--page-result[=program]] [-t=s] [--type=s] [-w=s] [num_names]\n\nExamples:\n  Generate five random PT names:\n  % gen-generic-ind-company-names 5\n\n  Generate three PT names with desired initials \"ACME\":\n  % gen-generic-ind-company-names -n3 --desired-initials ACME\n\nMain options:\n  --desired-initials=s  \n  --no-add-prefixes     \n  --no-add-suffixes     \n  --num-names=s, -n      (=arg[0]) [1]\n  --num-words=s, -w      [3]\n  --type=s, -t          Just a string to be prepended before the name [\"PT\"]\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  --page-result  Filter output through a pager\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; },
    'page-result:s' => sub { $_pci_r->{page_result} = 1; },
    'version|v' => sub { no warnings 'once'; require Acme::ID::CompanyName; print "gen-generic-ind-company-names version ", "0.007", ($Acme::ID::CompanyName::DATE ? " ($Acme::ID::CompanyName::DATE)" : ''), "\n"; print "  Generated by Perinci::CmdLine::Inline version 0.551 (2020-05-18)\n"; exit 0 },
};
my $go_spec2 = {
    'add-prefixes' => sub {         $_pci_args{'add_prefixes'} = $_[1];
 },
    'add-suffixes' => sub {         $_pci_args{'add_suffixes'} = $_[1];
 },
    'config-path=s@' => sub {  },
    'config-profile=s' => sub {  },
    'desired-initials=s' => sub {         $_pci_args{'desired_initials'} = $_[1];
 },
    'format=s' => sub {  },
    'help|h|?' => sub {  },
    'json' => sub {  },
    'n=s' => sub {         $_pci_args{'num_names'} = $_[1];
 },
    'naked-res' => sub {  },
    'no-add-prefixes' => sub {         $_pci_args{'add_prefixes'} = 0;
 },
    'no-add-suffixes' => sub {         $_pci_args{'add_suffixes'} = 0;
 },
    'no-config' => sub {  },
    'no-env' => sub {  },
    'no-naked-res|nonaked-res' => sub {  },
    'noadd-prefixes' => sub {         $_pci_args{'add_prefixes'} = 0;
 },
    'noadd-suffixes' => sub {         $_pci_args{'add_suffixes'} = 0;
 },
    'num-names=s' => sub {         $_pci_args{'num_names'} = $_[1];
 },
    'num-words=s' => sub {         $_pci_args{'num_words'} = $_[1];
 },
    'page-result:s' => sub {  },
    't=s' => sub {         $_pci_args{'type'} = $_[1];
 },
    'type=s' => sub {         $_pci_args{'type'} = $_[1];
 },
    'version|v' => sub {  },
    'w=s' => sub {         $_pci_args{'num_words'} = $_[1];
 },
};
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{"GEN_GENERIC_IND_COMPANY_NAMES_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  => "gen-generic-ind-company-names.conf",
    config_dirs      => undef // ["$ENV{HOME}/.config", $ENV{HOME}, "/etc"],
    program_name     => "gen-generic-ind-company-names",
  );
  _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       => "gen-generic-ind-company-names",
    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 Acme::ID::CompanyName;
    eval { $_pci_r->{res} = Acme::ID::CompanyName::gen_generic_ind_company_names(%_pci_args) };
    if ($@) { die if $ENV{PERINCI_CMDLINE_INLINE_DEBUG_DIE}; $_pci_r->{res} = [500, "Function died: $@"] }
    $_pci_r->{res} = [200, "OK (envelope added by Perinci::CmdLine::Inline)", $_pci_r->{res}];
}
}

### format & display result

{
my $fh;
if ($_pci_r->{page_result} // $ENV{PAGE_RESULT} // $_pci_r->{res}[3]{"cmdline.page_result"}) {
my $pager = $_pci_r->{pager} // $_pci_r->{res}[3]{"cmdline.pager"} // $ENV{PAGER} // "less -FRSX";
open $fh, "| $pager";
} else {
$fh = \*STDOUT;
}
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 $fh $l; print $fh "\n" unless $_pci_meta_result_type eq "buf"; } } else { while (defined(my $rec=$code->())) { if (!defined($rec) || ref $rec) { print $fh _pci_json()->encode($rec),"\n" } else { print $fh $rec,"\n" } } }
} else {
    print $fh $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

gen-generic-ind-company-names - Generate nice-sounding, generic Indonesian company names

=head1 VERSION

This document describes version 0.007 of main (from Perl distribution Acme-ID-CompanyName), released on 2021-05-07.

=head1 SYNOPSIS

Usage:

 % gen-generic-ind-company-names [--add-prefixes] [--add-suffixes]
     [--config-path=path+] [--config-profile=profile]
     [--desired-initials=s] [--format=name] [--json] [--(no)naked-res]
     [--no-add-prefixes] [--no-add-suffixes] [--no-config] [--no-env]
     [--noadd-prefixes] [--noadd-suffixes] [--num-words=s]
     [--page-result[=program]] [-t=s] [--type=s] [--view-result[=program]]
     [-w=s] [num_names]

Examples:

Generate five random PT names:

 % gen-generic-ind-company-names 5
 PT Mekar Simfoni Sempurna
 PT Elektro Kreasi Delapan
 PT Sarindo Vito Forsa
 PT Humania Delapan Jenggala
 PT Kala Karya Sentral

Generate three PT names with desired initials "ACME":

 % gen-generic-ind-company-names -n3 --desired-initials ACME
 PT Aksa Central Mandala Elegan
 PT Agung Cipta Milenial Esatama
 PT Aksa Cakrawala Mandiri Elektro

=head1 OPTIONS

C<*> marks required options.

=head2 Main options

=over

=item B<--desired-initials>=I<s>

=item B<--no-add-prefixes>

=item B<--no-add-suffixes>

=item B<--num-names>=I<s>, B<-n>

Default value:

 1

Can also be specified as the 1st command-line argument.

=item B<--num-words>=I<s>, B<-w>

Default value:

 3

=item B<--type>=I<s>, B<-t>

Just a string to be prepended before the name.

Default value:

 "PT"

=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.

=item B<--view-result>

View output using a viewer.

=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 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/gen-generic-ind-company-names.conf>, F<~/gen-generic-ind-company-names.conf>, or F</etc/gen-generic-ind-company-names.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.

You can also 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 equals some string: 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 some string: 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 includes some string: C<[env=HOSTNAME*=server ...]> or C<[SOMESECTION env=HOSTNAME*=server ...]>. If you only want a section to be read when the value of an environment variable does not include some string: 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.

To load and configure plugins, you can use either the C<-plugins> parameter (e.g. C<< -plugins=DumpArgs >> or C<< -plugins=DumpArgs@before_validate_args >>), or use the C<[plugin=NAME ...]> sections, for example:

 [plugin=DumpArgs]
 -event=before_validate_args
 -prio=99
 
 [plugin=Foo]
 -event=after_validate_args
 arg1=val1
 arg2=val2

 

which is equivalent to setting C<< -plugins=-DumpArgs@before_validate_args@99,-Foo@after_validate_args,arg1,val1,arg2,val2 >>.

List of available configuration parameters:

 add_prefixes (see --no-add-prefixes)
 add_suffixes (see --no-add-suffixes)
 desired_initials (see --desired-initials)
 format (see --format)
 naked_res (see --naked-res)
 num_names (see --num-names)
 num_words (see --num-words)
 type (see --type)

=head1 ENVIRONMENT

=head2 GEN_GENERIC_IND_COMPANY_NAMES_OPT => str

Specify additional command-line options.

=head1 FILES

F<~/.config/gen-generic-ind-company-names.conf>

F<~/gen-generic-ind-company-names.conf>

F</etc/gen-generic-ind-company-names.conf>

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Acme-ID-CompanyName>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Acme-ID-CompanyName>.

=head1 BUGS

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

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) 2021, 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

__DATA__
Data::Section::Seekable v1
Clone/PP.pm,20,6331,0;0
Complete/Bash.pm,6376,39632,1;193
Config/IOD/Base.pm,46035,23603,2;1432
Config/IOD/Reader.pm,69667,17366,3;2242
Data/Check/Structure.pm,87065,9787,4;2801
Data/Sah/Normalize.pm,96882,9038,5;3157
Getopt/Long/EvenLess.pm,105952,11364,6;3431
Local/_pci_check_args.pm,117349,5682,7;3813
Local/_pci_clean_json.pm,123064,4414,8;3933
Log/ger.pm,127497,11284,9;3995
Perinci/CmdLine/Util/Config.pm,138820,18532,10;4340
Perinci/Result/Format/Lite.pm,157390,23138,11;4941
Perinci/Sub/Normalize.pm,180561,7303,12;5548
Sah/Schema/rinci/function_meta.pm,187906,7198,13;5783
Scalar/Util/Numeric/PP.pm,195138,3106,14;6051
Text/Table/Tiny.pm,198271,15445,15;6192

### Clone/PP.pm ###
#package Clone::PP;
#
#use 5.006;
#use strict;
#use warnings;
#use vars qw($VERSION @EXPORT_OK);
#use Exporter;
#
#$VERSION = 1.07;
#
#@EXPORT_OK = qw( clone );
#sub import { goto &Exporter::import } # lazy Exporter
#
## These methods can be temporarily overridden to work with a given class.
#use vars qw( $CloneSelfMethod $CloneInitMethod );
#$CloneSelfMethod ||= 'clone_self';
#$CloneInitMethod ||= 'clone_init';
#
## Used to detect looped networks and avoid infinite recursion. 
#use vars qw( %CloneCache );
#
## Generic cloning function
#sub clone {
#  my $source = shift;
#
#  return undef if not defined($source);
#  
#  # Optional depth limit: after a given number of levels, do shallow copy.
#  my $depth = shift;
#  return $source if ( defined $depth and $depth -- < 1 );
#  
#  # Maintain a shared cache during recursive calls, then clear it at the end.
#  local %CloneCache = ( undef => undef ) unless ( exists $CloneCache{undef} );
#  
#  return $CloneCache{ $source } if ( defined $CloneCache{ $source } );
#  
#  # Non-reference values are copied shallowly
#  my $ref_type = ref $source or return $source;
#  
#  # Extract both the structure type and the class name of referent
#  my $class_name;
#  if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
#    $class_name = $ref_type;
#    $ref_type = $1;
#    # Some objects would prefer to clone themselves; check for clone_self().
#    return $CloneCache{ $source } = $source->$CloneSelfMethod() 
#				  if $source->can($CloneSelfMethod);
#  }
#  
#  # To make a copy:
#  # - Prepare a reference to the same type of structure;
#  # - Store it in the cache, to avoid looping if it refers to itself;
#  # - Tie in to the same class as the original, if it was tied;
#  # - Assign a value to the reference by cloning each item in the original;
#  
#  my $copy;
#  if ($ref_type eq 'HASH') {
#    $CloneCache{ $source } = $copy = {};
#    if ( my $tied = tied( %$source ) ) { tie %$copy, ref $tied }
#    %$copy = map { ! ref($_) ? $_ : clone($_, $depth) } %$source;
#  } elsif ($ref_type eq 'ARRAY') {
#    $CloneCache{ $source } = $copy = [];
#    if ( my $tied = tied( @$source ) ) { tie @$copy, ref $tied }
#    @$copy = map { ! ref($_) ? $_ : clone($_, $depth) } @$source;
#  } elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
#    $CloneCache{ $source } = $copy = \( my $var = "" );
#    if ( my $tied = tied( $$source ) ) { tie $$copy, ref $tied }
#    $$copy = clone($$source, $depth);
#  } else {
#    # Shallow copy anything else; this handles a reference to code, glob, regex
#    $CloneCache{ $source } = $copy = $source;
#  }
#  
#  # - Bless it into the same class as the original, if it was blessed;
#  # - If it has a post-cloning initialization method, call it.
#  if ( $class_name ) {
#    bless $copy, $class_name;
#    $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
#  }
#  
#  return $copy;
#}
#
#1;
#
#__END__
#
#=head1 NAME
#
#Clone::PP - Recursively copy Perl datatypes
#
#=head1 SYNOPSIS
#
#  use Clone::PP qw(clone);
#  
#  $item = { 'foo' => 'bar', 'move' => [ 'zig', 'zag' ]  };
#  $copy = clone( $item );
#
#  $item = [ 'alpha', 'beta', { 'gamma' => 'vlissides' } ];
#  $copy = clone( $item );
#
#  $item = Foo->new();
#  $copy = clone( $item );
#
#Or as an object method:
#
#  require Clone::PP;
#  push @Foo::ISA, 'Clone::PP';
#  
#  $item = Foo->new();
#  $copy = $item->clone();
#
#=head1 DESCRIPTION
#
#This module provides a general-purpose clone function to make deep
#copies of Perl data structures. It calls itself recursively to copy
#nested hash, array, scalar and reference types, including tied
#variables and objects.
#
#The clone() function takes a scalar argument to copy. To duplicate
#arrays or hashes, pass them in by reference:
#
#  my $copy = clone(\@array);    my @copy = @{ clone(\@array) };
#  my $copy = clone(\%hash);     my %copy = %{ clone(\%hash) };
#
#The clone() function also accepts an optional second parameter that
#can be used to limit the depth of the copy. If you pass a limit of
#0, clone will return the same value you supplied; for a limit of
#1, a shallow copy is constructed; for a limit of 2, two layers of
#copying are done, and so on.
#
#  my $shallow_copy = clone( $item, 1 );
#
#To allow objects to intervene in the way they are copied, the
#clone() function checks for a couple of optional methods. If an
#object provides a method named C<clone_self>, it is called and the
#result returned without further processing. Alternately, if an
#object provides a method named C<clone_init>, it is called on the
#copied object before it is returned.
#
#=head1 BUGS
#
#Some data types, such as globs, regexes, and code refs, are always copied shallowly.
#
#References to hash elements are not properly duplicated. (This is why two tests in t/dclone.t that are marked "todo".) For example, the following test should succeed but does not:
#
#  my $hash = { foo => 1 }; 
#  $hash->{bar} = \{ $hash->{foo} }; 
#  my $copy = clone( \%hash ); 
#  $hash->{foo} = 2; 
#  $copy->{foo} = 2; 
#  ok( $hash->{bar} == $copy->{bar} );
#
#To report bugs via the CPAN web tracking system, go to 
#C<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Clone-PP> or send mail 
#to C<Dist=Clone-PP#rt.cpan.org>, replacing C<#> with C<@>.
#
#=head1 SEE ALSO
#
#L<Clone> - a baseclass which provides a C<clone()> method.
#
#L<MooseX::Clone> - find-grained cloning for Moose objects.
#
#The C<dclone()> function in L<Storable>.
#
#L<Data::Clone> -
#polymorphic data cloning (see its documentation for what that means).
#
#L<Clone::Any> - use whichever of the cloning methods is available.
#
#=head1 REPOSITORY
#
#L<https://github.com/neilbowers/Clone-PP>
#
#=head1 AUTHOR AND CREDITS
#
#Developed by Matthew Simon Cavalletto at Evolution Softworks. 
#More free Perl software is available at C<www.evoscript.org>.
#
#
#=head1 COPYRIGHT AND LICENSE
#
#Copyright 2003 Matthew Simon Cavalletto. You may contact the author
#directly at C<evo@cpan.org> or C<simonm@cavalletto.org>.
#
#Code initially derived from Ref.pm. Portions Copyright 1994 David Muir Sharnoff.
#
#Interface based by Clone by Ray Finch with contributions from chocolateboy.
#Portions Copyright 2001 Ray Finch. Portions Copyright 2001 chocolateboy. 
#
#You may use, modify, and distribute this software under the same terms as Perl.
#
#=cut
### Complete/Bash.pm ###
#package Complete::Bash;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-16'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.335'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
#                       point
#                       parse_cmdline
#                       join_wordbreak_words
#                       format_completion
#               );
#
#our %SPEC;
#
#$SPEC{':package'} = {
#    v => 1.1,
#    summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
#    my ($user, $slash) = @_;
#    my @ent;
#    if (length $user) {
#        @ent = getpwnam($user);
#    } else {
#        @ent = getpwuid($>);
#        $user = $ent[0];
#    }
#    return $ent[7] . $slash if @ent;
#    "~$user$slash"; # return as-is when failed
#}
#
#sub _add_unquoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word, $after_ws) = @_;
#
#    #say "D:add_unquoted word=$word is_cur_word=$is_cur_word after_ws=$after_ws";
#
#    $word =~ s!^(~)(\w*)(/|\z) |  # 1) tilde  2) username  3) optional slash
#               \\(.)           |  # 4) escaped char
#               \$(\w+)            # 5) variable name
#              !
#                  $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
#                      $4 ? $4 :
#                          ($is_cur_word ? "\$$5" : $ENV{$5})
#                              !egx;
#    $word;
#}
#
#sub _add_double_quoted {
#    no warnings 'uninitialized';
#
#    my ($word, $is_cur_word) = @_;
#
#    $word =~ s!\\(.)           |  # 1) escaped char
#               \$(\w+)            # 2) variable name
#              !
#                  $1 ? $1 :
#                      ($is_cur_word ? "\$$2" : $ENV{$2})
#                          !egx;
#    $word;
#}
#
#sub _add_single_quoted {
#    my $word = shift;
#    $word =~ s/\\(.)/$1/g;
#    $word;
#}
#
#$SPEC{point} = {
#    v => 1.1,
#    summary => 'Return line with point marked by a marker',
#    description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
#    point("^foo") # => ("foo", 0)
#    point("fo^o") # => ("foo", 2)
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line which contains a marker character',
#            schema => 'str*',
#            pos => 0,
#        },
#        marker => {
#            summary => 'Marker character',
#            schema => ['str*', len=>1],
#            default => '^',
#            pos => 1,
#        },
#    },
#    result_naked => 1,
#};
#sub point {
#    my ($line, $marker) = @_;
#    $marker //= '^';
#
#    my $point = index($line, $marker);
#    die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
#    $line =~ s/\Q$marker\E//;
#    ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
#    v => 1.1,
#    summary => 'Parse shell command-line for processing by completion routines',
#    description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
#    command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
#    ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
#    ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
#   variable substitution for `COMP_WORDS`). However, note that special shell
#   variables that are not environment variables like `$0`, `$_`, `$IFS` will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
#  By default `COMP_WORDBREAKS` is:
#
#    "'@><=;|&(:
#
#  So if raw command-line is:
#
#    command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#  then the parse result will be:
#
#    ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#  which is annoying sometimes. But we follow bash here so we can more easily
#  accept input from a joined `COMP_WORDS` if we write completion bash functions,
#  e.g. (in the example, `foo` is a Perl script):
#
#    _foo ()
#    {
#        local words=(${COMP_CWORDS[@]})
#        # add things to words, etc
#        local point=... # calculate the new point
#        COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
#    }
#
#  To avoid these word-breaking characters to be split/grouped, we can escape
#  them with backslash or quote them, e.g.:
#
#    command "http://example.com:80" Foo\:\:Bar
#
#  which bash will parse as:
#
#    ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
#  and we parse as:
#
#    ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
#  equivalent:
#
#    % cmd --foo=bar
#    % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
#    args_as => 'array',
#    args => {
#        cmdline => {
#            summary => 'Command-line, defaults to COMP_LINE environment',
#            schema => 'str*',
#            pos => 0,
#        },
#        point => {
#            summary => 'Point/position to complete in command-line, '.
#                'defaults to COMP_POINT',
#            schema => 'int*',
#            pos => 1,
#        },
#        opts => {
#            summary => 'Options',
#            schema => 'hash*',
#            description => <<'_',
#
#Optional. Known options:
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
#  position of cursor, for example (`^` marks the position of cursor):
#  `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
#  doing tab completion.
#
#_
#            schema => 'hash*',
#            pos => 2,
#        },
#    },
#    result => {
#        schema => ['array*', len=>2],
#        description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in `@ARGV`), you need to strip the first element from
#`$words` and reduce `$cword` by 1.
#
#
#_
#    },
#    result_naked => 1,
#    links => [
#    ],
#};
#sub parse_cmdline {
#    no warnings 'uninitialized';
#    my ($line, $point, $opts) = @_;
#
#    $line  //= $ENV{COMP_LINE};
#    $point //= $ENV{COMP_POINT} // 0;
#
#    die "$0: COMP_LINE not set, make sure this script is run under ".
#        "bash completion (e.g. through complete -C)\n" unless defined $line;
#
#    log_trace "[compbash] parse_cmdline(): input: line=<$line> point=<$point>"
#        if $ENV{COMPLETE_BASH_TRACE};
#
#    my @words;
#    my $cword;
#    my $pos = 0;
#    my $pos_min_ws = 0;
#    my $after_ws = 1; # XXX what does this variable mean?
#    my $chunk;
#    my $add_blank;
#    my $is_cur_word;
#    $line =~ s!(                                                         # 1) everything
#                  (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*)               |  #  2) open "  3) content  4) space after
#                  (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*)               |  #  5) open '  6) content  7) space after
#                  ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) |  #  8) unquoted word  9) space after
#                  ([\@><=|&\(:]+) |                                      #  10) non-whitespace word-breaking characters
#                  \s+
#              )!
#                  $pos += length($1);
#                  #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
#                  #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
#                  if ($2 || $5 || defined($8)) {
#                      # double-quoted/single-quoted/unquoted chunk
#
#                      if (not(defined $cword)) {
#                          $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
#                          #say "D:pos_min_ws=$pos_min_ws";
#                          if ($point <= $pos_min_ws) {
#                              $cword = @words - ($after_ws ? 0 : 1);
#                          } elsif ($point < $pos) {
#                              $cword = @words + 1 - ($after_ws ? 0 : 1);
#                              $add_blank = 1;
#                          }
#                      }
#
#                      if ($after_ws) {
#                          $is_cur_word = defined($cword) && $cword==@words;
#                      } else {
#                          $is_cur_word = defined($cword) && $cword==@words-1;
#                      }
#                      #say "D:is_cur_word=$is_cur_word";
#                      $chunk =
#                          $2 ? _add_double_quoted($3, $is_cur_word) :
#                              $5 ? _add_single_quoted($6) :
#                              _add_unquoted($8, $is_cur_word, $after_ws);
#                      if ($opts && $opts->{truncate_current_word} &&
#                              $is_cur_word && $pos > $point) {
#                          $chunk = substr(
#                              $chunk, 0, length($chunk)-($pos_min_ws-$point));
#                          #say "D:truncating current word to <$chunk>";
#                      }
#                      if ($after_ws) {
#                          push @words, $chunk;
#                      } else {
#                          $words[-1] .= $chunk;
#                      }
#                      if ($add_blank) {
#                          push @words, '';
#                          $add_blank = 0;
#                      }
#                      $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
#
#                  } elsif ($10) {
#                      # non-whitespace word-breaking characters
#                      push @words, $10;
#                      $after_ws = 1;
#                  } else {
#                      # whitespace
#                      $after_ws = 1;
#                  }
#    !egx;
#
#    $cword //= @words;
#    $words[$cword] //= '';
#
#    log_trace "[compbash] parse_cmdline(): result: words=%s, cword=%s", \@words, $cword
#        if $ENV{COMPLETE_BASH_TRACE};
#
#    [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
#    v => 1.1,
#    summary => 'Post-process parse_cmdline() result by joining some words',
#    description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
#    "'@><=;|&(:
#
#So if command-line is:
#
#    command --module=Data::Dump bob@example.org
#
#then they will be parsed as:
#
#    ["command", "--module", "=", "Data", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
#    ["command", "--module=Data::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
#    my ($words, $cword) = @_;
#    my $new_words = [];
#    my $i = -1;
#    while (++$i < @$words) {
#        my $w = $words->[$i];
#        if ($w =~ /\A[\@=:]+\z/) {
#            if (@$new_words and $#$new_words != $cword) {
#                $new_words->[-1] .= $w;
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            } else {
#                push @$new_words, $w;
#            }
#            if ($i+1 < @$words) {
#                $i++;
#                $new_words->[-1] .= $words->[$i];
#                $cword-- if $cword >= $i || $cword >= @$new_words;
#            }
#        } else {
#            push @$new_words, $w;
#        }
#    }
#    log_trace "[compbash] join_wordbreak_words(): result: words=%s, cword=%d", $new_words, $cword
#        if $ENV{COMPLETE_BASH_TRACE};
#    [$new_words, $cword];
#}
#
#sub _terminal_width {
#    # XXX need to cache?
#    if (eval { require Term::Size; 1 }) {
#        my ($cols, undef) = Term::Size::chars(*STDOUT{IO});
#        $cols // 80;
#    } else {
#        $ENV{COLUMNS} // 80;
#    }
#}
#
## given terminal width & number of columns, calculate column width
#sub _column_width {
#    my ($terminal_width, $num_columns) = @_;
#    if (defined $num_columns && $num_columns > 0) {
#        int( ($terminal_width - ($num_columns-1)*2) / $num_columns ) - 1;
#    } else {
#        undef;
#    }
#}
#
## given terminal width & column width, calculate number of columns
#sub _num_columns {
#    my ($terminal_width, $column_width) = @_;
#    my $n = int( ($terminal_width+2) / ($column_width+2) );
#    $n >= 1 ? $n : 1;
#}
#
#$SPEC{format_completion} = {
#    v => 1.1,
#    summary => 'Format completion for output (for shell)',
#    description => <<'_',
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the `Complete`
#POD. Aside from `words`, this function also recognizes these keys:
#
#_
#    args_as => 'array',
#    args => {
#        completion => {
#            summary => 'Completion answer structure',
#            description => <<'_',
#
#Either an array or hash. See function description for more details.
#
#_
#            schema=>['any*' => of => ['hash*', 'array*']],
#            req=>1,
#            pos=>0,
#        },
#        opts => {
#            summary => 'Specify options',
#            schema=>'hash*',
#            pos=>1,
#            description => <<'_',
#
#Known options:
#
#* as
#
#  Either `string` (the default) or `array` (to return array of lines instead of
#  the lines joined together). Returning array is useful if you are doing
#  completion inside `Term::ReadLine`, for example, where the library expects an
#  array.
#
#* esc_mode
#
#  Escaping mode for entries. Either `default` (most nonalphanumeric characters
#  will be escaped), `shellvar` (like `default`, but dollar sign `$` will also be
#  escaped, convenient when completing environment variables for example),
#  `filename` (currently equals to `default`), `option` (currently equals to
#  `default`), or `none` (no escaping will be done).
#
#* word
#
#  A workaround. String. For now, see source code for more details.
#
#* show_summaries
#
#  Whether to show item's summaries. Boolean, default is from
#  COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
#  An answer item contain summary, which is a short description about the item,
#  e.g.:
#
#      [{word=>"-a"    , summary=>"Show hidden files"},
#       {word=>"-l"    , summary=>"Show details"},
#       {word=>"--sort", summary=>"Specify sort order"}],
#
#  When summaries are not shown, user will just be seeing something like:
#
#      -a
#      -l
#      --sort
#
#  But when summaries are shown, user will see:
#
#      -a         -- Show hidden files
#      -l         -- Show details
#      --sort     -- Specify sort order
#
#  which is quite helpful.
#
#* workaround_with_wordbreaks
#
#  Boolean. Default is true. See source code for more details.
#
#_
#
#        },
#    },
#    result => {
#        summary => 'Formatted string (or array, if `as` is set to `array`)',
#        schema => ['any*' => of => ['str*', 'array*']],
#    },
#    result_naked => 1,
#};
#sub format_completion {
#    my ($hcomp, $opts) = @_;
#
#    $opts //= {};
#
#    $hcomp = {words=>$hcomp} unless ref($hcomp) eq 'HASH';
#    my $words    = $hcomp->{words};
#    my $as       = $opts->{as} // 'string';
#    # 'escmode' key is deprecated (Complete 0.11-) and will be removed later
#    my $esc_mode = $opts->{esc_mode} // $ENV{COMPLETE_BASH_DEFAULT_ESC_MODE} //
#        'default';
#    my $path_sep = $hcomp->{path_sep};
#
#    # we keep the original words (before formatted with summaries) when we want
#    # to use fzf instead of passing to bash directly
#    my @words;
#    my @summaries;
#    my @res;
#    my $has_summary;
#
#    my $code_return_message = sub {
#        # display a message instead of list of words. we send " " (ASCII space)
#        # which bash does not display, so we can display a line of message while
#        # the user does not get the message as the completion. I've also tried
#        # \000 to \037 instead of space (\040) but nothing works better.
#        my $msg = shift;
#        if ($msg =~ /\A /) {
#            $msg =~ s/\A +//;
#            $msg = " (empty message)" unless length $msg;
#        }
#        return (sprintf("%-"._terminal_width()."s", $msg), " ");
#    };
#
#  FORMAT_MESSAGE:
#    # display a message instead of list of words. we send " " (ASCII space)
#    # which bash does not display, so we can display a line of message while the
#    # user does not get the message as the completion. I've also tried \000 to
#    # \037 instead of space (\040) but nothing works better.
#    if (defined $hcomp->{message}) {
#        @res = $code_return_message->($hcomp->{message});
#        goto RETURN_RES;
#    }
#
#  WORKAROUND_PREVENT_BASH_FROM_INSERTING_SPACE:
#    {
#        last unless @$words == 1;
#        if (defined $path_sep) {
#            my $re = qr/\Q$path_sep\E\z/;
#            my $word;
#            if (ref $words->[0] eq 'HASH') {
#                $words = [$words->[0], {word=>"$words->[0]{word} "}] if
#                    $words->[0]{word} =~ $re;
#            } else {
#                $words = [$words->[0], "$words->[0] "]
#                    if $words->[0] =~ $re;
#            }
#            last;
#        }
#
#        if ($hcomp->{is_partial} ||
#                ref $words->[0] eq 'HASH' && $words->[0]{is_partial}) {
#            if (ref $words->[0] eq 'HASH') {
#                $words = [$words->[0], {word=>"$words->[0]{word} "}];
#            } else {
#                $words = [$words->[0], "$words->[0] "];
#            }
#            last;
#        }
#    }
#
#  WORKAROUND_WITH_WORDBREAKS:
#    # this is a workaround. since bash breaks words using characters in
#    # $COMP_WORDBREAKS, which by default is "'@><=;|&(: this presents a problem
#    # we often encounter: if we want to provide with a list of strings
#    # containing say ':', most often Perl modules/packages, if user types e.g.
#    # "Text::AN" and we provide completion ["Text::ANSI"] then bash will change
#    # the word at cursor to become "Text::Text::ANSI" since it sees the current
#    # word as "AN" and not "Text::AN". the workaround is to chop /^Text::/ from
#    # completion answers. btw, we actually chop /^text::/i to handle
#    # case-insensitive matching, although this does not have the ability to
#    # replace the current word (e.g. if we type 'text::an' then bash can only
#    # replace the current word 'an' with 'ANSI).
#    {
#        last unless $opts->{workaround_with_wordbreaks} // 1;
#        last unless defined $opts->{word};
#
#        if ($opts->{word} =~ s/(.+[\@><=;|&\(:])//) {
#            my $prefix = $1;
#            for (@$words) {
#                if (ref($_) eq 'HASH') {
#                    $_->{word} =~ s/\A\Q$prefix\E//i;
#                } else {
#                    s/\A\Q$prefix\E//i;
#                }
#            }
#        }
#    }
#
#  ESCAPE_WORDS:
#    for my $entry (@$words) {
#        my $word    = ref($entry) eq 'HASH' ? $entry->{word}    : $entry;
#        my $summary = (ref($entry) eq 'HASH' ? $entry->{summary} : undef) // '';
#        if ($esc_mode eq 'shellvar') {
#            # escape $ also
#            $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
#        } elsif ($esc_mode eq 'none') {
#            # no escaping
#        } else {
#            # default
#            $word =~ s!([^A-Za-z0-9,+._/:\$~-])!\\$1!g;
#        }
#        push @words, $word;
#        push @summaries, $summary;
#        $has_summary = 1 if length $summary;
#    }
#
#    my $summary_align = $ENV{COMPLETE_BASH_SUMMARY_ALIGN} // 'left';
#    my $max_columns = $ENV{COMPLETE_BASH_MAX_COLUMNS} // 0;
#    my $terminal_width = _terminal_width();
#    my $column_width = _column_width($terminal_width, $max_columns);
#
#    #warn "terminal_width=$terminal_width, column_width=".($column_width // 'undef')."\n";
#
#  FORMAT_SUMMARIES: {
#        @res = @words;
#        last if @words <= 1;
#        last unless $has_summary;
#        last unless $opts->{show_summaries} //
#            $ENV{COMPLETE_BASH_SHOW_SUMMARIES} // 1;
#        my $max_entry_width   = 8;
#        my $max_summ_width = 0;
#        for (0..$#words) {
#            $max_entry_width = length $words[$_]
#                if $max_entry_width < length $words[$_];
#            $max_summ_width = length $summaries[$_]
#                if $max_summ_width < length $summaries[$_];
#        }
#        #warn "max_entry_width=$max_entry_width, max_summ_width=$max_summ_width\n";
#        if ($summary_align eq 'right') {
#            # if we are aligning summary to the right, we want to fill column
#            # width width
#            if ($max_columns <= 0) {
#                $max_columns = _num_columns(
#                    $terminal_width, ($max_entry_width + 2 + $max_summ_width));
#            }
#            $column_width = _column_width($terminal_width, $max_columns);
#            my $new_max_summ_width = $column_width - 2 - $max_entry_width;
#            $max_summ_width = $new_max_summ_width
#                if $max_summ_width < $new_max_summ_width;
#            #warn "max_columns=$max_columns, column_width=$column_width, max_summ_width=$max_summ_width\n";
#        }
#
#        for (0..$#words) {
#            my $summary = $summaries[$_];
#            if (length $summary) {
#                $res[$_] = sprintf(
#                    "%-${max_entry_width}s |%".
#                        ($summary_align eq 'right' ? $max_summ_width : '')."s",
#                    $words[$_], $summary);
#            }
#        }
#    } # FORMAT_SUMMARIES
#
#  MAX_COLUMNS: {
#        last unless $max_columns > 0;
#        my $max_entry_width = 0;
#        for (@res) {
#            $max_entry_width = length if $max_entry_width < length;
#        }
#        last if $max_entry_width >= $column_width;
#        for (@res) {
#            $_ .= " " x ($column_width - length) if $column_width > length;
#        }
#    }
#
#  PASS_TO_FZF: {
#        last unless $ENV{COMPLETE_BASH_FZF};
#        my $items = $ENV{COMPLETE_BASH_FZF_ITEMS} // 100;
#        last unless @words >= $items;
#
#        require File::Which;
#        unless (File::Which::which("fzf")) {
#            #@res = $code_return_message->("Cannot find fzf to filter ".
#            #                                  scalar(@words)." items");
#            goto RETURN_RES;
#        }
#
#        require IPC::Open2;
#        local *CHLD_OUT;
#        local *CHLD_IN;
#        my $pid = IPC::Open2::open2(
#            \*CHLD_OUT, \*CHLD_IN, "fzf", "-m", "-d:", "--with-nth=2..")
#            or do {
#                @res = $code_return_message->("Cannot open fzf to filter ".
#                                                  scalar(@words)." items");
#                goto RETURN_RES;
#            };
#
#        print CHLD_IN map { "$_:$res[$_]\n" } 0..$#res;
#        close CHLD_IN;
#
#        my @res_words;
#        while (<CHLD_OUT>) {
#            my ($index) = /\A([0-9]+)\:/ or next;
#            push @res_words, $words[$index];
#        }
#        if (@res_words) {
#            @res = join(" ", @res_words);
#        } else {
#            @res = ();
#        }
#        waitpid($pid, 0);
#    }
#
#  RETURN_RES:
#    #use Data::Dump; warn Data::Dump::dump(\@res);
#    if ($as eq 'array') {
#        return \@res;
#    } else {
#        return join("", map {($_, "\n")} @res);
#    }
#}
#
#1;
## ABSTRACT: Completion routines for bash shell
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Bash - Completion routines for bash shell
#
#=head1 VERSION
#
#This document describes version 0.335 of Complete::Bash (from Perl distribution Complete-Bash), released on 2020-04-16.
#
#=head1 DESCRIPTION
#
#This module provides routines related to tab completion in bash shell.
#
#=head2 About programmable completion in bash
#
#Bash allows completion to come from various sources. The simplest is from a list
#of words (C<-W>):
#
# % complete -W "one two three four" somecmd
# % somecmd t<Tab>
# two  three
#
#Another source is from a bash function (C<-F>). The function will receive input
#in two variables: C<COMP_WORDS> (array, command-line chopped into words) and
#C<COMP_CWORD> (integer, index to the array of words indicating the cursor
#position). It must set an array variable C<COMPREPLY> that contains the list of
#possible completion:
#
# % _foo()
# {
#   local cur
#   COMPREPLY=()
#   cur=${COMP_WORDS[COMP_CWORD]}
#   COMPREPLY=($( compgen -W '--help --verbose --version' -- $cur ) )
# }
# % complete -F _foo foo
# % foo <Tab>
# --help  --verbose  --version
#
#And yet another source is an external command (C<-C>) including, from a Perl
#script. The command receives two environment variables: C<COMP_LINE> (string,
#raw command-line) and C<COMP_POINT> (integer, cursor location). Program must
#split C<COMP_LINE> into words, find the word to be completed, complete that, and
#return the list of words one per-line to STDOUT. An example:
#
# % cat foo-complete
# #!/usr/bin/perl
# use Complete::Bash qw(parse_cmdline format_completion);
# use Complete::Util qw(complete_array_elem);
# my ($words, $cword) = @{ parse_cmdline() };
# my $res = complete_array_elem(array=>[qw/--help --verbose --version/], word=>$words->[$cword]);
# print format_completion($res);
#
# % complete -C foo-complete foo
# % foo --v<Tab>
# --verbose --version
#
#=head2 About the routines in this module
#
#First of all, C<parse_cmdline()> is the function to parse raw command-line (such
#as what you get from bash in C<COMP_LINE> environment variable) into words. This
#makes it easy for the other functions to generate completion answer. See the
#documentation for that function for more details.
#
#C<format_completion()> is what you use to format completion answer structure for
#bash.
#
#=head1 FUNCTIONS
#
#
#=head2 format_completion
#
#Usage:
#
# format_completion($completion, $opts) -> str|array
#
#Format completion for output (for shell).
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the C<Complete>
#POD. Aside from C<words>, this function also recognizes these keys:
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$completion>* => I<hash|array>
#
#Completion answer structure.
#
#Either an array or hash. See function description for more details.
#
#=item * B<$opts> => I<hash>
#
#Specify options.
#
#Known options:
#
#=over
#
#=item * as
#
#Either C<string> (the default) or C<array> (to return array of lines instead of
#the lines joined together). Returning array is useful if you are doing
#completion inside C<Term::ReadLine>, for example, where the library expects an
#array.
#
#=item * esc_mode
#
#Escaping mode for entries. Either C<default> (most nonalphanumeric characters
#will be escaped), C<shellvar> (like C<default>, but dollar sign C<$> will also be
#escaped, convenient when completing environment variables for example),
#C<filename> (currently equals to C<default>), C<option> (currently equals to
#C<default>), or C<none> (no escaping will be done).
#
#=item * word
#
#A workaround. String. For now, see source code for more details.
#
#=item * show_summaries
#
#Whether to show item's summaries. Boolean, default is from
#COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
#An answer item contain summary, which is a short description about the item,
#e.g.:
#
#  [{word=>"-a"    , summary=>"Show hidden files"},
#   {word=>"-l"    , summary=>"Show details"},
#   {word=>"--sort", summary=>"Specify sort order"}],
#
#When summaries are not shown, user will just be seeing something like:
#
#  -a
#  -l
#  --sort
#
#But when summaries are shown, user will see:
#
#  -a         -- Show hidden files
#  -l         -- Show details
#  --sort     -- Specify sort order
#
#which is quite helpful.
#
#=item * workaround_with_wordbreaks
#
#Boolean. Default is true. See source code for more details.
#
#=back
#
#
#=back
#
#Return value: Formatted string (or array, if `as` is set to `array`) (str|array)
#
#
#
#=head2 join_wordbreak_words
#
#Usage:
#
# join_wordbreak_words() -> [status, msg, payload, meta]
#
#Post-process parse_cmdline() result by joining some words.
#
#C<parse_cmdline()>, like bash, splits some characters that are considered as
#word-breaking characters:
#
# "'@><=;|&(:
#
#So if command-line is:
#
# command --module=Data::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "--module", "=", "Data", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want C<:>, C<@> to be part of word. So this
#routine will convert the above into:
#
# ["command", "--module=Data::Dump", 'bob@example.org']
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value:  (any)
#
#
#
#=head2 parse_cmdline
#
#Usage:
#
# parse_cmdline($cmdline, $point, $opts) -> array
#
#Parse shell command-line for processing by completion routines.
#
#This function basically converts C<COMP_LINE> (str) and C<COMP_POINT> (int) into
#something like (but not exactly the same as) C<COMP_WORDS> (array) and
#C<COMP_CWORD> (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's C<COMP_WORDS> contains all the
#   quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
#   parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
#   bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
#   which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
#   for the current word (C<COMP_WORDS[COMP_CWORD]>) (bash does not perform
#   variable substitution for C<COMP_WORDS>). However, note that special shell
#   variables that are not environment variables like C<$0>, C<$_>, C<$IFS> will not
#   be replaced correctly because bash does not export those variables for us.
#
#4) tildes (C<~>) are expanded with user's home directory except for the current
#   word (bash does not perform tilde expansion for C<COMP_WORDS>);
#
#Caveats:
#
#=over
#
#=item * Like bash, we group non-whitespace word-breaking characters into its own word.
#By default C<COMP_WORDBREAKS> is:
#
#"'@><=;|&(:
#
#So if raw command-line is:
#
#command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#then the parse result will be:
#
#["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#which is annoying sometimes. But we follow bash here so we can more easily
#accept input from a joined C<COMP_WORDS> if we write completion bash functions,
#e.g. (in the example, C<foo> is a Perl script):
#
#I<foo ()
#{
#    local words=(${COMP>CWORDS[@]})
#    # add things to words, etc
#    local point=... # calculate the new point
#    COMPREPLY=( C<COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo> )
#}
#
#To avoid these word-breaking characters to be split/grouped, we can escape
#them with backslash or quote them, e.g.:
#
#command "http://example.com:80" Foo\:\:Bar
#
#which bash will parse as:
#
#["command", "\"http://example.com:80\"", "Foo\:\:Bar"]
#
#and we parse as:
#
#["command", "http://example.com:80", "Foo::Bar"]
#
#=item * Due to the way bash parses the command line (see above), the two below are
#equivalent:
#
#% cmd --foo=bar
#% cmd --foo = bar
#
#=back
#
#Because they both expand to C<['--foo', '=', 'bar']>. But obviously
#L<Getopt::Long> does not regard the two as equivalent.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line, defaults to COMP_LINE environment.
#
#=item * B<$opts> => I<hash>
#
#Options.
#
#Optional. Known options:
#
#=over
#
#=item * C<truncate_current_word> (bool). If set to 1, will truncate current word to the
#position of cursor, for example (C<^> marks the position of cursor):
#C<--vers^oo> to C<--vers> instead of C<--versoo>. This is more convenient when
#doing tab completion.
#
#=back
#
#=item * B<$point> => I<int>
#
#PointE<sol>position to complete in command-line, defaults to COMP_POINT.
#
#
#=back
#
#Return value:  (array)
#
#
#Return a 2-element array: C<[$words, $cword]>. C<$words> is array of str,
#equivalent to C<COMP_WORDS> provided by bash to shell functions. C<$cword> is an
#integer, roughly equivalent to C<COMP_CWORD> provided by bash to shell functions.
#The word to be completed is at C<< $words-E<gt>[$cword] >>.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in C<@ARGV>), you need to strip the first element from
#C<$words> and reduce C<$cword> by 1.
#
#
#
#=head2 point
#
#Usage:
#
# point($cmdline, $marker) -> any
#
#Return line with point marked by a marker.
#
#This is a utility function useful for testing/debugging. C<parse_cmdline()>
#expects a command-line and a cursor position (C<$line>, C<$point>). This routine
#expects C<$line> with a marker character (by default it's the caret, C<^>) and
#return (C<$line>, C<$point>) to feed to C<parse_cmdline()>.
#
#Example:
#
# point("^foo") # => ("foo", 0)
# point("fo^o") # => ("foo", 2)
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line which contains a marker character.
#
#=item * B<$marker> => I<str> (default: "^")
#
#Marker character.
#
#
#=back
#
#Return value:  (any)
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_BASH_DEFAULT_ESC_MODE
#
#Str. To provide default for the C<esc_mode> option in L</format_completion>.
#
#=head2 COMPLETE_BASH_FZF
#
#Bool. Whether to pass large completion answer to fzf instead of directly passing
#it to bash and letting bash page it with a simpler more-like internal pager. By
#default, large is defined as having at least 100 items (same bash's
#C<completion-query-items> setting). This can be configured via
#L</COMPLETE_BASH_FZF_ITEMS>.
#
#=head2 COMPLETE_BASH_FZF_ITEMS
#
#Uint. Default 100. The minimum number of items to trigger passing completion
#answer to fzf. See also: L</COMPLETE_BASH_FZF>.
#
#=head2 COMPLETE_BASH_MAX_COLUMNS
#
#Uint.
#
#Bash will show completion entries in one or several columns, depending on the
#terminal width and the length of the entries (much like a standard non-long
#`ls`). If you prefer completion entries to be shown in a single column no matter
#how wide your terminal is, or how short the entries are, you can set the value
#of this variable to 1. If you prefer a maximum of two columns, set to 2, and so
#on. L</format_completion> will pad the entries with sufficient spaces to limit
#the number of columns.
#
#=head2 COMPLETE_BASH_SHOW_SUMMARIES
#
#Bool. Will set the default for C<show_summaries> option in
#L</format_completion>.
#
#=head2 COMPLETE_BASH_SUMMARY_ALIGN
#
#String. Either C<left> (the default) or C<right>.
#
#The C<left> align looks something like this:
#
# --bar      Summary about the bar option
# --baz      Summary about the baz option
# --foo      Summary about the foo option
# --schapen  Summary about the schapen option
#
#The C<right> align will make the completion answer look like what you see in the
#B<fish> shell:
#
# --bar                        Summary about the bar option
# --baz                        Summary about the baz option
# --foo                        Summary about the foo option
# --schapen                Summary about the schapen option
#
#=head2 COMPLETE_BASH_TRACE
#
#Bool. If set to true, will produce more log statements to L<Log::ger>.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Bash>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Bash>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Bash>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Complete>, the convention that this module follows.
#
#Some higher-level modules that use this module (so you don't have to use this
#module directly): L<Getopt::Long::Complete> (via L<Complete::Getopt::Long>),
#L<Getopt::Long::Subcommand>, L<Perinci::CmdLine> (via
#L<Perinci::Sub::Complete>).
#
#Other modules related to bash shell tab completion: L<Bash::Completion>,
#L<Getopt::Complete>, L<Term::Bash::Completion::Generator>.
#
#Programmable Completion section in Bash manual:
#L<https://www.gnu.org/software/bash/manual/html_node/Programmable-Completion.html>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2016, 2015, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### 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 $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-11-08'; # DATE
#our $DIST = 'Data-Check-Structure'; # DIST
#our $VERSION = '0.050'; # 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
#               );
#
#our $errstr = '';
#
#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;
#        my $ref = ref($data->[$i]);
#        do { $errstr = "not aos: array element [$i] not scalar ($ref)"; return 0 } if $ref;
#    }
#    $errstr = '';
#    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;
#        my $ref = ref($data->[$i]);
#        do { $errstr = "not aoa: array element [$i] not array ($ref)"; return 0 } unless $ref eq 'ARRAY';
#    }
#    $errstr = '';
#    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;
#        do { $errstr = "not aoaos: element [$i]".($errstr ? ": $errstr" : " not aos"); return 0 } unless is_aos($data->[$i], $aos_opts);
#    }
#    $errstr = '';
#    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;
#        my $ref = ref($data->[$i]);
#        do { $errstr = "not aoh: element [$i] not hash ($ref)"; return 0 } unless $ref eq 'HASH';
#    }
#    $errstr = '';
#    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;
#        do { $errstr = "not aohos: element [$i]".($errstr ? ": $errstr" : " not hos"); return 0 } unless is_hos($data->[$i], $hos_opts);
#    }
#    $errstr = '';
#    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;
#        my $ref = ref($data->{$k});
#        do { $errstr = "not hos: value for key '$k' not scalar ($ref)"; return 0 } if $ref;
#    }
#    $errstr = '';
#    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;
#        my $ref = ref($data->{$k});
#        do { $errstr = "not hoa: value for key '$k' not array ($ref)"; return 0 } unless $ref eq 'ARRAY';
#    }
#    $errstr = '';
#    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;
#        do { $errstr = "not hoaos: value for key '$k'".($errstr ? ": $errstr" : " not aos"); return 0 } unless is_aos($data->{$k});
#    }
#    $errstr = '';
#    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;
#        my $ref = ref($data->{$k});
#        do { $errstr = "not hoh: value for key '$k' not hash ($ref)"; return 0 } unless $ref eq 'HASH';
#    }
#    $errstr = '';
#    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;
#        do { $errstr = "not hohos: value for key '$k'".($errstr ? ": $errstr" : " not hos"); return 0 } unless is_hos($data->{$k});
#    }
#    $errstr = '';
#    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.050 of Data::Check::Structure (from Perl distribution Data-Check-Structure), released on 2020-11-08.
#
#=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) 2020, 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->{"num_names"}) { return [400, "You specified --num-names but also argument #0"]; } else { $args->{"num_names"} = delete($ARGV[0]); } }
#        }
#        my @check_argv = @ARGV;
#        # fill from cmdline_src
#
#        # fill defaults from "default" property and check against schema
#        no warnings ('void');
#        require Scalar::Util::Numeric::PP;
#        my $_sahv_dpath;
#        my $_sahv_err;
#        $args->{"add_prefixes"} //= 1;
#        if (exists $args->{"add_prefixes"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"add_prefixes"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"add_prefixes"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        $args->{"add_suffixes"} //= 1;
#        if (exists $args->{"add_suffixes"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"add_suffixes"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"add_suffixes"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"desired_initials"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"desired_initials"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'str'
#            ((!ref($args->{"desired_initials"})) ? 1 : (($_sahv_err //= "Not of type text"),0))
#            
#            &&
#            
#            (# clause: match
#            (($args->{"desired_initials"} =~ qr((?:(?-)\A[A-Za-z]+\z))) ? 1 : (($_sahv_err //= "Must match regex pattern qr(\\A[A-Za-z]+\\z)"),0)))
#            
#            &&
#            
#            (# clause: min_len
#            ((length($args->{"desired_initials"}) >= 1) ? 1 : (($_sahv_err //= "Length must be at least 1"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        $args->{"num_names"} //= 1;
#        if (exists $args->{"num_names"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"num_names"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'int'
#            ((Scalar::Util::Numeric::PP::isint($args->{"num_names"})) ? 1 : (($_sahv_err //= "Not of type integer"),0))
#            
#            &&
#            
#            (# clause: min
#            (($args->{"num_names"} >= 0) ? 1 : (($_sahv_err //= "Must be at least 0"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        $args->{"num_words"} //= 3;
#        if (exists $args->{"num_words"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"num_words"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'int'
#            ((Scalar::Util::Numeric::PP::isint($args->{"num_words"})) ? 1 : (($_sahv_err //= "Not of type integer"),0))
#            
#            &&
#            
#            (# clause: min
#            (($args->{"num_words"} >= 1) ? 1 : (($_sahv_err //= "Must be at least 1"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        $args->{"type"} //= "PT";
#        if (exists $args->{"type"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"type"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'str'
#            ((!ref($args->{"type"})) ? 1 : (($_sahv_err //= "Not of type text"),0))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#
#        # check required args
#        return [400, "Missing required value for argument: add_prefixes"] if exists($args->{"add_prefixes"}) && !defined($args->{"add_prefixes"});
#        return [400, "Missing required value for argument: add_suffixes"] if exists($args->{"add_suffixes"}) && !defined($args->{"add_suffixes"});
#        return [400, "Missing required value for argument: desired_initials"] if exists($args->{"desired_initials"}) && !defined($args->{"desired_initials"});
#        return [400, "Missing required value for argument: num_names"] if exists($args->{"num_names"}) && !defined($args->{"num_names"});
#        return [400, "Missing required value for argument: num_words"] if exists($args->{"num_words"}) && !defined($args->{"num_words"});
#        return [400, "Missing required value for argument: type"] if exists($args->{"type"}) && !defined($args->{"type"});
#        _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 Clone::PP; require Scalar::Util;  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 $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2021-01-31'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.038'; # VERSION
#
##IFUNBUILT
## use strict 'subs', 'vars';
## use warnings;
##END IFUNBUILT
#
#our $re_addr = qr/\(0x([0-9a-f]+)/o;
#
#our %Levels = (
#    fatal   => 10,
#    error   => 20,
#    warn    => 30,
#    info    => 40,
#    debug   => 50,
#    trace   => 60,
#);
#
#our %Level_Aliases = (
#    off     => 0,
#    warning => 30,
#);
#
#our $Current_Level = 30;
#
#our $Caller_Depth_Offset = 0;
#
## a flag that can be used by null output to skip using formatter
#our $_outputter_is_null;
#
#our $_dumper;
#
#our %Global_Hooks;
#
## in Log/ger/Heavy.pm
## our %Default_Hooks = (
#
#our %Package_Targets; # key = package name, value = \%per_target_conf
#our %Per_Package_Hooks; # key = package name, value = { phase => hooks, ... }
#
#our %Hash_Targets; # key = hash address, value = [$hashref, \%per_target_conf]
#our %Per_Hash_Hooks; # key = hash address, value = { phase => hooks, ... }
#
#our %Object_Targets; # key = object address, value = [$obj, \%per_target_conf]
#our %Per_Object_Hooks; # key = object address, value = { phase => hooks, ... }
#
#my $sub0 = sub {0};
#my $sub1 = sub {1};
#my $default_null_routines;
#
#sub install_routines {
#    my ($target, $target_arg, $routines, $name_routines) = @_;
#
#    if ($name_routines && !defined &subname) {
#        if (eval { require Sub::Name; 1 }) {
#            *subname = \&Sub::Name::subname;
#        } else {
#            *subname = sub {};
#        }
#    }
#
#    if ($target eq 'package') {
##IFUNBUILT
##         no warnings 'redefine';
##END IFUNBUILT
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            #print "D:installing $name to package $target_arg\n";
#            *{"$target_arg\::$name"} = $code;
#            subname("$target_arg\::$name", $code) if $name_routines;
#        }
#    } elsif ($target eq 'object') {
##IFUNBUILT
##         no warnings 'redefine';
##END IFUNBUILT
#        my $pkg = ref $target_arg;
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_method\z/;
#            *{"$pkg\::$name"} = $code;
#            subname("$pkg\::$name", $code) if $name_routines;
#        }
#    } elsif ($target eq 'hash') {
#        for my $r (@$routines) {
#            my ($code, $name, $lnum, $type) = @$r;
#            next unless $type =~ /_sub\z/;
#            $target_arg->{$name} = $code;
#        }
#    }
#}
#
#sub add_target {
#    my ($target_type, $target_name, $per_target_conf, $replace) = @_;
#    $replace = 1 unless defined $replace;
#
#    if ($target_type eq 'package') {
#        unless ($replace) { return if $Package_Targets{$target_name} }
#        $Package_Targets{$target_name} = $per_target_conf;
#    } elsif ($target_type eq 'object') {
#        my ($addr) = "$target_name" =~ $re_addr;
#        unless ($replace) { return if $Object_Targets{$addr} }
#        $Object_Targets{$addr} = [$target_name, $per_target_conf];
#    } elsif ($target_type eq 'hash') {
#        my ($addr) = "$target_name" =~ $re_addr;
#        unless ($replace) { return if $Hash_Targets{$addr} }
#        $Hash_Targets{$addr} = [$target_name, $per_target_conf];
#    }
#}
#
#sub _set_default_null_routines {
#    $default_null_routines ||= [
#        (map {(
#            [$sub0, "log_$_", $Levels{$_}, 'logger_sub'],
#            [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "log_is_$_", $Levels{$_}, 'level_checker_sub'],
#            [$sub0, $_, $Levels{$_}, 'logger_method'],
#            [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "is_$_", $Levels{$_}, 'level_checker_method'],
#        )} keys %Levels),
#    ];
#}
#
#sub get_logger {
#    my ($package, %per_target_conf) = @_;
#
#    my $caller = caller(0);
#    $per_target_conf{category} = $caller
#        if !defined($per_target_conf{category});
#    my $obj = []; $obj =~ $re_addr;
#    my $pkg = "Log::ger::Obj$1"; bless $obj, $pkg;
#    add_target(object => $obj, \%per_target_conf);
#    if (keys %Global_Hooks) {
#        require Log::ger::Heavy;
#        init_target(object => $obj, \%per_target_conf);
#    } else {
#        # if we haven't added any hooks etc, skip init_target() process and use
#        # this preconstructed routines as shortcut, to save startup overhead
#        _set_default_null_routines();
#        install_routines(object => $obj, $default_null_routines, 0);
#    }
#    $obj; # XXX add DESTROY to remove from list of targets
#}
#
#sub _import_to {
#    my ($package, $target_pkg, %per_target_conf) = @_;
#
#    $per_target_conf{category} = $target_pkg
#        if !defined($per_target_conf{category});
#    add_target(package => $target_pkg, \%per_target_conf);
#    if (keys %Global_Hooks) {
#        require Log::ger::Heavy;
#        init_target(package => $target_pkg, \%per_target_conf);
#    } else {
#        # if we haven't added any hooks etc, skip init_target() process and use
#        # this preconstructed routines as shortcut, to save startup overhead
#        _set_default_null_routines();
#        install_routines(package => $target_pkg, $default_null_routines, 0);
#    }
#}
#
#sub import {
#    my ($package, %per_target_conf) = @_;
#
#    my $caller = caller(0);
#    $package->_import_to($caller, %per_target_conf);
#}
#
#1;
## ABSTRACT: A lightweight, flexible logging framework
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger - A lightweight, flexible logging framework
#
#=head1 VERSION
#
#version 0.038
#
#=head1 SYNOPSIS
#
#=head2 Producing logs
#
#In your module (producer):
#
# package Foo;
# use Log::ger; # will install some logger routines e.g. log_warn, log_error
#
# sub foo {
#     ...
#     # produce some logs. no need to configure output or level.
#     log_error "an error occured: %03d - %s", $errcode, $errmsg;
#     ...
#     log_debug "http response: %s", $http; # automatic dumping of data
# }
# 1;
#
#=head2 Consuming logs
#
#=head3 Choosing an output
#
#In your application (consumer/listener):
#
# use Foo;
# use Log::ger::Output 'Screen'; # configure output
# # level is by default 'warn'
# foo(); # the error message is shown, but debug message is not.
#
#=head3 Choosing multiple outputs
#
#Instead of screen, you can output to multiple outputs (including multiple
#files):
#
# use Log::ger::Output 'Composite' => (
#     outputs => {
#         Screen => {},
#         File   => [
#             {conf=>{path=>'/path/to/app.log'}},
#             ...
#         ],
#         ...
#     },
# );
#
#See L<Log::ger::Manual::Tutorial::481_Output_Composite> for more examples.
#
#=head3 Choosing level
#
#One way to set level:
#
# use Log::ger::Util;
# Log::ger::Util::set_level('debug'); # be more verbose
# foo(); # the error message as well as debug message are now shown
#
#There are better ways, e.g. letting users configure log level via configuration
#file or command-line option. See L<Log::ger::Manual::Tutorial::300_Level> for
#more details.
#
#=head1 DESCRIPTION
#
#Log::ger is yet another logging framework with the following features:
#
#=over
#
#=item * Separation of producers and consumers/listeners
#
#Like L<Log::Any>, this offers a very easy way for modules to produce some logs
#without having to configure anything. Configuring output, level, etc can be done
#in the application as log consumers/listeners. To read more about this, see the
#documentation of L<Log::Any> or L<Log::ger::Manual> (but nevertheless see
#L<Log::ger::Manual> on why you might prefer Log::ger to Log::Any).
#
#=item * Lightweight and fast
#
#B<Slim distribution.> No non-core dependencies, extra functionalities are
#provided in separate distributions to be pulled as needed.
#
#B<Low startup overhead.> Only ~0.5-1ms. For comparison, L<strict> ~0.2-0.5ms,
#L<warnings> ~2ms, L<Log::Any> (v0.15) ~2-3ms, Log::Any (v1.049) ~8-10ms,
#L<Log::Log4perl> ~35ms. This is measured on a 2014-2015 PC and before doing any
#output configuration. I strive to make C<use Log::ger;> statement to be roughly
#as light as C<use strict;> or C<use warnings;> so the impact of adding the
#statement is really minimal and you can just add logging without much thought to
#most of your modules. This is important to me because I want logging to be
#pervasive.
#
#To test for yourself, try e.g. with L<bencher-code>:
#
# % bencher-code 'use Log::ger' 'use Log::Any' --startup
#
#B<Fast>. Low null-/stealth-logging overhead, about 1.5x faster than Log::Any, 3x
#faster than Log4perl, 5x faster than L<Log::Fast>, ~40x faster than
#L<Log::Contextual>, and ~100x faster than L<Log::Dispatch>.
#
#For more benchmarks, see L<Bencher::Scenarios::LogGer>.
#
#B<Conditional compilation.> There is a plugin to optimize away unneeded logging
#statements, like assertion/conditional compilation, so they have zero runtime
#performance cost. See L<Log::ger::Plugin::OptAway>.
#
#Being lightweight means the module can be used more universally, from CLI to
#long-running daemons to inside routines with tight loops.
#
#=item * Flexible
#
#B<Customizable levels and routine/method names.> Can be used in a procedural or
#OO style. Log::ger can mimic the interface of L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, or some other popular logging frameworks, to ease migration or
#adjust with your personal style.
#
#B<Per-package settings.> Each importer package can use its own format/layout,
#output. For example, a module that is migrated from Log::Any uses Log::Any-style
#logging, while another uses native Log::ger style, and yet some other uses block
#formatting like Log::Contextual. This eases code migration and teamwork. Each
#module author can preserve her own logging style, if wanted, and all the modules
#still use the same framework.
#
#B<Dynamic.> Outputs and levels can be changed anytime during run-time and logger
#routines will be updated automatically. This is useful in situation like a
#long-running server application: you can turn on tracing logs temporarily to
#debug problems, then turn them off again, without restarting your server.
#
#B<Interoperability.> There are modules to interop with Log::Any, either consume
#Log::Any logs (see L<Log::Any::Adapter::LogGer>) or produce logs to be consumed
#by Log::Any (see L<Log::ger::Output::LogAny>).
#
#B<Many output modules and plugins.> See C<Log::ger::Output::*>,
#C<Log::ger::Format::*>, C<Log::ger::Layout::*>, C<Log::ger::Plugin::*>. Writing
#an output module in Log::ger is easier than writing a Log::Any::Adapter::*.
#
#=back
#
#For more documentation, start with L<Log::ger::Manual>.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#Some other popular logging frameworks: L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, L<Log::Dispatch>, L<Log::Dispatchouli>.
#
#If you still prefer debugging using the good old C<print()>, there's
#L<Debug::Print>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2021, 2020, 2019, 2018, 2017 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Perinci/CmdLine/Util/Config.pm ###
#package Perinci::CmdLine::Util::Config;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-10-21'; # DATE
#our $DIST = 'Perinci-CmdLine-Util-Config'; # DIST
#our $VERSION = '1.724'; # 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) {
#            $res{$section} //= {};
#            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,
#    description => <<'_',
#
#`config` is a HoH (hashes of hashrefs) produced by reading an INI (IOD)
#configuration file using modules like <pm:Config::IOD::Reader>.
#
#Hashref argument `args` will be set by parameters in `config`, while `plugins`
#will be set by parameters in `[plugin=...]` sections in `config`. For example,
#with this configuration:
#
#    arg1=val1
#    arg2=val2
#    -special_arg1=val3
#    -special_arg2=val4
#
#    [plugin=DumpArgs]
#    -event=before_validation
#
#    [plugin=Foo]
#    arg1=val1
#
#`args` will become:
#
#    {
#      arg1=>"val1",
#      arg2=>"val2",
#      -special_arg1=>"val3",
#      -special_arg2=>"val4",
#    }
#
#and `plugins` will become:
#
#    [
#      'DumpArgs@before_validation' => {},
#      Foo => {arg1=>val},
#    ]
#
#_
#    args => {
#        r => {},
#        config => {},
#        args => {schema=>'hash'},
#        plugins => {schema=>'array'},
#        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 $plugins = $fargs{plugins} // [];
#    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};
#        my $sect_plugin  = $keyvals{plugin};
#
#        # 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);
#
#        if (defined $sect_plugin) {
#            # TODO: check against metadata in plugin
#            my $event;
#            my $prio;
#            my $plugin_args = {};
#            for my $k (keys %{ $conf->{$section0} }) {
#                my $v = $conf->{$section0}{$k};
#                if    ($k eq '-event') { $event = $v }
#                elsif ($k eq '-prio')  { $prio  = $v }
#                else { $plugin_args->{$k} = $v }
#            }
#            push @$plugins, $sect_plugin .
#                (defined $event || defined $prio ?
#                 '@'.($event // '') . (defined $prio ? "\@$prio" : "") : '');
#            push @$plugins, $plugin_args;
#        } else {
#            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::Resolve;
#                        my $rsch = Data::Sah::Resolve::resolve_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' && $rsch->[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}) {
#                        require Data::Sah::Resolve;
#                        my $rsch = Data::Sah::Resolve::resolve_schema($as->{$k}{schema});
#                        if ($rsch->[0] eq 'array') {
#                            $v = [$v];
#                        }
#                    }
#                    $args->{$k} = $v;
#                }
#            } # for params in section
#        } # if for plugin
#    }
#    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.724 of Perinci::CmdLine::Util::Config (from Perl distribution Perinci-CmdLine-Util-Config), released on 2020-10-21.
#
#=head1 FUNCTIONS
#
#
#=head2 get_args_from_config
#
#Usage:
#
# get_args_from_config(%args) -> [status, msg, payload, meta]
#
#C<config> is a HoH (hashes of hashrefs) produced by reading an INI (IOD)
#configuration file using modules like L<Config::IOD::Reader>.
#
#Hashref argument C<args> will be set by parameters in C<config>, while C<plugins>
#will be set by parameters in C<[plugin=...]> sections in C<config>. For example,
#with this configuration:
#
# arg1=val1
# arg2=val2
# -special_arg1=val3
# -special_arg2=val4
# 
# [plugin=DumpArgs]
# -event=before_validation
# 
# [plugin=Foo]
# arg1=val1
#
#C<args> will become:
#
# {
#   arg1=>"val1",
#   arg2=>"val2",
#   -special_arg1=>"val3",
#   -special_arg2=>"val4",
# }
#
#and C<plugins> will become:
#
# [
#   'DumpArgs@before_validation' => {},
#   Foo => {arg1=>val},
# ]
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<args> => I<hash>
#
#=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<plugins> => I<array>
#
#=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) 2020, 2019, 2018, 2017 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Perinci/Result/Format/Lite.pm ###
#package Perinci::Result::Format::Lite;
#
#our $DATE = '2021-03-08'; # DATE
#our $VERSION = '0.279'; # 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 'filesize') {
#                    require Format::Human::Bytes;
#                    $row->[$j] = Format::Human::Bytes::base2($row->[$j], 0);
#                } 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;
#        my $backend = $ENV{FORMAT_PRETTY_TABLE_BACKEND};
#        $backend //= "Text::Table::Org" if $ENV{INSIDE_EMACS};
#        if ($backend) {
#            require Text::Table::Any;
#            $fres = Text::Table::Any::table(rows=>$data, header_row=>$header_row, backend=>$backend);
#        } else {
#            require Text::Table::Sprintf;
#            $fres = Text::Table::Sprintf::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 = 1000;
#            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.279 of Perinci::Result::Format::Lite (from Perl distribution Perinci-Result-Format-Lite), released on 2021-03-08.
#
#=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::Sprintf>. 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
#
#For convenience, a default is chosen for you under certain condition. When
#inside Emacs (environment C<INSIDE_EMACS> is set), C<Text::Table::Org> is used
#as default.
#
#=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://github.com/perlancar/perl-Perinci-Result-Format-Lite/issues>
#
#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) 2021, 2020, 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 $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-09-23'; # DATE
#our $DIST = 'Sah-Schemas-Rinci'; # DIST
#our $VERSION = '1.1.94.0'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Normalize ();
#use Sah::Schema::rinci::meta ();
#
#our $schema = [hash => {
#    summary => 'Rinci function metadata',
#
#    # tmp
#    _ver => 1.1,
#    _prop => {
#        %Sah::Schema::rinci::meta::_dh_props,
#
#        # from common rinci metadata
#        entity_v => {},
#        entity_date => {},
#        links => {},
#
#        is_func => {},
#        is_meth => {},
#        is_class_meth => {},
#        args => {
#            _value_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                # common rinci metadata
#                links => {},
#
#                schema => {},
#                filters => {},
#                default => {},
#                req => {},
#                pos => {},
#                slurpy => {},
#                greedy => {}, # old alias for slurpy, will be removed in Rinci 1.2
#                partial => {},
#                stream => {},
#                is_password => {},
#                cmdline_aliases => {
#                    _value_prop => {
#                        summary => {},
#                        description => {},
#                        schema => {},
#                        code => {},
#                        is_flag => {},
#                    },
#                },
#                cmdline_on_getopt => {},
#                cmdline_prompt => {},
#                completion => {},
#                index_completion => {},
#                element_completion => {},
#                cmdline_src => {},
#                meta => 'fix',
#                element_meta => 'fix',
#                deps => {
#                    _keys => {
#                        arg => {},
#                        all => {},
#                        any => {},
#                        none => {},
#                    },
#                },
#                examples => {},
#            },
#        },
#        args_as => {},
#        args_rels => {},
#        result => {
#            _prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                schema => {},
#                statuses => {
#                    _value_prop => {
#                        # from defhash
#                        summary => {},
#                        description => {},
#                        schema => {},
#                    },
#                },
#                partial => {},
#                stream => {},
#            },
#        },
#        result_naked => {},
#        examples => {
#            _elem_prop => {
#                %Sah::Schema::rinci::meta::_dh_props,
#
#                args => {},
#                argv => {},
#                src => {},
#                src_plang => {},
#                status => {},
#                result => {},
#                naked_result => {},
#                env_result => {},
#                test => {},
#            },
#        },
#        features => {
#            _keys => {
#                reverse => {},
#                tx => {},
#                dry_run => {},
#                pure => {},
#                immutable => {},
#                idempotent => {},
#                check_arg => {},
#            },
#        },
#        deps => {
#            _keys => {
#                all => {},
#                any => {},
#                none => {},
#                env => {},
#                prog => {},
#                pkg => {},
#                func => {},
#                code => {},
#                tmp_dir => {},
#                trash_dir => {},
#            },
#        },
#    },
#
#    examples => [
#        {value=>{}, valid=>1},
#        {
#            value=>{v=>1.1, summary=>"Some function", args=>{a1=>{}, a2=>{}}},
#            valid=>1,
#        },
#        # XXX we have not implemented property & attribute checking
#    ],
#
#}, {}];
#
#$schema->[1]{_prop}{args}{_value_prop}{meta} = $schema->[1];
#$schema->[1]{_prop}{args}{_value_prop}{element_meta} = $schema->[1];
#
## just so the dzil plugin won't complain about schema not being normalized.
## because this is a circular structure and normalizing creates a shallow copy.
#
#$schema = Data::Sah::Normalize::normalize_schema($schema);
#
#1;
## ABSTRACT: Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schema::rinci::function_meta - Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 1.1.94.0 of Sah::Schema::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=head1 SYNOPSIS
#
#To check data against this schema (requires L<Data::Sah>):
#
# use Data::Sah qw(gen_validator);
# my $validator = gen_validator("rinci::function_meta*");
# say $validator->($data) ? "valid" : "INVALID!";
#
# # Data::Sah can also create validator that returns nice error message string
# # and/or coerced value. Data::Sah can even create validator that targets other
# # language, like JavaScript. All from the same schema. See its documentation
# # for more details.
#
#To validate function parameters against this schema (requires L<Params::Sah>):
#
# use Params::Sah qw(gen_validator);
#
# sub myfunc {
#     my @args = @_;
#     state $validator = gen_validator("rinci::function_meta*");
#     $validator->(\@args);
#     ...
# }
#
#To specify schema in L<Rinci> function metadata and use the metadata with
#L<Perinci::CmdLine> to create a CLI:
#
# # in lib/MyApp.pm
# package MyApp;
# our %SPEC;
# $SPEC{myfunc} = {
#     v => 1.1,
#     summary => 'Routine to do blah ...',
#     args => {
#         arg1 => {
#             summary => 'The blah blah argument',
#             schema => ['rinci::function_meta*'],
#         },
#         ...
#     },
# };
# sub myfunc {
#     my %args = @_;
#     ...
# }
# 1;
#
# # in myapp.pl
# package main;
# use Perinci::CmdLine::Any;
# Perinci::CmdLine::Any->new(url=>'MyApp::myfunc')->run;
#
# # in command-line
# % ./myapp.pl --help
# myapp - Routine to do blah ...
# ...
#
# % ./myapp.pl --version
#
# % ./myapp.pl --arg1 ...
#
#Sample data:
#
# {}  # valid
#
# {args=>{a1=>{},a2=>{}},summary=>"Some function",v=>1.1}  # valid
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-Rinci>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-Rinci>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-Rinci>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2016 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Scalar/Util/Numeric/PP.pm ###
#package Scalar::Util::Numeric::PP;
#
#our $DATE = '2016-01-22'; # DATE
#our $VERSION = '0.04'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA       = qw(Exporter);
#our @EXPORT_OK = qw(
#                       isint
#                       isnum
#                       isnan
#                       isinf
#                       isneg
#                       isfloat
#               );
#
#sub isint {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?(?:0|[1-9][0-9]*)\s*\z/s;
#    0;
#}
#
#sub isnan($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?nan\s*\z/is;
#    0;
#}
#
#sub isinf($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?inf(?:inity)?\s*\z/is;
#    0;
#}
#
#sub isneg($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*-/;
#    0;
#}
#
#sub isnum($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if isint($_);
#    return 1 if isfloat($_);
#    0;
#}
#
#sub isfloat($) {
#    local $_ = shift;
#    return 0 unless defined;
#    return 1 if /\A\s*[+-]?
#                 (?: (?:0|[1-9][0-9]*)(\.[0-9]+)? | (\.[0-9]+) )
#                 ([eE][+-]?[0-9]+)?\s*\z/sx && $1 || $2 || $3;
#    return 1 if isnan($_) || isinf($_);
#    0;
#}
#
#1;
## ABSTRACT: Pure-perl drop-in replacement/approximation of Scalar::Util::Numeric
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Scalar::Util::Numeric::PP - Pure-perl drop-in replacement/approximation of Scalar::Util::Numeric
#
#=head1 VERSION
#
#This document describes version 0.04 of Scalar::Util::Numeric::PP (from Perl distribution Scalar-Util-Numeric-PP), released on 2016-01-22.
#
#=head1 SYNOPSIS
#
#=head1 DESCRIPTION
#
#This module is written mainly for the convenience of L<Data::Sah>, as a drop-in
#pure-perl replacement for the XS module L<Scalar::Util::Numeric>, in the case
#when Data::Sah needs to generate code that uses PP modules instead of XS ones.
#
#Not all functions from Scalar::Util::Numeric have been provided.
#
#=head1 FUNCTIONS
#
#=head2 isint
#
#=head2 isfloat
#
#=head2 isnum
#
#=head2 isneg
#
#=head2 isinf
#
#=head2 isnan
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Scalar-Util-Numeric-PP>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Scalar-Util-Numeric-PP>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Scalar-Util-Numeric-PP>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Data::Sah>
#
#L<Scalar::Util::Numeric>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2016 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Text/Table/Tiny.pm ###
#package Text::Table::Tiny;
#$Text::Table::Tiny::VERSION = '1.02';
#use 5.010;
#use strict;
#use warnings;
#use utf8;
#use parent 'Exporter';
#use Carp                    qw/ croak /;
#use Ref::Util         0.202 qw/ is_arrayref /;
#use String::TtyLength 0.02  qw/ tty_width /;
#
#our @EXPORT_OK = qw/ generate_table /;
#
## Legacy package globals, that can be used to customise the look.
## These are only used in the "classic" style.
## I wish I could drop them, but I don't want to break anyone's code.
#our $COLUMN_SEPARATOR     = '|';
#our $ROW_SEPARATOR        = '-';
#our $CORNER_MARKER        = '+';
#our $HEADER_ROW_SEPARATOR = '=';
#our $HEADER_CORNER_MARKER = 'O';
#
#my %arguments = (
#    rows => "the rows, including a possible header row, of the table",
#    header_row => "if true, indicates that the first row is a header row",
#    separate_rows => "if true, a separate rule will be drawn between each row",
#    top_and_tail => "if true, miss out top and bottom edges of table",
#    align => "either single alignment, or an array per of alignments per col",
#    style => "styling of table, one of classic, boxrule, or norule",
#    indent => "indent every row of the table a certain number of spaces",
#    compact => "narrow columns (no space either side of content)",
#);
#
#my %charsets = (
#    classic => { TLC => '+', TT => '+', TRC => '+', HR => '-', VR => '|', FHR => '=', LT => '+', RT => '+', FLT => 'O', FRT => 'O', HC => '+', FHC => 'O', BLC => '+', BT => '+', BRC => '+' },
#    boxrule => { TLC => 'â', TT => 'â¬', TRC => 'â', HR => 'â', VR => 'â', FHR => 'â', LT => 'â', RT => 'â¤', FLT => 'â', FRT => 'â¡', HC => 'â¼', FHC => 'âª', BLC => 'â', BT => 'â´', BRC => 'â' },
#    norule  => { TLC => ' ', TT => ' ', TRC => ' ', HR => ' ', VR => ' ', FHR => ' ', LT => ' ', RT => ' ', FLT => ' ', FRT => ' ', HC => ' ', FHC => ' ', BLC => ' ', BT => ' ', BRC => ' ' },
#);
#
#sub generate_table
#{
#    my %param   = @_;
#
#    foreach my $arg (keys %param) {
#        croak "unknown argument '$arg'" if not exists $arguments{$arg};
#    }
#
#    my $rows    = $param{rows} or croak "you must pass the 'rows' argument!";
#    my @rows    = @$rows;
#    my @widths  = _calculate_widths($rows);
#
#    $param{style}  //= 'classic';
#
#    $param{indent} //= '';
#    $param{indent} = ' ' x $param{indent} if $param{indent} =~ /^[0-9]+$/;
#
#    my $style   = $param{style};
#    croak "unknown style '$style'" if not exists($charsets{ $style });
#    my $char    = $charsets{$style};
#
#    if ($style eq 'classic') {
#        $char->{TLC} = $char->{TRC} = $char->{TT} = $char->{LT} = $char->{RT} = $char->{HC} = $char->{BLC} = $char->{BT} = $char->{BRC} = $CORNER_MARKER;
#        $char->{HR}  = $ROW_SEPARATOR;
#        $char->{VR}  = $COLUMN_SEPARATOR;
#        $char->{FLT} = $char->{FRT} = $char->{FHC} = $HEADER_CORNER_MARKER;
#        $char->{FHR} = $HEADER_ROW_SEPARATOR;
#    }
#
#    my $header;
#    my @align;
#    if (defined $param{align}) {
#        @align = is_arrayref($param{align})
#               ? @{ $param{align} }
#               : ($param{align}) x int(@widths)
#               ;
#    }
#    else {
#        @align = ('l') x int(@widths);
#    }
#
#    $header = shift @rows if $param{header_row};
#
#    my $table = _top_border(\%param, \@widths, $char)
#                ._header_row(\%param, $header, \@widths, \@align, $char)
#                ._header_rule(\%param, \@widths, $char)
#                ._body(\%param, \@rows, \@widths, \@align, $char)
#                ._bottom_border(\%param, \@widths, $char);
#    chop($table);
#
#    return $table;
#}
#
#sub _top_border
#{
#    my ($param, $widths, $char) = @_;
#
#    return '' if $param->{top_and_tail};
#    return _rule_row($param, $widths, $char->{TLC}, $char->{HR}, $char->{TT}, $char->{TRC});
#}
#
#sub _bottom_border
#{
#    my ($param, $widths, $char) = @_;
#
#    return '' if $param->{top_and_tail};
#    return _rule_row($param, $widths, $char->{BLC}, $char->{HR}, $char->{BT}, $char->{BRC});
#}
#
#sub _rule_row
#{
#    my ($param, $widths, $le, $hr, $cross, $re) = @_;
#    my $pad = $param->{compact} ? '' : $hr;
#
#    return $param->{indent}
#           .$le
#           .join($cross, map { $pad.($hr x $_).$pad } @$widths)
#           .$re
#           ."\n"
#           ;
#}
#
#sub _header_row
#{
#    my ($param, $row, $widths, $align, $char) = @_;
#    return '' unless $param->{header_row};
#
#    return _text_row($param, $row, $widths, $align, $char);
#}
#
#sub _header_rule
#{
#    my ($param, $widths, $char) = @_;
#    return '' unless $param->{header_row};
#    my $fancy = $param->{separate_rows} ? 'F' : '';
#
#    return _rule_row($param, $widths, $char->{"${fancy}LT"}, $char->{"${fancy}HR"}, $char->{"${fancy}HC"}, $char->{"${fancy}RT"});
#}
#
#sub _body
#{
#    my ($param, $rows, $widths, $align, $char) = @_;
#    my $divider = $param->{separate_rows} ? _rule_row($param, $widths, $char->{LT}, $char->{HR}, $char->{HC}, $char->{RT}) : '';
#
#    return join($divider, map { _text_row($param, $_, $widths, $align, $char) } @$rows);
#}
#
#sub _text_row
#{
#    my ($param, $row, $widths, $align, $char) = @_;
#    my @columns = @$row;
#    my $text = $param->{indent}.$char->{VR};
#
#    for (my $i = 0; $i < @$widths; $i++) {
#        $text .= _format_column($columns[$i] // '', $widths->[$i], $align->[$i] // 'l', $param, $char);
#        $text .= $char->{VR};
#    }
#    $text .= "\n";
#
#    return $text;
#}
#
#sub _format_column
#{
#    my ($text, $width, $align, $param, $char) = @_;
#    my $pad = $param->{compact} ? '' : ' ';
#
#    if ($align eq 'r' || $align eq 'right') {
#        return $pad.' ' x ($width - tty_width($text)).$text.$pad;
#    }
#    elsif ($align eq 'c' || $align eq 'center' || $align eq 'centre') {
#        my $total_spaces = $width - tty_width($text);
#        my $left_spaces  = int($total_spaces / 2);
#        my $right_spaces = $left_spaces;
#        $right_spaces++ if $total_spaces % 2 == 1;
#        return $pad.(' ' x $left_spaces).$text.(' ' x $right_spaces).$pad;
#    }
#    else {
#        return $pad.$text.' ' x ($width - tty_width($text)).$pad;
#    }
#}
#
#sub _calculate_widths
#{
#    my $rows = shift;
#    my @widths;
#    foreach my $row (@$rows) {
#        my @columns = @$row;
#        for (my $i = 0; $i < @columns; $i++) {
#            next unless defined($columns[$i]);
#
#            my $width = tty_width($columns[$i]);
#
#            $widths[$i] = $width if !defined($widths[$i])
#                                 || $width > $widths[$i];
#        }
#    }
#    return @widths;
#}
#
## Back-compat: 'table' is an alias for 'generate_table', but isn't exported
#*table = \&generate_table;
#
#1;
#
#__END__
#
#=pod
#
#=encoding utf8
#
#=head1 NAME
#
#Text::Table::Tiny - generate simple text tables from 2D arrays
#
#=head1 SYNOPSIS
#
# use Text::Table::Tiny 1.02 qw/ generate_table /;
#
# my $rows = [
#   [qw/ Pokemon     Type     Count /],
#   [qw/ Abra        Psychic      5 /],
#   [qw/ Ekans       Poison     123 /],
#   [qw/ Feraligatr  Water     5678 /],
# ];
#
# print generate_table(rows => $rows, header_row => 1), "\n";
#
#
#=head1 DESCRIPTION
#
#This module provides a single function, C<generate_table>, which formats
#a two-dimensional array of data as a text table.
#It handles text that includes ANSI escape codes and wide Unicode characters.
#
#There are a number of options for adjusting the output format,
#but the intention is that the default option is good enough for most uses.
#
#The example shown in the SYNOPSIS generates the following table:
#
# +------------+---------+-------+
# | Pokemon    | Type    | Count |
# +------------+---------+-------+
# | Abra       | Psychic | 5     |
# | Ekans      | Poison  | 123   |
# | Feraligatr | Water   | 5678  |
# +------------+---------+-------+
#
#Support for wide characters was added in 1.02,
#so if you need that,
#you should specify that as your minimum required version,
#as per the SYNOPSIS.
#
#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.
#
#Some of the options described below were added in version 1.00,
#so your best bet is to require at least version 1.00.
#
#
#=head2 generate_table()
#
#The C<generate_table> function understands a number of arguments,
#which are passed as a hash.
#The only required argument is B<rows>.
#Where arguments were not supported in the original release,
#the first supporting version is noted.
#
#If you pass an unknown argument,
#C<generate_table> will die with an error message.
#
#=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.
#
#Added in 0.04.
#
#=item *
#
#align
#
#This takes an array ref with one entry per column,
#to specify the alignment of that column.
#Legal values are 'l', 'c', and 'r'.
#You can also specify a single alignment for all columns.
#ANSI escape codes are handled.
#
#Added in 1.00.
#
#=item *
#
#style
#
#Specifies the format of the output table.
#The default is C<'classic'>,
#but other options are C<'boxrule'> and C<'norule'>.
#
#If you use the C<boxrule> style,
#you'll probably need to run C<binmode(STDOUT, ':utf8')>.
#
#Added in 1.00.
#
#
#=item *
#
#indent
#
#Specify an indent that should be prefixed to every line
#of the generated table.
#This can either be a string of spaces,
#or an integer giving the number of spaces wanted.
#
#Added in 1.00.
#
#=item *
#
#compact
#
#If set to a true value then we omit the single space padding on either
#side of every column.
#
#Added in 1.00.
#
#=back
#
#
#=head2 EXAMPLES
#
#If you just pass the data and no other options:
#
# generate_table(rows => $rows);
#
#You get minimal ruling:
#
# +------------+---------+-------+
# | Pokemon    | Type    | Count |
# | Abra       | Psychic | 5     |
# | Ekans      | Poison  | 123   |
# | Feraligatr | Water   | 5678  |
# +------------+---------+-------+
#
#If you want a separate header, set the header_row option to a true value,
#as shown in the SYNOPSIS.
#
#To take up fewer lines,
#you can miss out the top and bottom rules,
#by setting C<top_and_tail> to a true value:
#
# generate_table(rows => $rows, header_row => 1, top_and_tail => 1);
#
#This will generate the following:
#
# | Pokemon    | Type    | Count |
# +------------+---------+-------+
# | Abra       | Psychic | 5     |
# | Ekans      | Poison  | 123   |
# | Feraligatr | Water   | 5678  |
#
#If you want a more stylish looking table,
#set the C<style> parameter to C<'boxrule'>:
#
# binmode(STDOUT,':utf8');
# generate_table(rows => $rows, header_row => 1, style => 'boxrule');
#
#This uses the ANSI box rule characters.
#Note that you will need to ensure UTF output.
#
# ââââââââââââââ¬ââââââââââ¬ââââââââ
# â Pokemon    â Type    â Count â
# ââââââââââââââ¼ââââââââââ¼ââââââââ¤
# â Abra       â Psychic â 5     â
# â Ekans      â Poison  â 123   â
# â Feraligatr â Water   â 5678  â
# ââââââââââââââ´ââââââââââ´ââââââââ
#
#You might want to right-align numeric values:
#
# generate_table( ... , align => [qw/ l l r /] );
#
#The C<align> parameter can either take an arrayref,
#or a string with an alignment to apply to all columns:
#
# ââââââââââââââ¬ââââââââââ¬ââââââââ
# â Pokemon    â Type    â Count â
# ââââââââââââââ¼ââââââââââ¼ââââââââ¤
# â Abra       â Psychic â     5 â
# â Ekans      â Poison  â   123 â
# â Feraligatr â Water   â  5678 â
# ââââââââââââââ´ââââââââââ´ââââââââ
#
#If you're using the boxrule style,
#you might feel you can remove the padding on either side of every column,
#done by setting C<compact> to a true value:
#
# ââââââââââââ¬ââââââââ¬ââââââ
# âPokemon   âType   âCountâ
# ââââââââââââ¼ââââââââ¼ââââââ¤
# âAbra      âPsychicâ    5â
# âEkans     âPoison â  123â
# âFeraligatrâWater  â 5678â
# ââââââââââââ´ââââââââ´ââââââ
#
#You can also ask for a rule between each row,
#in which case the header rule becomes stronger.
#This works best when combined with the boxrule style:
#
# generate_table( ... , separate_rows => 1 );
#
#Which results in the following:
#
# ââââââââââââââ¬ââââââââââ¬ââââââââ
# â Pokemon    â Type    â Count â
# ââââââââââââââªââââââââââªââââââââ¡
# â Abra       â Psychic â     5 â
# ââââââââââââââ¼ââââââââââ¼ââââââââ¤
# â Ekans      â Poison  â   123 â
# ââââââââââââââ¼ââââââââââ¼ââââââââ¤
# â Feraligatr â Water   â  5678 â
# ââââââââââââââ´ââââââââââ´ââââââââ
#
#You can use this with the other styles,
#but I'm not sure you'd want to.
# 
#If you just want columnar output,
#use the C<norule> style:
#
# generate_table( ... , style => 'norule' );
#
#which results in:
#
#  
#  Pokemon      Type      Count
#  
#  Abra         Psychic       5
#  Ekans        Poison      123
#  Feraligatr   Water      5678
#   
#
#Note that everywhere you saw a line on the previous tables,
#there will be a space character in this version.
#So you may want to combine the C<top_and_tail> option,
#to suppress the extra blank lines before and after
#the body of the table.
#
#
#=head1 SEE ALSO
#
#My L<blog post|http://neilb.org/2019/08/06/text-table-tiny-changes.html>
#where I described changes to formatting;
#this has more examples.
#
#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
#
#Neil Bowers <neilb@cpan.org>
#
#The original version was written by Creighton Higgins <chiggins@chiggins.com>,
#but the module was entirely rewritten for 0.05_01.
#
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020 by Neil Bowers.
#
#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
#
### begin code_after_end
### end code_after_end
