#!/usr/bin/perl
#
# Script to backup dot- and other files
#
# Copyright (C) 2009, Sven-Thorsten Fahrbach
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses>.

use strict;
use warnings;
use File::Path;
use File::Basename;
use File::Spec;
use File::Copy;
use Cwd;
use Getopt::Long;
use Fcntl qw/ :DEFAULT :flock /;

my $VERSION = "0.9";

##############################################################
# VARIABLE DECLARATIONS AND THE LIKE
##############################################################

# get a timestamp in the format YYYYMMDDHMS
my ($year, $month, $dayofmonth, $hour, $minute, $second)
        = (localtime())[5, 4, 3, 2, 1, 0];
$year += 1900;
$month++;
my $timestamp = "$year$month$dayofmonth-$hour$minute$second";

# standard values for config file/command line options
my $dotbackup_home      = get_dotbackup_home();
my $working_dir         = $ENV{HOME};
my $filename            = "dotbackup$timestamp";
my $destination_dir     = getcwd;
my $path_to_conf_file   = get_path_to_conf_file();
my $path_to_log_file    = File::Spec->catfile($dotbackup_home, "log");
my $path_to_file_list   = File::Spec->catfile($dotbackup_home, "files");
my $compression_level   = 1;
my $gzip_options        = '';
my $tar_options         = '';
my $show_help           = '';
my $show_version        = '';

# this is the array with the files that are to be backed up
my @backup_files        = get_files();

# $log_level can be:
#   0 - quiet mode, no logging
#   1 - errors
#   2 - warnings
#   3 - info
#   4 - debug
my $log_level           = 4;

# Get values from the configuration file. Default values will be overwritten
# with values from the config.
parse_config($path_to_conf_file) if $path_to_conf_file;

# Get command line options. These will overwrite default options and values
# we got from the configuration file.
my $result = GetOptions("working-dir=s"         => \$working_dir,
                        "filename=s"            => \$filename,
                        "destination-dir=s"     => \$destination_dir,
                        "logfile=s"             => \$path_to_log_file,
                        "file-list=s"           => \$path_to_file_list,
                        "log-level=i"           => \$log_level,
                        "compression-level=i"   => \$compression_level,
                        "gzip-options=s"        => \$gzip_options,
                        "tar-options=s"         => \$tar_options,
                        "help"                  => \$show_help,
                        "version"               => \$show_version);

help_and_exit()    if $show_help;
version_and_exit() if $show_version;

$compression_level = 1 if $compression_level < 1;
$compression_level = 9 if $compression_level > 9;

# commands that have to be invoked by us
my $tar                 = "tar -cf ";
my $gzip                = "gzip -$compression_level ";

####################################################################
# MAIN
####################################################################

# declare LOG file handle
my $LOG;
sysopen ($LOG, $path_to_log_file, O_WRONLY | O_APPEND | O_CREAT)
    or die "Can't open $path_to_log_file: $!";
# We'll try and keep a lock on the log file for the duration of our script
flock($LOG, LOCK_EX)        or die "Can't get a lock on $path_to_log_file";

logger("invoked script", 3);
logger("compression level is $compression_level", 3);
# try to append leftover command line arguments to our @backup_files
foreach (@ARGV) {
    my $cur_file;
    unless (File::Spec->file_name_is_absolute($_)) {
        $cur_file = File::Spec->catfile($working_dir, $_);
    }
    next unless -e $cur_file;
    push @backup_files, File::Spec->canonpath($cur_file);
}
if (@backup_files == 0) {
    print "Nothing to do\n";
    logger("file stack empty - nothing to do", 3);
    exit(0);
}

# build tar-string
$tar .= "$tar_options " if $tar_options;
my $absolute_filename = File::Spec->catfile($destination_dir, $filename . ".tar");
$tar .= "$absolute_filename ";
foreach (@backup_files) {
    # Remove trailing slash or else tar will archive to contents of the
    # directory instead of the directory itself which is probably not what
    # we want.
    s/\/$//;
    $tar .= "$_ ";
}
logger("Archiving " . scalar(@backup_files) . " entries", 3);
logger("tar string: $tar", 4);

# invoke tar
my $tar_result;
$tar_result = `$tar`;
if ($!) {
    logger("tar error: $!", 1);
    logger("exited abnormally", 1);
    die "tar exited abnormally: $!";
}
logger("tar exited successfully", 4);
logger("tar output: $tar_result", 4);

# invoke gzip
$gzip .= "$gzip_options " if $gzip_options;
$gzip .= $absolute_filename;
my $gzip_result;
$gzip_result = `$gzip`;
if ($!) {
    logger("gzip error: $!", 1);
    logger("gzip exited abnormally", 1);
    die "gzip exited abnormally: $!";
}
logger("gzip exited successfully", 4);
logger("gzip output: $gzip_result", 4);

logger("script exiting successfully", 3);

# release lock on log file, close FH and exit successfully
flock($LOG, LOCK_UN);
close($LOG);
exit(0);

###############################################################
# SUBROUTINES
###############################################################

sub parse_config {
    my $conf_filename = shift;
    unless (open(CONF, $conf_filename)) {
        warn "Could not open config $conf_filename";
        return;
    }
    
    while (<CONF>) {
        chomp;
        next if /^\s*$/;        # ignore blank lines
        next if /^\s*#/;        # ignore lines consisting of comments only
        
        if (/^working-dir\w*=\w*(.+)$/) {
            unless (-d $1) {
                warn "in $conf_filename line $.: Directory does not exist";
                next;
            }
            $working_dir = $1;
            next;
        }
        if (/^destination-dir\s*=\s*(.+)$/) {
            unless (-d $1) {
                warn "in $conf_filename line $.: Directory does not exist";
                next;
            }
            $destination_dir = $1;
            next;
        }
        if (/^log-file\s*=\s*(.+)$/) {
            if (-d $1) {
                warn "in $conf_filename line $.: $1 is a directory";
                next;
            }
            unless (-e $1) {
                unless (open(LOG, ">", $1)) {
                    warn "in $conf_filename line $.: Cannot open $1 for writing: $!";
                    next;
                }
                print LOG "[" . scalar(localtime()) . "] Created logfile\n";
            }
            close(LOG);
            $path_to_log_file = $1;
            next;
        }
        if (/^file-list\s*=\s*(.+)$/) {
            if (-d $1) {
                warn "in $conf_filename line $.: $1 is a directory";
                next;
            }
            unless (-e $1) {
                warn "in $conf_filename line $.: $1 does not exist";
                next;
            }
            $path_to_file_list = $1;
            next;
        }
        if (/^tar-options\s*=\s*(.*)$/) {
            $tar_options = $1;
        }
        if (/^gzip-options\s*=\s*(.*)$/) {
            $gzip_options = $1;
        }

        if (/^compression-level\s*=\s*(\d)$/) {
            $compression_level = $1;
        }
        if (/^filename\s*=\s*(.+)$/) {
            $filename = "$1$timestamp";
            next;
        }
    }
}

sub get_files {
    unless (open(FILES, $path_to_file_list)) {
        warn "Cannot open $path_to_file_list: $!";
        return
    }
    my @filelist;
    while (<FILES>) {
        chomp;
        next if /^\s*$/;         # ignore blank lines
        next if /^\s*#/;         # ignore lines containing only comments

        my $cur_file;        
        unless (File::Spec->file_name_is_absolute($_)) {
            $cur_file = File::Spec->catfile($working_dir, $_);
        }
        next unless -e $cur_file;
        push @filelist, File::Spec->canonpath($cur_file);
    }
    close(FILES);
    return @filelist;
}

sub logger {
    my ($message, $level) = @_;
    return if $level > $log_level;
    
    # name log levels
    my @level_names = qw( NONE ERROR WARNING INFO DEBUG );
    
    # autoflush output for current scope only
    local $| = 1;
    
    # DEBUG
    #print "\@level_names:\n";
    #print "\t$_\n" foreach @level_names;
    #print "\$level: $level\n";
    #print "\$message: $message\n";
    
    print $LOG "[" . scalar(localtime()) . "] " . $level_names[$level] . ": $message\n";
}

sub get_dotbackup_home {
    my $dotbackup_home_path = File::Spec->catdir($ENV{HOME}, ".dotbackup");
    unless (-d $dotbackup_home_path) {
        mkpath($dotbackup_home_path) or die "Could not create dir $dotbackup_home_path: $!";
    }
    
    return $dotbackup_home_path;
}

sub get_path_to_conf_file {
    my $conf_file_path = File::Spec->catfile($dotbackup_home, "conf");
    #GetOptions("config=s"   => \$path);
    #return if $path == undef;
 
    unless (-e $conf_file_path) {
        # warn "File $conf_file_path does not exist.\n";
        return;
    }
    if (-d $conf_file_path) {
        warn "$conf_file_path is a directory.\n";
        return;
    }
    return File::Spec->canonpath($conf_file_path);
}

sub help_and_exit {
    print <<EOHELP;
Usage: $0 [OPTION]... [FILE]...
Make a backup from a list of files. Save backup tarball to a specified path
(the current directory by default).
  -c, --compression-level   1-9, 1 is fastest, 9 is best
  -d, --destination-dir     path to the output directory, default is \$HOME
      --filename            filename of the generated tarball (without the
                            suffix)
      --file-list           path to the list of files to be backed up
  -g, --gzip-options        additionals options to pass to gzip
  -h, --help                give this help
      --log-level           0-4, 0 is quiet, 4 is the most verbose
      --logfile             path to the log file
  -t, --tar-options         additional options to pass to tar
  -v, --version             display version and exit
  -w, --working-dir         path to the default directory where the file to be
                            backed up are located, default is \$HOME
                            
Report bugs to <joran\@alice-dsl.de>.
EOHELP
    
    exit(0);
}

sub version_and_exit {
    print <<EOVERSION;
$0 $VERSION
Copyright (C) 2009 Sven-Thorsten Fahrbach
This is free software. You may redistribute copies of it under the terms of
the GNU General Public License <http://www.gnu.org/licenses/gpl.html>.
There is NO WARRANTY, to the extent permitted by law.

Written by Sven-Thorsten Fahrbach.
EOVERSION
    
    exit(0);
}