diff options
| -rw-r--r-- | MANIFEST | 3 | ||||
| -rw-r--r-- | NetWare/bat/BldNWExt-Exist.bat | 39 | ||||
| -rw-r--r-- | NetWare/t/NWModify-Exist.pl | 130 | ||||
| -rw-r--r-- | NetWare/t/NWScripts-Exist.pl | 243 |
4 files changed, 415 insertions, 0 deletions
@@ -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 0000000000..bdeddbbe56 --- /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 0000000000..2b1d07beb8 --- /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 0000000000..cb2938ebde --- /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"; + } +} + |