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
|
;# $Id$
;#
;# 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: locate.pl,v $
;# Revision 3.0.1.1 1994/10/29 16:36:52 ram
;# patch36: misspelled a 'closedir' as a 'close' statement
;#
;# Revision 3.0 1993/08/18 12:10:25 ram
;# Baseline for dist 3.0 netwide release.
;#
;#
;# Locate units and put them in the @ARGV array, for later perusal. We first
;# look in the private U directory, then in the public U library. In each U
;# directory, units may be gathered in clusters (directories). These clusters
;# should not have a name ending with .U, as those will never be stat()'ed.
;#
;# NB: Currently, the clusters are only a practical way of grouping a set of
;# closely related units. There must not be any name conflicts.
;#
;# The following variables are used:
;# $WD is assumed to be the working directory (where the process was spawned)
;# $MC is the location of metaconfig's public library
;# @ARGV is the list of all the units full path
;# %Unit maps an unit name (without final .U) to a path
;# @myUlist lists the user's units, which will be appended at the end of @ARGV
;# %myUseen lists the user's units which overwrite public ones
;#
package locate;
# Locate the units and push their path in @ARGV (sorted alphabetically)
sub main'locate_units {
print "Locating units...\n" unless $main'opt_s;
local(*WD) = *main'WD; # Current working directory
local(*MC) = *main'MC; # Public metaconfig library
undef %myUlist; # Records private units paths
undef %myUseen; # Records private/public conflicts
&private_units; # Locate private units in @myUlist
&public_units; # Locate public units in @ARGV
@ARGV = sort @ARGV; # Sort it alphabetically
push(@ARGV, sort @myUlist); # Append user's units sorted
&dump_list if $main'opt_v; # Dump the list of units
}
# Dump the list of units on stdout
sub dump_list {
print "\t";
$, = "\n\t";
print @ARGV;
$, = '';
print "\n";
}
# Scan private units
sub private_units {
return unless -d 'U'; # Nothing to be done if no 'U' entry
local(*ARGV) = *myUlist; # Really fill in @myUlist
local($MC) = $WD; # We are really in the working directory
&units_path("U"); # Locate units in the U directory
local($unit_name); # Unit's name (without .U)
local(@kept); # Array of kept units
# Loop over the units and remove duplicates (the first one seen is the one
# we keep). Also set the %myUseen H table to record private units seen.
foreach (@ARGV) {
($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
next if $myUseen{$unit_name}; # Already recorded
$myUseen{$unit_name} = 1; # Record pirvate unit
push(@kept, $_); # Keep this unit
}
@ARGV = @kept;
}
# Scan public units
sub public_units {
chdir($MC) || die "Can't find directory $MC.\n";
&units_path("U"); # Locate units in public U directory
chdir($WD) || die "Can't go back to directory $WD.\n";
local($path); # Relative path from $WD
local($unit_name); # Unit's name (without .U)
local(*Unit) = *main'Unit; # Unit is a global from main package
local(@kept); # Units kept
local(%warned); # Units which have already issued a message
# Loop over all the units and keep only the ones that were not found in
# the user's U directory. As it is possible two or more units with the same
# name be found in
foreach (@ARGV) {
($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
next if $warned{$unit_name}; # We have already seen this unit
$warned{$unit_name} = 1; # Remember we have warned the user
if ($myUseen{$unit_name}) { # User already has a private unit
$path = $Unit{$unit_name}; # Extract user's unit path
next if $path eq $_; # Same path, we must be in mcon/
$path =~ s|^$WD/||o; # Weed out leading working dir path
print " Your private $path overrides the public one.\n"
unless $main'opt_s;
} else {
push(@kept, $_); # We may keep this one
}
}
@ARGV = @kept;
}
# Recursively locate units in the directory. Each file ending with .U has to be
# a unit. Others are stat()'ed, and if they are a directory, they are also
# scanned through. The $MC and @ARGV variable are dynamically set by the caller.
sub units_path {
local($dir) = @_; # Directory where units are to be found
local(@contents); # Contents of the directory
local($unit_name); # Unit's name, without final .U
local($path); # Full path of a unit
local(*Unit) = *main'Unit; # Unit is a global from main package
unless (opendir(DIR, $dir)) {
warn("Cannot open directory $dir.\n");
return;
}
print "Locating in $MC/$dir...\n" if $main'opt_v;
@contents = readdir DIR; # Slurp the whole thing
closedir DIR; # And close dir, ready for recursion
foreach (@contents) {
next if $_ eq '.' || $_ eq '..';
if (/\.U$/) { # A unit, definitely
($unit_name) = /^(.*)\.U$/;
$path = "$MC/$dir/$_"; # Full path of unit
push(@ARGV, $path); # Record its path
if (defined $Unit{$unit_name}) { # Already seen this unit
if ($main'opt_v) {
($path) = $Unit{$unit_name} =~ m|^(.*)/.*|;
print " We've already seen $unit_name.U in $path.\n";
}
} else {
$Unit{$unit_name} = $path; # Map name to path
}
next;
}
# We have found a file which does not look like a unit. If it is a
# directory, then scan it. Otherwise skip the file.
unless (-d "$dir/$_") {
print " Skipping file $_ in $dir.\n" if $main'opt_v;
next;
}
&units_path("$dir/$_");
print "Back to $MC/$dir...\n" if $main'opt_v;
}
}
package main;
|
