#!/usr/bin/perl -w
use strict;

#------------------------------------------------------------------
#                                                           READ ME

=pod

backup: A script to keep a syncronized copy of the chosen directories.
  Only copies files that have been modified since last backup.

for UNIX systems, including OS X. by N Resnikoff, 2004.  This is free
software, you may do with it as you wish.

---------TO USE:

1. Examine the entries in the 'SETTINGS' section and adjust to suit.

2. Run from command line; no arguments needed.

---------MORE INFO & CAVEATS:

See Documentation section below.

=cut

#------------------------------------------------------------------
#                                                          SETTINGS

# options:
my $apple   = 'yes';  # use MacCP if it's an apple system
my $cull    = 'yes';  # erase files in dest that don't match source
my $verbose = 1;      # print report messages; 0=silent
my $test    = 'no';   # make directories, don't copy files

# destination directory:
my $backupTo = '/Volumes/Java/Backup';

# directories to back up:
my @sources =
  (
   '/Users/ned',
   '/Users/Shared/Pictures',
   '/Users/Shared/Music',
   '/Library/Webserver',
  );

# directories to skip:
my @blacklist =
  (
   '/Users/ned/.Trash',
   '/Users/ned/.cpan',
   '/Users/ned/.emacs.d',
   '/Users/ned/TV',
   '/Users/ned/Transfer',
   '/Users/ned/Desktop/JohnsMusic',
   '/Users/ned/Library/Application Support/FullCircle',
   '/Users/ned/Library/Caches',
   '/Users/ned/Library/Favorites',
   '/Users/ned/Library/LauncherItems',
   '/Users/ned/Library/Mozilla',
   '/Users/ned/Library/Safari/Icons',
   '/Users/ned/Library/Mail/POP-ned@pop.resnikoff.com/Junk.mbox',
   '/Users/ned/Library/Preferences/com.apple.recentitems.plist',
   '/Users/Shared/Pictures/ Slideshow',
   '/Library/Webserver/CGI-Executables/NL',
  );

#------------------------------------------------------------------
#                                                     DOCUMENTATION

=pod

$Apple: On Macs, use CpMac instead of cp, to copy resource forks.  See
  caveats below.

$cull: if no, directories in destination directory not matching ones
  in source directories will be left, instead of being removed.

$verbose: 0=quite, 1=basic, 2 & 3 are extra-wordy for debugging.

$test: if yes, report what would be copied but don't copy.  Does,
  however, create directories.

---------

$backupTo is the top-level backup directory.  The script will create
  directories within it that correspond to the source directories.

@sources is a list of directories to copy.  Invisible files &
  directories (those whose filenames start with a dot ('.') are copied
  also, unless, of course, they're on the blacklist.

@blacklist is a list of files & directories within the source tree to
  skip.  They can be listed in any order.  A simple way to create this
  list is to watch the output from backup.  If it's copying something
  you don't want copied, cut-and-paste the filename or directory name
  from the output into the blacklist and run again.

---------CAVEATS---------

To use on Macs, you must have developer tools installed, or at least
  the utility /Developer/Tools/CpMac.

Can't copy filenames with '$'.. not sure why.


=cut

#------------------------------------------------------------------
#                                                              CODE

report(0, "---------STARTING BACKUP SCRIPT---------");

# canonicalize names in white & blacklist: no trailing slash:
map( {s|/*$/||} @sources );
map( {s|/*$/||} @blacklist );

# make blacklist hash
my %skip = map({$_=>1} @blacklist);

#begin:
map({syncDirectory($_, $backupTo.$_)} @sources);

report(0, "---------FINISHED BACKUP SCRIPT---------");
exit;

#------------------------------------------------------------------
#                                                       SUBROUTINES

sub syncDirectory {
  my ($src, $dest) = @_;
  # is source on blacklist?
  exists($skip{$src}) and report(1, "Directory $src on blacklist; skipping")
    and ($cull eq 'yes') and remove($dest) and return 1;
  # does source directory exist?
  (!-e $src)  and die "No such directory as $src";
  # does destination directory exist?
  (!-e $dest) and makeDirectory($dest);
  # read filenames from source directory:
  opendir(DIR, $src) or die "Couldn't open directory $src; $!";
  my @names = readdir(DIR);
  closedir(DIR);
  report(1, "checking $src");
  #-- for each in this directory:
  for my $name (@names) {
    next if $name eq "." ;
    next if $name eq "..";
    # on blacklist?
    exists($skip{"$src/$name"}) and report(1, "$src/$name on blacklist; skipping") and next;
    # must be regular file or directory:
    next unless ((-f "$src/$name") or (-d "$src/$name"));
    # if a directory, recurse:
    (-d "$src/$name") and syncDirectory("$src/$name","$dest/$name") and next;
    # so name must be a file; if not in backup at all, copy:
    (!-e "$dest/$name") and copyFile("$src/$name", "$dest/$name") and next;
    ## else, compare mod dates:
    my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
	$atime, $mtime, $ctime, $blksize, $blocks) = stat "$src/$name";
    my ($dev1,$ino1,$mode1,$nlink1,$uid1,$gid1,$rdev1,$size1,
	$atime1,$mtime1,$ctime1,$blksize1,$blocks1)= stat "$dest/$name";
    ($mtime > $mtime1) ?
      copyFile("$src/$name", "$dest/$name") :
	report(1, "$dest/$name is up-to-date");
  }
  # check whether dest contains things that source doesn't:
  ($cull eq 'yes') and cullDirectory($src, $dest);
  report(2, "Finished $src");
  return 1;
}

sub copyFile {
  my ($src, $dest) = @_;
  # on blacklist?
  (exists($skip{$src})) and report(0, "File $src on blacklist; skipping") and return 1;
  # just testing?
  ($test eq 'yes') and report(0, "Test: would copy $src") and return 1;
  #if on apple system, use CpMac:
  if ($apple eq 'yes') {
    !system "/Developer/Tools/CpMac \"$src\" \"$dest\""  or die "Couldn't perform CpMac \"$src\" \"$dest\"; $!";
  } else {
    !system "cp -p \"$src\" \"$dest\"" or die "Couldn't perform cp \"$src\" \"$dest\"; $!";
  }
  report(0, "Copied $src");
  return 1;
}

# can make nested directories:
sub makeDirectory {
  my ($dest) = @_;
  # check for nested structure
  $dest =~ s|^/||;
  my @elts = split('/', $dest);
  my $name = '';
  for my $elt (@elts) {
    $name .= "/$elt";
    if (!-e $name) {
      report(0, "Creating directory $name\n");
      !system("mkdir \"$name\"") or die "Couldn't create directory \"$name\"; $!";
    }
  }
}

# erase unmatched files & dirs in destination directory tree:
sub cullDirectory {
  my ($src, $dest) = @_;
  #-- get names in both dirs:
  opendir(DIR, $src) or die "Couldn't open directory $src; $!";
  my %srcNames = map({$_=>1} readdir(DIR));
  closedir(DIR);
  opendir(DIR, $dest) or die "Couldn't open directory $dest; $!";
  my @destNames = readdir(DIR);
  closedir(DIR);
  #--check:
  for my $name (@destNames) {
    next if $name eq ".";
    next if $name eq "..";
    if (exists($skip{"$src/$name"}) || !exists($srcNames{$name}) ) {
      remove("$dest/$name");
    }
  }
}

# check whether file or directory, and remove:
sub remove {
  my $path = shift;
  ($test eq 'yes') and report(0, "Test: would remove $path") and return 1;
  if(-d $path) { system("rm -rf \"$path\""); }
  else { system( "rm -f \"$path\""); } # { unlink "\"$path\""; }
  report(0, "Removed $path");
  return 1;
}

sub report {
  my ($level, $msg) = @_;
  ($verbose > $level) and  print "$msg\n";
  return 1;
}


#--eof