Merge branch 'origtgz'
[alioth/cvs.git] / windows-NT / mkconfig.pl
1 #! perl -w
2
3 use strict;
4
5 # For the `mv' function which is smart enough to cross device boundries.
6 use File::Copy qw{mv};
7 # For the `basename' function.
8 use File::Basename;
9
10
11
12 ###
13 ### FUNCTIONS
14 ###
15 sub save_edit
16 {
17     my ($same, $file_name, $temp_name) = @_;
18
19     if ($same)
20     {
21         unlink $temp_name
22             or warn "Failed to unlink ", $temp_name, ": $!";
23         print "no change: ", $file_name, "\n";
24     }
25     else
26     {
27         mv $temp_name, $file_name
28             or die "Failed to rename ", $temp_name, " to ", $file_name, ": $!";
29
30         print "save edit: ", $file_name, "\n";
31     }
32 }
33
34 sub get_default
35 {
36     my ($value, $default) = @_;
37
38     if ($value eq "")
39     {
40         $value = $default;
41     }
42
43     return $value;
44 }
45
46
47
48 sub show_repeat
49 {
50     my ($file, $new_no, $old_no, $line) = @_;
51
52     print $file, " line ", $new_no, " duplicates line ", $old_no, ": ", $line;
53 }
54
55
56
57 sub show_orphan
58 {
59     my ($case, $that, $this, $this_key, %this_macros) = @_;
60     my $type = $this_macros{$this_key}[1];
61
62     if ($case eq 0)
63     {
64         # roots file has extra macro statement
65         # tell only of #undef
66         return if $type eq "d";
67     }
68     elsif ($case eq 1)
69     {
70         # build file has extra macro statement
71         # tell only of #define
72         return if $type eq "u";
73     }
74     else
75     {
76         die "Internal script error";
77     }
78
79     if ($type eq "d")
80     {
81             $type = "#define";
82     }
83     elsif ($type eq "u")
84     {
85             $type = "#undef";
86     }
87     else
88     {
89         die "Internal script error";
90     }
91
92     print $this, " line ", $this_macros{$this_key}[0], " has ", $type, " ",
93           $this_key, " not found in ", $that, "\n";
94 }
95
96
97
98 sub make_config_h
99 {
100     my $quiet;
101     if ($_[0] eq "-q")
102     {
103         $quiet = 1;
104         shift;
105     }
106
107     my ($ph_name, $out_name, $inp_name, $end_name) = @_;
108
109     $ph_name = get_default $ph_name, "../config.h.in";
110     $out_name = get_default $out_name, "config.h.in";
111     $inp_name = get_default $inp_name, $out_name . ".in";
112     $end_name = get_default $end_name, $out_name . ".footer";
113
114     print STDERR "($inp_name + $ph_name) . $end_name --> $out_name\n"
115         if !$quiet;
116
117     #==========================================================================
118     # scan build level configuration to collect define/undef values
119     #==========================================================================
120
121     open FINP, "< $inp_name"
122         or die "error opening ", $inp_name, " for read: $!";
123     my %build_macros;
124     while (<FINP>)
125     {
126         if (/^#\s*define\s*(\w+)(\s+(.+))?$/)
127         {
128             if (exists $build_macros{$1})
129             {
130                 show_repeat $inp_name, $., $build_macros{$1}[0], $_;
131             }
132             else
133             {
134                 $build_macros{$1} = [$., "d", $3];
135             }
136         }
137         elsif (/^\s*#\s*undef\s+(\w+)/)
138         {
139             if (exists $build_macros{$1})
140             {
141                 show_repeat $inp_name, $., $build_macros{$1}[0], $_;
142             }
143             else
144             {
145                 $build_macros{$1} = [$., "u"];
146             }
147         }
148     }
149     close FINP;
150     #==========================================================================
151
152     #==========================================================================
153     # temporary output file
154     #==========================================================================
155     my $temp_name = basename($out_name) . ".tmp";
156
157     open FOUT, "> $temp_name"
158         or die "error opening ", $temp_name, " for write: $!";
159
160     #==========================================================================
161     # copy build level configuration append file to output file
162     #==========================================================================
163     my $base_out = basename $out_name;
164     my $base_prog = basename $0;
165     my $base_inp = basename $inp_name;
166     my $base_ph = basename $ph_name;
167     my $base_end = basename $end_name;
168
169     print FOUT <<EOF;
170 /***
171  *** $base_out, generated by $base_prog:
172  ***
173  ***   ($base_inp
174  ***    + ../$base_ph)
175  ***   . $base_end
176  ***   --> $base_out
177  ***
178  *** ***** DO NOT ALTER THIS FILE!!! *****
179  ***
180  *** Changes to this file will be overwritten by automatic script runs.
181  *** Changes should be made to the $base_inp & $base_end
182  *** files instead.
183  ***/
184
185 EOF
186
187     #==========================================================================
188     # copy root level configuration to output file
189     # while keeping track of conditional compile nesting level
190     #==========================================================================
191     open FINP, "< $ph_name"
192         or die "error opening ", $ph_name, " for read: $!";
193     my %ph_macros;
194     while (<FINP>)
195     {
196
197         my $out_line = $_;
198
199         if (/^\s*#\s*undef\s+(\w+)/)
200         {
201             if (exists $ph_macros{$1})
202             {
203                     show_repeat $ph_name, $., $ph_macros{$1}[0], $_;
204             }
205             else
206             {
207                     $ph_macros{$1} = [$., "u"];
208             }
209
210             if (exists $build_macros{$1}
211                 and $build_macros{$1}[1] eq "d")
212             {
213                 $out_line = "#define $1";
214
215                 $out_line .= " " . $build_macros{$1}[2]
216                     if defined $build_macros{$1}[2];
217
218                 $out_line .= "\n";
219             }
220         }
221         print FOUT $out_line;
222     }
223     close FINP;
224     #==========================================================================
225
226     #==========================================================================
227     # copy build level configuration append file to output file
228     #==========================================================================
229     if (open FINP, "< $end_name")
230     {
231         while (<FINP>)
232         {
233                 print FOUT $_;
234         }
235         close FINP;
236     }
237     #==========================================================================
238     close FOUT;
239     #==========================================================================
240
241     #==========================================================================
242     # determine whether output (if any) has changed from last run
243     #==========================================================================
244     my $same = 0;
245
246     if (open FINP, "< $out_name")
247     {
248         open FOUT, "< $temp_name"
249             or die "error opening ", $temp_name, " for read: $!";
250
251         $same = 1;
252         while ($same)
253         {
254             last if eof FINP and eof FOUT;
255             if (eof FINP or eof FOUT or <FINP> ne <FOUT>)
256             {
257                 $same = 0;
258                 last;
259             }
260         }
261         close FOUT;
262         close FINP;
263     }
264
265     #==========================================================================
266     # nag the guilty
267     #==========================================================================
268     my @keys_build = sort keys %build_macros;
269     my @keys_roots = sort keys %ph_macros;
270     my ($idx_build, $idx_roots) = (0, 0);
271     while ($idx_build < @keys_build or $idx_roots < @keys_roots) {
272         if ($idx_build >= @keys_build)
273         {
274             show_orphan 0, $inp_name, $ph_name, $keys_roots[$idx_roots],
275                         %ph_macros;
276             $idx_roots++;
277         }
278         elsif ($idx_roots >= @keys_roots)
279         {
280             show_orphan 1, $ph_name, $inp_name, $keys_build[$idx_build],
281                            %build_macros;
282             $idx_build++;
283         }
284         elsif ($keys_build[$idx_build] gt $keys_roots[$idx_roots])
285         {
286             show_orphan 0, $inp_name, $ph_name, $keys_roots[$idx_roots],
287                         %ph_macros;
288             $idx_roots++;
289         }
290         elsif ($keys_roots[$idx_roots] gt $keys_build[$idx_build])
291         {
292             show_orphan 1, $ph_name, $inp_name, $keys_build[$idx_build],
293                         %build_macros;
294             $idx_build++;
295         }
296         else
297         {
298             $idx_build++;
299             $idx_roots++;
300         }
301     }
302
303     #==========================================================================
304     # save output only if changed
305     #==========================================================================
306     save_edit $same, $out_name, $temp_name;
307 }
308
309
310
311 ###
312 ### MAIN
313 ###
314 make_config_h @ARGV;