#!/usr/bin/perl -w
#
# $Id: filesnap.pl,v 1.2 2003/12/31 07:14:51 mitch Exp $
#
# DESCRIPTION
#
#   filesnap.pl: copy a snapshot of files to a directory for safekeeping
#
#   FileSnap copies one or more files or directories to a specified
#   backup location, changing the fileName(s) by embedding a
#   numerical sequence.  This allows multiple copies of the same
#   files to be saved, and allows recovery of any version.
#
#   See the $USAGE variable for a brief description of usage.
#   Detailed information is available at http://www.fullspan.com.
#
# LICENSE
#
#   OSI Certified Open Source Software (see www.opensource.org for details)
#   Licensed under the BSD license:
#  
#   Copyright (c) 2002-2003, FullSpan Software (www.fullspan.com)
#   All rights reserved
#  
#   Redistribution and use in source and binary forms, with or without
#   modification, are permitted provided that the following conditions are met:
#  
#   - Redistributions of source code must retain the above copyright notice,
#   this list of conditions and the following disclaimer.
#  
#   - Redistributions in binary form must reproduce the above copyright notice,
#   this list of conditions and the following disclaimer in the documentation
#   and/or other materials provided with the distribution. 
#  
#   - Neither the name of FullSpan Software nor the names of its contributors
#   may be used to endorse or promote products derived from this software
#   without specific prior written permission. 
#  
#   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
#   AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#   IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#   ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
#   LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
#   CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
#   SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
#   INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
#   CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
#   ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
#   THE POSSIBILITY OF SUCH DAMAGE.
#

use strict;
use Cwd;
use File::Basename;
use File::Copy;
use File::DosGlob 'glob';
use File::Find;
use File::Spec;
use Getopt::Long;

# Global Constants

my $VERSION = "1.3";

my $USAGE="FileSnap v$VERSION\n" . <<'END_OF_USAGE';
FileSnap is used to keep files safe by saving versions of them
in a separate backup directory.  Each time you save files or
directories, FileSnap uses a unique suffix for the backup files.
This allows you to easily keep multiple versions of files and
see how they changed from version to version.

Usage:

filesnap.pl [options] fileslist

The only required parameters are the destination directory and the
list of files to copy.

filelist is the name of one or more files and/or directories to copy
(wildcards are accepted).

The options are:

-d[estdir] directory
Specifies the directory in which FileSnap will save the files;
generally you should use the same directory each time so that you
can track file changes in that directory.

-m[ove]
To move files instead of copying them

-e[xtensions] extensionList
Give a single extension or a comma-separated list of extensions
to add to FileSnap's built-in compound-extension list: .tar.gz, .tar.Z.

-o[utputlevel] level
Specifies the output level; valid values are: quiet, standard,
verbose, or debug (the default is standard).

-n[ocopy]
Specifies that FileSnap should execute normally except not copy
any files; this is useful for testing and debugging.


Environment:

The environment variable FILESNAP_OPT can be set with the destination
directory or other options just as you would type them on the command
line.  FILESNAP_OPT is processed first, then the command line, so
you can have a typical setting in the environment but then override
it when necessary on the command line.
END_OF_USAGE


my $PROGRAM_NAME = "FileSnap";
my $ENVIRON_VBL_NAME = "FILESNAP_OPT";

my $INDEX_FILE_CONTENTS =
    "This file's name contains the numeric suffix that will be used for\n" .
    "the file(s) copied in the next run of $PROGRAM_NAME.\n";
my $INDEX_FILE_NAME_PREFIX = "_FileSnapIndex-";
my $INDEX_FILE_NAME_SUFFIX = ".txt";
my $INDEX_FILE_NAME_PATTERN =
    $INDEX_FILE_NAME_PREFIX . "*" . $INDEX_FILE_NAME_SUFFIX;
my $INDEX_NUM_FORMAT =  "%04d";  # 4-digit number with leading zeros, e.g., "0001"

my $START_NUMBER = sprintf($INDEX_NUM_FORMAT, 1);  # "0001"
my $FILENAME_MARKER = "_fs";

my $OPT_OUTPUT_QUIET = 10;
my $OPT_OUTPUT_STANDARD = 40;
my $OPT_OUTPUT_VERBOSE = 50;
my $OPT_OUTPUT_DEBUG = 60;

my %OPT_OUTPUT_CHOICES =
    ( "quiet" => $OPT_OUTPUT_QUIET,
      "standard" => $OPT_OUTPUT_STANDARD,
      "verbose" => $OPT_OUTPUT_VERBOSE,
      "debug" => $OPT_OUTPUT_DEBUG);

# Global Variables

my @compoundFileExtensions = (".tar.gz", ".tar.Z");
my $copyDirDest = "";
my $copyDirSrcRoot = "";
my $destDir = "";
my %filesProcessed = ();
my $firstCallThisDircopy = 1;
my $indexNum;
my $optDocopy = 1;
my $optMove = 0;
my $optNocopy = 0;
my $optOutputString = "standard";
my $optOutput = $OPT_OUTPUT_STANDARD;
my $optWait = 0;
my $srcDir = "";
my @srcFiles;


# Forward subroutine declarations

sub copyDirectory;
sub getSetIndexNum;
sub processCommandline;


# ------------ Begin main

my $fromFile;
my $fromFileBase;
my $fromFileDir;
my $fromFileExt;
my $fromFileName;
my $i;
my $numFiles;
my $toFile;
my $toFileBase;
my $toFileExt;


processCommandline();

# Copy files to the destination directory

$numFiles = scalar(@srcFiles);

# The snapshot sequence number is only incremented if there are
# any files to process

if ($numFiles > 0)
{
    getSetIndexNum();
}

# Copy or move each file specified on the command line

for ($i = 0; $i < $numFiles; $i++)
{
    $fromFile = $srcFiles[$i];

    if (! -e $fromFile)
    {
        print "File not found, skipping this file: $fromFile\n"
            if $optOutput > $OPT_OUTPUT_QUIET;
        next;
    }

    # Match only the final '.ext', for example, for a.txt the extension
    # is '.txt', for a.b.txt the extension is '.txt' (not '.b.txt').

    ($fromFileBase, $fromFileDir, $fromFileExt) = fileparse($fromFile, '\.[^.]*');

    $fromFileName = $fromFileBase . $fromFileExt;

    # Check for special case of a compound extension (such as '.tar.gz')

    my $compoundExt;

    foreach $compoundExt (@compoundFileExtensions)
    {
        if ($fromFileName =~ /^(.*)$compoundExt$/)
        {
            $fromFileBase = $1;
            $fromFileExt = $compoundExt;
            last;
        }
    }

    print "fromFile: $fromFile ($fromFileDir : $fromFileBase : $fromFileExt)\n"
        if $optOutput >= $OPT_OUTPUT_DEBUG;

    # It is possible that we need to process two or more files
    # with the same name - this could happen if they were in
    # two different source directories.  We track the files we
    # process, and if we hit a duplicate we bump up the index
    # number to ensure a unique destination file name.
    #
    # If we have already processed a file with this name, then
    # (a) bump up the index number again to avoid overwriting
    # the file we created, and (b) empty the filesProcessed hash
    # because we are starting fresh with a new index number.
    #
    # If we have not processed a file with this name yet, then
    # just add its name to the filesProcessed hash.

    if (exists($filesProcessed{$fromFileName}))
    {
        getSetIndexNum();
        %filesProcessed = ();
    }
    else
    {
        $filesProcessed{$fromFileName} = 1;
    }

    # The toFile name is constructed based on the fromFile name:
    #
    #  1.  File with extension - put index between base and extension
    #      Ex:  myfile.txt --> myfile_fs0001.txt
    #
    #  2.  File name with no dot - just append index
    #      Ex:  myfile --> myfile_fs0002
    #
    #  3.  File with ONLY leading dot - just append index
    #      Ex:  .bashrc --> .bashrc_fs0003
    #
    #  4.  File with ONLY trailing dot - just append index
    #      Ex:  myfile. --> myfile._fs0004

    $toFileBase = $fromFileBase;
    $toFileExt = $fromFileExt;

    if ($toFileBase eq "" && $toFileExt ne "")
    {
        $toFileBase = $toFileExt;
        $toFileExt = "";
    }

    $toFile = $destDir . "/" . $toFileBase . $FILENAME_MARKER .
        $indexNum . $toFileExt;

    print "toFile: $toFile\n"
        if $optOutput >= $OPT_OUTPUT_DEBUG;

    if (-d $fromFile)
    {
        if ($optDocopy && !mkdir($toFile))
        {
            print "Error creating directory, will be skipped: $fromFile: $!\n"
                if $optOutput > $OPT_OUTPUT_QUIET;
            next;
        }

        $srcDir = $fromFile;
        $copyDirDest = $toFile;

        copydir();
    }
    else
    {
        copyOrMoveFile($fromFile, $toFile);
    }
}

