diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2002-02-22 13:44:27 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-02-22 13:44:27 +0000 |
commit | bf313bd694adee5e6534146ff2fcfde9dae51e06 (patch) | |
tree | 4df1b394652bc7ea87bbe12e68188d6268076ab3 /NetWare | |
parent | 62f955573e85dc949b6e396624a9434d6c330a5f (diff) | |
download | perl-bf313bd694adee5e6534146ff2fcfde9dae51e06.tar.gz |
NetWare change from Ananth Kesari.
p4raw-id: //depot/perl@14830
Diffstat (limited to 'NetWare')
-rw-r--r-- | NetWare/t/NWModify-Exist.pl | 130 | ||||
-rw-r--r-- | NetWare/t/NWScripts-Exist.pl | 243 |
2 files changed, 0 insertions, 373 deletions
diff --git a/NetWare/t/NWModify-Exist.pl b/NetWare/t/NWModify-Exist.pl deleted file mode 100644 index 2b1d07beb8..0000000000 --- a/NetWare/t/NWModify-Exist.pl +++ /dev/null @@ -1,130 +0,0 @@ - - -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 deleted file mode 100644 index cb2938ebde..0000000000 --- a/NetWare/t/NWScripts-Exist.pl +++ /dev/null @@ -1,243 +0,0 @@ - - -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"; - } -} - |