Bug 31088

Comment 1 Anton Berezin 2001-10-06 22:40:34 UTC

Responsible Changed
From-To: freebsd-bugs->tobez

I'll take care of this one.

Here is an updated version of the cleanup patch, incorporating the suggestions
from tobez:

--- whereis.pl.orig	Sat Oct  6 13:47:54 2001
+++ whereis.pl	Sat Oct  6 14:50:38 2001
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
 #
 # Copyright © 1995, 1996 Jörg Wunsch
 #
@@ -31,21 +31,32 @@
 # $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++) {
 	    local($_) = substr($ARGV[$i], $j, 1);
-	    local($what, @list);
+	    my($what, @list);
 	    $opt_b++, next opt if /b/;
 	    $opt_m++, next opt if /m/;
 	    $opt_s++, next opt if /s/;
@@ -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);
+    chomp(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{$_};
+	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);
+    chomp($manpath = `/usr/bin/manpath` || '');
+    my(@list, %path);
 
     @list = &decolonify($manpath);
     push(@list, &decolonify($usermanpath));
 
     # remove duplicates
     foreach (@list) {
-	push(@manuals, $_) if !$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,22 +166,21 @@
 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) {
 	#
@@ -196,12 +198,11 @@
 	# Ask the man command to do the search for us.
 	#
 	$unusual++;
-	chop($result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`);
+	chomp(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"; }
+	    my($cat, $junk, $src) = split(/[()\s]+/, $result);
+	    $line .= $src ? " $src" : " $cat";
 	}
     }
 
@@ -209,7 +210,7 @@
 	#
 	# Sources match if a subdir with the exact name is found.
 	#
-	$found = 0;
+	my $found = 0;
 	$unusual++;
 	foreach (@sources) {
 		$line .= " $_/$name", $unusual--, $found++ if -d "$_/$name";
@@ -223,7 +224,8 @@
 	#
 	if (!$found && open(LOCATE, "locate */$name 2>/dev/null |")) {
 	  locate_item:
-	    while (chop($loc = <LOCATE>)) {
+	    while (my $loc = <LOCATE>) {
+		chomp($loc);
 		foreach (@sources) {
 		    $line .= " $loc", $unusual--, last locate_item
 			if $loc =~ m|^$_/[^/]+/|;
@@ -239,4 +241,3 @@
 	print "$name:$line\n";
     }
 }
-

-- 
Jos Backus                 _/  _/_/_/        Santa Clara, CA
                          _/  _/   _/
                         _/  _/_/_/             
                    _/  _/  _/    _/
josb@cncdsl.com     _/_/   _/_/_/            use Std::Disclaimer;

Comment 3 Anton Berezin 2001-10-06 23:26:44 UTC

On Sat, Oct 06, 2001 at 03:10:02PM -0700, Jos Backus wrote:

>  Here is an updated version of the cleanup patch

  -w ?   :-)

Seriously, that's what I meant when I said `part-fix'.  It is nonsesical
to commit just the use-strictified version.  It's better to wait a
couple of days and commit the version which will be also -w-safe.

As an example of remaining -w-unsafeties consider the

            $i++, last arg if $ARGV[$i] =~ /^-f$/;

line in scanopts() sub.  If -BMS is not terminated with -f, this line
will produce a warning (uninitialized value).  There are surely more
cases like this one lurking around.

Take your time.  :-)

+Anton.
-- 
| Anton Berezin                |      FreeBSD: The power to serve |
| catpipe Systems ApS   _ _ |_ |           http://www.FreeBSD.org |
| tobez@catpipe.net    (_(_||  |                tobez@FreeBSD.org | 
| +45 7021 0050                |         Private: tobez@tobez.org |

Comment 4 Joerg Wunsch 2002-07-15 22:33:26 UTC

State Changed
From-To: open->closed

Since Perl is being decommissioned in FreeBSD-current, 
whereis.pl has been translated into a new whereis.c file. 

The patch could perhaps still be applied to the Perl version 
in RELENG_4, but since it's cosmetics only (as opposed to a 
bugfix), there's not much point in modifying that file either.