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 | |
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 | |