Acme-ID-CompanyName
view release on metacpan or search on metacpan
script/gen-generic-ind-company-names view on Meta::CPAN
#=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;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# point
# parse_cmdline
# join_wordbreak_words
# format_completion
# );
#
#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 {
# 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,
script/gen-generic-ind-company-names view on Meta::CPAN
#
#* `truncate_current_word` (bool). If set to 1, will truncate current word to the
# position of cursor, for example (`^` marks the position of cursor):
# `--vers^oo` to `--vers` instead of `--versoo`. This is more convenient when
# doing tab completion.
#
#_
# schema => 'hash*',
# pos => 2,
# },
# },
# result => {
# schema => ['array*', len=>2],
# description => <<'_',
#
#Return a 2-element array: `[$words, $cword]`. `$words` is array of str,
#equivalent to `COMP_WORDS` provided by bash to shell functions. `$cword` is an
#integer, roughly equivalent to `COMP_CWORD` provided by bash to shell functions.
#The word to be completed is at `$words->[$cword]`.
#
#Note that COMP_LINE includes the command name. If you want the command-line
#arguments only (like in `@ARGV`), you need to strip the first element from
#`$words` and reduce `$cword` by 1.
#
#
#_
# },
# result_naked => 1,
# links => [
# ],
#};
#sub parse_cmdline {
# no warnings 'uninitialized';
# my ($line, $point, $opts) = @_;
#
# $line //= $ENV{COMP_LINE};
# $point //= $ENV{COMP_POINT} // 0;
#
# die "$0: COMP_LINE not set, make sure this script is run under ".
# "bash completion (e.g. through complete -C)\n" unless defined $line;
#
# log_trace "[compbash] parse_cmdline(): input: line=<$line> point=<$point>"
# if $ENV{COMPLETE_BASH_TRACE};
#
# my @words;
# my $cword;
# my $pos = 0;
# my $pos_min_ws = 0;
# my $after_ws = 1; # XXX what does this variable mean?
# my $chunk;
# my $add_blank;
# my $is_cur_word;
# $line =~ s!( # 1) everything
# (")((?: \\\\|\\"|[^"])*)(?:"|\z)(\s*) | # 2) open " 3) content 4) space after
# (')((?: \\\\|\\'|[^'])*)(?:'|\z)(\s*) | # 5) open ' 6) content 7) space after
# ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) | # 8) unquoted word 9) space after
# ([\@><=|&\(:]+) | # 10) non-whitespace word-breaking characters
# \s+
# )!
# $pos += length($1);
# #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
# #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
# if ($2 || $5 || defined($8)) {
# # double-quoted/single-quoted/unquoted chunk
#
# if (not(defined $cword)) {
# $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
# #say "D:pos_min_ws=$pos_min_ws";
# if ($point <= $pos_min_ws) {
# $cword = @words - ($after_ws ? 0 : 1);
# } elsif ($point < $pos) {
# $cword = @words + 1 - ($after_ws ? 0 : 1);
# $add_blank = 1;
# }
# }
#
# if ($after_ws) {
# $is_cur_word = defined($cword) && $cword==@words;
# } else {
# $is_cur_word = defined($cword) && $cword==@words-1;
# }
# #say "D:is_cur_word=$is_cur_word";
# $chunk =
# $2 ? _add_double_quoted($3, $is_cur_word) :
# $5 ? _add_single_quoted($6) :
# _add_unquoted($8, $is_cur_word, $after_ws);
# if ($opts && $opts->{truncate_current_word} &&
# $is_cur_word && $pos > $point) {
# $chunk = substr(
# $chunk, 0, length($chunk)-($pos_min_ws-$point));
# #say "D:truncating current word to <$chunk>";
# }
# if ($after_ws) {
# push @words, $chunk;
# } else {
# $words[-1] .= $chunk;
# }
# if ($add_blank) {
# push @words, '';
# $add_blank = 0;
# }
# $after_ws = ($2 ? $4 : $5 ? $7 : $9) ? 1:0;
#
# } elsif ($10) {
# # non-whitespace word-breaking characters
# push @words, $10;
# $after_ws = 1;
# } else {
# # whitespace
# $after_ws = 1;
# }
# !egx;
#
# $cword //= @words;
# $words[$cword] //= '';
#
# log_trace "[compbash] parse_cmdline(): result: words=%s, cword=%s", \@words, $cword
# if $ENV{COMPLETE_BASH_TRACE};
#
# [\@words, $cword];
#}
#
#$SPEC{join_wordbreak_words} = {
# v => 1.1,
# summary => 'Post-process parse_cmdline() result by joining some words',
# description => <<'_',
#
#`parse_cmdline()`, like bash, splits some characters that are considered as
#word-breaking characters:
#
# "'@><=;|&(:
#
#So if command-line is:
#
# command --module=Data::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "--module", "=", "Data", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
# ["command", "--module=Data::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
# my ($words, $cword) = @_;
# my $new_words = [];
# my $i = -1;
script/gen-generic-ind-company-names view on Meta::CPAN
# # 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[$_]
script/gen-generic-ind-company-names view on Meta::CPAN
# 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;
script/gen-generic-ind-company-names view on Meta::CPAN
# },
# },
# deps => {
# _keys => {
# all => {},
# any => {},
# none => {},
# env => {},
# prog => {},
# pkg => {},
# func => {},
# code => {},
# tmp_dir => {},
# trash_dir => {},
# },
# },
# },
#
# examples => [
# {value=>{}, valid=>1},
# {
# value=>{v=>1.1, summary=>"Some function", args=>{a1=>{}, a2=>{}}},
# valid=>1,
# },
# # XXX we have not implemented property & attribute checking
# ],
#
#}, {}];
#
#$schema->[1]{_prop}{args}{_value_prop}{meta} = $schema->[1];
#$schema->[1]{_prop}{args}{_value_prop}{element_meta} = $schema->[1];
#
## just so the dzil plugin won't complain about schema not being normalized.
## because this is a circular structure and normalizing creates a shallow copy.
#
#$schema = Data::Sah::Normalize::normalize_schema($schema);
#
#1;
## ABSTRACT: Rinci function metadata
#
#__END__
#
#=pod
#
#=encoding UTF-8
#
#=head1 NAME
#
#Sah::Schema::rinci::function_meta - Rinci function metadata
#
#=head1 VERSION
#
#This document describes version 1.1.94.0 of Sah::Schema::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2020-09-23.
#
#=head1 SYNOPSIS
#
#To check data against this schema (requires L<Data::Sah>):
#
# use Data::Sah qw(gen_validator);
# my $validator = gen_validator("rinci::function_meta*");
# say $validator->($data) ? "valid" : "INVALID!";
#
# # Data::Sah can also create validator that returns nice error message string
# # and/or coerced value. Data::Sah can even create validator that targets other
# # language, like JavaScript. All from the same schema. See its documentation
# # for more details.
#
#To validate function parameters against this schema (requires L<Params::Sah>):
#
# use Params::Sah qw(gen_validator);
#
# sub myfunc {
# my @args = @_;
# state $validator = gen_validator("rinci::function_meta*");
# $validator->(\@args);
# ...
# }
#
#To specify schema in L<Rinci> function metadata and use the metadata with
#L<Perinci::CmdLine> to create a CLI:
#
# # in lib/MyApp.pm
# package MyApp;
# our %SPEC;
# $SPEC{myfunc} = {
# v => 1.1,
# summary => 'Routine to do blah ...',
# args => {
# arg1 => {
# summary => 'The blah blah argument',
# schema => ['rinci::function_meta*'],
# },
# ...
# },
# };
# sub myfunc {
# my %args = @_;
# ...
# }
# 1;
#
# # in myapp.pl
# package main;
# use Perinci::CmdLine::Any;
# Perinci::CmdLine::Any->new(url=>'MyApp::myfunc')->run;
#
# # in command-line
# % ./myapp.pl --help
# myapp - Routine to do blah ...
# ...
#
# % ./myapp.pl --version
#
# % ./myapp.pl --arg1 ...
#
#Sample data:
#
# {} # valid
#
# {args=>{a1=>{},a2=>{}},summary=>"Some function",v=>1.1} # valid
#
( run in 3.800 seconds using v1.01-cache-2.11-cpan-8dfa8b56332 )