App-PickRandomLines
view release on metacpan or search on metacpan
script/_pick view on Meta::CPAN
# }
# 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;
script/_pick view on Meta::CPAN
# 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;
# }
script/_pick view on Meta::CPAN
# $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};
script/_pick view on Meta::CPAN
#
# my @expects;
#
# $i = -1;
# my $argpos = 0;
#
# WORD:
# while (1) {
# last WORD if ++$i >= @words;
# my $word = $words[$i];
# #say "D:i=$i, word=$word, ~~\@words=",~~@words;
#
# if ($word eq '--' && $i != $cword) {
# $expects[$i] = {separator=>1};
# while (1) {
# $i++;
# last WORD if $i >= @words;
# $expects[$i] = {arg=>1, argpos=>$argpos++};
# }
# }
#
script/_pick view on Meta::CPAN
# if (keys(%$matching_opts) == 1) {
# my $opthash = $matching_opts->{ (keys %$matching_opts)[0] };
# $opt = $opthash->{name};
# $expects[$i]{optname} = $opt;
# my $nth = $seen_opts{$opt} // 0;
# $expects[$i]{nth} = $nth;
# _mark_seen(\%seen_opts, $opt, \%opts);
#
# my $min_vals = $opthash->{parsed}{min_vals};
# my $max_vals = $opthash->{parsed}{max_vals};
# #say "D:min_vals=$min_vals, max_vals=$max_vals";
#
# # detect = after --opt
# if ($i+1 < @words && $words[$i+1] eq '=') {
# $i++;
# $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
# # force expecting a value due to =
# $min_vals = 1;
# $max_vals = $min_vals if $max_vals < $min_vals;
# }
#
script/_pick view on Meta::CPAN
# } else {
# $expects[$i]{optname} = '';
# $expects[$i]{arg} = 1;
# $expects[$i]{argpos} = $argpos++;
# }
# }
#
# my $exp = $expects[$cword];
# my $word = $exp->{word} // $words[$cword];
#
# #use DD; say "D:opts: "; dd \%opts;
# #use DD; print "D:words: "; dd \@words;
# #say "D:cword: $cword";
# #use DD; print "D:expects: "; dd \@expects;
# #use DD; print "D:seen_opts: "; dd \%seen_opts;
# #use DD; print "D:parsed_opts: "; dd \%parsed_opts;
# #use DD; print "D:exp: "; dd $exp;
# #use DD; say "D:word:<$word>";
#
# my @answers;
#
# # complete option names
# {
# last if $word =~ /\A[^-]/;
# last unless exists $exp->{optname};
# last if defined($exp->{do_complete_optname}) &&
# !$exp->{do_complete_optname};
# if ($exp->{comp_result}) {
# push @answers, $exp->{comp_result};
# last;
# }
# #say "D:completing option names";
# my $opt = $exp->{optname};
# my @o;
# my @osumms;
# my $o_has_summaries;
# for my $optname (@optnames) {
# my $repeatable = 0;
# next if $exp->{short_only} && $optname =~ /\A--/;
# if ($seen_opts{$optname}) {
# my $opthash = $opts{$optname};
# my $parsed = $opthash->{parsed};
script/_pick view on Meta::CPAN
# push @answers, $compres;
# if (!exists($exp->{optval}) && !exists($exp->{arg})) {
# $fres = {words=>$compres, esc_mode=>'option'};
# goto RETURN_RES;
# }
# }
#
# # complete option value
# {
# last unless exists($exp->{optval});
# #say "D:completing option value";
# my $opt = $exp->{optval};
# my $opthash; $opthash = $opts{$opt} if $opt;
# my %compargs = (
# %$extras,
# type=>'optval', words=>\@words, cword=>$args{cword},
# word=>$word, opt=>($opt // $exp->{possible_optnames}), ospec=>$opthash->{ospec},
# argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
# parsed_opts=>\%parsed_opts,
# );
# my $compres;
script/_pick view on Meta::CPAN
# {
# @intermediate_dirs = split qr/\Q$path_sep/, $word;
# @intermediate_dirs = ('') if !@intermediate_dirs;
# push @intermediate_dirs, '' if $word =~ $re_ends_with_path_sep;
# }
#
# # extract leaf path, because this one is treated differently
# my $leaf = pop @intermediate_dirs;
# @intermediate_dirs = ('') if !@intermediate_dirs;
#
# #say "D:starting_path=<$starting_path>";
# #say "D:intermediate_dirs=[",join(", ", map{"<$_>"} @intermediate_dirs),"]";
# #say "D:leaf=<$leaf>";
#
# # candidate for intermediate paths. when doing case-insensitive search,
# # there maybe multiple candidate paths for each dir, for example if
# # word='../foo/s' and there is '../foo/Surya', '../Foo/sri', '../FOO/SUPER'
# # then candidate paths would be ['../foo', '../Foo', '../FOO'] and the
# # filename should be searched inside all those dirs. everytime we drill down
# # to deeper subdirectories, we adjust this list by removing
# # no-longer-eligible candidates.
# my @candidate_paths;
#
script/_pick view on Meta::CPAN
# @dirs = @candidate_paths;
# }
#
# if ($i == $#intermediate_dirs && $intdir eq '') {
# @candidate_paths = @dirs;
# last;
# }
#
# my @new_candidate_paths;
# for my $dir (@dirs) {
# #say "D: intdir list($dir)";
# my $listres = $list_func->($dir, $intdir, 1);
# next unless $listres && @$listres;
# #use DD; say "D: list res=", DD::dump($listres);
# my $matches = Complete::Util::complete_array_elem(
# word => $intdir, array => $listres,
# );
# my $exact_matches = [grep {
# $_ eq $intdir || $_ eq $intdir_with_path_sep
# } @$matches];
# #use Data::Dmp; say "D: word=<$intdir>, matches=", dmp($matches), ", exact_matches=", dmp($exact_matches);
#
# # when doing exp_im_path, check if we have a single exact match. in
# # that case, don't use all the candidates because that can be
# # annoying, e.g. you have 'a/foo' and 'and/food', you won't be able
# # to complete 'a/f' because bash (e.g.) will always cut the answer
# # to 'a' because the candidates are 'a/foo' and 'and/foo' (it will
# # use the shortest common string which is 'a').
# #say "D: num_exact_matches: ", scalar @$exact_matches;
# if (!$exp_im_path || @$exact_matches == 1) {
# $matches = $exact_matches;
# }
#
# for (@$matches) {
# my $p = $dir =~ $re_ends_with_path_sep ?
# "$dir$_" : "$dir$path_sep$_";
# push @new_candidate_paths, $p;
# }
#
# }
# #say "D: candidate_paths=[",join(", ", map{"<$_>"} @new_candidate_paths),"]";
# return [] unless @new_candidate_paths;
# @candidate_paths = @new_candidate_paths;
# }
# log_trace "[comppath] candidate paths: %s", \@candidate_paths if $ENV{COMPLETE_PATH_TRACE};
#
# for my $dir (@candidate_paths) {
# #say "D:opendir($dir)";
# my $listres = $list_func->($dir, $leaf, 0);
# next unless $listres && @$listres;
# my $matches = Complete::Util::complete_array_elem(
# word => $leaf, array => $listres,
# );
# #use DD; dd $matches;
#
# L1:
# for my $e (@$matches) {
# my $p = $dir =~ $re_ends_with_path_sep ?
script/_pick view on Meta::CPAN
# starting_path => $p,
# word => '',
# _cut_chars => $cut_chars,
# )};
# } elsif ($dig_leaf) {
# DIG_LEAF:
# {
# my $p2 = _dig_leaf($p, $list_func, $is_dir_func, $filter_func, $path_sep);
# last DIG_LEAF if $p2 eq $p;
# $p = $p2;
# #say "D:p=$p (dig_leaf)";
#
# # check again
# if ($p =~ $re_ends_with_path_sep) {
# $is_dir = 1;
# } else {
# local $_ = $p; # convenience for is_dir_func
# $is_dir = $is_dir_func->($p);
# }
# } # DIG_LEAF
# }
script/_pick view on Meta::CPAN
# if ($editdist_flex) {
# $d = $code_editdist->($wordn, $chopped, $maxd);
# next ELEM unless defined $d;
# } else {
# $d = $code_editdist->($wordn, $chopped);
# }
# $editdists{$chopped} = $d;
# } else {
# $d = $editdists{$chopped};
# }
# #say "D: d($word,$chopped)=$d (maxd=$maxd)";
# next unless $d <= $maxd;
# push @words, $array[$i];
# push @wordsumms, $arraysumms[$i] if $summaries;
# next ELEM;
# }
# }
# log_trace("[computil] Result from fuzzy matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
# }
#
# # replace back the words from replace_map
script/_pick view on Meta::CPAN
# modify_answer(answer=>$res, prefix=>$prefix);
# }
#}
#
#$SPEC{combine_answers} = {
# v => 1.1,
# summary => 'Given two or more answers, combine them into one',
# description => <<'_',
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool <prog:cpanm>, which accepts a filename (a tarball like
#`*.tar.gz`), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
# complete_module(word=>$word),
# );
#
#But if a completion answer has a metadata `final` set to true, then that answer
#is used as the final answer without any combining with the other answers.
script/_pick view on Meta::CPAN
#
#=head2 combine_answers
#
#Usage:
#
# combine_answers($answers, ...) -> hash
#
#Given two or more answers, combine them into one.
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool L<cpanm>, which accepts a filename (a tarball like
#C<*.tar.gz>), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
# complete_module(word=>$word),
# );
#
#But if a completion answer has a metadata C<final> set to true, then that answer
#is used as the final answer without any combining with the other answers.
script/_pick view on Meta::CPAN
#
#in scalar context, or:
#
# (undef, $path, $entry, $index, $name_mod, $name_pm, $name_path)
#
#in list context. In scalar context, you can differentiate path from module
#source because the path is returned as a scalar reference. So to get the path:
#
# $source_or_pathref = module_source("Foo/Bar.pm", {find_prefix=>1});
# if (ref $source_or_pathref eq 'SCALAR') {
# say "Path is ", $$source_or_pathref;
# } else {
# say "Module source code is $source_or_pathref";
# }
#
#=item * all
#
#Bool. If set to true, then instead of stopping after one source is found, the
#function will continue finding sources until all entries in C<@INC> is
#exhausted. Then will return all the found sources as an arrayref:
#
# my $sources = module_source($name, {all=>1});
#
script/_pick view on Meta::CPAN
# contains_class_wildcard
# contains_joker_wildcard
# contains_qmark_wildcard
# contains_glob_wildcard
# contains_globstar_wildcard
#
# convert_wildcard_to_sql
# convert_wildcard_to_re
# );
#
# say 1 if contains_wildcard("")); # ->
# say 1 if contains_wildcard("ab*")); # -> 1
# say 1 if contains_wildcard("ab\\*")); # ->
#
# say 1 if contains_glob_wildcard("ab*")); # -> 1
# say 1 if contains_glob_wildcard("ab?")); # ->
# say 1 if contains_qmark_wildcard("ab?")); # -> 1
#
# say convert_wildcard_to_sql("foo*"); # -> "foo%"
#
# say convert_wildcard_to_re("foo*"); # -> "foo.*"
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(qqquote)$
#
#=head1 VARIABLES
#
#=head2 $RE_WILDCARD_BASH
#
#=head1 FUNCTIONS
script/_pick-random-lines view on Meta::CPAN
# }
# 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;
script/_pick-random-lines view on Meta::CPAN
# 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;
# }
script/_pick-random-lines view on Meta::CPAN
# $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};
script/_pick-random-lines view on Meta::CPAN
#
# my @expects;
#
# $i = -1;
# my $argpos = 0;
#
# WORD:
# while (1) {
# last WORD if ++$i >= @words;
# my $word = $words[$i];
# #say "D:i=$i, word=$word, ~~\@words=",~~@words;
#
# if ($word eq '--' && $i != $cword) {
# $expects[$i] = {separator=>1};
# while (1) {
# $i++;
# last WORD if $i >= @words;
# $expects[$i] = {arg=>1, argpos=>$argpos++};
# }
# }
#
script/_pick-random-lines view on Meta::CPAN
# if (keys(%$matching_opts) == 1) {
# my $opthash = $matching_opts->{ (keys %$matching_opts)[0] };
# $opt = $opthash->{name};
# $expects[$i]{optname} = $opt;
# my $nth = $seen_opts{$opt} // 0;
# $expects[$i]{nth} = $nth;
# _mark_seen(\%seen_opts, $opt, \%opts);
#
# my $min_vals = $opthash->{parsed}{min_vals};
# my $max_vals = $opthash->{parsed}{max_vals};
# #say "D:min_vals=$min_vals, max_vals=$max_vals";
#
# # detect = after --opt
# if ($i+1 < @words && $words[$i+1] eq '=') {
# $i++;
# $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
# # force expecting a value due to =
# $min_vals = 1;
# $max_vals = $min_vals if $max_vals < $min_vals;
# }
#
script/_pick-random-lines view on Meta::CPAN
# } else {
# $expects[$i]{optname} = '';
# $expects[$i]{arg} = 1;
# $expects[$i]{argpos} = $argpos++;
# }
# }
#
# my $exp = $expects[$cword];
# my $word = $exp->{word} // $words[$cword];
#
# #use DD; say "D:opts: "; dd \%opts;
# #use DD; print "D:words: "; dd \@words;
# #say "D:cword: $cword";
# #use DD; print "D:expects: "; dd \@expects;
# #use DD; print "D:seen_opts: "; dd \%seen_opts;
# #use DD; print "D:parsed_opts: "; dd \%parsed_opts;
# #use DD; print "D:exp: "; dd $exp;
# #use DD; say "D:word:<$word>";
#
# my @answers;
#
# # complete option names
# {
# last if $word =~ /\A[^-]/;
# last unless exists $exp->{optname};
# last if defined($exp->{do_complete_optname}) &&
# !$exp->{do_complete_optname};
# if ($exp->{comp_result}) {
# push @answers, $exp->{comp_result};
# last;
# }
# #say "D:completing option names";
# my $opt = $exp->{optname};
# my @o;
# my @osumms;
# my $o_has_summaries;
# for my $optname (@optnames) {
# my $repeatable = 0;
# next if $exp->{short_only} && $optname =~ /\A--/;
# if ($seen_opts{$optname}) {
# my $opthash = $opts{$optname};
# my $parsed = $opthash->{parsed};
script/_pick-random-lines view on Meta::CPAN
# push @answers, $compres;
# if (!exists($exp->{optval}) && !exists($exp->{arg})) {
# $fres = {words=>$compres, esc_mode=>'option'};
# goto RETURN_RES;
# }
# }
#
# # complete option value
# {
# last unless exists($exp->{optval});
# #say "D:completing option value";
# my $opt = $exp->{optval};
# my $opthash; $opthash = $opts{$opt} if $opt;
# my %compargs = (
# %$extras,
# type=>'optval', words=>\@words, cword=>$args{cword},
# word=>$word, opt=>($opt // $exp->{possible_optnames}), ospec=>$opthash->{ospec},
# argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts,
# parsed_opts=>\%parsed_opts,
# );
# my $compres;
script/_pick-random-lines view on Meta::CPAN
# {
# @intermediate_dirs = split qr/\Q$path_sep/, $word;
# @intermediate_dirs = ('') if !@intermediate_dirs;
# push @intermediate_dirs, '' if $word =~ $re_ends_with_path_sep;
# }
#
# # extract leaf path, because this one is treated differently
# my $leaf = pop @intermediate_dirs;
# @intermediate_dirs = ('') if !@intermediate_dirs;
#
# #say "D:starting_path=<$starting_path>";
# #say "D:intermediate_dirs=[",join(", ", map{"<$_>"} @intermediate_dirs),"]";
# #say "D:leaf=<$leaf>";
#
# # candidate for intermediate paths. when doing case-insensitive search,
# # there maybe multiple candidate paths for each dir, for example if
# # word='../foo/s' and there is '../foo/Surya', '../Foo/sri', '../FOO/SUPER'
# # then candidate paths would be ['../foo', '../Foo', '../FOO'] and the
# # filename should be searched inside all those dirs. everytime we drill down
# # to deeper subdirectories, we adjust this list by removing
# # no-longer-eligible candidates.
# my @candidate_paths;
#
script/_pick-random-lines view on Meta::CPAN
# @dirs = @candidate_paths;
# }
#
# if ($i == $#intermediate_dirs && $intdir eq '') {
# @candidate_paths = @dirs;
# last;
# }
#
# my @new_candidate_paths;
# for my $dir (@dirs) {
# #say "D: intdir list($dir)";
# my $listres = $list_func->($dir, $intdir, 1);
# next unless $listres && @$listres;
# #use DD; say "D: list res=", DD::dump($listres);
# my $matches = Complete::Util::complete_array_elem(
# word => $intdir, array => $listres,
# );
# my $exact_matches = [grep {
# $_ eq $intdir || $_ eq $intdir_with_path_sep
# } @$matches];
# #use Data::Dmp; say "D: word=<$intdir>, matches=", dmp($matches), ", exact_matches=", dmp($exact_matches);
#
# # when doing exp_im_path, check if we have a single exact match. in
# # that case, don't use all the candidates because that can be
# # annoying, e.g. you have 'a/foo' and 'and/food', you won't be able
# # to complete 'a/f' because bash (e.g.) will always cut the answer
# # to 'a' because the candidates are 'a/foo' and 'and/foo' (it will
# # use the shortest common string which is 'a').
# #say "D: num_exact_matches: ", scalar @$exact_matches;
# if (!$exp_im_path || @$exact_matches == 1) {
# $matches = $exact_matches;
# }
#
# for (@$matches) {
# my $p = $dir =~ $re_ends_with_path_sep ?
# "$dir$_" : "$dir$path_sep$_";
# push @new_candidate_paths, $p;
# }
#
# }
# #say "D: candidate_paths=[",join(", ", map{"<$_>"} @new_candidate_paths),"]";
# return [] unless @new_candidate_paths;
# @candidate_paths = @new_candidate_paths;
# }
# log_trace "[comppath] candidate paths: %s", \@candidate_paths if $ENV{COMPLETE_PATH_TRACE};
#
# for my $dir (@candidate_paths) {
# #say "D:opendir($dir)";
# my $listres = $list_func->($dir, $leaf, 0);
# next unless $listres && @$listres;
# my $matches = Complete::Util::complete_array_elem(
# word => $leaf, array => $listres,
# );
# #use DD; dd $matches;
#
# L1:
# for my $e (@$matches) {
# my $p = $dir =~ $re_ends_with_path_sep ?
script/_pick-random-lines view on Meta::CPAN
# starting_path => $p,
# word => '',
# _cut_chars => $cut_chars,
# )};
# } elsif ($dig_leaf) {
# DIG_LEAF:
# {
# my $p2 = _dig_leaf($p, $list_func, $is_dir_func, $filter_func, $path_sep);
# last DIG_LEAF if $p2 eq $p;
# $p = $p2;
# #say "D:p=$p (dig_leaf)";
#
# # check again
# if ($p =~ $re_ends_with_path_sep) {
# $is_dir = 1;
# } else {
# local $_ = $p; # convenience for is_dir_func
# $is_dir = $is_dir_func->($p);
# }
# } # DIG_LEAF
# }
script/_pick-random-lines view on Meta::CPAN
# if ($editdist_flex) {
# $d = $code_editdist->($wordn, $chopped, $maxd);
# next ELEM unless defined $d;
# } else {
# $d = $code_editdist->($wordn, $chopped);
# }
# $editdists{$chopped} = $d;
# } else {
# $d = $editdists{$chopped};
# }
# #say "D: d($word,$chopped)=$d (maxd=$maxd)";
# next unless $d <= $maxd;
# push @words, $array[$i];
# push @wordsumms, $arraysumms[$i] if $summaries;
# next ELEM;
# }
# }
# log_trace("[computil] Result from fuzzy matching: %s", \@words) if @words && $COMPLETE_UTIL_TRACE;
# }
#
# # replace back the words from replace_map
script/_pick-random-lines view on Meta::CPAN
# modify_answer(answer=>$res, prefix=>$prefix);
# }
#}
#
#$SPEC{combine_answers} = {
# v => 1.1,
# summary => 'Given two or more answers, combine them into one',
# description => <<'_',
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool <prog:cpanm>, which accepts a filename (a tarball like
#`*.tar.gz`), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
# complete_module(word=>$word),
# );
#
#But if a completion answer has a metadata `final` set to true, then that answer
#is used as the final answer without any combining with the other answers.
script/_pick-random-lines view on Meta::CPAN
#
#=head2 combine_answers
#
#Usage:
#
# combine_answers($answers, ...) -> hash
#
#Given two or more answers, combine them into one.
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool L<cpanm>, which accepts a filename (a tarball like
#C<*.tar.gz>), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
# complete_module(word=>$word),
# );
#
#But if a completion answer has a metadata C<final> set to true, then that answer
#is used as the final answer without any combining with the other answers.
script/_pick-random-lines view on Meta::CPAN
#
#in scalar context, or:
#
# (undef, $path, $entry, $index, $name_mod, $name_pm, $name_path)
#
#in list context. In scalar context, you can differentiate path from module
#source because the path is returned as a scalar reference. So to get the path:
#
# $source_or_pathref = module_source("Foo/Bar.pm", {find_prefix=>1});
# if (ref $source_or_pathref eq 'SCALAR') {
# say "Path is ", $$source_or_pathref;
# } else {
# say "Module source code is $source_or_pathref";
# }
#
#=item * all
#
#Bool. If set to true, then instead of stopping after one source is found, the
#function will continue finding sources until all entries in C<@INC> is
#exhausted. Then will return all the found sources as an arrayref:
#
# my $sources = module_source($name, {all=>1});
#
script/_pick-random-lines view on Meta::CPAN
# contains_class_wildcard
# contains_joker_wildcard
# contains_qmark_wildcard
# contains_glob_wildcard
# contains_globstar_wildcard
#
# convert_wildcard_to_sql
# convert_wildcard_to_re
# );
#
# say 1 if contains_wildcard("")); # ->
# say 1 if contains_wildcard("ab*")); # -> 1
# say 1 if contains_wildcard("ab\\*")); # ->
#
# say 1 if contains_glob_wildcard("ab*")); # -> 1
# say 1 if contains_glob_wildcard("ab?")); # ->
# say 1 if contains_qmark_wildcard("ab?")); # -> 1
#
# say convert_wildcard_to_sql("foo*"); # -> "foo%"
#
# say convert_wildcard_to_re("foo*"); # -> "foo.*"
#
#=head1 DESCRIPTION
#
#=for Pod::Coverage ^(qqquote)$
#
#=head1 VARIABLES
#
#=head2 $RE_WILDCARD_BASH
#
#=head1 FUNCTIONS
script/pick view on Meta::CPAN
# }
# 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;
script/pick view on Meta::CPAN
# 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;
# }
script/pick view on Meta::CPAN
# $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};
script/pick view on Meta::CPAN
# }
#
# 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);
script/pick view on Meta::CPAN
# 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;
script/pick view on Meta::CPAN
# } 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 = {};
script/pick view on Meta::CPAN
#=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);
#
script/pick-random-lines view on Meta::CPAN
# }
# 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;
script/pick-random-lines view on Meta::CPAN
# 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;
# }
script/pick-random-lines view on Meta::CPAN
# $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};
script/pick-random-lines view on Meta::CPAN
# }
#
# 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);
script/pick-random-lines view on Meta::CPAN
# 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;
script/pick-random-lines view on Meta::CPAN
# } 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 = {};
script/pick-random-lines view on Meta::CPAN
#=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);
#
( run in 0.386 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )