NetWare scripts tweak from Ananth Kesari.

[p5sagit/p5-mst-13.2.git] / NetWare / t / NWScripts.pl

print "\nGenerating automated scripts for NetWare...\n\n\n";


use File::Basename;
use File::Copy;

chdir '/perl/scripts/';
$DirName = "t";

# These scripts have problems (either abend or hang) as of now (11 May 2001).
# So, they are commented out in the corresponding auto scripts, io.pl and lib.pl
@ScriptsNotUsed = ("t/io/argv.t", "t/io/openpid.t", "t/lib/filehandle.t", "t/lib/warnings.t");\r

opendir(DIR, $DirName);
@Dirs = readdir(DIR);
close(DIR);
foreach $DirItem(@Dirs)
{
	$DirItem1 = $DirName."/".$DirItem;
	push @DirNames, $DirItem1;	# All items under  $DirName  folder is copied into an array.

	if(-d $DirItem1)
	{	# If an item is a folder, then open it further.

		# Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
		$IntAutoScript = "t/".$DirItem.".pl";

		# Open once in write mode since later files are opened in append mode,
		# and if there already exists a file with the same name, all further opens
		# will append to that file!!
		open(FHW, "> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for writing.\n";
		seek(FHW, 0, 0);	# seek to the beginning of the file.
		close FHW;			# close the file.
	}
}


print "Generating  t/nwauto.pl ...\n\n\n";

open(FHWA, "> t/nwauto.pl") or die "Unable to open the file,  t/nwauto.pl  for writing.\n";
seek(FHWA, 0, 0);	# seek to the beginning of the file.
flock(FHWA, LOCK_EX);		# Lock the file for safety purposes.

$version = sprintf("%vd",$^V);
print FHWA "\n\nprint \"Automated Unit Testing of Perl$version for NetWare\\n\\n\\n\"\;\n\n\n";


foreach $FileName(@DirNames)
{
	$index = 0;
	if(-d $FileName)
	{	# If an item is a folder, then open it further.

		$dir = dirname($FileName);		# Get the folder name

		foreach $DirItem1(@Dirs)
		{
			$DirItem2 = $DirItem1;
			if($FileName =~ m/$DirItem2/)
			{
				$DirItem = $DirItem1;

				# Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
				$IntAutoScript = "t/".$DirItem.".pl";
			}
		}

		# Write into the intermediary auto script.
		open(FHW, ">> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for appending.\n";
		seek(FHW, 0, 2);	# seek to the end of the file.
		flock(FHW, LOCK_EX);		# Lock the file for safety purposes.

		$pos = tell(FHW);
		if($pos <= 0)
		{
			print "Generating  $IntAutoScript...\n";
			print FHW "\n\nprint \"Testing  $DirItem  folder:\\n\\n\\n\"\;\n\n\n";
		}

		opendir(SUBDIR, $FileName);
		@SubDirs = readdir(SUBDIR);
		close(SUBDIR);
		foreach $SubFileName(@SubDirs)
		{
			$SubFileName = $FileName."/".$SubFileName;
			if(-d $SubFileName)
			{
				push @DirNames, $SubFileName;	# If sub-folder, push it into the array.
			}
			else
			{
				&Process_File($SubFileName);	# If file, process it.
			}

			$index++;
		}

		flock(FHW, LOCK_UN);	# unlock the file.
		close FHW;			# close the file.

		if($index <= 0)
		{
			# The folder is empty and delete the corresponding '.pl' file.
			unlink($IntAutoScript);
			print "Deleted  $IntAutoScript  since it corresponded to an empty folder.\n";
		}
		else
		{
			if($pos <= 0)
			{	# This logic to make sure that it is written only once.
				# Only if something is written into the intermediary auto script,
				# only then make an entry of the intermediary auto script in  nwauto.pl
				print FHWA "print \`perl $IntAutoScript\`\;\n";
				print FHWA "print \"\\n\\n\\n\"\;\n\n";
			}
		}
	}
	else
	{
		if(-f $FileName)
		{
			$dir = dirname($FileName);		# Get the folder name
			$base = basename($FileName);	# Get the base name
			($base, $dir, $ext) = fileparse($FileName, '\..*');	# Get the extension of the file passed.
			
			# Do the processing only if the file has '.t' extension.
			if($ext eq '.t')
			{
				print FHWA "print \`perl $FileName\`\;\n";
				print FHWA "print \"\\n\\n\\n\"\;\n\n";
			}
		}
	}
}


## Below adds the ending comments into all the intermediary auto scripts:

opendir(DIR, $DirName);
@Dirs = readdir(DIR);
close(DIR);
foreach $DirItem(@Dirs)
{
	$index = 0;

	$FileName = $DirName."/".$DirItem;
	if(-d $FileName)
	{	# If an item is a folder, then open it further.

		opendir(SUBDIR, $FileName);
		@SubDirs = readdir(SUBDIR);
		close(SUBDIR);

		# To not to write into the file if the corresponding folder was empty.
		foreach $SubDir(@SubDirs)
		{
			$index++;
		}

		if($index > 0)
		{
			# The folder not empty.

			# Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
			$IntAutoScript = "t/".$DirItem.".pl";

			# Write into the intermediary auto script.
			open(FHW, ">> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for appending.\n";
			seek(FHW, 0, 2);	# seek to the end of the file.
			flock(FHW, LOCK_EX);		# Lock the file for safety purposes.

			# Write into the intermediary auto script.
			print FHW "\nprint \"Testing of  $DirItem  folder done!\\n\\n\"\;\n\n";

			flock(FHW, LOCK_UN);	# unlock the file.
			close FHW;			# close the file.
		}
	}
}


# Write into  nwauto.pl
print FHWA "\nprint \"Automated Unit Testing of Perl$version for NetWare done!\\n\\n\"\;\n\n";

flock(FHWA, LOCK_UN);	# unlock the file.
close FHWA;			# close the file.

print "\n\nGeneration of  t/nwauto.pl  Done!\n\n";

print "\nGeneration of automated scripts for NetWare DONE!\n";




# Process the file.
sub Process_File
{
	local($FileToProcess) = @_;		# File name.
	local($Script) = 0;
	local($HeadCut) = 0;

	## For example:
	## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then
		## $dir1 = '/perl/scripts/t/pragma/'
		## $base1 = 'warnings'
		## $ext1 = '.t'
	$dir1 = dirname($FileToProcess);	# Get the folder name
	$base1 = basename($FileToProcess);	# Get the base name
	($base1, $dir1, $ext1) = fileparse($FileToProcess, '\..*');	# Get the extension of the file passed.

	# Do the processing only if the file has '.t' extension.
	if($ext1 eq '.t')
	{
		foreach $Script(@ScriptsNotUsed)
		{
			# The variables are converted to lower case before they are compared.
			# This is done to remove the case-sensitive comparison done by 'eq'.
			$Script1 = lc($Script);
			$FileToProcess1 = lc($FileToProcess);
			if($Script1 eq $FileToProcess1)
			{
				$HeadCut = 1;
			}
		}

		if($HeadCut)
		{
			# Write into the intermediary auto script.
			print FHW "=head\n";
		}

		# Write into the intermediary auto script.
		print FHW "print \"Testing  $base1"."$ext1:\\n\\n\"\;\n";
		print FHW "print \`perl $FileToProcess\`\;\n";	# Write the changed array into the file.
		print FHW "print \"\\n\\n\\n\"\;\n";

		if($HeadCut)
		{
			# Write into the intermediary auto script.
			print FHW "=cut\n";
		}

		$HeadCut = 0;
		print FHW "\n";
	}
}