From josb@cncdsl.com  Sat Oct  6 13:53:36 2001
Return-Path: <josb@cncdsl.com>
Received: from w250.z064001178.sjc-ca.dsl.cnc.net (w250.z064001178.sjc-ca.dsl.cnc.net [64.1.178.250])
	by hub.freebsd.org (Postfix) with SMTP id 54BEC37B401
	for <FreeBSD-gnats-submit@freebsd.org>; Sat,  6 Oct 2001 13:53:36 -0700 (PDT)
Received: (qmail 61075 invoked by uid 1000); 6 Oct 2001 20:53:57 -0000
Message-Id: <20011006205357.61074.qmail@lizzy.bugworks.com>
Date: 6 Oct 2001 20:53:57 -0000
From: Jos Backus <jos@cncdsl.com>
Reply-To: Jos@lizzy.bugworks.com,
	Backus <@lizzy.bugworks.com Jos Backus <josb@cncdsl.com>>
To: FreeBSD-gnats-submit@freebsd.org
Cc:
Subject: Make whereis.pl use strict, and a couple of minor cleanups
X-Send-Pr-Version: 3.113
X-GNATS-Notify:

>Number:         31088
>Category:       bin
>Synopsis:       Make whereis.pl use strict, and a couple of minor cleanups
>Confidential:   no
>Severity:       non-critical
>Priority:       low
>Responsible:    tobez
>State:          closed
>Quarter:        
>Keywords:       
>Date-Required:  
>Class:          update
>Submitter-Id:   current-users
>Arrival-Date:   Sat Oct 06 14:00:07 PDT 2001
>Closed-Date:    Mon Jul 15 23:36:24 MEST 2002
>Last-Modified:  Mon Jul 15 23:36:24 MEST 2002
>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:
Responsible-Changed-From-To: freebsd-bugs->tobez 
Responsible-Changed-By: tobez 
Responsible-Changed-When: Sat Oct 6 14:40:34 PDT 2001 
Responsible-Changed-Why:  
I'll take care of this one. 

http://www.FreeBSD.org/cgi/query-pr.cgi?pr=31088 

From: Jos Backus <josb@cncdsl.com>
To: freebsd-gnats-submit@freebsd.org
Cc:  
Subject: bin/31088 update
Date: Sat, 6 Oct 2001 15:02:52 -0701

 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 Jrg 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;

From: Anton Berezin <tobez@FreeBSD.org>
To: Jos Backus <josb@cncdsl.com>
Cc: freebsd-gnats-submit@freebsd.org
Subject: Re: bin/31088 update
Date: Sun, 7 Oct 2001 00:26:44 +0200

 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 |
State-Changed-From-To: open->closed 
State-Changed-By: joerg 
State-Changed-When: Mon Jul 15 23:33:26 MEST 2002 
State-Changed-Why:  
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. 

http://www.freebsd.org/cgi/query-pr.cgi?pr=31088 
>Unformatted:
