+++ /dev/null
-
-
-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.
-}
-
+++ /dev/null
-
-
-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";
- }
-}
-
projects / p5sagit/p5-mst-13.2.git / commitdiff