#!perl -w
##***********************************************************************
##      File:       PerlBackup.pl
##      Platforms:  Macintosh 7.1P2, MacPerl 5.1.4r4
##***********************************************************************
=head1 NAME
        PerlBackup - Incremental Backup script in Perl

=head1 AUTHOR
        Ken Tanaka
        
=head1 VERSION:  1.5

=head1 NOTES
        Backup the file system by finding files that are more recent than a
        certain date (such as the last successful backup date and time). 
        Files to be backed up are copied to a new location (specified by the
        user) with the directory structure kept intact.  (Copies of folders
        are created as necessary to mimic the layout of the part of the
        filesystem to be backed up.)
        
        This script implements an incremental backup approach; meaning that
        the intent is to back up just the documents and files that have
        changed since the last time the script was run.  (A different time
        can be specified in place of the last successful run date/time.) 
        Programs can be restored from their original media, and there are
        other methods of making full copies of the hard disk contents, but I
        wanted an easy and free method of performing an incremental backup.
        By writing my own script in perl I could automate the process of
        finding all files changed in the last few weeks and protect them
        with a backup that typically fits on one or two floppy disks.  Being
        written in perl, this script can also be customized by those
        familiar with Perl.

        Various steps to be customized to your setup are marked below with
        double angle brackets, like <<1>>.

        A directory containing folder aliases that need backing up is
        supplied as a Starting Directory (see marker <<1>> below).  In this
        way, only branches of the file system that you want backed up are
        scanned.

        Because there are often files that have changed that you know in
        advance you do not want to bother backing up, there are ways of
        specifying filename patterns and directories to be ignored.  One
        example of files to ignore are the numerous cache files stored up by
        web browsers.

        I keep the original directory structure, since that's how I like the
        files organized.  The resulting clone folder, containing just the
        files changed since the comparison date, is suitable for dropping on
        a floppy or, if too large, compressing and splitting (with a utility
        such as StuffIt).  The destination can be some type of removable
        media if large enough. The hierarchy of folders regenerates if
        needed, so you can delete unwanted files and folders while script is
        running without disrupting the backup.  (I use spare space on the hard disk
        for speed.)

        Aliases are ignored, except for the first level of the starting
        directory.  So you can place aliases of the folders to be backed up
        in a "Folders to backup" folder.

        Here is a partial directory structure on my machine:
        
                Macintosh HD
                        |-- Applications
                        |               |-- MacPerl É
                        |               |-- PerlBackup
                        |                               |-- dir1                                        (top of test folders)
                        |                               |               |-- file1                       (files and folders of 
                        |                               |               |-- file2                        various dates)
                        |                               |               |-- dir2
                        |                               |-- Folders to Backup
                        |                               |               |-- Applications        (alias)
                        |                               |               |-- Documents           (alias)
                        |                               |               |-- NewStuff            (alias)
                        |                               |               |-- System Folder       (alias)
                        |                               |-- PerlBackup 1.5.pl
                        |                               |-- Test Folders to Backup
                        |                                               |-- dir1                        (alias)
                        |-- Documents
                        |-- NewStuff
                        |-- System Folder
                        
        After running PerlBackup there is an additional folder at the
        'Macintosh HD' level called 'Backup': 
                
                Macintosh HD
                        |-- Applications
                        |-- Documents
                        |-- NewStuff
                        |-- System Folder
                        |-- Backup                              (new folder with backed up files)
                                        |-- Applications
                                        |-- Documents
                                        |-- NewStuff
                                        |-- System Folder

                        
        Improvements:  There are probably some improvements that can be made
        to this script to improve efficiency or fix potential problems. One
        thing that comes to mind:  when this script creates new folders and
        copies files, I don't yet know how to force appearance of changes in
        Finder (I know it can be done).  I should probably track free space
        on the destination disk and pause and post an alert if I run out.
        
        This is a preliminary script that mostly does what I want, but
        feedback is desired to improve the script--send to: tanaka9@idt.net

