summaryrefslogtreecommitdiff
path: root/mcon/pl/wanted.pl
blob: b9626ef2943b63e4be445cd509a38e24adb1c80a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
;# $Id: wanted.pl 1 2006-08-24 12:32:52Z rmanfredi $
;#
;#  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
;#  
;#  You may redistribute only under the terms of the Artistic Licence,
;#  as specified in the README file that comes with the distribution.
;#  You may reuse parts of this distribution only within the terms of
;#  that same Artistic Licence; a copy of which may be found at the root
;#  of the source tree for dist 4.0.
;#
;# $Log: wanted.pl,v $
;# Revision 3.0.1.2  1995/01/11  15:42:37  ram
;# patch45: added % in front of hash table names for perl5's each() (ADO)
;# patch45: tell users about possible extra file-extension lookups
;#
;# Revision 3.0.1.1  1993/10/16  13:56:05  ram
;# patch12: modified to handle ?M: lines
;# patch12: added warning when magic symbols used without proper config
;#
;# Revision 3.0  1993/08/18  12:10:29  ram
;# Baseline for dist 3.0 netwide release.
;#
;# 
;# These two arrays record the file names of the files which may (or may not)
;# contain shell or C symbols known by metaconfig.
;#  @SHlist records the .SH files
;#  @clist records the C-like files (i.e. .[chyl])
;#
;# These files are scanned in turn to see how many symbols known by metaconfig
;# they have. Those symbols are gathered in a Wanted file. As C symbols are
;# not true targets for the forthcoming Makefile, a ">" sign is prepended.
;# Finally, the obsolete symbols are preceded by a "!".
;#
;# When obsolete symbols are found, they are dumped in file 'Obsolete'. Two
;# files are created anyway in the .MT directory. Obsol_h.U and Obsol_sh.U which
;# respectively list the obsoleted symbols (C and shell ones).
;#  Obsol_h.U records obsolete C symbols
;#  Obsol_sh.U records obsolete shell symbols
;#
;# The manifake() routine has to be provided externally.
;#
# 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
	# was used. Otherwise, build a new one.
	if (-f 'Wanted') {
		&map_obsolete if $opt_o;			# Build Obsol*.U files
		&dump_obsolete;						# Dump obsolete symbols if any
		return;
	}
	&parse_files;
}

sub parse_files {
	print "Building a Wanted file...\n" unless $opt_s;
	open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n";
	unless (-f $NEWMANI) {
		&manifake;
		die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI;
	}

	local($search);							# Where to-be-evaled script is held
	local($_) = ' ' x 50000 if $opt_m;		# Pre-extend pattern search space
	local(%visited);						# Records visited files
	local(%lastfound);						# Where last occurence of key was

	# Now we are a little clever, and build a loop to eval so that we don't
	# have to recompile our patterns on every file.  We also use "study" since
	# we are searching the same string for many different things.  Hauls!

	if (@clist) {
		local($others) = $cext ? " $cext" : '';
		print "    Scanning .[chyl]$others files for symbols...\n"
			unless $opt_s;
		$search = ' ' x (40 * (@cmaster + @ocmaster));	# Pre-extend
		$search = "while (<>) {study;\n";				# Init loop over ARGV
		foreach $key (keys(%cmaster)) {
			$search .= "&cmaster('$key') if /\\b$key\\b/;\n";
		}
		foreach $key (grep(!/^\$/, keys %Obsolete)) {
			$search .= "&ofound('$key') if /\\b$key\\b/;\n";
		}
		$search .= "}\n";			# terminate loop
		print $search if $opt_d;
		@ARGV = @clist;
		# Swallow each file as a whole, if memory is available
		undef $/ if $opt_m;
		eval $search;
		eval '';
		$/ = "\n";
		while (($key,$value) = each(%cmaster)) {
			print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value;
		}
	}

	# If they don't use magic but use magically guarded symbols without
	# their corresponding C symbol dependency, warn them, since they might
	# not know about that portability issue.

	if (@clist && !$opt_M) {
		local($nused);					# list of non-used symbols
		local($warning) = 0;			# true when one warning issued
		foreach $cmag (keys %mwanted) {	# loop over all used magic symbols
			next unless $cmaster{$cmag};
			$nused = '';
			foreach $cdep (split(' ', $mwanted{$cmag})) {
				$nused .= " $cdep" unless $cmaster{$cdep};
			}
			$nused =~ s/^ //;
			$nused = "one of " . $nused if $nused =~ s/ /, /g;
			if ($nused ne '') {
				print "    Warning: $cmag is used without $nused.\n";
				$warning++;
			}
		}
		if ($warning) {
			local($those) = $warning == 1 ? 'that' : 'those';
			local($s) = $warning == 1 ? '' : 's';
			print "Note: $those previous warning$s may be suppressed by -M.\n";
		}
	}

	# Cannot remove $cmaster as it is used later on when building Configure
	undef @clist;
	undef %cwanted;
	undef %mwanted;
	%visited = ();
	%lastfound = ();

	if (@SHlist) {
		local($others) = $shext ? " $shext" : '';
		print "    Scanning .SH$others files for symbols...\n" unless $opt_s;
		$search = ' ' x (40 * (@shmaster + @oshmaster));	# Pre-extend
		$search = "while (<>) {study;\n";
		# All the keys already have a leading '$'
		foreach $key (keys(%shmaster)) {
			$search .= "&shmaster('$key') if /\\$key\\b/;\n";
		}
		foreach $key (grep (/^\$/, keys %Obsolete)) {
			$search .= "&ofound('$key') if /\\$key\\b/;\n";
		}
		$search .= "}\n";
		print $search if $opt_d;
		@ARGV = @SHlist;
		# Swallow each file as a whole, if memory is available
		undef $/ if $opt_m;
		eval $search;
		eval '';
		$/ = "\n";
		while (($key,$value) = each(%shmaster)) {
			if ($value) {
				$key =~ s/^\$//;
				print WANTED $key, "\n";
			}
		}
	}

	# Obsolete symbols, if any, are written in the Wanted file preceded by a
	# '!' character. In case -w is used, we'll thus be able to correctly build
	# the Obsol_h.U and Obsol_sh.U files.

	&add_obsolete;						# Add obsolete symbols in Wanted file

	close WANTED;

	# If obsolete symbols where found, write an Obsolete file which lists where
	# each of them appear and the new symbol to be used. Also write Obsol_h.U
	# and Obsol_sh.U in .MT for later perusal.

	&dump_obsolete;						# Dump obsolete symbols if any

	die "No desirable symbols found--aborting.\n" unless -s 'Wanted';

	# Clean-up memory by freeing useless data structures
	undef @SHlist;
	undef %shmaster;
}

