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/openpid.t", "t/lib/filehandle.t", "t/lib/memoize/t/expire_module_t.t", "t/lib/NEXT/t/next.t", "t/lib/Math/BigInt/t/require.t", "t/ext/B/t/debug.t","t/lib/IPC/Open3.t", "t/ext/B/t/showlex.t", "t/op/subst_wamp.t", "t/uni/upper.t", "t/lib/Net/t/ftp.t", "t/op/sort.t, ", "t/ext/POSIX/t/posix.t");
  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
  45 $version = sprintf("%vd",$^V);
  46 print FHWA "\n\nprint \"Automated Unit Testing of Perl$version for NetWare\\n\\n\\n\"\;\n\n\n";
  47
  48
  49 foreach $FileName(@DirNames)
  50 {
  51         $index = 0;
  52         if(-d $FileName)
  53         {       # If an item is a folder, then open it further.
  54
  55                 $dir = dirname($FileName);              # Get the folder name
  56
  57                 foreach $DirItem1(@Dirs)
  58                 {
  59                         $DirItem2 = $DirItem1;
  60                         if($FileName =~ m/$DirItem2/)
  61                         {
  62                                 $DirItem = $DirItem1;
  63
  64                                 # Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
  65                                 $IntAutoScript = "t/".$DirItem.".pl";
  66                         }
  67                 }
  68
  69                 # Write into the intermediary auto script.
  70                 open(FHW, ">> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for appending.\n";
  71                 seek(FHW, 0, 2);        # seek to the end of the file.
  72
  73                 $pos = tell(FHW);
  74                 if($pos <= 0)
  75                 {
  76                         print "Generating  $IntAutoScript...\n";
  77                         print FHW "\n\nprint \"Testing  $DirItem  folder:\\n\\n\\n\"\;\n\n\n";
  78                 }
  79
  80                 opendir(SUBDIR, $FileName);
  81                 @SubDirs = readdir(SUBDIR);
  82                 close(SUBDIR);
  83                 foreach $SubFileName(@SubDirs)
  84                 {
  85                         $SubFileName = $FileName."/".$SubFileName;
  86                         if(-d $SubFileName)
  87                         {
  88                                 push @DirNames, $SubFileName;   # If sub-folder, push it into the array.
  89                         }
  90                         else
  91                         {
  92                                 &Process_File($SubFileName);    # If file, process it.
  93                         }
  94
  95                         $index++;
  96                 }
  97
  98                 close FHW;                      # close the file.
  99
 100                 if($index <= 0)
 101                 {
 102                         # The folder is empty and delete the corresponding '.pl' file.
 103                         unlink($IntAutoScript);
 104                         print "Deleted  $IntAutoScript  since it corresponded to an empty folder.\n";
 105                 }
 106                 else
 107                 {
 108                         if($pos <= 0)
 109                         {       # This logic to make sure that it is written only once.
 110                                 # Only if something is written into the intermediary auto script,
 111                                 # only then make an entry of the intermediary auto script in  nwauto.pl
 112                                 print FHWA "print \`perl $IntAutoScript\`\;\n";
 113                                 print FHWA "print \"\\n\\n\\n\"\;\n\n";
 114                         }
 115                 }
 116         }
 117         else
 118         {
 119                 if(-f $FileName)
 120                 {
 121                         $dir = dirname($FileName);              # Get the folder name
 122                         $base = basename($FileName);    # Get the base name
 123                         ($base, $dir, $ext) = fileparse($FileName, '\..*');     # Get the extension of the file passed.
 124
 125                         # Do the processing only if the file has '.t' extension.
 126                         if($ext eq '.t')
 127                         {
 128                                 print FHWA "print \`perl $FileName\`\;\n";
 129                                 print FHWA "print \"\\n\\n\\n\"\;\n\n";
 130                         }
 131                 }
 132         }
 133 }
 134
 135
 136 ## Below adds the ending comments into all the intermediary auto scripts:
 137
 138 opendir(DIR, $DirName);
 139 @Dirs = readdir(DIR);
 140 close(DIR);
 141 foreach $DirItem(@Dirs)
 142 {
 143         $index = 0;
 144
 145         $FileName = $DirName."/".$DirItem;
 146         if(-d $FileName)
 147         {       # If an item is a folder, then open it further.
 148
 149                 opendir(SUBDIR, $FileName);
 150                 @SubDirs = readdir(SUBDIR);
 151                 close(SUBDIR);
 152
 153                 # To not to write into the file if the corresponding folder was empty.
 154                 foreach $SubDir(@SubDirs)
 155                 {
 156                         $index++;
 157                 }
 158
 159                 if($index > 0)
 160                 {
 161                         # The folder not empty.
 162
 163                         # Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
 164                         $IntAutoScript = "t/".$DirItem.".pl";
 165
 166                         # Write into the intermediary auto script.
 167                         open(FHW, ">> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for appending.\n";
 168                         seek(FHW, 0, 2);        # seek to the end of the file.
 169
 170                         # Write into the intermediary auto script.
 171                         print FHW "\nprint \"Testing of  $DirItem  folder done!\\n\\n\"\;\n\n";
 172
 173                         close FHW;                      # close the file.
 174                 }
 175         }
 176 }
 177
 178
 179 # Write into  nwauto.pl
 180 print FHWA "\nprint \"Automated Unit Testing of Perl$version for NetWare done!\\n\\n\"\;\n\n";
 181
 182 close FHWA;                     # close the file.
 183
 184 print "\n\nGeneration of  t/nwauto.pl  Done!\n\n";
 185
 186 print "\nGeneration of automated scripts for NetWare DONE!\n";
 187
 188
 189
 190
 191 # Process the file.
 192 sub Process_File
 193 {
 194         local($FileToProcess) = @_;             # File name.
 195         local($Script) = 0;
 196         local($HeadCut) = 0;
 197
 198         ## For example:
 199         ## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then
 200                 ## $dir1 = '/perl/scripts/t/pragma/'
 201                 ## $base1 = 'warnings'
 202                 ## $ext1 = '.t'
 203         $dir1 = dirname($FileToProcess);        # Get the folder name
 204         $base1 = basename($FileToProcess);      # Get the base name
 205         ($base1, $dir1, $ext1) = fileparse($FileToProcess, '\..*');     # Get the extension of the file passed.
 206
 207         # Do the processing only if the file has '.t' extension.
 208         if($ext1 eq '.t')
 209         {
 210                 foreach $Script(@ScriptsNotUsed)
 211                 {
 212                         # The variables are converted to lower case before they are compared.
 213                         # This is done to remove the case-sensitive comparison done by 'eq'.
 214                         $Script1 = lc($Script);
 215                         $FileToProcess1 = lc($FileToProcess);
 216                         if($Script1 eq $FileToProcess1)
 217                         {
 218                                 $HeadCut = 1;
 219                         }
 220                 }
 221
 222                 if($HeadCut)
 223                 {
 224                         # Write into the intermediary auto script.
 225                         print FHW "=head\n";
 226                 }
 227
 228                 # Write into the intermediary auto script.
 229                 print FHW "print \"Testing  $base1"."$ext1:\\n\\n\"\;\n";
 230                 print FHW "print \`perl $FileToProcess\`\;\n";  # Write the changed array into the file.
 231                 print FHW "print \"\\n\\n\\n\"\;\n";
 232
 233                 if($HeadCut)
 234                 {
 235                         # Write into the intermediary auto script.
 236                         print FHW "=cut\n";
 237                 }
 238
 239                 $HeadCut = 0;
 240                 print FHW "\n";
 241         }
 242 }
 243