Acme-ID-CompanyName
view release on metacpan or search on metacpan
script/gen-generic-ind-company-names view on Meta::CPAN
### check arguments
{
require Local::_pci_check_args; my $res = _pci_check_args(\%_pci_args);
_pci_err($res) if $res->[0] != 200;
$_pci_r->{args} = \%_pci_args;
}
### call function
{
my $sc_name = $_pci_r->{subcommand_name};
if ($sc_name eq "") {
$_pci_meta_result_type = "";
require Acme::ID::CompanyName;
eval { $_pci_r->{res} = Acme::ID::CompanyName::gen_generic_ind_company_names(%_pci_args) };
if ($@) { die if $ENV{PERINCI_CMDLINE_INLINE_DEBUG_DIE}; $_pci_r->{res} = [500, "Function died: $@"] }
$_pci_r->{res} = [200, "OK (envelope added by Perinci::CmdLine::Inline)", $_pci_r->{res}];
}
}
### format & display result
{
my $fh;
if ($_pci_r->{page_result} // $ENV{PAGE_RESULT} // $_pci_r->{res}[3]{"cmdline.page_result"}) {
my $pager = $_pci_r->{pager} // $_pci_r->{res}[3]{"cmdline.pager"} // $ENV{PAGER} // "less -FRSX";
open $fh, "| $pager";
} else {
$fh = \*STDOUT;
}
my $fres;
my $save_res; if (exists $_pci_r->{res}[3]{"cmdline.result"}) { $save_res = $_pci_r->{res}[2]; $_pci_r->{res}[2] = $_pci_r->{res}[3]{"cmdline.result"} }
my $is_success = $_pci_r->{res}[0] =~ /\A2/ || $_pci_r->{res}[0] == 304;
my $is_stream = $_pci_r->{res}[3]{stream} // $_pci_meta_result_stream // 0;
if ($is_success && (0 || $_pci_meta_skip_format || $_pci_r->{res}[3]{"cmdline.skip_format"})) { $fres = $_pci_r->{res}[2] }
elsif ($is_success && $is_stream) {}
else { require Local::_pci_clean_json; require Perinci::Result::Format::Lite; $is_stream=0; _pci_clean_json($_pci_r->{res}); $fres = Perinci::Result::Format::Lite::format($_pci_r->{res}, ($_pci_r->{format} // $_pci_r->{res}[3]{"cmdline.default_format...
my $use_utf8 = $_pci_r->{res}[3]{"x.hint.result_binary"} ? 0 : 0;
if ($use_utf8) { binmode STDOUT, ":encoding(utf8)" }
if ($is_stream) {
my $code = $_pci_r->{res}[2]; if (ref($code) ne "CODE") { die "Result is a stream but no coderef provided" } if ($_pci_meta_result_type_is_simple) { while(defined(my $l=$code->())) { print $fh $l; print $fh "\n" unless $_pci_meta_result_type eq "...
} else {
print $fh $fres;
}
if (defined $save_res) { $_pci_r->{res}[2] = $save_res }
}
### exit
{
my $status = $_pci_r->{res}[0];
my $exit_code = $_pci_r->{res}[3]{"cmdline.exit_code"} // ($status =~ /200|304/ ? 0 : ($status-300));
exit($exit_code);
}
=pod
=encoding UTF-8
=head1 NAME
gen-generic-ind-company-names - Generate nice-sounding, generic Indonesian company names
=head1 VERSION
This document describes version 0.007 of main (from Perl distribution Acme-ID-CompanyName), released on 2021-05-07.
=head1 SYNOPSIS
Usage:
% gen-generic-ind-company-names [--add-prefixes] [--add-suffixes]
[--config-path=path+] [--config-profile=profile]
[--desired-initials=s] [--format=name] [--json] [--(no)naked-res]
[--no-add-prefixes] [--no-add-suffixes] [--no-config] [--no-env]
[--noadd-prefixes] [--noadd-suffixes] [--num-words=s]
[--page-result[=program]] [-t=s] [--type=s] [--view-result[=program]]
[-w=s] [num_names]
Examples:
Generate five random PT names:
% gen-generic-ind-company-names 5
PT Mekar Simfoni Sempurna
PT Elektro Kreasi Delapan
PT Sarindo Vito Forsa
PT Humania Delapan Jenggala
PT Kala Karya Sentral
Generate three PT names with desired initials "ACME":
% gen-generic-ind-company-names -n3 --desired-initials ACME
PT Aksa Central Mandala Elegan
PT Agung Cipta Milenial Esatama
PT Aksa Cakrawala Mandiri Elektro
=head1 OPTIONS
C<*> marks required options.
=head2 Main options
=over
=item B<--desired-initials>=I<s>
=item B<--no-add-prefixes>
=item B<--no-add-suffixes>
=item B<--num-names>=I<s>, B<-n>
Default value:
1
Can also be specified as the 1st command-line argument.
script/gen-generic-ind-company-names view on Meta::CPAN
# for (@res) {
# $_ .= " " x ($column_width - length) if $column_width > length;
# }
# }
#
# PASS_TO_FZF: {
# last unless $ENV{COMPLETE_BASH_FZF};
# my $items = $ENV{COMPLETE_BASH_FZF_ITEMS} // 100;
# last unless @words >= $items;
#
# require File::Which;
# unless (File::Which::which("fzf")) {
# #@res = $code_return_message->("Cannot find fzf to filter ".
# # scalar(@words)." items");
# goto RETURN_RES;
# }
#
# require IPC::Open2;
# local *CHLD_OUT;
# local *CHLD_IN;
# my $pid = IPC::Open2::open2(
# \*CHLD_OUT, \*CHLD_IN, "fzf", "-m", "-d:", "--with-nth=2..")
# or do {
# @res = $code_return_message->("Cannot open fzf to filter ".
# scalar(@words)." items");
# goto RETURN_RES;
# };
#
# print CHLD_IN map { "$_:$res[$_]\n" } 0..$#res;
# close CHLD_IN;
#
# my @res_words;
# while (<CHLD_OUT>) {
# my ($index) = /\A([0-9]+)\:/ or next;
# push @res_words, $words[$index];
# }
# if (@res_words) {
# @res = join(" ", @res_words);
# } else {
# @res = ();
# }
# waitpid($pid, 0);
# }
#
# RETURN_RES:
# #use Data::Dump; warn Data::Dump::dump(\@res);
# if ($as eq 'array') {
# return \@res;
# } else {
# return join("", map {($_, "\n")} @res);
# }
#}
#
#1;
## ABSTRACT: Completion routines for bash shell
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Complete::Bash - Completion routines for bash shell
#
#=head1 VERSION
#
#This document describes version 0.335 of Complete::Bash (from Perl distribution Complete-Bash), released on 2020-04-16.
#
#=head1 DESCRIPTION
#
#This module provides routines related to tab completion in bash shell.
#
#=head2 About programmable completion in bash
#
#Bash allows completion to come from various sources. The simplest is from a list
#of words (C<-W>):
#
# % complete -W "one two three four" somecmd
# % somecmd t<Tab>
# two three
#
#Another source is from a bash function (C<-F>). The function will receive input
#in two variables: C<COMP_WORDS> (array, command-line chopped into words) and
#C<COMP_CWORD> (integer, index to the array of words indicating the cursor
#position). It must set an array variable C<COMPREPLY> that contains the list of
#possible completion:
#
# % _foo()
# {
# local cur
# COMPREPLY=()
# cur=${COMP_WORDS[COMP_CWORD]}
# COMPREPLY=($( compgen -W '--help --verbose --version' -- $cur ) )
# }
# % complete -F _foo foo
# % foo <Tab>
# --help --verbose --version
#
#And yet another source is an external command (C<-C>) including, from a Perl
#script. The command receives two environment variables: C<COMP_LINE> (string,
#raw command-line) and C<COMP_POINT> (integer, cursor location). Program must
#split C<COMP_LINE> into words, find the word to be completed, complete that, and
#return the list of words one per-line to STDOUT. An example:
#
# % cat foo-complete
# #!/usr/bin/perl
# use Complete::Bash qw(parse_cmdline format_completion);
# use Complete::Util qw(complete_array_elem);
# my ($words, $cword) = @{ parse_cmdline() };
# my $res = complete_array_elem(array=>[qw/--help --verbose --version/], word=>$words->[$cword]);
# print format_completion($res);
#
# % complete -C foo-complete foo
# % foo --v<Tab>
# --verbose --version
#
#=head2 About the routines in this module
#
#First of all, C<parse_cmdline()> is the function to parse raw command-line (such
script/gen-generic-ind-company-names view on Meta::CPAN
#sub _pop_include_stack {
# my $self = shift;
#
# die "BUG: Overpopped _pop_include_stack"
# unless @{$self->{_include_stack}};
# pop @{ $self->{_include_stack} };
#}
#
#sub _init_read {
# my $self = shift;
#
# $self->{_include_stack} = [];
#
# # set expr variables
# {
# last unless $self->{enable_expr};
# no strict 'refs';
# my $pkg = \%{"Config::IOD::Expr::_Compiled::"};
# undef ${"Config::IOD::Expr::_Compiled::$_"} for keys %$pkg;
# my $vars = $self->{expr_vars};
# ${"Config::IOD::Expr::_Compiled::$_"} = $vars->{$_} for keys %$vars;
# }
#}
#
#sub _read_file {
# my ($self, $filename) = @_;
# open my $fh, "<", $filename
# or die "Can't open file '$filename': $!";
# binmode($fh, ":encoding(utf8)");
# local $/;
# my $res = scalar <$fh>;
# close $fh;
# $res;
#}
#
#sub read_file {
# my $self = shift;
# my $filename = shift;
# $self->_init_read;
# my $res = $self->_push_include_stack($filename);
# die "Can't read '$filename': $res->[1]" unless $res->[0] == 200;
# $res =
# $self->_read_string($self->_read_file($filename), @_);
# $self->_pop_include_stack;
# $res;
#}
#
#sub read_string {
# my $self = shift;
# $self->_init_read;
# $self->_read_string(@_);
#}
#
#1;
## ABSTRACT: Base class for Config::IOD and Config::IOD::Reader
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Config::IOD::Base - Base class for Config::IOD and Config::IOD::Reader
#
#=head1 VERSION
#
#This document describes version 0.342 of Config::IOD::Base (from Perl distribution Config-IOD-Reader), released on 2019-01-17.
#
#=head1 EXPRESSION
#
#=for BEGIN_BLOCK: expression
#
#Expression allows you to do things like:
#
# [section1]
# foo=1
# bar="monkey"
#
# [section2]
# baz =!e 1+1
# qux =!e "grease" . val("section1.bar")
# quux=!e val("qux") . " " . val('baz')
#
#And the result will be:
#
# {
# section1 => {foo=>1, bar=>"monkey"},
# section2 => {baz=>2, qux=>"greasemonkey", quux=>"greasemonkey 2"},
# }
#
#For safety, you'll need to set C<enable_expr> attribute to 1 first to enable
#this feature.
#
#The syntax of the expression (the C<expr> encoding) is not officially specified
#yet in the L<IOD> specification. It will probably be Expr (see
#L<Language::Expr::Manual::Syntax>). At the moment, this module implements a very
#limited subset that is compatible (lowest common denominator) with Perl syntax
#and uses C<eval()> to evaluate the expression. However, only the limited subset
#is allowed (checked by Perl 5.10 regular expression).
#
#The supported terms:
#
# number
# string (double-quoted and single-quoted)
# undef literal
# simple variable ($abc, no namespace, no array/hash sigil, no special variables)
# function call (only the 'val' function is supported)
# grouping (parenthesis)
#
#The supported operators are:
#
# + - .
# * / % x
# **
# unary -, unary +, !, ~
#
#The C<val()> function refers to the configuration key. If the argument contains
#".", it will be assumed as C<SECTIONNAME.KEYNAME>, otherwise it will access the
#current section's key. Since parsing is done in a single pass, you can only
script/gen-generic-ind-company-names view on Meta::CPAN
# if ($line =~ /^\s*([^=]+?)\s*=\s*(.*)/) {
# my $key = $1;
# my $val = $2;
#
# # the common case is that value are not decoded or
# # quoted/bracketed/braced, so we avoid calling _parse_raw_value here
# # to avoid overhead
# if ($val =~ /\A["!\\[\{~]/) {
# $_raw_val = $val if $cb;
# my ($err, $parse_res, $decoded_val) = $self->_parse_raw_value($val);
# $self->_err("Invalid value: " . $err) if $err;
# $val = $decoded_val;
# } else {
# $_raw_val = $val if $cb;
# $val =~ s/\s*[#;].*//; # strip comment
# }
#
# if (exists $res->{$cur_section}{$key}) {
# if (!$self->{allow_duplicate_key}) {
# $self->_err("Duplicate key: $key (section $cur_section)");
# } elsif ($self->{_arrayified}{$cur_section}{$key}++) {
# push @{ $res->{$cur_section}{$key} }, $val;
# } else {
# $res->{$cur_section}{$key} = [
# $res->{$cur_section}{$key}, $val];
# }
# } else {
# $res->{$cur_section}{$key} = $val;
# }
#
# if ($cb) {
# $cb->(
# event => 'key',
# linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
# key => $key,
# val => $val,
# raw_val => $_raw_val,
# );
# }
#
# next LINE;
# }
#
# $self->_err("Invalid syntax");
# }
#
# if ($self->{_merge} && $self->{_num_seen_section_lines} > 1) {
# $self->_merge($cur_section);
# }
#
# $res;
#}
#
#1;
## ABSTRACT: Read IOD/INI configuration files
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Config::IOD::Reader - Read IOD/INI configuration files
#
#=head1 VERSION
#
#This document describes version 0.342 of Config::IOD::Reader (from Perl distribution Config-IOD-Reader), released on 2019-01-17.
#
#=head1 SYNOPSIS
#
# use Config::IOD::Reader;
# my $reader = Config::IOD::Reader->new(
# # list of known attributes, with their default values
# # default_section => 'GLOBAL',
# # enable_directive => 1,
# # enable_encoding => 1,
# # enable_quoting => 1,
# # enable_backet => 1,
# # enable_brace => 1,
# # allow_encodings => undef, # or ['base64','json',...]
# # disallow_encodings => undef, # or ['base64','json',...]
# # allow_directives => undef, # or ['include','merge',...]
# # disallow_directives => undef, # or ['include','merge',...]
# # allow_bang_only => 1,
# # enable_expr => 0,
# # allow_duplicate_key => 1,
# # ignore_unknown_directive => 0,
# );
# my $config_hash = $reader->read_file('config.iod');
#
#=head1 DESCRIPTION
#
#This module reads L<IOD> configuration files (IOD is an INI-like format with
#more precise specification, some extra features, and 99% compatible with typical
#INI format). It is a minimalist alternative to the more fully-featured
#L<Config::IOD>. It cannot write IOD files and is optimized for low startup
#overhead.
#
#=head1 EXPRESSION
#
#Expression allows you to do things like:
#
# [section1]
# foo=1
# bar="monkey"
#
# [section2]
# baz =!e 1+1
# qux =!e "grease" . val("section1.bar")
# quux=!e val("qux") . " " . val('baz')
#
#And the result will be:
#
# {
# section1 => {foo=>1, bar=>"monkey"},
# section2 => {baz=>2, qux=>"greasemonkey", quux=>"greasemonkey 2"},
# }
#
#For safety, you'll need to set C<enable_expr> attribute to 1 first to enable
script/gen-generic-ind-company-names view on Meta::CPAN
# my $ref = ref($data->{$k});
# do { $errstr = "not hoa: value for key '$k' not array ($ref)"; return 0 } unless $ref eq 'ARRAY';
# }
# $errstr = '';
# 1;
#}
#
#sub is_hoaos {
# my ($data, $opts) = @_;
# $opts ||= {};
# my $max = $opts->{max};
#
# return 0 unless ref($data) eq 'HASH';
# my $i = 0;
# for my $k (keys %$data) {
# last if defined($max) && ++$i >= $max;
# do { $errstr = "not hoaos: value for key '$k'".($errstr ? ": $errstr" : " not aos"); return 0 } unless is_aos($data->{$k});
# }
# $errstr = '';
# 1;
#}
#
#sub is_hoh {
# my ($data, $opts) = @_;
# $opts ||= {};
# my $max = $opts->{max};
#
# return 0 unless ref($data) eq 'HASH';
# my $i = 0;
# for my $k (keys %$data) {
# last if defined($max) && ++$i >= $max;
# my $ref = ref($data->{$k});
# do { $errstr = "not hoh: value for key '$k' not hash ($ref)"; return 0 } unless $ref eq 'HASH';
# }
# $errstr = '';
# 1;
#}
#
#sub is_hohos {
# my ($data, $opts) = @_;
# $opts ||= {};
# my $max = $opts->{max};
#
# return 0 unless ref($data) eq 'HASH';
# my $i = 0;
# for my $k (keys %$data) {
# last if defined($max) && ++$i >= $max;
# do { $errstr = "not hohos: value for key '$k'".($errstr ? ": $errstr" : " not hos"); return 0 } unless is_hos($data->{$k});
# }
# $errstr = '';
# 1;
#}
#
#1;
## ABSTRACT: Check structure of data
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Check::Structure - Check structure of data
#
#=head1 VERSION
#
#This document describes version 0.050 of Data::Check::Structure (from Perl distribution Data-Check-Structure), released on 2020-11-08.
#
#=head1 SYNOPSIS
#
#=head1 DESCRIPTION
#
#This small module provides several simple routines to check the structure of
#data, e.g. whether data is an array of arrays ("aoa"), array of scalars ("aos"),
#and so on.
#
#=head1 FUNCTIONS
#
#None exported by default, but they are exportable.
#
#=head2 is_aos($data[, \%opts]) => bool
#
#Check that data is an array of scalars. Examples:
#
# is_aos([]); # true
# is_aos(['a', 'b']); # true
# is_aos(['a', []]); # false
# is_aos([1,2,3, []], {max=>3}); # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aoa($data[, \%opts]) => bool
#
#Check that data is an array of arrays. Examples:
#
# is_aoa([]); # true
# is_aoa([[1], [2]]); # true
# is_aoa([[1], 'a']); # false
# is_aoa([[1],[],[], 'a'], {max=>3}); # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aoaos($data[, \%opts]) => bool
#
#Check that data is an array of arrays of scalars. Examples:
#
# is_aoaos([]); # true
# is_aoaos([[1], [2]]); # true
# is_aoaos([[1], [{}]]); # false
# is_aoaos([[1],[],[], [{}]], {max=>3}); # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aoh($data[, \%opts]) => bool
#
#Check that data is an array of hashes. Examples:
script/gen-generic-ind-company-names view on Meta::CPAN
#
# my $has_req = $s =~ s/\*\z//;
# $s =~ $type_re or die "Invalid type syntax $s, please use ".
# "letter/digit/underscore only";
# return [$s, $has_req ? {req=>1} : {}, {}];
#
# } elsif ($ref eq 'ARRAY') {
#
# my $t = $s->[0];
# my $has_req = $t && $t =~ s/\*\z//;
# if (!defined($t)) {
# die "For array form, at least 1 element is needed for type";
# } elsif (ref $t) {
# die "For array form, first element must be a string";
# }
# $t =~ $type_re or die "Invalid type syntax $s, please use ".
# "letter/digit/underscore only";
#
# my $clset0;
# my $extras;
# if (defined($s->[1])) {
# if (ref($s->[1]) eq 'HASH') {
# $clset0 = $s->[1];
# $extras = $s->[2];
# die "For array form, there should not be more than 3 elements"
# if @$s > 3;
# } else {
# # flattened clause set [t, c=>1, c2=>2, ...]
# die "For array in the form of [t, c1=>1, ...], there must be ".
# "3 elements (or 5, 7, ...)"
# unless @$s % 2;
# $clset0 = { @{$s}[1..@$s-1] };
# }
# } else {
# $clset0 = {};
# }
#
# # check clauses and parse shortcuts (!c, c&, c|, c=)
# my $clset = normalize_clset($clset0, {has_req=>$has_req});
# if (defined $extras) {
# die "For array form with 3 elements, extras must be hash"
# unless ref($extras) eq 'HASH';
# die "'def' in extras must be a hash"
# if exists $extras->{def} && ref($extras->{def}) ne 'HASH';
# return [$t, $clset, { %{$extras} }];
# } else {
# return [$t, $clset, {}];
# }
# }
#
# die "Schema must be a string or arrayref (not $ref)";
#}
#
#1;
## ABSTRACT: Normalize Sah schema
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Data::Sah::Normalize - Normalize Sah schema
#
#=head1 VERSION
#
#This document describes version 0.050 of Data::Sah::Normalize (from Perl distribution Data-Sah-Normalize), released on 2018-09-10.
#
#=head1 SYNOPSIS
#
# use Data::Sah::Normalize qw(normalize_clset normalize_schema);
#
# my $nclset = normalize_clset({'!a'=>1}); # -> {a=>1, 'a.op'=>'not'}
# my $nsch = normalize_schema("int"); # -> ["int", {}, {}]
#
#=head1 DESCRIPTION
#
#This often-needed functionality is split from the main L<Data::Sah> to keep it
#in a small and minimal-dependencies package.
#
#=head1 FUNCTIONS
#
#=head2 normalize_clset($clset) => HASH
#
#Normalize a clause set (hash). Return a shallow copy of the original hash. Die
#on failure.
#
#TODO: option to recursively normalize clause which contains sah clauses (e.g.
#C<of>).
#
#=head2 normalize_schema($sch) => ARRAY
#
#Normalize a Sah schema (scalar or array). Return an array. Produce a 2-level
#copy of schema, so it's safe to add/delete/modify the normalized schema's clause
#set and extras (but clause set's and extras' values are still references to the
#original). Die on failure.
#
#TODO: recursively normalize clause which contains sah clauses (e.g. C<of>).
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Normalize>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Normalize>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-Normalize>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Sah>, L<Data::Sah>
#
script/gen-generic-ind-company-names view on Meta::CPAN
# 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:
#
script/gen-generic-ind-company-names view on Meta::CPAN
# [$sub0, "log_$_", $Levels{$_}, 'logger_sub'],
# [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "log_is_$_", $Levels{$_}, 'level_checker_sub'],
# [$sub0, $_, $Levels{$_}, 'logger_method'],
# [$Levels{$_} > $Current_Level ? $sub0 : $sub1, "is_$_", $Levels{$_}, 'level_checker_method'],
# )} keys %Levels),
# ];
#}
#
#sub get_logger {
# my ($package, %per_target_conf) = @_;
#
# my $caller = caller(0);
# $per_target_conf{category} = $caller
# if !defined($per_target_conf{category});
# my $obj = []; $obj =~ $re_addr;
# my $pkg = "Log::ger::Obj$1"; bless $obj, $pkg;
# add_target(object => $obj, \%per_target_conf);
# if (keys %Global_Hooks) {
# require Log::ger::Heavy;
# init_target(object => $obj, \%per_target_conf);
# } else {
# # if we haven't added any hooks etc, skip init_target() process and use
# # this preconstructed routines as shortcut, to save startup overhead
# _set_default_null_routines();
# install_routines(object => $obj, $default_null_routines, 0);
# }
# $obj; # XXX add DESTROY to remove from list of targets
#}
#
#sub _import_to {
# my ($package, $target_pkg, %per_target_conf) = @_;
#
# $per_target_conf{category} = $target_pkg
# if !defined($per_target_conf{category});
# add_target(package => $target_pkg, \%per_target_conf);
# if (keys %Global_Hooks) {
# require Log::ger::Heavy;
# init_target(package => $target_pkg, \%per_target_conf);
# } else {
# # if we haven't added any hooks etc, skip init_target() process and use
# # this preconstructed routines as shortcut, to save startup overhead
# _set_default_null_routines();
# install_routines(package => $target_pkg, $default_null_routines, 0);
# }
#}
#
#sub import {
# my ($package, %per_target_conf) = @_;
#
# my $caller = caller(0);
# $package->_import_to($caller, %per_target_conf);
#}
#
#1;
## ABSTRACT: A lightweight, flexible logging framework
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Log::ger - A lightweight, flexible logging framework
#
#=head1 VERSION
#
#version 0.038
#
#=head1 SYNOPSIS
#
#=head2 Producing logs
#
#In your module (producer):
#
# package Foo;
# use Log::ger; # will install some logger routines e.g. log_warn, log_error
#
# sub foo {
# ...
# # produce some logs. no need to configure output or level.
# log_error "an error occured: %03d - %s", $errcode, $errmsg;
# ...
# log_debug "http response: %s", $http; # automatic dumping of data
# }
# 1;
#
#=head2 Consuming logs
#
#=head3 Choosing an output
#
#In your application (consumer/listener):
#
# use Foo;
# use Log::ger::Output 'Screen'; # configure output
# # level is by default 'warn'
# foo(); # the error message is shown, but debug message is not.
#
#=head3 Choosing multiple outputs
#
#Instead of screen, you can output to multiple outputs (including multiple
#files):
#
# use Log::ger::Output 'Composite' => (
# outputs => {
# Screen => {},
# File => [
# {conf=>{path=>'/path/to/app.log'}},
# ...
# ],
# ...
# },
# );
#
#See L<Log::ger::Manual::Tutorial::481_Output_Composite> for more examples.
#
#=head3 Choosing level
#
#One way to set level:
#
script/gen-generic-ind-company-names view on Meta::CPAN
# if ($k eq '-event') { $event = $v }
# elsif ($k eq '-prio') { $prio = $v }
# else { $plugin_args->{$k} = $v }
# }
# push @$plugins, $sect_plugin .
# (defined $event || defined $prio ?
# '@'.($event // '') . (defined $prio ? "\@$prio" : "") : '');
# push @$plugins, $plugin_args;
# } else {
# my $as = $meta->{args} // {};
# for my $k (keys %{ $conf->{$section0} }) {
# my $v = $conf->{$section0}{$k};
# if ($copts->{$k} && $copts->{$k}{is_settable_via_config}) {
# my $sch = $copts->{$k}{schema};
# if ($sch) {
# require Data::Sah::Resolve;
# my $rsch = Data::Sah::Resolve::resolve_schema($sch);
# # since IOD might return a scalar or an array (depending on
# # whether there is a single param=val or multiple param=
# # lines), we need to arrayify the value if the argument is
# # expected to be an array.
# if (ref($v) ne 'ARRAY' && $rsch->[0] eq 'array') {
# $v = [$v];
# }
# }
# $copts->{$k}{handler}->(undef, $v, $r);
# } else {
# # when common option clashes with function argument name,
# # user can use NAME.arg to refer to function argument.
# $k =~ s/\.arg\z//;
#
# # since IOD might return a scalar or an array (depending on
# # whether there is a single param=val or multiple param=
# # lines), we need to arrayify the value if the argument is
# # expected to be an array.
# if (ref($v) ne 'ARRAY' && $as->{$k} && $as->{$k}{schema}) {
# require Data::Sah::Resolve;
# my $rsch = Data::Sah::Resolve::resolve_schema($as->{$k}{schema});
# if ($rsch->[0] eq 'array') {
# $v = [$v];
# }
# }
# $args->{$k} = $v;
# }
# } # for params in section
# } # if for plugin
# }
# log_trace("[pericmd] Seen config profiles: %s",
# [sort keys %seen_profiles]);
#
# [200, "OK", $args, {'func.found'=>$found}];
#}
#
#1;
## ABSTRACT: Utility routines related to config files
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::CmdLine::Util::Config - Utility routines related to config files
#
#=head1 VERSION
#
#This document describes version 1.724 of Perinci::CmdLine::Util::Config (from Perl distribution Perinci-CmdLine-Util-Config), released on 2020-10-21.
#
#=head1 FUNCTIONS
#
#
#=head2 get_args_from_config
#
#Usage:
#
# get_args_from_config(%args) -> [status, msg, payload, meta]
#
#C<config> is a HoH (hashes of hashrefs) produced by reading an INI (IOD)
#configuration file using modules like L<Config::IOD::Reader>.
#
#Hashref argument C<args> will be set by parameters in C<config>, while C<plugins>
#will be set by parameters in C<[plugin=...]> sections in C<config>. For example,
#with this configuration:
#
# arg1=val1
# arg2=val2
# -special_arg1=val3
# -special_arg2=val4
#
# [plugin=DumpArgs]
# -event=before_validation
#
# [plugin=Foo]
# arg1=val1
#
#C<args> will become:
#
# {
# arg1=>"val1",
# arg2=>"val2",
# -special_arg1=>"val3",
# -special_arg2=>"val4",
# }
#
#and C<plugins> will become:
#
# [
# 'DumpArgs@before_validation' => {},
# Foo => {arg1=>val},
# ]
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<args> => I<hash>
#
script/gen-generic-ind-company-names view on Meta::CPAN
# }
# unshift @$newdata, \@fieldnames;
# return __gen_table($newdata, 1, $res->[3], $format);
# } else {
# $format = 'json-pretty';
# }
# }
# }
#
# my $tff = $res->[3]{'table.fields'};
# $res = $res->[2] if $is_naked;
#
# if ($format eq 'perl') {
# my $use_color = $ENV{COLOR} // (-t STDOUT);
# if ($use_color && eval { require Data::Dump::Color; 1 }) {
# return Data::Dump::Color::dump($res);
# } elsif (eval { require Data::Dump; 1 }) {
# return Data::Dump::dump($res);
# } else {
# no warnings 'once';
# require Data::Dumper;
# local $Data::Dumper::Terse = 1;
# local $Data::Dumper::Indent = 1;
# local $Data::Dumper::Useqq = 1;
# local $Data::Dumper::Deparse = 1;
# local $Data::Dumper::Quotekeys = 0;
# local $Data::Dumper::Sortkeys = 1;
# local $Data::Dumper::Trailingcomma = 1;
# return Data::Dumper::Dumper($res);
# }
# }
#
# unless ($format =~ /\Ajson(-pretty)?\z/) {
# warn "Unknown format '$format', fallback to json-pretty";
# $format = 'json-pretty';
# }
# __cleanse($res) if ($cleanse//1);
# if ($format =~ /json/) {
# if ($tff && _json->can("sort_by") &&
# eval { require Sort::ByExample; 1}) {
# my $cmp = Sort::ByExample->cmp($tff);
# _json->sort_by(sub { $cmp->($JSON::PP::a, $JSON::PP::b) });
# }
#
# if ($format eq 'json') {
# return _json->encode($res) . "\n";
# } else {
# _json->pretty(1);
# return _json->encode($res);
# }
# }
#}
#
#1;
## ABSTRACT: Format enveloped result
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Result::Format::Lite - Format enveloped result
#
#=head1 VERSION
#
#This document describes version 0.279 of Perinci::Result::Format::Lite (from Perl distribution Perinci-Result-Format-Lite), released on 2021-03-08.
#
#=head1 SYNOPSIS
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(firstidx)$
#
#=head1 FUNCTIONS
#
#=head2 format($res, $format[ , $is_naked=0, $cleanse=1 ]) => str
#
#=head1 ENVIRONMENT
#
#=head2 FORMAT_PRETTY_TABLE_BACKEND => str
#
#If this is set, will render text table using L<Text::Table::Any> (with
#C<backend> set to the value of this environment variable) instead of the default
#L<Text::Table::Sprintf>. This is useful if you want to output text table in a
#different format, for example to generate Org tables (make sure
#L<Text::Table::Org> backend is already installed):
#
# % FORMAT_PRETTY_TABLE_BACKEND=Text::Table::Org lcpan rdeps Getopt::Lucid
#
#For convenience, a default is chosen for you under certain condition. When
#inside Emacs (environment C<INSIDE_EMACS> is set), C<Text::Table::Org> is used
#as default.
#
#=head2 FORMAT_PRETTY_TABLE_COLUMN_ORDERS => array (json)
#
#Set the default of C<table_column_orders> in C<format_options> in result
#metadata, similar to what's implemented in L<Perinci::Result::Format> and
#L<Data::Format::Pretty::Console>.
#
#=head2 COLOR => bool
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Result-Format-Lite>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Result-Format-Lite>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://github.com/perlancar/perl-Perinci-Result-Format-Lite/issues>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
script/gen-generic-ind-company-names view on Meta::CPAN
# push @{ $nmeta->{$nk} }, $_;
# }
# $i++;
# }
# } elsif ($prop_proplist && $prop_proplist->{_value_prop}) {
# die "Property '$prefix/$prop' must be a hash"
# unless ref($meta->{$k}) eq 'HASH';
# $nmeta->{$nk} = {};
# for (keys %{ $meta->{$k} }) {
# $nmeta->{$nk}{$_} = {};
# die "Property '$prefix/$prop/$_' must be a hash"
# unless ref($meta->{$k}{$_}) eq 'HASH';
# _normalize(
# $meta->{$k}{$_},
# $prop_proplist->{_ver},
# $opts,
# $prop_proplist->{_value_prop},
# $nmeta->{$nk}{$_},
# "$prefix/$prop/$_",
# ($prop eq 'args' ? "$prefix/arg" : undef),
# );
# }
# } else {
# if ($k eq 'schema' && $opt_nss) { # XXX currently hardcoded
# require Data::Sah::Normalize;
# $nmeta->{$nk} = Data::Sah::Normalize::normalize_schema(
# $meta->{$k});
# } else {
# $nmeta->{$nk} = $meta->{$k};
# }
# }
# }
#
# $nmeta;
#}
#
#sub normalize_function_metadata($;$) {
# my ($meta, $opts) = @_;
#
# $opts //= {};
#
# $opts->{allow_unknown_properties} //= 0;
# $opts->{normalize_sah_schemas} //= 1;
# $opts->{remove_internal_properties} //= 0;
#
# require Sah::Schema::rinci::function_meta;
# my $sch = $Sah::Schema::rinci::function_meta::schema;
# my $sch_proplist = $sch->[1]{_prop}
# or die "BUG: Rinci schema structure changed (1a)";
#
# _normalize($meta, 1.1, $opts, $sch_proplist, {}, '');
#}
#
#1;
## ABSTRACT: Normalize Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Sub::Normalize - Normalize Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 0.200 of Perinci::Sub::Normalize (from Perl distribution Perinci-Sub-Normalize), released on 2018-09-10.
#
#=head1 SYNOPSIS
#
# use Perinci::Sub::Normalize qw(normalize_function_metadata);
#
# my $nmeta = normalize_function_metadata($meta);
#
#=head1 FUNCTIONS
#
#=head2 normalize_function_metadata($meta[ , \%opts ]) => HASH
#
#Normalize and check L<Rinci> function metadata C<$meta>. Return normalized
#metadata, which is a shallow copy of C<$meta>. Die on error.
#
#Available options:
#
#=over
#
#=item * allow_unknown_properties => BOOL (default: 0)
#
#If set to true, will die if there are unknown properties.
#
#=item * normalize_sah_schemas => BOOL (default: 1)
#
#By default, L<Sah> schemas e.g. in C<result/schema> or C<args/*/schema> property
#is normalized using L<Data::Sah>'s C<normalize_schema>. Set this to 0 if you
#don't want this.
#
#=item * remove_internal_properties => BOOL (default: 0)
#
#If set to 1, all properties and attributes starting with underscore (C<_>) with
#will be stripped. According to L<DefHash> specification, they are ignored and
#usually contain notes/comments/extra information.
#
#=back
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Sub-Normalize>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-Sub-Normalize>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Sub-Normalize>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
script/gen-generic-ind-company-names view on Meta::CPAN
# status => {},
# result => {},
# naked_result => {},
# env_result => {},
# test => {},
# },
# },
# features => {
# _keys => {
# reverse => {},
# tx => {},
# dry_run => {},
# pure => {},
# immutable => {},
# idempotent => {},
# check_arg => {},
# },
# },
# deps => {
# _keys => {
# all => {},
# any => {},
# none => {},
# env => {},
# prog => {},
# pkg => {},
# func => {},
# code => {},
# tmp_dir => {},
# trash_dir => {},
# },
# },
# },
#
# examples => [
# {value=>{}, valid=>1},
# {
# value=>{v=>1.1, summary=>"Some function", args=>{a1=>{}, a2=>{}}},
# valid=>1,
# },
# # XXX we have not implemented property & attribute checking
# ],
#
#}, {}];
#
#$schema->[1]{_prop}{args}{_value_prop}{meta} = $schema->[1];
#$schema->[1]{_prop}{args}{_value_prop}{element_meta} = $schema->[1];
#
## just so the dzil plugin won't complain about schema not being normalized.
## because this is a circular structure and normalizing creates a shallow copy.
#
#$schema = Data::Sah::Normalize::normalize_schema($schema);
#
#1;
## ABSTRACT: Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schema::rinci::function_meta - Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 1.1.94.0 of Sah::Schema::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=head1 SYNOPSIS
#
#To check data against this schema (requires L<Data::Sah>):
#
# use Data::Sah qw(gen_validator);
# my $validator = gen_validator("rinci::function_meta*");
# say $validator->($data) ? "valid" : "INVALID!";
#
# # Data::Sah can also create validator that returns nice error message string
# # and/or coerced value. Data::Sah can even create validator that targets other
# # language, like JavaScript. All from the same schema. See its documentation
# # for more details.
#
#To validate function parameters against this schema (requires L<Params::Sah>):
#
# use Params::Sah qw(gen_validator);
#
# sub myfunc {
# my @args = @_;
# state $validator = gen_validator("rinci::function_meta*");
# $validator->(\@args);
# ...
# }
#
#To specify schema in L<Rinci> function metadata and use the metadata with
#L<Perinci::CmdLine> to create a CLI:
#
# # in lib/MyApp.pm
# package MyApp;
# our %SPEC;
# $SPEC{myfunc} = {
# v => 1.1,
# summary => 'Routine to do blah ...',
# args => {
# arg1 => {
# summary => 'The blah blah argument',
# schema => ['rinci::function_meta*'],
# },
# ...
# },
# };
# sub myfunc {
# my %args = @_;
# ...
# }
# 1;
#
# # in myapp.pl
# package main;
# use Perinci::CmdLine::Any;
# Perinci::CmdLine::Any->new(url=>'MyApp::myfunc')->run;
script/gen-generic-ind-company-names view on Meta::CPAN
# 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
( run in 0.402 second using v1.01-cache-2.11-cpan-bbe5e583499 )