=head1  VERSION HISTORY
        1.0     Initial working version.
        1.1     Added print of previous backup date/time when finished to
                facilitate labeling of backup media.  Also changed Starting
                folder to:
                Macintosh HD:Applications:PerlBackup:Folders to Backup
        1.2     Added internal subroutine myDateStr.
        1.3     (1997 Dec 13) Changed prompt for comparison date a little, made 
                start time the same as $nowDateStr instead of script start time
                ($BASETIME).
        1.4     (1998 Jan 9) Finds preferences folder with Mac::Files FindFolder.
                Added $Testing option.
        1.5     (1998 Jan 17) More comments to make for better usage by others.

=cut
##********************************************************************
***
use English;
use File::Basename;
use File::Copy;
use File::Path;
use Mac::Files;
use Time::Local;

$Debugging = 0;
$Testing = 0;

##      <<1>> Comparision Time
##      Usually the starting time of the successful last backup.  Files changed
##      after this time will be backed up.  This is a default to fall back on
##      when the date file can't be found (see step <<5>>).  Under normal circumstances
##      this date is rarely used--It could be your birthday, unless you want to backup
##      files older than you are.
##
##      year = Year in four digit format
##      mon  = Month in 1-12 format
##      mday = Day of month,
##      hour = 0-23 format
##      min  = 0-59 format
##      sec  = 0-59 format
##-----------------------
($year, $mon, $mday,   $hour, $min, $sec) = (1997, 3, 28,   1, 2, 3);
$mon--; ## Convert month number to index.
$Default_time = timelocal($sec,$min,$hour,$mday,$mon,$year);

