sourcecode John M. Dlugosz <CODE> 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 changed 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::Find 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 intermediate 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 be 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 document plans for other options. planned for v1.1 - trap individual errors and continue with rest of files. plans for future versions - encrypt destination files. =head INSTRUCTIONS Edit the values in the next section to indicate where you want the files 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 processing but will copy all files. You can include "rules" to skip copying of specified files or directories. 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 "rule" 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 source locations to the backupdir. It will skip files based on date, only overwriting an older 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 "Release", 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 also exists. # these generate "file open" errors when Source Insight is running. (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 intermediate junk. } # >>>>> add rules here. } elsif ($rule eq 'docs') { return 1 if $filename =~ /[\\\/]~.+\.tmp$/i; # skip filenames like ~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 the dest filename # before the copy takes place, and may do any work needed in this situation. { 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 writing.\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); # copy 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 $verbose; 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 the 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 subdirectory ($backupdir) then the file will be restored to the original position. 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 above, 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; </CODE> This is a Perl program to perform daily backups of interesting "work" files in an intelligent manner. Developed under Win32, should be OK on all platforms. Utility Scripts John M. Dlugosz http://www.dlugosz.com/tools/index.html#work_backup