#!/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;