Acme-ID-CompanyName
view release on metacpan or search on metacpan
lib/Acme/ID/CompanyName.pm view on Meta::CPAN
sub gen_generic_ind_company_names {
my %args = @_;
my $type = $args{type} // 'PT';
my $num_names = $args{num_names} // 1;
my $num_words = $args{num_words} // 3;
my $desired_initials = lc($args{desired_initials} // "");
my $add_prefixes = $args{add_prefixes} // 1;
my $add_suffixes = $args{add_suffixes} // 1;
$num_words = length($desired_initials)
if $num_words < length($desired_initials);
my @res;
my $name_tries = 0;
for my $i (1..$num_names) {
die "Can't produce that many unique company names"
if ++$name_tries > 5*$num_names;
my @words;
my $word_tries = 0;
my $has_added_prefix;
lib/Acme/ID/CompanyName.pm view on Meta::CPAN
for my $j (1..$num_words) {
die "Can't produce a company name that satisfies requirements"
if ++$word_tries > 1000;
my $will_add_prefix =
!$add_prefixes ? 0 :
$has_added_prefix ? 0 :
rand()*$num_words*6 > 1 ? 0 : 1;
my $word;
my $desired_initial = length($desired_initials) >= $j ?
substr($desired_initials, $j-1, 1) : undef;
if (!$will_add_prefix && $desired_initial) {
die "There are no words that start with '$desired_initial'"
unless $Per_Letter_Words{$desired_initial};
$word = $Per_Letter_Words{$desired_initial}->[
@{ $Per_Letter_Words{$desired_initial} } * rand()
];
} else {
$word = $Words[@Words * rand()];
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];
script/gen-generic-ind-company-names view on Meta::CPAN
#our %SPEC;
#
#$SPEC{':package'} = {
# v => 1.1,
# summary => 'Completion routines for bash shell',
#};
#
#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 {
script/gen-generic-ind-company-names view on Meta::CPAN
# my $chunk;
# my $add_blank;
# my $is_cur_word;
# $line =~ s!( # 1) everything
# (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*) | # 2) open " 3) content 4) space after
# (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*) | # 5) open ' 6) content 7) space after
# ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) | # 8) unquoted word 9) space after
# ([\@><=|&\(:]+) | # 10) non-whitespace word-breaking characters
# \s+
# )!
# $pos += length($1);
# #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
# #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
# if ($2 || $5 || defined($8)) {
# # double-quoted/single-quoted/unquoted chunk
#
# if (not(defined $cword)) {
# $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
# #say "D:pos_min_ws=$pos_min_ws";
# if ($point <= $pos_min_ws) {
# $cword = @words - ($after_ws ? 0 : 1);
# } elsif ($point < $pos) {
# $cword = @words + 1 - ($after_ws ? 0 : 1);
# $add_blank = 1;
# }
# }
#
# if ($after_ws) {
script/gen-generic-ind-company-names view on Meta::CPAN
# $is_cur_word = defined($cword) && $cword==@words-1;
# }
# #say "D:is_cur_word=$is_cur_word";
# $chunk =
# $2 ? _add_double_quoted($3, $is_cur_word) :
# $5 ? _add_single_quoted($6) :
# _add_unquoted($8, $is_cur_word, $after_ws);
# if ($opts && $opts->{truncate_current_word} &&
# $is_cur_word && $pos > $point) {
# $chunk = substr(
# $chunk, 0, length($chunk)-($pos_min_ws-$point));
# #say "D:truncating current word to <$chunk>";
# }
# if ($after_ws) {
# push @words, $chunk;
# } else {
# $words[-1] .= $chunk;
# }
# if ($add_blank) {
# push @words, '';
# $add_blank = 0;
script/gen-generic-ind-company-names view on Meta::CPAN
# 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}) {
script/gen-generic-ind-company-names view on Meta::CPAN
# # 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;
# }
# last if $max_entry_width >= $column_width;
# for (@res) {
# $_ .= " " x ($column_width - length) if $column_width > length;
# }
# }
#
# PASS_TO_FZF: {
# last unless $ENV{COMPLETE_BASH_FZF};
# my $items = $ENV{COMPLETE_BASH_FZF_ITEMS} // 100;
# last unless @words >= $items;
#
# require File::Which;
# unless (File::Which::which("fzf")) {
script/gen-generic-ind-company-names view on Meta::CPAN
#=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>.
script/gen-generic-ind-company-names view on Meta::CPAN
# 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') {
script/gen-generic-ind-company-names view on Meta::CPAN
# }
#
# my $code_find_opt = sub {
# my ($wanted, $short_mode) = @_;
# my @candidates;
# OPT_SPEC:
# for my $spec (keys %spec) {
# $spec =~ s/=[fios][@%]?\z//;
# my @opts = split /\|/, $spec;
# for my $o (@opts) {
# next if $short_mode && length($o) > 1;
# if ($o eq $wanted) {
# # perfect match, we immediately go with this one
# @candidates = ($opts[0]);
# last OPT_SPEC;
# } elsif ($config->{auto_abbrev} && index($o, $wanted) == 0) {
# # prefix match, collect candidates first
# push @candidates, $opts[0];
# next OPT_SPEC;
# }
# }
script/gen-generic-ind-company-names view on Meta::CPAN
# last ELEM;
#
# } elsif ($argv->[$i] =~ /\A--(.+?)(?:=(.*))?\z/) {
#
# my ($used_name, $val_in_opt) = ($1, $2);
# my $opt = $code_find_opt->($used_name);
# if (!defined($opt)) {
# # unknown option
# push @remaining, $argv->[$i];
# next ELEM;
# } elsif (!length($opt)) {
# push @remaining, $argv->[$i];
# next ELEM; # ambiguous
# }
#
# my $spec = $spec_by_opt_name{$opt};
# # check whether option requires an argument
# if ($spec =~ /=[fios][@%]?\z/) {
# if (defined $val_in_opt) {
# # argument is taken after =
# $code_set_val->($opt, $val_in_opt);
script/gen-generic-ind-company-names view on Meta::CPAN
# SHORT_OPT:
# while ($str =~ s/(.)//) {
# my $used_name = $1;
# my $short_opt = $1;
# my $opt = $code_find_opt->($short_opt, 'short');
# if (!defined $opt) {
# # unknown short option
# push @remaining, "-" unless $remaining_pushed++;
# $remaining[-1] .= $short_opt;
# next SHORT_OPT;
# } elsif (!length $opt) {
# # ambiguous short option
# push @remaining, "-" unless $remaining_pushed++;
# $remaining[-1] .= $short_opt;
# }
#
# my $spec = $spec_by_opt_name{$opt};
# # check whether option requires an argument
# if ($spec =~ /=[fios][@%]?\z/) {
# if (length $str) {
# # argument is taken from $str
# $code_set_val->($opt, $str);
# next ELEM;
# } else {
# if ($i+1 >= @$argv) {
# # we are the last element
# unless ($config->{pass_through}) {
# warn "Option $used_name requires an argument\n";
# $success = 0;
# }
script/gen-generic-ind-company-names view on Meta::CPAN
# ((!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))
#
# &&
#
script/gen-generic-ind-company-names view on Meta::CPAN
# }
# }
# $seen_profiles{$keyvals{profile}}++ if defined $keyvals{profile};
#
# my $sect_scn = $keyvals{subcommand} // '';
# my $sect_profile = $keyvals{profile};
# my $sect_plugin = $keyvals{plugin};
#
# # if there is a subcommand name, use section with no subcommand=... or
# # the matching subcommand
# if (length $scn) {
# if (length($sect_scn) && $sect_scn ne $scn) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "subcommand does not match '$scn'",
# );
# next;
# }
# } else {
# if (length $sect_scn) {
# log_trace(
# "[pericmd] Skipped config section '%s' (%s)",
# $section0, "only for a certain subcommand",
# );
# next;
# }
# }
#
# # if user chooses a profile, only use section with no profile=... or the
# # matching profile
script/gen-generic-ind-company-names view on Meta::CPAN
# $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} // ',',
script/gen-generic-ind-company-names view on Meta::CPAN
# # 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];
# next unless defined($cell);
# if ($align eq 'number') {
# my ($bd, $d, $ad);
# if ($header_row && $i == 0) {
# } elsif (($bd, $d, $ad) = $cell =~ /\A([+-]?\d+)(\.?)(\d*)\z/) {
# $cell = join(
# '',
# (' ' x ($maxw_bd - length($bd))), $bd,
# $d , (' ' x ($maxw_d - length($d ))),
# $ad, (' ' x ($maxw_ad - length($ad))),
# );
# } elsif (($bd, $d, $ad) = $cell =~ /\A([+-]?\d+\.?\d*)([eE])([+-]?\d+)\z/) {
# $cell = join(
# '',
# (' ' x ($maxw_bd - length($bd))), $bd,
# $d , (' ' x ($maxw_d - length($d ))),
# $ad, (' ' x ($maxw_ad - length($ad))),
# );
# }
# my $w = length($cell);
# $cell = (' ' x ($maxw - $w)) . $cell
# if $maxw > $w;
# } elsif ($align eq 'right') {
# $cell = (' ' x ($maxw - length($cell))) . $cell;
# } elsif ($align eq 'middle' || $align eq 'center') {
# my $w = length($cell);
# my $n = int(($maxw-$w)/2);
# $cell = (' ' x $n) . $cell . (' ' x ($maxw-$w-$n));
# } else {
# # assumed left
# $cell .= (' ' x ($maxw - length($cell)));
#
# }
# $row->[$colidx] = $cell;
# }
# }
# } # for $colidx
# } # END align columns
#
# my $fres;
# my $backend = $ENV{FORMAT_PRETTY_TABLE_BACKEND};
# $backend //= "Text::Table::Org" if $ENV{INSIDE_EMACS};
# if ($backend) {
# require Text::Table::Any;
# $fres = Text::Table::Any::table(rows=>$data, header_row=>$header_row, backend=>$backend);
# } else {
# require Text::Table::Sprintf;
# $fres = Text::Table::Sprintf::table(rows=>$data, header_row=>$header_row);
# }
# $fres .= "\n" unless $fres =~ /\R\z/ || !length($fres);
# $fres;
# } elsif ($format eq 'csv') {
# no warnings 'uninitialized';
# join(
# "",
# map {
# my $row = $_;
# join(
# ",",
# map {
script/gen-generic-ind-company-names view on Meta::CPAN
# }
# return "$fres\n";
# } elsif ($res->[3] && $res->[3]{"x.hint.result_binary"}) {
# return $res->[2];
# } else {
# require Data::Check::Structure;
# my $data = $res->[2];
# my $max = 1000;
# if (!ref($data)) {
# $data //= "";
# $data .= "\n" unless !length($data) || $data =~ /\n\z/;
# return $data;
# } elsif (ref($data) eq 'ARRAY' && !@$data) {
# return "";
# } elsif (Data::Check::Structure::is_aos($data, {max=>$max})) {
# return join("", map {"$_\n"} @$data);
# } elsif (Data::Check::Structure::is_aoaos($data, {max=>$max})) {
# my $header_row = 0;
# my $data = $data;
# if ($res->[3]{'table.fields'}) {
# $data = [$res->[3]{'table.fields'}, @$data];
( run in 0.784 second using v1.01-cache-2.11-cpan-65fba6d93b7 )