Acme-ID-CompanyName
view release on metacpan or search on metacpan
script/gen-generic-ind-company-names view on Meta::CPAN
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);
$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;
script/gen-generic-ind-company-names view on Meta::CPAN
#
#@EXPORT_OK = qw( clone );
#sub import { goto &Exporter::import } # lazy Exporter
#
## These methods can be temporarily overridden to work with a given class.
#use vars qw( $CloneSelfMethod $CloneInitMethod );
#$CloneSelfMethod ||= 'clone_self';
#$CloneInitMethod ||= 'clone_init';
#
## Used to detect looped networks and avoid infinite recursion.
#use vars qw( %CloneCache );
#
## Generic cloning function
#sub clone {
# my $source = shift;
#
# return undef if not defined($source);
#
# # Optional depth limit: after a given number of levels, do shallow copy.
# my $depth = shift;
# return $source if ( defined $depth and $depth -- < 1 );
#
# # Maintain a shared cache during recursive calls, then clear it at the end.
# local %CloneCache = ( undef => undef ) unless ( exists $CloneCache{undef} );
#
# return $CloneCache{ $source } if ( defined $CloneCache{ $source } );
#
# # Non-reference values are copied shallowly
# my $ref_type = ref $source or return $source;
#
# # Extract both the structure type and the class name of referent
# my $class_name;
# if ( "$source" =~ /^\Q$ref_type\E\=([A-Z]+)\(0x[0-9a-f]+\)$/ ) {
# $class_name = $ref_type;
# $ref_type = $1;
# # Some objects would prefer to clone themselves; check for clone_self().
# return $CloneCache{ $source } = $source->$CloneSelfMethod()
# if $source->can($CloneSelfMethod);
# }
#
# # To make a copy:
# # - Prepare a reference to the same type of structure;
# # - Store it in the cache, to avoid looping if it refers to itself;
# # - Tie in to the same class as the original, if it was tied;
# # - Assign a value to the reference by cloning each item in the original;
#
# my $copy;
# if ($ref_type eq 'HASH') {
# $CloneCache{ $source } = $copy = {};
# if ( my $tied = tied( %$source ) ) { tie %$copy, ref $tied }
# %$copy = map { ! ref($_) ? $_ : clone($_, $depth) } %$source;
# } elsif ($ref_type eq 'ARRAY') {
# $CloneCache{ $source } = $copy = [];
# if ( my $tied = tied( @$source ) ) { tie @$copy, ref $tied }
# @$copy = map { ! ref($_) ? $_ : clone($_, $depth) } @$source;
# } elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
# $CloneCache{ $source } = $copy = \( my $var = "" );
# if ( my $tied = tied( $$source ) ) { tie $$copy, ref $tied }
# $$copy = clone($$source, $depth);
# } else {
# # Shallow copy anything else; this handles a reference to code, glob, regex
# $CloneCache{ $source } = $copy = $source;
# }
#
# # - Bless it into the same class as the original, if it was blessed;
# # - If it has a post-cloning initialization method, call it.
# if ( $class_name ) {
# bless $copy, $class_name;
# $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
# }
#
# return $copy;
#}
#
#1;
#
#__END__
#
#=head1 NAME
#
#Clone::PP - Recursively copy Perl datatypes
#
#=head1 SYNOPSIS
#
# use Clone::PP qw(clone);
#
# $item = { 'foo' => 'bar', 'move' => [ 'zig', 'zag' ] };
# $copy = clone( $item );
#
# $item = [ 'alpha', 'beta', { 'gamma' => 'vlissides' } ];
# $copy = clone( $item );
#
# $item = Foo->new();
# $copy = clone( $item );
#
#Or as an object method:
#
# require Clone::PP;
# push @Foo::ISA, 'Clone::PP';
#
# $item = Foo->new();
# $copy = $item->clone();
#
#=head1 DESCRIPTION
#
#This module provides a general-purpose clone function to make deep
#copies of Perl data structures. It calls itself recursively to copy
#nested hash, array, scalar and reference types, including tied
#variables and objects.
#
#The clone() function takes a scalar argument to copy. To duplicate
#arrays or hashes, pass them in by reference:
#
# my $copy = clone(\@array); my @copy = @{ clone(\@array) };
# my $copy = clone(\%hash); my %copy = %{ clone(\%hash) };
#
#The clone() function also accepts an optional second parameter that
#can be used to limit the depth of the copy. If you pass a limit of
#0, clone will return the same value you supplied; for a limit of
#1, a shallow copy is constructed; for a limit of 2, two layers of
#copying are done, and so on.
#
# my $shallow_copy = clone( $item, 1 );
#
#To allow objects to intervene in the way they are copied, the
#clone() function checks for a couple of optional methods. If an
#object provides a method named C<clone_self>, it is called and the
#result returned without further processing. Alternately, if an
#object provides a method named C<clone_init>, it is called on the
#copied object before it is returned.
#
#=head1 BUGS
#
#Some data types, such as globs, regexes, and code refs, are always copied shallowly.
#
#References to hash elements are not properly duplicated. (This is why two tests in t/dclone.t that are marked "todo".) For example, the following test should succeed but does not:
#
# my $hash = { foo => 1 };
# $hash->{bar} = \{ $hash->{foo} };
# my $copy = clone( \%hash );
# $hash->{foo} = 2;
# $copy->{foo} = 2;
# ok( $hash->{bar} == $copy->{bar} );
#
#To report bugs via the CPAN web tracking system, go to
#C<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Clone-PP> or send mail
#to C<Dist=Clone-PP#rt.cpan.org>, replacing C<#> with C<@>.
#
#=head1 SEE ALSO
#
#L<Clone> - a baseclass which provides a C<clone()> method.
#
#L<MooseX::Clone> - find-grained cloning for Moose objects.
#
#The C<dclone()> function in L<Storable>.
#
#L<Data::Clone> -
#polymorphic data cloning (see its documentation for what that means).
#
#L<Clone::Any> - use whichever of the cloning methods is available.
#
#=head1 REPOSITORY
#
#L<https://github.com/neilbowers/Clone-PP>
#
#=head1 AUTHOR AND CREDITS
#
#Developed by Matthew Simon Cavalletto at Evolution Softworks.
#More free Perl software is available at C<www.evoscript.org>.
#
#
#=head1 COPYRIGHT AND LICENSE
#
#Copyright 2003 Matthew Simon Cavalletto. You may contact the author
#directly at C<evo@cpan.org> or C<simonm@cavalletto.org>.
#
#Code initially derived from Ref.pm. Portions Copyright 1994 David Muir Sharnoff.
#
#Interface based by Clone by Ray Finch with contributions from chocolateboy.
#Portions Copyright 2001 Ray Finch. Portions Copyright 2001 chocolateboy.
#
#You may use, modify, and distribute this software under the same terms as Perl.
#
#=cut
### Complete/Bash.pm ###
#package Complete::Bash;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-16'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.335'; # VERSION
#
#use 5.010001;
#use strict;
script/gen-generic-ind-company-names view on Meta::CPAN
# 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(
# "",
# @{ $self->{_include_stack} } ? "$self->{_include_stack}[0] " : "",
# "line $self->{_linum}: ",
# $msg
# );
#}
#
#sub _push_include_stack {
# require Cwd;
#
# my ($self, $path) = @_;
#
# # included file's path is based on the main (topmost) file
# if (@{ $self->{_include_stack} }) {
# require File::Spec;
# my ($vol, $dir, $file) =
# File::Spec->splitpath($self->{_include_stack}[-1]);
# $path = File::Spec->rel2abs($path, File::Spec->catpath($vol, $dir));
# }
#
# my $abs_path = Cwd::abs_path($path) or return [400, "Invalid path name"];
# return [409, "Recursive", $abs_path]
# if grep { $_ eq $abs_path } @{ $self->{_include_stack} };
# push @{ $self->{_include_stack} }, $abs_path;
# return [200, "OK", $abs_path];
#}
#
script/gen-generic-ind-company-names view on Meta::CPAN
#=head2 isint
#
#=head2 isfloat
#
#=head2 isnum
#
#=head2 isneg
#
#=head2 isinf
#
#=head2 isnan
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Scalar-Util-Numeric-PP>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Scalar-Util-Numeric-PP>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Scalar-Util-Numeric-PP>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Data::Sah>
#
#L<Scalar::Util::Numeric>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2016 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
### Text/Table/Tiny.pm ###
#package Text::Table::Tiny;
#$Text::Table::Tiny::VERSION = '1.02';
#use 5.010;
#use strict;
#use warnings;
#use utf8;
#use parent 'Exporter';
#use Carp qw/ croak /;
#use Ref::Util 0.202 qw/ is_arrayref /;
#use String::TtyLength 0.02 qw/ tty_width /;
#
#our @EXPORT_OK = qw/ generate_table /;
#
## Legacy package globals, that can be used to customise the look.
## These are only used in the "classic" style.
## I wish I could drop them, but I don't want to break anyone's code.
#our $COLUMN_SEPARATOR = '|';
#our $ROW_SEPARATOR = '-';
#our $CORNER_MARKER = '+';
#our $HEADER_ROW_SEPARATOR = '=';
#our $HEADER_CORNER_MARKER = 'O';
#
#my %arguments = (
# rows => "the rows, including a possible header row, of the table",
# header_row => "if true, indicates that the first row is a header row",
# separate_rows => "if true, a separate rule will be drawn between each row",
# top_and_tail => "if true, miss out top and bottom edges of table",
# align => "either single alignment, or an array per of alignments per col",
# style => "styling of table, one of classic, boxrule, or norule",
# indent => "indent every row of the table a certain number of spaces",
# compact => "narrow columns (no space either side of content)",
#);
#
#my %charsets = (
# classic => { TLC => '+', TT => '+', TRC => '+', HR => '-', VR => '|', FHR => '=', LT => '+', RT => '+', FLT => 'O', FRT => 'O', HC => '+', FHC => 'O', BLC => '+', BT => '+', BRC => '+' },
# boxrule => { TLC => '┌', TT => '┬', TRC => 'â”Â', HR => '─', VR => '│', FHR => 'â•Â', LT => '├', RT => '┤', FLT => '╞', FRT => '╡', HC => '┼', FHC => '╪', BLC => '└', BT => '┴', B...
# norule => { TLC => ' ', TT => ' ', TRC => ' ', HR => ' ', VR => ' ', FHR => ' ', LT => ' ', RT => ' ', FLT => ' ', FRT => ' ', HC => ' ', FHC => ' ', BLC => ' ', BT => ' ', BRC => ' ' },
#);
#
#sub generate_table
#{
# my %param = @_;
#
# foreach my $arg (keys %param) {
# croak "unknown argument '$arg'" if not exists $arguments{$arg};
# }
#
# my $rows = $param{rows} or croak "you must pass the 'rows' argument!";
# my @rows = @$rows;
# my @widths = _calculate_widths($rows);
#
# $param{style} //= 'classic';
#
# $param{indent} //= '';
# $param{indent} = ' ' x $param{indent} if $param{indent} =~ /^[0-9]+$/;
#
# my $style = $param{style};
# croak "unknown style '$style'" if not exists($charsets{ $style });
# my $char = $charsets{$style};
#
# if ($style eq 'classic') {
# $char->{TLC} = $char->{TRC} = $char->{TT} = $char->{LT} = $char->{RT} = $char->{HC} = $char->{BLC} = $char->{BT} = $char->{BRC} = $CORNER_MARKER;
# $char->{HR} = $ROW_SEPARATOR;
# $char->{VR} = $COLUMN_SEPARATOR;
# $char->{FLT} = $char->{FRT} = $char->{FHC} = $HEADER_CORNER_MARKER;
# $char->{FHR} = $HEADER_ROW_SEPARATOR;
# }
#
# my $header;
# my @align;
# if (defined $param{align}) {
# @align = is_arrayref($param{align})
# ? @{ $param{align} }
# : ($param{align}) x int(@widths)
( run in 0.787 second using v1.01-cache-2.11-cpan-7fcb06a456a )