App-Genpass-ID
view release on metacpan or search on metacpan
script/_genpass-id view on Meta::CPAN
# return $CloneCache{ $source } = $source->$CloneSelfMethod()
# if $source->can($CloneSelfMethod);
# }
#
#
# my $copy;
# if ($ref_type eq 'HASH') {
# $CloneCache{ $source } = $copy = {};
# if ( my $tied = tied( %$source ) ) { tie %$copy, ref $tied }
# %$copy = map { ! ref($_) ? $_ : clone($_, $depth) } %$source;
# } elsif ($ref_type eq 'ARRAY') {
# $CloneCache{ $source } = $copy = [];
# if ( my $tied = tied( @$source ) ) { tie @$copy, ref $tied }
# @$copy = map { ! ref($_) ? $_ : clone($_, $depth) } @$source;
# } elsif ($ref_type eq 'REF' or $ref_type eq 'SCALAR') {
# $CloneCache{ $source } = $copy = \( my $var = "" );
# if ( my $tied = tied( $$source ) ) { tie $$copy, ref $tied }
# $$copy = clone($$source, $depth);
# } else {
# $CloneCache{ $source } = $copy = $source;
# }
#
# if ( $class_name ) {
# bless $copy, $class_name;
# $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
# }
#
# return $copy;
#}
#
#1;
#
#__END__
#
### Complete/Bash.pm ###
#package Complete::Bash;
#
#our $DATE = '2016-12-28';
#our $VERSION = '0.31';
#
#use 5.010001;
#use strict;
#use warnings;
#
#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";
#}
#
#sub _add_unquoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word, $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,
# },
# },
# result_naked => 1,
#};
#sub point {
# my ($line, $marker) = @_;
# $marker //= '^';
#
# my $point = index($line, $marker);
# die "BUG: No marker '$marker' in line <$line>" unless $point >= 0;
# $line =~ s/\Q$marker\E//;
# ($line, $point);
#}
#
#$SPEC{parse_cmdline} = {
# v => 1.1,
# summary => 'Parse shell command-line for processing by completion routines',
# description => <<'_',
#
#This function basically converts `COMP_LINE` (str) and `COMP_POINT` (int) into
#something like (but not exactly the same as) `COMP_WORDS` (array) and
#`COMP_CWORD` (int) that bash supplies to shell functions.
#
#The differences with bash are (these differences are mostly for parsing
#convenience for programs that use this routine; this comparison is made against
#bash versions 4.2-4.3):
#
#1) quotes and backslashes are stripped (bash's `COMP_WORDS` contains all the
# quotes and backslashes);
#
#2) quoted phrase that contains spaces, or phrase that contains escaped spaces is
# parsed as a single word. For example:
#
# command "First argument" Second\ argument
#
# bash would split it as (represented as Perl):
#
# ["command", "\"First", "argument\"", "Second\\", "argument"]
#
# which is not very convenient. We parse it into:
#
# ["command", "First argument", "Second argument"]
#
#3) variables are substituted with their values from environment variables except
# for the current word (`COMP_WORDS[COMP_CWORD]`) (bash does not perform
# variable substitution for `COMP_WORDS`). However, note that special shell
# variables that are not environment variables like `$0`, `$_`, `$IFS` will not
# be replaced correctly because bash does not export those variables for us.
#
#4) tildes (`~`) are expanded with user's home directory except for the current
# word (bash does not perform tilde expansion for `COMP_WORDS`);
#
#Caveats:
#
#* Like bash, we group non-whitespace word-breaking characters into its own word.
# By default `COMP_WORDBREAKS` is:
#
# "'@><=;|&(:
#
# So if raw command-line is:
#
# command --foo=bar http://example.com:80 mail@example.org Foo::Bar
#
# then the parse result will be:
#
# ["command", "--foo", "=", "bar", "http", ":", "//example.com", ":", "80", "Foo", "::", "Bar"]
#
# which is annoying sometimes. But we follow bash here so we can more easily
# accept input from a joined `COMP_WORDS` if we write completion bash functions,
# e.g. (in the example, `foo` is a Perl script):
#
# _foo ()
# {
# local words=(${COMP_CWORDS[@]})
# # add things to words, etc
# local point=... # calculate the new point
# COMPREPLY=( `COMP_LINE="foo ${words[@]}" COMP_POINT=$point foo` )
# }
#
# To avoid these word-breaking characters to be split/grouped, we can escape
# them with backslash or quote them, e.g.:
#
# command "http://example.com:80" Foo\:\:Bar
#
# which bash will parse as:
#
# ["command", "\"http://example.com:80\"", "Foo\\:\\:Bar"]
#
# and we parse as:
#
# ["command", "http://example.com:80", "Foo::Bar"]
#
#* Due to the way bash parses the command line (see above), the two below are
# equivalent:
#
# % cmd --foo=bar
# % cmd --foo = bar
#
#Because they both expand to `['--foo', '=', 'bar']`. But obviously
#<pm:Getopt::Long> does not regard the two as equivalent.
#
#_
# args_as => 'array',
# args => {
# cmdline => {
# summary => 'Command-line, defaults to COMP_LINE environment',
# schema => 'str*',
# pos => 0,
# },
# point => {
# summary => 'Point/position to complete in command-line, '.
# 'defaults to COMP_POINT',
# schema => 'int*',
# pos => 1,
# },
# opts => {
# summary => 'Options',
# schema => 'hash*',
# description => <<'_',
#
#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;
#
script/_genpass-id view on Meta::CPAN
# require Complete::Env;
# require Complete::File;
# require Complete::Util;
#
# my %args = @_;
# my $word = $args{word} // '';
#
# my $fres;
#
# if ($word =~ /\A\$/) {
# {
# my $compres = Complete::Env::complete_env(
# word=>$word);
# last unless @$compres;
# $fres = {words=>$compres, esc_mode=>'shellvar'};
# goto RETURN_RES;
# }
# }
#
# if ($word =~ m!\A~([^/]*)\z!) {
# {
# eval { require Unix::Passwd::File };
# last if $@;
# my $res = Unix::Passwd::File::list_users(detail=>1);
# last unless $res->[0] == 200;
# my $compres = Complete::Util::complete_array_elem(
# array=>[map {"~" . $_->{user} . ((-d $_->{home}) ? "/":"")}
# @{ $res->[2] }],
# word=>$word,
# );
# last unless @$compres;
# $fres = {words=>$compres, path_sep=>'/'};
# goto RETURN_RES;
# }
# }
#
# if ($word =~ m!\A(~[^/]*)/!) {
# $fres = {words=>Complete::File::complete_file(word=>$word),
# path_sep=>'/'};
# goto RETURN_RES;
# }
#
# require String::Wildcard::Bash;
# if (String::Wildcard::Bash::contains_wildcard($word)) {
# {
# my $compres = [glob("$word*")];
# last unless @$compres;
# for (@$compres) {
# $_ .= "/" if (-d $_);
# }
# $fres = {words=>$compres, path_sep=>'/'};
# goto RETURN_RES;
# }
# }
# $fres = {words=>Complete::File::complete_file(word=>$word),
# path_sep=>'/'};
# RETURN_RES:
# $fres;
#}
#
#sub _expand1 {
# my ($opt, $opts) = @_;
# my @candidates;
# my $is_hash = ref($opts) eq 'HASH';
# for ($is_hash ? (sort {length($a)<=>length($b)} keys %$opts) : @$opts) {
# next unless index($_, $opt) == 0;
# push @candidates, $is_hash ? $opts->{$_} : $_;
# last if $opt eq $_;
# }
# return @candidates == 1 ? $candidates[0] : undef;
#}
#
#sub _mark_seen {
# my ($seen_opts, $opt, $opts) = @_;
# my $opthash = $opts->{$opt};
# return unless $opthash;
# my $ospec = $opthash->{ospec};
# for (keys %$opts) {
# my $v = $opts->{$_};
# $seen_opts->{$_}++ if $v->{ospec} eq $ospec;
# }
#}
#
#$SPEC{complete_cli_arg} = {
# v => 1.1,
# summary => 'Complete command-line argument using '.
# 'Getopt::Long specification',
# description => <<'_',
#
#This routine can complete option names, where the option names are retrieved
#from <pm:Getopt::Long> specification. If you provide completion routine in
#`completion`, you can also complete _option values_ and _arguments_.
#
#Note that this routine does not use <pm:Getopt::Long> (it does its own parsing)
#and currently is not affected by Getopt::Long's configuration. Its behavior
#mimics Getopt::Long under these configuration: `no_ignore_case`, `bundling` (or
#`no_bundling` if the `bundling` option is turned off). Which I think is the
#sensible default. This routine also does not currently support `auto_help` and
#`auto_version`, so you'll need to add those options specifically if you want to
#recognize `--help/-?` and `--version`, respectively.
#
#_
# args => {
# getopt_spec => {
# summary => 'Getopt::Long specification',
# schema => 'hash*',
# req => 1,
# },
# completion => {
# summary =>
# 'Completion routine to complete option value/argument',
# schema => 'code*',
# description => <<'_',
#
#Completion code will receive a hash of arguments (`%args`) containing these
#keys:
#
#* `type` (str, what is being completed, either `optval`, or `arg`)
#* `word` (str, word to be completed)
#* `cword` (int, position of words in the words array, starts from 0)
#* `opt` (str, option name, e.g. `--str`; undef if we're completing argument)
script/_genpass-id view on Meta::CPAN
# }
# }
# }
# my @optnames = sort keys %opts;
#
# my %seen_opts;
#
#
# my @expects;
#
# my $i = -1;
# my $argpos = 0;
#
# WORD:
# while (1) {
# last WORD if ++$i >= @words;
# my $word = $words[$i];
#
# if ($word eq '--' && $i != $cword) {
# $expects[$i] = {separator=>1};
# while (1) {
# $i++;
# last WORD if $i >= @words;
# $expects[$i] = {arg=>1, argpos=>$argpos++};
# }
# }
#
# if ($word =~ /\A-/) {
#
# SHORT_OPTS:
# {
# last unless $opts{"-".substr($word,1,1)};
#
# last unless $bundling;
#
# my $j = $i;
# my $rest = substr($word, 1);
# my @inswords;
# my $encounter_equal_sign;
# EXPAND:
# while (1) {
# $rest =~ s/(.)// or last;
# my $opt = "-$1";
# my $opthash = $opts{$opt};
# unless ($opthash) {
# @inswords = ();
# $expects[$i]{short_only} = 0;
# $rest = $word;
# last EXPAND;
# }
# if ($opthash->{parsed}{max_vals}) {
# _mark_seen(\%seen_opts, $opt, \%opts);
#
# if ($i == $j) {
# $words[$i] = $opt;
# } else {
# push @inswords, $opt;
# $j++;
# }
#
# my $expand;
# if (length $rest) {
# $expand++;
# $expects[$j > $i ? $j+1 : $j+2]{do_complete_optname} = 0;
# $expects[$j > $i ? $j+1 : $j+2]{optval} = $opt;
# } else {
# $expects[$j > $i ? $j-1 : $j]{optname} = $opt;
# $expects[$j > $i ? $j-1 : $j]{comp_result} = [
# substr($word, 0, length($word)-length($rest))];
# }
#
# if ($rest =~ s/\A=//) {
# $encounter_equal_sign++;
# }
#
# if ($expand) {
# push @inswords, "=", $rest;
# $j+=2;
# }
# last EXPAND;
# }
# _mark_seen(\%seen_opts, $opt, \%opts);
# if ($i == $j) {
# $words[$i] = $opt;
# } else {
# push @inswords, $opt;
# }
# $j++;
# }
#
#
# my $prefix = $encounter_equal_sign ? '' :
# substr($word, 0, length($word)-length($rest));
# splice @words, $i+1, 0, @inswords;
# for (0..@inswords) {
# $expects[$i+$_]{prefix} = $prefix;
# $expects[$i+$_]{word} = $rest;
# }
# $cword += @inswords;
# $i += @inswords;
# $word = $words[$i];
# $expects[$i]{short_only} //= 1;
# }
#
# SPLIT_EQUAL:
# {
# if ($word =~ /\A(--?[^=]+)(=)(.*)/) {
# splice @words, $i, 1, $1, $2, $3;
# $word = $1;
# $cword += 2 if $cword >= $i;
# }
# }
#
# my $opt = $word;
# my $opthash = _expand1($opt, \%opts);
#
# if ($opthash) {
# $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};
#
# if ($i+1 < @words && $words[$i+1] eq '=') {
# $i++;
# $expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth};
# if (!$max_vals) { $min_vals = $max_vals = 1 }
# }
#
# for (1 .. $min_vals) {
# $i++;
# last WORD if $i >= @words;
# $expects[$i]{optval} = $opt;
# $expects[$i]{nth} = $nth;
# push @{ $parsed_opts{$opt} }, $words[$i];
# }
# for (1 .. $max_vals-$min_vals) {
# last if $i+$_ >= @words;
# last if $words[$i+$_] =~ /\A-/;
# $expects[$i+$_]{optval} = $opt;
# $expects[$i]{nth} = $nth;
# push @{ $parsed_opts{$opt} }, $words[$i+$_];
# }
# } else {
# $opt = undef;
# $expects[$i]{optname} = $opt;
#
# if ($i+1 < @words && $words[$i+1] eq '=') {
# $i++;
# $expects[$i] = {separator=>1, optval=>undef, word=>''};
# if ($i+1 < @words) {
# $i++;
# $expects[$i]{optval} = $opt;
# }
# }
# }
# } else {
# $expects[$i]{optname} = '';
# $expects[$i]{arg} = 1;
# $expects[$i]{argpos} = $argpos++;
# }
# }
#
# my $exp = $expects[$cword];
# my $word = $exp->{word} // $words[$cword];
#
#
# my @answers;
#
# {
# last if $word =~ /\A[^-]/;
# last unless exists $exp->{optname};
script/_genpass-id view on Meta::CPAN
#__END__
#
### Complete/Path.pm ###
#package Complete::Path;
#
#our $DATE = '2017-07-03';
#our $VERSION = '0.24';
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Complete::Common qw(:all);
#
#our $COMPLETE_PATH_TRACE = $ENV{COMPLETE_PATH_TRACE} // 0;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# complete_path
# );
#
#sub _dig_leaf {
# my ($p, $list_func, $is_dir_func, $filter_func, $path_sep) = @_;
# my $num_dirs;
# my $listres = $list_func->($p, '', 0);
# return $p unless ref($listres) eq 'ARRAY' && @$listres;
# my @candidates;
# L1:
# for my $e (@$listres) {
# my $p2 = $p =~ m!\Q$path_sep\E\z! ? "$p$e" : "$p$path_sep$e";
# {
# local $_ = $p2;
# next L1 if $filter_func && !$filter_func->($p2);
# }
# push @candidates, $p2;
# }
# return $p unless @candidates == 1;
# my $p2 = $candidates[0];
# my $is_dir;
# if ($p2 =~ m!\Q$path_sep\E\z!) {
# $is_dir++;
# } else {
# $is_dir = $is_dir_func && $is_dir_func->($p2);
# }
# return _dig_leaf($p2, $list_func, $is_dir_func, $filter_func, $path_sep)
# if $is_dir;
# $p2;
#}
#
#our %SPEC;
#
#$SPEC{complete_path} = {
# v => 1.1,
# summary => 'Complete path',
# description => <<'_',
#
#Complete path, for anything path-like. Meant to be used as backend for other
#functions like `Complete::File::complete_file` or
#`Complete::Module::complete_module`. Provides features like case-insensitive
#matching, expanding intermediate paths, and case mapping.
#
#Algorithm is to split path into path elements, then list items (using the
#supplied `list_func`) and perform filtering (using the supplied `filter_func`)
#at every level.
#
#_
# args => {
# %arg_word,
# list_func => {
# summary => 'Function to list the content of intermediate "dirs"',
# schema => 'code*',
# req => 1,
# description => <<'_',
#
#Code will be called with arguments: ($path, $cur_path_elem, $is_intermediate).
#Code should return an arrayref containing list of elements. "Directories" can be
#marked by ending the name with the path separator (see `path_sep`). Or, you can
#also provide an `is_dir_func` function that will be consulted after filtering.
#If an item is a "directory" then its name will be suffixed with a path
#separator by `complete_path()`.
#
#_
# },
# is_dir_func => {
# summary => 'Function to check whether a path is a "dir"',
# schema => 'code*',
# description => <<'_',
#
#Optional. You can provide this function to determine if an item is a "directory"
#(so its name can be suffixed with path separator). You do not need to do this if
#you already suffix names of "directories" with path separator in `list_func`.
#
#One reason you might want to provide this and not mark "directories" in
#`list_func` is when you want to do extra filtering with `filter_func`. Sometimes
#you do not want to suffix the names first (example: see `complete_file` in
#`Complete::File`).
#
#_
# },
# starting_path => {
# schema => 'str*',
# req => 1,
# default => '',
# },
# filter_func => {
# schema => 'code*',
# description => <<'_',
#
#Provide extra filtering. Code will be given path and should return 1 if the item
#should be included in the final result or 0 if the item should be excluded.
#
#_
# },
# path_sep => {
# schema => 'str*',
# default => '/',
# },
# },
# result_naked => 1,
# result => {
script/_genpass-id view on Meta::CPAN
# "\t" => "\\t",
# "\n" => "\\n",
# "\f" => "\\f",
# "\r" => "\\r",
# "\e" => "\\e",
#);
#
#sub double_quote {
# local($_) = $_[0];
# s/([\\\"\@\$])/\\$1/g;
# return qq("$_") unless /[^\040-\176]/;
#
# s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
# s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
# s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
# s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
# return qq("$_");
#}
#
#sub single_quote {
# local($_) = $_[0];
# s/([\\'])/\\$1/g;
# return qq('$_');
#}
#1;
#
#__END__
#
### String/Wildcard/Bash.pm ###
#package String::Wildcard::Bash;
#
#use 5.010001;
#use strict;
#use warnings;
#
#our $VERSION = '0.03';
#
#use Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# $RE_WILDCARD_BASH
# contains_wildcard
# convert_wildcard_to_sql
# );
#
#our $RE_WILDCARD_BASH =
# qr(
# # non-escaped brace expression, with at least one comma
# (?P<brace>
# (?<!\\)(?:\\\\)*\{
# (?: \\\\ | \\\{ | \\\} | [^\\\{\}] )*
# (?:, (?: \\\\ | \\\{ | \\\} | [^\\\{\}] )* )+
# (?<!\\)(?:\\\\)*\}
# )
# |
# # non-escaped brace expression, to catch * or ? or [...] inside so
# # they don't go to below pattern, because bash doesn't consider them
# # wildcards, e.g. '/{et?,us*}' expands to '/etc /usr', but '/{et?}'
# # doesn't expand at all to /etc.
# (?P<braceno>
# (?<!\\)(?:\\\\)*\{
# (?: \\\\ | \\\{ | \\\} | [^\\\{\}] )*
# (?<!\\)(?:\\\\)*\}
# )
# |
# (?P<class>
# # non-empty, non-escaped character class
# (?<!\\)(?:\\\\)*\[
# (?: \\\\ | \\\[ | \\\] | [^\\\[\]] )+
# (?<!\\)(?:\\\\)*\]
# )
# |
# (?P<joker>
# # non-escaped * and ?
# (?<!\\)(?:\\\\)*[*?]
# )
# |
# (?P<sql_wc>
# # non-escaped % and ?
# (?<!\\)(?:\\\\)*[%_]
# )
# )ox;
#
#sub contains_wildcard {
# my $str = shift;
#
# while ($str =~ /$RE_WILDCARD_BASH/go) {
# my %m = %+;
# return 1 if $m{brace} || $m{class} || $m{joker};
# }
# 0;
#}
#
#sub convert_wildcard_to_sql {
# my $str = shift;
#
# $str =~ s/$RE_WILDCARD_BASH/
# if ($+{joker}) {
# if ($+{joker} eq '*') {
# "%";
# } else {
# "_";
# }
# } elsif ($+{sql_wc}) {
# "\\$+{sql_wc}";
# } else {
# $&;
# }
# /eg;
#
# $str;
#}
#
#1;
#
#__END__
#
### YAML/Old.pm ###
#package YAML::Old;
( run in 0.449 second using v1.01-cache-2.11-cpan-5623c5533a1 )