Acme-ID-CompanyName
view release on metacpan or search on metacpan
script/gen-generic-ind-company-names view on Meta::CPAN
#!perl
### begin code_after_shebang
# Note: This script is a CLI for Riap function /Acme/ID/CompanyName/gen_generic_ind_company_names
# and generated automatically using Perinci::CmdLine::Gen version 0.498
### end code_after_shebang
# PERICMD_INLINE_SCRIPT: {"code_after_shebang":"...","config_dirs":null,"config_filename":"gen-generic-ind-company-names.conf","env_name":"GEN_GENERIC_IND_COMPANY_NAMES_OPT","include":null,"log":null,"pack_deps":1,"pod":0,"read_config":1,"read_env":1...
my $_pci_metas = {""=>{args=>{add_prefixes=>{default=>1,schema=>["bool",{req=>1},{}]},add_suffixes=>{default=>1,schema=>["bool",{req=>1},{}]},desired_initials=>{schema=>["str",{match=>qr(\A[A-Za-z]+\z),min_len=>1,req=>1},{}]},num_names=>{cmdline_alia...
# This script is generated by Perinci::CmdLine::Inline version 0.551 on Fri May 7 20:03:14 2021.
# Rinci metadata taken from these modules: Acme::ID::CompanyName (no version)
# You probably should not manually edit this file.
our $DATE = '2021-05-07'; # DATE
our $VERSION = '0.007'; # VERSION
# PODNAME: gen-generic-ind-company-names
# ABSTRACT: Generate nice-sounding, generic Indonesian company names
# 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) {
script/gen-generic-ind-company-names view on Meta::CPAN
# args_as => 'array',
# args => {
# cmdline => {
# summary => 'Command-line, defaults to COMP_LINE environment',
# schema => 'str*',
# pos => 0,
# },
# point => {
# summary => 'Point/position to complete in command-line, '.
# 'defaults to COMP_POINT',
# schema => 'int*',
# pos => 1,
# },
# opts => {
# summary => 'Options',
# schema => 'hash*',
# description => <<'_',
#
#Optional. Known options:
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
# position of cursor, for example (`^` marks the position of cursor):
# `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
# doing tab completion.
#
#_
# schema => 'hash*',
# pos => 2,
# },
# },
# result => {
# schema => ['array*', len=>2],
# description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in `@ARGV`), you need to strip the first element from
#`$words` and reduce `$cword` by 1.
#
#
#_
# },
# result_naked => 1,
# links => [
# ],
#};
#sub parse_cmdline {
# no warnings 'uninitialized';
# my ($line, $point, $opts) = @_;
#
# $line //= $ENV{COMP_LINE};
# $point //= $ENV{COMP_POINT} // 0;
#
# die "$0: COMP_LINE not set, make sure this script is run under ".
# "bash completion (e.g. through complete -C)\n" unless defined $line;
#
# log_trace "[compbash] parse_cmdline(): input: line=<$line> point=<$point>"
# if $ENV{COMPLETE_BASH_TRACE};
#
# my @words;
# my $cword;
# my $pos = 0;
# my $pos_min_ws = 0;
# my $after_ws = 1; # XXX what does this variable mean?
# my $chunk;
# my $add_blank;
# my $is_cur_word;
# $line =~ s!( # 1) everything
# (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*) | # 2) open " 3) content 4) space after
# (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*) | # 5) open ' 6) content 7) space after
# ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) | # 8) unquoted word 9) space after
# ([\@><=|&\(:]+) | # 10) non-whitespace word-breaking characters
# \s+
# )!
# $pos += length($1);
# #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
# #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
# if ($2 || $5 || defined($8)) {
# # double-quoted/single-quoted/unquoted chunk
#
# if (not(defined $cword)) {
# $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
# #say "D:pos_min_ws=$pos_min_ws";
# if ($point <= $pos_min_ws) {
# $cword = @words - ($after_ws ? 0 : 1);
# } elsif ($point < $pos) {
# $cword = @words + 1 - ($after_ws ? 0 : 1);
# $add_blank = 1;
# }
# }
#
# if ($after_ws) {
# $is_cur_word = defined($cword) && $cword==@words;
# } else {
# $is_cur_word = defined($cword) && $cword==@words-1;
# }
# #say "D:is_cur_word=$is_cur_word";
# $chunk =
# $2 ? _add_double_quoted($3, $is_cur_word) :
# $5 ? _add_single_quoted($6) :
# _add_unquoted($8, $is_cur_word, $after_ws);
# if ($opts && $opts->{truncate_current_word} &&
# $is_cur_word && $pos > $point) {
# $chunk = substr(
# $chunk, 0, length($chunk)-($pos_min_ws-$point));
# #say "D:truncating current word to <$chunk>";
# }
# if ($after_ws) {
# push @words, $chunk;
# } else {
# $words[-1] .= $chunk;
# }
# if ($add_blank) {
# push @words, '';
# $add_blank = 0;
# }
# $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
#
# } elsif ($10) {
# # non-whitespace word-breaking characters
# push @words, $10;
# $after_ws = 1;
# } else {
# # whitespace
# $after_ws = 1;
# }
# !egx;
#
# $cword //= @words;
# $words[$cword] //= '';
#
# log_trace "[compbash] parse_cmdline(): result: words=%s, cword=%s", \@words, $cword
# if $ENV{COMPLETE_BASH_TRACE};
#
# [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
# v => 1.1,
# summary => 'Post-process parse_cmdline() result by joining some words',
# description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
# "'@><=;|&(:
#
#So if command-line is:
#
# command --module=Data::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "--module", "=", "Data", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
# ["command", "--module=Data::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
# my ($words, $cword) = @_;
# my $new_words = [];
# my $i = -1;
# while (++$i < @$words) {
# my $w = $words->[$i];
# if ($w =~ /\A[\@=:]+\z/) {
# if (@$new_words and $#$new_words != $cword) {
# $new_words->[-1] .= $w;
# $cword-- if $cword >= $i || $cword >= @$new_words;
# } else {
# push @$new_words, $w;
# }
# if ($i+1 < @$words) {
# $i++;
# $new_words->[-1] .= $words->[$i];
# $cword-- if $cword >= $i || $cword >= @$new_words;
# }
# } else {
# push @$new_words, $w;
# }
# }
# log_trace "[compbash] join_wordbreak_words(): result: words=%s, cword=%d", $new_words, $cword
# if $ENV{COMPLETE_BASH_TRACE};
# [$new_words, $cword];
#}
#
#sub _terminal_width {
# # XXX need to cache?
# if (eval { require Term::Size; 1 }) {
# my ($cols, undef) = Term::Size::chars(*STDOUT{IO});
# $cols // 80;
# } else {
# $ENV{COLUMNS} // 80;
# }
#}
#
## given terminal width & number of columns, calculate column width
#sub _column_width {
# my ($terminal_width, $num_columns) = @_;
# if (defined $num_columns && $num_columns > 0) {
# int( ($terminal_width - ($num_columns-1)*2) / $num_columns ) - 1;
# } else {
# undef;
# }
#}
#
## given terminal width & column width, calculate number of columns
#sub _num_columns {
# my ($terminal_width, $column_width) = @_;
# my $n = int( ($terminal_width+2) / ($column_width+2) );
# $n >= 1 ? $n : 1;
#}
#
#$SPEC{format_completion} = {
# v => 1.1,
# summary => 'Format completion for output (for shell)',
# description => <<'_',
#
#Bash accepts completion reply in the form of one entry per line to STDOUT. Some
#characters will need to be escaped. This function helps you do the formatting,
#with some options.
#
#This function accepts completion answer structure as described in the `Complete`
#POD. Aside from `words`, this function also recognizes these keys:
#
#_
# args_as => 'array',
# args => {
# completion => {
# summary => 'Completion answer structure',
# description => <<'_',
#
#Either an array or hash. See function description for more details.
#
#_
# schema=>['any*' => of => ['hash*', 'array*']],
# req=>1,
# pos=>0,
# },
# opts => {
# summary => 'Specify options',
# schema=>'hash*',
script/gen-generic-ind-company-names view on Meta::CPAN
#
#Return value: (any)
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_BASH_DEFAULT_ESC_MODE
#
#Str. To provide default for the C<esc_mode> option in L</format_completion>.
#
#=head2 COMPLETE_BASH_FZF
#
#Bool. Whether to pass large completion answer to fzf instead of directly passing
#it to bash and letting bash page it with a simpler more-like internal pager. By
#default, large is defined as having at least 100 items (same bash's
#C<completion-query-items> setting). This can be configured via
#L</COMPLETE_BASH_FZF_ITEMS>.
#
#=head2 COMPLETE_BASH_FZF_ITEMS
#
#Uint. Default 100. The minimum number of items to trigger passing completion
#answer to fzf. See also: L</COMPLETE_BASH_FZF>.
#
#=head2 COMPLETE_BASH_MAX_COLUMNS
#
#Uint.
#
#Bash will show completion entries in one or several columns, depending on the
#terminal width and the length of the entries (much like a standard non-long
#`ls`). If you prefer completion entries to be shown in a single column no matter
#how wide your terminal is, or how short the entries are, you can set the value
#of this variable to 1. If you prefer a maximum of two columns, set to 2, and so
#on. L</format_completion> will pad the entries with sufficient spaces to limit
#the number of columns.
#
#=head2 COMPLETE_BASH_SHOW_SUMMARIES
#
#Bool. Will set the default for C<show_summaries> option in
#L</format_completion>.
#
#=head2 COMPLETE_BASH_SUMMARY_ALIGN
#
#String. Either C<left> (the default) or C<right>.
#
#The C<left> align looks something like this:
#
# --bar Summary about the bar option
# --baz Summary about the baz option
# --foo Summary about the foo option
# --schapen Summary about the schapen option
#
#The C<right> align will make the completion answer look like what you see in the
#B<fish> shell:
#
# --bar Summary about the bar option
# --baz Summary about the baz option
# --foo Summary about the foo option
# --schapen Summary about the schapen option
#
#=head2 COMPLETE_BASH_TRACE
#
#Bool. If set to true, will produce more log statements to L<Log::ger>.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Bash>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Bash>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Bash>
#
#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<Complete>, the convention that this module follows.
#
#Some higher-level modules that use this module (so you don't have to use this
#module directly): L<Getopt::Long::Complete> (via L<Complete::Getopt::Long>),
#L<Getopt::Long::Subcommand>, L<Perinci::CmdLine> (via
#L<Perinci::Sub::Complete>).
#
#Other modules related to bash shell tab completion: L<Bash::Completion>,
#L<Getopt::Complete>, L<Term::Bash::Completion::Generator>.
#
#Programmable Completion section in Bash manual:
#L<https://www.gnu.org/software/bash/manual/html_node/Programmable-Completion.html>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2016, 2015, 2014 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
### Config/IOD/Base.pm ###
#package Config::IOD::Base;
#
#our $DATE = '2019-01-17'; # DATE
#our $VERSION = '0.342'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
##use Carp; # avoided to shave a bit of startup time
#
#use constant +{
# COL_V_ENCODING => 0, # either "!j"... or '"', '[', '{', '~'
# COL_V_WS1 => 1,
# COL_V_VALUE => 2,
# COL_V_WS2 => 3,
script/gen-generic-ind-company-names view on Meta::CPAN
#
# !include foo.ini
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_encoding => bool (default: 1)
#
#If set to false, then encoding notation will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = !json null
#
#With C<enable_encoding> turned off, value will not be undef but will be string
#with the value of (as Perl literal) C<"!json null">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_quoting => bool (default: 1)
#
#If set to false, then quotes on key value will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = "line 1\nline2"
#
#With C<enable_quoting> turned off, value will not be a two-line string, but will
#be a one line string with the value of (as Perl literal) C<"line 1\\nline2">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_bracket => bool (default: 1)
#
#If set to false, then JSON literal array will be parsed as verbatim. Example:
#
# name = [1,2,3]
#
#With C<enable_bracket> turned off, value will not be a three-element array, but
#will be a string with the value of (as Perl literal) C<"[1,2,3]">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_brace => bool (default: 1)
#
#If set to false, then JSON literal object (hash) will be parsed as verbatim.
#Example:
#
# name = {"a":1,"b":2}
#
#With C<enable_brace> turned off, value will not be a hash with two pairs, but
#will be a string with the value of (as Perl literal) C<'{"a":1,"b":2}'>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_tilde => bool (default: 1)
#
#If set to true (the default), then value that starts with C<~> (tilde) will be
#assumed to use !path encoding, unless an explicit encoding has been otherwise
#specified.
#
#Example:
#
# log_dir = ~/logs ; ~ will be resolved to current user's home directory
#
#With C<enable_tilde> turned off, value will still be literally C<~/logs>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 allow_encodings => array
#
#If defined, set list of allowed encodings. Note that if C<disallow_encodings> is
#also set, an encoding must also not be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 disallow_encodings => array
#
#If defined, set list of disallowed encodings. Note that if C<allow_encodings> is
#also set, an encoding must also be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 enable_expr => bool (default: 0)
#
#Whether to enable C<expr> encoding. By default this is turned on, for safety.
#Please see L</"EXPRESSION"> for more details.
#
#=head2 allow_directives => array
#
#If defined, only directives listed here are allowed. Note that if
#C<disallow_directives> is also set, a directive must also not be in that list.
#
#=head2 disallow_directives => array
#
#If defined, directives listed here are not allowed. Note that if
#C<allow_directives> is also set, a directive must also be in that list.
#
#=head2 allow_bang_only => bool (default: 1)
#
#Since the mistake of specifying a directive like this:
#
# !foo
#
#instead of the correct:
#
# ;!foo
#
#is very common, the spec allows it. This reader, however, can be configured to
#be more strict.
#
#=head2 allow_duplicate_key => bool (default: 1)
#
#If set to 0, you can forbid duplicate key, e.g.:
#
# [section]
# a=1
# a=2
#
#or:
#
# [section]
# a=1
# b=2
script/gen-generic-ind-company-names view on Meta::CPAN
#
# !include foo.ini
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_encoding => bool (default: 1)
#
#If set to false, then encoding notation will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = !json null
#
#With C<enable_encoding> turned off, value will not be undef but will be string
#with the value of (as Perl literal) C<"!json null">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_quoting => bool (default: 1)
#
#If set to false, then quotes on key value will be ignored and key value will be
#parsed as verbatim. Example:
#
# name = "line 1\nline2"
#
#With C<enable_quoting> turned off, value will not be a two-line string, but will
#be a one line string with the value of (as Perl literal) C<"line 1\\nline2">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_bracket => bool (default: 1)
#
#If set to false, then JSON literal array will be parsed as verbatim. Example:
#
# name = [1,2,3]
#
#With C<enable_bracket> turned off, value will not be a three-element array, but
#will be a string with the value of (as Perl literal) C<"[1,2,3]">.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_brace => bool (default: 1)
#
#If set to false, then JSON literal object (hash) will be parsed as verbatim.
#Example:
#
# name = {"a":1,"b":2}
#
#With C<enable_brace> turned off, value will not be a hash with two pairs, but
#will be a string with the value of (as Perl literal) C<'{"a":1,"b":2}'>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 enable_tilde => bool (default: 1)
#
#If set to true (the default), then value that starts with C<~> (tilde) will be
#assumed to use !path encoding, unless an explicit encoding has been otherwise
#specified.
#
#Example:
#
# log_dir = ~/logs ; ~ will be resolved to current user's home directory
#
#With C<enable_tilde> turned off, value will still be literally C<~/logs>.
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 allow_encodings => array
#
#If defined, set list of allowed encodings. Note that if C<disallow_encodings> is
#also set, an encoding must also not be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 disallow_encodings => array
#
#If defined, set list of disallowed encodings. Note that if C<allow_encodings> is
#also set, an encoding must also be in that list.
#
#Also note that, for safety reason, if you want to enable C<expr> encoding,
#you'll also need to set C<enable_expr> to 1.
#
#=head2 enable_expr => bool (default: 0)
#
#Whether to enable C<expr> encoding. By default this is turned on, for safety.
#Please see L</"EXPRESSION"> for more details.
#
#=head2 allow_directives => array
#
#If defined, only directives listed here are allowed. Note that if
#C<disallow_directives> is also set, a directive must also not be in that list.
#
#=head2 disallow_directives => array
#
#If defined, directives listed here are not allowed. Note that if
#C<allow_directives> is also set, a directive must also be in that list.
#
#=head2 allow_bang_only => bool (default: 1)
#
#Since the mistake of specifying a directive like this:
#
# !foo
#
#instead of the correct:
#
# ;!foo
#
#is very common, the spec allows it. This reader, however, can be configured to
#be more strict.
#
#=head2 allow_duplicate_key => bool (default: 1)
#
#If set to 0, you can forbid duplicate key, e.g.:
#
# [section]
# a=1
# a=2
#
#or:
#
# [section]
# a=1
# b=2
script/gen-generic-ind-company-names view on Meta::CPAN
# if ($name_routines && !defined &subname) {
# if (eval { require Sub::Name; 1 }) {
# *subname = \&Sub::Name::subname;
# } else {
# *subname = sub {};
# }
# }
#
# if ($target eq 'package') {
##IFUNBUILT
## no warnings 'redefine';
##END IFUNBUILT
# for my $r (@$routines) {
# my ($code, $name, $lnum, $type) = @$r;
# next unless $type =~ /_sub\z/;
# #print "D:installing $name to package $target_arg\n";
# *{"$target_arg\::$name"} = $code;
# subname("$target_arg\::$name", $code) if $name_routines;
# }
# } elsif ($target eq 'object') {
##IFUNBUILT
## no warnings 'redefine';
##END IFUNBUILT
# my $pkg = ref $target_arg;
# for my $r (@$routines) {
# my ($code, $name, $lnum, $type) = @$r;
# next unless $type =~ /_method\z/;
# *{"$pkg\::$name"} = $code;
# subname("$pkg\::$name", $code) if $name_routines;
# }
# } elsif ($target eq 'hash') {
# for my $r (@$routines) {
# my ($code, $name, $lnum, $type) = @$r;
# next unless $type =~ /_sub\z/;
# $target_arg->{$name} = $code;
# }
# }
#}
#
#sub add_target {
# my ($target_type, $target_name, $per_target_conf, $replace) = @_;
# $replace = 1 unless defined $replace;
#
# if ($target_type eq 'package') {
# unless ($replace) { return if $Package_Targets{$target_name} }
# $Package_Targets{$target_name} = $per_target_conf;
# } elsif ($target_type eq 'object') {
# my ($addr) = "$target_name" =~ $re_addr;
# unless ($replace) { return if $Object_Targets{$addr} }
# $Object_Targets{$addr} = [$target_name, $per_target_conf];
# } elsif ($target_type eq 'hash') {
# my ($addr) = "$target_name" =~ $re_addr;
# unless ($replace) { return if $Hash_Targets{$addr} }
# $Hash_Targets{$addr} = [$target_name, $per_target_conf];
# }
#}
#
#sub _set_default_null_routines {
# $default_null_routines ||= [
# (map {(
# [$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:
#
# use Log::ger::Util;
# Log::ger::Util::set_level('debug'); # be more verbose
# foo(); # the error message as well as debug message are now shown
#
#There are better ways, e.g. letting users configure log level via configuration
#file or command-line option. See L<Log::ger::Manual::Tutorial::300_Level> for
#more details.
#
#=head1 DESCRIPTION
#
#Log::ger is yet another logging framework with the following features:
#
#=over
#
#=item * Separation of producers and consumers/listeners
#
#Like L<Log::Any>, this offers a very easy way for modules to produce some logs
#without having to configure anything. Configuring output, level, etc can be done
#in the application as log consumers/listeners. To read more about this, see the
#documentation of L<Log::Any> or L<Log::ger::Manual> (but nevertheless see
#L<Log::ger::Manual> on why you might prefer Log::ger to Log::Any).
#
#=item * Lightweight and fast
#
#B<Slim distribution.> No non-core dependencies, extra functionalities are
#provided in separate distributions to be pulled as needed.
#
#B<Low startup overhead.> Only ~0.5-1ms. For comparison, L<strict> ~0.2-0.5ms,
#L<warnings> ~2ms, L<Log::Any> (v0.15) ~2-3ms, Log::Any (v1.049) ~8-10ms,
#L<Log::Log4perl> ~35ms. This is measured on a 2014-2015 PC and before doing any
#output configuration. I strive to make C<use Log::ger;> statement to be roughly
#as light as C<use strict;> or C<use warnings;> so the impact of adding the
#statement is really minimal and you can just add logging without much thought to
#most of your modules. This is important to me because I want logging to be
#pervasive.
#
#To test for yourself, try e.g. with L<bencher-code>:
#
# % bencher-code 'use Log::ger' 'use Log::Any' --startup
#
#B<Fast>. Low null-/stealth-logging overhead, about 1.5x faster than Log::Any, 3x
#faster than Log4perl, 5x faster than L<Log::Fast>, ~40x faster than
#L<Log::Contextual>, and ~100x faster than L<Log::Dispatch>.
#
#For more benchmarks, see L<Bencher::Scenarios::LogGer>.
#
#B<Conditional compilation.> There is a plugin to optimize away unneeded logging
#statements, like assertion/conditional compilation, so they have zero runtime
#performance cost. See L<Log::ger::Plugin::OptAway>.
#
#Being lightweight means the module can be used more universally, from CLI to
#long-running daemons to inside routines with tight loops.
#
#=item * Flexible
#
#B<Customizable levels and routine/method names.> Can be used in a procedural or
#OO style. Log::ger can mimic the interface of L<Log::Any>, L<Log::Contextual>,
#L<Log::Log4perl>, or some other popular logging frameworks, to ease migration or
#adjust with your personal style.
#
#B<Per-package settings.> Each importer package can use its own format/layout,
#output. For example, a module that is migrated from Log::Any uses Log::Any-style
#logging, while another uses native Log::ger style, and yet some other uses block
#formatting like Log::Contextual. This eases code migration and teamwork. Each
#module author can preserve her own logging style, if wanted, and all the modules
#still use the same framework.
#
#B<Dynamic.> Outputs and levels can be changed anytime during run-time and logger
#routines will be updated automatically. This is useful in situation like a
#long-running server application: you can turn on tracing logs temporarily to
#debug problems, then turn them off again, without restarting your server.
#
#B<Interoperability.> There are modules to interop with Log::Any, either consume
#Log::Any logs (see L<Log::Any::Adapter::LogGer>) or produce logs to be consumed
#by Log::Any (see L<Log::ger::Output::LogAny>).
#
#B<Many output modules and plugins.> See C<Log::ger::Output::*>,
#C<Log::ger::Format::*>, C<Log::ger::Layout::*>, C<Log::ger::Plugin::*>. Writing
#an output module in Log::ger is easier than writing a Log::Any::Adapter::*.
#
#=back
#
#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) 2021, 2020, 2019, 2018, 2017 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
### Perinci/CmdLine/Util/Config.pm ###
#package Perinci::CmdLine::Util::Config;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-10-21'; # DATE
#our $DIST = 'Perinci-CmdLine-Util-Config'; # DIST
#our $VERSION = '1.724'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter qw(import);
#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 => {},
script/gen-generic-ind-company-names view on Meta::CPAN
#}
#
#$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}) {
# $paths = $args{config_paths};
# } else {
# for my $dir (@$config_dirs) {
# for my $name (@filenames) {
# my $path = "$dir/" . $name;
# push @$paths, $path if -e $path;
# }
# }
# }
#
# my $reader = Config::IOD::Reader->new;
# my %res;
# my @read;
# my %section_read_order;
# FILE:
# for my $i (0..$#{$paths}) {
# my $path = $paths->[$i];
# my $filename = $path; $filename =~ s!.*[/\\]!!;
# my $wanted_section = $section_config_filename_map{$filename};
# log_trace "[pericmd] Reading config file '%s' ...", $path;
# my $j = 0;
# $section_read_order{GLOBAL} = [$i, $j++];
# my @file_sections = ("GLOBAL");
# my $hoh = $reader->read_file(
# $path,
# sub {
# my %args = @_;
# return unless $args{event} eq 'section';
# my $section = $args{section};
# push @file_sections, $section
# unless grep {$section eq $_} @file_sections;
# $section_read_order{$section} = [$i, $j++];
# },
# );
# push @read, $path;
# SECTION:
# for my $section (@file_sections) {
# $res{$section} //= {};
# my $hash = $hoh->{$section};
#
# my $s = $section; $s =~ s/\s*\S*=.*\z//; # strip key=value pairs
# $s = 'GLOBAL' if $s eq '';
#
# if ($args{hook_section}) {
# my $res = $args{hook_section}->($section, $hash);
# if ($res->[0] == 204) {
# log_trace "[pericmd] Skipped config section '$section' ".
# "in file '$path': hook_section returns 204";
# next SECTION;
# } elsif ($res->[0] >= 400 && $res->[0] <= 599) {
# return [$res->[0], "Error when reading config file '$path'".
# ": $res->[1]"];
# }
# }
#
# next unless !defined($wanted_section) || $s eq $wanted_section;
#
# for (keys %$hash) {
# $res{$section}{$_} = $hash->{$_};
# }
# }
# }
# [200, "OK", \%res, {
# 'func.read_files' => \@read,
# 'func.section_read_order' => \%section_read_order,
# }];
#}
#
#$SPEC{get_args_from_config} = {
# v => 1.1,
# description => <<'_',
#
#`config` is a HoH (hashes of hashrefs) produced by reading an INI (IOD)
#configuration file using modules like <pm:Config::IOD::Reader>.
#
#Hashref argument `args` will be set by parameters in `config`, while `plugins`
#will be set by parameters in `[plugin=...]` sections in `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
#
#`args` will become:
#
# {
# arg1=>"val1",
# arg2=>"val2",
# -special_arg1=>"val3",
# -special_arg2=>"val4",
# }
#
#and `plugins` will become:
#
# [
# 'DumpArgs@before_validation' => {},
# Foo => {arg1=>val},
# ]
#
#_
script/gen-generic-ind-company-names view on Meta::CPAN
# config => {},
# args => {schema=>'hash'},
# plugins => {schema=>'array'},
# subcommand_name => {},
# config_profile => {},
# common_opts => {},
# meta => {},
# meta_is_normalized => {},
# },
#};
#sub get_args_from_config {
# my %fargs = @_;
#
# my $r = $fargs{r};
# my $conf = $fargs{config};
# my $progn = $fargs{program_name};
# my $scn = $fargs{subcommand_name} // '';
# my $profile = $fargs{config_profile};
# my $args = $fargs{args} // {};
# my $plugins = $fargs{plugins} // [];
# my $copts = $fargs{common_opts};
# my $meta = $fargs{meta};
# my $found;
#
# unless ($fargs{meta_is_normalized}) {
# require Perinci::Sub::Normalize;
# $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
# }
#
# my $csro = $r->{_config_section_read_order} // {};
# my @sections = sort {
# # sort according to the order the section is seen in the file
# my $csro_a = $csro->{$a} // [0,0];
# my $csro_b = $csro->{$b} // [0,0];
# $csro_a->[0] <=> $csro_b->[0] ||
# $csro_a->[1] <=> $csro_b->[1] ||
# $a cmp $b
# } keys %$conf;
#
# my %seen_profiles; # for debugging message
# for my $section0 (@sections) {
# my %keyvals;
# my $sect_name;
# for my $word (split /\s+/, $section0) {
# if ($word =~ /(.*?)=(.*)/) {
# $keyvals{$1} = $2;
# } else {
# $sect_name //= $word;
# }
# }
# $seen_profiles{$keyvals{profile}}++ if defined $keyvals{profile};
#
# my $sect_scn = $keyvals{subcommand} // '';
# my $sect_profile = $keyvals{profile};
# my $sect_plugin = $keyvals{plugin};
#
# # if there is a subcommand name, use section with no subcommand=... or
# # the matching subcommand
# if (length $scn) {
# if (length($sect_scn) && $sect_scn ne $scn) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "subcommand does not match '$scn'",
# );
# next;
# }
# } else {
# if (length $sect_scn) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "only for a certain subcommand",
# );
# next;
# }
# }
#
# # if user chooses a profile, only use section with no profile=... or the
# # matching profile
# if (defined $profile) {
# if (defined($sect_profile) && $sect_profile ne $profile) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "profile does not match '$profile'",
# );
# next;
# }
# $found = 1 if defined($sect_profile) && $sect_profile eq $profile;
# } else {
# if (defined($sect_profile)) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "only for a certain profile",
# );
# next;
# }
# }
#
# # only use section marked with program=... if the program name matches
# if (defined($progn) && defined($keyvals{program})) {
# if ($progn ne $keyvals{program}) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "program does not match '$progn'",
# );
# next;
# }
# }
#
# # if user specifies env=... then apply filtering by ENV variable
# if (defined(my $env = $keyvals{env})) {
# my ($var, $val);
# if (($var, $val) = $env =~ /\A(\w+)=(.*)\z/) {
# if (($ENV{$var} // '') ne $val) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "env $var has non-matching value '".
# ($ENV{$var} // '')."'",
# );
# next;
# }
# } elsif (($var, $val) = $env =~ /\A(\w+)!=(.*)\z/) {
# if (($ENV{$var} // '') eq $val) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "env $var has that value",
# );
# next;
# }
# } elsif (($var, $val) = $env =~ /\A(\w+)\*=(.*)\z/) {
# if (index(($ENV{$var} // ''), $val) < 0) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "env $var has value '".
# ($ENV{$var} // '')."' which does not contain the ".
# "requested string"
# );
# next;
# }
# } else {
# if (!$ENV{$env}) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "env $env is not set/true",
# );
# next;
# }
# }
# }
#
# log_trace("[pericmd] Reading config section '%s'", $section0);
#
# if (defined $sect_plugin) {
# # TODO: check against metadata in plugin
# my $event;
# my $prio;
# my $plugin_args = {};
# for my $k (keys %{ $conf->{$section0} }) {
# my $v = $conf->{$section0}{$k};
# 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:
#
script/gen-generic-ind-company-names view on Meta::CPAN
# │ Feraligatr │ Water │ 5678 │
# └────────────┴─────────┴───────┘
#
#If you're using the boxrule style,
#you might feel you can remove the padding on either side of every column,
#done by setting C<compact> to a true value:
#
# ┌──────────┬───────┬─────â”Â
# │Pokemon │Type │Count│
# ├──────────┼───────┼─────┤
# │Abra │Psychic│ 5│
# │Ekans │Poison │ 123│
# │Feraligatr│Water │ 5678│
# └──────────┴───────┴─────┘
#
#You can also ask for a rule between each row,
#in which case the header rule becomes stronger.
#This works best when combined with the boxrule style:
#
# generate_table( ... , separate_rows => 1 );
#
#Which results in the following:
#
# ┌────────────┬─────────┬───────â”Â
# │ Pokemon │ Type │ Count │
# ╞â•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Â╪â•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Â╪â•Ââ•Ââ•Ââ•Ââ•Ââ•Ââ•Â╡
# │ Abra │ Psychic │ 5 │
# ├────────────┼─────────┼───────┤
# │ Ekans │ Poison │ 123 │
# ├────────────┼─────────┼───────┤
# │ Feraligatr │ Water │ 5678 │
# └────────────┴─────────┴───────┘
#
#You can use this with the other styles,
#but I'm not sure you'd want to.
#
#If you just want columnar output,
#use the C<norule> style:
#
# generate_table( ... , style => 'norule' );
#
#which results in:
#
#
# Pokemon Type Count
#
# Abra Psychic 5
# Ekans Poison 123
# Feraligatr Water 5678
#
#
#Note that everywhere you saw a line on the previous tables,
#there will be a space character in this version.
#So you may want to combine the C<top_and_tail> option,
#to suppress the extra blank lines before and after
#the body of the table.
#
#
#=head1 SEE ALSO
#
#My L<blog post|http://neilb.org/2019/08/06/text-table-tiny-changes.html>
#where I described changes to formatting;
#this has more examples.
#
#There are many modules for formatting text tables on CPAN.
#A good number of them are listed in the
#L<See Also|https://metacpan.org/pod/Text::Table::Manifold#See-Also>
#section of the documentation for L<Text::Table::Manifold>.
#
#
#=head1 REPOSITORY
#
#L<https://github.com/neilb/Text-Table-Tiny>
#
#
#=head1 AUTHOR
#
#Neil Bowers <neilb@cpan.org>
#
#The original version was written by Creighton Higgins <chiggins@chiggins.com>,
#but the module was entirely rewritten for 0.05_01.
#
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020 by Neil Bowers.
#
#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
#
### begin code_after_end
### end code_after_end
( run in 1.222 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )