1f43246f49336c9c83f5d9bb456dcc8e72f22b8a
[dragonfly.git] / usr.bin / whereis / whereis.pl
1 #!/usr/bin/perl
2 #
3 # Copyright © 1995, 1996 Jörg Wunsch
4 #
5 # All rights reserved.
6 #
7 # Redistribution and use in source and binary forms, with or without
8 # modification, are permitted provided that the following conditions
9 # are met:
10 # 1. Redistributions of source code must retain the above copyright
11 #    notice, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 #    notice, this list of conditions and the following disclaimer in the
14 #    documentation and/or other materials provided with the distribution.
15 #
16 # THIS SOFTWARE IS PROVIDED BY THE DEVELOPERS ``AS IS'' AND ANY EXPRESS OR
17 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
18 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
19 # IN NO EVENT SHALL THE DEVELOPERS BE LIABLE FOR ANY DIRECT, INDIRECT,
20 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
21 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
22 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
23 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
24 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
25 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26 #
27 # whereis -- search for binaries, man pages and source directories.
28 #
29 # Rewritten from scratch for FreeBSD after the 4.3BSD manual page.
30 #
31 # $FreeBSD: src/usr.bin/whereis/whereis.pl,v 1.8 1999/08/28 01:07:37 peter Exp $
32 # $DragonFly: src/usr.bin/whereis/Attic/whereis.pl,v 1.2 2003/06/17 04:29:33 dillon Exp $
33 #
34
35 sub usage
36 {
37     print STDERR "usage: $0 [-bms] [-u] [-BMS dir... -f] name ...\n";
38     exit 1;
39 }
40
41 sub scanopts
42 {
43     local($i, $j);
44   arg:
45     while ($ARGV[$i] =~ /^-/) {
46       opt:
47         for ($j = 1; $j < length($ARGV[$i]); $j++) {
48             local($_) = substr($ARGV[$i], $j, 1);
49             local($what, @list);
50             $opt_b++, next opt if /b/;
51             $opt_m++, next opt if /m/;
52             $opt_s++, next opt if /s/;
53             $opt_u++, next opt if /u/;
54             &usage unless /[BMS]/;
55
56             # directory list processing
57             $what = $_; @list = ();
58             push(@list, substr($ARGV[$i], $j+1)) if $j+1 < length($ARGV[$i]);
59             $i++;
60             while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
61                 push(@list, $ARGV[$i++]);
62             }
63             if ($what eq "B") {@binaries = @list;}
64             elsif ($what eq "M") {@manuals = @list;}
65             elsif ($what eq "S") {@sources = @list;}
66
67             $i++, last arg if $ARGV[$i] =~ /^-f$/;
68             next arg;
69         }
70         $i++;
71     }
72     &usage if $i > $#ARGV;
73
74     while ($ARGV[$i]) {
75         push(@names, $ARGV[$i++]);
76     }
77 }
78
79
80 sub decolonify
81 {
82     local($list) = @_;
83     local($_, @rv);
84     foreach(split(/:/, $list)) {
85         push(@rv, $_);
86     }
87     return @rv;
88 }
89
90
91 &scanopts;
92
93 # default to all if no type requested
94 if ($opt_b + $opt_m + $opt_s == 0) {$opt_b = $opt_m = $opt_s = 1;}
95
96 if (!defined(@binaries)) {
97     #
98     # first, use default path, then append /usr/libexec and the user's path
99     #
100     local($cs_path) = `/sbin/sysctl -n user.cs_path`;
101     local(@list, %path);
102
103     chop($cs_path);
104
105     @list = &decolonify($cs_path);
106     push(@list, "/usr/libexec");
107     push(@list, &decolonify($ENV{'PATH'}));
108
109     # resolve ~, remove duplicates
110     foreach (@list) {
111         s/^~/$ENV{'HOME'}/ if /^~/;
112         push(@binaries, $_) if !$path{$_};
113         $path{$_}++;
114     }
115 }
116
117 if (!defined(@manuals)) {
118     #
119     # first, use default manpath, then append user's $MANPATH
120     #
121     local($usermanpath) = $ENV{'MANPATH'};
122     delete $ENV{'MANPATH'};
123     local($manpath) = `/usr/bin/manpath`;
124     local(@list, %path, $i);
125
126     chop($manpath);
127
128     @list = &decolonify($manpath);
129     push(@list, &decolonify($usermanpath));
130
131     # remove duplicates
132     foreach (@list) {
133         push(@manuals, $_) if !$path{$_};
134         $path{$_}++;
135     }
136 }
137
138 if (!defined(@sources)) {
139     #
140     # default command sources
141     #
142     local($_);
143
144     @sources = ("/usr/src/bin", "/usr/src/usr.bin", "/usr/src/sbin",
145                 "/usr/src/usr.sbin", "/usr/src/libexec",
146                 "/usr/src/gnu/bin", "/usr/src/gnu/usr.bin",
147                 "/usr/src/gnu/sbin", "/usr/src/gnu/usr.sbin",
148                 "/usr/src/gnu/libexec", "/usr/src/contrib");
149
150     #
151     # if /usr/ports exists, look in all its subdirs, too
152     #
153     if (-d "/usr/ports" && opendir(PORTS, "/usr/ports")) {
154         while ($_ = readdir(PORTS)) {
155             next if /^\.\.?$/;
156             next if /^distfiles$/; # magic
157             next if ! -d "/usr/ports/$_";
158             push(@sources, "/usr/ports/$_");
159         }
160         closedir(PORTS);
161     }
162 }
163
164 if ($opt_m) {
165     # construct a new MANPATH
166     foreach (@manuals) {
167         next if ! -d $_;
168         if ($manpath) { $manpath .= ":$_"; }
169         else { $manpath = $_; }
170     }
171 }
172
173 #
174 # main loop
175 #
176 foreach $name (@names) {
177     $name =~ s|^.*/||;          # strip leading path name component
178     $name =~ s/,v$//; $name =~ s/^s\.//; # RCS or SCCS suffix/prefix
179     $name =~ s/\.(Z|z|gz)$//;   # compression suffix
180
181     $line = "";
182     $unusual = 0;
183
184     if ($opt_b) {
185         #
186         # Binaries have to match exactly, and must be regular executable
187         # files.
188         #
189         $unusual++;
190         foreach (@binaries) {
191             $line .= " $_/$name", $unusual--, last if -f "$_/$name" && -x _;
192         }
193     }
194
195     if ($opt_m) {
196         #
197         # Ask the man command to do the search for us.
198         #
199         $unusual++;
200         chop($result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`);
201         if ($result ne '') {
202             $unusual--;
203             ($cat, $junk, $src) = split(/[() \t\n]+/, $result);
204             if ($src ne '') { $line .= " $src"; }
205             else { $line .= " $cat"; }
206         }
207     }
208
209     if ($opt_s) {
210         #
211         # Sources match if a subdir with the exact name is found.
212         #
213         $found = 0;
214         $unusual++;
215         foreach (@sources) {
216                 $line .= " $_/$name", $unusual--, $found++ if -d "$_/$name";
217         }
218         #
219         # If not yet found, ask locate(1) to do the search for us.
220         # This will find sources for things like lpr, but take longer.
221         # Do only match locate output that starts with one of our
222         # source directories, and at least one further level of
223         # subdirectories.
224         #
225         if (!$found && open(LOCATE, "locate */$name 2>/dev/null |")) {
226           locate_item:
227             while (chop($loc = <LOCATE>)) {
228                 foreach (@sources) {
229                     $line .= " $loc", $unusual--, last locate_item
230                         if $loc =~ m|^$_/[^/]+/|;
231                 }
232             }
233             close(LOCATE);
234         }
235     }
236
237     if ($opt_u) {
238         print "$name:\n" if $unusual;
239     } else {
240         print "$name:$line\n";
241     }
242 }
243