From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Wed, 6 Feb 2002 15:10:00 +0000 (+0000)
Subject: New Netware scripts.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1789d6a403fe0cc064d8a7f0f9e302f5c4182ab7;p=p5sagit%2Fp5-mst-13.2.git

New Netware scripts.

p4raw-id: //depot/perl@14573
---

diff --git a/MANIFEST b/MANIFEST
index 47870bb..61687b3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1742,6 +1742,7 @@ mpeix/nm			MPE/iX port
 mpeix/relink			MPE/iX port
 mv-if-diff			Script to mv a file if it changed
 myconfig.SH			Prints summary of the current configuration
+NetWare/bat/BldNWExt-Exist.bat	Netware port
 NetWare/bat/BldNWExt.bat	Netware port
 NetWare/bat/Buildtype.bat	Netware port
 NetWare/bat/MPKBuild.bat	Netware port
@@ -1786,7 +1787,9 @@ NetWare/NWTInfo.c		Netware port
 NetWare/nwtinfo.h		Netware port
 NetWare/NWUtil.c		Netware port
 NetWare/nwutil.h		Netware port
+NetWare/t/NWModify-Exist.pl	Netware port
 NetWare/t/NWModify.pl		Netware port
+NetWare/t/NWScripts-Exist.pl	Netware port
 NetWare/t/NWScripts.pl		Netware port
 NetWare/t/Readme.txt		Netware port
 NetWare/testnlm/echo/echo.c	Netware port