##      <<2>> Starting Directory (Folder)
##      This is a folder containing aliases to directories to be backed up.
##      The backup directory will have an appearance similar to this one
##      after running this script.
##-----------------------
@directories = ('Macintosh HD:Applications:PerlBackup:Folders to 
Backup');

@directories = ('Macintosh HD:Applications:PerlBackup:Test Folders to 
Backup') if $Testing;

##      <<3>> Destination Directory (Folder)
##      This is where a backup file structure will be cloned.
##-----------------------
$Dest_dir_root = 'Macintosh HD:Backup';

##      <<4>> Exclude Directories
##      These are directories to explicitly ignore when scanning for files 
to backup.
##-----------------------
%Exclude_dirs = (
        $Dest_dir_root => 1,
        'Macintosh HD:Applications:PerlBackup:Folders to Backup:System Folder:At Ease Items'   => 1,
        'Macintosh HD:Applications:PerlBackup:Folders to Backup:System Folder:Preferences:Explorer:Explorer Cache'     => 1,
);

##      <<5>> Date File (Preferences file)
##      This file stores the time of the last successful PerlBack run.
##-----------------------
$prefDir = FindFolder(kOnSystemDisk(), kPreferencesFolderType());
$DateFile = $prefDir . ':' . 'PerlBack Last Run';

$DateFile = $prefDir . ':' . 'PerlBack Last Run Test' if $Testing;

##      <<6>> Set up the filename filter.  Files matching this pattern will be
##      ignored.
##-----------------------
$Filter = '/cache/i';


##-------------------------------------------------------------------------
##      Setup some internal constants.
##-------------------------------------------------------------------------
##      Directory Seperator
$dirSep = ':';
@MonthNames = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );


##-------------------------------------------------------------------------
##      Print startup line.  (Marks where this run started and delineates the
##      of the compiler warnings.)
##-------------------------------------------------------------------------
print "\n", '+'x15, ' New Run:  PerlBackup.pl ', '+'x15, "\n";

print   "Starting directories =",
        join("\n                      ", @directories), "\n";
print "Destination directory=$Dest_dir_root\n";

print "Filter (file pattern to be ignored)=$Filter\n" if $Debugging;


##-------------------------------------------------------------------------
##      Try to get last successful run time from $DateFile.
##-------------------------------------------------------------------------
$prefDir = dirname($DateFile);
if (! -e $prefDir) {
        warn "Couldn't find preferences directory: $prefDir";
}

if (! -d $prefDir) {
        warn "Preferences directory is not a directory: $prefDir\n"
}

if (-e $DateFile) {
        open(DF, $DateFile) or die "Couldn't open $DateFile";
        $LastRunTime = <DF>;
        close(DF);
        print "    LastRunTime=$LastRunTime\n" if $Debugging;
        $LastRunStr = &myDateStr($LastRunTime);
        $Last_Backup_Msg = "Date from preferences file ($DateFile)\n"
                        . "is $LastRunStr\n";
        ##      Use this as the new comparison time.
        $Default_time = $LastRunTime;
} else {
        print "non-existent DateFile=$DateFile\n" if $Debugging;
        $Last_Backup_Msg = "Did NOT find preferences file ($DateFile).\n";
        ##      Let comparison time set above in step <<1>> stand as is.
}

##-------------------------------------------------------------------------
##      Notify user of comparison date with a dialog box.
##-------------------------------------------------------------------------
do {
        $nowDateStr = myDateStr(time);
        $compDateStr = myDateStr($Default_time);
        $ans = MacPerl::Answer("Current Date:  $nowDateStr\n"
                        . 'Press "OK" to backup files modified after:' . "\n  $compDateStr\n"
                        . 'or press "Modify" to enter a different time',        'OK', 'Modify', 'Quit');
        die 'Quit at time dialog' if $ans == 0;

        if ($ans == 1) {
                ##      User selected 'Modify' (1)
                $Comp_time_ready = 0;
                ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($Default_time);
                $year += 1900;
                $newDateStr = MacPerl::Ask("Enter comparison date: Year Mon Day      hour min sec\n"
                                .       '(Files modified after this date will be backed up)',
                                join(' ', $year, ($mon+1), $mday, ('    ' . $hour), $min, $sec));
                if (defined $newDateStr) {
                        ($year, $mon, $mday, $hour, $min, $sec) = split ' ', $newDateStr;
                        $mon--;
                        $Default_time = timelocal($sec,$min,$hour,$mday,$mon,$year);
                }
        } else {
                ##      User must have selected 'OK' (2)
                $Comp_time_ready = 1;
        }
} until $Comp_time_ready;

$startDateStr = $nowDateStr;

$Comp_time = $Default_time;
print "    Comp_time=$Comp_time\n" if $Debugging;
$compDateStr = myDateStr($Comp_time);
print "    Comparison date=$compDateStr\n";

##-------------------------------------------------------------------------
##      Check for pre-existing destination folder.
##-------------------------------------------------------------------------
if (-e $Dest_dir_root) {
        if (! -d _) {
                $message2 = q"and it's not a directory!";
        } else {
                $message2 = '';
        }
        $ans = MacPerl::Answer("Warning: Destination directory\n"
                        . "($Dest_dir_root)\nalready exists $message2", 'Quit', 'Continue');
        die "Quit because of pre-existing ($Dest_dir_root)" if $ans == 1; 
}

##-------------------------------------------------------------------------
##      Build the file filter test.  Passed items are added to the
##      selected list, $slist.  Building up the filter in advance like this
##      speeds up the execution since Perl does not need to recompile the
##      pattern every time the filter is used.
##-------------------------------------------------------------------------
$Filt = <<EOF;
        if ((-f "\$fullPath") and (\$item !~ $Filter)) {
                        push(\@slist, "\$fullPath");
        }
EOF

$copysize_kb = 0;
##-------------------------------------------------------------------------
##      Scan files in each directory, one directory at a time.
##-------------------------------------------------------------------------
print "Scanning in Directory:\n";
foreach $dir (@directories) {
        if (-e $dir) {
                if (-r _) {
                        if (-d _) {
                                ## Links are allowed here since it's the starting point.
                                $links_OK = 1;
                                $Source_dir_root = $dir;
                                &scandir($dir, $links_OK);
                        } else {
                                warn "WARNING: not a directory: $dir";
                        }
                } else {
                        warn "WARNING: not permitted to read $dir";
                }
        } else {
                warn "WARNING: non-existent directory $dir";
        }
}

print "Total copy size is $copysize_kb\n";

$nowDateStr = myDateStr(time);

print "$Last_Backup_Msg";
print "Backed up files modified since: $compDateStr\n";
print "Start time:  $startDateStr\n";
print "Finish time: $nowDateStr\n";

##      Update last successful run time.
open(DF, ">$DateFile") or die "Couldn't open for writing: $DateFile";
print DF "$BASETIME\n";
close(DF);
print "Updated DateFile: [$DateFile]\n" if $Debugging;

print <<'ENDTEXT';
____    __   _  _  ___
 |  \  /  \  |\ |  |_
_|__/  \__/  | \|  |__/
ENDTEXT


##********************************************************************
***
##      myDateStr subroutine
##
##      Return a string in a standard format like:
##      1997 Dec 4, 13:27 (+12 sec)
##      Call with seconds since the epoch:
##      myDateStr(time);
##********************************************************************
***
sub myDateStr {
        my($intime) = @_;
        
        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($intime);
        $year += 1900;  ##      localtime returns years since 1900.
        return sprintf("$year $MonthNames[$mon] $mday, $hour:%02d (+$sec sec)",
                        $min);
}
##      end of scandir()


##********************************************************************
***
##      scandir subroutine
##
##      Scan strings in code files in a directory.
##********************************************************************
***
sub scandir {
        my($dir, $links_OK) = @_;
        my($item);
        my(@list);
        my($lowerLinks);
        my(@slist);

        if (defined $Exclude_dirs{$dir}) {
                print "---ignoring directory $dir\n";
                return;
        }

        print "$dir\n";

        ##-----------------------------------------------------------------------
        ##      Initialize the search list.
        ##-----------------------------------------------------------------------
        @slist = ();

        ##-----------------------------------------------------------------------
        ##      Build up the search list of files in the current directory.
        ##-----------------------------------------------------------------------
        opendir(DIR, "$dir") or die "Can't open dir $dir";
        @list = readdir(DIR);
        closedir(DIR);
        print "list=@list (last index=$#list)\n" if $Debugging;
        foreach $item (@list) {
                print "  item=$item\n" if $Debugging;
                $fullPath = "$dir$dirSep$item";
                if (-e $fullPath) {
                        if ($Debugging) {
                                $isReadable = (-r $fullPath) ? 'YES' : 'no';
                                $isaFile    = (-f $fullPath) ? 'YES' : 'no';
                                $isaDir     = (-d $fullPath) ? 'YES' : 'no';
                                $isaLink    = (-l $fullPath) ? 'YES' : 'no';
                                print "    readable=$isReadable  file=$isaFile  dir=$isaDir  link=$isaLink\n";
                        }
                } else {
                        warn "WARNING:  non-existent file: $fullPath";
                }
                eval $Filt;
                die $EVAL_ERROR if $EVAL_ERROR;
        }

        print "search list=@slist (last index=$#slist)\n" if $Debugging;

        foreach $file (@slist) {
                if (! -l $file) {
                        if ($Debugging) {
                                $fileAge = -M $file;
                                print "  $file is $fileAge days old\n";
                        }
                        ($size, $mtime) = (stat($file))[7,9];
                        if ($Debugging) {
                                print "    size=$size KB, mtime=$mtime\n";
                                $mtime_str = myDateStr($mtime);
                                print "    localtime(mtime)=$mtime_str\n";
                        }
                        if ($mtime >= $Comp_time) {
                                print "    This file needs backing up!\n" if $Debugging;
                                ##      Generate a destination path from the source path.
                                ($destPath = $file) =~ s/^$Source_dir_root/$Dest_dir_root/;
                                $destDir = dirname($destPath);
                                if ($Debugging) {
                                        print "    >>>> copy **[ $file ]**\n";
                                        print "    >>>>   to **[ $destPath ]**\n";
                                        print "    dirpart=$destDir\n";
                                }
                                mkpath($destDir, $Debugging);
                                copy($file, $destPath);
                                $copysize_kb += $size;
                        }
                }
        }

        ##-----------------------------------------------------------------------
        ##      Call scandir recursively for any directories in the current directory.
        ##-----------------------------------------------------------------------
        foreach $item (@list) {
                $fullPath = "$dir$dirSep$item";
                if ((-d $fullPath) and ($item !~ /^(\.|\.\.)$/)) {
                        if ((! $links_OK) and (-l $fullPath)) {
                                print "--- ignoring link directory $fullPath\n" if $Debugging;
                        } else {
                                ##      For recursive calls, links are not allowed.
                                $lowerLinks = 0;
                                &scandir($fullPath, $lowerLinks);
                        }
                }
        }
}
##      end of scandir()