#!/usr/bin/perl -w
#
# 2002 Copyright (c) Markus Drechsler, Bavaria, Germany
#
# 2002-01-03 Author: Markus Drechsler
#
# Minor revisions:
#     2002-04-12: v1.0.5 - bugfixes parsing trailing comments in resourcefile
#                          of default list, if it exists
#     2002-01-14: v1.0.4 - scan filelist from resourcefile instead 
#                          of default list, if it exists
#     2002-01-03: v1.0.3 - bugfixes, extensions, some tests
#     2002-01-03: v1.0.2 - bugfixes, extensions, temporary release
#     2001-09-28: v1.0.1 - created, first try
#
# A script to archive files in tgz format with current date
#
#     Inside there's a list of files to archive and where.
#     Each of all files <filename> will be archived with
#     the name <filename>.<current-date>.tgz within the
#     specified folder. After that the original files
#     <filename> will be truncated to zero, so logs
#     work well. Renaming and creating of new files
#     with zero length would not always work !
#     
#     You were asked to confirm each operation. If the
#     archive already exists, you can use option -f to
#     force generating and overwriting the old file.
#
# You can distribute or modify the way you like, but please
# don't remove the copyright notice - thanks !
#
#*******************************************************************

# TO DO:
#    probably file and target dir as arguments
#
use strict; # forces getopts with $Getopt::Std::opt_h instead of $opt_h :-(
use Getopt::Std;
use File::Basename;

my $VER    = $File::Basename::VERSION; # Tribute to perl -w
my $TAR    = "/bin/tar";               # Tar Exe-File
my $DIR    = "/var/log";               # Backup-Dir

# To archive:  what                   where             ignore
my           ($file,                 $dest,            $rest);
my %FILES  = (
              "/var/log/messages" => "$DIR",
              "/var/log/firewall" => "$DIR",
              "/var/log/mail"     => "$DIR",
              "/var/log/warn"     => "$DIR",
	     );

my $resfile = "." . "mdback" . "rc";
#my $resfile = "." . basename($0) . "rc";
#$resfile =~ y/A-Z/a-z/; quatsch
#print $resfile, ":\n";
my $line;

# predefined hash
#print "Hash:\n";
#foreach $file (keys %FILES) {
#    print $file, "\t\t:", $FILES{$file}, "\n";
#}

unless (-f $resfile) {
    print "\nskipped: source file $resfile does not exist !\n";
}

if (open (FILE, $resfile)) {
  # ok, file exists, so remove defaults from hash
  foreach $file (keys %FILES) {
      delete $FILES{$file};
  }
  #print "Test deleted Hash:\n";
  #foreach $file (keys %FILES) {
  #    print $file, "\t\t:", $FILES{$file}, "\n";
  #}
  while (defined ($line = <FILE>)) {
      chop $line;
      $line =~ s/^\s+//;       # kill leading spaces
      $line =~ s/#(.*)//;      # kill end comments
      next if $line eq "";     # is anything out there ?
                               # currently no check for pairs !
      ($file, $dest, $rest) = split(/\s+/, $line, 3);
      #print $file, "\t\t:", $dest, "\n";
      #print $line, "\n";
      $FILES{$file} = $dest;   # add hash
  }
  #print "Used Hash:\n";
  #foreach $file (keys %FILES) {
  #    print $file, "\t\t:", $FILES{$file}, "\n";
  #}
}
else {
    print "\nskipped: can't open source file $resfile !\n";
}

getopts('fh') or die usage();
if ((defined ($Getopt::Std::opt_h))) {
  usage($Getopt::Std::opt_h);
  exit;
}
#if (!(defined ($Getopt::Std::opt_f))) {
#if (!(defined ($opt_f))) {
#print "exit !\n";
#exit;
#}

# get timestamp once
my ($y, $m, $d) = (localtime(time))[5,4,3];
my  $date = sprintf "%d%02d%02d", 1900+$y, $m+1, $d;

if (inder_agdif()) {
  # do something in the future
  # e.g. no screen messages
}

foreach $file (keys %FILES) {
  $dest = $FILES{$file};   # add hash
  #print $file, "\t", $dest, "\t", $date , "\n";
  pack_it($file, $dest, $date);
}

# Subroutines ###############################################################

sub pack_it {
  my $me = $_[0]; # what
  my $to = $_[1]; # whereto
  my $ex = $_[2]; # extension

  #(my $base = $me) =~ s!^.*/!!;
  my $dir = dirname($me);
  my $base = basename($me);
  my $msg = "";
  
  print "archiving $me in $to/$base.$ex.tgz";
  
  # consistency checks
  unless (-f $me) {
    print "\nskipped: source file $me does not exist !\n";
    return;
  }
  unless (-d $to) {
    print "\nskipped: target directory $to does not exist !\n";
    return;
  } 
  my $target = "$to/$base.$ex.tgz";
  if (-f $target) {
    unless ($Getopt::Std::opt_f) {
      print "\nskipped: target file $target does exist !\n";
      return;
    }
    $Getopt::Std::opt_f = 1; # parser, be quiet !
    $msg = " forced";
  } 
  # ggf. testen, ob $me groesser 0 !?

  if (&ask_me($msg)) {
    # flush my output to see the message before the output of tar
    $| = 1; # ;-)
    if (-f $target) {
      print "overwrite: ";
    }
    # block others (does this really help ?)
    if( open(DATEI, "$me")) {
      # change to dir and then tgz file with timestamp
      if (system($TAR, "-zcv", "-C", "$dir", "-f", "$target", "$base")) {
        close(DATEI);
        die "$TAR failed ($!)";
      } 
      # strip content from original file
      truncate("$me", 0);
      close(DATEI);
    }
    else {
      print "not found ($!)\n";
    }
  }
  else {
    print "ignored\n";
  }
}
print "ready !\n";

sub ask_me {
  my $prompt = $_[0];
  print STDOUT $prompt, " y/[n] ? ";
  
  my $answer = scalar(<STDIN>);
  $answer =~ /^y/i;
}

sub inder_agdif {
  return -t STDIN && -t STDOUT;
}

sub usage {
print <<DEATH;
usage: $0 [-f]
 -f  : force overwriting existing files
 -h  : this help screen
hint : parse .$0rc instead of default list
       if it exists 
DEATH
}