Commit | Line | Data |
---|---|---|
2986a63f JH |
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 | ||
2986a63f JH |
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 | |
3e7b198a | 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"); |
2986a63f | 15 | |
225a5dca JH |
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. | |
2986a63f | 23 | |
225a5dca JH |
24 | if(-d $DirItem1) |
25 | { # If an item is a folder, then open it further. | |
2986a63f | 26 | |
231c54e0 | 27 | # Intermediary automated script like base.pl, lib.pl, cmd.pl etc. |
225a5dca | 28 | $IntAutoScript = "t/".$DirItem.".pl"; |
2986a63f | 29 | |
225a5dca JH |
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!! | |
1ae6ead9 | 33 | open(FHW, '>', $IntAutoScript) or die "Unable to open the file, $IntAutoScript for writing.\n"; |
225a5dca JH |
34 | seek(FHW, 0, 0); # seek to the beginning of the file. |
35 | close FHW; # close the file. | |
36 | } | |
37 | } | |
2986a63f JH |
38 | |
39 | ||
225a5dca JH |
40 | print "Generating t/nwauto.pl ...\n\n\n"; |
41 | ||
1ae6ead9 | 42 | open(FHWA, '>', 't/nwauto.pl') or die "Unable to open the file, t/nwauto.pl for writing.\n"; |
225a5dca | 43 | seek(FHWA, 0, 0); # seek to the beginning of the file. |
225a5dca JH |
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"; | |
2986a63f | 47 | |
2986a63f JH |
48 | |
49 | foreach $FileName(@DirNames) | |
50 | { | |
225a5dca | 51 | $index = 0; |
2986a63f | 52 | if(-d $FileName) |
225a5dca | 53 | { # If an item is a folder, then open it further. |
2986a63f | 54 | |
225a5dca | 55 | $dir = dirname($FileName); # Get the folder name |
2986a63f | 56 | |
225a5dca JH |
57 | foreach $DirItem1(@Dirs) |
58 | { | |
59 | $DirItem2 = $DirItem1; | |
60 | if($FileName =~ m/$DirItem2/) | |
61 | { | |
62 | $DirItem = $DirItem1; | |
2986a63f | 63 | |
231c54e0 | 64 | # Intermediary automated script like base.pl, lib.pl, cmd.pl etc. |
225a5dca JH |
65 | $IntAutoScript = "t/".$DirItem.".pl"; |
66 | } | |
67 | } | |
2986a63f | 68 | |
2986a63f | 69 | # Write into the intermediary auto script. |
1ae6ead9 | 70 | open(FHW, '>>', $IntAutoScript) or die "Unable to open the file, $IntAutoScript for appending.\n"; |
225a5dca | 71 | seek(FHW, 0, 2); # seek to the end of the file. |
2986a63f | 72 | |
225a5dca JH |
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 | } | |
2986a63f | 79 | |
225a5dca JH |
80 | opendir(SUBDIR, $FileName); |
81 | @SubDirs = readdir(SUBDIR); | |
82 | close(SUBDIR); | |
2986a63f JH |
83 | foreach $SubFileName(@SubDirs) |
84 | { | |
225a5dca | 85 | $SubFileName = $FileName."/".$SubFileName; |
2986a63f JH |
86 | if(-d $SubFileName) |
87 | { | |
225a5dca | 88 | push @DirNames, $SubFileName; # If sub-folder, push it into the array. |
2986a63f JH |
89 | } |
90 | else | |
91 | { | |
2986a63f JH |
92 | &Process_File($SubFileName); # If file, process it. |
93 | } | |
2986a63f | 94 | |
225a5dca JH |
95 | $index++; |
96 | } | |
2986a63f | 97 | |
2986a63f | 98 | close FHW; # close the file. |
225a5dca JH |
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 | } | |
2986a63f JH |
132 | } |
133 | } | |
134 | ||
225a5dca JH |
135 | |
136 | ## Below adds the ending comments into all the intermediary auto scripts: | |
137 | ||
138 | opendir(DIR, $DirName); | |
139 | @Dirs = readdir(DIR); | |
2986a63f | 140 | close(DIR); |
225a5dca JH |
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. | |
2986a63f | 148 | |
225a5dca JH |
149 | opendir(SUBDIR, $FileName); |
150 | @SubDirs = readdir(SUBDIR); | |
151 | close(SUBDIR); | |
2986a63f | 152 | |
225a5dca JH |
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 | ||
231c54e0 | 163 | # Intermediary automated script like base.pl, lib.pl, cmd.pl etc. |
225a5dca JH |
164 | $IntAutoScript = "t/".$DirItem.".pl"; |
165 | ||
166 | # Write into the intermediary auto script. | |
1ae6ead9 | 167 | open(FHW, '>>', $IntAutoScript) or die "Unable to open the file, $IntAutoScript for appending.\n"; |
225a5dca | 168 | seek(FHW, 0, 2); # seek to the end of the file. |
225a5dca JH |
169 | |
170 | # Write into the intermediary auto script. | |
171 | print FHW "\nprint \"Testing of $DirItem folder done!\\n\\n\"\;\n\n"; | |
172 | ||
225a5dca JH |
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"; | |
2986a63f | 181 | |
2986a63f JH |
182 | close FHWA; # close the file. |
183 | ||
225a5dca | 184 | print "\n\nGeneration of t/nwauto.pl Done!\n\n"; |
2986a63f | 185 | |
225a5dca | 186 | print "\nGeneration of automated scripts for NetWare DONE!\n"; |
2986a63f | 187 | |
2986a63f JH |
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 | ||
225a5dca | 198 | ## For example: |
2986a63f JH |
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' | |
225a5dca JH |
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. | |
2986a63f JH |
206 | |
207 | # Do the processing only if the file has '.t' extension. | |
208 | if($ext1 eq '.t') | |
209 | { | |
210 | foreach $Script(@ScriptsNotUsed) | |
211 | { | |
225a5dca JH |
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) | |
2986a63f JH |
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 |