view release on metacpan or search on metacpan
lib/App/File/Grepper.pm view on Meta::CPAN
A perl pattern to select which files must be rejected. Note that this
pattern is applied to the basename of each file, not the full path.
Also, this pattern is applied before the filter pattern.
Version control directories C<RCS>, C<CVS>, C<.svn>, C<.git> and
C<.hg> are always excluded, as are common editor backups.
=back
=cut
view release on metacpan or search on metacpan
lib/App/FilenameTypeUtils.pm view on Meta::CPAN
wrap_code => _gen_wrapper('an audio file'),
);
require Filename::Type::Backup;
gen_modified_sub(
base_name => 'Filename::Type::Backup::check_backup_filename',
add_args => {
%argsopt,
},
modify_meta => sub {
$_[0]{result_naked} = 0;
# XXX we should adjust the examples instead
delete $_[0]{examples};
},
wrap_code => _gen_wrapper('a backup file'),
);
require Filename::Type::Compressed;
gen_modified_sub(
base_name => 'Filename::Type::Compressed::check_compressed_filename',
lib/App/FilenameTypeUtils.pm view on Meta::CPAN
=item 1. L<check-archive-filename>
=item 2. L<check-audio-filename>
=item 3. L<check-backup-filename>
=item 4. L<check-compressed-filename>
=item 5. L<check-ebook-filename>
lib/App/FilenameTypeUtils.pm view on Meta::CPAN
Return false if no archive suffixes detected. Otherwise return a hash of
information.
=head2 check_backup_filename
Usage:
check_backup_filename(%args) -> [$status_code, $reason, $payload, \%result_meta]
Check whether filename indicates being a backup file.
This function is not exported.
Arguments ('*' denotes required arguments):
lib/App/FilenameTypeUtils.pm view on Meta::CPAN
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value: (bool|hash)
Return false if not detected as backup name. Otherwise return a hash, which may
contain these keys: C<original_filename>. In the future there will be extra
information returned, e.g. editor name (if filename indicates backup from
certain backup program), date (if filename contains date information), and so
on.
=head2 check_compressed_filename
view release on metacpan or search on metacpan
lib/App/FilenameUtils.pm view on Meta::CPAN
wrap_code => _gen_wrapper('an audio file'),
);
require Filename::Type::Backup;
gen_modified_sub(
base_name => 'Filename::Type::Backup::check_backup_filename',
add_args => {
%argsopt,
},
modify_meta => sub {
$_[0]{result_naked} = 0;
# XXX we should adjust the examples instead
delete $_[0]{examples};
},
wrap_code => _gen_wrapper('a backup file'),
);
require Filename::Type::Compressed;
gen_modified_sub(
base_name => 'Filename::Type::Compressed::check_compressed_filename',
lib/App/FilenameUtils.pm view on Meta::CPAN
=item 1. L<check-archive-filename>
=item 2. L<check-audio-filename>
=item 3. L<check-backup-filename>
=item 4. L<check-compressed-filename>
=item 5. L<check-ebook-filename>
lib/App/FilenameUtils.pm view on Meta::CPAN
Return false if no archive suffixes detected. Otherwise return a hash of
information.
=head2 check_backup_filename
Usage:
check_backup_filename(%args) -> [$status_code, $reason, $payload, \%result_meta]
Check whether filename indicates being a backup file.
This function is not exported.
Arguments ('*' denotes required arguments):
lib/App/FilenameUtils.pm view on Meta::CPAN
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value: (bool|hash)
Return false if not detected as backup name. Otherwise return a hash, which may
contain these keys: C<original_filename>. In the future there will be extra
information returned, e.g. editor name (if filename indicates backup from
certain backup program), date (if filename contains date information), and so
on.
=head2 check_compressed_filename
view release on metacpan or search on metacpan
lib/App/FindUtils.pm view on Meta::CPAN
'x.doc.show_result' => 0,
src => '[[prog]]',
src_plang => 'bash',
},
{
summary => "Find duplicate receipts by order ID (filenames are named receipt-order=12345.pdf), exclude backup files",
test => 0,
'x.doc.show_result' => 0,
src => q{[[prog]] -x '/\\.bak$/' -r '/order=(\\d+)/' --debug},
src_plang => 'bash',
},
view release on metacpan or search on metacpan
lib/App/FirefoxMultiAccountContainersUtils.pm view on Meta::CPAN
require File::Copy;
require File::Slurper;
require Firefox::Util::Profile;
require JSON::MaybeXS;
my ($args, $do_backup) = @_;
my $res;
if ($do_backup) {
$res = App::FirefoxUtils::firefox_is_running();
return [500, "Can't check if Firefox is running: $res->[0] - $res->[1]"]
unless $res->[0] == 200;
if ($args->{-dry_run}) {
log_info "[DRY-RUN] Note that Firefox is still running, ".
lib/App/FirefoxMultiAccountContainersUtils.pm view on Meta::CPAN
$path = "$path/containers.json";
return [412, "Can't find '$path', is this Firefox using Multi-Account Containers?"]
unless (-f $path);
unless ($args->{-dry_run} || !$do_backup) {
log_info "Backing up $path to $path~ ...";
File::Copy::copy($path, "$path~") or
return [500, "Can't backup $path to $path~: $!"];
}
my $json = JSON::MaybeXS::decode_json(File::Slurper::read_text($path));
[200, "OK", {path=>$path, content=>$json}];
lib/App/FirefoxMultiAccountContainersUtils.pm view on Meta::CPAN
$code = eval $code; ## no critic: BuiltinFunctions::ProhibitStringyEval
return [400, "Cannot compile string code: $@"] if $@;
}
my $res;
$res = _get_containers_json(\%args, 'backup');
return $res unless $res->[0] == 200;
my $path = $res->[2]{path};
my $json = $res->[2]{content};
my $new_identities = [];
lib/App/FirefoxMultiAccountContainersUtils.pm view on Meta::CPAN
my %args = @_;
defined(my $name = $args{name}) or return [400, "Please specify name for new container"];
my $res;
$res = _get_containers_json(\%args, 'backup');
return $res unless $res->[0] == 200;
my $path = $res->[2]{path};
my $json = $res->[2]{content};
lib/App/FirefoxMultiAccountContainersUtils.pm view on Meta::CPAN
my $sort_sub = $args{sort_sub} // 'asciibetically';
my $sort_args = $args{sort_args} // [];
my $cmp = Sort::Sub::get_sorter($sort_sub, { map { split /=/, $_, 2 } @$sort_args });
my $res;
$res = _get_containers_json(\%args, 'backup');
return $res unless $res->[0] == 200;
my $path = $res->[2]{path};
my $json = $res->[2]{content};
$json->{identities} = [
view release on metacpan or search on metacpan
share/clean.pl view on Meta::CPAN
push(@output, @input);
return join('', @output)
}
#----------------------------------------------------------------------
# Create a backup copy of the original file
sub backup_file {
my ($file, $text) = @_;
$file .= '~';
write_file($file, $text);
}
share/clean.pl view on Meta::CPAN
my ($patterns, @files) = @_;
foreach my $file (@files) {
my $text = slurp_file($file);
backup_file($file, $text);
my @tags = web_split_at_tags($text);
my $tokens = {next => 0, data => \@tags};
$text = replace_tokens($patterns, $tokens);
view release on metacpan or search on metacpan
TODO:
- Add --backup (or --no-backup) option
- Change --package option to --class
0.024 Monday June 08 11:06:08 PDT 2009:
- Added --class as an alias to --package
- Added "Apache2 and FastCGI on Ubuntu" tutorial
view release on metacpan or search on metacpan
examples/eg1.pl view on Meta::CPAN
sub app
{
my ($app) = @_ ;
# Get source/dest dirs
my ($src_dir, $backup_dir) = $app->args();
# options
my %opts = $app->options() ;
if ($opts{array})
examples/eg1.pl view on Meta::CPAN
[ARGS]
* src_dir=d Source directory
* backup_dir=d Backup directory
[OPTIONS]
-database=s Database name [default=test]
view release on metacpan or search on metacpan
script/_genpass-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,
# };
#}
#
#sub _process_todo {
# my ($self) = @_;
script/_genpass-id 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/_genpass-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) {
# $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/_genpass-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/_genpass-id 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/_genpass-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/_genpass-id 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/_genpass-id 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/_genpass-id 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/_genpass-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 };
#
#
script/_genpass-id 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/_genpass-id view on Meta::CPAN
#
# if ($config_replaced) {
# $mm->config($orig_c);
# }
#
# ($key, $res, $backup);
#}
#
#1;
#
#__END__
view release on metacpan or search on metacpan
script/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist 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/_genpass-wordlist view on Meta::CPAN
#
# if ($config_replaced) {
# $mm->config($orig_c);
# }
#
# ($key, $res, $backup);
#}
#
#1;
#
#__END__
view release on metacpan or search on metacpan
MANIFEST.SKIP view on Meta::CPAN
# Avoid Module::Build generated and utility files.
\bBuild$
\b_build/
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
view release on metacpan or search on metacpan
bin/git-hook-setup view on Meta::CPAN
sub write_hooks {
my ($dir, $hooks) = @_;
for my $hook (keys %{ $hooks } ) {
my $file = catfile($dir, $hook);
my $backup = catfile($dir, "$hook~");
my $count = 1;
while (-e $backup) {
$backup = catfile($dir, "$hook$count~");
$count++;
}
system 'cp', $file, $backup;
my $fh = $file->openw;
print {$fh} $hooks->{$hook};
close $fh;
chmod 0755, $file;
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$
view release on metacpan or search on metacpan
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
# All of the above do the same thing, basically
=head1 DESCRIPTION
App::GitHub::FixRepositoryName will automatically find and update the github repository URLs in .git/config (so that they have
the right casing). It will first make a backup of your .git/config AND it will prompt you before writing out
the new config (and show it to you first)
=head1 INSTALL
You can install L<App::GitHub::FixRepositoryName> by using L<CPAN>:
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
A commandline application that will fix a given .git/config to have the right repository name(s)
Usage: github-fix-repository-name [...] <path1> <path2> ...
--backup-to <directory> Backup 'config' to <directory> (default is the same directory)
--no-backup Do not make a backup first
--always-yes Assume yes when asking to write out the new config
--help, -h, -? This help
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
warn $error if $error;
warn <<'_END_';
Usage: github-fix-repository-name [...] <path>
--backup-to <directory> Backup 'config' to <directory> (default is the same directory)
--no-backup Do not make a backup first
--always-yes Assume yes when asking to write out the new config
--help, -h, -? This help
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
}
sub run {
my $self = shift;
my ($backup_to, $no_backup, $always_yes, $help);
GetOptions(
'help|h|?' => \$help,
'backup-to=s' => \$backup_to,
'no-backup' => \$no_backup,
'always-yes|Y' => \$always_yes,
);
if ($help) {
do_usage;
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
}
my @fix = @ARGV ? @ARGV : qw/./;
for my $path (@fix) {
$self->_try_to_fix_file_or_directory( $path,
backup_to => $backup_to, no_backup => $no_backup, always_yes => $always_yes );
}
}
sub _try_to_fix_file_or_directory {
my $self = shift;
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
if (! -s _ ) {
carp "File \"$file\" is empty";
return;
}
my ($backup_file);
my ($content, $original_content) = $self->fix_file( $file );
if ($content eq $original_content) {
$print->( "Nothing to do to \"$file\"\n" );
return;
}
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
unless ($Y) {
$print->( "Abandoning update to \"$file\"\n" );
return;
}
}
unless ( $given{no_backup} ) {
$backup_file = $self->_backup_file( $file, to => $given{backup_to}, template => $given{backup_template} );
$print->( "Made a backup of \"$file\" to \"$backup_file\"\n" );
}
File::AtomicWrite->write_file({ file => $file, input => \$content });
$print->( "Fixup of \"$file\" complete\n" );
$file = Path::Class::File->new( "$file" );
return wantarray ? ($file, $backup_file) : $file;
}
}
# TODO: Factor this out to a CPAN module
sub _backup_file {
my $self = shift;
my $file = shift;
my %given = @_;
croak "Wasn't given file to backup" unless defined $file;
croak "Can't read file \"$file\"" unless -r $file;
$file = Path::Class::File->new( "$file" );
my $to = $given{to} || $file->parent;
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
$to = Path::Class::Dir->new( "$to" );
$to->mkpath unless -e $to;
croak "Backup destination \"$to\" is not a directory (or doesn't exist)" unless -d $to;
croak "Cannot write to backup destination \"$to\"" unless -w _;
my $template = $given{template} || '.backup-%basename-%date-%tmp';
if ($template =~ m/%fullpath\b/) {
my $value = $file.'';
$value =~ s!/+!-!g;
$template =~ s/%fullpath\b/$value/g;
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
if ($template =~ m/%sha1\b/) {
my $value = sha1_hex scalar $file->slurp;
$template =~ s/%sha1\b/$value/g;
}
my ($handle, $backup_file);
if ($tmp) {
($handle, $backup_file) = tempfile( $template, DIR => "$to", UNLINK => 0 );
}
else {
$backup_file = $to->file( $template );
$handle = $backup_file->openw or croak "Couldn't open \"$backup_file\": since $!";
}
$handle->print( scalar $file->slurp );
close $handle;
my $file_size = -s $file;
my $backup_file_size = -s $backup_file;
croak "Couldn't backup \"$file\" ($file_size) to \"$backup_file\" ($backup_file_size): size doesn't match!" unless $file_size == $backup_file_size;
return Path::Class::File->new( $backup_file );
}
=head1 AUTHOR
Robert Krimen, C<< <rkrimen at cpan.org> >>
view release on metacpan or search on metacpan
App::Glacier
============
Command line utility for working with Amazon Glacier, an online service
that provides storage for data archiving and backup.
Usage:
glacier COMMAND [OPTIONS] [ARGS]
view release on metacpan or search on metacpan
[GithubMeta]
; Enable issue tracking using Github
issues = 1
[PruneFiles]
; Git rid of backup files
match = ~$
match = \.bak$
[NextRelease]
format = %-7v %{yyyy-MM-dd}d
view release on metacpan or search on metacpan
lib/App/Gre.pm view on Meta::CPAN
other. One level is the "include" filters like -perl, -nophp, or
-ext=c. The second level is the "exclude" filters like -xname=foo
or -xbinary.
Why are they independent? Consider if the script had a default
filter to remove all backup files (-xname='~$') which would have
to mix with additional command line filters. The following would
try to search for bash files (files whose first line starts with
#!/bin/bash) that aren't backups:
$ gre -xname='~$' -line1='^#!/bin/bash'
It wouldn't work if they weren't independent: filters are additive,
so this would have added all files which are not backups then add
all files which are bash files (some of which may be backup files).
The reason the filters have to be additive is to let commands like
this work:
$ gre -html -js
lib/App/Gre.pm view on Meta::CPAN
Then you wouldn't have a chance to disable it:
$ gre -line1='^#!/bin/bash' -noxname='~$' -xname='~$'
It would still filter out the backup files.
The result should be intuitive. For example, if you want to
search everything except one file that's messing up the search add:
$ gre -xname=INBOX.mbox -ext=mbox qwerty
and you wouldn't have to worry about order of these filters.
If you want to remove all the builtin "exclude" filters, use -x on
the command line. By default, gre will exclude backup files, swap
files, core dumps, .git directories, .svn directories, binary files,
minimized js files, and more. See the output of -c for the full
list.
"exclude" filters also have another property which the regular
view release on metacpan or search on metacpan
lib/App/Greple/subst/desumasu.pm view on Meta::CPAN
=item B<--overwrite>
To update the file, use these options. Option B<--create> make new
file with extention C<.new>. Option B<--replace> updates the target
file with backup, while option B<--overwrite> does it without backup.
=back
See L<App::Greple::subst> for other options.
view release on metacpan or search on metacpan
lib/App/Greple/subst.pm view on Meta::CPAN
original filename.
=item B<--replace>
Replace the target file by converted result. Original file is renamed
to backup name with ".bak" suffix.
=item B<--overwrite>
Overwrite the target file by converted result with no backup.
=back
=head1 DICTIONARY
lib/App/Greple/subst.pm view on Meta::CPAN
--update::update \
--update::discard
option --diff --subst --update::diff
option --create --subst --update::create
option --replace --subst --update::update --with-backup
option --overwrite --subst --update::update
option --with-stat --epilogue subst_show_stat
option --stat --update::discard --with-stat
view release on metacpan or search on metacpan
lib/App/Greple/update.pm view on Meta::CPAN
greple -Mupdate
Options:
--update replace file content
--with-backup make backup files
--diff produce diff output
-U# specify unified diff context length
--discard simply discard the output
lib/App/Greple/update.pm view on Meta::CPAN
The file is also not updated if the output is empty. This is to
prevent the contents of the file from being erased if none of the
match strings are included. If you want to intentionally empty a
file, you need to think of another way.
=item B<--with-backup>[=I<suffix>]
Backup original file with C<.bak> suffix. If optional parameter is
given, it is used as a suffix string. If the file exists, C<.bak_1>,
C<.bak_2> ... are used.
lib/App/Greple/update.pm view on Meta::CPAN
our $debug = 0;
our $remember_data = 1;
our $opt_update_diffcmd = "diff -u";
our $opt_suffix = '';
our $opt_backup;
our $opt_U = '';
my $current_file;
my $contents;
my @update_diffcmd;
lib/App/Greple/update.pm view on Meta::CPAN
sub update_initialize {
@update_diffcmd = shellwords $opt_update_diffcmd;
if ($opt_U ne '') {
@update_diffcmd = ('diff', "-U$opt_U");
}
if (defined $opt_backup) {
$opt_suffix = $opt_backup ne '' ? $opt_backup : '.bak';
}
}
sub update_begin {
my %arg = @_;
lib/App/Greple/update.pm view on Meta::CPAN
builtin diffcmd=s $opt_update_diffcmd
builtin update-suffix=s $opt_suffix
builtin U=i $opt_U
builtin remember! $remember_data
builtin with-backup:s $opt_backup
option default \
--prologue update_initialize \
--begin update_begin
view release on metacpan or search on metacpan
lib/App/Greple/dig.pm view on Meta::CPAN
## files
##
expand is_dots -name .*
expand is_version -name *,v
expand is_backup ( -name *~ -o -name *.swp )
expand is_image ( -iname *.jpg -o -iname *.jpeg -o \
-iname *.gif -o -iname *.png -o \
-iname *.ico -o \
-iname *.heic -o -iname *.heif -o \
-iname *.svg -o \
lib/App/Greple/dig.pm view on Meta::CPAN
-prune -o \
-type f \
) \
! is_dots \
! is_version \
! is_backup \
! is_image \
! is_archive \
! is_pdf \
! is_db \
! is_others \
view release on metacpan or search on metacpan
setup/import_export/ascii.pl view on Meta::CPAN
my ($self, $elements_to_save, $file) = @_ ;
if($self->{CREATE_BACKUP} && -e $file)
{
use File::Copy;
copy($file,"$file.bak") or die "export_pod: Copy failed while making backup copy: $!";
}
write_file($file, $self->transform_elements_to_ascii_buffer()) ;
#~ open FH, ">:encoding(utf8)", $file_name;
#~ print FH $self->transform_elements_to_ascii_buffer() ;
view release on metacpan or search on metacpan
t/in/status.dat view on Meta::CPAN
last_hard_state_change=1279065910
last_time_ok=1280288856
last_time_warning=0
last_time_unknown=0
last_time_critical=0
plugin_output=/dev/mapper/misc-backup 109G 40G 69G 37% /backup
long_plugin_output=
performance_data=
last_check=1280288856
next_check=0
check_options=0
view release on metacpan or search on metacpan
lib/App/InvestSim/Values.pm view on Meta::CPAN
# two arguments:
# - the string to validate.
# - the validation event: 'key' when the validation is for a key entered by the
# user, 'focusout' when the value is complete and it can be validated
# entirely. That second event is also used to validate values read from a
# backup file.
# On failure, these methods must all return 0 (and not just '' which is the
# default false value), as that is expected by Tcl.
# An integer that is allowed to be 0 or more.
sub validate_non_negative_integer {
view release on metacpan or search on metacpan
* lib/App/Jawk.pm: restored, for ease of implementation.
Dist::Zilla wanted it by default.
2012-12-16 14:04 joshr
* .Makefile.PL: backup
2012-12-16 14:14 joshr
* .README, README: 'file moved from README to .README'
view release on metacpan or search on metacpan
lib/App/JobLog.pm view on Meta::CPAN
with special valence so the log has to handle its own escaping of spaces and colons and so forth. We don't want to
worry about character encoding so the log has to be in Unicode (utf8).
B<App::JobLog> keeps its documents, by default, in a hidden directory in your home directory called F<.joblog/>. These
documents are a README file explaining to anyone who stumbles across the directory what it's function is, a log, called
F<log>, a configuration file, called F<config.ini>, a vacation file, called F<vacation>, and perhaps log backups.
To perform any action with B<App::JobLog> one invokes the executable with a command and a list of options. These commands
are listed below.
=head2 COMMANDS
view release on metacpan or search on metacpan
lib/App/LDAP/Command/Export.pm view on Meta::CPAN
App::LDAP::Command::Export
=head1 SYNOPSIS
$ sudo ldap export backup.ldif
backup whole DIT
$ ldap export people.ldif --base ou=people,dc=example,dc=com
dump user information without password
$ sudo ldap export people.ldif --base ou=people,dc=example,dc=com
view release on metacpan or search on metacpan
lib/App/LXC/Container/Data/common.pm view on Meta::CPAN
'/usr/share/lintian/overrides ignore',
'/usr/share/man ignore',
'/usr/share/misc/magic.mgc ignore',
'/usr/src nomerge',
'/var nomerge',
'/var/backups ignore',
'/var/cache nomerge',
# Note that /var/lib would break the start of a container due to
# /var/lib/lxc* behaving unexpectedly:
'/var/lib nomerge',
'/var/lib/dpkg ignore',
view release on metacpan or search on metacpan
lib/App/LedgerSMB/Admin.pm view on Meta::CPAN
Provides base version tracking and management routines
=head2 App::LedgerSMB::Admin::Database
Routines to reload, create, update, backup, and restore databases
=head2 App::LedgerSMB::Admin::Database::Setting
Look up settings in a LedgerSMB database
view release on metacpan or search on metacpan
bin/licensecheck view on Meta::CPAN
I<Since v2.10.10.>
regular expression of files to skip
when more than one F<PATH> is provided
S<(default value: some backup and VCS files)>
=item B<-r>, B<--recursive>
I<Since v2.10.7.>
bin/licensecheck view on Meta::CPAN
check|c=s
ignore|i=s
recursive|r
);
$OPT{check} = 'common source files';
$OPT{ignore} = 'some backup and VCS files';
=head2 Parsing contents
=over 16
bin/licensecheck view on Meta::CPAN
)$
!;
# From dpkg-source
my $default_ignore_regex = q!
# Ignore general backup files
~$|
# Ignore emacs recovery files
(?:^|/)\.#|
# Ignore vi swap files
(?:^|/)\..*\.swp$|
bin/licensecheck view on Meta::CPAN
(?:^|/),,.*(?:$|/.*$)|
# File-names that should be ignored (never directories)
(?:^|/)(?:DEADJOE|\.cvsignore|\.arch-inventory|\.bzrignore|\.gitignore)$|
# File or directory names that should be ignored
(?:^|/)(?:CVS|RCS|\.pc|\.deps|\{arch\}|\.arch-ids|\.svn|\.hg|_darcs|\.git|
\.shelf|_MTN|\.bzr(?:\.backup|tags)?)(?:$|/.*$)
!;
my $check_regex = $OPT{check};
if ( !$check_regex or $check_regex eq 'common source files' ) {
$check_regex = qr/$default_check_regex/x;
bin/licensecheck view on Meta::CPAN
else {
$check_regex = qr/$check_regex/;
}
my $ignore_regex = $OPT{ignore};
if ( !$ignore_regex or $ignore_regex eq 'some backup and VCS files' ) {
$ignore_regex = qr/$default_ignore_regex/x;
}
else {
$ignore_regex = qr/$ignore_regex/;
}