App-bk
view release on metacpan or search on metacpan
bugtracker => {
web => 'https://github.com/duncs/perl-app-bk/issues',
},
homepage => 'https://github.com/duncs/perl-app-bk',
},
},
module_name => 'App::bk',
license => 'perl',
dist_author => q{Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>},
dist_version_from => 'lib/App/bk.pm',
dist_abstract => 'A pre-edit file backup program',
requires => {
'FindBin' => 0,
'File::Basename' => 0,
'Getopt::Long' => 0,
'Pod::Usage' => 0,
'English' => 0,
'POSIX' => 0,
'File::Copy' => 0,
'File::Which' => 0,
},
MANIFEST
MANIFEST.SKIP
META.yml
README
t/00-load.t
t/boilerplate.t
t/file1.txt
t/file2.txt
t/find_sum_binary.t
t/get_chksum.t
t/get_last_backup.t
t/manifest.t
t/multi_files.t
t/no_files.t
t/one_file.t
t/pod-coverage.t
t/pod.t
META.json
{
"abstract" : "A pre-edit file backup program",
"author" : [
"Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>"
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.421",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
---
abstract: 'A pre-edit file backup program'
author:
- 'Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>'
build_requires:
CPAN::Meta::Spec: '2.13338'
English: '0'
File::Basename: '0'
File::Copy: '0'
File::Which: '0'
FindBin: '0'
Getopt::Long: '0'
App-bk
bk is a quick file backup utility to be used prior to modifying files.
In essence it does a 'cp <file. <file>.date' but it ss far quicker to type
'bk <file>' and not have to worry about whether or not the backup file
already exists (bk checks that for you).
INSTALLATION
To install this module, run the following commands:
perl Build.PL
./Build
./Build test
./Build install
#
# Author: Duncan Ferguson, (c) 2011
use strict;
use warnings;
package main;
use App::bk;
App::bk::backup_files();
__END__
=head1 NAME
bk
=head1 SYNOPSIS
bk [-?hV]
bk [filename] [...]
=head1 DESCRIPTION
Command to ease backing up a file before editting. If a previously backed
up file exists and has a matching checksum a new backup is not made. Backed up
files have date/time appended as necessary.
When invoked as root the username is not appended to the backup file name.
Backups are stored relative to file being backed up.
=head1 OPTIONS
=over
=item --help, -?, -h
Display basic help
Enable debugging mode (using more than once increases verbosity, or specify
a level explicitly to a maximum of level 8)
=item --version, -V
Show version information
=item --diff, -d
Show the differences between the file and its last backup (using 'diff -u')
=item --edit, -e
After the file has been backed up, edit them (using EDITOR or VISUAL
environment variables)
=back
=head1 ARGUMENTS
lib/App/bk.pm view on Meta::CPAN
'edit|e' => 0,
);
my %options;
# 'tidier' way to store global variables
# 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 );
die("Version: $VERSION\n") if ( $options{version} );
pod2usage( -verbose => 1 ) if ( $options{'?'} || $options{help} );
pod2usage( -verbose => 2 ) if ( $options{HELP} || $options{man} );
lib/App/bk.pm view on Meta::CPAN
warn "WARNING: File $filename not found", $/;
next;
}
if ( !$savedir ) {
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";
$savefilename .= ".$options{username}" if ( $options{username} );
$savefilename .= ".$date";
if ( -f $savefilename ) {
$savefilename .= ".$time";
}
lib/App/bk.pm view on Meta::CPAN
sub get_diff {
my ( $old, $new ) = @_;
my $diff_binary = find_diff_binary();
my $differences = qx/$diff_binary -u $old $new/;
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" );
}
}
return $save_files[-1];
}
=head1 AUTHOR
t/get_last_backup.t view on Meta::CPAN
use FindBin qw($Bin);
use File::Copy;
my $result;
use_ok("App::bk");
chdir($Bin) || BAIL_OUT( 'Failed to cd into '. $Bin );
unlink <file1.txt.*>;
$result = trap { App::bk::get_last_backup(); };
is( $trap->stderr, '', 'no stderr output' );
is( $trap->stdout, '', 'no stdout output' );
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'die', 'died correctly' );
like(
$trap->die,
qr/^Invalid save directory provided at/,
'correct death output'
);
is( $result, undef, 'got correct output' );
$result = trap { App::bk::get_last_backup( $Bin, 'file1.txt' ); };
is( $trap->stderr, '', 'no stderr output' );
is( $trap->stdout, '', 'no stdout output' );
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'died correctly' );
is( $trap->die, undef, 'no die message' );
is( $result, undef, 'no backup file found' );
copy( 'file1.txt', 'file1.txt.12345678' );
$result = trap { App::bk::get_last_backup( $Bin, 'file1.txt' ); };
is( $trap->stderr, '', 'no stderr output' );
is( $trap->stdout, '', 'no stdout output' );
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'died correctly' );
is( $trap->die, undef, 'no die message' );
is( $result, 'file1.txt.12345678', 'correct backup file found' );
copy( 'file1.txt', 'file1.txt.87654321' );
$result = trap { App::bk::get_last_backup( $Bin, 'file1.txt' ); };
is( $trap->stderr, '', 'no stderr output' );
is( $trap->stdout, '', 'no stdout output' );
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'died correctly' );
is( $trap->die, undef, 'no die message' );
is( $result, 'file1.txt.87654321', 'correct backup file found' );
done_testing();
t/multi_files.t view on Meta::CPAN
my $result;
use_ok("App::bk");
chdir($Bin) || BAIL_OUT( 'Failed to cd into '. $Bin );
unlink <file*.txt.*>;
local @ARGV = ('no_such_file.txt');
$result = trap { App::bk::backup_files(); };
like(
$trap->stderr,
qr/WARNING: File no_such_file.txt not found/,
'correct stderr output'
);
is( $trap->stdout, '', 'no stdout output' );
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
local @ARGV = ( 'file1.txt', 'file2.txt' );
$result = trap { App::bk::backup_files(); };
is( $trap->stderr, '', 'no stderr output' );
like(
$trap->stdout,
qr!Backed up file1.txt to ./file1.txt.([\w-]+\.)?\d{8}
Backed up file2.txt to ./file2.txt.([\w-]+\.)?\d{8}
$!,
'got correct backup filename'
);
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
$result = trap { App::bk::backup_files(); };
is( $trap->stderr, '', 'no stderr output' );
like(
$trap->stdout,
qr!No change since last backup of file1.txt
No change since last backup of file2.txt
$!,
'got correct backup filename'
);
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
my $file1_last_backup_file = App::bk::get_last_backup( $Bin, 'file1.txt' );
note( 'Amending file ', $file1_last_backup_file );
chmod 0644, $file1_last_backup_file || BAIL_OUT("Could not reset perms on $file1_last_backup_file:: ". $!);
open(my $fh, '>>', $file1_last_backup_file) || BAIL_OUT("Could not open $file1_last_backup_file: ". $!);
print $fh ' Amended test',$/ || BAIL_OUT("Could not write to $file1_last_backup_file: ", $!);
close($fh) || BAIL_OUT("Could not close $file1_last_backup_file: ". $!);
my $file2_last_backup_file = App::bk::get_last_backup( $Bin, 'file2.txt' );
note( 'Amending file ', $file2_last_backup_file );
chmod 0644, $file2_last_backup_file || BAIL_OUT("Could not reset perms on $file2_last_backup_file:: ". $!);
open($fh, '>>', $file2_last_backup_file) || BAIL_OUT("Could not open $file2_last_backup_file: ". $!);
print $fh ' Amended test',$/ || BAIL_OUT("Could not write to $file2_last_backup_file: ". $!);
close($fh) || BAIL_OUT("Could not close $file2_last_backup_file: ". $!);
$result = trap { App::bk::backup_files(); };
is( $trap->stderr, '', 'no stderr output' );
like(
$trap->stdout,
qr!Backed up file1.txt to ./file1.txt.([\w-]+\.)?\d{8}\.\d{6}
Backed up file2.txt to ./file2.txt.([\w-]+\.)?\d{8}\.\d{6}
$!,
'got correct backup filename'
);
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
unlink <file*.txt.*>;
done_testing();
t/no_files.t view on Meta::CPAN
use strict;
use warnings;
use Test::More tests => 2;
use Test::Trap;
use_ok("App::bk");
local @ARGV = ();
my $r = trap { App::bk::backup_files(); };
like( $trap->stderr, qr/No filenames provided./, 'No files error ok' );
t/one_file.t view on Meta::CPAN
my $result;
use_ok("App::bk");
chdir($Bin) || BAIL_OUT( 'Failed to cd into '. $Bin );
unlink <file1.txt.*>;
local @ARGV = ('no_such_file.txt');
$result = trap { App::bk::backup_files(); };
like(
$trap->stderr,
qr/WARNING: File no_such_file.txt not found/,
'correct stderr output'
);
is( $trap->stdout, '', 'no stdout output' );
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
local @ARGV = ('file1.txt');
$result = trap { App::bk::backup_files(); };
is( $trap->stderr, '', 'no stderr output' );
like(
$trap->stdout,
qr!Backed up file1.txt to ./file1.txt.([\w-]+\.)?\d{8}\s$!,
'got correct backup filename'
);
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
$result = trap { App::bk::backup_files(); };
is( $trap->stderr, '', 'no stderr output' );
like(
$trap->stdout,
qr!No change since last backup of file1.txt$!,
'correctly got no change'
);
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
my $last_backup_file = App::bk::get_last_backup( $Bin, 'file1.txt' );
note( 'Amending file ', $last_backup_file );
# have to reset perms on some systems as the backed up file might be RO
chmod 0644, $last_backup_file || BAIL_OUT("Could not reset perms on $last_backup_file:: ". $!);
open(my $fh, '>>', $last_backup_file) || BAIL_OUT("Could not open $last_backup_file: ". $!);
print $fh ' Amended test',$/ || BAIL_OUT("Could not write to $last_backup_file: ". $!);
close($fh) || BAIL_OUT("Could not close $last_backup_file: ". $!);
$result = trap { App::bk::backup_files(); };
is( $trap->stderr, '', 'no stderr output' );
like(
$trap->stdout,
qr!Backed up file1.txt to ./file1.txt.([\w-]+\.)?\d{8}\.\d{6}\s$!,
'got correct backup filename'
);
is( $trap->exit, undef, 'correct exit' );
is( $trap->leaveby, 'return', 'returned correctly' );
is( $trap->die, undef, 'no death output' );
is( $result, 1, 'got correct return value' );
unlink <file1.txt.*>;
done_testing();
( run in 1.603 second using v1.01-cache-2.11-cpan-49f99fa48dc )