diff --git a/NetWare/bat/BldNWExt-Exist.bat b/NetWare/bat/BldNWExt-Exist.bat
new file mode 100644
index 0000000..bdeddbb
--- /dev/null
+++ b/NetWare/bat/BldNWExt-Exist.bat
@@ -0,0 +1,39 @@
+@echo off
+@rem AUTHOR: sgp
+@rem CREATED: Sat Apr 14 13:05:44 2001
+@rem LAST REVISED: Sat Apr 14 2001
+@rem Batch file to toggle b/n building and not building NetWare
+@rem specific extns - cgi2perl & perl2ucs.
+
+if "%1" == "" goto Usage
+
+if "%1" == "/now" goto now
+if "%1" == "on" goto yes
+if "%1" == "off" goto no
+if "%1" == "/?" goto usage
+if "%1" == "/h" goto usage
+goto dontknow
+
+:now
+if not "%NW_EXTNS%" == "yes" echo NW_EXTNS is removed, doesn't build NetWare specific extensions
+if "%NW_EXTNS%"  == "yes" echo NW_EXTNS is set, builds NetWare specific extensions
+goto exit
+
+:yes
+Set NW_EXTNS=yes
+echo ....NW_EXTNS is set, builds NetWare specific extensions
+goto exit
+
+:no
+Set NW_EXTNS=
+echo ....NW_EXTNS is removed, doesn't build NetWare specific extensions
+goto exit
+
+:dontknow
+goto Usage
+
+:Usage
+ @echo on
+ @echo "Usage: BldNWExt [on|off]"
+ @echo "Usage: BldNWExt /now" - To display current setting
+:exit
diff --git a/NetWare/t/NWModify-Exist.pl b/NetWare/t/NWModify-Exist.pl
new file mode 100644
index 0000000..2b1d07b
--- /dev/null
+++ b/NetWare/t/NWModify-Exist.pl
@@ -0,0 +1,130 @@
+
+
+print "\nModifying the '.t' files...\n\n";
+
+use File::Basename;
+use File::Copy;
+
+## Change the below line to the folder you want to process
+$DirName = "/perl/scripts/t";
+
+$FilesTotal = 0;
+$FilesRead = 0;
+$FilesModified = 0;
+
+opendir(DIR, $DirName);
+@Dirs = readdir(DIR);
+
+foreach $DirItem(@Dirs)
+{
+	$DirItem = $DirName."/".$DirItem;
+	push @DirNames, $DirItem;	# All items under  $DirName  folder is copied into an array.
+}
+
+foreach $FileName(@DirNames)
+{
+	if(-d $FileName)
+	{	# If an item is a folder, then open it further.
+
+		opendir(SUBDIR, $FileName);
+		@SubDirs = readdir(SUBDIR);
+		close(SUBDIR);
+
+		foreach $SubFileName(@SubDirs)
+		{
+			if(-f $SubFileName)
+			{
+				&Process_File($SubFileName);	# If file, process it.
+			}
+			else
+			{
+				$SubFileName = $FileName."/".$SubFileName;
+				push @DirNames, $SubFileName;	# If sub-folder, push it into the array.
+			}
+		}
+	}
+	else
+	{
+		if(-f $FileName)
+		{
+			&Process_File($FileName);	# If file, process it.
+		}
+	}
+}
+
+close(DIR);
+
+print "\n\n\nTotal number of files present = $FilesTotal\n";
+print "Total number of '.t' files read = $FilesRead\n";
+print "Total number of '.t' files modified = $FilesModified\n\n";
+
+
+
+
+# Process the file.
+sub Process_File
+{
+	local($FileToProcess) = @_;		# File name.
+	local($Modified) = 0;
+
+	if(!(-w $FileToProcess)) {
+		# If the file is a read-only file, then change its mode to read-write.
+		chmod(0777, $FileToProcess);
+	}
+
+	## For example:
+	## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then
+		## $dir = '/perl/scripts/t/pragma/'
+		## $base = 'warnings'
+		## $ext = '.t'
+	$dir = dirname($FileToProcess);		# Get the folder name
+	$base = basename($FileToProcess);	# Get the base name
+	($base, $dir, $ext) = fileparse($FileToProcess, '\..*');	# Get the extension of the file passed.
+
+
+	# Do the processing only if the file has '.t' extension.
+	if($ext eq '.t') {
+
+		open(FH, "+< $FileToProcess") or die "Unable to open the file,  $FileToProcess  for reading and writing.\n";
+		@ARRAY = <FH>;	# Get the contents of the file into an array.
+
+		flock(FH, LOCK_EX);		# Lock the file for safety purposes.
+		foreach $Line(@ARRAY)	# Get each line of the file.
+		{
+			if($Line =~ m/\@INC = /)
+			{	# If the line contains the string (@INC = ), then replace it
+
+				# Replace "@INC = " with "unshift @INC, "
+				$Line =~ s/\@INC = /unshift \@INC, /;
+
+				$Modified = 1;
+			}
+
+			if($Line =~ m/push \@INC, /)
+			{	# If the line contains the string (push @INC, ), then replace it
+
+				# Replace "push @INC, " with "unshift @INC, "
+				$Line =~ s/push \@INC, /unshift \@INC, /;
+
+				$Modified = 1;
+			}
+		}
+
+		seek(FH, 0, 0);		# Seek to the beginning.
+		print FH @ARRAY;	# Write the changed array into the file.
+		flock(FH, LOCK_UN);	# unlock the file.
+		close FH;			# close the file.
+
+		$FilesRead++;	# One more file read.
+
+		if($Modified) {
+			print "Modified the file,  $FileToProcess\n";
+			$Modified = 0;
+
+			$FilesModified++;	# One more file modified.
+		}
+	}
+
+	$FilesTotal++;	# One more file present.
+}
+
diff --git a/NetWare/t/NWScripts-Exist.pl b/NetWare/t/NWScripts-Exist.pl
new file mode 100644
index 0000000..cb2938e
--- /dev/null
+++ b/NetWare/t/NWScripts-Exist.pl
@@ -0,0 +1,243 @@
+
+
+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/openpid.t", "t/lib/filehandle.t", "t/lib/memoize/t/expire_module_t.t");
+
+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.
+
+$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.
+
+		$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++;
+		}
+
+		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.
+
+			# Write into the intermediary auto script.
+			print FHW "\nprint \"Testing of  $DirItem  folder done!\\n\\n\"\;\n\n";
+
+			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";
+
+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";
+	}
+}
+