# ------------ End main


sub processCommandline
{
    # Process environment variable (if any) by pre-pending it to
    # the command line arguments (if any).  This order of concatenation
    # ensures that command line arguments override any settings
    # in the environment variable.

    print "argv before env: @ARGV\n"
        if $optOutput >= $OPT_OUTPUT_DEBUG;

    if (defined($_ = $ENV{$ENVIRON_VBL_NAME}))
    {
       unshift(@ARGV, split /\s+/);
    }

    print "argv after env: @ARGV\n"
        if $optOutput >= $OPT_OUTPUT_DEBUG;

    my @userCompoundExts = ();

    # Process command line

    GetOptions("destdir=s" => \$destDir,
               "nocopy" => \$optNocopy,
               "move" => \$optMove,
               "output=s" => \$optOutputString,
               "extensions=s" => \@userCompoundExts);

    $optDocopy = ! $optNocopy;

    if (!exists($OPT_OUTPUT_CHOICES{$optOutputString}))
    {
        die "Error: Unrecognized value for output option: $optOutputString.\n\n" .
            "$USAGE\n";
    }

    $optOutput = $OPT_OUTPUT_CHOICES{$optOutputString};

    # Destination dir must have been defined by now

    print "destDir: $destDir\n"
        if $optOutput >= $OPT_OUTPUT_VERBOSE;

    if ($destDir eq "")
    {
       die "Error: You must specify a destination directory.\n\n$USAGE\n";
    }

    # For the user-specified compound exceptions, the user may have
    # given individual arguments and/or a comma-separated list

    @userCompoundExts = split(/,/, join(',', @userCompoundExts));

    # Add the user-specified compound extensions (if any) to the
    # master list

    my $userCompoundExt;

    foreach $userCompoundExt (@userCompoundExts)
    {
        push(@compoundFileExtensions, $userCompoundExt);
    }

    # Make sure at least one file was specified

    if (scalar(@ARGV) < 1)
    {
       die "Error: You must specify at least one file to copy.\n\n$USAGE\n";
    }

    # Handle wildcards (for Win32 or other platforms where the shell
    # does not do filename globbing)

    my $srcFile;

    foreach  $srcFile (@ARGV)
    {
        if ($srcFile =~ /[\?\*]/)
        {
            push(@srcFiles, glob $srcFile);
        }
        else
        {
            $srcFiles[scalar(@srcFiles)] = $srcFile;
        }
    }

    for (my $i = 0; $i < scalar(@srcFiles); $i++)
    {
        # Make relative paths absolute.  This allows us to handle
        # "." and ".." as arguments.

        $srcFiles[$i] = File::Spec->rel2abs($srcFiles[$i]);

        # Convert backslash (Windows) path separators to slashes
        # (otherwise the backslashes are treated as special characters
        # in the regex pattern in copydirHandleFile).
        
        $srcFiles[$i] =~ s|\\|/|g;
    }

    print "Files: @srcFiles\n"
        if $optOutput >= $OPT_OUTPUT_VERBOSE;
}


sub getSetIndexNum
{
    my $indexFileSpec = $destDir . "/" . $INDEX_FILE_NAME_PATTERN;
    my @indexFileList = glob($indexFileSpec);
    my $indexFileName;

    if (scalar(@indexFileList) == 0)
    {
        $indexFileName =
            $destDir .
            '/' .
            $INDEX_FILE_NAME_PREFIX .
            $START_NUMBER .
            $INDEX_FILE_NAME_SUFFIX;

        print "indexFileName: $indexFileName\n"
            if $optOutput >= $OPT_OUTPUT_DEBUG;

        if ($optDocopy)
        {
            open(INDEX_FILE, "> $indexFileName")
                or die "Cannot create index file: $indexFileName: $!";

            print INDEX_FILE $INDEX_FILE_CONTENTS;

            close(INDEX_FILE);
        }
    }
    elsif (scalar(@indexFileList) == 1)
    {
        $indexFileName = $indexFileList[0];
    }
    else
    {
        die "Found multiple index files matching pattern: " .
            $indexFileSpec;
    }

    if (!($indexFileName =~
        /$INDEX_FILE_NAME_PREFIX(\d+)$INDEX_FILE_NAME_SUFFIX$/))
    {
        die "Index fileName not found in expected format: "
            . $indexFileName;
    }

    $indexNum = $1;
    $indexNum = sprintf($INDEX_NUM_FORMAT, $indexNum);

    print "indexNum: $indexNum\n"
        if $optOutput >= $OPT_OUTPUT_DEBUG;

    my $newIndexFileName =
        $destDir .
        '/' .
        $INDEX_FILE_NAME_PREFIX .
        sprintf($INDEX_NUM_FORMAT, ($indexNum + 1)) .
        $INDEX_FILE_NAME_SUFFIX;

    if ($optDocopy)
    {
        rename($indexFileName, $newIndexFileName)
            or die "Cannot rename index file: $indexFileName: $!";
    }
}

sub copydir
{
    print "Copying directory $srcDir to $destDir\n"
        if $optOutput >= $OPT_OUTPUT_VERBOSE;

    $firstCallThisDircopy = 1;

    # The no_chdir option tells find to not cd into each directory
    # that it traverses - this makes the copy logic simpler in this case

    find({ wanted => \&copydirHandleFile, no_chdir => 1 },  $srcDir);
}

sub copydirHandleFile
{
    if ($optOutput >= $OPT_OUTPUT_DEBUG)
    {
        print "\n";
        print "Processing: $File::Find::name\n";
        print "Processing dir: $File::Find::dir, file: $_\n";
    }

    if ($firstCallThisDircopy)
    {
        $copyDirSrcRoot = "$_/";
        $firstCallThisDircopy = 0;
        return;
    }

    $File::Find::name =~ /^$copyDirSrcRoot(.*)$/;
    my $destName = $1;
    my $dest = "$copyDirDest/$destName";

    if (-d $File::Find::name)
    {
        print "Creating directory: $dest\n"
            if $optOutput >= $OPT_OUTPUT_VERBOSE;

        if ($optDocopy && !mkdir($dest))
        {
            print "Error creating directory, will be skipped: $dest: $!\n"
                if $optOutput > $OPT_OUTPUT_QUIET;
        }
    }
    else
    {
        copyOrMoveFile($File::Find::name, $dest);
    }
}


sub copyOrMoveFile
{
    my $srcFileName = shift(@_);
    my $destFileName = shift(@_);

    print "Copying file $srcFileName to $destFileName\n"
            if $optOutput >= $OPT_OUTPUT_DEBUG;

    if ($optDocopy)
    {
        my $retval;

        if ($optMove)
        {
            $retval = move($srcFileName, $destFileName);
        }
        else
        {
            $retval = copy($srcFileName, $destFileName);
        }
         
        if (!$retval)
        {
            print "Error copying file, will be skipped; " .
                "From: $srcFileName; To: $destFileName; Error: $!\n"
                if $optOutput > $OPT_OUTPUT_QUIET;
        }
    }
}