App-PickRandomLines
view release on metacpan or search on metacpan
script/pick-random-lines view on Meta::CPAN
#L<Clone::Any> - use whichever of the cloning methods is available.
#
#=head1 REPOSITORY
#
#L<https://github.com/neilbowers/Clone-PP>
#
#=head1 AUTHOR AND CREDITS
#
#Developed by Matthew Simon Cavalletto at Evolution Softworks.
#More free Perl software is available at C<www.evoscript.org>.
#
#
#=head1 COPYRIGHT AND LICENSE
#
#Copyright 2003 Matthew Simon Cavalletto. You may contact the author
#directly at C<evo@cpan.org> or C<simonm@cavalletto.org>.
#
#Code initially derived from Ref.pm. Portions Copyright 1994 David Muir Sharnoff.
#
#Interface based by Clone by Ray Finch with contributions from chocolateboy.
#Portions Copyright 2001 Ray Finch. Portions Copyright 2001 chocolateboy.
#
#You may use, modify, and distribute this software under the same terms as Perl.
#
#=cut
### Complete/Bash.pm ###
#package Complete::Bash;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter 'import';
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-09-08'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.337'; # VERSION
#
#our @EXPORT_OK = qw(
# point
# parse_cmdline
# join_wordbreak_words
# format_completion
# );
#
#our %SPEC;
#
#$SPEC{':package'} = {
# v => 1.1,
# summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
# my ($user, $slash) = @_;
# my @ent;
# if (length $user) {
# @ent = getpwnam($user);
# } else {
# @ent = getpwuid($>);
# $user = $ent[0];
# }
# return $ent[7] . $slash if @ent;
# "~$user$slash"; # return as-is when failed
#}
#
#sub _add_unquoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word, $after_ws) = @_;
#
# #say "D:add_unquoted word=$word is_cur_word=$is_cur_word after_ws=$after_ws";
#
# $word =~ s!^(~)(\w*)(/|\z) | # 1) tilde 2) username 3) optional slash
# \\(.) | # 4) escaped char
# \$(\w+) # 5) variable name
# !
# $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
# $4 ? $4 :
# ($is_cur_word ? "\$$5" : $ENV{$5})
# !egx;
# $word;
#}
#
#sub _add_double_quoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word) = @_;
#
# $word =~ s!\\(.) | # 1) escaped char
# \$(\w+) # 2) variable name
# !
# $1 ? $1 :
# ($is_cur_word ? "\$$2" : $ENV{$2})
# !egx;
# $word;
#}
#
#sub _add_single_quoted {
# my $word = shift;
# $word =~ s/\\(.)/$1/g;
# $word;
#}
#
#$SPEC{point} = {
# v => 1.1,
# summary => 'Return line with point marked by a marker',
# description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
# point("^foo") # => ("foo", 0)
# point("fo^o") # => ("foo", 2)
#
#_
script/pick-random-lines view on Meta::CPAN
# \z/x or return ("Invalid syntax in braced hash value");
# my $res; $res = [
# '{', # COL_V_ENCODING
# '', # COL_V_WS1
# $1, # VOL_V_VALUE
# $2, # COL_V_WS2
# $3, # COL_V_COMMENT_CHAR
# $4, # COL_V_COMMENT
# ] if $needs_res;
# my $decode_res = $self->_decode_json("{$1}");
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($val =~ /\A~/ && $self->{enable_tilde}) {
#
# $val =~ /\A
# ~(.*)
# (\s*)
# (?: ([;#])(.*) )?
# \z/x or return ("Invalid syntax in path value");
# my $res; $res = [
# '~', # COL_V_ENCODING
# '', # COL_V_WS1
# $1, # VOL_V_VALUE
# $2, # COL_V_WS2
# $3, # COL_V_COMMENT_CHAR
# $4, # COL_V_COMMENT
# ] if $needs_res;
#
# my $decode_res = $self->_decode_path_or_paths($val, 'path');
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } else {
#
# $val =~ /\A
# (.*?)
# (\s*)
# (?: ([#;])(.*) )?
# \z/x or return ("Invalid syntax in value"); # shouldn't happen, regex should match any string
# my $res; $res = [
# '', # COL_V_ENCODING
# '', # COL_V_WS1
# $1, # VOL_V_VALUE
# $2, # COL_V_WS2
# $3, # COL_V_COMMENT_CHAR
# $4, # COL_V_COMMENT
# ] if $needs_res;
# return (undef, $res, $1);
#
# }
# # should not be reached
#}
#
#sub _get_my_user_name {
# if ($^O eq 'MSWin32') {
# return $ENV{USERNAME};
# } else {
# return $ENV{USER} if $ENV{USER};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[0] if @pw;
# }
#}
#
## borrowed from PERLANCAR::File::HomeDir 0.04
#sub _get_my_home_dir {
# if ($^O eq 'MSWin32') {
# # File::HomeDir always uses exists($ENV{x}) first, does it want to avoid
# # accidentally creating env vars?
# return $ENV{HOME} if $ENV{HOME};
# return $ENV{USERPROFILE} if $ENV{USERPROFILE};
# return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
# if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
# } else {
# return $ENV{HOME} if $ENV{HOME};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[7] if @pw;
# }
#
# die "Can't get home directory";
#}
#
## borrowed from PERLANCAR::File::HomeDir 0.05, with some modifications
#sub _get_user_home_dir {
# my ($name) = @_;
#
# if ($^O eq 'MSWin32') {
# # not yet implemented
# return undef; ## 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)];
#}
script/pick-random-lines view on Meta::CPAN
#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->{"files"}) { return [400, "You specified --file but also argument #0"]; } else { $args->{"files"} = [splice(@ARGV, 0)]; } }
# }
# my @check_argv = @ARGV;
# # fill from cmdline_src
#
# # fill defaults from "default" property and check against schema
# no warnings ('void');
# require List::Util;
# require Scalar::Util::Numeric::PP;
# my $_sahv_dpath;
# my $_sahv_err;
# $args->{"algorithm"} //= "scan";
# if (exists $args->{"algorithm"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"algorithm"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'str'
# ((!ref($args->{"algorithm"})) ? 1 : (($_sahv_err //= "Not of type text"),0))
#
# &&
#
# (# clause: in
# ((grep { $_ eq $args->{"algorithm"} } @{ ["scan","seek"] }) ? 1 : (($_sahv_err //= "Must be one of [\"scan\",\"seek\"]"),0)))
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
# if (exists $args->{"files"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"files"})) ? 1 : (($_sahv_err //= (@$_sahv_dpath ? '@'.join("",map {"[$_]"} @$_sahv_dpath).": " : "") . "Required but not specified"),0))
#
# &&
#
# # check type 'array'
# ((ref($args->{"files"}) 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->{"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)//"";
script/pick-random-lines view on Meta::CPAN
#
#For more documentation, start with L<Log::ger::Manual>.
#
#=for Pod::Coverage ^(.+)$
#
#=head1 SEE ALSO
#
#Some other popular logging frameworks: L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, L<Log::Dispatch>, L<Log::Dispatchouli>.
#
#If you still prefer debugging using the good old C<print()>, there's
#L<Debug::Print>.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2023, 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.
#
#=cut
### Perinci/CmdLine/Util/Config.pm ###
#package Perinci::CmdLine::Util::Config;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter qw(import);
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-05-02'; # DATE
#our $DIST = 'Perinci-CmdLine-Util-Config'; # DIST
#our $VERSION = '1.726'; # VERSION
#
#our @EXPORT_OK = (
# 'get_default_config_dirs',
# 'read_config',
# 'get_args_from_config',
#);
#
#our %SPEC;
#
## from PERLANCAR::File::HomeDir 0.03, with minor modification
#sub _get_my_home_dir {
# if ($^O eq 'MSWin32') {
# # File::HomeDir always uses exists($ENV{x}) first, does it want to avoid
# # accidentally creating env vars?
# return $ENV{HOME} if $ENV{HOME};
# return $ENV{USERPROFILE} if $ENV{USERPROFILE};
# return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
# if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
# } else {
# return $ENV{HOME} if $ENV{HOME};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[7] if @pw;
# }
# die "Can't get home directory";
#}
#
#$SPEC{get_default_config_dirs} = {
# v => 1.1,
# args => {},
#};
#sub get_default_config_dirs {
# my @dirs;
# #local $PERLANCAR::File::HomeDir::DIE_ON_FAILURE = 1;
# my $home = _get_my_home_dir();
# if ($^O eq 'MSWin32') {
# push @dirs, $home;
# } else {
# push @dirs, "$home/.config", $home, "/etc";
# }
# \@dirs;
#}
#
#$SPEC{read_config} = {
# v => 1.1,
# args => {
# config_paths => {},
# config_filename => {},
# config_dirs => {},
# program_name => {},
# # TODO: hook_file
# hook_section => {},
# # TODO: hook_param?
# },
#};
#sub read_config {
# require Config::IOD::Reader;
#
# my %args = @_;
#
# my $config_dirs = $args{config_dirs} // get_default_config_dirs();
#
# my $paths;
#
# my @filenames;
# my %section_config_filename_map;
# if (my $names = $args{config_filename}) {
# for my $name (ref($names) eq 'ARRAY' ? @$names : ($names)) {
# if (ref($name) eq 'HASH') {
# $section_config_filename_map{$name->{filename}} = $name->{section};
# push @filenames, $name->{filename};
# } else {
# $section_config_filename_map{$name} = 'GLOBAL';
# push @filenames, $name;
# }
# }
# }
# unless (@filenames) {
# @filenames = (($args{program_name} // "prog") . ".conf");
# }
#
# if ($args{config_paths}) {
( run in 0.694 second using v1.01-cache-2.11-cpan-39bf76dae61 )