Commit | Line | Data |
2986a63f |
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 |
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 |
91c54917 |
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"); |
2986a63f |
15 | |
225a5dca |
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 |
24 | if(-d $DirItem1) |
25 | { # If an item is a folder, then open it further. |
2986a63f |
26 | |
225a5dca |
27 | # Intemediary automated script like base.pl, lib.pl, cmd.pl etc. |
28 | $IntAutoScript = "t/".$DirItem.".pl"; |
2986a63f |
29 | |
225a5dca |
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 | } |
2986a63f |
38 | |
39 | |
225a5dca |
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. |
225a5dca |
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 |
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 |
57 | foreach $DirItem1(@Dirs) |
58 | { |
59 | $DirItem2 = $DirItem1; |
60 | if($FileName =~ m/$DirItem2/) |
61 | { |
62 | $DirItem = $DirItem1; |
2986a63f |
63 | |
225a5dca |
64 | # Intemediary automated script like base.pl, lib.pl, cmd.pl etc. |
65 | $IntAutoScript = "t/".$DirItem.".pl"; |
66 | } |
67 | } |
2986a63f |
68 | |
2986a63f |
69 | # Write into the intermediary auto script. |
225a5dca |
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. |
2986a63f |
72 | |
225a5dca |
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 |
80 | opendir(SUBDIR, $FileName); |
81 | @SubDirs = readdir(SUBDIR); |
82 | close(SUBDIR); |
2986a63f |
83 | foreach $SubFileName(@SubDirs) |
84 | { |
225a5dca |
85 | $SubFileName = $FileName."/".$SubFileName; |
2986a63f |
86 | if(-d $SubFileName) |
87 | { |
225a5dca |
88 | push @DirNames, $SubFileName; # If sub-folder, push it into the array. |
2986a63f |
89 | } |
90 | else |
91 | { |
2986a63f |
92 | &Process_File($SubFileName); # If file, process it. |
93 | } |
2986a63f |
94 | |
225a5dca |
95 | $index++; |
96 | } |
2986a63f |
97 | |
2986a63f |
98 | close FHW; # close the file. |
225a5dca |
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 |
132 | } |
133 | } |
134 | |
225a5dca |
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 |
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 |
149 | opendir(SUBDIR, $FileName); |
150 | @SubDirs = readdir(SUBDIR); |
151 | close(SUBDIR); |
2986a63f |
152 | |
225a5dca |
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. |
225a5dca |
169 | |
170 | # Write into the intermediary auto script. |
171 | print FHW "\nprint \"Testing of $DirItem folder done!\\n\\n\"\;\n\n"; |
172 | |
225a5dca |
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 |
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 |
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 |
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 |
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 |
206 | |
207 | # Do the processing only if the file has '.t' extension. |
208 | if($ext1 eq '.t') |
209 | { |
210 | foreach $Script(@ScriptsNotUsed) |
211 | { |
225a5dca |
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 |
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 | |