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) {
my $line = <DATA>;
$pos += length($line);
script/gen-generic-ind-company-names view on Meta::CPAN
};
if ($toc->{$_[1]}) {
seek DATA, $toc->{$_[1]}[0], 0;
read DATA, my($content), $toc->{$_[1]}[1];
my ($order, $lineoffset) = split(';', $toc->{$_[1]}[2]);
$content =~ s/^#//gm;
$content = "# line ".($data_linepos + $order+1 + $lineoffset)." \"".__FILE__."\"\n" . $content;
open my $fh, '<', \$content
or die "DataPacker error loading $_[1]: $!";
return $fh;
}
return;
};
}
# END DATAPACK CODE
package main;
use 5.010001;
use strict;
#use warnings;
# load modules
### declare global variables
our $_pci_meta_result_stream = 0;
our $_pci_meta_result_type;
our $_pci_meta_result_type_is_simple;
our $_pci_meta_skip_format = 0;
our $_pci_r = {naked_res=>0,read_config=>1,read_env=>1,subcommand_name=>""};
our %_pci_args;
### declare subroutines
sub _pci_err {
my $res = shift;
print STDERR "ERROR $res->[0]: $res->[1]\n";
exit $res->[0]-300;
}
sub _pci_json {
state $json = do {
if (eval { require JSON::XS; 1 }) { JSON::XS->new->canonical(1)->allow_nonref }
else { require JSON::PP; JSON::PP->new->canonical(1)->allow_nonref }
};
$json;
}
### begin code_before_parse_cmdline_options
### end code_before_parse_cmdline_options
### get arguments (from config file, env, command-line args
{
my %mentioned_args;
require Getopt::Long::EvenLess;
my $go_spec1 = {
'config-path=s@' => sub { $_pci_r->{config_paths} //= []; push @{ $_pci_r->{config_paths} }, $_[1]; },
'config-profile=s' => sub { $_pci_r->{config_profile} = $_[1]; },
'format=s' => sub { $_pci_r->{format} = $_[1]; },
'help|h|?' => sub { print "gen-generic-ind-company-names - Generate nice-sounding, generic Indonesian company names\n\nUsage:\n gen-generic-ind-company-names --help (or -h, -?)\n gen-generic-ind-company-names --version (or -v)\n gen-generic-in...
'json' => sub { $_pci_r->{format} = (-t STDOUT) ? "json-pretty" : "json"; },
'naked-res' => sub { $_pci_r->{naked_res} = 1; },
'no-config' => sub { $_pci_r->{read_config} = 0; },
'no-env' => sub { $_pci_r->{read_env} = 0; },
'no-naked-res|nonaked-res' => sub { $_pci_r->{naked_res} = 0; },
'page-result:s' => sub { $_pci_r->{page_result} = 1; },
'version|v' => sub { no warnings 'once'; require Acme::ID::CompanyName; print "gen-generic-ind-company-names version ", "0.007", ($Acme::ID::CompanyName::DATE ? " ($Acme::ID::CompanyName::DATE)" : ''), "\n"; print " Generated by Perinci::CmdLine...
};
my $go_spec2 = {
'add-prefixes' => sub { $_pci_args{'add_prefixes'} = $_[1];
},
'add-suffixes' => sub { $_pci_args{'add_suffixes'} = $_[1];
},
'config-path=s@' => sub { },
'config-profile=s' => sub { },
'desired-initials=s' => sub { $_pci_args{'desired_initials'} = $_[1];
},
'format=s' => sub { },
'help|h|?' => sub { },
'json' => sub { },
'n=s' => sub { $_pci_args{'num_names'} = $_[1];
},
'naked-res' => sub { },
'no-add-prefixes' => sub { $_pci_args{'add_prefixes'} = 0;
},
'no-add-suffixes' => sub { $_pci_args{'add_suffixes'} = 0;
},
'no-config' => sub { },
'no-env' => sub { },
'no-naked-res|nonaked-res' => sub { },
'noadd-prefixes' => sub { $_pci_args{'add_prefixes'} = 0;
},
'noadd-suffixes' => sub { $_pci_args{'add_suffixes'} = 0;
},
'num-names=s' => sub { $_pci_args{'num_names'} = $_[1];
},
'num-words=s' => sub { $_pci_args{'num_words'} = $_[1];
},
'page-result:s' => sub { },
't=s' => sub { $_pci_args{'type'} = $_[1];
},
'type=s' => sub { $_pci_args{'type'} = $_[1];
},
'version|v' => sub { },
'w=s' => sub { $_pci_args{'num_words'} = $_[1];
},
};
my $old_conf = Getopt::Long::EvenLess::Configure("pass_through");
Getopt::Long::EvenLess::GetOptions(%$go_spec1);
Getopt::Long::EvenLess::Configure($old_conf);
{
last unless $_pci_r->{read_env};
my $env = $ENV{"GEN_GENERIC_IND_COMPANY_NAMES_OPT"};
last unless defined $env;
require Complete::Bash;
my ($words, undef) = @{ Complete::Bash::parse_cmdline($env, 0) };
unshift @ARGV, @$words;
}
if ($_pci_r->{read_config}) {
require Perinci::CmdLine::Util::Config;
script/gen-generic-ind-company-names view on Meta::CPAN
$_pci_r->{_config_section_read_order} = $res->[3]{"func.section_read_order"}; # we currently dont want to publish this request key
$res = Perinci::CmdLine::Util::Config::get_args_from_config(
r => $_pci_r,
config => $_pci_r->{config},
args => \%_pci_args,
program_name => "gen-generic-ind-company-names",
subcommand_name => $_pci_r->{subcommand_name},
config_profile => $_pci_r->{config_profile},
common_opts => {},
meta => $_pci_metas->{ $_pci_r->{subcommand_name} },
meta_is_normalized => 1,
);
die $res unless $res->[0] == 200;
my $found = $res->[3]{"func.found"};
if (defined($_pci_r->{config_profile}) && !$found && defined($_pci_r->{read_config_files}) && @{$_pci_r->{read_config_files}} && !$_pci_r->{ignore_missing_config_profile_section}) {
_pci_err([412, "Profile '$_pci_r->{config_profile}' not found in configuration file"]);
}
}
my $res = Getopt::Long::EvenLess::GetOptions(%$go_spec2);
_pci_err([500, "GetOptions failed"]) unless $res;
}
### 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
script/gen-generic-ind-company-names view on Meta::CPAN
=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.
=item B<--num-words>=I<s>, B<-w>
Default value:
3
=item B<--type>=I<s>, B<-t>
Just a string to be prepended before the name.
Default value:
"PT"
=back
=head2 Configuration options
=over
=item B<--config-path>=I<s>
Set path to configuration file.
Can be specified multiple times.
=item B<--config-profile>=I<s>
Set configuration profile to use.
=item B<--no-config>
Do not use any configuration file.
=back
=head2 Environment options
=over
=item B<--no-env>
Do not read environment for default options.
=back
=head2 Output options
=over
=item B<--format>=I<s>
Choose output format, e.g. json, text.
Default value:
undef
=item B<--json>
Set output format to json.
=item B<--naked-res>
When outputing as JSON, strip result envelope.
Default value:
0
By default, when outputing as JSON, the full enveloped result is returned, e.g.:
[200,"OK",[1,2,3],{"func.extra"=>4}]
The reason is so you can get the status (1st element), status message (2nd
element) as well as result metadata/extra result (4th element) instead of just
the result (3rd element). However, sometimes you want just the result, e.g. when
you want to pipe the result for more post-processing. In this case you can use
`--naked-res` so you just get:
[1,2,3]
=item B<--page-result>
Filter output through a pager.
=item B<--view-result>
View output using a viewer.
=back
=head2 Other options
=over
=item B<--help>, B<-h>, B<-?>
Display help message and exit.
=item B<--version>, B<-v>
Display program's version and exit.
=back
=head1 CONFIGURATION FILE
This script can read configuration files. Configuration files are in the format of L<IOD>, which is basically INI with some extra features.
By default, these names are searched for configuration filenames (can be changed using C<--config-path>): F<~/.config/gen-generic-ind-company-names.conf>, F<~/gen-generic-ind-company-names.conf>, or F</etc/gen-generic-ind-company-names.conf>.
All found files will be read and merged.
To disable searching for configuration files, pass C<--no-config>.
You can put multiple profiles in a single file by using section names like C<[profile=SOMENAME]> or C<[SOMESECTION profile=SOMENAME]>. Those sections will only be read if you specify the matching C<--config-profile SOMENAME>.
You can also put configuration for multiple programs inside a single file, and use filter C<program=NAME> in section names, e.g. C<[program=NAME ...]> or C<[SOMESECTION program=NAME]>. The section will then only be used when the reading program match...
You can also filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOMEVAR ...
To load and configure plugins, you can use either the C<-plugins> parameter (e.g. C<< -plugins=DumpArgs >> or C<< -plugins=DumpArgs@before_validate_args >>), or use the C<[plugin=NAME ...]> sections, for example:
[plugin=DumpArgs]
-event=before_validate_args
-prio=99
[plugin=Foo]
-event=after_validate_args
arg1=val1
arg2=val2
which is equivalent to setting C<< -plugins=-DumpArgs@before_validate_args@99,-Foo@after_validate_args,arg1,val1,arg2,val2 >>.
List of available configuration parameters:
add_prefixes (see --no-add-prefixes)
add_suffixes (see --no-add-suffixes)
desired_initials (see --desired-initials)
format (see --format)
naked_res (see --naked-res)
num_names (see --num-names)
num_words (see --num-words)
type (see --type)
=head1 ENVIRONMENT
=head2 GEN_GENERIC_IND_COMPANY_NAMES_OPT => str
Specify additional command-line options.
=head1 FILES
F<~/.config/gen-generic-ind-company-names.conf>
F<~/gen-generic-ind-company-names.conf>
F</etc/gen-generic-ind-company-names.conf>
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/Acme-ID-CompanyName>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-Acme-ID-CompanyName>.
=head1 BUGS
script/gen-generic-ind-company-names view on Meta::CPAN
#};
#
#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)
#
#_
# args_as => 'array',
# args => {
# cmdline => {
# summary => 'Command-line which contains a marker character',
# schema => 'str*',
# pos => 0,
# },
# marker => {
# summary => 'Marker character',
# schema => ['str*', len=>1],
# default => '^',
# pos => 1,
# },
# },
# result_naked => 1,
#};
#sub point {
# my ($line, $marker) = @_;
# $marker //= '^';
#
# my $point = index($line, $marker);
# die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
# $line =~ s/\Q$marker\E//;
# ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
# v => 1.1,
# summary => 'Parse shell command-line for processing by completion routines',
# description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
# quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
# parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
# bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
# which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
# for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
# variable substitution for `COMP_WORDS`). However, note that special shell
# variables that are not environment variables like `$0`, `$_`, `$IFS` will not
# be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
# word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
# By default `COMP_WORDBREAKS` is:
#
# "'@><=;|&(:
#
# So if raw command-line is:
#
# command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
# then the parse result will be:
#
# ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
# which is annoying sometimes. But we follow bash here so we can more easily
# accept input from a joined `COMP_WORDS` if we write completion bash functions,
# e.g. (in the example, `foo` is a Perl script):
#
# _foo ()
# {
# local words=(${COMP_CWORDS[@]})
# # add things to words, etc
# local point=... # calculate the new point
# COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
# }
#
# To avoid these word-breaking characters to be split/grouped, we can escape
# them with backslash or quote them, e.g.:
#
# command "http://example.com:80" Foo\:\:Bar
#
# which bash will parse as:
#
# ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
# and we parse as:
#
# ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
# equivalent:
#
# % cmd --foo=bar
# % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
# 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;
script/gen-generic-ind-company-names view on Meta::CPAN
# 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*',
# pos=>1,
# description => <<'_',
#
#Known options:
#
#* as
#
# Either `string` (the default) or `array` (to return array of lines instead of
# the lines joined together). Returning array is useful if you are doing
# completion inside `Term::ReadLine`, for example, where the library expects an
# array.
#
#* esc_mode
#
# Escaping mode for entries. Either `default` (most nonalphanumeric characters
# will be escaped), `shellvar` (like `default`, but dollar sign `$` will also be
# escaped, convenient when completing environment variables for example),
# `filename` (currently equals to `default`), `option` (currently equals to
# `default`), or `none` (no escaping will be done).
#
#* word
#
# A workaround. String. For now, see source code for more details.
#
#* show_summaries
#
# Whether to show item's summaries. Boolean, default is from
# COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
# An answer item contain summary, which is a short description about the item,
# e.g.:
#
# [{word=>"-a" , summary=>"Show hidden files"},
# {word=>"-l" , summary=>"Show details"},
# {word=>"--sort", summary=>"Specify sort order"}],
#
# When summaries are not shown, user will just be seeing something like:
#
# -a
# -l
# --sort
#
# But when summaries are shown, user will see:
#
# -a -- Show hidden files
# -l -- Show details
# --sort -- Specify sort order
#
# which is quite helpful.
#
#* workaround_with_wordbreaks
#
# Boolean. Default is true. See source code for more details.
#
#_
#
# },
# },
# result => {
# summary => 'Formatted string (or array, if `as` is set to `array`)',
# schema => ['any*' => of => ['str*', 'array*']],
# },
# result_naked => 1,
#};
#sub format_completion {
# my ($hcomp, $opts) = @_;
#
# $opts //= {};
#
# $hcomp = {words=>$hcomp} unless ref($hcomp) eq 'HASH';
# my $words = $hcomp->{words};
# my $as = $opts->{as} // 'string';
# # 'escmode' key is deprecated (Complete 0.11-) and will be removed later
# my $esc_mode = $opts->{esc_mode} // $ENV{COMPLETE_BASH_DEFAULT_ESC_MODE} //
# 'default';
# my $path_sep = $hcomp->{path_sep};
#
# # we keep the original words (before formatted with summaries) when we want
# # to use fzf instead of passing to bash directly
# my @words;
# my @summaries;
# my @res;
# my $has_summary;
#
# my $code_return_message = sub {
# # display a message instead of list of words. we send " " (ASCII space)
# # which bash does not display, so we can display a line of message while
# # the user does not get the message as the completion. I've also tried
# # \000 to \037 instead of space (\040) but nothing works better.
# my $msg = shift;
# if ($msg =~ /\A /) {
# $msg =~ s/\A +//;
# $msg = " (empty message)" unless length $msg;
# }
# return (sprintf("%-"._terminal_width()."s", $msg), " ");
# };
#
# FORMAT_MESSAGE:
# # display a message instead of list of words. we send " " (ASCII space)
# # which bash does not display, so we can display a line of message while the
# # user does not get the message as the completion. I've also tried \000 to
# # \037 instead of space (\040) but nothing works better.
# if (defined $hcomp->{message}) {
# @res = $code_return_message->($hcomp->{message});
# goto RETURN_RES;
# }
#
# WORKAROUND_PREVENT_BASH_FROM_INSERTING_SPACE:
# {
# last unless @$words == 1;
# if (defined $path_sep) {
# my $re = qr/\Q$path_sep\E\z/;
# my $word;
# if (ref $words->[0] eq 'HASH') {
# $words = [$words->[0], {word=>"$words->[0]{word} "}] if
# $words->[0]{word} =~ $re;
# } else {
# $words = [$words->[0], "$words->[0] "]
# if $words->[0] =~ $re;
# }
# last;
# }
#
# if ($hcomp->{is_partial} ||
# ref $words->[0] eq 'HASH' && $words->[0]{is_partial}) {
# if (ref $words->[0] eq 'HASH') {
# $words = [$words->[0], {word=>"$words->[0]{word} "}];
# } else {
# $words = [$words->[0], "$words->[0] "];
# }
# last;
# }
# }
#
# WORKAROUND_WITH_WORDBREAKS:
# # this is a workaround. since bash breaks words using characters in
# # $COMP_WORDBREAKS, which by default is "'@><=;|&(: this presents a problem
# # we often encounter: if we want to provide with a list of strings
# # containing say ':', most often Perl modules/packages, if user types e.g.
# # "Text::AN" and we provide completion ["Text::ANSI"] then bash will change
# # the word at cursor to become "Text::Text::ANSI" since it sees the current
# # word as "AN" and not "Text::AN". the workaround is to chop /^Text::/ from
# # completion answers. btw, we actually chop /^text::/i to handle
# # case-insensitive matching, although this does not have the ability to
# # replace the current word (e.g. if we type 'text::an' then bash can only
# # replace the current word 'an' with 'ANSI).
# {
# last unless $opts->{workaround_with_wordbreaks} // 1;
# last unless defined $opts->{word};
#
# if ($opts->{word} =~ s/(.+[\@><=;|&\(:])//) {
# my $prefix = $1;
# for (@$words) {
# if (ref($_) eq 'HASH') {
# $_->{word} =~ s/\A\Q$prefix\E//i;
# } else {
# s/\A\Q$prefix\E//i;
# }
# }
# }
# }
#
# ESCAPE_WORDS:
# for my $entry (@$words) {
# my $word = ref($entry) eq 'HASH' ? $entry->{word} : $entry;
# my $summary = (ref($entry) eq 'HASH' ? $entry->{summary} : undef) // '';
# if ($esc_mode eq 'shellvar') {
# # escape $ also
# $word =~ s!([^A-Za-z0-9,+._/:~-])!\\$1!g;
# } elsif ($esc_mode eq 'none') {
# # no escaping
# } else {
# # default
# $word =~ s!([^A-Za-z0-9,+._/:\$~-])!\\$1!g;
# }
# push @words, $word;
# push @summaries, $summary;
# $has_summary = 1 if length $summary;
# }
#
# my $summary_align = $ENV{COMPLETE_BASH_SUMMARY_ALIGN} // 'left';
# my $max_columns = $ENV{COMPLETE_BASH_MAX_COLUMNS} // 0;
# my $terminal_width = _terminal_width();
# my $column_width = _column_width($terminal_width, $max_columns);
#
# #warn "terminal_width=$terminal_width, column_width=".($column_width // 'undef')."\n";
#
# FORMAT_SUMMARIES: {
# @res = @words;
# last if @words <= 1;
# last unless $has_summary;
# last unless $opts->{show_summaries} //
# $ENV{COMPLETE_BASH_SHOW_SUMMARIES} // 1;
# my $max_entry_width = 8;
# my $max_summ_width = 0;
# for (0..$#words) {
# $max_entry_width = length $words[$_]
# if $max_entry_width < length $words[$_];
# $max_summ_width = length $summaries[$_]
# if $max_summ_width < length $summaries[$_];
# }
# #warn "max_entry_width=$max_entry_width, max_summ_width=$max_summ_width\n";
# if ($summary_align eq 'right') {
# # if we are aligning summary to the right, we want to fill column
# # width width
# if ($max_columns <= 0) {
# $max_columns = _num_columns(
# $terminal_width, ($max_entry_width + 2 + $max_summ_width));
# }
# $column_width = _column_width($terminal_width, $max_columns);
# my $new_max_summ_width = $column_width - 2 - $max_entry_width;
# $max_summ_width = $new_max_summ_width
# if $max_summ_width < $new_max_summ_width;
# #warn "max_columns=$max_columns, column_width=$column_width, max_summ_width=$max_summ_width\n";
# }
#
# for (0..$#words) {
# my $summary = $summaries[$_];
# if (length $summary) {
# $res[$_] = sprintf(
# "%-${max_entry_width}s |%".
# ($summary_align eq 'right' ? $max_summ_width : '')."s",
# $words[$_], $summary);
# }
# }
# } # FORMAT_SUMMARIES
#
# MAX_COLUMNS: {
# last unless $max_columns > 0;
# my $max_entry_width = 0;
# for (@res) {
# $max_entry_width = length if $max_entry_width < length;
# }
script/gen-generic-ind-company-names view on Meta::CPAN
#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
#as what you get from bash in C<COMP_LINE> environment variable) into words. This
#makes it easy for the other functions to generate completion answer. See the
#documentation for that function for more details.
#
#C<format_completion()> is what you use to format completion answer structure for
#bash.
#
#=head1 FUNCTIONS
#
#
#=head2 format_completion
#
#Usage:
#
# format_completion($completion, $opts) -> str|array
#
#Format completion for output (for shell).
#
#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 C<Complete>
#POD. Aside from C<words>, this function also recognizes these keys:
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$completion>* => I<hash|array>
#
#Completion answer structure.
#
#Either an array or hash. See function description for more details.
#
#=item * B<$opts> => I<hash>
#
#Specify options.
#
#Known options:
#
#=over
#
#=item * as
#
#Either C<string> (the default) or C<array> (to return array of lines instead of
#the lines joined together). Returning array is useful if you are doing
#completion inside C<Term::ReadLine>, for example, where the library expects an
#array.
#
#=item * esc_mode
#
#Escaping mode for entries. Either C<default> (most nonalphanumeric characters
#will be escaped), C<shellvar> (like C<default>, but dollar sign C<$> will also be
#escaped, convenient when completing environment variables for example),
#C<filename> (currently equals to C<default>), C<option> (currently equals to
#C<default>), or C<none> (no escaping will be done).
#
#=item * word
#
#A workaround. String. For now, see source code for more details.
#
#=item * show_summaries
#
#Whether to show item's summaries. Boolean, default is from
#COMPLETE_BASH_SHOW_SUMMARIES environment variable or 1.
#
#An answer item contain summary, which is a short description about the item,
#e.g.:
#
# [{word=>"-a" , summary=>"Show hidden files"},
# {word=>"-l" , summary=>"Show details"},
# {word=>"--sort", summary=>"Specify sort order"}],
#
#When summaries are not shown, user will just be seeing something like:
#
# -a
# -l
# --sort
#
#But when summaries are shown, user will see:
#
# -a -- Show hidden files
# -l -- Show details
# --sort -- Specify sort order
#
#which is quite helpful.
#
#=item * workaround_with_wordbreaks
#
#Boolean. Default is true. See source code for more details.
#
#=back
#
#
#=back
#
#Return value: Formatted string (or array, if `as` is set to `array`) (str|array)
#
#
#
#=head2 join_wordbreak_words
#
#Usage:
#
# join_wordbreak_words() -> [status, msg, payload, meta]
#
#Post-process parse_cmdline() result by joining some words.
#
#C<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 C<:>, C<@> to be part of word. So this
#routine will convert the above into:
#
# ["command", "--module=Data::Dump", 'bob@example.org']
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value: (any)
#
#
#
#=head2 parse_cmdline
#
#Usage:
#
# parse_cmdline($cmdline, $point, $opts) -> array
#
#Parse shell command-line for processing by completion routines.
#
#This function basically converts C<COMP_LINE> (str) and C<COMP_POINT> (int) into
#something like (but not exactly the same as) C<COMP_WORDS> (array) and
#C<COMP_CWORD> (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's C<COMP_WORDS> contains all the
# quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
# parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
# bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
# which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
# for the current word (C<COMP_WORDS[COMP_CWORD]>) (bash does not perform
# variable substitution for C<COMP_WORDS>). However, note that special shell
# variables that are not environment variables like C<$0>, C<$_>, C<$IFS> will not
# be replaced correctly because bash does not export those variables for us.
#
#4) tildes (C<~>) are expanded with user's home directory except for the current
# word (bash does not perform tilde expansion for C<COMP_WORDS>);
#
#Caveats:
#
#=over
#
#=item * Like bash, we group non-whitespace word-breaking characters into its own word.
#By default C<COMP_WORDBREAKS> is:
#
#"'@><=;|&(:
#
#So if raw command-line is:
#
#command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
#then the parse result will be:
#
#["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
#which is annoying sometimes. But we follow bash here so we can more easily
#accept input from a joined C<COMP_WORDS> if we write completion bash functions,
#e.g. (in the example, C<foo> is a Perl script):
#
#I<foo ()
#{
# local words=(${COMP>CWORDS[@]})
# # add things to words, etc
# local point=... # calculate the new point
# COMPREPLY=( C<COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo> )
#}
#
#To avoid these word-breaking characters to be split/grouped, we can escape
#them with backslash or quote them, e.g.:
#
#command "http://example.com:80" Foo\:\:Bar
#
#which bash will parse as:
#
#["command", "\"http://example.com:80\"", "Foo\:\:Bar"]
#
#and we parse as:
#
#["command", "http://example.com:80", "Foo::Bar"]
#
#=item * Due to the way bash parses the command line (see above), the two below are
#equivalent:
#
#% cmd --foo=bar
#% cmd --foo = bar
#
#=back
#
#Because they both expand to C<['--foo', '=', 'bar']>. But obviously
#L<Getopt::Long> does not regard the two as equivalent.
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line, defaults to COMP_LINE environment.
#
#=item * B<$opts> => I<hash>
#
#Options.
#
#Optional. Known options:
#
#=over
#
#=item * C<truncate_current_word> (bool). If set to 1, will truncate current word to the
#position of cursor, for example (C<^> marks the position of cursor):
#C<--vers^oo> to C<--vers> instead of C<--versoo>. This is more convenient when
#doing tab completion.
#
#=back
#
#=item * B<$point> => I<int>
#
#PointE<sol>position to complete in command-line, defaults to COMP_POINT.
#
#
#=back
#
#Return value: (array)
#
#
#Return a 2-element array: C<[$words, $cword]>. C<$words> is array of str,
#equivalent to C<COMP_WORDS> provided by bash to shell functions. C<$cword> is an
#integer, roughly equivalent to C<COMP_CWORD> provided by bash to shell functions.
#The word to be completed is at C<< $words-E<gt>[$cword] >>.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in C<@ARGV>), you need to strip the first element from
#C<$words> and reduce C<$cword> by 1.
#
#
#
#=head2 point
#
#Usage:
#
# point($cmdline, $marker) -> any
#
#Return line with point marked by a marker.
#
#This is a utility function useful for testing/debugging. C<parse_cmdline()>
#expects a command-line and a cursor position (C<$line>, C<$point>). This routine
#expects C<$line> with a marker character (by default it's the caret, C<^>) and
#return (C<$line>, C<$point>) to feed to C<parse_cmdline()>.
#
#Example:
#
# point("^foo") # => ("foo", 0)
# point("fo^o") # => ("foo", 2)
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line which contains a marker character.
#
#=item * B<$marker> => I<str> (default: "^")
#
#Marker character.
#
#
#=back
#
#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,
# COL_V_COMMENT_CHAR => 4,
# COL_V_COMMENT => 5,
#};
#
#sub new {
# my ($class, %attrs) = @_;
# $attrs{default_section} //= 'GLOBAL';
# $attrs{allow_bang_only} //= 1;
# $attrs{allow_duplicate_key} //= 1;
# $attrs{enable_directive} //= 1;
# $attrs{enable_encoding} //= 1;
# $attrs{enable_quoting} //= 1;
# $attrs{enable_bracket} //= 1;
# $attrs{enable_brace} //= 1;
# $attrs{enable_tilde} //= 1;
# $attrs{enable_expr} //= 0;
# $attrs{expr_vars} //= {};
# $attrs{ignore_unknown_directive} //= 0;
# # allow_encodings
# # disallow_encodings
# # allow_directives
# # disallow_directives
# bless \%attrs, $class;
#}
#
## borrowed from Parse::CommandLine. differences: returns arrayref. return undef
## on error (instead of dying).
#sub _parse_command_line {
# my ($self, $str) = @_;
#
# $str =~ s/\A\s+//ms;
# $str =~ s/\s+\z//ms;
#
# my @argv;
# my $buf;
# my $escaped;
# my $double_quoted;
# my $single_quoted;
#
# for my $char (split //, $str) {
# if ($escaped) {
# $buf .= $char;
# $escaped = undef;
# next;
# }
#
# if ($char eq '\\') {
# if ($single_quoted) {
# $buf .= $char;
# }
# else {
# $escaped = 1;
# }
# next;
# }
#
# if ($char =~ /\s/) {
# if ($single_quoted || $double_quoted) {
# $buf .= $char;
# }
# else {
# push @argv, $buf if defined $buf;
# undef $buf;
# }
# next;
# }
#
script/gen-generic-ind-company-names view on Meta::CPAN
#=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
#refer to the already mentioned key.
#
#Code will be compiled using Perl's C<eval()> in the
#C<Config::IOD::Expr::_Compiled> namespace, with C<no strict>, C<no warnings>.
#
#=for END_BLOCK: expression
#
#=head1 ATTRIBUTES
#
#=for BEGIN_BLOCK: attributes
#
#=head2 default_section => str (default: C<GLOBAL>)
#
#If a key line is specified before any section line, this is the section that the
#key will be put in.
#
#=head2 enable_directive => bool (default: 1)
#
#If set to false, then directives will not be parsed. Lines such as below will be
#considered a regular comment:
#
# ;!include foo.ini
#
#and lines such as below will be considered a syntax error (B<regardless> of the
#C<allow_bang_only> setting):
#
# !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
# c=3
# a=10
#
#In traditional INI file, to specify an array you specify multiple keys. But when
#there is only a single key, it is unclear if the value is a single-element array
#or a scalar. You can use this setting to avoid this array/scalar ambiguity in
#config file and force user to use JSON encoding or bracket to specify array:
#
# [section]
# a=[1,2]
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 ignore_unknown_directive => bool (default: 0)
#
#If set to true, will not die if an unknown directive is encountered. It will
#simply be ignored as a regular comment.
#
#B<NOTE: Turning this setting on violates IOD specification.>
#
#=for END_BLOCK: attributes
#
#=head1 METHODS
#
#=for BEGIN_BLOCK: methods
#
#=head2 new(%attrs) => obj
#
#=head2 $reader->read_file($filename)
#
#Read IOD configuration from a file. Die on errors.
#
#=head2 $reader->read_string($str)
#
#Read IOD configuration from a string. Die on errors.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Config-IOD-Reader>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Config-IOD-Reader>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Config-IOD-Reader>
#
#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 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2017, 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/Reader.pm ###
#package Config::IOD::Reader;
#
#our $DATE = '2019-01-17'; # DATE
#our $VERSION = '0.342'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Config::IOD::Base);
#
#sub _merge {
# my ($self, $section) = @_;
#
# my $res = $self->{_res};
# for my $msect (@{ $self->{_merge} }) {
# if ($msect eq $section) {
# # ignore merging self
# next;
# #local $self->{_linum} = $self->{_linum}-1;
# #$self->_err("Can't merge section '$msect' to '$section': ".
# # "Same section");
# }
# if (!exists($res->{$msect})) {
# local $self->{_linum} = $self->{_linum}-1;
# $self->_err("Can't merge section '$msect' to '$section': ".
# "Section '$msect' not seen yet");
# }
# for my $k (keys %{ $res->{$msect} }) {
# $res->{$section}{$k} //= $res->{$msect}{$k};
# }
# }
#}
#
#sub _init_read {
# my $self = shift;
#
# $self->SUPER::_init_read;
# $self->{_res} = {};
# $self->{_merge} = undef;
# $self->{_num_seen_section_lines} = 0;
# $self->{_cur_section} = $self->{default_section};
# $self->{_arrayified} = {};
#}
#
#sub _read_string {
# my ($self, $str, $cb) = @_;
#
# my $res = $self->{_res};
# my $cur_section = $self->{_cur_section};
#
# my $directive_re = $self->{allow_bang_only} ?
# qr/^;?\s*!\s*(\w+)\s*/ :
# qr/^;\s*!\s*(\w+)\s*/;
#
# my $_raw_val; # only to provide to callback
#
# my @lines = split /^/, $str;
# local $self->{_linum} = 0;
# LINE:
# for my $line (@lines) {
# $self->{_linum}++;
#
# # blank line
# if ($line !~ /\S/) {
# next LINE;
# }
#
# # directive line
# if ($self->{enable_directive} && $line =~ s/$directive_re//) {
# my $directive = $1;
# if ($self->{allow_directives}) {
# $self->_err("Directive '$directive' is not in ".
# "allow_directives list")
# unless grep { $_ eq $directive }
# @{$self->{allow_directives}};
# }
# if ($self->{disallow_directives}) {
# $self->_err("Directive '$directive' is in ".
# "disallow_directives list")
# if grep { $_ eq $directive }
# @{$self->{disallow_directives}};
# }
# my $args = $self->_parse_command_line($line);
# if (!defined($args)) {
# $self->_err("Invalid arguments syntax '$line'");
# }
#
# if ($cb) {
# $cb->(
# event => 'directive',
# linum=>$self->{_linum}, line=>$line, cur_section=>$self->{_cur_section},
# directive => $directive,
# args => $args,
# );
# }
#
# if ($directive eq 'include') {
# my $path;
# if (! @$args) {
# $self->_err("Missing filename to include");
# } elsif (@$args > 1) {
script/gen-generic-ind-company-names view on Meta::CPAN
# $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
#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
#refer to the already mentioned key.
#
#Code will be compiled using Perl's C<eval()> in the
#C<Config::IOD::Expr::_Compiled> namespace, with C<no strict>, C<no warnings>.
#
#=head1 ATTRIBUTES
#
#=head2 default_section => str (default: C<GLOBAL>)
#
#If a key line is specified before any section line, this is the section that the
#key will be put in.
#
#=head2 enable_directive => bool (default: 1)
#
#If set to false, then directives will not be parsed. Lines such as below will be
#considered a regular comment:
#
# ;!include foo.ini
#
#and lines such as below will be considered a syntax error (B<regardless> of the
#C<allow_bang_only> setting):
#
# !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
# c=3
# a=10
#
#In traditional INI file, to specify an array you specify multiple keys. But when
#there is only a single key, it is unclear if the value is a single-element array
#or a scalar. You can use this setting to avoid this array/scalar ambiguity in
#config file and force user to use JSON encoding or bracket to specify array:
#
# [section]
# a=[1,2]
#
#B<NOTE: Turning this setting off violates IOD specification.>
#
#=head2 ignore_unknown_directive => bool (default: 0)
#
#If set to true, will not die if an unknown directive is encountered. It will
#simply be ignored as a regular comment.
#
#B<NOTE: Turning this setting on violates IOD specification.>
#
#=head1 METHODS
#
#=head2 new(%attrs) => obj
#
#=head2 $reader->read_file($filename[ , $callback ]) => hash
#
#Read IOD configuration from a file. Die on errors.
#
#See C<read_string> for more information on C<$callback> argument.
#
#=head2 $reader->read_string($str[ , $callback ]) => hash
#
#Read IOD configuration from a string. Die on errors.
#
#C<$callback> is an optional coderef argument that will be called during various
#stages. It can be useful if you want more information (especially ordering). It
#will be called with hash argument C<%args>
#
#=over
#
#=item * Found a directive line
#
#Arguments passed: C<event> (str, has the value of 'directive'), C<linum> (int,
#line number, starts from 1), C<line> (str, raw line), C<directive> (str,
#directive name), C<cur_section> (str, current section name), C<args> (array,
#directive arguments).
#
#=item * Found a comment line
#
#Arguments passed: C<event> (str, 'comment'), C<linum>, C<line>, C<cur_section>.
#
#=item * Found a section line
#
#Arguments passed: C<event> (str, 'section'), C<linum>, C<line>, C<cur_section>,
#C<section> (str, section name).
#
#=item * Found a key line
#
#Arguments passed: C<event> (str, 'section'), C<linum>, C<line>, C<cur_section>,
#C<key> (str, key name), C<val> (any, value name, already decoded if encoded),
#C<raw_val> (str, raw value).
#
#=back
#
#TODO: callback when there is merging.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Config-IOD-Reader>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Config-IOD-Reader>.
#
script/gen-generic-ind-company-names view on Meta::CPAN
#}
#
#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:
#
# is_aoh([]); # true
# is_aoh([{}, {a=>1}]); # true
# is_aoh([{}, 'a']); # false
# is_aoh([{},{},{a=>1}, 'a'], {max=>3}); # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
#
#=head2 is_aohos($data[, \%opts]) => bool
#
#Check that data is an array of hashes of scalars. Examples:
#
# is_aohos([]); # true
# is_aohos([{a=>1}, {}]); # true
# is_aohos([{a=>1}, {b=>[]}]); # false
# is_aohos([{a=>1},{},{}, {b=>[]}], {max=>3}); # true
#
#Known options: C<max> (maximum number of items to check, undef means check all
#items).
script/gen-generic-ind-company-names view on Meta::CPAN
# # 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:
#
# @ARGV = grep { /^--([^=]+)(=(.*))?/ ? ($opts{$1} = $2 ? $3 : 1, 0) : 1 } @ARGV;
#
#and you're already able to extract C<--flag> or C<--opt=val> from C<@ARGV> but
#you also lose a lot of stuffs like autoabbreviation, C<--opt val> syntax support
#syntax (which is more common, but requires you specify an option spec), custom
#destination, etc.
#
#=head1 FUNCTIONS
#
#=head2 Configure(@configs | \%config) => hash
#
#Set configuration. Known configurations:
#
#=over
#
#=item * pass_through
#
#Ignore errors (unknown/ambiguous option) and still make GetOptions return true.
#
#=item * no_pass_through (default)
#
#=item * no_auto_abbrev
#
#=item * auto_abbrev (default)
#
#=item * no_ignore_case
#
#=item * no_getopt_compat
#
#=item * gnu_compat
#
#=item * bundling
#
#=item * permute
#
#=back
#
#Return old configuration data. To restore old configuration data you can pass it
#back to C<Configure()>, e.g.:
#
# my $orig_conf = Getopt::Long::EvenLess::Configure("pass_through");
# # ...
# Getopt::Long::EvenLess::Configure($orig_conf);
#
#=head2 GetOptions(%spec) => bool
#
#Shortcut for:
#
# GetOptionsFromArray(\@ARGV, %spec)
#
#=head2 GetOptionsFromArray(\@ary, %spec) => bool
#
#Get (and strip) options from C<@ary>. Return true on success or false on failure
#(unknown option, etc).
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Getopt-Long-EvenLess>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Getopt-Long-EvenLess>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Getopt-Long-EvenLess>
#
#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<Getopt::Long>
#
#L<Getopt::Long::Less>
#
#If you want I<more> features intead of less, try L<Getopt::Long::More>.
#
#Benchmarks in L<Bencher::Scenario::GetoptModules>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2017, 2016, 2015 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
### 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->{"num_names"}) { return [400, "You specified --num-names but also argument #0"]; } else { $args->{"num_names"} = delete($ARGV[0]); } }
# }
# my @check_argv = @ARGV;
# # fill from cmdline_src
#
# # fill defaults from "default" property and check against schema
# no warnings ('void');
# require Scalar::Util::Numeric::PP;
# my $_sahv_dpath;
# my $_sahv_err;
# $args->{"add_prefixes"} //= 1;
# if (exists $args->{"add_prefixes"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"add_prefixes"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'bool'
# ((!ref($args->{"add_prefixes"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
# $args->{"add_suffixes"} //= 1;
# if (exists $args->{"add_suffixes"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"add_suffixes"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'bool'
# ((!ref($args->{"add_suffixes"})) ? 1 : (($_sahv_err //= "Not of type boolean value"),0))
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
# if (exists $args->{"desired_initials"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"desired_initials"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'str'
# ((!ref($args->{"desired_initials"})) ? 1 : (($_sahv_err //= "Not of type text"),0))
#
# &&
#
# (# clause: match
# (($args->{"desired_initials"} =~ qr((?:(?-)\A[A-Za-z]+\z))) ? 1 : (($_sahv_err //= "Must match regex pattern qr(\\A[A-Za-z]+\\z)"),0)))
#
# &&
#
# (# clause: min_len
# ((length($args->{"desired_initials"}) >= 1) ? 1 : (($_sahv_err //= "Length must be at least 1"),0)))
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
# $args->{"num_names"} //= 1;
# if (exists $args->{"num_names"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"num_names"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'int'
# ((Scalar::Util::Numeric::PP::isint($args->{"num_names"})) ? 1 : (($_sahv_err //= "Not of type integer"),0))
#
script/gen-generic-ind-company-names view on Meta::CPAN
# elsif ($ref) { $_ = $ref; $ref = "" }
#}
#$data
#}
#;; $cleanser->(shift) }
#1;
### Log/ger.pm ###
#package Log::ger;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2021-01-31'; # DATE
#our $DIST = 'Log-ger'; # DIST
#our $VERSION = '0.038'; # VERSION
#
##IFUNBUILT
## use strict 'subs', 'vars';
## use warnings;
##END IFUNBUILT
#
#our $re_addr = qr/\(0x([0-9a-f]+)/o;
#
#our %Levels = (
# fatal => 10,
# error => 20,
# warn => 30,
# info => 40,
# debug => 50,
# trace => 60,
#);
#
#our %Level_Aliases = (
# off => 0,
# warning => 30,
#);
#
#our $Current_Level = 30;
#
#our $Caller_Depth_Offset = 0;
#
## a flag that can be used by null output to skip using formatter
#our $_outputter_is_null;
#
#our $_dumper;
#
#our %Global_Hooks;
#
## in Log/ger/Heavy.pm
## our %Default_Hooks = (
#
#our %Package_Targets; # key = package name, value = \%per_target_conf
#our %Per_Package_Hooks; # key = package name, value = { phase => hooks, ... }
#
#our %Hash_Targets; # key = hash address, value = [$hashref, \%per_target_conf]
#our %Per_Hash_Hooks; # key = hash address, value = { phase => hooks, ... }
#
#our %Object_Targets; # key = object address, value = [$obj, \%per_target_conf]
#our %Per_Object_Hooks; # key = object address, value = { phase => hooks, ... }
#
#my $sub0 = sub {0};
#my $sub1 = sub {1};
#my $default_null_routines;
#
#sub install_routines {
# my ($target, $target_arg, $routines, $name_routines) = @_;
#
# 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.
#
script/gen-generic-ind-company-names view on Meta::CPAN
#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 => {},
#};
#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}) {
# $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};
script/gen-generic-ind-company-names view on Meta::CPAN
#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>
#
#=item * B<common_opts> => I<any>
#
#=item * B<config> => I<any>
#
#=item * B<config_profile> => I<any>
#
#=item * B<meta> => I<any>
#
#=item * B<meta_is_normalized> => I<any>
#
#=item * B<plugins> => I<array>
#
#=item * B<r> => I<any>
#
#=item * B<subcommand_name> => I<any>
#
#
#=back
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value: (any)
#
#
#
#=head2 get_default_config_dirs
#
#Usage:
#
# get_default_config_dirs() -> [status, msg, payload, meta]
#
#This function is not exported by default, but exportable.
#
#No arguments.
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value: (any)
#
#
#
#=head2 read_config
#
#Usage:
#
# read_config(%args) -> [status, msg, payload, meta]
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<config_dirs> => I<any>
#
#=item * B<config_filename> => I<any>
#
#=item * B<config_paths> => I<any>
#
#=item * B<hook_section> => I<any>
#
#=item * B<program_name> => I<any>
#
#
#=back
#
#Returns an enveloped result (an array).
#
#First element (status) is an integer containing HTTP status code
#(200 means OK, 4xx caller error, 5xx function error). Second element
#(msg) is a string containing error message, or 'OK' if status is
#200. Third element (payload) is optional, the actual result. Fourth
#element (meta) is called result metadata and is optional, a hash
#that contains extra information.
#
#Return value: (any)
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Perinci-CmdLine-Util-Config>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Perinci-CmdLine-Util-Config>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-CmdLine-Util-Config>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 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/Result/Format/Lite.pm ###
#package Perinci::Result::Format::Lite;
#
script/gen-generic-ind-company-names view on Meta::CPAN
#
# # find column orders from table spec
# $column_orders = $resmeta->{'table.fields'};
# }
#
# # reorder each row according to requested column order
# if ($column_orders) {
# require Sort::BySpec;
# my $cmp = Sort::BySpec::cmp_by_spec(spec => $column_orders);
# # 0->2, 1->0, ... (map column position from unordered to ordered)
# my @map0 = sort { $cmp->($a->[1], $b->[1]) }
# map {[$_, $columns[$_]]} 0..$#columns;
# #use DD; dd \@map0;
# my @map;
# for (0..$#map0) {
# $map[$_] = $map0[$_][0];
# }
# #use DD; dd \@map;
# my $newdata = [];
# for my $row (@$data) {
# my @newrow;
# for (0..$#map) { $newrow[$_] = $row->[$map[$_]] }
# push @$newdata, \@newrow;
# }
# $data = $newdata;
# my @newcolumns;
# for (@map) { push @newcolumns, $columns[$_] }
# @columns = @newcolumns;
# }
#
# my @field_idxs; # map column to index in table.fields
# {
# my $tff = $resmeta->{'table.fields'} or last;
# for my $i (0..$#columns) {
# $field_idxs[$i] = firstidx { $_ eq $columns[$i] } @$tff;
# }
# }
#
# # determine field labels
# {
# last unless $header_row && @$data;
# my $tff = $resmeta->{'table.fields'} or last;
# my $tfl = $resmeta->{'table.field_labels'};
# my $tfu = $resmeta->{'table.field_units'};
# for my $i (0..$#columns) {
# my $field_idx = $field_idxs[$i];
# next unless $field_idx >= 0;
# if ($tfl && defined $tfl->[$field_idx]) {
# $data->[0][$i] = $tfl->[$field_idx];
# } elsif ($tfu && defined $tfu->[$field_idx]) {
# # add field units as label suffix to header (" (UNIT)")
# $data->[0][$i] .= " ($tfu->[$field_idx])";
# }
# }
# }
#
# FORMAT_CELLS:
# {
# my $tffmt = $resmeta->{'table.field_formats'};
# my $tffmt_code = $resmeta->{'table.field_format_code'};
# my $tffmt_default = $resmeta->{'table.default_field_format'};
# last unless $tffmt || $tffmt_code || $tffmt_default;
#
# my (@fmt_names, @fmt_opts); # key: column index
# for my $i (0..$#columns) {
# my $field_idx = $field_idxs[$i];
# my $fmt = $tffmt_code ? $tffmt_code->($columns[$i]) : undef;
# $fmt //= $tffmt->[$field_idx] if $field_idx >= 0;
# $fmt //= $tffmt_default;
# if (ref $fmt eq 'ARRAY') {
# $fmt_names[$i] = $fmt->[0];
# $fmt_opts [$i] = $fmt->[1] // {};
# } else {
# $fmt_names[$i] = $fmt;
# $fmt_opts [$i] = {};
# }
# }
#
# my $nf;
#
# for my $i (0..$#{$data}) {
# next if $i==0 && $header_row;
# my $row = $data->[$i];
# for my $j (0..$#columns) {
# next unless defined $row->[$j];
# my $fmt_name = $fmt_names[$j];
# #say "D:j=$j fmt_name=$fmt_name";
# next unless $fmt_name;
# my $fmt_opts = $fmt_opts [$j];
# if ($fmt_name eq 'iso8601_datetime' || $fmt_name eq 'iso8601_date') {
# if ($row->[$j] =~ /\A[0-9]+(\.[0-9]*)?\z/) {
# my $frac = $1 ? "0$1"+0 : 0;
# my @t = gmtime($row->[$j]);
# if ($fmt_name eq 'iso8601_datetime') {
# $row->[$j] = sprintf(
# "%04d-%02d-%02dT%02d:%02d:".($frac ? "%06.3f" : "%02d")."Z",
# $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]+$frac);
# } else {
# $row->[$j] = sprintf(
# "%04d-%02d-%02d",
# $t[5]+1900, $t[4]+1, $t[3]);
# }
# }
# } elsif ($fmt_name eq 'boolstr') {
# $row->[$j] = $row->[$j] ? "yes" : "no";
# } elsif ($fmt_name eq 'filesize') {
# require Format::Human::Bytes;
# $row->[$j] = Format::Human::Bytes::base2($row->[$j], 0);
# } elsif ($fmt_name eq 'sci2dec') {
# if ($row->[$j] =~ /\A(?:[+-]?)(?:\d+\.|\d*\.(\d+))[eE]([+-]?\d+)\z/) {
# my $n = length($1 || "") - $2; $n = 0 if $n < 0;
# $row->[$j] = sprintf("%.${n}f", $row->[$j]);
# }
# } elsif ($fmt_name eq 'percent') {
# my $fmt = $fmt_opts->{sprintf} // '%.2f%%';
# $row->[$j] = sprintf($fmt, $row->[$j] * 100);
# } elsif ($fmt_name eq 'number') {
# require Number::Format::BigFloat;
# $row->[$j] = Number::Format::BigFloat::format_number(
# $row->[$j], {
# thousands_sep => $fmt_opts->{thousands_sep} // ',',
# decimal_point => $fmt_opts->{decimal_point} // '.',
# decimal_digits => $fmt_opts->{precision} // 0,
# # XXX decimal_fill
# });
# }
# }
# }
# }
#
# if ($format eq 'text-pretty') {
# ALIGN_COLUMNS:
# {
# # XXX we just want to turn off 'uninitialized' and 'negative repeat
# # count does nothing' from the operator x
# no warnings;
#
# my $tfa = $resmeta->{'table.field_aligns'};
# my $tfa_code = $resmeta->{'table.field_align_code'};
# my $tfa_default = $resmeta->{'table.default_field_align'};
# last unless $tfa || $tfa_code || $tfa_default;
# last unless @$data;
#
# for my $colidx (0..$#columns) {
# my $field_idx = $field_idxs[$colidx];
# my $align = $tfa_code ? $tfa_code->($columns[$colidx]) : undef;
# $align //= $tfa->[$field_idx] if $field_idx >= 0;
# $align //= $tfa_default;
# next unless $align;
#
# # determine max widths
# my $maxw;
# my ($maxw_bd, $maxw_d, $maxw_ad); # before digit, digit, after d
# if ($align eq 'number') {
# my (@w_bd, @w_d, @w_ad);
# for my $i (0..$#{$data}) {
# my $row = $data->[$i];
# if (@$row > $colidx) {
# my $cell = $row->[$colidx];
# if ($header_row && $i == 0) {
# my $w = length($cell);
# push @w_bd, 0;
# push @w_bd, 0;
# push @w_ad, 0;
# } elsif ($cell =~ /\A([+-]?\d+)(\.?)(\d*)\z/) {
# # decimal notation number
# push @w_bd, length($1);
# push @w_d , length($2);
# push @w_ad, length($3);
# } elsif ($cell =~ /\A([+-]?\d+\.?\d*)([eE])([+-]?\d+)\z/) {
# # scientific notation number
# push @w_bd, length($1);
# push @w_d , length($2);
# push @w_ad, length($3);
# } else {
# # not a number
# push @w_bd, length($cell);
# push @w_bd, 0;
# push @w_ad, 0;
# }
# } else {
# push @w_bd, 0;
# push @w_d , 0;
# push @w_ad, 0;
# }
# }
# $maxw_bd = max(@w_bd);
# $maxw_d = max(@w_d);
# $maxw_ad = max(@w_ad);
# if ($header_row) {
# my $w = length($data->[0][$colidx]);
# if ($maxw_d == 0 && $maxw_ad == 0) {
# $maxw_bd = $w;
# }
# }
# }
#
# $maxw = max(map {
# @$_ > $colidx ? length($_->[$colidx]) : 0
# } @$data);
#
# # do the alignment
# for my $i (0..$#{$data}) {
# my $row = $data->[$i];
# for my $i (0..$#{$data}) {
# my $row = $data->[$i];
# next unless @$row > $colidx;
# my $cell = $row->[$colidx];
script/gen-generic-ind-company-names view on Meta::CPAN
# 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
#
#L<Perinci::Result::Format>, a more heavyweight version of this module.
#
#L<Perinci::CmdLine::Lite> uses this module to format enveloped result.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2021, 2020, 2018, 2017, 2016, 2015 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/Sub/Normalize.pm ###
#package Perinci::Sub::Normalize;
#
#our $DATE = '2018-09-10'; # DATE
#our $VERSION = '0.200'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# normalize_function_metadata
# );
#
#sub _normalize{
# my ($meta, $ver, $opts, $proplist, $nmeta, $prefix, $modprefix) = @_;
#
# my $opt_aup = $opts->{allow_unknown_properties};
# my $opt_nss = $opts->{normalize_sah_schemas};
script/gen-generic-ind-company-names view on Meta::CPAN
# } 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.
#
#=head1 SEE ALSO
#
#L<Rinci::function>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 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
### Sah/Schema/rinci/function_meta.pm ###
#package Sah::Schema::rinci::function_meta;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-09-23'; # DATE
#our $DIST = 'Sah-Schemas-Rinci'; # DIST
#our $VERSION = '1.1.94.0'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Data::Sah::Normalize ();
#use Sah::Schema::rinci::meta ();
#
#our $schema = [hash => {
# summary => 'Rinci function metadata',
#
# # tmp
# _ver => 1.1,
# _prop => {
# %Sah::Schema::rinci::meta::_dh_props,
#
# # from common rinci metadata
# entity_v => {},
# entity_date => {},
# links => {},
#
# is_func => {},
# is_meth => {},
# is_class_meth => {},
# args => {
# _value_prop => {
# %Sah::Schema::rinci::meta::_dh_props,
#
# # common rinci metadata
# links => {},
#
# schema => {},
# filters => {},
# default => {},
# req => {},
# pos => {},
# slurpy => {},
# greedy => {}, # old alias for slurpy, will be removed in Rinci 1.2
# partial => {},
# stream => {},
# is_password => {},
# cmdline_aliases => {
# _value_prop => {
# summary => {},
# description => {},
# schema => {},
# code => {},
# is_flag => {},
# },
# },
# cmdline_on_getopt => {},
# cmdline_prompt => {},
# completion => {},
# index_completion => {},
# element_completion => {},
# cmdline_src => {},
# meta => 'fix',
# element_meta => 'fix',
# deps => {
# _keys => {
# arg => {},
# all => {},
# any => {},
# none => {},
# },
# },
# examples => {},
# },
# },
# args_as => {},
# args_rels => {},
# result => {
# _prop => {
# %Sah::Schema::rinci::meta::_dh_props,
#
# schema => {},
# statuses => {
# _value_prop => {
# # from defhash
# summary => {},
# description => {},
# schema => {},
# },
# },
# partial => {},
# stream => {},
# },
# },
# result_naked => {},
# examples => {
# _elem_prop => {
# %Sah::Schema::rinci::meta::_dh_props,
#
# args => {},
script/gen-generic-ind-company-names view on Meta::CPAN
# }
# else {
# return $pad.$text.' ' x ($width - tty_width($text)).$pad;
# }
#}
#
#sub _calculate_widths
#{
# my $rows = shift;
# my @widths;
# foreach my $row (@$rows) {
# my @columns = @$row;
# for (my $i = 0; $i < @columns; $i++) {
# next unless defined($columns[$i]);
#
# my $width = tty_width($columns[$i]);
#
# $widths[$i] = $width if !defined($widths[$i])
# || $width > $widths[$i];
# }
# }
# return @widths;
#}
#
## Back-compat: 'table' is an alias for 'generate_table', but isn't exported
#*table = \&generate_table;
#
#1;
#
#__END__
#
#=pod
#
#=encoding utf8
#
#=head1 NAME
#
#Text::Table::Tiny - generate simple text tables from 2D arrays
#
#=head1 SYNOPSIS
#
# use Text::Table::Tiny 1.02 qw/ generate_table /;
#
# my $rows = [
# [qw/ Pokemon Type Count /],
# [qw/ Abra Psychic 5 /],
# [qw/ Ekans Poison 123 /],
# [qw/ Feraligatr Water 5678 /],
# ];
#
# print generate_table(rows => $rows, header_row => 1), "\n";
#
#
#=head1 DESCRIPTION
#
#This module provides a single function, C<generate_table>, which formats
#a two-dimensional array of data as a text table.
#It handles text that includes ANSI escape codes and wide Unicode characters.
#
#There are a number of options for adjusting the output format,
#but the intention is that the default option is good enough for most uses.
#
#The example shown in the SYNOPSIS generates the following table:
#
# +------------+---------+-------+
# | Pokemon | Type | Count |
# +------------+---------+-------+
# | Abra | Psychic | 5 |
# | Ekans | Poison | 123 |
# | Feraligatr | Water | 5678 |
# +------------+---------+-------+
#
#Support for wide characters was added in 1.02,
#so if you need that,
#you should specify that as your minimum required version,
#as per the SYNOPSIS.
#
#The interface changed with version 0.04,
#so if you use the C<generate_table()> function illustrated above,
#then you need to require at least version 0.04 of this module.
#
#Some of the options described below were added in version 1.00,
#so your best bet is to require at least version 1.00.
#
#
#=head2 generate_table()
#
#The C<generate_table> function understands a number of arguments,
#which are passed as a hash.
#The only required argument is B<rows>.
#Where arguments were not supported in the original release,
#the first supporting version is noted.
#
#If you pass an unknown argument,
#C<generate_table> will die with an error message.
#
#=over 4
#
#
#=item *
#
#rows
#
#Takes an array reference which should contain one or more rows
#of data, where each row is an array reference.
#
#
#=item *
#
#header_row
#
#If given a true value, the first row in the data will be interpreted
#as a header row, and separated from the rest of the table with a ruled line.
#
#
#=item *
#
#separate_rows
#
#If given a true value, a separator line will be drawn between every row in
#the table,
#and a thicker line will be used for the header separator.
#
#=item *
#
#top_and_tail
#
#If given a true value, then the top and bottom border lines will be skipped.
#This reduces the vertical height of the generated table.
#
#Added in 0.04.
#
#=item *
#
#align
#
#This takes an array ref with one entry per column,
#to specify the alignment of that column.
#Legal values are 'l', 'c', and 'r'.
#You can also specify a single alignment for all columns.
#ANSI escape codes are handled.
#
#Added in 1.00.
#
#=item *
#
#style
#
#Specifies the format of the output table.
#The default is C<'classic'>,
#but other options are C<'boxrule'> and C<'norule'>.
#
#If you use the C<boxrule> style,
#you'll probably need to run C<binmode(STDOUT, ':utf8')>.
#
#Added in 1.00.
#
#
#=item *
#
#indent
#
#Specify an indent that should be prefixed to every line
#of the generated table.
#This can either be a string of spaces,
#or an integer giving the number of spaces wanted.
#
#Added in 1.00.
#
#=item *
#
#compact
#
#If set to a true value then we omit the single space padding on either
#side of every column.
#
#Added in 1.00.
#
#=back
#
#
#=head2 EXAMPLES
#
#If you just pass the data and no other options:
#
# generate_table(rows => $rows);
#
#You get minimal ruling:
#
# +------------+---------+-------+
# | Pokemon | Type | Count |
# | Abra | Psychic | 5 |
# | Ekans | Poison | 123 |
# | Feraligatr | Water | 5678 |
# +------------+---------+-------+
#
#If you want a separate header, set the header_row option to a true value,
#as shown in the SYNOPSIS.
#
#To take up fewer lines,
#you can miss out the top and bottom rules,
#by setting C<top_and_tail> to a true value:
#
# generate_table(rows => $rows, header_row => 1, top_and_tail => 1);
#
#This will generate the following:
#
# | Pokemon | Type | Count |
# +------------+---------+-------+
# | Abra | Psychic | 5 |
( run in 0.726 second using v1.01-cache-2.11-cpan-97f6503c9c8 )