#!/usr/bin/perl -w
########################################################################
# Copyright 2004 by Malcolm Nooning
# This program does not impose any
# licensing restrictions on files generated by their execution, in
# accordance with the 8th article of the Artistic License:
#
#    "Aggregation of this Package with a commercial distribution is
#    always permitted provided that the use of this Package is embedded;
#    that is, when no overt attempt is made to make this Package's
#    interfaces visible to the end user of the commercial distribution.
#    Such use shall not be construed as a distribution of this Package."
#
# Therefore, you are absolutely free to place any license on the resulting
# executable(s), as long as the packed 3rd-party libraries are also available
# under the Artistic License.
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# See L<http://www.perl.com/perl/misc/Artistic.html>
#
#
#
########################################################################
our $VERSION = 0.06;


########################################################################
# Usage:
# $error = 
#        prior_to_test($test_number, 
#                      $startdir, 
#                      $os, 
#                      \$test_sub_dir_to_use_this_test,
#                      $verbose,
#                      \$message);
#
# $error will be one of POSIX (EXIT_SUCCESS EXIT_FAILURE)
# 
########################################################################
# Outline
# -------
# . chdir to the base directory.
# . Decide which of three possible sub dirs to wipe out,
#   which will be tempn where the 'n' is test number mod 3.
# . Wipe out the temp dir and all it's files and sub dirs
# . Recreate the temp dir and four further sub dirs.
# . Assign the temp dir name (the one used by the caller) 
#   to be passed back up.
# 
########################################################################
# 
# There are three temp directories used so that we can inspect prior
# test results if there is a crash, as well as the current test 
# results.  The rationale is that it may be helpful to know what
# we were doing prior to the present test.  There should never be 
# a relationship, but, ...
# 
########################################################################

package prior_to_test;


use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("prior_to_test");

use POSIX qw(EXIT_SUCCESS EXIT_FAILURE);
use File::Path;
use File::Find;
use Cwd qw(cwd);

use strict;

##############################################################
# The find command does not seem to like globals.  Hence
# the need for these two globals.
my @global_files = ();
my @global_dirs = ();

##############################################################
# This sub is used in conjunction with the perl "find" module.
sub push_to_file_or_dir_array {

  my $file_or_dir = $File::Find::name;

  return if ($file_or_dir =~ /^\.+$/);

  if (-d($file_or_dir)) {
    if ($file_or_dir =~ m/\w+/) {
      push (@global_dirs, ($file_or_dir));
    }
  } else {
    push (@global_files, ($file_or_dir));
  }
}

########################################################################
sub remove_windows_tree {
  my ($test_sub_dir, $message_ref) = @_;
  my $file;
  my $dir;
  my $MAX_FILES_TO_DELETE = 100;
  my $actual_num_files = 0;
  my $cwd = cwd;

  $$message_ref = "";
  # There should never be more than just files, or at most
  # files and subdirectories that contain no further 
  # subdirectories.  Thus we can use the find command without
  # using up too much ram.

  @global_files = ();
  @global_dirs = ();

  find(\&push_to_file_or_dir_array, ($test_sub_dir));

  #....................................................................
  # Before we start deleting files, make sure there are less than, oh,
  # some small number.  There is not supposed to be many files or
  # directories.  We can up the number if we need to but we want to
  # prevent an inadvertant disaster.

  $actual_num_files = @global_files;

  if ($actual_num_files >= $MAX_FILES_TO_DELETE) {
    # Ouch.  Something is wrong
    $$message_ref = "ptt_055: "                                   .
               "In preparation for a test, I am not permitted "   .
               "to delete more than $MAX_FILES_TO_DELETE files\n" .
               "however, there are $actual_num_files files to "   .
               "be deleted.  I will not do it.\n"                 .
               "Please research and fix\n";
    return(EXIT_FAILURE);

  }
  #....................................................................

  # Delete the files first.  Then we can delete the dirs
  # without worring about whether or not they are empty.
  foreach $file (@global_files) {
    if (!(unlink ("$file"))) {
      $$message_ref =  "ptt_060: "                .
                       "Cannot unlink $file:$!:\n";
      return (EXIT_FAILURE);
    }
  }

  # Remove the last dir first
  foreach $dir (reverse @global_dirs) {
    if (!(rmdir($dir))) {
      $$message_ref = "ptt_065: "                              .
                      "I am in dir $cwd and I "                .
                      "cannot rmdir $dir:$!:\n"                .
                      "Are you using it in another window?\n";
      return (EXIT_FAILURE);
    }
  }

  return (EXIT_SUCCESS);
}

########################################################################
sub prior_to_test {
  my (
       $test_number, 
       $base_directory,
       $os,
       $test_sub_dir_to_use_ref,
       $verbose,
       $message_ref,
     ) = @_;

  my $MODULUS = 3;
  my $temp_num = ($test_number % $MODULUS);
  my $error = EXIT_FAILURE;
  my $test_sub_dir = "";
  my $permission = 509; # 509 decimal is octal 0775
  my $further_subdir = "";
  my @further_subdirs = qw(subdir1 subdir2 subdir3 subdir4);
  my $further_subdir_to_create = "";

  $$message_ref = "";

  chdir($base_directory);

  # Remove the test directory, if present,
  if ($os =~ m!^Win!i) {
    $test_sub_dir = $base_directory . "\\temp" . "$temp_num";
    if (-e("$test_sub_dir")) {
      $error = remove_windows_tree($test_sub_dir, $message_ref);
       return $error if ($error == EXIT_FAILURE);
    }
  } else {
    $test_sub_dir = $base_directory . "/temp" . "$temp_num";
    if (-e("$test_sub_dir")) {
      if (system("rm -rf \"$test_sub_dir\"")) {
        $$message_ref = ( "ptt_075: "  .
                          ":$!:$?:\n");
        return (EXIT_FAILURE);
      }
    }
  }

  # mkpath assuming unix.  Windows defaults to read/write itself.
  if (!(mkpath ("$test_sub_dir", 0, $permission))) {
    $$message_ref = "ptt_080: Cannot create dir $test_sub_dir:$!:\n";
    return (EXIT_FAILURE);
  }

  $$test_sub_dir_to_use_ref = $test_sub_dir;


  #.................................................................
  # Create subdirs underneath our test_sub_dir, just in case
  #.................................................................
  foreach $further_subdir (@further_subdirs) {
    $further_subdir_to_create = $test_sub_dir . "/$further_subdir";
    if (!(mkpath ("$further_subdir_to_create", 0, $permission))) {
      $$message_ref = "ptt_085: "         .
                      "Cannot create dir $further_subdir_to_create:$!:\n";
      return (EXIT_FAILURE);
    }
  }
  #.................................................................

  return (EXIT_SUCCESS);

}
########################################################################
1;