#!/usr/bin/perl

###############################################################################
#                                                                             #
#  Name   : bobber                                                            #
#  Author : Chris Koeritz                                                     #
#  Rights : Copyright (C) 1996-$now by Author                                 #
#                                                                             #
#  Purpose:                                                                   #
#                                                                             #
#    Provides facilities for bobbing up archives.                             #
#                                                                             #
###############################################################################
#  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 2 of the License or (at your option)   #
#  any later version.  See: "http://www.gruntose.com/Info/GNU/GPL.txt" for a  #
#  version of the License.  Please send any updates to "fred@gruntose.com".   #
###############################################################################

require "filename_helper.pl";
require "hostname.pl";
require "importenv.pl";
require "inc_num.pl";

# these files are considered unimportant and will not be included in the bob.
#TODO: it would be cool to get this from the unimportant filename dealy
#TODO: it would be even cooler to synch the two lists.
$junk_file_list = '"*~" "*.$$$" "*.aps" "*.bak" "*.bsc" "*.cgl" "*.csm" "*CVS*" "*.dll" "*.err" "*.exe" "*.EXE" "*.glb" "*.llm" "*.log" "*.lnk" "makefile.fw*" "*.mbt" "*.mrt" "*.ncb" "*.o" "*.obj" "*.obr" "*.opt" "*.pch" "*.plg" "*.r$p" "*.rcs" "*.res" "*.rws" "*.sbr" "*.scc" "*.spx" "*.stackdump" "*.sym" "*.td" "*.tds" "*.tdw" "*.trw" "*.tmp" "*.tr" "*/version.h" "*_version.rc" "*.vspscc" "*.wav" ';

#print "junk list is: $junk_file_list\n";

#hmmm: move this to a script file!
$null_log = "/dev/null";
if ( ("$OS" =~ /[wW][iI][nN]/) || ("$OS" =~ /[Oo][Ss]2/)
    || ("$OS" =~ /[Dd][Oo][Ss]/) ) {
  $null_log = "nul"
}
#print "nul log is $null_log \n";

# returns the current hostname, but without any domain included.
sub short_hostname {
  local($temphost) = &hostname();
#print "hostname so far is $temphost\n";
  $temphost =~ s/([^.]*)\..*/\1/;
#print "hostname now is $temphost\n";
  return &lower($temphost);
}

# returns the name of the bob file to create based on the prefix and the
# current bobbing number.
sub bob_name {
  local($prefix, $number) = @_;
  local($path) = $original_path;
#print "path is $path\n";
  local($bob_file) = $path . '/' . $prefix . "_" . $number . ".zip";
#print "bob_filename is $bob_file.\n";
  return $bob_file;
}

# fixes the directory passed in, if required.  this is only needed for
# dos-like operating systems, where there are drives to worry about and where
# cygnus refuses to store the full path for an absolute pathname in the zip.
# instead of letting it store partial paths, we change to the top of the
# drive and scoop up the files using a relative path.

sub chdir_to_top {
  local($directory) = @_;
######print "dir in as $directory\n";
######  $directory = &re_unix_name($directory);
######print "dir now has $directory\n";

  if ( (substr($directory, 0, 2) eq "//")
      && (substr($directory, 3, 1) eq "/") ) {
#print "into special case\n";
    # it was originally a dos path, so now we must do some directory changing
    # magic to get the paths to work right.
    local($drive) = substr($directory, 0, 4);  # get just drive letter biz.
#print "going to change to $drive\n";
    chdir($drive);
#print "cwd is now " . cwd() . "\n";
    $directory = substr($directory, 4);  # rip off absolutist path.
#print "using dir now as $directory\n";
    if (length($directory) == 0) {
#print "caught zero length dir, patching to dot now.\n";
      $directory = ".";
    }
  }
  return $directory;
}

###old # Note: on dos-like operating systems, bobber depends on the CygWin
###old # functionality for having a set of mounts per each drive letter.  For
###old # example, drive C: needs to have a mount of /cygdrive/c/ for this script
###old # to work properly.  This is only a problem on w9x, wnt, w2k, wxp, etc.

