—

              
#!perl
### code_after_shebang
# Note: This script is a CLI for Riap function /App/ppgrep/ppgrep
# and generated automatically using Perinci::CmdLine::Gen version 0.491
# PERICMD_INLINE_SCRIPT: {"code_after_shebang":"...","config_dirs":null,"config_filename":"ppgrep.conf","env_name":"PPGREP_OPT","include":null,"log":null,"pack_deps":1,"pod":0,"read_config":"0","read_env":"0","script_name":"ppgrep","script_summary":null,"script_version":"0.033","shebang":"perl","skip_format":1,"subcommands":null,"url":"/App/ppgrep/ppgrep","use_cleanser":1,"validate_args":1}
my $_pci_metas = {""=>{args=>{count=>{cmdline_aliases=>{c=>{}},schema=>["true",{req=>1},{}],summary=>"Suppress normal output; instead print a count of matching processes",tags=>["category:display"]},euid=>{cmdline_aliases=>{u=>{}},schema=>["array",{of=>["str",{req=>1},{}],req=>1,"x.perl.coerce_rules"=>["From_str::comma_sep"]},{}],summary=>"Only match processes whose effective user ID is listed. Either the numerical or symbolical value may be used.",tags=>["category:filtering"]},exact=>{cmdline_aliases=>{x=>{}},schema=>["true",{req=>1},{}],summary=>"Only match processes whose names (or command line if -f is specified) exactly match the pattern",tags=>["category:filtering"]},full=>{cmdline_aliases=>{f=>{}},schema=>["true",{req=>1},{}],summary=>"The pattern is normally only matched against the process name. When -f is set, the full command line is used.",tags=>["category:filtering"]},group=>{cmdline_aliases=>{G=>{}},schema=>["array",{of=>["str",{req=>1},{}],req=>1,"x.perl.coerce_rules"=>["From_str::comma_sep"]},{}],summary=>"Only match processes whose real group ID is listed. Either the numerical or symbolical value may be used.",tags=>["category:filtering"]},inverse=>{cmdline_aliases=>{v=>{}},schema=>["true",{req=>1},{}],summary=>"Negates the matching",tags=>["category:filtering"]},list_full=>{cmdline_aliases=>{a=>{}},schema=>["true",{req=>1},{}],summary=>"List the full command line as well as the process ID",tags=>["category:display"]},list_name=>{cmdline_aliases=>{l=>{}},schema=>["true",{req=>1},{}],summary=>"List the process name as well as the process ID",tags=>["category:display"]},pattern=>{pos=>0,schema=>["str",{req=>1},{}],summary=>"Only match processes whose name/cmdline match the pattern",tags=>["category:filtering"]},pgroup=>{cmdline_aliases=>{g=>{}},schema=>["array",{of=>["uint",{req=>1},{}],req=>1,"x.perl.coerce_rules"=>["From_str::comma_sep"]},{}],summary=>"Only match processes in the process group IDs listed",tags=>["category:filtering"]},session=>{cmdline_aliases=>{s=>{}},schema=>["array",{of=>["uint",{req=>1},{}],req=>1,"x.perl.coerce_rules"=>["From_str::comma_sep"]},{}],summary=>"Only match processes whose process session ID is listed",tags=>["category:filtering"]},terminal=>{cmdline_aliases=>{t=>{}},schema=>["array",{of=>["str",{req=>1},{}],req=>1,"x.perl.coerce_rules"=>["From_str::comma_sep"]},{}],summary=>"Only match processes whose controlling terminal is listed. The terminal name should be specified without the \"/dev/\" prefix.",tags=>["category:filtering"]},uid=>{cmdline_aliases=>{U=>{}},schema=>["array",{of=>["str",{req=>1},{}],req=>1,"x.perl.coerce_rules"=>["From_str::comma_sep"]},{}],summary=>"Only match processes whose user ID is listed. Either the numerical or symbolical value may be used.",tags=>["category:filtering"]}},description=>"\nThis utility is similar to <prog:pgrep> except that we only look at our\ndescendants (parent, parent's parent, and so on up to PID 1).\n\n",links=>["prog:pgrep"],result=>{},summary=>"Look up parents' processes based on name and other attributes",v=>1.1}};
# This script is generated by Perinci::CmdLine::Inline version 0.545 on Fri Nov 29 13:50:02 2019.
# Rinci metadata taken from these modules: App::ppgrep (no version)
# You probably should not manually edit this file.
our $DATE = '2019-11-29'; # DATE
our $VERSION = '0.033'; # VERSION
# PODNAME: ppgrep
# ABSTRACT: Look up parents' processes based on name and other attributes
# BEGIN DATAPACK CODE
{
    my $toc;
    my $data_linepos = 1;
    unshift @INC, sub {
        $toc ||= do {
            my $fh = \*DATA;
        my $header_line;
        my $header_found;
        while (1) {
            my $header_line = <$fh>;
            defined($header_line)
                or die "Unexpected end of data section while reading header line";
            chomp($header_line);
            if ($header_line eq 'Data::Section::Seekable v1') {
                $header_found++;
                last;
            }
        }
        die "Can't find header 'Data::Section::Seekable v1'"
            unless $header_found;
        my %toc;
        my $i = 0;
        while (1) {
            $i++;
            my $toc_line = <$fh>;
            defined($toc_line)
                or die "Unexpected end of data section while reading TOC line #$i";
            chomp($toc_line);
            $toc_line =~ /\S/ or last;
            $toc_line =~ /^([^,]+),(\d+),(\d+)(?:,(.*))?$/
                or die "Invalid TOC line #$i in data section: $toc_line";
            $toc{$1} = [$2, $3, $4];
        }
        my $pos = tell $fh;
        $toc{$_}[0] += $pos for keys %toc;
            # calculate the line number of data section
            my $data_pos = tell(DATA);
            seek DATA, 0, 0;
            my $pos = 0;
            while (1) {
                my $line = <DATA>;
                $pos += length($line);
                $data_linepos++;
                last if $pos >= $data_pos;
            }
            seek DATA, $data_pos, 0;
            \%toc;
        };
        if ($toc->{$_[1]}) {
            seek DATA, $toc->{$_[1]}[0], 0;
            read DATA, my($content), $toc->{$_[1]}[1];
            my ($order, $lineoffset) = split(';', $toc->{$_[1]}[2]);
            $content =~ s/^#//gm;
            $content = "# line ".($data_linepos + $order+1 + $lineoffset)." \"".__FILE__."\"\n" . $content;
            open my $fh, '<', \$content
                or die "DataPacker error loading $_[1]: $!";
            return $fh;
        }
        return;
    };
}
# END DATAPACK CODE
package main;
use 5.010001;
use strict;
#use warnings;
# modules
### declare global variables
our $_pci_meta_result_stream = 0;
our $_pci_meta_result_type;
our $_pci_meta_result_type_is_simple;
our $_pci_meta_skip_format = 0;
our $_pci_r = {naked_res=>0,read_config=>0,read_env=>0,subcommand_name=>""};
our %_pci_args;
### declare subroutines
sub _pci_err {
    my $res = shift;
    print STDERR "ERROR $res->[0]: $res->[1]\n";
    exit $res->[0]-300;
}
sub _pci_json {
    state $json = do {
        if (eval { require JSON::XS; 1 }) { JSON::XS->new->canonical(1)->allow_nonref }
        else { require JSON::PP; JSON::PP->new->canonical(1)->allow_nonref }
    };
    $json;
}
### get arguments (from config file, env, command-line args
{
my %mentioned_args;
require Getopt::Long::EvenLess;
my $go_spec1 = {
    'help|h|?' => sub { print "ppgrep - Look up parents' processes based on name and other attributes\n\nUsage:\n  ppgrep --help (or -h, -?)\n  ppgrep --version (or -v)\n  ppgrep [options] [pattern]\n\nThis utility is similar to <prog:pgrep> except that we only look at our\ndescendants (parent, parent's parent, and so on up to PID 1).\n\nDisplay options:\n  --count, -c      Suppress normal output; instead print a count of matching processes\n  --list-full, -a  List the full command line as well as the process ID\n  --list-name, -l  List the process name as well as the process ID\n\nFiltering options:\n  --euid=s\@, -u      Only match processes whose effective user ID is listed. Either the numerical or\n\t\t       symbolical value may be used.\n  --exact, -x        Only match processes whose names (or command line if -f is specified) exactly\n\t\t       match the pattern\n  --full, -f         The pattern is normally only matched against the process name. When -f is set,\n\t\t       the full command line is used.\n  --group=s\@, -G     Only match processes whose real group ID is listed. Either the numerical or\n\t\t       symbolical value may be used.\n  --inverse          Negates the matching\n  --pattern=s        Only match processes whose name/cmdline match the pattern (=arg[0])\n  --pgroup=s\@, -g    Only match processes in the process group IDs listed\n  --session=s\@, -s   Only match processes whose process session ID is listed\n  --terminal=s\@, -t  Only match processes whose controlling terminal is listed. The terminal name\n\t\t       should be specified without the \"/dev/\" prefix.\n  --uid=s\@, -U       Only match processes whose user ID is listed. Either the numerical or\n\t\t       symbolical value may be used.\n\nOther options:\n  --help, -h, -?  Display help message and exit\n  --version, -v   Display program's version and exit\n"; exit 0; },
    'version|v' => sub { no warnings 'once'; require App::ppgrep; print "ppgrep version ", "0.033", ($App::ppgrep::DATE ? " ($App::ppgrep::DATE)" : ''), "\n"; print "  Generated by Perinci::CmdLine::Inline version 0.545 (2019-04-15)\n"; exit 0 },
};
my $go_spec2 = {
    'G=s@' => sub {         if ($mentioned_args{'group'}++) { push @{ $_pci_args{'group'} }, $_[1] } else { $_pci_args{'group'} = [$_[1]] }
 },
    'U=s@' => sub {         if ($mentioned_args{'uid'}++) { push @{ $_pci_args{'uid'} }, $_[1] } else { $_pci_args{'uid'} = [$_[1]] }
 },
    'a' => sub {         $_pci_args{'list_full'} = $_[1];
 },
    'c' => sub {         $_pci_args{'count'} = $_[1];
 },
    'count' => sub {         $_pci_args{'count'} = $_[1];
 },
    'euid-json=s' => sub {         $_pci_args{'euid'} = _pci_json()->decode($_[1]);
 },
    'euid=s@' => sub {         if ($mentioned_args{'euid'}++) { push @{ $_pci_args{'euid'} }, $_[1] } else { $_pci_args{'euid'} = [$_[1]] }
 },
    'exact' => sub {         $_pci_args{'exact'} = $_[1];
 },
    'f' => sub {         $_pci_args{'full'} = $_[1];
 },
    'full' => sub {         $_pci_args{'full'} = $_[1];
 },
    'g=s@' => sub {         if ($mentioned_args{'pgroup'}++) { push @{ $_pci_args{'pgroup'} }, $_[1] } else { $_pci_args{'pgroup'} = [$_[1]] }
 },
    'group-json=s' => sub {         $_pci_args{'group'} = _pci_json()->decode($_[1]);
 },
    'group=s@' => sub {         if ($mentioned_args{'group'}++) { push @{ $_pci_args{'group'} }, $_[1] } else { $_pci_args{'group'} = [$_[1]] }
 },
    'help|h|?' => sub {  },
    'inverse' => sub {         $_pci_args{'inverse'} = $_[1];
 },
    'l' => sub {         $_pci_args{'list_name'} = $_[1];
 },
    'list-full' => sub {         $_pci_args{'list_full'} = $_[1];
 },
    'list-name' => sub {         $_pci_args{'list_name'} = $_[1];
 },
    'pattern=s' => sub {         $_pci_args{'pattern'} = $_[1];
 },
    'pgroup-json=s' => sub {         $_pci_args{'pgroup'} = _pci_json()->decode($_[1]);
 },
    'pgroup=s@' => sub {         if ($mentioned_args{'pgroup'}++) { push @{ $_pci_args{'pgroup'} }, $_[1] } else { $_pci_args{'pgroup'} = [$_[1]] }
 },
    's=s@' => sub {         if ($mentioned_args{'session'}++) { push @{ $_pci_args{'session'} }, $_[1] } else { $_pci_args{'session'} = [$_[1]] }
 },
    'session-json=s' => sub {         $_pci_args{'session'} = _pci_json()->decode($_[1]);
 },
    'session=s@' => sub {         if ($mentioned_args{'session'}++) { push @{ $_pci_args{'session'} }, $_[1] } else { $_pci_args{'session'} = [$_[1]] }
 },
    't=s@' => sub {         if ($mentioned_args{'terminal'}++) { push @{ $_pci_args{'terminal'} }, $_[1] } else { $_pci_args{'terminal'} = [$_[1]] }
 },
    'terminal-json=s' => sub {         $_pci_args{'terminal'} = _pci_json()->decode($_[1]);
 },
    'terminal=s@' => sub {         if ($mentioned_args{'terminal'}++) { push @{ $_pci_args{'terminal'} }, $_[1] } else { $_pci_args{'terminal'} = [$_[1]] }
 },
    'u=s@' => sub {         if ($mentioned_args{'euid'}++) { push @{ $_pci_args{'euid'} }, $_[1] } else { $_pci_args{'euid'} = [$_[1]] }
 },
    'uid-json=s' => sub {         $_pci_args{'uid'} = _pci_json()->decode($_[1]);
 },
    'uid=s@' => sub {         if ($mentioned_args{'uid'}++) { push @{ $_pci_args{'uid'} }, $_[1] } else { $_pci_args{'uid'} = [$_[1]] }
 },
    'version|v' => sub {  },
    'x' => sub {         $_pci_args{'exact'} = $_[1];
 },
};
my $old_conf = Getopt::Long::EvenLess::Configure("pass_through");
Getopt::Long::EvenLess::GetOptions(%$go_spec1);
Getopt::Long::EvenLess::Configure($old_conf);
my $res = Getopt::Long::EvenLess::GetOptions(%$go_spec2);
_pci_err([500, "GetOptions failed"]) unless $res;
}
### check arguments
{
require Local::_pci_check_args; my $res = _pci_check_args(\%_pci_args);
_pci_err($res) if $res->[0] != 200;
$_pci_r->{args} = \%_pci_args;
}
### call function
{
my $sc_name = $_pci_r->{subcommand_name};
if ($sc_name eq "") {
    $_pci_meta_result_type = "";
    require App::ppgrep;
    eval { $_pci_r->{res} = App::ppgrep::ppgrep(%_pci_args) };
    if ($@) { $_pci_r->{res} = [500, "Function died: $@"] }
}
}
### format & display result
{
my $fres;
my $save_res; if (exists $_pci_r->{res}[3]{"cmdline.result"}) { $save_res = $_pci_r->{res}[2]; $_pci_r->{res}[2] = $_pci_r->{res}[3]{"cmdline.result"} }
my $is_success = $_pci_r->{res}[0] =~ /\A2/ || $_pci_r->{res}[0] == 304;
my $is_stream = $_pci_r->{res}[3]{stream} // $_pci_meta_result_stream // 0;
if ($is_success && (1 || $_pci_meta_skip_format || $_pci_r->{res}[3]{"cmdline.skip_format"})) { $fres = $_pci_r->{res}[2] }
elsif ($is_success && $is_stream) {}
else { require Local::_pci_clean_json; require Perinci::Result::Format::Lite; $is_stream=0; _pci_clean_json($_pci_r->{res}); $fres = Perinci::Result::Format::Lite::format($_pci_r->{res}, ($_pci_r->{format} // $_pci_r->{res}[3]{"cmdline.default_format"} // "text"), $_pci_r->{naked_res}, 0) }
my $use_utf8 = $_pci_r->{res}[3]{"x.hint.result_binary"} ? 0 : 0;
if ($use_utf8) { binmode STDOUT, ":encoding(utf8)" }
if ($is_stream) {
    my $code = $_pci_r->{res}[2]; if (ref($code) ne "CODE") { die "Result is a stream but no coderef provided" } if ($_pci_meta_result_type_is_simple) { while(defined(my $l=$code->())) { print $l; print "\n" unless $_pci_meta_result_type eq "buf"; } } else { while (defined(my $rec=$code->())) { print _pci_json()->encode($rec),"\n" } }
} else {
    print $fres;
}
if (defined $save_res) { $_pci_r->{res}[2] = $save_res }
}
### exit
{
my $status = $_pci_r->{res}[0];
my $exit_code = $_pci_r->{res}[3]{"cmdline.exit_code"} // ($status =~ /200|304/ ? 0 : ($status-300));
exit($exit_code);
}
HideShow 220 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
ppgrep - Look up parents' processes based on name and other attributes
=head1 VERSION
This document describes version 0.033 of main (from Perl distribution App-ppgrep), released on 2019-11-29.
=head1 SYNOPSIS
Usage:
 % ppgrep [options] [pattern]
=head1 DESCRIPTION
This utility is similar to L<pgrep> except that we only look at our
descendants (parent, parent's parent, and so on up to PID 1).
=head1 OPTIONS
C<*> marks required options.
=head2 Display options
=over
=item B<--count>, B<-c>
Suppress normal output; instead print a count of matching processes.
=item B<--list-full>, B<-a>
List the full command line as well as the process ID.
=item B<--list-name>, B<-l>
List the process name as well as the process ID.
=back
=head2 Filtering options
=over
=item B<--euid-json>=I<s>, B<-u>
Only match processes whose effective user ID is listed. Either the numerical or symbolical value may be used. (JSON-encoded).
See C<--euid>.
=item B<--euid>=I<s@>
Only match processes whose effective user ID is listed. Either the numerical or symbolical value may be used..
Can be specified multiple times.
=item B<--exact>, B<-x>
Only match processes whose names (or command line if -f is specified) exactly match the pattern.
=item B<--full>, B<-f>
The pattern is normally only matched against the process name. When -f is set, the full command line is used..
=item B<--group-json>=I<s>, B<-G>
Only match processes whose real group ID is listed. Either the numerical or symbolical value may be used. (JSON-encoded).
See C<--group>.
=item B<--group>=I<s@>
Only match processes whose real group ID is listed. Either the numerical or symbolical value may be used..
Can be specified multiple times.
=item B<--inverse>
Negates the matching.
=item B<--pattern>=I<s>
Only match processes whose name/cmdline match the pattern.
=item B<--pgroup-json>=I<s>, B<-g>
Only match processes in the process group IDs listed (JSON-encoded).
See C<--pgroup>.
=item B<--pgroup>=I<s@>
Only match processes in the process group IDs listed.
Can be specified multiple times.
=item B<--session-json>=I<s>, B<-s>
Only match processes whose process session ID is listed (JSON-encoded).
See C<--session>.
=item B<--session>=I<s@>
Only match processes whose process session ID is listed.
Can be specified multiple times.
=item B<--terminal-json>=I<s>, B<-t>
Only match processes whose controlling terminal is listed. The terminal name should be specified without the "/dev/" prefix. (JSON-encoded).
See C<--terminal>.
=item B<--terminal>=I<s@>
Only match processes whose controlling terminal is listed. The terminal name should be specified without the "/dev/" prefix..
Can be specified multiple times.
=item B<--uid-json>=I<s>, B<-U>
Only match processes whose user ID is listed. Either the numerical or symbolical value may be used. (JSON-encoded).
See C<--uid>.
=item B<--uid>=I<s@>
Only match processes whose user ID is listed. Either the numerical or symbolical value may be used..
Can be specified multiple times.
=back
=head2 Other options
=over
=item B<--help>, B<-h>, B<-?>
Display help message and exit.
=item B<--version>, B<-v>
Display program's version and exit.
=back
=head1 COMPLETION
The script comes with a companion shell completer script (L<_ppgrep>)
for this script.
=head2 bash
To activate bash completion for this script, put:
 complete -C _ppgrep ppgrep
in your bash startup (e.g. F<~/.bashrc>). Your next shell session will then
recognize tab completion for the command. Or, you can also directly execute the
line above in your shell to activate immediately.
It is recommended, however, that you install modules using L<cpanm-shcompgen>
which can activate shell completion for scripts immediately.
=head2 tcsh
To activate tcsh completion for this script, put:
 complete ppgrep 'p/*/`ppgrep`/'
in your tcsh startup (e.g. F<~/.tcshrc>). Your next shell session will then
recognize tab completion for the command. Or, you can also directly execute the
line above in your shell to activate immediately.
It is also recommended to install L<shcompgen> (see above).
=head2 other shells
For fish and zsh, install L<shcompgen> as described above.
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/App-ppgrep>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-App-ppgrep>.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-ppgrep>
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<pgrep>.
=head1 AUTHOR
perlancar <perlancar@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2019 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
Getopt/Long/EvenLess.pm,6383,11364,1;193
Local/_pci_check_args.pm,17780,18748,2;575
Local/_pci_clean_json.pm,36561,4414,3;909
Scalar/Util/Numeric/PP.pm,41009,3106,4;971
### 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
### 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->{"pattern"}) { return [400, "You specified --pattern but also argument #0"]; } else { $args->{"pattern"} = delete($ARGV[0]); } }
#        }
#        my @check_argv = @ARGV;
#        # fill from cmdline_src
#
#        # fill defaults from "default" property and check against schema
#        no warnings ('void');
#        require List::Util;
#        require Scalar::Util::Numeric::PP;
#        my $_sahv_dpath;
#        my $_sahv_err;
#        if (exists $args->{"count"}) {
#            $_sahv_dpath = [];
#            # req #1
#            ((defined($args->{"count"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"count"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#            
#            &&
#            
#            (# clause: is_true
#            (((1) ? $args->{"count"} : !defined(1) ? 1 : !$args->{"count"}) ? 1 : (($_sahv_err //= "Must be true"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"euid"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"euid"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#            
#            &&
#            
#            # coerce rule(s): From_str::comma_sep
#            (($args->{"euid"} = (!ref($args->{"euid"})) ? ([split /\s*,\s*/, $args->{"euid"}]) : $args->{"euid"}), 1)
#            
#            &&
#            
#            # check type 'array'
#            ((ref($args->{"euid"}) eq 'ARRAY') ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type array"),0))
#            
#            &&
#            
#            ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
#            ((!defined(List::Util::first(sub {!(
#                        ($_sahv_dpath->[-1] = $_),
#                        # req #0
#                        ((defined($args->{"euid"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#                        
#                        &&
#                        
#                        # check type 'str'
#                        ((!ref($args->{"euid"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))
#                        )}, 0..@{$args->{"euid"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))), pop(@{$_sahv_dpath})]->[1])
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"exact"}) {
#            $_sahv_dpath = [];
#            # req #1
#            ((defined($args->{"exact"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"exact"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#            
#            &&
#            
#            (# clause: is_true
#            (((1) ? $args->{"exact"} : !defined(1) ? 1 : !$args->{"exact"}) ? 1 : (($_sahv_err //= "Must be true"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"full"}) {
#            $_sahv_dpath = [];
#            # req #1
#            ((defined($args->{"full"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"full"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#            
#            &&
#            
#            (# clause: is_true
#            (((1) ? $args->{"full"} : !defined(1) ? 1 : !$args->{"full"}) ? 1 : (($_sahv_err //= "Must be true"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"group"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"group"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#            
#            &&
#            
#            # coerce rule(s): From_str::comma_sep
#            (($args->{"group"} = (!ref($args->{"group"})) ? ([split /\s*,\s*/, $args->{"group"}]) : $args->{"group"}), 1)
#            
#            &&
#            
#            # check type 'array'
#            ((ref($args->{"group"}) eq 'ARRAY') ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type array"),0))
#            
#            &&
#            
#            ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
#            ((!defined(List::Util::first(sub {!(
#                        ($_sahv_dpath->[-1] = $_),
#                        # req #0
#                        ((defined($args->{"group"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#                        
#                        &&
#                        
#                        # check type 'str'
#                        ((!ref($args->{"group"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))
#                        )}, 0..@{$args->{"group"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))), pop(@{$_sahv_dpath})]->[1])
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"inverse"}) {
#            $_sahv_dpath = [];
#            # req #1
#            ((defined($args->{"inverse"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"inverse"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#            
#            &&
#            
#            (# clause: is_true
#            (((1) ? $args->{"inverse"} : !defined(1) ? 1 : !$args->{"inverse"}) ? 1 : (($_sahv_err //= "Must be true"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"list_full"}) {
#            $_sahv_dpath = [];
#            # req #1
#            ((defined($args->{"list_full"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"list_full"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#            
#            &&
#            
#            (# clause: is_true
#            (((1) ? $args->{"list_full"} : !defined(1) ? 1 : !$args->{"list_full"}) ? 1 : (($_sahv_err //= "Must be true"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"list_name"}) {
#            $_sahv_dpath = [];
#            # req #1
#            ((defined($args->{"list_name"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'bool'
#            ((!ref($args->{"list_name"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
#            
#            &&
#            
#            (# clause: is_true
#            (((1) ? $args->{"list_name"} : !defined(1) ? 1 : !$args->{"list_name"}) ? 1 : (($_sahv_err //= "Must be true"),0)))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"pattern"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"pattern"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#            
#            &&
#            
#            # check type 'str'
#            ((!ref($args->{"pattern"})) ? 1 : (($_sahv_err //= "Not of type text"),0))
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"pgroup"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"pgroup"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#            
#            &&
#            
#            # coerce rule(s): From_str::comma_sep
#            (($args->{"pgroup"} = (!ref($args->{"pgroup"})) ? ([split /\s*,\s*/, $args->{"pgroup"}]) : $args->{"pgroup"}), 1)
#            
#            &&
#            
#            # check type 'array'
#            ((ref($args->{"pgroup"}) eq 'ARRAY') ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type array"),0))
#            
#            &&
#            
#            ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
#            ((!defined(List::Util::first(sub {!(
#                        ($_sahv_dpath->[-1] = $_),
#                        # req #1
#                        ((defined($args->{"pgroup"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#                        
#                        &&
#                        
#                        # check type 'int'
#                        ((Scalar::Util::Numeric::PP::isint($args->{"pgroup"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type integer"),0))
#                        
#                        &&
#                        
#                        (# clause: min
#                        (($args->{"pgroup"}->[$_] >= 0) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Must be at least 0"),0)))
#                        )}, 0..@{$args->{"pgroup"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Does not satisfy the following schema: each array element must be: (integer, must be at least 0)"),0))), pop(@{$_sahv_dpath})]->[1])
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"session"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"session"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#            
#            &&
#            
#            # coerce rule(s): From_str::comma_sep
#            (($args->{"session"} = (!ref($args->{"session"})) ? ([split /\s*,\s*/, $args->{"session"}]) : $args->{"session"}), 1)
#            
#            &&
#            
#            # check type 'array'
#            ((ref($args->{"session"}) eq 'ARRAY') ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type array"),0))
#            
#            &&
#            
#            ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
#            ((!defined(List::Util::first(sub {!(
#                        ($_sahv_dpath->[-1] = $_),
#                        # req #1
#                        ((defined($args->{"session"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#                        
#                        &&
#                        
#                        # check type 'int'
#                        ((Scalar::Util::Numeric::PP::isint($args->{"session"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type integer"),0))
#                        
#                        &&
#                        
#                        (# clause: min
#                        (($args->{"session"}->[$_] >= 0) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Must be at least 0"),0)))
#                        )}, 0..@{$args->{"session"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Does not satisfy the following schema: each array element must be: (integer, must be at least 0)"),0))), pop(@{$_sahv_dpath})]->[1])
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"terminal"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"terminal"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#            
#            &&
#            
#            # coerce rule(s): From_str::comma_sep
#            (($args->{"terminal"} = (!ref($args->{"terminal"})) ? ([split /\s*,\s*/, $args->{"terminal"}]) : $args->{"terminal"}), 1)
#            
#            &&
#            
#            # check type 'array'
#            ((ref($args->{"terminal"}) eq 'ARRAY') ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type array"),0))
#            
#            &&
#            
#            ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
#            ((!defined(List::Util::first(sub {!(
#                        ($_sahv_dpath->[-1] = $_),
#                        # req #0
#                        ((defined($args->{"terminal"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#                        
#                        &&
#                        
#                        # check type 'str'
#                        ((!ref($args->{"terminal"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))
#                        )}, 0..@{$args->{"terminal"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))), pop(@{$_sahv_dpath})]->[1])
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#        if (exists $args->{"uid"}) {
#            $_sahv_dpath = [];
#            # req #0
#            ((defined($args->{"uid"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#            
#            &&
#            
#            # coerce rule(s): From_str::comma_sep
#            (($args->{"uid"} = (!ref($args->{"uid"})) ? ([split /\s*,\s*/, $args->{"uid"}]) : $args->{"uid"}), 1)
#            
#            &&
#            
#            # check type 'array'
#            ((ref($args->{"uid"}) eq 'ARRAY') ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type array"),0))
#            
#            &&
#            
#            ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
#            ((!defined(List::Util::first(sub {!(
#                        ($_sahv_dpath->[-1] = $_),
#                        # req #0
#                        ((defined($args->{"uid"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#                        
#                        &&
#                        
#                        # check type 'str'
#                        ((!ref($args->{"uid"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))
#                        )}, 0..@{$args->{"uid"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))), pop(@{$_sahv_dpath})]->[1])
#             ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
#        } # if date arg exists
#
#        # check required args
#        return [400, "Missing required value for argument: count"] if exists($args->{"count"}) && !defined($args->{"count"});
#        return [400, "Missing required value for argument: euid"] if exists($args->{"euid"}) && !defined($args->{"euid"});
#        return [400, "Missing required value for argument: exact"] if exists($args->{"exact"}) && !defined($args->{"exact"});
#        return [400, "Missing required value for argument: full"] if exists($args->{"full"}) && !defined($args->{"full"});
#        return [400, "Missing required value for argument: group"] if exists($args->{"group"}) && !defined($args->{"group"});
#        return [400, "Missing required value for argument: inverse"] if exists($args->{"inverse"}) && !defined($args->{"inverse"});
#        return [400, "Missing required value for argument: list_full"] if exists($args->{"list_full"}) && !defined($args->{"list_full"});
#        return [400, "Missing required value for argument: list_name"] if exists($args->{"list_name"}) && !defined($args->{"list_name"});
#        return [400, "Missing required value for argument: pattern"] if exists($args->{"pattern"}) && !defined($args->{"pattern"});
#        return [400, "Missing required value for argument: pgroup"] if exists($args->{"pgroup"}) && !defined($args->{"pgroup"});
#        return [400, "Missing required value for argument: session"] if exists($args->{"session"}) && !defined($args->{"session"});
#        return [400, "Missing required value for argument: terminal"] if exists($args->{"terminal"}) && !defined($args->{"terminal"});
#        return [400, "Missing required value for argument: uid"] if exists($args->{"uid"}) && !defined($args->{"uid"});
#        _pci_err([500, "Extraneous command-line argument(s): ".join(", ", @check_argv)]) if @check_argv;
#        [200];
#    } else { _pci_err([500, "Unknown subcommand1: $sc_name"]); }
#}
#1;
### Local/_pci_clean_json.pm ###
#sub _pci_clean_json { require Scalar::Util; require Clone::PP;  use feature 'state'; state $cleanser = sub {
#my $data = shift;
#state %refs;
#state $ctr_circ;
#state $process_array;
#state $process_hash;
#if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { my $ref=ref($e);
#    if ($ref && $refs{ $e }++) { if (++$ctr_circ <= 1) { $e = Clone::PP::clone($e); redo } else { $e = 'CIRCULAR'; $ref = '' } }
#    elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $e = $e ? 1:0; $ref = '' }
#    elsif ($ref eq 'DateTime') { $e = $e->epoch; $ref = ref($e) }
#    elsif ($ref eq 'JSON::PP::Boolean') { $e = $e ? 1:0; $ref = '' }
#    elsif ($ref eq 'JSON::XS::Boolean') { $e = $e ? 1:0; $ref = '' }
#    elsif ($ref eq 'Math::BigInt') { $e = $e->bstr; $ref = ref($e) }
#    elsif ($ref eq 'Regexp') { $e = "$e"; $ref = "" }
#    elsif ($ref eq 'SCALAR') { $e = ${ $e }; $ref = ref($e) }
#    elsif ($ref eq 'Time::Moment') { $e = $e->epoch; $ref = ref($e) }
#    elsif ($ref eq 'version') { $e = "$e"; $ref = "" }
#    elsif (Scalar::Util::blessed($e)) { my $reftype = Scalar::Util::reftype($e); $e = $reftype eq "HASH" ? {%{ $e }} : $reftype eq "ARRAY" ? [@{ $e }] : $reftype eq "SCALAR" ? \(my $copy = ${ $e }) : $reftype eq "CODE" ? sub { goto &{ $e } } :(die "Cannot unbless object with type $ref") }
#    my $reftype=Scalar::Util::reftype($e)//"";
#    if ($reftype eq "ARRAY") { $process_array->($e) }
#    elsif ($reftype eq "HASH") { $process_hash->($e) }
#    elsif ($ref) { $e = $ref; $ref = "" }
#} } }
#if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { my $ref=ref($h->{$k});
#    if ($ref && $refs{ $h->{$k} }++) { if (++$ctr_circ <= 1) { $h->{$k} = Clone::PP::clone($h->{$k}); redo } else { $h->{$k} = 'CIRCULAR'; $ref = '' } }
#    elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
#    elsif ($ref eq 'DateTime') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'JSON::PP::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
#    elsif ($ref eq 'JSON::XS::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
#    elsif ($ref eq 'Math::BigInt') { $h->{$k} = $h->{$k}->bstr; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'Regexp') { $h->{$k} = "$h->{$k}"; $ref = "" }
#    elsif ($ref eq 'SCALAR') { $h->{$k} = ${ $h->{$k} }; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'Time::Moment') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
#    elsif ($ref eq 'version') { $h->{$k} = "$h->{$k}"; $ref = "" }
#    elsif (Scalar::Util::blessed($h->{$k})) { my $reftype = Scalar::Util::reftype($h->{$k}); $h->{$k} = $reftype eq "HASH" ? {%{ $h->{$k} }} : $reftype eq "ARRAY" ? [@{ $h->{$k} }] : $reftype eq "SCALAR" ? \(my $copy = ${ $h->{$k} }) : $reftype eq "CODE" ? sub { goto &{ $h->{$k} } } :(die "Cannot unbless object with type $ref") }
#    my $reftype=Scalar::Util::reftype($h->{$k})//"";
#    if ($reftype eq "ARRAY") { $process_array->($h->{$k}) }
#    elsif ($reftype eq "HASH") { $process_hash->($h->{$k}) }
#    elsif ($ref) { $h->{$k} = $ref; $ref = "" }
#} } }
#%refs = (); $ctr_circ=0;
#for ($data) { my $ref=ref($_);
#    if ($ref && $refs{ $_ }++) { if (++$ctr_circ <= 1) { $_ = Clone::PP::clone($_); redo } else { $_ = 'CIRCULAR'; $ref = '' } }
#    elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $_ = $_ ? 1:0; $ref = '' }
#    elsif ($ref eq 'DateTime') { $_ = $_->epoch; $ref = ref($_) }
#    elsif ($ref eq 'JSON::PP::Boolean') { $_ = $_ ? 1:0; $ref = '' }
#    elsif ($ref eq 'JSON::XS::Boolean') { $_ = $_ ? 1:0; $ref = '' }
#    elsif ($ref eq 'Math::BigInt') { $_ = $_->bstr; $ref = ref($_) }
#    elsif ($ref eq 'Regexp') { $_ = "$_"; $ref = "" }
#    elsif ($ref eq 'SCALAR') { $_ = ${ $_ }; $ref = ref($_) }
#    elsif ($ref eq 'Time::Moment') { $_ = $_->epoch; $ref = ref($_) }
#    elsif ($ref eq 'version') { $_ = "$_"; $ref = "" }
#    elsif (Scalar::Util::blessed($_)) { my $reftype = Scalar::Util::reftype($_); $_ = $reftype eq "HASH" ? {%{ $_ }} : $reftype eq "ARRAY" ? [@{ $_ }] : $reftype eq "SCALAR" ? \(my $copy = ${ $_ }) : $reftype eq "CODE" ? sub { goto &{ $_ } } :(die "Cannot unbless object with type $ref") }
#    my $reftype=Scalar::Util::reftype($_)//"";
#    if ($reftype eq "ARRAY") { $process_array->($_) }
#    elsif ($reftype eq "HASH") { $process_hash->($_) }
#    elsif ($ref) { $_ = $ref; $ref = "" }
#}
#$data
#}
#;; $cleanser->(shift) }
#1;
### 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