App-PickRandomLines
view release on metacpan or search on metacpan
script/pick-random-lines view on Meta::CPAN
$data_linepos++;
last if $pos >= $data_pos;
}
seek DATA, $data_pos, 0;
\%toc;
};
if ($toc->{$_[1]}) {
warn "[datapacker] $_[1] FOUND in packed modules\n" if $debug;
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;
} else {
warn "[datapacker] $_[1] NOT found in packed modules\n" if $debug;
}
return;
}; # handler
unshift @INC, bless(sub {"dummy"}, "main::_DataPacker");
}
# END DATAPACK CODE
package main;
use 5.010001;
use strict;
#use warnings;
# load modules
### declare global variables
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-20'; # DATE
our $DIST = 'App-PickRandomLines'; # DIST
our $VERSION = '0.021'; # VERSION
my $_pci_metas = {""=>{args=>{algorithm=>{default=>"scan",description=>"\n`scan` is the algorithm described in the `perlfaq` manual (`perldoc -q \"random\nline\"). This algorithm scans the whole input once and picks one or more lines\nrandomly from i...
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 "pick-random-lines - Pick one or more random lines from input\n\nUsage:\n pick-random-lines --help (or -h, -?)\n pick-random-lines --version (or -v)\n pick-random-lines [--algorithm=str] [(--config-path=path)+|--no-co...
'json' => sub { $_pci_r->{format} = (-t STDOUT) ? "json-pretty" : "json"; ## no critic InputOutput::ProhibitInteractiveTest
},
'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 App::PickRandomLines; print "pick-random-lines version ", "0.021", ($App::PickRandomLines::DATE ? " ($App::PickRandomLines::DATE)" : ''), "\n"; print " Generated by Perinci::CmdLine::Inline versio...
};
my $go_spec2 = {
'algorithm=s' => sub { $_pci_args{'algorithm'} = $_[1];
},
'config-path=s@' => sub { },
'config-profile=s' => sub { },
'file=s@' => sub { if ($mentioned_args{'files'}++) { push @{ $_pci_args{'files'} }, $_[1] } else { $_pci_args{'files'} = [$_[1]] }
},
'files-json=s' => sub { $_pci_args{'files'} = _pci_json()->decode($_[1]);
},
'format=s' => sub { },
'help|h|?' => sub { },
'json' => sub { },
'n=s' => sub { $_pci_args{'num_lines'} = $_[1];
},
'naked-res' => sub { },
'no-config' => sub { },
'no-env' => sub { },
'no-naked-res|nonaked-res' => sub { },
'num-lines=s' => sub { $_pci_args{'num_lines'} = $_[1];
},
'page-result:s' => sub { },
'version|v' => sub { },
};
my $old_conf = Getopt::Long::EvenLess::Configure("pass_through");
Getopt::Long::EvenLess::GetOptions(%$go_spec1);
Getopt::Long::EvenLess::Configure($old_conf);
{
last unless $_pci_r->{read_env};
my $env = $ENV{"PICK_RANDOM_LINES_OPT"};
last unless defined $env;
require Complete::Bash;
my ($words, undef) = @{ Complete::Bash::parse_cmdline($env, 0) };
unshift @ARGV, @$words;
}
script/pick-random-lines view on Meta::CPAN
#}
#
#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; ## no critic: Subroutines::ProhibitExplicitReturnUndef
# } 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; ## no critic: Subroutines::ProhibitExplicitReturnUndef
# }
#
#}
#
#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'; ## no critic: TestingAndDebugging::ProhibitNoStrict
# 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};
script/pick-random-lines view on Meta::CPAN
#
# ([push(@{$_sahv_dpath}, undef), scalar(# clause: of
# ((!defined(List::Util::first(sub {!(
# ($_sahv_dpath->[-1] = $_),
# # req #1
# ((defined($args->{"files"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#
# &&
#
# # prefilters: Path::expand_tilde_when_on_unix, Path::strip_slashes_when_on_unix
# (($args->{"files"}->[$_] = do { my $tmp = $args->{"files"}->[$_]; if ($^O =~ qr/(?^:\A(?:aix|android|bsdos|bitrig|dgux|dynixptx|cygwin|darwin|dragonfly|freebsd|gnu|gnukfreebsd|hpux|interix|iphoneos|irix|linux|machten|midnight...
#
# &&
#
# # check type 'str'
# ((!ref($args->{"files"}->[$_])) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Not of type text"),0))
#
# &&
#
# (# clause: min_len
# ((length($args->{"files"}->[$_]) >= 1) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Length must be at least 1"),0)))
# )}, 0..@{$args->{"files"}}-1))) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Does not satisfy the following schema: each array element must be: (text, length must be at least 1...
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
# $args->{"num_lines"} //= 1;
# if (exists $args->{"num_lines"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"num_lines"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'int'
# ((Scalar::Util::Numeric::PP::isint($args->{"num_lines"})) ? 1 : (($_sahv_err //= "Not of type integer"),0))
#
# &&
#
# (# clause: min
# (($args->{"num_lines"} >= 1) ? 1 : (($_sahv_err //= "Must be at least 1"),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: algorithm"] if exists($args->{"algorithm"}) && !defined($args->{"algorithm"});
# return [400, "Missing required value for argument: files"] if exists($args->{"files"}) && !defined($args->{"files"});
# return [400, "Missing required value for argument: num_lines"] if exists($args->{"num_lines"}) && !defined($args->{"num_lines"});
# _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 "...
# 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;
### Log/ger.pm ###
### no critic: TestingAndDebugging::RequireUseStrict
#package Log::ger;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-10-29'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.041'; # 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
script/pick-random-lines view on Meta::CPAN
#Most of the time, you don't need to build the distribution yourself. You can
#simply modify the code, then test via:
#
# % prove -l
#
#If you want to build the distribution (e.g. to try to install it locally on your
#system), you can install L<Dist::Zilla>,
#L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
#Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
#beyond that are considered a bug and can be reported to me.
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2022, 2020, 2019, 2018, 2017 by perlancar <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.
#
#=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.
#
#=cut
### Perinci/Result/Format/Lite.pm ###
### no critic: Subroutines::ProhibitSubroutinePrototypes
#package Perinci::Result::Format::Lite;
#
#use 5.010001;
#use strict;
##IFUNBUILT
## use warnings;
##END IFUNBUILT
#
#use Exporter qw(import);
#use List::Util qw(first max);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2023-07-29'; # DATE
#our $DIST = 'Perinci-Result-Format-Lite'; # DIST
#our $VERSION = '0.288'; # VERSION
#
#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;
( run in 1.104 second using v1.01-cache-2.11-cpan-39bf76dae61 )