1#! perl -w
2
3use strict;
4
5# For the `mv' function which is smart enough to cross device boundries.
6use File::Copy qw{mv};
7# For the `basename' function.
8use File::Basename;
9
10
11
12###
13### FUNCTIONS
14###
15sub 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
34sub 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
48sub 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
57sub 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
98sub 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
185EOF
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###
314make_config_h @ARGV;
315