# bobber scoops up some files in a directory.
sub bobber {
  local($prefix, $number, $directory, $logfile, $extra_flags) = @_;

#print "prefix is $prefix, num is $number, directory is $directory, log is $logfile, extra is $extra_flags.\n";

  $directory = &chdir_to_top($directory);

  if ($logfile eq "") {
#print "logfile is null.\n";
    $logfile = $null_log;  # see above for setup.
  }

  local($bob_file) = &bob_name($prefix, $number);
#print "bobber filename is $bob_file.\n";

  local($outcome) = 0xff & system("zip -D -y $extra_flags $bob_file \"$directory\"/* -x $junk_file_list >>$logfile");
  if ($outcome) { die("failure to zip"); }
}

#TODO: it would be nice to abstract common code out of bobber and bob_files

# bob_files is like bobber but expects a file pattern at the end rather than
# a directory name.
sub bob_files {
  local($prefix, $number, $file_pattern, $logfile, $extra_flags) = @_;

#print "prefix is $prefix, num is $number, file_pattern is $file_pattern, log is $logfile, extra is $extra_flags.\n";

  $file_pattern = &chdir_to_top($file_pattern);

#local($test1) = &sanitize_name($file_pattern);
#print "test1 is $test1\n";

####  $file_pattern = &re_unix_name($file_pattern);
#####print "file_pattern after unix is $file_pattern\n";
  local(@files) = &glob_list(("$file_pattern"));

#print "files after glob are @files\n";

  if ($logfile eq "") {
#print "logfile is null.\n";
    $logfile = $null_log;  # see above for setup.
  }

  local($bob_file) = &bob_name($prefix, $number);
#print "bobber filename is $bob_file.\n";

  if ($#files + 1 != 0) {
    local($outcome) = 0xff & system("zip -D -y $extra_flags $bob_file @files -x $junk_file_list >>$logfile");
    if ($outcome) { die("failure to zip"); }
  } else {
    print "No files matching $file_pattern to backup.\n";
  }
}

# backup some specific files.
sub backup_files {
  local($prefix, $number, $log, $locus, @files) = @_;
#print "backup_files: ref=$prefix, num=$number, location is $locus, list of files is @files.\n";
  foreach $i (@files) { &bob_files($prefix, $number, "$locus/$i", $log); }
}

# backup some specific directories.
sub backup_directories {
  local($prefix, $number, $log, $locus, @dirs) = @_;
#print "backup_directories: ref=$prefix, num=$number, location is $locus, list of dirs is @dirs.\n";
  foreach $i (@dirs) { &bobber($prefix, $number, "$locus/$i", $log); }
}

# removes items from the bob that match a pattern.
sub remove_from_backup {
  local($prefix, $number, $log, $locus) = @_;
#print "remove_from_backup: pref=$prefix, num=$number, location is $locus,\n";
  local($bob_file) = &bob_name($prefix, $number);
#print "remove: filename is $bob_file.\n";
  system("zip -d \"$bob_file\" \"$locus\" >$null_log 2>$null_log");
}

# recursively scoops up a directory hierarchy.
sub backup_hierarchy {
  local($prefix, $number, $log, $locus) = @_;
  local(@mod_locus) = &glob_list(("$locus"));
#print "backup_hierarchy: pref=$prefix, num=$number, location is $locus,\n";
#print "mod locus is @mod_locus.\n";
  if ($#mod_locus + 1 == 0) {
    print "Nothing in $locus to backup.\n";
  } else {
    foreach $i (@mod_locus) {
      &bobber($prefix, $number, "$i", $log, "-r");
    }
  }
}

# recursively scoop up a list of directory hierarchies.
sub backup_hierarchies {
  local($prefix, $number, $log, $locus, @dirs) = @_;
#  print "backup_hierarchy: pref=$prefix, num=$number, location is $locus,\n";
#  print "list of dirs is @dirs.\n";
  foreach $i (@dirs) {
#    print "cur dir is $i\n";
    &backup_hierarchy($prefix, $number, $log, "$locus/$i");
  }
}

# gets the number out of the file specified by a basename.  the number file
# is assumed to be stored in the TMP directory and to have an extension of
# ".num".
sub retrieve_number {
  local($number_prefix) = @_;
  # get number from the file specified and increment it for the next use.
  local($NUMBER_FILE) = $TMP."/$number_prefix.num";
#print "file is $NUMBER_FILE.\n";
  local($number) = &get_number($NUMBER_FILE);
#print "number is $number.\n";
  &next_number($NUMBER_FILE);
#print "number is now $number.\n";
  return $number;
}

