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
  13 # These scripts have problems (either abend or hang) as of now (11 May 2001).
  14 # So, they are commented out in the corresponding auto scripts, io.pl and lib.pl
  15 @ScriptsNotUsed = ("t/io/argv.t", "t/io/openpid.t", "t/lib/filehand.t");
  16
  17
  18 print "Generating  t/auto.pl ...\n\n\n";
  19
  20 open(FHWA, "> t/auto.pl") or die "Unable to open the file,  t/auto.pl  for writing.\n";
  21 seek(FHWA, 0 ,0);
  22 flock(FHWA, LOCK_EX);           # Lock the file for safety purposes.
  23
  24 $version = sprintf("%vd",$^V);
  25 print FHWA "\n\nprint \"Automated Unit Testing of Perl$version\\n\\n\\n\"\;\n\n\n";
  26
  27
  28 opendir(DIR, $DirName) or die "Unable to open the directory, $DirName  for reading.\n";
  29 @Dirs = readdir(DIR);
  30
  31 foreach $DirItem(@Dirs)
  32 {
  33         $DirItem = $DirName."/".$DirItem;
  34         push @DirNames, $DirItem;       # All items under  $DirName  directory is copied into an array.
  35 }
  36
  37 foreach $FileName(@DirNames)
  38 {
  39         if(-d $FileName)
  40         {       # If an item is a directory, then open it further.
  41
  42                 opendir(SUBDIR, $FileName) or die "Unable to open the directory, $FileName  for reading.\n";
  43                 @SubDirs = readdir(SUBDIR);
  44                 close(SUBDIR);
  45
  46
  47                 $base = basename($FileName);    # Get the base name
  48                 $dir = dirname($FileName);              # Get the directory name
  49                 ($base, $dir, $ext) = fileparse($FileName, '\..*');     # Get the extension of the file passed.
  50
  51                 # Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
  52                 $IntAutoScript = "t/".$base.".pl";
  53
  54
  55                 # Write into auto.pl
  56                 print FHWA "print \`perl $IntAutoScript\`\;\n";
  57                 print FHWA "print \"\\n\\n\\n\"\;\n\n";
  58
  59
  60                 print "Generating  $IntAutoScript...\n";
  61                 # Write into the intermediary auto script.
  62                 open(FHW, "> $IntAutoScript") or die "Unable to open the file,  $IntAutoScript  for writing.\n";
  63                 seek(FHW, 0 ,0);
  64                 flock(FHW, LOCK_EX);            # Lock the file for safety purposes.
  65
  66                 print FHW "\n\nprint \"Testing  $base  directory:\\n\\n\\n\"\;\n\n\n";
  67
  68
  69                 foreach $SubFileName(@SubDirs)
  70                 {
  71                         if(-d $SubFileName)
  72                         {
  73                                 $SubFileName = $FileName."/".$SubFileName;
  74                                 push @DirNames, $SubFileName;   # If sub-directory, push it into the array.
  75                         }
  76                         else
  77                         {
  78                                 $SubFileName = $FileName."/".$SubFileName;
  79                                 &Process_File($SubFileName);    # If file, process it.
  80                         }
  81                 }
  82
  83                 # Write into the intermediary auto script.
  84                 print FHW "\nprint \"Testing of  $base  directory done!\\n\\n\"\;\n\n";
  85
  86                 flock(FHW, LOCK_UN);    # unlock the file.
  87                 close FHW;                      # close the file.
  88                 print "$IntAutoScript Done!\n\n";
  89         }
  90 }
  91
  92 close(DIR);
  93
  94
  95 # Write into  auto.pl
  96 print FHWA "\nprint \"Automated Unit Testing of Perl$version  done!\\n\\n\"\;\n\n";
  97
  98 flock(FHWA, LOCK_UN);   # unlock the file.
  99 close FHWA;                     # close the file.
 100
 101 print "\nt/auto.pl Done!\n\n";
 102
 103
 104 print "\nGeneration of automated scripts for NetWare  DONE!\n";
 105
 106
 107
 108 # Process the file.
 109 sub Process_File
 110 {
 111         local($FileToProcess) = @_;             # File name.
 112         local($Script) = 0;
 113         local($HeadCut) = 0;
 114
 115
 116         $base1 = basename($FileToProcess);      # Get the base name
 117         $dir1 = dirname($FileToProcess);                # Get the directory name
 118         ($base1, $dir1, $ext1) = fileparse($FileToProcess, '\..*');     # Get the extension of the file passed.
 119
 120         ## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then
 121                 ## $dir1 = '/perl/scripts/t/pragma/'
 122                 ## $base1 = 'warnings'
 123                 ## $ext1 = '.t'
 124
 125
 126         # Do the processing only if the file has '.t' extension.
 127         if($ext1 eq '.t')
 128         {
 129                 foreach $Script(@ScriptsNotUsed)
 130                 {
 131                         if($Script eq $FileToProcess)
 132                         {
 133                                 $HeadCut = 1;
 134                         }
 135                 }
 136
 137                 if($HeadCut)
 138                 {
 139                         # Write into the intermediary auto script.
 140                         print FHW "=head\n";
 141                 }
 142
 143                 # Write into the intermediary auto script.
 144                 print FHW "print \"Testing  $base1"."$ext1:\\n\\n\"\;\n";
 145                 print FHW "print \`perl $FileToProcess\`\;\n";  # Write the changed array into the file.
 146                 print FHW "print \"\\n\\n\\n\"\;\n";
 147
 148                 if($HeadCut)
 149                 {
 150                         # Write into the intermediary auto script.
 151                         print FHW "=cut\n";
 152                 }
 153
 154                 $HeadCut = 0;
 155                 print FHW "\n";
 156         }
 157 }
 158