App-PickRandomLines
view release on metacpan or search on metacpan
script/pick-random-lines 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;
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#use Exporter 'import';
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2022-09-08'; # DATE
#our $DIST = 'Complete-Bash'; # DIST
#our $VERSION = '0.337'; # VERSION
#
#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/pick-random-lines 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/pick-random-lines 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/pick-random-lines 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' || $fmt_name eq 'datetime' || $fmt_name eq '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' || $fmt_name eq '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:
# {
# last unless @$data;
#
# # note: the logic of this block of code now also put in Number::Pad
#
# # 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'};
#
# # align numbers by default, with 'right' currently as 'number' is too slow
# unless ($tfa || $tfa_code || $tfa_default) {
# $tfa = [map { undef } 0 .. $#columns];
# COLUMN:
# for my $colidx (0 .. $#columns) {
# for my $i (0 .. $#{$data}) {
# next if $header_row && $i == 0;
# my $cell = $data->[$i][$colidx];
# next unless defined $cell;
# next COLUMN unless $cell =~ /\A[+-]?[0-9]+(?:\.[0-9]*)?(?:[Ee][+-]?[0-9]+)?(?:%)?\z/;
# }
# $tfa->[$colidx] = 'right';
# }
# }
# #use DD; dd $tfa;
# #say "D1";
#
# for my $colidx (0..$#columns) {
# my $field_idx = $field_idxs[$colidx];
# my $align = $tfa_code ? $tfa_code->($columns[$colidx]) : undef;
# $align //= $tfa->[$field_idx] if $field_idx >= 0;
# $align //= $tfa_default;
# next unless $align;
#
# # determine max widths
# my $maxw;
# my ($maxw_bd, $maxw_d, $maxw_ad); # before digit, digit, after d
# if ($align eq 'number') {
# my (@w_bd, @w_d, @w_ad);
# for my $i (0..$#{$data}) {
# my $row = $data->[$i];
# if (@$row > $colidx) {
# my $cell = $row->[$colidx];
# if ($header_row && $i == 0) {
# my $w = length($cell);
# push @w_bd, 0;
# push @w_bd, 0;
# push @w_ad, 0;
# } elsif ($cell =~ /\A([+-]?\d+)(\.?)(\d*)[%]?\z/) {
# # decimal notation number (with optional percent sign). TODO: allow arbitraty units after number, e.g. ml, mcg, etc? but should we align the unit too?
# 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
# #say "D2";
#
# my $fres;
# my $backend = $ENV{FORMAT_PRETTY_TABLE_BACKEND};
# $backend //= "Text::Table::Org" if $ENV{INSIDE_EMACS};
# my $backend_opts = $ENV{FORMAT_PRETTY_TABLE_BACKEND_OPTS};
# if (defined $backend_opts) {
# $backend_opts = eval { _json->decode($backend_opts) };
# die "Invalid JSON in FORMAT_PRETTY_TABLE_BACKEND_OPTS: $@" if $@;
# } else {
# $backend_opts = {};
# }
# if ($backend) {
# require Text::Table::Any;
# $fres = Text::Table::Any::table(
# rows => $data,
# header_row => $header_row,
# backend => $backend,
# backend_opts => $backend_opts,
# (caption => $resmeta->{caption}) x !!defined($resmeta->{caption}),
# );
# } 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 {
# my $cell = $_;
# $cell =~ s/"/""/g;
# qq("$cell");
# } @$row)."\n";
# } @$data
# );
# } elsif ($format eq 'tsv') {
# no warnings 'uninitialized';
# join("", map { my $row = $_; join("\t", @$row)."\n" } @$data);
# } elsif ($format eq 'ltsv') {
# no warnings 'uninitialized';
# join("", map { my $row = $_; join("\t", map { "$columns[$_]:$row->[$_]" } 0 .. $#{$row})."\n" } @$data);
# } elsif ($format eq 'html') {
# no warnings 'uninitialized';
# require HTML::Entities;
#
# my $tfa = $resmeta->{'table.field_aligns'};
#
# my @res;
# push @res, "<table".($resmeta->{'table.html_class'} ?
# " class=\"".HTML::Entities::encode_entities(
# $resmeta->{'table.html_class'})."\"" : "").
# ">\n";
# for my $i (0..$#{$data}) {
# my $data_elem = $i == 0 ? "th" : "td";
script/pick-random-lines 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.98.0 of Sah::Schema::rinci::function_meta (from Perl distribution Sah-Schemas-Rinci), released on 2021-07-20.
#
#=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
#
( run in 0.468 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )