App-ppgrep
view release on metacpan or search on metacpan
script/ppgrep view on Meta::CPAN
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 t...
'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]);
},
script/ppgrep view on Meta::CPAN
# } # 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 "...
# 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 "...
# 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 "...
# 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;
( run in 0.588 second using v1.01-cache-2.11-cpan-7fcb06a456a )