Porting/checkcfgvar.pl

   1 #!/usr/bin/perl
   2
   3 # Check that the various config.sh-clones have (at least) all the
   4 # same symbols as the top-level config_h.SH so that the (potentially)
   5 # needed symbols are not lagging after how Configure thinks the world
   6 # is laid out.
   7 #
   8 # VMS is probably not handled properly here, due to their own
   9 # rather elaborate DCL scripting.
  10 #
  11
  12 use strict;
  13 use warnings;
  14 use autodie;
  15
  16 sub usage
  17 {
  18     my $err = shift and select STDERR;
  19     print "usage: $0 [--list] [--regen] [--default=value]\n";
  20     exit $err;
  21     } # usage
  22
  23 use Getopt::Long;
  24 my $opt_l = 0;
  25 my $opt_r = 0;
  26 my $default;
  27 GetOptions (
  28     "help|?"    => sub { usage (0); },
  29     "l|list!"   => \$opt_l,
  30     "regen"     => \$opt_r,
  31     "default=s" => \$default,
  32     ) or usage (1);
  33
  34 require 'regen/regen_lib.pl' if $opt_r;
  35
  36 my $MASTER_CFG = "config_h.SH";
  37 # Inclusive bounds on the main part of the file, $section == 1 below:
  38 my $first = qr/^Author=/;
  39 my $last = qr/^zip=/;
  40
  41 my @CFG = (
  42            # we check from MANIFEST whether they are expected to be present.
  43            # We can't base our check on $], because that's the version of the
  44            # perl that we are running, not the version of the source tree.
  45            "Cross/config.sh-arm-linux",
  46            "epoc/config.sh",
  47            "NetWare/config.wc",
  48            "symbian/config.sh",
  49            "uconfig.sh",
  50            "uconfig64.sh",
  51            "plan9/config_sh.sample",
  52            "win32/config.gc",
  53            "win32/config.gc64",
  54            "win32/config.gc64nox",
  55            "win32/config.vc",
  56            "win32/config.vc64",
  57            "win32/config.ce",
  58            "configure.com",
  59            "Porting/config.sh",
  60           );
  61
  62 my @MASTER_CFG;
  63 {
  64     my %seen;
  65     open my $fh, '<', $MASTER_CFG;
  66     while (<$fh>) {
  67         while (/[^\\]\$([a-z]\w+)/g) {
  68             my $v = $1;
  69             next if $v =~ /^(CONFIG_H|CONFIG_SH)$/;
  70             $seen{$v}++;
  71         }
  72     }
  73     close $fh;
  74     @MASTER_CFG = sort keys %seen;
  75 }
  76
  77 my %MANIFEST;
  78
  79 {
  80     open my $fh, '<', 'MANIFEST';
  81     while (<$fh>) {
  82         $MANIFEST{$1}++ if /^(.+?)\t/;
  83     }
  84     close $fh;
  85 }
  86
  87 for my $cfg (sort @CFG) {
  88     unless (exists $MANIFEST{$cfg}) {
  89         print STDERR "[skipping not-expected '$cfg']\n";
  90         next;
  91     }
  92     my %cfg;
  93     my $section = 0;
  94     my @lines;
  95
  96     open my $fh, '<', $cfg;
  97
  98     if ($cfg eq 'configure.com') {
  99         ++$cfg{startperl}; # Cheat.
 100
 101         while (<$fh>) {
 102             next if /^\#/ || /^\s*$/ || /^\:/;
 103             s/(\s*!.*|\s*)$//; # remove trailing comments or whitespace
 104             ++$cfg{$1} if /^\$\s+WC "(\w+)='(?:.*)'"$/;
 105         }
 106     } else {
 107         while (<$fh>) {
 108             if ($_ =~ $first) {
 109                 die "$cfg:$.:section=$section:$_" unless $section == 0;
 110                 $section = 1;
 111             }
 112             push @{$lines[$section]}, $_;
 113             next if /^\#/ || /^\s*$/ || /^\:/;
 114             if ($_ =~ $last) {
 115                 die "$cfg:$.:section=$section:$_" unless $section == 1;
 116                 $section = 2;
 117             }
 118             # foo='bar'
 119             # foo=bar
 120             # (optionally with a trailing comment)
 121             if (/^(\w+)=(?:'.*'|[^'].*)(?: #.*)?$/) {
 122                 ++$cfg{$1};
 123             } else {
 124                 warn "$cfg:$.:$_";
 125             }
 126         }
 127     }
 128     close $fh;
 129
 130     my $missing;
 131     if ($cfg eq 'configure.com'
 132         || join("", @{$lines[1]}) eq join("", sort @{$lines[1]})) {
 133         # All is good with the world.
 134     } elsif ($opt_r || $opt_l) {
 135         # A reference to an empty array is true, hence this flags the
 136         # file for later attention by --regen and --list, even if
 137         # nothing is missing. Actual sort and output are done later.
 138         $missing = [];
 139     } else {
 140         print "$cfg: unsorted\n"
 141     }
 142
 143     for my $v (@MASTER_CFG) {
 144         # This only creates a reference in $missing if something is missing:
 145         push @$missing, $v unless exists $cfg{$v};
 146     }
 147
 148     if ($missing) {
 149         if ($opt_l) {
 150             # print the name once, however many problems
 151             print "$cfg\n";
 152         } elsif ($opt_r && $cfg ne 'configure.com') {
 153             if (defined $default) {
 154                 push @{$lines[1]}, map {"$_='$default'\n"} @$missing;
 155             } else {
 156                 print "$cfg: missing '$_', use --default to add it\n"
 157                     foreach @$missing;
 158             }
 159
 160             @{$lines[1]} = sort @{$lines[1]};
 161             my $fh = open_new($cfg);
 162             print $fh @{$_} foreach @lines;
 163             close_and_rename($fh);
 164         } else {
 165             print "$cfg: missing '$_'\n" foreach @$missing;
 166         }
 167     }
 168 }