require v5.6;
use strict;
use warnings;
use File::Spec;
use File::Path;
use File::Copy;
use File::Find;
use Getopt::Long qw (:config bundling);
our $VERSION= v1.0.3;
=head AUTHOR John M. Dlugosz - john@dlugosz.com
=head ABSTRACT
This is a Perl program to perform daily backups of interesting "work"
+files
in an intelligent manner. See http://www.dlugosz.com/tools/index.html
+#work_backup
for more information and the latest version.
=head HISTORY
v1.0.1 - quick fix to put fatal error messages into LOG.
v1.0.2 - major bug fix! Got comparison backwards and didn't copy chang
+ed files,
only new files.
- deal with read-only files by removing the read-only bit on the dest.
+ Uses chmod
for portability, but abstracted for easy customization if needed.
- turn on WIDE_SYSTEM_CALLS. It doesn't break anything (e.g. File::Fi
+nd module) and
does now copy files with names outside the common OEM/ANSI code pages.
- run under ActiveState Perl 623, Perl 6.5.1.
- add filename skip rules for Source Insight and Visual Studio interme
+diate files. They
generate errors when copying at night with programs still open, and we
+ don't need them,
so filtering out will keep clutter out of the log. The rules should b
+e smart enough to
prevent false hits.
v1.0.3 - further abstract the copy function in anticipation of future
+changes, add eval
block around a single file's processing.
- add argument processing, with a few implemented and help screen to d
+ocument
plans for other options.
planned for v1.1 - trap individual errors and continue with rest of fi
+les.
plans for future versions - encrypt destination files.
=head INSTRUCTIONS
Edit the values in the next section to indicate where you want the fil
+es copied to and
which directories you want copied. Don't include a trailing slash in
+directory names!
For the "locations", make a list of source directories you want copied
+. The 'source' or 'docs'
string is a "rule". 'norule' is also a rule that has no special proce
+ssing but will copy all files.
You can include "rules" to skip copying of specified files or director
+ies. Edit the "skip_directory" or
"skip_file" function to add your intelligence. For example, 'source'
+directories don't back up the
compiler output, and 'docs' directories skip MS Word's litter. The "r
+ule" name is only used by
these functions, so define the names and the logic to suit.
The basic behavior of this program is to copy the files from your sour
+ce locations to the
backupdir. It will skip files based on date, only overwriting an olde
+r file with a newer.
=cut
##########################
### Configuration section - edit this.
my $custom_message= 'Configured for JMD';
my $backupdir= '\\\\data01\\A0436084\\backup';
my @locations= (
[ source => 'D:\\dev' ],
[ docs => 'D:\\My Documents' ],
[ source => 'F:\\dev' ],
[ docs => 'F:\\Documents' ],
[ norule => 'D:\\Program Files\\util']
);
###########################
### "rules" for skipping files. customize or extend this, if needed.
# functions return true to skip, false to backup normally.
${^WIDE_SYSTEM_CALLS}= 1; # comment this out on Win9X/Me if it's not
+simply ignored.
sub skip_directory ($$)
{
my ($directory, $rule)= @_;
if ($rule eq 'source') {
return 1 if $directory =~ /Release/i; # dirname contains "Releas
+e", includes things like "bin_Release" and "Releaseme";
return 1 if $directory =~ /Debug/i; # likewise
# >>>>> add rules here.
}
return undef; # don't skip.
}
sub skip_file ($$)
{
my ($filename, $rule)= @_;
if ($rule eq 'source') {
if ($filename =~/\.(?:IAB|IMB)$/) { # all-caps KNOWN, so no i.
# skip IAB and IMB files if a PR file with the same basename al
+so exists.
# these generate "file open" errors when Source Insight is runn
+ing.
(my $othername=$filename) =~ s/\....$/\.PR/;
return 1 if -e $othername; # looks like Source Insight index
+files.
}
if ($filename =~ /\.(?:ncb|opt)$/) { # all-lower known, so no i.
(my $othername=$filename) =~ s/\....$/\.dsw/;
# skip .NCB and .OPT if a .DSW exists.
return 1 if -e $othername; # Visual Studio project files inte
+rmediate junk.
}
# >>>>> add rules here.
}
elsif ($rule eq 'docs') {
return 1 if $filename =~ /[\\\/]~.+\.tmp$/i; # skip filenames li
+ke ~XXX.TMP;
}
return undef; # don't skip.
}
###########################
my $verbose= 0; # enable with -v
my $quiet= 0;
my $nolog= 0; # enable with -s
my $filecount= 0;
###########################
sub prep_target_file ($)
# this was introduced to deal with read-only files. It is called on t
+he dest filename
# before the copy takes place, and may do any work needed in this situ
+ation.
{
return unless -e $_[0];
chmod 0777, $_[0];
}
###########################
sub check_backupdir
{
eval { mkpath ($backupdir); };
if ($@) {
die "Error: cannot verify or create directory [$backupdir]\n$@\n";
}
unless ($nolog) {
my $logfile= File::Spec->catfile ($backupdir, "backup_log.txt");
print "logging results to [$logfile]\n" if $verbose;
open LOG, ">> $logfile" or die "Cannot open file [$logfile] for w
+riting.\n";
my $time= localtime();
print LOG "Started $time\n";
}
}
sub perform_copy ($$)
{
my ($sourcefile, $destfile) = @_;
unless (copy ($sourcefile, $destfile)) {
my $err= $!;
my $err2= $^E;
my $message= "ERROR COPYING FILE\n from $sourcefile\n to $destfile
+\n $err\n $err2\n";
print LOG $message unless $nolog;
print $message;
}
}
sub do_backup ($$$)
{
my ($sourcefile, $destfile, $rule)= @_;
if (-d $sourcefile) {
# do the directory
if (skip_directory ($sourcefile, $rule)) {
$File::Find::prune= 1; # tell find to skip the contents.
return;
}
mkpath ($destfile);
}
else { # is a file
return if skip_file ($sourcefile, $rule);
return if -e $destfile && (-M $destfile <= -M $sourcefile); # cop
+y is up to date.
print "==> $sourcefile\n" if $verbose;
++$filecount;
prep_target_file ($destfile);
perform_copy ($sourcefile, $destfile);
}
}
sub process_location ($)
{
my ($rule, $source)= @{shift @_};
my $dest= $source;
# change drive letter or server name to subdir
$dest =~ s/^(.):/Drive $1/;
$dest =~ s/^\\\\/\\/;
$dest= File::Spec->catdir ($backupdir, $dest);
print "Backing up [$source] to [$dest] using rule '$rule'\n" if $ver
+bose;
my $re= qr/^\Q$source\E/;
my $sub= sub {
my $sourcefile= $File::Find::name;
(my $destfile= $sourcefile) =~ s/$re/$dest/;
eval {
do_backup ($sourcefile, $destfile, $rule);
};
if ($@) {
my $message= "EXCEPTION CAUGHT trying to copy from [$sourcefile
+] to [$destfile].\n$@";
print LOG $message unless $nolog;
print $message;
}
};
find ($sub, $source);
print "Copied a total of $filecount files\n" if $verbose;
}
sub show_options
{
print <<"EOF";
NOTE: this is a placeholder and design docs. Options are not
implemented yet.
Usage:
With no parameters, performs the pre-configured backup. Change th
+e
configuration by editing the config section of \"$0\".
If filenames are given, will backup (or restore) just those named
+files
(directory names OK). If the named file is within the backup subd
+irectory
($backupdir) then the file will be restored to the original positi
+on.
Otherwise it is taken as the name of a file to backup.
Flags can modify this behavior. Flags are not order-dependant and
mean the same thing whether before, mixed with, or after filename
arguments.
Flags:
-restore Restores the named files. Unlike the implicit restore a
+bove,
the filename is the original location, not the backup location.
-full Ignore dates, always copy the file.
-all Ignore the skip rules and copy all files.
-verbose Print messages concerning program's operation.
-output=xxx Specify a different directory for restored files.
-keep Rename restored files by adding '.restored' to the name.
-secret Don't write to logfile.
-quiet Show less output.
-nowork Disable copy, used to try the options before doing it.
-help Show this message.
EOF
exit 1;
}
###########################
### "main" program
GetOptions (
'help|?|h' => \&show_options,
'verbose!' => \$verbose, 'v' => \$verbose,
'quiet!' => \$quiet, 'q' => \$quiet,
'secret!' => \$nolog, 's' => \$nolog
) || exit 1;
print "work_backup utility - $custom_message\n" unless $quiet;
check_backupdir();
eval {
if (@ARGV) {
# process named files on the command line
die "filename arguments not implemented yet.\n";
}
else {
foreach my $item (@locations) {
process_location ($item);
}
}
my $time= localtime();
print LOG "finished $time\n" unless $nolog;
print LOG "copied $filecount files\n" unless $nolog;
};
if ($@) {
print LOG "ABNORMAL TERMINATION: $@" unless $nolog;
print $@;
}
print LOG "======== done =========\n" unless $nolog;
close LOG unless $nolog;
print "copied $filecount files\n" unless $quiet;
|