Date: 6 Oct 2001 20:53:57 -0000 From: Jos Backus <jos@cncdsl.com> To: FreeBSD-gnats-submit@freebsd.org Subject: bin/31088: Make whereis.pl use strict, and a couple of minor cleanups Message-ID: <20011006205357.61074.qmail@lizzy.bugworks.com>
next in thread | raw e-mail | index | archive | help
>Number: 31088
>Category: bin
>Synopsis: Make whereis.pl use strict, and a couple of minor cleanups
>Confidential: no
>Severity: non-critical
>Priority: low
>Responsible: freebsd-bugs
>State: open
>Quarter:
>Keywords:
>Date-Required:
>Class: update
>Submitter-Id: current-users
>Arrival-Date: Sat Oct 06 14:00:07 PDT 2001
>Closed-Date:
>Last-Modified:
>Originator: Jos Backus
>Release: FreeBSD 5.0-CURRENT i386
>Organization:
none
>Environment:
System: FreeBSD lizzy.bugworks.com 5.0-CURRENT FreeBSD 5.0-CURRENT #0: Sun Sep 30 12:32:29 PDT 2001 jos@lizzy.bugworks.com:/usr/src/sys/i386/compile/LIZZY i386
FreeBSD -current, lightly tested on -stable
>Description:
/usr/src/usr.bin/whereis/whereis.pl does not use strict and does gives
warnings when run with -w.
>How-To-Repeat:
>Fix:
--- whereis.pl.orig Sat Oct 6 13:47:54 2001
+++ whereis.pl Sat Oct 6 13:48:11 2001
@@ -31,31 +31,42 @@
# $FreeBSD: src/usr.bin/whereis/whereis.pl,v 1.8 1999/08/28 01:07:37 peter Exp $
#
+use strict;
+
sub usage
{
- print STDERR "usage: $0 [-bms] [-u] [-BMS dir... -f] name ...\n";
+ warn "usage: $0 [-bms] [-u] [-BMS dir... -f] name ...\n";
exit 1;
}
+my $opt_b = 0;
+my $opt_m = 0;
+my $opt_s = 0;
+my $opt_u = 0;
+my $manpath;
+my(@binaries, @manuals, @sources, @names);
+
+
sub scanopts
{
- local($i, $j);
+ my($i, $j);
+ $i = 0;
arg:
while ($ARGV[$i] =~ /^-/) {
opt:
- for ($j = 1; $j < length($ARGV[$i]); $j++) {
+ for ($j = 1; $j < length($ARGV[$i]); ++$j) {
local($_) = substr($ARGV[$i], $j, 1);
- local($what, @list);
- $opt_b++, next opt if /b/;
- $opt_m++, next opt if /m/;
- $opt_s++, next opt if /s/;
- $opt_u++, next opt if /u/;
+ my($what, @list);
+ ++$opt_b, next opt if /b/;
+ ++$opt_m, next opt if /m/;
+ ++$opt_s, next opt if /s/;
+ ++$opt_u, next opt if /u/;
&usage unless /[BMS]/;
# directory list processing
$what = $_; @list = ();
push(@list, substr($ARGV[$i], $j+1)) if $j+1 < length($ARGV[$i]);
- $i++;
+ ++$i;
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
push(@list, $ARGV[$i++]);
}
@@ -66,7 +77,7 @@
$i++, last arg if $ARGV[$i] =~ /^-f$/;
next arg;
}
- $i++;
+ ++$i;
}
&usage if $i > $#ARGV;
@@ -78,12 +89,7 @@
sub decolonify
{
- local($list) = @_;
- local($_, @rv);
- foreach(split(/:/, $list)) {
- push(@rv, $_);
- }
- return @rv;
+ return split(/:/, shift);
}
@@ -92,14 +98,12 @@
# default to all if no type requested
if ($opt_b + $opt_m + $opt_s == 0) {$opt_b = $opt_m = $opt_s = 1;}
-if (!defined(@binaries)) {
+unless (@binaries) {
#
# first, use default path, then append /usr/libexec and the user's path
#
- local($cs_path) = `/sbin/sysctl -n user.cs_path`;
- local(@list, %path);
-
- chop($cs_path);
+ chop(my($cs_path) = `/sbin/sysctl -n user.cs_path`);
+ my(@list, %path);
@list = &decolonify($cs_path);
push(@list, "/usr/libexec");
@@ -108,33 +112,31 @@
# resolve ~, remove duplicates
foreach (@list) {
s/^~/$ENV{'HOME'}/ if /^~/;
- push(@binaries, $_) if !$path{$_};
- $path{$_}++;
+ push(@binaries, $_) unless $path{$_};
+ ++$path{$_};
}
}
-if (!defined(@manuals)) {
+unless (@manuals) {
#
# first, use default manpath, then append user's $MANPATH
#
- local($usermanpath) = $ENV{'MANPATH'};
+ my($usermanpath) = $ENV{'MANPATH'} || '';
delete $ENV{'MANPATH'};
- local($manpath) = `/usr/bin/manpath`;
- local(@list, %path, $i);
-
- chop($manpath);
+ chop($manpath = `/usr/bin/manpath`);
+ my(@list, %path);
@list = &decolonify($manpath);
push(@list, &decolonify($usermanpath));
# remove duplicates
foreach (@list) {
- push(@manuals, $_) if !$path{$_};
- $path{$_}++;
+ push(@manuals, $_) unless $path{$_};
+ ++$path{$_};
}
}
-if (!defined(@sources)) {
+unless (@sources) {
#
# default command sources
#
@@ -149,6 +151,7 @@
#
# if /usr/ports exists, look in all its subdirs, too
#
+ local *PORTS;
if (-d "/usr/ports" && opendir(PORTS, "/usr/ports")) {
while ($_ = readdir(PORTS)) {
next if /^\.\.?$/;
@@ -163,31 +166,30 @@
if ($opt_m) {
# construct a new MANPATH
foreach (@manuals) {
- next if ! -d $_;
- if ($manpath) { $manpath .= ":$_"; }
- else { $manpath = $_; }
+ next unless -d;
+ $manpath .= $manpath ? ":$_" : $_;
}
}
#
# main loop
#
-foreach $name (@names) {
+foreach my $name (@names) {
$name =~ s|^.*/||; # strip leading path name component
$name =~ s/,v$//; $name =~ s/^s\.//; # RCS or SCCS suffix/prefix
- $name =~ s/\.(Z|z|gz)$//; # compression suffix
+ $name =~ s/\.(Z|z|gz|bz2)$//; # compression suffix
- $line = "";
- $unusual = 0;
+ my $line = "";
+ my $unusual = 0;
if ($opt_b) {
#
# Binaries have to match exactly, and must be regular executable
# files.
#
- $unusual++;
+ ++$unusual;
foreach (@binaries) {
- $line .= " $_/$name", $unusual--, last if -f "$_/$name" && -x _;
+ $line .= " $_/$name", --$unusual, last if -f "$_/$name" && -x _;
}
}
@@ -195,13 +197,12 @@
#
# Ask the man command to do the search for us.
#
- $unusual++;
- chop($result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`);
+ ++$unusual;
+ chop(my $result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`);
if ($result ne '') {
- $unusual--;
- ($cat, $junk, $src) = split(/[() \t\n]+/, $result);
- if ($src ne '') { $line .= " $src"; }
- else { $line .= " $cat"; }
+ --$unusual;
+ my($cat, $junk, $src) = split(/[()\s]+/, $result);
+ $line .= $src ? " $src" : " $cat";
}
}
@@ -209,10 +210,10 @@
#
# Sources match if a subdir with the exact name is found.
#
- $found = 0;
- $unusual++;
+ my $found = 0;
+ ++$unusual;
foreach (@sources) {
- $line .= " $_/$name", $unusual--, $found++ if -d "$_/$name";
+ $line .= " $_/$name", --$unusual, ++$found if -d "$_/$name";
}
#
# If not yet found, ask locate(1) to do the search for us.
@@ -223,9 +224,9 @@
#
if (!$found && open(LOCATE, "locate */$name 2>/dev/null |")) {
locate_item:
- while (chop($loc = <LOCATE>)) {
+ while (chop(my $loc = <LOCATE>)) {
foreach (@sources) {
- $line .= " $loc", $unusual--, last locate_item
+ $line .= " $loc", --$unusual, last locate_item
if $loc =~ m|^$_/[^/]+/|;
}
}
@@ -239,4 +240,3 @@
print "$name:$line\n";
}
}
-
>Release-Note:
>Audit-Trail:
>Unformatted:
To Unsubscribe: send mail to majordomo@FreeBSD.org
with "unsubscribe freebsd-bugs" in the body of the message
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20011006205357.61074.qmail>