NetWare/t/NWScripts.pl

   1
   2
   3 print "\nGenerating automated scripts for NetWare...\n\n\n";
   4
   5
   6 use File::Basename;
   7 use File::Copy;
   8
   9 chdir '/perl/scripts/';
  10 $DirName = "t";
  11
  12 # These scripts have problems (either abend or hang) as of now (11 May 2001).
  13 # So, they are commented out in the corresponding auto scripts, io.pl and lib.pl
  14 @ScriptsNotUsed = ("t/io/argv.t", "t/io/openpid.t", "t/lib/filehandle.t", "t/lib/warnings.t");\r
  15
  16 opendir(DIR, $DirName);
  17 @Dirs = readdir(DIR);
  18 close(DIR);
  19 foreach $DirItem(@Dirs)
  20 {
  21         $DirItem1 = $DirName."/".$DirItem;
  22         push @DirNames, $DirItem1;      # All items under  $DirName  folder is copied into an array.
  23
  24         if(-d $DirItem1)
  25         {       # If an item is a folder, then open it further.
  26
  27                 # Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
  28                 $IntAutoScript = "t/".$DirItem.".pl";
  29
  30                 # Open once in write mode since later files are opened in append mode,
  31                 # and if there already exists a file with the same name, all further opens
  32                 # will append to that file!!
  33                 open(FHW, "> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for writing.\n";
  34                 seek(FHW, 0, 0);        # seek to the beginning of the file.
  35                 close FHW;                      # close the file.
  36         }
  37 }
  38
  39
  40 print "Generating  t/nwauto.pl ...\n\n\n";
  41
  42 open(FHWA, "> t/nwauto.pl") or die "Unable to open the file,  t/nwauto.pl  for writing.\n";
  43 seek(FHWA, 0, 0);       # seek to the beginning of the file.
  44 flock(FHWA, LOCK_EX);           # Lock the file for safety purposes.
  45
  46 $version = sprintf("%vd",$^V);
  47 print FHWA "\n\nprint \"Automated Unit Testing of Perl$version for NetWare\\n\\n\\n\"\;\n\n\n";
  48
  49
  50 foreach $FileName(@DirNames)
  51 {
  52         $index = 0;
  53         if(-d $FileName)
  54         {       # If an item is a folder, then open it further.
  55
  56                 $dir = dirname($FileName);              # Get the folder name
  57
  58                 foreach $DirItem1(@Dirs)
  59                 {
  60                         $DirItem2 = $DirItem1;
  61                         if($FileName =~ m/$DirItem2/)
  62                         {
  63                                 $DirItem = $DirItem1;
  64
  65                                 # Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
  66                                 $IntAutoScript = "t/".$DirItem.".pl";
  67                         }
  68                 }
  69
  70                 # Write into the intermediary auto script.
  71                 open(FHW, ">> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for appending.\n";
  72                 seek(FHW, 0, 2);        # seek to the end of the file.
  73                 flock(FHW, LOCK_EX);            # Lock the file for safety purposes.
  74
  75                 $pos = tell(FHW);
  76                 if($pos <= 0)
  77                 {
  78                         print "Generating  $IntAutoScript...\n";
  79                         print FHW "\n\nprint \"Testing  $DirItem  folder:\\n\\n\\n\"\;\n\n\n";
  80                 }
  81
  82                 opendir(SUBDIR, $FileName);
  83                 @SubDirs = readdir(SUBDIR);
  84                 close(SUBDIR);
  85                 foreach $SubFileName(@SubDirs)
  86                 {
  87                         $SubFileName = $FileName."/".$SubFileName;
  88                         if(-d $SubFileName)
  89                         {
  90                                 push @DirNames, $SubFileName;   # If sub-folder, push it into the array.
  91                         }
  92                         else
  93                         {
  94                                 &Process_File($SubFileName);    # If file, process it.
  95                         }
  96
  97                         $index++;
  98                 }
  99
 100                 flock(FHW, LOCK_UN);    # unlock the file.
 101                 close FHW;                      # close the file.
 102
 103                 if($index <= 0)
 104                 {
 105                         # The folder is empty and delete the corresponding '.pl' file.
 106                         unlink($IntAutoScript);
 107                         print "Deleted  $IntAutoScript  since it corresponded to an empty folder.\n";
 108                 }
 109                 else
 110                 {
 111                         if($pos <= 0)
 112                         {       # This logic to make sure that it is written only once.
 113                                 # Only if something is written into the intermediary auto script,
 114                                 # only then make an entry of the intermediary auto script in  nwauto.pl
 115                                 print FHWA "print \`perl $IntAutoScript\`\;\n";
 116                                 print FHWA "print \"\\n\\n\\n\"\;\n\n";
 117                         }
 118                 }
 119         }
 120         else
 121         {
 122                 if(-f $FileName)
 123                 {
 124                         $dir = dirname($FileName);              # Get the folder name
 125                         $base = basename($FileName);    # Get the base name
 126                         ($base, $dir, $ext) = fileparse($FileName, '\..*');     # Get the extension of the file passed.
 127
 128                         # Do the processing only if the file has '.t' extension.
 129                         if($ext eq '.t')
 130                         {
 131                                 print FHWA "print \`perl $FileName\`\;\n";
 132                                 print FHWA "print \"\\n\\n\\n\"\;\n\n";
 133                         }
 134                 }
 135         }
 136 }
 137
 138
 139 ## Below adds the ending comments into all the intermediary auto scripts:
 140
 141 opendir(DIR, $DirName);
 142 @Dirs = readdir(DIR);
 143 close(DIR);
 144 foreach $DirItem(@Dirs)
 145 {
 146         $index = 0;
 147
 148         $FileName = $DirName."/".$DirItem;
 149         if(-d $FileName)
 150         {       # If an item is a folder, then open it further.
 151
 152                 opendir(SUBDIR, $FileName);
 153                 @SubDirs = readdir(SUBDIR);
 154                 close(SUBDIR);
 155
 156                 # To not to write into the file if the corresponding folder was empty.
 157                 foreach $SubDir(@SubDirs)
 158                 {
 159                         $index++;
 160                 }
 161
 162                 if($index > 0)
 163                 {
 164                         # The folder not empty.
 165
 166                         # Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
 167                         $IntAutoScript = "t/".$DirItem.".pl";
 168
 169                         # Write into the intermediary auto script.
 170                         open(FHW, ">> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for appending.\n";
 171                         seek(FHW, 0, 2);        # seek to the end of the file.
 172                         flock(FHW, LOCK_EX);            # Lock the file for safety purposes.
 173
 174                         # Write into the intermediary auto script.
 175                         print FHW "\nprint \"Testing of  $DirItem  folder done!\\n\\n\"\;\n\n";
 176
 177                         flock(FHW, LOCK_UN);    # unlock the file.
 178                         close FHW;                      # close the file.
 179                 }
 180         }
 181 }
 182
 183
 184 # Write into  nwauto.pl
 185 print FHWA "\nprint \"Automated Unit Testing of Perl$version for NetWare done!\\n\\n\"\;\n\n";
 186
 187 flock(FHWA, LOCK_UN);   # unlock the file.
 188 close FHWA;                     # close the file.
 189
 190 print "\n\nGeneration of  t/nwauto.pl  Done!\n\n";
 191
 192 print "\nGeneration of automated scripts for NetWare DONE!\n";
 193
 194
 195
 196
 197 # Process the file.
 198 sub Process_File
 199 {
 200         local($FileToProcess) = @_;             # File name.
 201         local($Script) = 0;
 202         local($HeadCut) = 0;
 203
 204         ## For example:
 205         ## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then
 206                 ## $dir1 = '/perl/scripts/t/pragma/'
 207                 ## $base1 = 'warnings'
 208                 ## $ext1 = '.t'
 209         $dir1 = dirname($FileToProcess);        # Get the folder name
 210         $base1 = basename($FileToProcess);      # Get the base name
 211         ($base1, $dir1, $ext1) = fileparse($FileToProcess, '\..*');     # Get the extension of the file passed.
 212
 213         # Do the processing only if the file has '.t' extension.
 214         if($ext1 eq '.t')
 215         {
 216                 foreach $Script(@ScriptsNotUsed)
 217                 {
 218                         # The variables are converted to lower case before they are compared.
 219                         # This is done to remove the case-sensitive comparison done by 'eq'.
 220                         $Script1 = lc($Script);
 221                         $FileToProcess1 = lc($FileToProcess);
 222                         if($Script1 eq $FileToProcess1)
 223                         {
 224                                 $HeadCut = 1;
 225                         }
 226                 }
 227
 228                 if($HeadCut)
 229                 {
 230                         # Write into the intermediary auto script.
 231                         print FHW "=head\n";
 232                 }
 233
 234                 # Write into the intermediary auto script.
 235                 print FHW "print \"Testing  $base1"."$ext1:\\n\\n\"\;\n";
 236                 print FHW "print \`perl $FileToProcess\`\;\n";  # Write the changed array into the file.
 237                 print FHW "print \"\\n\\n\\n\"\;\n";
 238
 239                 if($HeadCut)
 240                 {
 241                         # Write into the intermediary auto script.
 242                         print FHW "=cut\n";
 243                 }
 244
 245                 $HeadCut = 0;
 246                 print FHW "\n";
 247         }
 248 }
 249