# This routine records matches of C master keys
sub cmaster {
	local($key) = @_;
	$cmaster{$key}++;					# This symbol is wanted
	return unless $opt_t || $opt_M;		# Return if neither -t nor -M
	if ($opt_t &&
		$lastfound{$key} ne $ARGV		# Never mentionned for this file ?
	) {
		$visited{$ARGV}++ || print $ARGV,":\n";
		print "\t$key\n";
		$lastfound{$key} = $ARGV;
	}
	if ($opt_M &&
		defined($mwanted{$key})			# Found a ?M: symbol
	) {
		foreach $csym (split(' ', $mwanted{$key})) {
			$cmaster{$csym}++;			# Activate C symbol dependencies
		}
	}
}

# This routine records matches of obsolete keys (C or shell)
sub ofound {
	local($key) = @_;
	local($_) = $Obsolete{$key};		# Value of new symbol
	$ofound{"$ARGV $key $_"}++;			# Record obsolete match
	$cmaster{$_}++ unless /^\$/;		# A C hit
	$shmaster{$_}++ if /^\$/;			# Or a shell one
	return unless $opt_t;				# Continue if trace option on
	if ($lastfound{$key} ne $ARGV) {	# Never mentionned for this file ?
		$visited{$ARGV}++ || print $ARGV,":\n";
		print "\t$key (obsolete, use $_)\n";
		$lastfound{$key} = $ARGV;
	}
}

# This routine records matches of shell master keys
sub shmaster {
	local($key) = @_;
	$shmaster{$key}++;					# This symbol is wanted
	return unless $opt_t;				# Continue if trace option on
	if ($lastfound{$key} ne $ARGV) {	# Never mentionned for this file ?
		$visited{$ARGV}++ || print $ARGV,":\n";
		print "\t$key\n";
		$lastfound{$key} = $ARGV;
	}
}

# Write obsolete symbols into the Wanted file for later perusal by -w.
sub add_obsolete {
	local($file);						# File where obsolete symbol was found
	local($old);						# Name of this old symbol
	local($new);						# Value of the new symbol to be used
	foreach $key (sort keys %ofound) {
		($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
		if ($new =~ s/^\$//) {			# We found an obsolete shell symbol
			print WANTED "!$old\n";
		} else {						# We found an obsolete C symbol
			print WANTED "!>$old\n";
		}
	}
}

# Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete
# to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed
# during the Configure building phase to actually do the remaping.
# The obsolete symbols found are entered in the %ofound array, tagged as from
# file 'XXX', which is specially recognized by dump_obsolete.
sub map_obsolete {
	open(WANTED, 'Wanted') || die "Can't open Wanted file.\n";
	local($new);				# New symbol to be used instead of obsolete one
	while (<WANTED>) {
		chop;
		next unless s/^!//;		# Skip non-obsolete symbols
		if (s/^>//) {					# C symbol
			$new = $Obsolete{$_};		# Fetch new symbol
			$ofound{"XXX $_ $new"}++;	# Record obsolete match (XXX = no file)
		} else {						# Shell symbol
			$new = $Obsolete{"\$$_"};	# Fetch new symbol
			$ofound{"XXX \$$_ $new"}++;	# Record obsolete match (XXX = no file)
		}
	}
	close WANTED;
}