dist-3.0at70b/mcon/pl/xwant.pl

   1 ;# $Id: xwant.pl,v 3.0 1993/08/18 12:10:32 ram Exp $
   2 ;#
   3 ;#  Copyright (c) 1991-1993, Raphael Manfredi
   4 ;#
   5 ;#  You may redistribute only under the terms of the Artistic Licence,
   6 ;#  as specified in the README file that comes with the distribution.
   7 ;#  You may reuse parts of this distribution only within the terms of
   8 ;#  that same Artistic Licence; a copy of which may be found at the root
   9 ;#  of the source tree for dist 3.0.
  10 ;#
  11 ;# $Log: xwant.pl,v $
  12 ;# Revision 3.0  1993/08/18  12:10:32  ram
  13 ;# Baseline for dist 3.0 netwide release.
  14 ;#
  15 ;#
  16 ;# These two arrays record the file names of the files which may (or may not)
  17 ;# contain shell or C symbols known by metaconfig.
  18 ;#  @SHlist records the .SH files
  19 ;#  @clist records the C-like files (i.e. .[chyl])
  20 ;#
  21 # Parse files and build cross references
  22 sub build_xref {
  23         print "Building cross-reference files...\n" unless $opt_s;
  24         unless (-f $NEWMANI) {
  25                 &manifake;
  26                 die "No $NEWMANI--don't know who to scan.\n" unless -f $NEWMANI;
  27         }
  28
  29         open(FUI, "|sort | uniq >I.fui") || die "Can't create I.fui.\n";
  30         open(UIF, "|sort | uniq >I.uif") || die "Can't create I.uif.\n";
  31
  32         local($search);                                                 # Where to-be-evaled script is held
  33         local($_) = ' ' x 50000 if $opt_m;              # Pre-extend pattern search space
  34         local(%visited);                                                # Records visited files
  35         local(%lastfound);                                              # Where last occurence of key was
  36
  37         # Map shell symbol names to units by reverse engineering the @Master array
  38         # which records all the known shell symbols and the units where they
  39         # are defined.
  40         foreach $init (@Master) {
  41                 $init =~ /^\?(.*):(.*)=''/ && ($shwanted{"\$$2"} = $1);
  42         }
  43
  44         # Now we are a little clever, and build a loop to eval so that we don't
  45         # have to recompile our patterns on every file.  We also use "study" since
  46         # we are searching the same string for many different things.  Hauls!
  47
  48         if (@clist) {
  49                 print "    Scanning .[chyl] files for symbols...\n" unless $opt_s;
  50                 $search = ' ' x (40 * (@cmaster + @ocmaster));  # Pre-extend
  51                 $search = "while (<>) {study;\n";                               # Init loop over ARGV
  52                 foreach $key (keys(cmaster)) {
  53                         $search .= "\$cmaster{'$key'} .= \"\$ARGV#\" if /\\b$key\\b/;\n";
  54                 }
  55                 foreach $key (grep(!/^\$/, keys %Obsolete)) {
  56                         $search .= "&ofound('$key') if /\\b$key\\b/;\n";
  57                 }
  58                 $search .= "}\n";                       # terminate loop
  59                 print $search if $opt_d;
  60                 @ARGV = @clist;
  61                 # Swallow each file as a whole, if memory is available
  62                 undef $/ if $opt_m;
  63                 eval $search;
  64                 eval '';
  65                 $/ = "\n";
  66                 while (($key,$value) = each(cmaster)) {
  67                         next if $value eq '';
  68                         foreach $file (sort(split(/#/, $value))) {
  69                                 next if $file eq '';
  70                                 # %cwanted may contain value separated by \n -- take last one
  71                                 @sym = split(/\n/, $cwanted{$key});
  72                                 $sym = pop(@sym);
  73                                 $shell = "\$$sym";
  74                                 print FUI
  75                                         pack("A35", $file),
  76                                         pack("A20", "$shwanted{$shell}.U"),
  77                                         $key, "\n";
  78                                 print UIF
  79                                         pack("A20", "$shwanted{$shell}.U"),
  80                                         pack("A25", $key),
  81                                         $file, "\n";
  82                         }
  83                 }
  84         }
  85
  86         undef @clist;
  87         undef %cwanted;
  88         undef %cmaster;         # We're not building Configure, we may delete this
  89         %visited = ();
  90         %lastfound = ();
  91
  92         if (@SHlist) {
  93                 print "    Scanning .SH files for symbols...\n" unless $opt_s;
  94                 $search = ' ' x (40 * (@shmaster + @oshmaster));        # Pre-extend
  95                 $search = "while (<>) {study;\n";
  96                 # All the keys already have a leading '$'
  97                 foreach $key (keys(shmaster)) {
  98                         $search .= "\$shmaster{'$key'} .= \"\$ARGV#\" if /\\$key\\b/;\n";
  99                 }
 100                 foreach $key (grep (/^\$/, keys %Obsolete)) {
 101                         $search .= "&ofound('$key') if /\\$key\\b/;\n";
 102                 }
 103                 $search .= "}\n";
 104                 print $search if $opt_d;
 105                 @ARGV = @SHlist;
 106                 # Swallow each file as a whole, if memory is available
 107                 undef $/ if $opt_m;
 108                 eval $search;
 109                 eval '';
 110                 $/ = "\n";
 111                 while (($key,$value) = each(shmaster)) {
 112                         next if $value eq '';
 113                         foreach $file (sort(split(/#/, $value))) {
 114                                 next if $file eq '';
 115                                 print FUI
 116                                         pack("A35", $file),
 117                                         pack("A20", "$shwanted{$key}.U"),
 118                                         $key, "\n";
 119                                 print UIF
 120                                         pack("A20", "$shwanted{$key}.U"),
 121                                         pack("A25", $key),
 122                                         $file, "\n";
 123                         }
 124                 }
 125         }
 126
 127         close FUI;
 128         close UIF;
 129
 130         # If obsolete symbols where found, write an Obsolete file which lists where
 131         # each of them appear and the new symbol to be used. Also write Obsol_h.U
 132         # and Obsol_sh.U in .MT for later perusal.
 133
 134         &dump_obsolete;                                         # Dump obsolete symbols if any
 135
 136         # Clean-up memory by freeing useless data structures
 137         undef @SHlist;
 138         undef %shmaster;
 139 }
 140
 141 # This routine records matches of obsolete keys (C or shell)
 142 sub ofound {
 143         local($key) = @_;
 144         local($_) = $Obsolete{$key};            # Value of new symbol
 145         $ofound{"$ARGV $key $_"}++;                     # Record obsolete match
 146         $cmaster{$_} .= "$ARGV#" unless /^\$/;  # A C hit
 147         $shmaster{$_} .= "$ARGV#" if /^\$/;             # Or a shell one
 148 }
 149