=head1 NAME
backup.pl - Yet Another Script for making rotating backups
=head1 SYNOPSIS
backup.pl --bakdir=??? [--netdir=??? --keep=???
--verbose|noverbose]
Options:
--bakdir - required - where to look for and store
backup files, uses environment
variable BAKDIR if it exists
--netdir - optional - where to make a redundant copy of
the new backup file, can be a
directory or file name, uses
environment variable BAKDIR_LAN if
it exists
--keep - optional - how many backup files to keep before
recycling the oldest, defaults to 10
--noverbose - optional - will suppress messsages to STDOUT
| OR
--verbose - optional - (default) will encourage messsages
to STDOUT
NOTE: The items to be backed up are listed in __DATA__
=head1 DESCRIPTION
Yet another personal backup script.
This script was written for my current work setup - WinXP with three
hard disk partitions and access to limited space on a network share.
It creates a zip-compressed backup file in $bakdir that contains a
set of files and directories as listed in __DATA__. Keeping the
list in __DATA__ means that it can't be separated from the backup
script.
It creates a new file each time it is run and it removes the oldest
backup file(s) when the total number of backup files exceeds $keep.
Backup filenames have the form yyyy-mm-dd-hh-nn-ss-xxx.zip. The
'xxx' part is to avoid a naming conflict when multiple backups are
created in the same second. The first filename will use '000', the
next '001' etc.
As an additional precaution it copies the newly created backup file
to $netdir. Yes this is redundant, but as the saying goes: "Who is
General Failure, and why is he reading my hard disk?"
Features have been minimised in the hope of avoiding the endless
complications of an industrial strength backup application. If you
want more features then you might want to consider
http://BackupPC.sourceforge.net.
The usual disclaimers apply. Please don't rely on this script
unless you have tested it to your own satisfaction.
=head1 BUGS
If you try to make more than 1000 backups in the same second the
script will probably start an infinite loop. Try to avoid this.
=head1 AUTHOR
EdwardG (perlmonks@edwardguiness.com)
Loosely based on File::Backup by Ken Williams and backfiles.pl by
Jeffa.
=head1 COPYRIGHT
Copyright 2003 Edward Guiness. All rights reserved.
This is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
File::Backup (CPAN)
http://BackupPC.sourceforge.net
http://perlmonks.com/index.pl?node_id=177830 (backfiles.pl)
=cut
use 5.6.1;
use strict;
use warnings;
use Getopt::Long;
use Env qw (BAKDIR BAKDIR_LAN);
use File::Path;
use Archive::Zip;
use File::Find::Rule;
use File::Copy;
use File::Spec;
use Pod::Usage;
my $verbose = 1;
my $keep = 10;
my $bakdir = '';
my $netdir = '';
GetOptions(
'verbose!' => \$verbose
, 'keep=i' => \$keep
, 'bakdir=s' => \$bakdir
, 'netdir=s' => \$netdir
);
$bakdir ||= $ENV{BAKDIR};
$netdir ||= $ENV{BAKDIR_LAN};
pod2usage(-verbose=>0) unless ($bakdir);
die "Cowardly refusing to keep less than 1 backup file\n" if ($keep <
+1);
sub yak {
print @_ if ($verbose);
}
sub newname {
my @t = reverse((localtime)[0..5]); $t[0]+=1900; $t[1]++;
my $newbackup = $bakdir.'\\'.sprintf("%4u-%02u-%02u-%02u-%02u-%02u
+_000",@t).'.zip';
$newbackup =~ s/(\d\d\d)\.zip$/substr('00'.($1+1),-3).'.zip'/e whi
+le (-e $newbackup);
return $newbackup;
}
# Ensure that the backup directory exists
eval {mkpath($bakdir)};
die "Unable to find or create directory $bakdir\n$@\n" if ($@);
yak "Attempting a backup of -\n";
# Tell Archive::Zip about the files and directories we want to backup
my $zip = Archive::Zip->new();
$zip->addTree($_,$_) for grep {
chomp;
yak "$_\n";
(($_) and (-e)) or not warn "'".$_."' NOT FOUND";
} <DATA>;
# Choose a name for this backup
my $newbackup=newname();
# Create the backup and confirm its existence
$zip->writeToFileNamed( $newbackup );
die "\$zip->writeToFileNamed() failed to create $newbackup\n" unless (
+-e $newbackup);
yak "New backup created: $newbackup (" . (-s $newbackup) . " bytes)\n"
+;
# Get a list of existing backup filenames sorted by modification time
my @backupfiles = sort {(stat $a)[9] <=> (stat $b)[9]}
File::Find::Rule
->file()
->name(qr/^\d\d\d\d(?:-\d\d){5}_\d\d\d\.zip$/)
->in($bakdir);
yak "Found a total of " . scalar(@backupfiles) . " backup files in $ba
+kdir\n";
# Recycle the oldest backup(s) if necessary
while ( scalar(@backupfiles) > $keep ) {
yak("Unlinking oldest backup file: ". File::Spec->canonpath($backu
+pfiles[0]) ."\n");
unlink($backupfiles[0]) or warn "Unable to unlink $backupfiles[0]\
+n";
shift @backupfiles;
}
if ($netdir) {
yak "Copying $newbackup to $netdir\n";
copy($newbackup, $netdir) or warn "Copy failed: $!";
}
yak "Finished\n";
__DATA__
c:\perl\usr\lib
c:\utils
c:\batch
e:\iis
c:\vim
e:\my documents
|
