App-Genpass-ID
view release on metacpan or search on metacpan
script/_genpass-id view on Meta::CPAN
#
#Optional. Known options:
#
#* `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;
#
#
# my @words;
# my $cword;
# my $pos = 0;
# my $pos_min_ws = 0;
# my $after_ws = 1;
# 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] //= '';
#
# [\@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 -MData::Dump bob@example.org
#
#then they will be parsed as:
#
# ["command", "-MData", "::", "Dump", "bob", '@', "example.org"]
#
#Normally in Perl applications, we want `:`, `@` to be part of word. So this
#routine will convert the above into:
#
# ["command", "-MData::Dump", 'bob@example.org']
#
#_
#};
#sub join_wordbreak_words {
# my ($words, $cword) = @_;
# my $new_words = [];
# my $i = -1;
# while (++$i < @$words) {
# my $w = $words->[$i];
# if ($w =~ /\A[\@=:]+\z/) {
script/_genpass-id view on Meta::CPAN
# %complete_comma_sep_args,
# },
# result_naked => 1,
# result => {
# schema => 'array',
# },
#};
#sub complete_comma_sep {
# my %args = @_;
# my $word = delete $args{word} // "";
# my $sep = delete $args{sep} // ',';
# my $elems = delete $args{elems} or die "Please specify elems";
# my $uniq = delete $args{uniq};
# my $remaining = delete $args{remaining};
#
# my $ci = $Complete::Common::OPT_CI;
#
# my @mentioned_elems = split /\Q$sep\E/, $word, -1;
# my $cae_word = @mentioned_elems ? pop(@mentioned_elems) : '';
#
# my $remaining_elems;
# if ($remaining) {
# $remaining_elems = $remaining->(\@mentioned_elems, $elems);
# } elsif ($uniq) {
# my %mem;
# $remaining_elems = [];
# for (@mentioned_elems) {
# if ($ci) { $mem{lc $_}++ } else { $mem{$_}++ }
# }
# for (@$elems) {
# push @$remaining_elems, $_ unless ($ci ? $mem{lc $_} : $mem{$_});
# }
# } else {
# $remaining_elems = $elems;
# }
#
# my $cae_res = complete_array_elem(
# %args,
# word => $cae_word,
# array => $remaining_elems,
# );
#
# my $prefix = join($sep, @mentioned_elems);
# $prefix .= $sep if @mentioned_elems;
# $cae_res = [map { "$prefix$_" } @$cae_res];
#
# {
# last unless @$cae_res == 1;
# last if @$remaining_elems <= 1;
# $cae_res->[0] .= $sep;
# }
# $cae_res;
#}
#
#$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.
#
#_
# args => {
# answers => {
# schema => [
# 'array*' => {
# of => ['any*', of=>['hash*','array*']],
# min_len => 1,
# },
# ],
# req => 1,
# pos => 0,
# greedy => 1,
# },
# },
# args_as => 'array',
# result_naked => 1,
# result => {
# schema => 'hash*',
# description => <<'_',
#
#Return a combined completion answer. Words from each input answer will be
#combined, order preserved and duplicates removed. The other keys from each
#answer will be merged.
#
#_
# },
#};
#sub combine_answers {
# require List::Util;
#
# return undef unless @_;
# return $_[0] if @_ < 2;
#
# my $final = {words=>[]};
# my $encounter_hash;
# my $add_words = sub {
# my $words = shift;
# for my $entry (@$words) {
# push @{ $final->{words} }, $entry
# unless List::Util::first(
# sub {
# (ref($entry) ? $entry->{word} : $entry)
# eq
# (ref($_) ? $_->{word} : $_)
# }, @{ $final->{words} }
# );
# }
# };
#
script/_genpass-id view on Meta::CPAN
# return Regexp::Stringify::stringify_regexp(
# regexp=>$val, with_qr=>1, plver=>$OPT_PERL_VERSION);
# }
#
# if (blessed $val) {
# $class = $ref;
# $ref = reftype($val);
# }
#
# my $res;
# if ($ref eq 'ARRAY') {
# $res = "[";
# my $i = 0;
# for (@$val) {
# $res .= "," if $i;
# $res .= _dump($_, "$subscript\[$i]");
# $i++;
# }
# $res .= "]";
# } elsif ($ref eq 'HASH') {
# $res = "{";
# my $i = 0;
# for (sort keys %$val) {
# $res .= "," if $i++;
# my $k = _quote_key($_);
# my $v = _dump($val->{$_}, "$subscript\{$k}");
# $res .= "$k=>$v";
# }
# $res .= "}";
# } elsif ($ref eq 'SCALAR') {
# $res = "\\"._dump($$val, $subscript);
# } elsif ($ref eq 'REF') {
# $res = "\\"._dump($$val, $subscript);
# } elsif ($ref eq 'CODE') {
# $res = $OPT_DEPARSE ? _dump_code($val) : 'sub{"DUMMY"}';
# } else {
# die "Sorry, I can't dump $val (ref=$ref) yet";
# }
#
# $res = "bless($res,"._double_quote($class).")" if defined($class);
# $res;
#}
#
#our $_is_dd;
#sub _dd_or_dmp {
# local %_seen_refaddrs;
# local %_subscripts;
# local @_fixups;
#
# my $res;
# if (@_ > 1) {
# $res = "(" . join(",", map {_dump($_, '')} @_) . ")";
# } else {
# $res = _dump($_[0], '');
# }
# if (@_fixups) {
# $res = "do{my\$a=$res;" . join("", @_fixups) . "\$a}";
# }
#
# if ($_is_dd) {
# say $res;
# return wantarray() || @_ > 1 ? @_ : $_[0];
# } else {
# return $res;
# }
#}
#
#sub dd { local $_is_dd=1; _dd_or_dmp(@_) }
#sub dmp { goto &_dd_or_dmp }
#
#1;
#
#__END__
#
### Data/ModeMerge.pm ###
#package Data::ModeMerge;
#
#our $DATE = '2016-07-22';
#our $VERSION = '0.35';
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Mo qw(build default);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT = qw(mode_merge);
#
#sub mode_merge {
# my ($l, $r, $config_vars) = @_;
# my $mm = __PACKAGE__->new(config => $config_vars);
# $mm->merge($l, $r);
#}
#
#has config => (is => "rw");
#
#has modes => (is => 'rw', default => sub { {} });
#
#has combine_rules => (is => 'rw');
#
#has path => (is => "rw", default => sub { [] });
#has errors => (is => "rw", default => sub { [] });
#has mem => (is => "rw", default => sub { {} });
#has cur_mem_key => (is => "rw");
#
#sub _in($$) {
# state $load_dmp = do { require Data::Dmp };
# my ($self, $needle, $haystack) = @_;
# return 0 unless defined($needle);
# my $r1 = ref($needle);
# my $f1 = $r1 ? Data::Dmp::dmp($needle) : undef;
# for (@$haystack) {
# my $r2 = ref($_);
# next if $r1 xor $r2;
# return 1 if $r2 && $f1 eq Data::Dmp::dmp($_);
# return 1 if !$r2 && $needle eq $_;
# }
# 0;
#}
( run in 0.647 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )