This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
NetWare tweaks from Guruprasad.
[perl5.git] / 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");
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