# takes a name to use as the basename for a number file, and stores the
# file into the bob file specified.
sub backup_number {
  local($number_prefix, $bob_prefix, $number) = @_;
#print "backup_number: parms are: numpref=$number_prefix, bobpref=$bob_prefix, num=$number.\n";
  local($bob_file) = $original_path ."/". $bob_prefix . "_" . $number . ".zip";
  local($number_file) = "$TMP" . "/" . $number_prefix . ".num";
  local($outcome) = 0xff & system("zip -j $bob_file $number_file >$null_log");
  if ($outcome) { die("failure to zip"); }
  local($prefix_file) = "$TMP/prefix.bac";
  open(NUM_PREFIX, ">" . $prefix_file);
  print NUM_PREFIX $number_prefix;
  close(NUM_PREFIX);
  $outcome = 0xff & system("zip -j $bob_file $prefix_file >$null_log");
  if ($outcome) { die("failure to zip"); }
  unlink($prefix_file);
}

# takes a prefix for the number file and a filename where it can be found.
# the current number in the temporary directory is compared against the file,
# and the new number's used if it's greater.
sub restore_number {
  local($number_prefix, $number_file) = @_;
#print "restore num has numpref $number_prefix and numfile $number_file\n";
  local($comparison_file) = "$TMP" . "/" . $number_prefix . ".num";
#print "compare file is $comparison_file\n";
  local($number) = &get_number($number_file);
#print "number found in $number_file is $number\n";
  local($old_number) = &get_number($comparison_file);
#print "old number found in $comparison_file is $old_number\n";
  if ($number > $old_number) {
#print "going to store number!\n";
    &store_number($number, $comparison_file);
  }
}

# ensures that the special restoration program is used on the archives by
# renaming their extension.
sub rename_archive {
  local($filename) = @_;
#print "rename: file is $filename\n";
  local(@pieces) = split(/\.[^.]*$/, $filename, 2);
  local($just_dir_and_base) = $pieces[0];
#print "rename: the dir+base are $just_dir_and_base\n";
  local($new_name) = $just_dir_and_base . '.bob'; 
#print "rename: the new name is $new_name\n";
  rename($filename, $new_name)
      || die("could not rename $filename to $new_name.");
#print "renamed $filename to new name $new_name\n";
}

# undoes a bobbed up archive and pulls out the number.
sub restore_archive {
  local($filename) = &canonicalize(&remove_trailing_slashes(@_));
  local(@split_name) = &split_filename($filename);
  if ($#split_name < 1) {
    print "The name \"$filename\" could not be parsed for restoration.\n";
    exit 1;
  }
  # get the basename of the file.
  local(@pieces) = split(/\.[^.]*$/, @split_name[1], 2);
  # we don't want the extension.
  local($just_dir_and_base) = $split_name[0] . $pieces[0];
#print "restore: the dir+base are $just_dir_and_base\n";
  # now just get the basename without a directory.
  local(@name_components) = split(/\//, $just_dir_and_base);
  local($basename) = $name_components[$#name_components];
#print "basename is $basename.\n";
  local($new_dir_name) = 'bob_' . $basename;
#print "new dir name is $new_dir_name.\n";

  if (!chdir($new_dir_name)) {
    mkdir($new_dir_name, 0777)
        || die("could not create directory $new_dir_name.");
#print "made $new_dir_name.\n";
  }
#print "about to unzip.\n";
  local($outcome) =
      0xff & system("unzip -d $new_dir_name $filename >$null_log");
  if ($outcome) { die("failure to unzip"); }

  local($outcome) =
      0xff & system("perl $SHELLDIR/normal_perm.sh $new_dir_name");
  if ($outcome) { die("failure to normalize permissions"); }

#print "removing links.\n";
  local($outcome) = 0xff & system("find $new_dir_name -type l -exec rm {} ';'");

  # now change to the directory to get at the prefix file.
  chdir($new_dir_name)
      || die("could not change to directory $new_dir_name.");

  # read the name of the prefix file.
  local($prefix_file) = "prefix.bac";
  open(NUM_PREFIX, "<" . $prefix_file);
  local($number_prefix) = <NUM_PREFIX>;
#print "the restored number prefix is $number_prefix.\n";
  close(NUM_PREFIX);

#print "the file containing the number is " . $number_prefix . ".num.\n";
  &restore_number($number_prefix, $number_prefix . ".num");
}

1;