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;