Acme-ID-CompanyName
view release on metacpan or search on metacpan
script/gen-generic-ind-company-names view on Meta::CPAN
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);
$data_linepos++;
last if $pos >= $data_pos;
}
seek DATA, $data_pos, 0;
\%toc;
};
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
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
script/gen-generic-ind-company-names view on Meta::CPAN
# next;
# }
# $single_quoted = !$single_quoted;
# next;
# }
#
# $buf .= $char;
# }
# push @argv, $buf if defined $buf;
#
# if ($escaped || $single_quoted || $double_quoted) {
# return undef;
# }
#
# \@argv;
#}
#
## return ($err, $res, $decoded_val)
#sub _parse_raw_value {
# my ($self, $val, $needs_res) = @_;
#
# if ($val =~ /\A!/ && $self->{enable_encoding}) {
#
# $val =~ s/!(\w+)(\s+)// or return ("Invalid syntax in encoded value");
# my ($enc, $ws1) = ($1, $2);
#
# my $res; $res = [
# "!$enc", # COL_V_ENCODING
# $ws1, # COL_V_WS1
# $1, # COL_V_VALUE
# $2, # COL_V_WS2
# $3, # COL_V_COMMENT_CHAR
# $4, # COL_V_COMMENT
# ] if $needs_res;
#
# # canonicalize shorthands
# $enc = "json" if $enc eq 'j';
# $enc = "hex" if $enc eq 'h';
# $enc = "expr" if $enc eq 'e';
#
# if ($self->{allow_encodings}) {
# return ("Encoding '$enc' is not in ".
# "allow_encodings list")
# unless grep {$_ eq $enc} @{$self->{allow_encodings}};
# }
# if ($self->{disallow_encodings}) {
# return ("Encoding '$enc' is in ".
# "disallow_encodings list")
# if grep {$_ eq $enc} @{$self->{disallow_encodings}};
# }
#
# if ($enc eq 'json') {
#
# # XXX imperfect regex for simplicity, comment should not contain
# # "]", '"', or '}' or it will be gobbled up as value by greedy regex
# # quantifier
# $val =~ /\A
# (".*"|\[.*\]|\{.*\}|\S+)
# (\s*)
# (?: ([;#])(.*) )?
# \z/x or return ("Invalid syntax in JSON-encoded value");
# my $decode_res = $self->_decode_json($val);
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($enc eq 'path' || $enc eq 'paths') {
#
# my $decode_res = $self->_decode_path_or_paths($val, $enc);
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($enc eq 'hex') {
#
# $val =~ /\A
# ([0-9A-Fa-f]*)
# (\s*)
# (?: ([;#])(.*) )?
# \z/x or return ("Invalid syntax in hex-encoded value");
# my $decode_res = $self->_decode_hex($1);
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($enc eq 'base64') {
#
# $val =~ m!\A
# ([A-Za-z0-9+/]*=*)
# (\s*)
# (?: ([;#])(.*) )?
# \z!x or return ("Invalid syntax in base64-encoded value");
# my $decode_res = $self->_decode_base64($1);
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($enc eq 'none') {
#
# return (undef, $res, $val);
#
# } elsif ($enc eq 'expr') {
#
# return ("expr is not allowed (enable_expr=0)")
# unless $self->{enable_expr};
# # XXX imperfect regex, expression can't contain # and ; because it
# # will be assumed as comment
# $val =~ m!\A
# ((?:[^#;])+?)
# (\s*)
# (?: ([;#])(.*) )?
# \z!x or return ("Invalid syntax in expr-encoded value");
# my $decode_res = $self->_decode_expr($1);
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } else {
#
# return ("unknown encoding '$enc'");
#
# }
#
# } elsif ($val =~ /\A"/ && $self->{enable_quoting}) {
#
# $val =~ /\A
script/gen-generic-ind-company-names view on Meta::CPAN
#}
#
#sub _get_my_user_name {
# if ($^O eq 'MSWin32') {
# return $ENV{USERNAME};
# } else {
# return $ENV{USER} if $ENV{USER};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[0] if @pw;
# }
#}
#
## borrowed from PERLANCAR::File::HomeDir 0.04
#sub _get_my_home_dir {
# if ($^O eq 'MSWin32') {
# # File::HomeDir always uses exists($ENV{x}) first, does it want to avoid
# # accidentally creating env vars?
# return $ENV{HOME} if $ENV{HOME};
# return $ENV{USERPROFILE} if $ENV{USERPROFILE};
# return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
# if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
# } else {
# return $ENV{HOME} if $ENV{HOME};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[7] if @pw;
# }
#
# die "Can't get home directory";
#}
#
## borrowed from PERLANCAR::File::HomeDir 0.05, with some modifications
#sub _get_user_home_dir {
# my ($name) = @_;
#
# if ($^O eq 'MSWin32') {
# # not yet implemented
# return undef;
# } else {
# # IF and only if we have getpwuid support, and the name of the user is
# # our own, shortcut to my_home. This is needed to handle HOME
# # environment settings.
# if ($name eq getpwuid($<)) {
# return _get_my_home_dir();
# }
#
# SCOPE: {
# my $home = (getpwnam($name))[7];
# return $home if $home and -d $home;
# }
#
# return undef;
# }
#
#}
#
#sub _decode_json {
# my ($self, $val) = @_;
# state $json = do {
# if (eval { require Cpanel::JSON::XS; 1 }) {
# Cpanel::JSON::XS->new->allow_nonref;
# } else {
# require JSON::PP;
# JSON::PP->new->allow_nonref;
# }
# };
# my $res;
# eval { $res = $json->decode($val) };
# if ($@) {
# return [500, "Invalid JSON: $@"];
# } else {
# return [200, "OK", $res];
# }
#}
#
#sub _decode_path_or_paths {
# my ($self, $val, $which) = @_;
#
# if ($val =~ m!\A~([^/]+)?(?:/|\z)!) {
# my $home_dir = length($1) ?
# _get_user_home_dir($1) : _get_my_home_dir();
# unless ($home_dir) {
# if (length $1) {
# return [500, "Can't get home directory for user '$1' in path"];
# } else {
# return [500, "Can't get home directory for current user in path"];
# }
# }
# $val =~ s!\A~([^/]+)?!$home_dir!;
# }
# $val =~ s!(?<=.)/\z!!;
#
# if ($which eq 'path') {
# return [200, "OK", $val];
# } else {
# return [200, "OK", [glob $val]];
# }
#}
#
#sub _decode_hex {
# my ($self, $val) = @_;
# [200, "OK", pack("H*", $val)];
#}
#
#sub _decode_base64 {
# my ($self, $val) = @_;
# require MIME::Base64;
# [200, "OK", MIME::Base64::decode_base64($val)];
#}
#
#sub _decode_expr {
# require Config::IOD::Expr;
#
# my ($self, $val) = @_;
# no strict 'refs';
# local *{"Config::IOD::Expr::_Compiled::val"} = sub {
# my $arg = shift;
# if ($arg =~ /(.+)\.(.+)/) {
# return $self->{_res}{$1}{$2};
# } else {
# return $self->{_res}{ $self->{_cur_section} }{$arg};
# }
# };
# Config::IOD::Expr::_parse_expr($val);
#}
#
#sub _err {
# my ($self, $msg) = @_;
# die join(
# "",
script/gen-generic-ind-company-names view on Meta::CPAN
#
#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;
#
script/gen-generic-ind-company-names view on Meta::CPAN
# + - .
# * / % 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
script/gen-generic-ind-company-names view on Meta::CPAN
# # check type 'int'
# ((Scalar::Util::Numeric::PP::isint($args->{"num_names"})) ? 1 : (($_sahv_err //= "Not of type integer"),0))
#
# &&
#
# (# clause: min
# (($args->{"num_names"} >= 0) ? 1 : (($_sahv_err //= "Must be at least 0"),0)))
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
# $args->{"num_words"} //= 3;
# if (exists $args->{"num_words"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"num_words"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'int'
# ((Scalar::Util::Numeric::PP::isint($args->{"num_words"})) ? 1 : (($_sahv_err //= "Not of type integer"),0))
#
# &&
#
# (# clause: min
# (($args->{"num_words"} >= 1) ? 1 : (($_sahv_err //= "Must be at least 1"),0)))
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
# $args->{"type"} //= "PT";
# if (exists $args->{"type"}) {
# $_sahv_dpath = [];
# # req #0
# ((defined($args->{"type"})) ? 1 : (($_sahv_err //= "Required but not specified"),0))
#
# &&
#
# # check type 'str'
# ((!ref($args->{"type"})) ? 1 : (($_sahv_err //= "Not of type text"),0))
# ; if ($_sahv_err) { return [400, "Argument validation failed: $_sahv_err"] }
# } # if date arg exists
#
# # check required args
# return [400, "Missing required value for argument: add_prefixes"] if exists($args->{"add_prefixes"}) && !defined($args->{"add_prefixes"});
# return [400, "Missing required value for argument: add_suffixes"] if exists($args->{"add_suffixes"}) && !defined($args->{"add_suffixes"});
# return [400, "Missing required value for argument: desired_initials"] if exists($args->{"desired_initials"}) && !defined($args->{"desired_initials"});
# return [400, "Missing required value for argument: num_names"] if exists($args->{"num_names"}) && !defined($args->{"num_names"});
# return [400, "Missing required value for argument: num_words"] if exists($args->{"num_words"}) && !defined($args->{"num_words"});
# return [400, "Missing required value for argument: type"] if exists($args->{"type"}) && !defined($args->{"type"});
# _pci_err([500, "Extraneous command-line argument(s): ".join(", ", @check_argv)]) if @check_argv;
# [200];
# } else { _pci_err([500, "Unknown subcommand1: $sc_name"]); }
#}
#1;
### Local/_pci_clean_json.pm ###
#sub _pci_clean_json { require Clone::PP; require Scalar::Util; use feature 'state'; state $cleanser = sub {
#my $data = shift;
#state %refs;
#state $ctr_circ;
#state $process_array;
#state $process_hash;
#if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { my $ref=ref($e);
# if ($ref && $refs{ $e }++) { if (++$ctr_circ <= 1) { $e = Clone::PP::clone($e); redo } else { $e = 'CIRCULAR'; $ref = '' } }
# elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $e = $e ? 1:0; $ref = '' }
# elsif ($ref eq 'DateTime') { $e = $e->epoch; $ref = ref($e) }
# elsif ($ref eq 'JSON::PP::Boolean') { $e = $e ? 1:0; $ref = '' }
# elsif ($ref eq 'JSON::XS::Boolean') { $e = $e ? 1:0; $ref = '' }
# elsif ($ref eq 'Math::BigInt') { $e = $e->bstr; $ref = ref($e) }
# elsif ($ref eq 'Regexp') { $e = "$e"; $ref = "" }
# elsif ($ref eq 'SCALAR') { $e = ${ $e }; $ref = ref($e) }
# elsif ($ref eq 'Time::Moment') { $e = $e->epoch; $ref = ref($e) }
# elsif ($ref eq 'version') { $e = "$e"; $ref = "" }
# elsif (Scalar::Util::blessed($e)) { my $reftype = Scalar::Util::reftype($e); $e = $reftype eq "HASH" ? {%{ $e }} : $reftype eq "ARRAY" ? [@{ $e }] : $reftype eq "SCALAR" ? \(my $copy = ${ $e }) : $reftype eq "CODE" ? sub { goto &{ $e } } :(die "...
# my $reftype=Scalar::Util::reftype($e)//"";
# if ($reftype eq "ARRAY") { $process_array->($e) }
# elsif ($reftype eq "HASH") { $process_hash->($e) }
# elsif ($ref) { $e = $ref; $ref = "" }
#} } }
#if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { my $ref=ref($h->{$k});
# if ($ref && $refs{ $h->{$k} }++) { if (++$ctr_circ <= 1) { $h->{$k} = Clone::PP::clone($h->{$k}); redo } else { $h->{$k} = 'CIRCULAR'; $ref = '' } }
# elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
# elsif ($ref eq 'DateTime') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
# elsif ($ref eq 'JSON::PP::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
# elsif ($ref eq 'JSON::XS::Boolean') { $h->{$k} = $h->{$k} ? 1:0; $ref = '' }
# elsif ($ref eq 'Math::BigInt') { $h->{$k} = $h->{$k}->bstr; $ref = ref($h->{$k}) }
# elsif ($ref eq 'Regexp') { $h->{$k} = "$h->{$k}"; $ref = "" }
# elsif ($ref eq 'SCALAR') { $h->{$k} = ${ $h->{$k} }; $ref = ref($h->{$k}) }
# elsif ($ref eq 'Time::Moment') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
# elsif ($ref eq 'version') { $h->{$k} = "$h->{$k}"; $ref = "" }
# elsif (Scalar::Util::blessed($h->{$k})) { my $reftype = Scalar::Util::reftype($h->{$k}); $h->{$k} = $reftype eq "HASH" ? {%{ $h->{$k} }} : $reftype eq "ARRAY" ? [@{ $h->{$k} }] : $reftype eq "SCALAR" ? \(my $copy = ${ $h->{$k} }) : $reftype eq "...
# my $reftype=Scalar::Util::reftype($h->{$k})//"";
# if ($reftype eq "ARRAY") { $process_array->($h->{$k}) }
# elsif ($reftype eq "HASH") { $process_hash->($h->{$k}) }
# elsif ($ref) { $h->{$k} = $ref; $ref = "" }
#} } }
#%refs = (); $ctr_circ=0;
#for ($data) { my $ref=ref($_);
# if ($ref && $refs{ $_ }++) { if (++$ctr_circ <= 1) { $_ = Clone::PP::clone($_); redo } else { $_ = 'CIRCULAR'; $ref = '' } }
# elsif ($ref eq 'Cpanel::JSON::XS::Boolean') { $_ = $_ ? 1:0; $ref = '' }
# elsif ($ref eq 'DateTime') { $_ = $_->epoch; $ref = ref($_) }
# elsif ($ref eq 'JSON::PP::Boolean') { $_ = $_ ? 1:0; $ref = '' }
# elsif ($ref eq 'JSON::XS::Boolean') { $_ = $_ ? 1:0; $ref = '' }
# elsif ($ref eq 'Math::BigInt') { $_ = $_->bstr; $ref = ref($_) }
# elsif ($ref eq 'Regexp') { $_ = "$_"; $ref = "" }
# elsif ($ref eq 'SCALAR') { $_ = ${ $_ }; $ref = ref($_) }
# elsif ($ref eq 'Time::Moment') { $_ = $_->epoch; $ref = ref($_) }
# elsif ($ref eq 'version') { $_ = "$_"; $ref = "" }
# elsif (Scalar::Util::blessed($_)) { my $reftype = Scalar::Util::reftype($_); $_ = $reftype eq "HASH" ? {%{ $_ }} : $reftype eq "ARRAY" ? [@{ $_ }] : $reftype eq "SCALAR" ? \(my $copy = ${ $_ }) : $reftype eq "CODE" ? sub { goto &{ $_ } } :(die "...
# my $reftype=Scalar::Util::reftype($_)//"";
# if ($reftype eq "ARRAY") { $process_array->($_) }
# elsif ($reftype eq "HASH") { $process_hash->($_) }
# elsif ($ref) { $_ = $ref; $ref = "" }
#}
#$data
#}
#;; $cleanser->(shift) }
#1;
### Log/ger.pm ###
#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, ... }
script/gen-generic-ind-company-names view on Meta::CPAN
#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;
#
#our $DATE = '2021-03-08'; # DATE
#our $VERSION = '0.279'; # VERSION
#
#use 5.010001;
##IFUNBUILT
## use strict;
## use warnings;
##END IFUNBUILT
#
#use List::Util qw(first max);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(format);
#
## copy-pasted from List::MoreUtils::PP
#sub firstidx (&@) {
# my $f = shift;
# foreach my $i ( 0 .. $#_ )
# {
# local *_ = \$_[$i];
# return $i if $f->();
# }
# return -1;
#}
#
#sub _json {
# state $json = do {
# if (eval { require Cpanel::JSON::XS; 1 }) { Cpanel::JSON::XS->new->canonical(1)->convert_blessed->allow_nonref }
# elsif (eval { require JSON::Tiny::Subclassable; 1 }) { JSON::Tiny::Subclassable->new }
# elsif (eval { require JSON::PP; 1 }) { JSON::PP->new->canonical(1)->convert_blessed->allow_nonref }
# else { die "Can't find any JSON module" }
# };
# $json;
#};
#
#sub __cleanse {
# state $cleanser = do {
# eval { require Data::Clean::JSON; 1 };
# if ($@) {
# undef;
# } else {
# Data::Clean::JSON->get_cleanser;
# }
# };
# if ($cleanser) {
# $cleanser->clean_in_place($_[0]);
# } else {
# $_[0];
# }
#}
#
#sub __gen_table {
# my ($data, $header_row, $resmeta, $format) = @_;
#
# $resmeta //= {};
#
# # column names
# my @columns;
# if ($header_row) {
# @columns = @{$data->[0]};
# } else {
# @columns = map {"col$_"} 0..@{$data->[0]}-1;
# }
#
# my $column_orders; # e.g. [col2, col1, col3, ...]
# SET_COLUMN_ORDERS: {
#
# # find column orders from 'table_column_orders' in result metadata (or
# # from env)
# my $tcos;
# if ($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS}) {
# $tcos = _json->encode($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS});
# } elsif (my $rfos = ($resmeta->{'cmdline.format_options'} //
# $resmeta->{format_options})) {
# my $rfo = $rfos->{'text-pretty'} // $rfos->{text} // $rfos->{any};
# if ($rfo) {
# $tcos = $rfo->{table_column_orders};
# }
# }
# if ($tcos) {
# # find an entry in tcos that @columns contains all the columns of
# COLS:
# for my $cols (@$tcos) {
# for my $col (@$cols) {
# next COLS unless first {$_ eq $col} @columns;
# }
# $column_orders = $cols;
# last SET_COLUMN_ORDERS;
# }
# }
#
# if ($resmeta->{'table.field_orders'}) {
# $column_orders = $resmeta->{'table.field_orders'};
# last SET_COLUMN_ORDERS;
# }
#
# # find column orders from table spec
# $column_orders = $resmeta->{'table.fields'};
# }
#
# # reorder each row according to requested column order
# if ($column_orders) {
script/gen-generic-ind-company-names view on Meta::CPAN
# $data = [map {[$_, $data->{$_}]} sort keys %$data];
# unshift @$data, ["key", "value"];
# return __gen_table($data, 1, $res->[3], $format);
# } elsif (Data::Check::Structure::is_aohos($data, {max=>$max})) {
# # collect all mentioned fields
# my @fieldnames;
# if ($res->[3] && $res->[3]{'table.fields'} &&
# $res->[3]{'table.hide_unknown_fields'}) {
# @fieldnames = @{ $res->[3]{'table.fields'} };
# } else {
# my %fieldnames;
# for my $row (@$data) {
# $fieldnames{$_}++ for keys %$row;
# }
# @fieldnames = sort keys %fieldnames;
# }
# my $newdata = [];
# for my $row (@$data) {
# push @$newdata, [map {$row->{$_}} @fieldnames];
# }
# unshift @$newdata, \@fieldnames;
# return __gen_table($newdata, 1, $res->[3], $format);
# } else {
# $format = 'json-pretty';
# }
# }
# }
#
# my $tff = $res->[3]{'table.fields'};
# $res = $res->[2] if $is_naked;
#
# if ($format eq 'perl') {
# my $use_color = $ENV{COLOR} // (-t STDOUT);
# if ($use_color && eval { require Data::Dump::Color; 1 }) {
# return Data::Dump::Color::dump($res);
# } elsif (eval { require Data::Dump; 1 }) {
# return Data::Dump::dump($res);
# } else {
# no warnings 'once';
# require Data::Dumper;
# local $Data::Dumper::Terse = 1;
# local $Data::Dumper::Indent = 1;
# local $Data::Dumper::Useqq = 1;
# local $Data::Dumper::Deparse = 1;
# local $Data::Dumper::Quotekeys = 0;
# local $Data::Dumper::Sortkeys = 1;
# local $Data::Dumper::Trailingcomma = 1;
# return Data::Dumper::Dumper($res);
# }
# }
#
# unless ($format =~ /\Ajson(-pretty)?\z/) {
# warn "Unknown format '$format', fallback to json-pretty";
# $format = 'json-pretty';
# }
# __cleanse($res) if ($cleanse//1);
# if ($format =~ /json/) {
# if ($tff && _json->can("sort_by") &&
# eval { require Sort::ByExample; 1}) {
# my $cmp = Sort::ByExample->cmp($tff);
# _json->sort_by(sub { $cmp->($JSON::PP::a, $JSON::PP::b) });
# }
#
# if ($format eq 'json') {
# return _json->encode($res) . "\n";
# } else {
# _json->pretty(1);
# return _json->encode($res);
# }
# }
#}
#
#1;
## ABSTRACT: Format enveloped result
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Perinci::Result::Format::Lite - Format enveloped result
#
#=head1 VERSION
#
#This document describes version 0.279 of Perinci::Result::Format::Lite (from Perl distribution Perinci-Result-Format-Lite), released on 2021-03-08.
#
#=head1 SYNOPSIS
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(firstidx)$
#
#=head1 FUNCTIONS
#
#=head2 format($res, $format[ , $is_naked=0, $cleanse=1 ]) => str
#
#=head1 ENVIRONMENT
#
#=head2 FORMAT_PRETTY_TABLE_BACKEND => str
#
#If this is set, will render text table using L<Text::Table::Any> (with
#C<backend> set to the value of this environment variable) instead of the default
#L<Text::Table::Sprintf>. This is useful if you want to output text table in a
#different format, for example to generate Org tables (make sure
#L<Text::Table::Org> backend is already installed):
#
# % FORMAT_PRETTY_TABLE_BACKEND=Text::Table::Org lcpan rdeps Getopt::Lucid
#
#For convenience, a default is chosen for you under certain condition. When
#inside Emacs (environment C<INSIDE_EMACS> is set), C<Text::Table::Org> is used
#as default.
#
#=head2 FORMAT_PRETTY_TABLE_COLUMN_ORDERS => array (json)
#
#Set the default of C<table_column_orders> in C<format_options> in result
#metadata, similar to what's implemented in L<Perinci::Result::Format> and
#L<Data::Format::Pretty::Console>.
#
( run in 0.654 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )