Result:
found more than 886 distributions - search limited to the first 2001 files matching your query
( run in 0.506 )
App-Waf
view release on metacpan or search on metacpan
lib/App/Waf.pm view on Meta::CPAN
'(gopher|doc|php|glob|file|phar|zlib|ftp|ldap|dict|ogg|data)\:\/',
'java\.lang',
'\$_(GET|post|cookie|files|session|env|phplib|GLOBALS|SERVER)\[',
'\<(iframe|script|body|img|layer|div|meta|style|base|object|input)',
'(onmouseover|onerror|onload)\=',
'\.(bak|inc|old|mdb|sql|backup|java|class)$',
'\.(svn|htaccess|bash_history)',
'(vhost|bbs|host|wwwroot|www|site|root|hytop|flashfxp).*\.rar',
'(phpmyadmin|jmx-console|jmxinvokerservlet)',
'/xmlrpc.php',
'/(attachments|upimg|images|css|uploadfiles|html|uploads|templets|static|template|data|inc|forumdata|upload|includes|cache|avatar)/(\w+).(php|jsp|asp)',
App-WordPressTools
view release on metacpan or search on metacpan
lib/App/WordPressTools.pm view on Meta::CPAN
# eventually we should refactor some code out of the script into modules like this
=head1 NAME
App::WordPressTools - tools to backup and upgrade WordPress installations
=head1 DESCRIPTION
This module is part of the WordPress Tools package. For information about how to install and use the command-line
program, see L<wp-tools>.
App-YTDL
view release on metacpan or search on metacpan
lib/App/YTDL/ChooseVideos.pm view on Meta::CPAN
}
sub set_sort_videolist {
my ( $set, $opt ) = @_;
my $backup_item = $opt->{list_sort_item};
my $backup_order = $set->{list_sort_order};
my $sort_items = [ 'upload_date', 'title', 'view_count_raw', 'duration' ];
my $confirm = ' CONFIRM';
my @pre = ( undef, $confirm );
my $menu = [ @pre, map { my $s = $_; $s =~ s/_raw\z//; $s =~ s/_/ /g; '- ' . $s } @$sort_items ];
lib/App/YTDL/ChooseVideos.pm view on Meta::CPAN
my $idx = choose (
$menu,
{ prompt => $prompt, clear_screen => 0, layout => 3, index => 1, undef => ' BACK' }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
$opt->{list_sort_item} = $backup_item;
return;
}
if ( $menu->[$idx] eq $confirm ) {
last ITEM;
}
lib/App/YTDL/ChooseVideos.pm view on Meta::CPAN
my $choice = choose (
[ @pre, '- Asc', '- Desc' ],
{ prompt => $order_prompt, clear_screen => 0, layout => 3, undef => ' BACK' }
);
if ( ! defined $choice ) {
$set->{list_sort_order} = $backup_order;
return;
}
if ( $choice eq $confirm ) {
$set->{change}++;
return;
App-Yabsm
view release on metacpan or search on metacpan
lib/App/Yabsm.pm view on Meta::CPAN
# WWW: https://github.com/NicholasBHubbard/yabsm
# License: MIT
# The main module of Yabsm.
# ABSTRACT: a btrfs snapshot and backup management system
use strict;
use warnings;
use v5.16.3;
lib/App/Yabsm.pm view on Meta::CPAN
see 'man yabsm' for a detailed overview of yabsm.
commands:
<config|c> [--help] [check ?file] [ssh-check <SSH_BACKUP>] [ssh-key]
[yabsm-user-home] [yabsm_dir] [subvols] [snaps] [ssh_backups]
[local_backups] [backups]
<find|f> [--help] [<SNAP|SSH_BACKUP|LOCAL_BACKUP> <QUERY>]
<daemon|d> [--help] [start] [stop] [restart] [status] [init]
END_USAGE
App-ZFSCurses
view release on metacpan or search on metacpan
lib/App/ZFSCurses/Text.pm view on Meta::CPAN
sharenfs%Controls whether the file system is shared via NFS, and what options are used. A file system with a sharenfs property of off is managed the traditional way via exports(5). Otherwise, the file system is automatically shared and unshared with ...
logbias%Provide a hint to ZFS about handling of synchronous requests in this dataset. If logbias is set to latency (the default), ZFS will use pool log devices (if configured) to handle the requests at low latency. If logbias is set to throughput, ZF...
snapdir%Controls whether the .zfs directory is hidden or visible in the root of the file system as discussed in the "Snapshots" section. The default value is hidden.
sync%Controls the behavior of synchronous requests (e.g. fsync(2), O_DSYNC). This property accepts the following values:
volsize%For volumes, specifies the logical size of the volume. By default, creating a volume establishes a reservation of equal size. For storage pools with a version number of 9 or higher, a refreservation is set instead. Any changes to volsize are ...
volmode%This property specifies how volumes should be exposed to the OS. Setting it to geom exposes volumes as geom(4) providers, providing maximal functionality. Setting it to dev exposes volumes only as cdev device in devfs. Such volumes can be acc...
jailed%Controls whether the dataset is managed from a jail. See the "Jails" section for more information. The default value is off.
casesensitivity%Indicates whether the file name matching algorithm used by the file system should be case-sensitive, case-insensitive, or allow a combination of both styles of matching. The default value for the casesensitivity property is sensitive....
normalization%Indicates whether the file system should perform a unicode normalization of file names whenever two file names are compared, and which normalization algorithm should be used. File names are always stored unmodified, names are normalized...
utf8only%Indicates whether the file system should reject file names that include characters that are not present in the UTF-8 character code set. If this property is explicitly set to off, the normalization property must either not be explicitly set ...
dnodesize%Specifies a compatibility mode or literal value for the size of dnodes in the file system. The default value is legacy. Setting this property to a value other than legacy requires the large_dnode pool feature to be enabled. Consider setting...
App-ZodiacUtils
view release on metacpan or search on metacpan
script/_chinese-zodiac-of view on Meta::CPAN
# my ($self, $l, $r) = @_;
# $self->path([]);
# $self->errors([]);
# $self->mem({});
# $self->cur_mem_key(undef);
# my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
# {
# success => !@{ $self->errors },
# error => (@{ $self->errors } ?
# join(", ",
# map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
# @{ $self->errors }) : ''),
# result => $res,
# backup => $backup,
# };
#}
#
## handle circular refs: process todo's
#sub _process_todo {
script/_chinese-zodiac-of view on Meta::CPAN
# }
# } else {
# $self->mem->{$memkey} = {res=>undef, todo=>[]};
# $self->cur_mem_key($memkey);
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
# #print "DEBUG: setting res for mem<$memkey>\n";
# $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
# $self->_process_todo;
# return ($newkey, $res, $backup);
# }
# } else {
# $self->_process_todo;
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# return $mh->$meth($key, $l, $r);
script/_chinese-zodiac-of view on Meta::CPAN
#specified hash. Return the same hash but with prefixes removed.
#
#=head2 merge($l, $r)
#
#Merge two nested data structures. Returns the result hash: {
#success=>0|1, error=>'...', result=>..., backup=>... }. The 'error'
#key is set to contain an error message if there is an error. The merge
#result is in the 'result' key. The 'backup' key contains replaced
#elements from the original hash/array.
#
#=head1 FAQ
#
#=head2 What is this module good for? Why would I want to use this module instead of the other hash merge modules?
script/_chinese-zodiac-of view on Meta::CPAN
# my $c = $mm->config;
# return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
# return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
# my @res;
# my @backup;
# my $la = @$l;
# my $lb = @$r;
# push @{ $mm->path }, -1;
# for my $i (0..($la > $lb ? $la : $lb)-1) {
# #print "DEBUG: merge_A_A: #$i: a->[$i]=".Data::Dumper->new([$l->[$i]])->Indent(0)->Terse(1)->Dump.", b->[$i]=".Data::Dumper->new([$r->[$i]])->Indent(0)->Terse(1)->Dump."\n";
# $mm->path->[-1] = $i;
# if ($i < $la && $i < $lb) {
# push @backup, $l->[$i];
# my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
# last if @{ $mm->errors };
# if ($is_circular) {
# push @res, undef;
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (i=$i)\n";
# $res[$i] = $subres;
# }
# } else {
# push @res, $subres;# if defined($newkey); = we allow DELETE on array?
script/_chinese-zodiac-of view on Meta::CPAN
# } else {
# push @res, $r->[$i];
# }
# }
# pop @{ $mm->path };
# ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
# my ($self, $h, $desc, $sub) = @_;
# my $mm = $self->merger;
script/_chinese-zodiac-of view on Meta::CPAN
# my $c = $mm->config;
#
# #print "DEBUG: Entering _merge_gen(".dmp($hl).", ".dmp($hr).", $mode, ...)\n";
#
# my $res = {};
# my $backup = {};
#
# my %k = map {$_=>1} keys(%$hl), keys(%$hr);
# push @{ $mm->path }, "";
# K:
# for my $k (keys %k) {
script/_chinese-zodiac-of view on Meta::CPAN
# if (!$do_merge) {
# $res->{$k} = $hl->{$k} if $hl->{$k};
# next K;
# }
#
# $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
# if ($hl->{$k}) {
# push @o, $hl->{$k};
# }
# if ($hr->{$k}) {
# my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
script/_chinese-zodiac-of view on Meta::CPAN
# if (@o == 1 &&
# (($hl->{$k} && $mh->can("merge_left_only")) ||
# ($hr->{$k} && $mh->can("merge_right_only")))) {
# # there's only left-side or right-side
# my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
# my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); # XXX handle circular?
# next K unless defined($subnewkey);
# $final_mode = $newmode;
# $v = $res;
# } else {
# $final_mode = $o[$i][0];
script/_chinese-zodiac-of view on Meta::CPAN
# or do {
# $mm->push_error("Can't merge $final_mode + $o[$i][0]");
# return;
# };
# #print "DEBUG: merge $final_mode+$o[$i][0] = $m->[0], $m->[1]\n";
# my ($subnewkey, $subbackup);
# ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
# return if @{ $mm->errors };
# if ($is_circular) {
# if ($i < $#o) {
# $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
# return;
# }
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (k=$k)\n";
# my $final_mode = $m->[1];
# #XXX return unless defined($subnewkey);
# $res->{$k} = [$m->[1], $subres];
# if ($c->readd_prefix) {
script/_chinese-zodiac-of view on Meta::CPAN
# }
# $res->{$k} = [$final_mode, $v] unless $is_circular;
# }
# pop @{ $mm->path };
# #print "DEBUG: Leaving _merge_gen, res = ".dmp($res)."\n";
# ($res, $backup);
#}
#
## hh is {key=>[MODE, val], ...} which is the format returned by _merge_gen
#sub _readd_prefix {
# my ($self, $hh, $k, $defmode) = @_;
script/_chinese-zodiac-of view on Meta::CPAN
#
# my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
# return if @{ $mm->errors };
#
# push @{ $mm->path }, $ok;
# my ($res, $backup);
# {
# local $c->{readd_prefix} = 0;
# ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
# }
# pop @{ $mm->path };
# return if @{ $mm->errors };
#
# #print "DEBUG: merge options key (".dmp($okl).", ".dmp($okr).") = ".dmp($res)."\n";
script/_chinese-zodiac-of view on Meta::CPAN
# return;
# }
# }
#
# # STEP 4. MERGE LEFT & RIGHT
# my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
# return if @{ $mm->errors };
#
# #print "DEBUG: intermediate res(5) = ".Data::Dumper->new([$res])->Indent(0)->Terse(1)->Dump."\n";
#
# # STEP 5. TURN BACK {key=>[MODE=>val]}, ...} INTO {(prefix)key => val, ...}
script/_chinese-zodiac-of view on Meta::CPAN
# if ($config_replaced) {
# $mm->config($orig_c);
# #print "DEBUG: Restored config, config=", dmp($mm->config), "\n";
# }
#
# #print "DEBUG: backup = ".Data::Dumper->new([$backup])->Indent(0)->Terse(1)->Dump."\n";
# #print "DEBUG: leaving merge_H_H, result = ".dmp($res)."\n";
# ($key, $res, $backup);
#}
#
#1;
## ABSTRACT: Base class for Data::ModeMerge mode handler
#
script/_chinese-zodiac-of view on Meta::CPAN
#
#sub default_prefix_re { qr/^!/ }
#
## merge_left_only and merge_right_only are a bit different: they are
## called with $l only or $r only instead of both, and should return an
## extra argument $mode, i.e. ($key, $result, $backup, $is_circular,
## $mode)
#sub merge_left_only {
# my ($self, $key, $l) = @_;
# return;
#}
App-bcrypt
view release on metacpan or search on metacpan
MANIFEST.SKIP view on Meta::CPAN
\bbuild.com$
# and Module::Build::Tiny generated files
\b_build_params$
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
App-bk
view release on metacpan or search on metacpan
lib/App/bk.pm view on Meta::CPAN
# probably shouldnt do it like this - will rework later
$options{debug} ||= 0;
$options{username} = getpwuid($EUID);
if ( $options{username} eq 'root' ) {
logmsg( 2, 'Running as root so dropping username from file backups' );
$options{username} = '';
}
=head1 SYNOPSIS
Please see the file F<bk> for more information about the F<bk> program.
=head1 SUBROUTINES/METHODS
=head2 backup_files
Main function to process ARGV and backup files as necessary
=cut
sub backup_files {
# make sure we don't clobber any callers variables
local @ARGV = @ARGV;
GetOptions( \%options, keys(%opts) ) || pod2usage( -verbose => 1 );
lib/App/bk.pm view on Meta::CPAN
warn "WARNING: $savedir does not exist", $/;
next;
}
# compare the last file found with the current file
my $last_backup = get_last_backup( $savedir, $basename );
if ( $options{diff} ) {
if ( !$last_backup ) {
print "'$filename' not previously backed up.", $/;
}
else {
print get_diff( $last_backup, $filename );
}
next;
}
if ($last_backup) {
logmsg( 1, "Found last backup as: $last_backup" );
my $last_backup_sum = get_chksum($last_backup);
my $current_sum = get_chksum($filename);
logmsg( 2, "Last backup file $options{sum}: $last_backup_sum" );
logmsg( 2, "Current file $options{sum}: $current_sum" );
if ( $last_backup_sum eq $current_sum ) {
logmsg( 0, "No change since last backup of $filename" );
next;
}
}
my $savefilename = "$savedir$basename";
lib/App/bk.pm view on Meta::CPAN
return $differences
? $differences
: "No differences between '$old' and '$new'" . $/;
}
=head2 $filename = get_last_backup($file);
Get the last backup filename for given file
=cut
sub get_last_backup {
my ( $savedir, $filename ) = @_;
if ( !$savedir || !-d $savedir ) {
croak 'Invalid save directory provided';
}
# get last backup and compare to current file to prevent
# unnecessary backups being created
opendir( my $savedir_fh, $savedir )
|| die( "Unable to read $savedir: $!", $/ );
my @save_files = sort
grep( /$filename\.(?:$options{username}\.)?\d{8}/,
readdir($savedir_fh) );
closedir($savedir_fh) || die( "Unable to close $savedir: $!", $/ );
if ( $options{debug} > 2 ) {
logmsg( 3, "Previous backups found:" );
foreach my $bk (@save_files) {
logmsg( 3, "\t$bk" );
}
}
App-cloc
view release on metacpan or search on metacpan
$Exclude_Dir{".svn"} = 1;
$Exclude_Dir{".cvs"} = 1;
$Exclude_Dir{".hg"} = 1;
$Exclude_Dir{".git"} = 1;
$Exclude_Dir{".bzr"} = 1;
$Exclude_Dir{".snapshot"} = 1; # NetApp backups
$opt_count_diff = defined $opt_count_diff ? 1 : 0;
$opt_diff = 1 if $opt_diff_alignment;
$opt_exclude_ext = "" unless $opt_exclude_ext;
$opt_ignore_whitespace = 0 unless $opt_ignore_whitespace;
$opt_ignore_case = 0 unless $opt_ignore_case;
App-contenttype
view release on metacpan or search on metacpan
script/contenttype view on Meta::CPAN
application/x-troff-ms ms
application/x-tzo tzo
application/x-ufraw ufraw
application/x-ustar ustar
application/x-vda vda
application/x-vmsbackup bck
application/x-vnd.audioexplosion.mzz mzz
application/x-vnd.ls-xpix xpix
application/x-vocaltec-media-file vmf
application/x-wais-source src
application/x-wais-source wsrc
App-cpanbaker
view release on metacpan or search on metacpan
lib/App/cpanbaker.pm view on Meta::CPAN
1;
__END__
=head1 NAME
App::cpanbaker - cpan module baker, backup your whole cpan module files
=head1 SYNOPSIS
use App::cpanbaker;
=head1 DESCRIPTION
Use cpanbaker, backup your whole cpan module files.
cpanbaker not only backup module files , also script files and cpan, cpanplus,
cpanminus, minicpan configs.
And cpanbaker also detects perlbrew, local::lib directories to backup.
=head1 SUPPORTS
* script files
* perlbrew.
App-cpanminus
view release on metacpan or search on metacpan
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
$file->save('cpanfile');
Saves the currently loaded prereqs as a new C<cpanfile> by calling
C<to_string>. Beware B<this method will overwrite the existing
cpanfile without any warning or backup>. Taking a backup or giving
warnings to users is a caller's responsibility.
# Read MYMETA.json and creates a new cpanfile
my $meta = CPAN::Meta->load_file('MYMETA.json');
my $file = Module::CPANfile->from_prereqs($meta->prereqs);
App-cpantested
view release on metacpan or search on metacpan
MANIFEST.SKIP view on Meta::CPAN
\bBuild.bat$
\bBuild.COM$
\bBUILD.COM$
\bbuild.com$
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
App-devmode
view release on metacpan or search on metacpan
MANIFEST.SKIP view on Meta::CPAN
\bBuild.bat$
\bBuild.COM$
\bBUILD.COM$
\bbuild.com$
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
App-diceware
view release on metacpan or search on metacpan
share/wordlist_en.tsv view on Meta::CPAN
13114 backspin
13115 backstab
13116 backstage
13121 backtalk
13122 backtrack
13123 backup
13124 backward
13125 backwash
13126 backwater
13131 backyard
13132 bacon
App-distfind
view release on metacpan or search on metacpan
MANIFEST.SKIP view on Meta::CPAN
CPAN.SKIP
t/000_standard__*
Debian_CPANTS.txt
nytprof.out
# Temp, old, emacs, vim, backup files.
~$
\.old$
\.swp$
\.tar$
\.tar\.gz$
App-financeta
view release on metacpan or search on metacpan
lib/App/financeta/utils.pm view on Meta::CPAN
$file_path = undef;
};
unless ($file_path) {
my $dist_share_path = rel2abs(catfile(getcwd, 'share'));
try {
$log->debug("$filename backup dist-share path: $dist_share_path");
## find all packages and search for all of them
if (@args) {
foreach (@args) {
$File::ShareDir::DIST_SHARE{$_} = $dist_share_path;
}
App-finddo
view release on metacpan or search on metacpan
lib/App/finddo.pm view on Meta::CPAN
schema => 'bool*',
},
image => {
schema => 'bool*',
},
# XXX add arg: doc/ebook, backup, compressed, archive
# XXX add arg: recursive (-r)
# XXX add arg: max_depth
# XXX add arg: (mtime, ctime) (min, max)
# XXX add arg: size (min, max)
App-genpw-base56
view release on metacpan or search on metacpan
script/_genpw-base56 view on Meta::CPAN
# my ($self, $l, $r) = @_;
# $self->path([]);
# $self->errors([]);
# $self->mem({});
# $self->cur_mem_key(undef);
# my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
# {
# success => !@{ $self->errors },
# error => (@{ $self->errors } ?
# join(", ",
# map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
# @{ $self->errors }) : ''),
# result => $res,
# backup => $backup,
# };
#}
#
#sub _process_todo {
# my ($self) = @_;
script/_genpw-base56 view on Meta::CPAN
# return ($key, undef, undef, 1);
# }
# } else {
# $self->mem->{$memkey} = {res=>undef, todo=>[]};
# $self->cur_mem_key($memkey);
# my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
# $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
# $self->_process_todo;
# return ($newkey, $res, $backup);
# }
# } else {
# $self->_process_todo;
# return $mh->$meth($key, $l, $r);
# }
script/_genpw-base56 view on Meta::CPAN
# my $c = $mm->config;
# return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
# return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
# my @res;
# my @backup;
# my $la = @$l;
# my $lb = @$r;
# push @{ $mm->path }, -1;
# for my $i (0..($la > $lb ? $la : $lb)-1) {
# $mm->path->[-1] = $i;
# if ($i < $la && $i < $lb) {
# push @backup, $l->[$i];
# my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
# last if @{ $mm->errors };
# if ($is_circular) {
# push @res, undef;
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# $res[$i] = $subres;
# }
# } else {
# push @res, $subres;
# }
script/_genpw-base56 view on Meta::CPAN
# } else {
# push @res, $r->[$i];
# }
# }
# pop @{ $mm->path };
# ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
# my ($self, $h, $desc, $sub) = @_;
# my $mm = $self->merger;
script/_genpw-base56 view on Meta::CPAN
# my $mm = $self->merger;
# my $c = $mm->config;
#
#
# my $res = {};
# my $backup = {};
#
# my %k = map {$_=>1} keys(%$hl), keys(%$hr);
# push @{ $mm->path }, "";
# K:
# for my $k (keys %k) {
script/_genpw-base56 view on Meta::CPAN
# if (!$do_merge) {
# $res->{$k} = $hl->{$k} if $hl->{$k};
# next K;
# }
#
# $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
# if ($hl->{$k}) {
# push @o, $hl->{$k};
# }
# if ($hr->{$k}) {
# my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
script/_genpw-base56 view on Meta::CPAN
# my $mh = $mm->modes->{$o[$i][0]};
# if (@o == 1 &&
# (($hl->{$k} && $mh->can("merge_left_only")) ||
# ($hr->{$k} && $mh->can("merge_right_only")))) {
# my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
# my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]);
# next K unless defined($subnewkey);
# $final_mode = $newmode;
# $v = $res;
# } else {
# $final_mode = $o[$i][0];
script/_genpw-base56 view on Meta::CPAN
# my $m = $mm->combine_rules->{"$final_mode+$o[$i][0]"}
# or do {
# $mm->push_error("Can't merge $final_mode + $o[$i][0]");
# return;
# };
# my ($subnewkey, $subbackup);
# ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
# return if @{ $mm->errors };
# if ($is_circular) {
# if ($i < $#o) {
# $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
# return;
# }
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# my $final_mode = $m->[1];
# $res->{$k} = [$m->[1], $subres];
# if ($c->readd_prefix) {
# $self->_readd_prefix($res, $k, $c->default_mode);
# } else {
script/_genpw-base56 view on Meta::CPAN
# }
# }
# $res->{$k} = [$final_mode, $v] unless $is_circular;
# }
# pop @{ $mm->path };
# ($res, $backup);
#}
#
#sub _readd_prefix {
# my ($self, $hh, $k, $defmode) = @_;
# my $mm = $self->merger;
script/_genpw-base56 view on Meta::CPAN
#
# my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
# return if @{ $mm->errors };
#
# push @{ $mm->path }, $ok;
# my ($res, $backup);
# {
# local $c->{readd_prefix} = 0;
# ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
# }
# pop @{ $mm->path };
# return if @{ $mm->errors };
#
#
script/_genpw-base56 view on Meta::CPAN
# $mm->push_error("Invalid config value `include_merge_regex`: invalid regex: $@");
# return;
# }
# }
#
# my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
# return if @{ $mm->errors };
#
#
# if ($c->readd_prefix) {
# for my $k (keys %$res) {
script/_genpw-base56 view on Meta::CPAN
#
# if ($config_replaced) {
# $mm->config($orig_c);
# }
#
# ($key, $res, $backup);
#}
#
#1;
#
#__END__
App-genpw-base58
view release on metacpan or search on metacpan
script/_genpw-base58 view on Meta::CPAN
# my ($self, $l, $r) = @_;
# $self->path([]);
# $self->errors([]);
# $self->mem({});
# $self->cur_mem_key(undef);
# my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
# {
# success => !@{ $self->errors },
# error => (@{ $self->errors } ?
# join(", ",
# map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
# @{ $self->errors }) : ''),
# result => $res,
# backup => $backup,
# };
#}
#
#sub _process_todo {
# my ($self) = @_;
script/_genpw-base58 view on Meta::CPAN
# return ($key, undef, undef, 1);
# }
# } else {
# $self->mem->{$memkey} = {res=>undef, todo=>[]};
# $self->cur_mem_key($memkey);
# my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
# $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
# $self->_process_todo;
# return ($newkey, $res, $backup);
# }
# } else {
# $self->_process_todo;
# return $mh->$meth($key, $l, $r);
# }
script/_genpw-base58 view on Meta::CPAN
# my $c = $mm->config;
# return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
# return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
# my @res;
# my @backup;
# my $la = @$l;
# my $lb = @$r;
# push @{ $mm->path }, -1;
# for my $i (0..($la > $lb ? $la : $lb)-1) {
# $mm->path->[-1] = $i;
# if ($i < $la && $i < $lb) {
# push @backup, $l->[$i];
# my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
# last if @{ $mm->errors };
# if ($is_circular) {
# push @res, undef;
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# $res[$i] = $subres;
# }
# } else {
# push @res, $subres;
# }
script/_genpw-base58 view on Meta::CPAN
# } else {
# push @res, $r->[$i];
# }
# }
# pop @{ $mm->path };
# ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
# my ($self, $h, $desc, $sub) = @_;
# my $mm = $self->merger;
script/_genpw-base58 view on Meta::CPAN
# my $mm = $self->merger;
# my $c = $mm->config;
#
#
# my $res = {};
# my $backup = {};
#
# my %k = map {$_=>1} keys(%$hl), keys(%$hr);
# push @{ $mm->path }, "";
# K:
# for my $k (keys %k) {
script/_genpw-base58 view on Meta::CPAN
# if (!$do_merge) {
# $res->{$k} = $hl->{$k} if $hl->{$k};
# next K;
# }
#
# $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
# if ($hl->{$k}) {
# push @o, $hl->{$k};
# }
# if ($hr->{$k}) {
# my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
script/_genpw-base58 view on Meta::CPAN
# my $mh = $mm->modes->{$o[$i][0]};
# if (@o == 1 &&
# (($hl->{$k} && $mh->can("merge_left_only")) ||
# ($hr->{$k} && $mh->can("merge_right_only")))) {
# my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
# my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]);
# next K unless defined($subnewkey);
# $final_mode = $newmode;
# $v = $res;
# } else {
# $final_mode = $o[$i][0];
script/_genpw-base58 view on Meta::CPAN
# my $m = $mm->combine_rules->{"$final_mode+$o[$i][0]"}
# or do {
# $mm->push_error("Can't merge $final_mode + $o[$i][0]");
# return;
# };
# my ($subnewkey, $subbackup);
# ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
# return if @{ $mm->errors };
# if ($is_circular) {
# if ($i < $#o) {
# $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
# return;
# }
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# my $final_mode = $m->[1];
# $res->{$k} = [$m->[1], $subres];
# if ($c->readd_prefix) {
# $self->_readd_prefix($res, $k, $c->default_mode);
# } else {
script/_genpw-base58 view on Meta::CPAN
# }
# }
# $res->{$k} = [$final_mode, $v] unless $is_circular;
# }
# pop @{ $mm->path };
# ($res, $backup);
#}
#
#sub _readd_prefix {
# my ($self, $hh, $k, $defmode) = @_;
# my $mm = $self->merger;
script/_genpw-base58 view on Meta::CPAN
#
# my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
# return if @{ $mm->errors };
#
# push @{ $mm->path }, $ok;
# my ($res, $backup);
# {
# local $c->{readd_prefix} = 0;
# ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
# }
# pop @{ $mm->path };
# return if @{ $mm->errors };
#
#
script/_genpw-base58 view on Meta::CPAN
# $mm->push_error("Invalid config value `include_merge_regex`: invalid regex: $@");
# return;
# }
# }
#
# my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
# return if @{ $mm->errors };
#
#
# if ($c->readd_prefix) {
# for my $k (keys %$res) {
script/_genpw-base58 view on Meta::CPAN
#
# if ($config_replaced) {
# $mm->config($orig_c);
# }
#
# ($key, $res, $backup);
#}
#
#1;
#
#__END__
App-genpw-base64
view release on metacpan or search on metacpan
script/_genpw-base64 view on Meta::CPAN
# my ($self, $l, $r) = @_;
# $self->path([]);
# $self->errors([]);
# $self->mem({});
# $self->cur_mem_key(undef);
# my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
# {
# success => !@{ $self->errors },
# error => (@{ $self->errors } ?
# join(", ",
# map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
# @{ $self->errors }) : ''),
# result => $res,
# backup => $backup,
# };
#}
#
#sub _process_todo {
# my ($self) = @_;
script/_genpw-base64 view on Meta::CPAN
# return ($key, undef, undef, 1);
# }
# } else {
# $self->mem->{$memkey} = {res=>undef, todo=>[]};
# $self->cur_mem_key($memkey);
# my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
# $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
# $self->_process_todo;
# return ($newkey, $res, $backup);
# }
# } else {
# $self->_process_todo;
# return $mh->$meth($key, $l, $r);
# }
script/_genpw-base64 view on Meta::CPAN
# my $c = $mm->config;
# return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
# return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
# my @res;
# my @backup;
# my $la = @$l;
# my $lb = @$r;
# push @{ $mm->path }, -1;
# for my $i (0..($la > $lb ? $la : $lb)-1) {
# $mm->path->[-1] = $i;
# if ($i < $la && $i < $lb) {
# push @backup, $l->[$i];
# my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
# last if @{ $mm->errors };
# if ($is_circular) {
# push @res, undef;
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# $res[$i] = $subres;
# }
# } else {
# push @res, $subres;
# }
script/_genpw-base64 view on Meta::CPAN
# } else {
# push @res, $r->[$i];
# }
# }
# pop @{ $mm->path };
# ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
# my ($self, $h, $desc, $sub) = @_;
# my $mm = $self->merger;
script/_genpw-base64 view on Meta::CPAN
# my $mm = $self->merger;
# my $c = $mm->config;
#
#
# my $res = {};
# my $backup = {};
#
# my %k = map {$_=>1} keys(%$hl), keys(%$hr);
# push @{ $mm->path }, "";
# K:
# for my $k (keys %k) {
script/_genpw-base64 view on Meta::CPAN
# if (!$do_merge) {
# $res->{$k} = $hl->{$k} if $hl->{$k};
# next K;
# }
#
# $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
# if ($hl->{$k}) {
# push @o, $hl->{$k};
# }
# if ($hr->{$k}) {
# my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
script/_genpw-base64 view on Meta::CPAN
# my $mh = $mm->modes->{$o[$i][0]};
# if (@o == 1 &&
# (($hl->{$k} && $mh->can("merge_left_only")) ||
# ($hr->{$k} && $mh->can("merge_right_only")))) {
# my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
# my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]);
# next K unless defined($subnewkey);
# $final_mode = $newmode;
# $v = $res;
# } else {
# $final_mode = $o[$i][0];
script/_genpw-base64 view on Meta::CPAN
# my $m = $mm->combine_rules->{"$final_mode+$o[$i][0]"}
# or do {
# $mm->push_error("Can't merge $final_mode + $o[$i][0]");
# return;
# };
# my ($subnewkey, $subbackup);
# ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
# return if @{ $mm->errors };
# if ($is_circular) {
# if ($i < $#o) {
# $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
# return;
# }
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# my $final_mode = $m->[1];
# $res->{$k} = [$m->[1], $subres];
# if ($c->readd_prefix) {
# $self->_readd_prefix($res, $k, $c->default_mode);
# } else {
script/_genpw-base64 view on Meta::CPAN
# }
# }
# $res->{$k} = [$final_mode, $v] unless $is_circular;
# }
# pop @{ $mm->path };
# ($res, $backup);
#}
#
#sub _readd_prefix {
# my ($self, $hh, $k, $defmode) = @_;
# my $mm = $self->merger;
script/_genpw-base64 view on Meta::CPAN
#
# my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
# return if @{ $mm->errors };
#
# push @{ $mm->path }, $ok;
# my ($res, $backup);
# {
# local $c->{readd_prefix} = 0;
# ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
# }
# pop @{ $mm->path };
# return if @{ $mm->errors };
#
#
script/_genpw-base64 view on Meta::CPAN
# $mm->push_error("Invalid config value `include_merge_regex`: invalid regex: $@");
# return;
# }
# }
#
# my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
# return if @{ $mm->errors };
#
#
# if ($c->readd_prefix) {
# for my $k (keys %$res) {
script/_genpw-base64 view on Meta::CPAN
#
# if ($config_replaced) {
# $mm->config($orig_c);
# }
#
# ($key, $res, $backup);
#}
#
#1;
#
#__END__
App-genpw-id
view release on metacpan or search on metacpan
script/_genpw-id view on Meta::CPAN
# my ($self, $l, $r) = @_;
# $self->path([]);
# $self->errors([]);
# $self->mem({});
# $self->cur_mem_key(undef);
# my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
# {
# success => !@{ $self->errors },
# error => (@{ $self->errors } ?
# join(", ",
# map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
# @{ $self->errors }) : ''),
# result => $res,
# backup => $backup,
# };
#}
#
## handle circular refs: process todo's
#sub _process_todo {
script/_genpw-id view on Meta::CPAN
# }
# } else {
# $self->mem->{$memkey} = {res=>undef, todo=>[]};
# $self->cur_mem_key($memkey);
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
# #print "DEBUG: setting res for mem<$memkey>\n";
# $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
# $self->_process_todo;
# return ($newkey, $res, $backup);
# }
# } else {
# $self->_process_todo;
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# return $mh->$meth($key, $l, $r);
script/_genpw-id view on Meta::CPAN
#specified hash. Return the same hash but with prefixes removed.
#
#=head2 merge($l, $r)
#
#Merge two nested data structures. Returns the result hash: {
#success=>0|1, error=>'...', result=>..., backup=>... }. The 'error'
#key is set to contain an error message if there is an error. The merge
#result is in the 'result' key. The 'backup' key contains replaced
#elements from the original hash/array.
#
#=head1 FAQ
#
#=head2 What is this module good for? Why would I want to use this module instead of the other hash merge modules?
script/_genpw-id view on Meta::CPAN
# my $c = $mm->config;
# return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
# return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
# my @res;
# my @backup;
# my $la = @$l;
# my $lb = @$r;
# push @{ $mm->path }, -1;
# for my $i (0..($la > $lb ? $la : $lb)-1) {
# #print "DEBUG: merge_A_A: #$i: a->[$i]=".Data::Dumper->new([$l->[$i]])->Indent(0)->Terse(1)->Dump.", b->[$i]=".Data::Dumper->new([$r->[$i]])->Indent(0)->Terse(1)->Dump."\n";
# $mm->path->[-1] = $i;
# if ($i < $la && $i < $lb) {
# push @backup, $l->[$i];
# my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
# last if @{ $mm->errors };
# if ($is_circular) {
# push @res, undef;
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (i=$i)\n";
# $res[$i] = $subres;
# }
# } else {
# push @res, $subres;# if defined($newkey); = we allow DELETE on array?
script/_genpw-id view on Meta::CPAN
# } else {
# push @res, $r->[$i];
# }
# }
# pop @{ $mm->path };
# ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
# my ($self, $h, $desc, $sub) = @_;
# my $mm = $self->merger;
script/_genpw-id view on Meta::CPAN
# my $c = $mm->config;
#
# #print "DEBUG: Entering _merge_gen(".dmp($hl).", ".dmp($hr).", $mode, ...)\n";
#
# my $res = {};
# my $backup = {};
#
# my %k = map {$_=>1} keys(%$hl), keys(%$hr);
# push @{ $mm->path }, "";
# K:
# for my $k (keys %k) {
script/_genpw-id view on Meta::CPAN
# if (!$do_merge) {
# $res->{$k} = $hl->{$k} if $hl->{$k};
# next K;
# }
#
# $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
# if ($hl->{$k}) {
# push @o, $hl->{$k};
# }
# if ($hr->{$k}) {
# my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
script/_genpw-id view on Meta::CPAN
# if (@o == 1 &&
# (($hl->{$k} && $mh->can("merge_left_only")) ||
# ($hr->{$k} && $mh->can("merge_right_only")))) {
# # there's only left-side or right-side
# my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
# my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); # XXX handle circular?
# next K unless defined($subnewkey);
# $final_mode = $newmode;
# $v = $res;
# } else {
# $final_mode = $o[$i][0];
script/_genpw-id view on Meta::CPAN
# or do {
# $mm->push_error("Can't merge $final_mode + $o[$i][0]");
# return;
# };
# #print "DEBUG: merge $final_mode+$o[$i][0] = $m->[0], $m->[1]\n";
# my ($subnewkey, $subbackup);
# ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
# return if @{ $mm->errors };
# if ($is_circular) {
# if ($i < $#o) {
# $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
# return;
# }
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (k=$k)\n";
# my $final_mode = $m->[1];
# #XXX return unless defined($subnewkey);
# $res->{$k} = [$m->[1], $subres];
# if ($c->readd_prefix) {
script/_genpw-id view on Meta::CPAN
# }
# $res->{$k} = [$final_mode, $v] unless $is_circular;
# }
# pop @{ $mm->path };
# #print "DEBUG: Leaving _merge_gen, res = ".dmp($res)."\n";
# ($res, $backup);
#}
#
## hh is {key=>[MODE, val], ...} which is the format returned by _merge_gen
#sub _readd_prefix {
# my ($self, $hh, $k, $defmode) = @_;
script/_genpw-id view on Meta::CPAN
#
# my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
# return if @{ $mm->errors };
#
# push @{ $mm->path }, $ok;
# my ($res, $backup);
# {
# local $c->{readd_prefix} = 0;
# ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
# }
# pop @{ $mm->path };
# return if @{ $mm->errors };
#
# #print "DEBUG: merge options key (".dmp($okl).", ".dmp($okr).") = ".dmp($res)."\n";
script/_genpw-id view on Meta::CPAN
# return;
# }
# }
#
# # STEP 4. MERGE LEFT & RIGHT
# my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
# return if @{ $mm->errors };
#
# #print "DEBUG: intermediate res(5) = ".Data::Dumper->new([$res])->Indent(0)->Terse(1)->Dump."\n";
#
# # STEP 5. TURN BACK {key=>[MODE=>val]}, ...} INTO {(prefix)key => val, ...}
script/_genpw-id view on Meta::CPAN
# if ($config_replaced) {
# $mm->config($orig_c);
# #print "DEBUG: Restored config, config=", dmp($mm->config), "\n";
# }
#
# #print "DEBUG: backup = ".Data::Dumper->new([$backup])->Indent(0)->Terse(1)->Dump."\n";
# #print "DEBUG: leaving merge_H_H, result = ".dmp($res)."\n";
# ($key, $res, $backup);
#}
#
#1;
## ABSTRACT: Base class for Data::ModeMerge mode handler
#
script/_genpw-id view on Meta::CPAN
#
#sub default_prefix_re { qr/^!/ }
#
## merge_left_only and merge_right_only are a bit different: they are
## called with $l only or $r only instead of both, and should return an
## extra argument $mode, i.e. ($key, $result, $backup, $is_circular,
## $mode)
#sub merge_left_only {
# my ($self, $key, $l) = @_;
# return;
#}
App-genpw-ind
view release on metacpan or search on metacpan
script/_genpw-ind view on Meta::CPAN
# my ($self, $l, $r) = @_;
# $self->path([]);
# $self->errors([]);
# $self->mem({});
# $self->cur_mem_key(undef);
# my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
# {
# success => !@{ $self->errors },
# error => (@{ $self->errors } ?
# join(", ",
# map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
# @{ $self->errors }) : ''),
# result => $res,
# backup => $backup,
# };
#}
#
## handle circular refs: process todo's
#sub _process_todo {
script/_genpw-ind view on Meta::CPAN
# }
# } else {
# $self->mem->{$memkey} = {res=>undef, todo=>[]};
# $self->cur_mem_key($memkey);
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
# #print "DEBUG: setting res for mem<$memkey>\n";
# $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
# $self->_process_todo;
# return ($newkey, $res, $backup);
# }
# } else {
# $self->_process_todo;
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# return $mh->$meth($key, $l, $r);
script/_genpw-ind view on Meta::CPAN
#specified hash. Return the same hash but with prefixes removed.
#
#=head2 merge($l, $r)
#
#Merge two nested data structures. Returns the result hash: {
#success=>0|1, error=>'...', result=>..., backup=>... }. The 'error'
#key is set to contain an error message if there is an error. The merge
#result is in the 'result' key. The 'backup' key contains replaced
#elements from the original hash/array.
#
#=head1 FAQ
#
#=head2 What is this module good for? Why would I want to use this module instead of the other hash merge modules?
script/_genpw-ind view on Meta::CPAN
# my $c = $mm->config;
# return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
# return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
# my @res;
# my @backup;
# my $la = @$l;
# my $lb = @$r;
# push @{ $mm->path }, -1;
# for my $i (0..($la > $lb ? $la : $lb)-1) {
# #print "DEBUG: merge_A_A: #$i: a->[$i]=".Data::Dumper->new([$l->[$i]])->Indent(0)->Terse(1)->Dump.", b->[$i]=".Data::Dumper->new([$r->[$i]])->Indent(0)->Terse(1)->Dump."\n";
# $mm->path->[-1] = $i;
# if ($i < $la && $i < $lb) {
# push @backup, $l->[$i];
# my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
# last if @{ $mm->errors };
# if ($is_circular) {
# push @res, undef;
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (i=$i)\n";
# $res[$i] = $subres;
# }
# } else {
# push @res, $subres;# if defined($newkey); = we allow DELETE on array?
script/_genpw-ind view on Meta::CPAN
# } else {
# push @res, $r->[$i];
# }
# }
# pop @{ $mm->path };
# ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
# my ($self, $h, $desc, $sub) = @_;
# my $mm = $self->merger;
script/_genpw-ind view on Meta::CPAN
# my $c = $mm->config;
#
# #print "DEBUG: Entering _merge_gen(".dmp($hl).", ".dmp($hr).", $mode, ...)\n";
#
# my $res = {};
# my $backup = {};
#
# my %k = map {$_=>1} keys(%$hl), keys(%$hr);
# push @{ $mm->path }, "";
# K:
# for my $k (keys %k) {
script/_genpw-ind view on Meta::CPAN
# if (!$do_merge) {
# $res->{$k} = $hl->{$k} if $hl->{$k};
# next K;
# }
#
# $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
# if ($hl->{$k}) {
# push @o, $hl->{$k};
# }
# if ($hr->{$k}) {
# my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
script/_genpw-ind view on Meta::CPAN
# if (@o == 1 &&
# (($hl->{$k} && $mh->can("merge_left_only")) ||
# ($hr->{$k} && $mh->can("merge_right_only")))) {
# # there's only left-side or right-side
# my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
# my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); # XXX handle circular?
# next K unless defined($subnewkey);
# $final_mode = $newmode;
# $v = $res;
# } else {
# $final_mode = $o[$i][0];
script/_genpw-ind view on Meta::CPAN
# or do {
# $mm->push_error("Can't merge $final_mode + $o[$i][0]");
# return;
# };
# #print "DEBUG: merge $final_mode+$o[$i][0] = $m->[0], $m->[1]\n";
# my ($subnewkey, $subbackup);
# ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
# return if @{ $mm->errors };
# if ($is_circular) {
# if ($i < $#o) {
# $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
# return;
# }
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (k=$k)\n";
# my $final_mode = $m->[1];
# #XXX return unless defined($subnewkey);
# $res->{$k} = [$m->[1], $subres];
# if ($c->readd_prefix) {
script/_genpw-ind view on Meta::CPAN
# }
# $res->{$k} = [$final_mode, $v] unless $is_circular;
# }
# pop @{ $mm->path };
# #print "DEBUG: Leaving _merge_gen, res = ".dmp($res)."\n";
# ($res, $backup);
#}
#
## hh is {key=>[MODE, val], ...} which is the format returned by _merge_gen
#sub _readd_prefix {
# my ($self, $hh, $k, $defmode) = @_;
script/_genpw-ind view on Meta::CPAN
#
# my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
# return if @{ $mm->errors };
#
# push @{ $mm->path }, $ok;
# my ($res, $backup);
# {
# local $c->{readd_prefix} = 0;
# ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
# }
# pop @{ $mm->path };
# return if @{ $mm->errors };
#
# #print "DEBUG: merge options key (".dmp($okl).", ".dmp($okr).") = ".dmp($res)."\n";
script/_genpw-ind view on Meta::CPAN
# return;
# }
# }
#
# # STEP 4. MERGE LEFT & RIGHT
# my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
# return if @{ $mm->errors };
#
# #print "DEBUG: intermediate res(5) = ".Data::Dumper->new([$res])->Indent(0)->Terse(1)->Dump."\n";
#
# # STEP 5. TURN BACK {key=>[MODE=>val]}, ...} INTO {(prefix)key => val, ...}
script/_genpw-ind view on Meta::CPAN
# if ($config_replaced) {
# $mm->config($orig_c);
# #print "DEBUG: Restored config, config=", dmp($mm->config), "\n";
# }
#
# #print "DEBUG: backup = ".Data::Dumper->new([$backup])->Indent(0)->Terse(1)->Dump."\n";
# #print "DEBUG: leaving merge_H_H, result = ".dmp($res)."\n";
# ($key, $res, $backup);
#}
#
#1;
## ABSTRACT: Base class for Data::ModeMerge mode handler
#
script/_genpw-ind view on Meta::CPAN
#
#sub default_prefix_re { qr/^!/ }
#
## merge_left_only and merge_right_only are a bit different: they are
## called with $l only or $r only instead of both, and should return an
## extra argument $mode, i.e. ($key, $result, $backup, $is_circular,
## $mode)
#sub merge_left_only {
# my ($self, $key, $l) = @_;
# return;
#}
App-githook-perltidy
view release on metacpan or search on metacpan
lib/App/githook/perltidy/pre_commit.pm view on Meta::CPAN
Pod::Tidy::tidy_files(
files => [$tmp_file],
recursive => 0,
verbose => 0,
inplace => 1,
nobackup => 1,
columns => 72,
%{ $self->podtidyrc_opts },
);
}
App-grepurl
view release on metacpan or search on metacpan
MANIFEST.SKIP view on Meta::CPAN
\bBuild.bat$
\bBuild.COM$
\bBUILD.COM$
\bbuild.com$
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
App-hopen
view release on metacpan or search on metacpan
MANIFEST.SKIP view on Meta::CPAN
\bblibdirs\.ts$ # 6.18 through 6.25 generated this
\b_eumm/ # 7.05_05 and above
\.tar\.gz$
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
App-hr
view release on metacpan or search on metacpan
# my ($self, $l, $r) = @_;
# $self->path([]);
# $self->errors([]);
# $self->mem({});
# $self->cur_mem_key(undef);
# my ($key, $res, $backup) = $self->_merge(undef, $l, $r);
# {
# success => !@{ $self->errors },
# error => (@{ $self->errors } ?
# join(", ",
# map { sprintf("/%s: %s", join("/", @{ $_->[0] }), $_->[1]) }
# @{ $self->errors }) : ''),
# result => $res,
# backup => $backup,
# };
#}
#
## handle circular refs: process todo's
#sub _process_todo {
# }
# } else {
# $self->mem->{$memkey} = {res=>undef, todo=>[]};
# $self->cur_mem_key($memkey);
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# my ($newkey, $res, $backup) = $mh->$meth($key, $l, $r);
# #print "DEBUG: setting res for mem<$memkey>\n";
# $self->mem->{$memkey}{res} = [$newkey, $res, $backup];
# $self->_process_todo;
# return ($newkey, $res, $backup);
# }
# } else {
# $self->_process_todo;
# #print "DEBUG: invoking ".$mh->name."'s $meth(".dmp($key).", ".dmp($l).", ".dmp($r).")\n";
# return $mh->$meth($key, $l, $r);
#specified hash. Return the same hash but with prefixes removed.
#
#=head2 merge($l, $r)
#
#Merge two nested data structures. Returns the result hash: {
#success=>0|1, error=>'...', result=>..., backup=>... }. The 'error'
#key is set to contain an error message if there is an error. The merge
#result is in the 'result' key. The 'backup' key contains replaced
#elements from the original hash/array.
#
#=head1 FAQ
#
#=head2 What is this module good for? Why would I want to use this module instead of the other hash merge modules?
# my $c = $mm->config;
# return $self->merge_SCALAR_SCALAR($key, $l, $r) unless $c->recurse_array;
# return if $c->wanted_path && !$mm->_path_is_included($mm->path, $c->wanted_path);
#
# my @res;
# my @backup;
# my $la = @$l;
# my $lb = @$r;
# push @{ $mm->path }, -1;
# for my $i (0..($la > $lb ? $la : $lb)-1) {
# #print "DEBUG: merge_A_A: #$i: a->[$i]=".Data::Dumper->new([$l->[$i]])->Indent(0)->Terse(1)->Dump.", b->[$i]=".Data::Dumper->new([$r->[$i]])->Indent(0)->Terse(1)->Dump."\n";
# $mm->path->[-1] = $i;
# if ($i < $la && $i < $lb) {
# push @backup, $l->[$i];
# my ($subnewkey, $subres, $subbackup, $is_circular) = $mm->_merge($i, $l->[$i], $r->[$i], $c->default_mode);
# last if @{ $mm->errors };
# if ($is_circular) {
# push @res, undef;
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (i=$i)\n";
# $res[$i] = $subres;
# }
# } else {
# push @res, $subres;# if defined($newkey); = we allow DELETE on array?
# } else {
# push @res, $r->[$i];
# }
# }
# pop @{ $mm->path };
# ($key, \@res, \@backup);
#}
#
#sub _prefilter_hash {
# my ($self, $h, $desc, $sub) = @_;
# my $mm = $self->merger;
# my $c = $mm->config;
#
# #print "DEBUG: Entering _merge_gen(".dmp($hl).", ".dmp($hr).", $mode, ...)\n";
#
# my $res = {};
# my $backup = {};
#
# my %k = map {$_=>1} keys(%$hl), keys(%$hr);
# push @{ $mm->path }, "";
# K:
# for my $k (keys %k) {
# if (!$do_merge) {
# $res->{$k} = $hl->{$k} if $hl->{$k};
# next K;
# }
#
# $backup->{$k} = $hl->{$k}[1] if $hl->{$k} && $hr->{$k};
# if ($hl->{$k}) {
# push @o, $hl->{$k};
# }
# if ($hr->{$k}) {
# my %m = map {$_=>$mm->modes->{$_}->precedence_level} keys %{ $hr->{$k} };
# if (@o == 1 &&
# (($hl->{$k} && $mh->can("merge_left_only")) ||
# ($hr->{$k} && $mh->can("merge_right_only")))) {
# # there's only left-side or right-side
# my $meth = $hl->{$k} ? "merge_left_only" : "merge_right_only";
# my ($subnewkey, $v, $subbackup, $is_circular, $newmode) = $mh->$meth($k, $o[$i][1]); # XXX handle circular?
# next K unless defined($subnewkey);
# $final_mode = $newmode;
# $v = $res;
# } else {
# $final_mode = $o[$i][0];
# or do {
# $mm->push_error("Can't merge $final_mode + $o[$i][0]");
# return;
# };
# #print "DEBUG: merge $final_mode+$o[$i][0] = $m->[0], $m->[1]\n";
# my ($subnewkey, $subbackup);
# ($subnewkey, $v, $subbackup, $is_circular) = $mm->_merge($k, $v, $o[$i][1], $m->[0]);
# return if @{ $mm->errors };
# if ($is_circular) {
# if ($i < $#o) {
# $mm->push_error("Can't handle circular at $i of $#o merges (mode $m->[0]): not the last merge");
# return;
# }
# #print "DEBUG: pushing todo to mem<".$mm->cur_mem_key.">\n";
# push @{ $mm->mem->{ $mm->cur_mem_key }{todo} }, sub {
# my ($subnewkey, $subres, $subbackup) = @_;
# #print "DEBUG: Entering todo subroutine (k=$k)\n";
# my $final_mode = $m->[1];
# #XXX return unless defined($subnewkey);
# $res->{$k} = [$m->[1], $subres];
# if ($c->readd_prefix) {
# }
# $res->{$k} = [$final_mode, $v] unless $is_circular;
# }
# pop @{ $mm->path };
# #print "DEBUG: Leaving _merge_gen, res = ".dmp($res)."\n";
# ($res, $backup);
#}
#
## hh is {key=>[MODE, val], ...} which is the format returned by _merge_gen
#sub _readd_prefix {
# my ($self, $hh, $k, $defmode) = @_;
#
# my $okr = $self->_gen_right($r, $mode, sub {$_[0] eq $ok});
# return if @{ $mm->errors };
#
# push @{ $mm->path }, $ok;
# my ($res, $backup);
# {
# local $c->{readd_prefix} = 0;
# ($res, $backup) = $self->_merge_gen($okl, $okr, $mode);
# }
# pop @{ $mm->path };
# return if @{ $mm->errors };
#
# #print "DEBUG: merge options key (".dmp($okl).", ".dmp($okr).") = ".dmp($res)."\n";
# return;
# }
# }
#
# # STEP 4. MERGE LEFT & RIGHT
# my ($res, $backup) = $self->_merge_gen($hl, $hr, $mode, $em, $im, $emr, $imr);
# return if @{ $mm->errors };
#
# #print "DEBUG: intermediate res(5) = ".Data::Dumper->new([$res])->Indent(0)->Terse(1)->Dump."\n";
#
# # STEP 5. TURN BACK {key=>[MODE=>val]}, ...} INTO {(prefix)key => val, ...}
# if ($config_replaced) {
# $mm->config($orig_c);
# #print "DEBUG: Restored config, config=", dmp($mm->config), "\n";
# }
#
# #print "DEBUG: backup = ".Data::Dumper->new([$backup])->Indent(0)->Terse(1)->Dump."\n";
# #print "DEBUG: leaving merge_H_H, result = ".dmp($res)."\n";
# ($key, $res, $backup);
#}
#
#1;
## ABSTRACT: Base class for Data::ModeMerge mode handler
#
#
#sub default_prefix_re { qr/^!/ }
#
## merge_left_only and merge_right_only are a bit different: they are
## called with $l only or $r only instead of both, and should return an
## extra argument $mode, i.e. ($key, $result, $backup, $is_circular,
## $mode)
#sub merge_left_only {
# my ($self, $key, $l) = @_;
# return;
#}
App-inplace
view release on metacpan or search on metacpan
script/inplace view on Meta::CPAN
our $DATE = '2023-02-15'; # DATE
our $DIST = 'App-inplace'; # DIST
our $VERSION = '0.002'; # VERSION
my %Opts = (
backup => "~",
);
my $Command;
my $File;
sub parse_cmdline {
my $res = GetOptions(
'backup|b:s' => \$Opts{backup},
'help|h' => sub {
print <<USAGE;
Usage:
inplace [INPLACE_OPTS] <COMMAND> <FILE> [CMD_OPTS]...
inplace --help
inplace options:
--backup[=.ext], -b
For more details, see the manpage/documentation.
USAGE
exit 0;
},
);
script/inplace view on Meta::CPAN
or die "inplace: Command '$Command' failed ($?), not replacing file '$File'\n";
close $tempfh
or die "inplace: Failed writing to tempfile '$tempfile': $!\n";
# if there is a backup extension, move the original file to backup
if (defined $Opts{backup} && $Opts{backup} ne '') {
my $bakfile = "$File$Opts{backup}";
rename $File, $bakfile
or die "inplace: Failed moving '$File' to '$bakfile': $!\n";
}
# replace original file with temporary file
script/inplace view on Meta::CPAN
If command is successful, then F<myfile.txt> will contain the output of the
command. F<myfile.txt~> will contain the original content. The file to be
replaced must be specified as the first argument to the command.
If you do not want any backup:
% inplace -b csv2ansitable myfile.txt
If you want another backup extension other than the default C<~>:
% inplace -b.bak csv2ansitable myfile.txt
If the file is not the first argument of the command, you can use C<-->:
App-ipinfo
view release on metacpan or search on metacpan
lib/App/ipinfo.pm view on Meta::CPAN
=back
=head1 SOURCE AVAILABILITY
The main source repository is in Github, and there are backup repos
in other services:
=over 4
=item * L<https://github.com/briandfoy/app-ipinfo>
App-lcpan
view release on metacpan or search on metacpan
lib/App/lcpan.pm view on Meta::CPAN
if (!$args->{cpan}) {
require File::HomeDir;
$args->{cpan} = File::HomeDir->my_home . '/cpan';
}
$args->{index_name} //= 'index.db';
if (!defined($args->{num_backups})) {
$args->{num_backups} = 7;
}
$args->{use_bootstrap} //= 1;
$args->{update_db_schema} //= 1;
}
lib/App/lcpan.pm view on Meta::CPAN
_set_args_default(\%args);
my $cpan = $args{cpan};
my $index_name = $args{index_name};
my $db_path = _db_path($cpan, $index_name);
if ($args{num_backups} > 0 && (-f $db_path)) {
require File::Copy;
require Logfile::Rotate;
log_info("Rotating old indexes ...");
my $rotate = Logfile::Rotate->new(
File => $db_path,
Count => $args{num_backups},
Gzip => 'no',
);
$rotate->rotate;
File::Copy::copy("$db_path.1", $db_path)
or return [500, "Copy $db_path.1 -> $db_path failed: $!"];
( run in 0.506 second using v1.01-cache-2.11-cpan-1d5ca39e368 )