Improve the broken order of the release_managers_guide
[perl.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/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", "t/lib/CPAN/t/loadme.t", "t/lib/CPAN/t/vcmp.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