Backport some commits from Zefram

[metaconfig.git] / bin / mconfig

diff --git a/bin/mconfig b/bin/mconfig
index 3ce6c63..698d118 100755 (executable)
--- a/bin/mconfig
+++ b/bin/mconfig
@@ -1,15 +1,20 @@
-#!/pro/bin/perl
+#!/usr/bin/perl
 
 use sort "stable";
 BEGIN { $ENV{LC_ALL} = "C"; }
-chdir "/pro/3gl/CPAN/perl";
-{   my @Cc = qw( Configure config_h.SH );
-    system "chown merijn @Cc";
-    chmod 0775, @Cc;
-    #-d "merijn" or mkdir "merijn";
-    #system "cp -f Configure config_h.SH Porting/Glossary Porting/config.sh merijn/";
-    system "ls", "-l", @Cc;
-    }
+
+use FindBin;
+use Getopt::Std;
+
+$p5_metaconfig_base = "$FindBin::Bin/../";
+chdir "$p5_metaconfig_base/perl" or
+    die "perl/ directory missing in $p5_metaconfig_base\n";
+
+-w 'Configure' && -w 'config_h.SH' or
+    die "both Configure and config_h.SH must be writable\n";
+
+-l '.package' && -l 'U' or
+    die ".package and U should be symlinks as per README\n";
 
 # $Id: mconfig.SH 22 2008-05-28 08:01:59Z rmanfredi $
 #
@@ -46,15 +51,16 @@ chdir "/pro/3gl/CPAN/perl";
 
 # Perload ON
 
-$MC = '/pro/3gl/CPAN/lib/dist';
+$MC = "$p5_metaconfig_base/dist";
 $version = '3.5';
 $patchlevel = '0';
 $grep = '/usr/bin/grep';
 chop($date = `date`);
 &profile;                                              # Read ~/.dist_profile
-require 'getopts.pl';
-&usage unless &Getopts("dhkmoOstvwGMVL:");
+&usage unless getopts("dhkmoOstvwGMVL:X:");
 
+my %excluded_symbol;
+read_exclusions($opt_X) if defined $opt_X;
 $MC = $opt_L if $opt_L;                        # May override public library path
 $MC = &tilda_expand($MC);              # ~name expansion
 chop($WD = `pwd`);                             # Working directory
@@ -93,7 +99,7 @@ if ($opt_k) {
 } else {
        `rm -rf .MT 2>&1`;
 }
-system "/pro/bin/perl", "Porting/config_h.pl";
+system $^X, "Porting/config_h.pl";
 print "Done.\n" unless $opt_s;
 
 # General initializations
@@ -150,6 +156,7 @@ Usage: metaconfig [-dhkmostvwGMV] [-L dir]
   -L : specify main units repository.
   -M : activate production of confmagic.h.
   -V : print version number and exits.
+  -X FILE : read symbol exclusions from FILE
 EOH
        exit 1;
 }
@@ -520,6 +527,9 @@ sub p_wanted {
                $cmaster{$_} = undef;                                   # Asks for look-up in C files
                $cwanted{$_} = "$active" if $active;    # Shell symbols to activate
        }
+
+       delete @cmaster{keys %excluded_symbol};
+       delete @cwanted{keys %excluded_symbol};
 }
 
 # Process the ?INIT: lines
@@ -803,6 +813,25 @@ sub q {
        $_;
 }
 
+sub read_exclusions {
+       my ($filename) = @_;
+       print "Reading exclusions from $filename...\n" unless $opt_s;
+       open(EXCLUSIONS, "< $filename\0") || die "Can't read $filename: $!\n";
+       local $_;
+       while (<EXCLUSIONS>) {
+               if (/^\s*#|^\s*$/) {
+                       # comment or blank line, ignore
+               }
+               elsif (/^\s*(\w+)\s*$/) {
+                       $excluded_symbol{$1} = 1;
+               }
+               else {
+                       die "$filename:$.: unrecognised line\n";
+               }
+       }
+       close(EXCLUSIONS) || die "Can't close $filename: $!\n";
+}
+
 # Build a wanted file from the files held in @SHlist and @clist arrays
 sub build_wanted {
        # If wanted file is already there, parse it to map obsolete if -o option
@@ -1297,7 +1326,7 @@ sub process_command {
                        warn "\t    $msg\n";
                }
        }
-       die "Can't open $file.\n" unless open(UNIT, $file);
+       die "Can't open UNIT (name: $name, target: $target) $file.\n" unless open(UNIT, $file);
        print "\t$cmd $file\n" if $opt_v;
        &init_interp;                                           # Initializes the interpreter
 
@@ -1435,7 +1464,7 @@ sub process_command {
                        open(PREPEND, ">.prepend") ||
                                die "Can't create .MT/.prepend.\n";
                        open(TARGET, $Unit{$target}) ||
-                               die "Can't open $Unit{$target}.\n";
+                               die "Can't open Unit $Unit{$target}.\n";
                        while (<TARGET>) {
                                print PREPEND unless &skipped;
                        }