|
Lines 31-61
Link Here
|
| 31 |
# $FreeBSD: src/usr.bin/whereis/whereis.pl,v 1.8 1999/08/28 01:07:37 peter Exp $ |
31 |
# $FreeBSD: src/usr.bin/whereis/whereis.pl,v 1.8 1999/08/28 01:07:37 peter Exp $ |
| 32 |
# |
32 |
# |
| 33 |
|
33 |
|
|
|
34 |
use strict; |
| 35 |
|
| 34 |
sub usage |
36 |
sub usage |
| 35 |
{ |
37 |
{ |
| 36 |
print STDERR "usage: $0 [-bms] [-u] [-BMS dir... -f] name ...\n"; |
38 |
warn "usage: $0 [-bms] [-u] [-BMS dir... -f] name ...\n"; |
| 37 |
exit 1; |
39 |
exit 1; |
| 38 |
} |
40 |
} |
| 39 |
|
41 |
|
|
|
42 |
my $opt_b = 0; |
| 43 |
my $opt_m = 0; |
| 44 |
my $opt_s = 0; |
| 45 |
my $opt_u = 0; |
| 46 |
my $manpath; |
| 47 |
my(@binaries, @manuals, @sources, @names); |
| 48 |
|
| 49 |
|
| 40 |
sub scanopts |
50 |
sub scanopts |
| 41 |
{ |
51 |
{ |
| 42 |
local($i, $j); |
52 |
my($i, $j); |
|
|
53 |
$i = 0; |
| 43 |
arg: |
54 |
arg: |
| 44 |
while ($ARGV[$i] =~ /^-/) { |
55 |
while ($ARGV[$i] =~ /^-/) { |
| 45 |
opt: |
56 |
opt: |
| 46 |
for ($j = 1; $j < length($ARGV[$i]); $j++) { |
57 |
for ($j = 1; $j < length($ARGV[$i]); ++$j) { |
| 47 |
local($_) = substr($ARGV[$i], $j, 1); |
58 |
local($_) = substr($ARGV[$i], $j, 1); |
| 48 |
local($what, @list); |
59 |
my($what, @list); |
| 49 |
$opt_b++, next opt if /b/; |
60 |
++$opt_b, next opt if /b/; |
| 50 |
$opt_m++, next opt if /m/; |
61 |
++$opt_m, next opt if /m/; |
| 51 |
$opt_s++, next opt if /s/; |
62 |
++$opt_s, next opt if /s/; |
| 52 |
$opt_u++, next opt if /u/; |
63 |
++$opt_u, next opt if /u/; |
| 53 |
&usage unless /[BMS]/; |
64 |
&usage unless /[BMS]/; |
| 54 |
|
65 |
|
| 55 |
# directory list processing |
66 |
# directory list processing |
| 56 |
$what = $_; @list = (); |
67 |
$what = $_; @list = (); |
| 57 |
push(@list, substr($ARGV[$i], $j+1)) if $j+1 < length($ARGV[$i]); |
68 |
push(@list, substr($ARGV[$i], $j+1)) if $j+1 < length($ARGV[$i]); |
| 58 |
$i++; |
69 |
++$i; |
| 59 |
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) { |
70 |
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) { |
| 60 |
push(@list, $ARGV[$i++]); |
71 |
push(@list, $ARGV[$i++]); |
| 61 |
} |
72 |
} |
|
Lines 66-72
Link Here
|
| 66 |
$i++, last arg if $ARGV[$i] =~ /^-f$/; |
77 |
$i++, last arg if $ARGV[$i] =~ /^-f$/; |
| 67 |
next arg; |
78 |
next arg; |
| 68 |
} |
79 |
} |
| 69 |
$i++; |
80 |
++$i; |
| 70 |
} |
81 |
} |
| 71 |
&usage if $i > $#ARGV; |
82 |
&usage if $i > $#ARGV; |
| 72 |
|
83 |
|
|
Lines 78-89
Link Here
|
| 78 |
|
89 |
|
| 79 |
sub decolonify |
90 |
sub decolonify |
| 80 |
{ |
91 |
{ |
| 81 |
local($list) = @_; |
92 |
return split(/:/, shift); |
| 82 |
local($_, @rv); |
|
|
| 83 |
foreach(split(/:/, $list)) { |
| 84 |
push(@rv, $_); |
| 85 |
} |
| 86 |
return @rv; |
| 87 |
} |
93 |
} |
| 88 |
|
94 |
|
| 89 |
|
95 |
|
|
Lines 92-105
Link Here
|
| 92 |
# default to all if no type requested |
98 |
# default to all if no type requested |
| 93 |
if ($opt_b + $opt_m + $opt_s == 0) {$opt_b = $opt_m = $opt_s = 1;} |
99 |
if ($opt_b + $opt_m + $opt_s == 0) {$opt_b = $opt_m = $opt_s = 1;} |
| 94 |
|
100 |
|
| 95 |
if (!defined(@binaries)) { |
101 |
unless (@binaries) { |
| 96 |
# |
102 |
# |
| 97 |
# first, use default path, then append /usr/libexec and the user's path |
103 |
# first, use default path, then append /usr/libexec and the user's path |
| 98 |
# |
104 |
# |
| 99 |
local($cs_path) = `/sbin/sysctl -n user.cs_path`; |
105 |
chop(my($cs_path) = `/sbin/sysctl -n user.cs_path`); |
| 100 |
local(@list, %path); |
106 |
my(@list, %path); |
| 101 |
|
|
|
| 102 |
chop($cs_path); |
| 103 |
|
107 |
|
| 104 |
@list = &decolonify($cs_path); |
108 |
@list = &decolonify($cs_path); |
| 105 |
push(@list, "/usr/libexec"); |
109 |
push(@list, "/usr/libexec"); |
|
Lines 108-140
Link Here
|
| 108 |
# resolve ~, remove duplicates |
112 |
# resolve ~, remove duplicates |
| 109 |
foreach (@list) { |
113 |
foreach (@list) { |
| 110 |
s/^~/$ENV{'HOME'}/ if /^~/; |
114 |
s/^~/$ENV{'HOME'}/ if /^~/; |
| 111 |
push(@binaries, $_) if !$path{$_}; |
115 |
push(@binaries, $_) unless $path{$_}; |
| 112 |
$path{$_}++; |
116 |
++$path{$_}; |
| 113 |
} |
117 |
} |
| 114 |
} |
118 |
} |
| 115 |
|
119 |
|
| 116 |
if (!defined(@manuals)) { |
120 |
unless (@manuals) { |
| 117 |
# |
121 |
# |
| 118 |
# first, use default manpath, then append user's $MANPATH |
122 |
# first, use default manpath, then append user's $MANPATH |
| 119 |
# |
123 |
# |
| 120 |
local($usermanpath) = $ENV{'MANPATH'}; |
124 |
my($usermanpath) = $ENV{'MANPATH'} || ''; |
| 121 |
delete $ENV{'MANPATH'}; |
125 |
delete $ENV{'MANPATH'}; |
| 122 |
local($manpath) = `/usr/bin/manpath`; |
126 |
chop($manpath = `/usr/bin/manpath`); |
| 123 |
local(@list, %path, $i); |
127 |
my(@list, %path); |
| 124 |
|
|
|
| 125 |
chop($manpath); |
| 126 |
|
128 |
|
| 127 |
@list = &decolonify($manpath); |
129 |
@list = &decolonify($manpath); |
| 128 |
push(@list, &decolonify($usermanpath)); |
130 |
push(@list, &decolonify($usermanpath)); |
| 129 |
|
131 |
|
| 130 |
# remove duplicates |
132 |
# remove duplicates |
| 131 |
foreach (@list) { |
133 |
foreach (@list) { |
| 132 |
push(@manuals, $_) if !$path{$_}; |
134 |
push(@manuals, $_) unless $path{$_}; |
| 133 |
$path{$_}++; |
135 |
++$path{$_}; |
| 134 |
} |
136 |
} |
| 135 |
} |
137 |
} |
| 136 |
|
138 |
|
| 137 |
if (!defined(@sources)) { |
139 |
unless (@sources) { |
| 138 |
# |
140 |
# |
| 139 |
# default command sources |
141 |
# default command sources |
| 140 |
# |
142 |
# |
|
Lines 149-154
Link Here
|
| 149 |
# |
151 |
# |
| 150 |
# if /usr/ports exists, look in all its subdirs, too |
152 |
# if /usr/ports exists, look in all its subdirs, too |
| 151 |
# |
153 |
# |
|
|
154 |
local *PORTS; |
| 152 |
if (-d "/usr/ports" && opendir(PORTS, "/usr/ports")) { |
155 |
if (-d "/usr/ports" && opendir(PORTS, "/usr/ports")) { |
| 153 |
while ($_ = readdir(PORTS)) { |
156 |
while ($_ = readdir(PORTS)) { |
| 154 |
next if /^\.\.?$/; |
157 |
next if /^\.\.?$/; |
|
Lines 163-193
Link Here
|
| 163 |
if ($opt_m) { |
166 |
if ($opt_m) { |
| 164 |
# construct a new MANPATH |
167 |
# construct a new MANPATH |
| 165 |
foreach (@manuals) { |
168 |
foreach (@manuals) { |
| 166 |
next if ! -d $_; |
169 |
next unless -d; |
| 167 |
if ($manpath) { $manpath .= ":$_"; } |
170 |
$manpath .= $manpath ? ":$_" : $_; |
| 168 |
else { $manpath = $_; } |
|
|
| 169 |
} |
171 |
} |
| 170 |
} |
172 |
} |
| 171 |
|
173 |
|
| 172 |
# |
174 |
# |
| 173 |
# main loop |
175 |
# main loop |
| 174 |
# |
176 |
# |
| 175 |
foreach $name (@names) { |
177 |
foreach my $name (@names) { |
| 176 |
$name =~ s|^.*/||; # strip leading path name component |
178 |
$name =~ s|^.*/||; # strip leading path name component |
| 177 |
$name =~ s/,v$//; $name =~ s/^s\.//; # RCS or SCCS suffix/prefix |
179 |
$name =~ s/,v$//; $name =~ s/^s\.//; # RCS or SCCS suffix/prefix |
| 178 |
$name =~ s/\.(Z|z|gz)$//; # compression suffix |
180 |
$name =~ s/\.(Z|z|gz|bz2)$//; # compression suffix |
| 179 |
|
181 |
|
| 180 |
$line = ""; |
182 |
my $line = ""; |
| 181 |
$unusual = 0; |
183 |
my $unusual = 0; |
| 182 |
|
184 |
|
| 183 |
if ($opt_b) { |
185 |
if ($opt_b) { |
| 184 |
# |
186 |
# |
| 185 |
# Binaries have to match exactly, and must be regular executable |
187 |
# Binaries have to match exactly, and must be regular executable |
| 186 |
# files. |
188 |
# files. |
| 187 |
# |
189 |
# |
| 188 |
$unusual++; |
190 |
++$unusual; |
| 189 |
foreach (@binaries) { |
191 |
foreach (@binaries) { |
| 190 |
$line .= " $_/$name", $unusual--, last if -f "$_/$name" && -x _; |
192 |
$line .= " $_/$name", --$unusual, last if -f "$_/$name" && -x _; |
| 191 |
} |
193 |
} |
| 192 |
} |
194 |
} |
| 193 |
|
195 |
|
|
Lines 195-207
Link Here
|
| 195 |
# |
197 |
# |
| 196 |
# Ask the man command to do the search for us. |
198 |
# Ask the man command to do the search for us. |
| 197 |
# |
199 |
# |
| 198 |
$unusual++; |
200 |
++$unusual; |
| 199 |
chop($result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`); |
201 |
chop(my $result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`); |
| 200 |
if ($result ne '') { |
202 |
if ($result ne '') { |
| 201 |
$unusual--; |
203 |
--$unusual; |
| 202 |
($cat, $junk, $src) = split(/[() \t\n]+/, $result); |
204 |
my($cat, $junk, $src) = split(/[()\s]+/, $result); |
| 203 |
if ($src ne '') { $line .= " $src"; } |
205 |
$line .= $src ? " $src" : " $cat"; |
| 204 |
else { $line .= " $cat"; } |
|
|
| 205 |
} |
206 |
} |
| 206 |
} |
207 |
} |
| 207 |
|
208 |
|
|
Lines 209-218
Link Here
|
| 209 |
# |
210 |
# |
| 210 |
# Sources match if a subdir with the exact name is found. |
211 |
# Sources match if a subdir with the exact name is found. |
| 211 |
# |
212 |
# |
| 212 |
$found = 0; |
213 |
my $found = 0; |
| 213 |
$unusual++; |
214 |
++$unusual; |
| 214 |
foreach (@sources) { |
215 |
foreach (@sources) { |
| 215 |
$line .= " $_/$name", $unusual--, $found++ if -d "$_/$name"; |
216 |
$line .= " $_/$name", --$unusual, ++$found if -d "$_/$name"; |
| 216 |
} |
217 |
} |
| 217 |
# |
218 |
# |
| 218 |
# If not yet found, ask locate(1) to do the search for us. |
219 |
# If not yet found, ask locate(1) to do the search for us. |
|
Lines 223-231
Link Here
|
| 223 |
# |
224 |
# |
| 224 |
if (!$found && open(LOCATE, "locate */$name 2>/dev/null |")) { |
225 |
if (!$found && open(LOCATE, "locate */$name 2>/dev/null |")) { |
| 225 |
locate_item: |
226 |
locate_item: |
| 226 |
while (chop($loc = <LOCATE>)) { |
227 |
while (chop(my $loc = <LOCATE>)) { |
| 227 |
foreach (@sources) { |
228 |
foreach (@sources) { |
| 228 |
$line .= " $loc", $unusual--, last locate_item |
229 |
$line .= " $loc", --$unusual, last locate_item |
| 229 |
if $loc =~ m|^$_/[^/]+/|; |
230 |
if $loc =~ m|^$_/[^/]+/|; |
| 230 |
} |
231 |
} |
| 231 |
} |
232 |
} |
|
Lines 239-242
Link Here
|
| 239 |
print "$name:$line\n"; |
240 |
print "$name:$line\n"; |
| 240 |
} |
241 |
} |
| 241 |
} |
242 |
} |
| 242 |
|
|
|