Result:
found more than 894 distributions - search limited to the first 2001 files matching your query
( run in 1.810 )
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: $!"];
App-local-lib-Win32Helper
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-lupapona
view release on metacpan or search on metacpan
script/lupa-pona view on Meta::CPAN
$stream->write("20 text/gemini; charset=UTF-8\r\n");
$stream->write("Welcome to Lupa Pona!\n");
for (read_dir(".")) {
next if $_ eq $cert_file;
next if $_ eq $key_file;
next if /~$/; # Emacs backup files
$stream->write("=> $_\n") if -f;
}
} elsif ($path eq "/$cert_file" or $path eq "/$key_file") {
$stream->write("50 Forbidden\n");
} elsif ($path =~ m!^/([^/]+)$!) {
App-metasyn
view release on metacpan or search on metacpan
script/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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/_metasyn 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-migrate
view release on metacpan or search on metacpan
lib/App/migrate.pm view on Meta::CPAN
sub new {
my ($class) = @_;
my $self = bless {
paths => {}, # {prev_version}{next_version} = \@steps
on => {
BACKUP => \&_on_backup,
RESTORE => \&_on_restore,
VERSION => \&_on_version,
error => \&_on_error,
},
}, ref $class || $class;
lib/App/migrate.pm view on Meta::CPAN
return [@from, $to] if $p->{$to};
my %seen = map {$_=>1} @from;
return map {$self->_find_paths($to,@from,$_)} grep {!$seen{$_}} keys %{$p};
}
sub _on_backup {
croak 'You need to define how to make BACKUP';
}
sub _on_restore {
croak 'You need to define how to RESTORE from backup';
}
sub _on_version {
# do nothing
}
lib/App/migrate.pm view on Meta::CPAN
warn <<'ERROR';
YOU NEED TO MANUALLY FIX THIS ISSUE RIGHT NOW
When done, use:
exit to continue migration
exit 1 to interrupt migration and RESTORE from backup
ERROR
system($ENV{SHELL} // '/bin/sh') == 0 or die "Migration interrupted\n";
return;
}
lib/App/migrate.pm view on Meta::CPAN
you need to migrate anything isn't supported by VCS - you can try this
module/tool.
Sometimes it isn't possible to really downgrade because some data was lost
while upgrade - to handle these situations you should provide a ways to
create complete backup of your project and restore any project's version
from these backups while downgrade (of course, restoring backups will
result in losing new changes, so whenever possible it's better to do some
extra work to provide a way to downgrade without losing any data).
=head2 Example
lib/App/migrate.pm view on Meta::CPAN
parent for both '1.1.x' and '1.2.x' branches, so we need to downgrade
project from '1.1.8' to '1.0.42' first, and then upgrade from '1.0.42' to
'1.2.3'. You'll need two C<*.migrate> files, one which describe migrations
from '1.0.42' (or earlier version) to '1.1.8', and another with migrations
from '1.0.42' (or earlier) to '1.2.3'. For brevity let's not make any
backups while migration.
my $migrate = App::migrate
->new
->load('1.1.8.migrate')
->load('1.2.3.migrate');
lib/App/migrate.pm view on Meta::CPAN
=over
=item 'BACKUP' event
Handler will be executed when project backup should be created: before
starting any new migration, except next one after RESTORE.
If handler throws then 'error' handler will be executed.
Default handler will throw (because it doesn't know how to backup your
project).
NOTE: If you'll use handler which doesn't really create and keep backups
for all versions then it will be impossible to do RESTORE operation.
=item 'RESTORE' event
Handler will be executed when project should be restored from backup: when
downgrading between versions which contain RESTORE operation or when
migration fails.
If handler throws then 'error' handler will be executed.
lib/App/migrate.pm view on Meta::CPAN
calling error handler again if it throws too).
Default handler will run $SHELL (to let you manually fix errors) and throw
if you $SHELL exit status != 0 (to let you choose what to do next -
continue migration if you fixed error or interrupt migration to restore
version-before-migration from backup).
=back
=head2 run
lib/App/migrate.pm view on Meta::CPAN
after another.>
=item *
Make it obvious some version can't be downgraded and have to be restored
from backup.
I<Thus RESTORE operation is named in upper case.>
=item *
lib/App/migrate.pm view on Meta::CPAN
upgrade mkdir empty_dir
downgrade rmdir empty_dir
VERSION 0.1.0
# To upgrade from 0.1.0 to 0.2.0 we need to drop old database. This
# change can't be undone, so only way to downgrade from 0.2.0 is to
# restore 0.1.0 from backup.
upgrade rm useless.db
RESTORE
VERSION 0.2.0
# To upgrade from 0.2.0 to 1.0.0 we need to run several commands,
# and after downgrading we need to kill some background service.
lib/App/migrate.pm view on Meta::CPAN
version than C<$MIGRATE_PREV_VERSION>)
All executed commands must complete without error, otherwise emergency
shell will be started and user should either fix the error and C<exit>
from shell to continue migration, or C<exit 1> from shell to interrupt
migration and restore previous-before-this-migration version from backup.
=head2 Supported operations
=head3 VERSION
lib/App/migrate.pm view on Meta::CPAN
Can be used only after 'before_upgrade' or 'upgrade' operations.
When one or more 'RESTORE' operations are used between some 'VERSION'
operations then all 'downgrade' and 'after_downgrade' operations between
same 'VERSION' operations will be ignored and on downgrading previous
version will be restored from backup.
=head3 DEFINE
This operation must have only one non-multiline param - name of defined
macro. This name must not be same as one of existing operation names, both
App-minecraft
view release on metacpan or search on metacpan
lib/App/minecraft.pm view on Meta::CPAN
App::minecraft - Backup and restore your Minecraft. Install mods.
=head1 USAGE
$ minecraft.pl backup
$ minecraft.pl install Shelf.zip
$ minecraft.pl install --jar /usr/local/bin/jar Shelf.zip
$ minecraft.pl restore --verbose
=head1 DESCRIPTION
As it stands this script is very limited. However, I did manage to successfully backup my Minecraft folder, install the Shelf mod in the sample directory and restore my Minecraft without any problems.
Remember to always perform a backup using the 'backup' parameter before installing any mod, because this script can, and probably will, corrupt your main jar file. So use it at your own peril!
In the future I'd like it to properly check the contents of each zip before doing anything. Some mods have different formats, and App::minecraft needs to be smart enough to handle those and know what to do with them.
=head1 AUTHOR
App-mvr
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$
( run in 1.810 second using v1.01-cache-2.11-cpan-49f99fa48dc )