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