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;