#!/opt/perl/bin/perl -w
#
$vernum = "1.2 - 14 MAR 2003" ;             # Code version and modify date
#
# Interrogate the user's $PATH and determine where the specified
# command is located and which one (if there are several) will be
# executed. Also scans some 'traditional' places not on your PATH.
#
#   hunt "commandname"
#
# (Created because the conventional "which" and "whereis" commands
#  did not do quite what I wanted.)
#
# This code copyright 1999-2003 by
# D. W. Eaton, Artronic Development, Phoenix, AZ -- dwe@arde.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported -- if it does something useful for you, great!
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at dwe@arde.com.
#
use Getopt::Long;
#
# Constants
$true  = 1;  # truth values
$false = 0;
$all   = 2;  # for Getopt ignore case
use vars qw($false $true $all $matches);
# --------------------------------------------------------
# Configurable values:
#
# This hash defines other places to look if they are not on the
# current $PATH (i.e., likely places to find stuff the user may
# have left off $PATH and would like to be informed about.)
# If the entry's value in this hash is "exp", then any "~" in
# the path is replaced with the user's $HOME string.
# If the entry's value is "wild", then _one_ instance of "/*/" is
# allowed and is expanded so each instance is searched (including
# '/./', but excluding '/../'. Two instances of '*' is an error.
# Alter this hash for your site as needed.
%otherplaces = (
 '/usr/bin/X11' , 'OK',
 '/usr/contrib/bin/X11' , 'OK',
 '/usr/local/bin' , 'OK',
 '/bin' , 'OK',
 '/sbin' , 'OK',
 '/usr/sbin' , 'OK',
 '/usr/lbin', 'OK',
 '/opt/*/bin' , 'wild',
 '/usr/*/bin' , 'wild',
 '~/bin' , 'exp',
 '/etc' , 'OK',
 '/com' , 'OK',
 '/usr/apollo/bin' , 'OK',
 '/bsd4.3/usr/ucb' , 'OK',
 '/bsd4.3/bin' , 'OK',
 '/sys5.3/bin' , 'OK',
 '/sys5.3/usr/ucb' , 'OK',
 '~/com' , 'exp',
 '.', 'OK'
 );
undef %alreadyfound;
#
# Option defaults
$opt{'alias'}     = $false;
$opt{'dup'}       = $false;
$opt{'help'}      = $false;
$opt{'ignore'}    = $false;
$opt{'quiet'}     = $false;
$opt{'lib'}       = $false;
$opt{'long'}      = $false;
$opt{'noexact'}   = $false;
$opt{'other'}     = $false;
$opt{'verbose'}   = $false;
$opt{'vverbose'}  = $false;
#
# ---- end normal configuration items --------------------
# Find out who we are
$scriptleaf = $0;
$scriptleaf =~ s/^.*\///; # strip leading path to see who we are
#
# Process command-line
@opts = qw(
 alias|a
 dup|d
 help|h
 ignore|i
 lib
 long|l
 noexact|n
 other|o
 quiet|q
 verbose|v
 vverbose|vv
);
$Getopt::Long::bundling = $true;  # perl 5.003 and earlier will complain about this
$Getopt::Long::ignorecase = $all;
GetOptions (\%opt, @opts);
if ($opt{'vverbose'})
{
 $opt{'verbose'} = $true; # very verbose implies verbose
}
if ($opt{'quiet'})
{
 $opt{'verbose'} = $false; # Quiet overrides verbose
 $opt{'vverbose'} = $false;
}
#
# Initialize
$foundone = $false; # Haven't found entry yet
$altscan = $false;  # Indicate doing regular (on PATH) scan
#
# Determine what is shown in output for ...
if ($opt{'long'})
{
 # show (english) word phrases
 $goodmark = '*Execute*';              # the executable instance
 $noexecmark = '(not executable)';     # non-executables
 $nofilemark = '(not a file)';         # non-file destinations
 $zeromark = '(no content)';           # files with no content
 $badlinkmark = '(no target of link)'; # bad link, target missing
 $waysmark = ' ways';                  # duplicate ways tag
}
else
{
 # take the short character route
 $goodmark = '***';                    # the executable instance
 $noexecmark = '(X)';                  # non-executables
 $nofilemark = '(D)';                  # non-file, bad destinations
 $zeromark = '(0)';                    # files with no content
 $badlinkmark = '?';                   # bad link, target missing
 $waysmark = '+';                      # duplicate ways tag
}
#
# ---- logic ---------------------------------------------

if ($opt{'verbose'} || $opt{'help'})
{
 # Put out a heading ...
 print "$scriptleaf - version $vernum\n";
}

if ($opt{'help'})
{
 &syntax_message ();
 exit (1);
}

# More checks:
if (! defined ($ARGV[0]))
{
 if ($opt{'other'})
 {
  # Well, at least show what they asked for
  &showother; # show other dirs we will search (if we should)
  exit (1);
 }

 print STDERR "$scriptleaf ERROR: must specifiy command name to be found.\n";
 &syntax_message ();
 exit (0);
}

# So, should still have more arguments, must be the command(s)

if ($opt{'alias'})
{
 # Try to snatch user's aliases:
 if (! open (ALIAS, "alias\n |"))
 {
  print "Cannot access alias\n" if ($opt{'verbose'});
 }
 else
 {
  # Ok, opened fine ... get back the results
  while (defined($line=<ALIAS>))
  {
   chomp ($line);
   push (@aliases, $line);
  }
  close (ALIAS);
 }
}

while ($command = shift(@ARGV))
{
 if ($opt{'ignore'})
 {
  # Then make command be all lower case for search
  $command =~ tr/A-Z/a-z/;
 }

 if ($opt{'verbose'})
 {
  print "Command: $command\n"
 }

 if ($opt{'alias'})
 {
  # Try to snatch user's aliases:
  # Look through aliases first:
  if (scalar(@aliases))
  {
   while (@aliases)
   {
    ($nxtalias,$nxtaliasval) = split ("=",$aliases[0]);
    if ($command eq $nxtalias)
    {
     print "$nxtalias = $nxtaliasval";
     if (! $foundone)
     {
      # Indicate this is the one we will execute
      print " $goodmark";
      $foundone = $true; # Show we already found executable one
     }
     print "\n";
    }
    shift (@aliases);
   }
  }
 }

 $userpath = $ENV{'PATH'}; # Get the user's $PATH
 if ($ENV{'SHELL'} eq '/com/sh')
 {
  # Hmm. assume this is an Apollo, but we can't get the "search rules"
  # which is its PATH ('csr' is an embeded shell command)
  unless ($opt{'quiet'})
  {
   print "Warning: Looks like this is an Aegis shell, but we cannot obtain your 'csr'\n";
  }
 }
 $home = $ENV{'HOME'};     # Get user's $HOME directory

 $restpath = $userpath;
 if ($opt{'lib'})
 {
  # Ah, look for lib stuff, too.
  $userlibpath = $ENV{'LD_LIBRARY_PATH'};
  if ($userlibpath)
  {
   $restpath .= ":$userlibpath";
  }
  else
  {
   print "Warning: '\$LD_LIBRARY_PATH' was empty.\n" unless ($opt{'quiet'});
  }
 }

 while ($restpath)
 {
  # Get each path to search off the $PATH variable
  ($nxtdirname,$restpath) = split (":", $restpath,2);
  if (defined ($checkedpath{$nxtdirname}))
  {
   if ($opt{'verbose'})
   {
    print "Skipping $nxtdirname, already on your PATH ";
    print "$checkedpath{$nxtdirname} time";
    if ($checkedpath{$nxtdirname} != 1)
    {
     print "s";
    }
    print " ...\n";
   }
  }
  else
  {
   $goodone = &checkdir ($nxtdirname);
  }
  $checkedpath{$nxtdirname}++; # Note that we processed it
  if ($goodone)
  {
   print "$goodone";
   $goodone = ''; # Clear it
  }
 }

 if ($opt{'verbose'})
 {
  print "\nYour PATH is:\n$userpath\n\n";
  print "Searching 'traditional' directories not on your PATH ...\n";
 }

 &showother; # show other dirs we will search (if we should)

 $foundalt = $false; # No alternate ones found yet
 $altscan = $true;   # Indicate doing alternate search (not on path)
 foreach $key (sort keys %otherplaces)
 {
  if ($otherplaces{$key} eq "wild" &&
      $key =~ /\*/)
  {
   # Do some work on it to expand for a wildcard dir:
   print "Trying to expand $key\n" if ($opt{'verbose'});
   ($nxtdirlead,$nxtdirtail) = split ('/\*/', $key, 2);
   if ($nxtdirtail =~ /\*/)
   {
    # Oops, someone modified our list and didn't follow directions:
    print STDERR "$scriptleaf ERROR: only one wildcard allowed in 'otherplaces' directory names.\n";
    print STDERR "  Path '$key' not expanded.\n";
   }
   else
   {
    # Look for all dir names matching this wildcard
    ($matches,$dirlist) = &getls($nxtdirlead,'');
    while ($dirlist)
    {
     ($nxtdirtry,$dirlist) = split ("\n", $dirlist,2);
     if ($nxtdirtry =~ /\/\.$/)
     {
      $nxtdirtry =~ s/\/\.$//; # Remove the current dir dot
     }
     $nxttotry = $nxtdirtry . "/" . $nxtdirtail; # Build next place to look
     if ($nxtdirtry !~ /\/\.\.$/)
     {
      # Avoid current parent dirs, but expand other */bin's:
      if (-d $nxttotry)
      {
       print "Going to look in $nxttotry\n" if ($opt{'other'});
       &processdir($nxttotry);
      }
     }
    }
   }
  }
  else
  {
   if ($otherplaces{$key} eq "exp")
   {
    # Do some work on it to expand for our home dir first:
    $key =~ s/\~/$home/;
   }
   # Go look for matches
   &processdir($key);
  }
 }

 if (! $foundone)
 {
  # Oops, we never found one
  unless ($opt{'quiet'})
  {
   print "Did not find an executable instance of '$command' on your PATH\n";
  }
 }
}

#
exit (0) ;
### END.

# --------------------------- subroutines ----------------------------
# Get list of contents of directory
# (subject to optional pattern match)
#   ($results,$textresults) = &getls("newdir"[,"pattern"])
# where $results:
#     0 = directory not found or not opened or no pattern matches found
#    +n = count of the matches
# and $textresults:
#  null = directory not found or not opened or no pattern matches found
#  text = actual matches, one per line
sub getls
{
 my ($newdir,$newpatt) = @_;
 my ($name,$results,$textresults);

 $results = 0;
 $textresults = "";

 if (! opendir (DIR, $newdir))
 {
  if ($opt{'verbose'})
  {
   print "Cannot open directory '$newdir'\n$!\n" ;
  }
  return (0) ;
 }

 while (defined($name = readdir (DIR)))
 {
  # Scan each file in turn ...
  if ($newpatt)
  {
   next unless ($name =~ /$newpatt/ ||
               ($opt{'ignore'} &&
                $name =~ /$newpatt/i)) ;
  }
  $results++;
  $textresults .= "$newdir/$name\n";
 }
 closedir (DIR) ;
 return ($results,$textresults);
}

# ----------
# Process a candidate directory
#   &processdir($key);
sub processdir
{
 my ($checkpath) = @_;
 my ($goodone);

 if (! defined ($checkedpath{$checkpath}))
 {
  # Check this one, it was not on user's $PATH
  # Look for our command
  $goodone = &checkdir ($checkpath);
  if ($goodone)
  {
   if (! $foundalt)
   {
    print "Found, but not on your PATH:\n" unless ($opt{'quiet'});
   }
   print "$goodone";
   $goodone = ''; # Clear it
   $foundalt = $true;
  }
 }
}

# ----------
# Check specified directory for the command
# $goodone = &checkdir("nxtdirname");
# Returns found paths (with opt tags) or null
sub checkdir
{
 my ($nxtdirname) = @_;
 my ($goodones,$goodone,$matches,$dirlist,$nextent,$destination,$statchr);

 $goodones = ""; # Nothing found yet
 $statchr = "";
 $matches = 0;
 $dirlist = "";
 # Look for all file names matching this command
 if ($nxtdirname)
 {
  print "Searching $nxtdirname ...\n" if ($opt{'vverbose'});
  ($matches,$dirlist) = &getls($nxtdirname,$command);
 }
 else
 {
  print "Warning: null directory entry detected.\n" unless ($opt{'quiet'});
 }
 # Cycle through each name found looking for ones we really want
 while ($dirlist)
 {
  $goodone = ""; # Nothing found yet
  # Split each entry
  ($nextent,$dirlist) = split ("\n",$dirlist,2);
  $target = $nextent; # Assume this is the end of the chain
  $numlinks = 0; # No linked levels hunted yet
  # Now see if we got an exact match on our command
  # (or if we don't care about that)
  if ($opt{'noexact'} ||
      ($nextent =~ /\/$command$/ ||
       $nextent =~ /^$command$/ ||
       ($opt{'ignore'} &&
        ($nextent =~ /\/$command$/i ||
         $nextent =~ /^$command$/i))))
  {
   # OK, got an exact match
   $goodone .= "  $nextent";
   if (-f $nextent || -l $nextent)
   {
    if (-l $nextent)
    {
     # It was a link, hunt it down
     ($arrow,$destination,$statchr) = &huntlink ($nextent);
     $alreadyfound{$destination}++; # Show we found this entry
     $target = $destination; # Nope, found new end of chain
     $goodone .= "$arrow $destination";
     if ($statchr)
     {
      $goodone .= " $statchr";
     }
    }
    # OK, we found something we might be able to execute
    $alreadyfound{$nextent}++; # Show we found this entry
    if (-x $nextent)
    {
     if (-z $nextent)
     {
      # File there, but no content
      $goodone .= " $zeromark";
     }
     if (! $foundone)
     {
      if (! $statchr && ! $altscan)
      {
       # Indicate this is the one we will execute
       $goodone .= " $goodmark";
       $foundone = $true; # Show we already found executable one
      }
     }
    }
    else
    {
     if (! $statchr)
     {
      # Indicate this cannot be executed
      $goodone .= " $noexecmark";
     }
    }
   }
   else
   {
    # Indicate this is not a file
    $goodone .= " $nofilemark";
   }
   $goodone .= "\n";
  }
  if (defined $alreadyfound{$target} && $goodone)
  {
   if ($alreadyfound{$target} <= 1 ||
       $opt{'dup'})
   {
    # Only show the first instance of a target unless dups are requested
    if ($alreadyfound{$target} > 1)
    {
     chomp ($goodone);
     $goodone .= " ($alreadyfound{$target}$waysmark)\n";
    }
    $goodones .= "$goodone"; 
   }
  }
 }
 return ($goodones);
}

# ----------
# Hunt down a link to see if it can be executed
# ($arrow,$destination,$statchr) = &huntlink ($nextent);
# Returns what should be tacked on to output
# for arrow, destination, and status or a null for
# these fields
sub huntlink
{
 my ($nextent) = @_;
 my ($destination,$nextentdir,$arrow,$statchr);

 $numlinks++; # Bump number of links we have found
 # Do special processing for links
 $arrow = "";
 $statchr = "";
 $destination = readlink ($nextent); # Get link target
 if ($destination !~ /^\//)
 {
  # Then "assume" it is relative to the directory it is in
  # Strip trailing filename to see where it is
  $nextentdir = $nextent;
  $nextentdir =~ s/\/[^\/]*$//;
  # Tack on its directory name
  $destination = $nextentdir . "/" . $destination;
 }
 if (-l $destination)
 {
  # Shucks, keep hunting, it was a link to a link
  ($arrow,$destination,$statchr) = &huntlink($destination);
 }
 # Put in '-->' or '-X->'
 $arrow = " -";
 if ($numlinks > 1)
 {
  $arrow .= $numlinks;
 }
 $arrow .= "->";
 if (! -e $destination)
 {
  # Link destination does not exist, flag it
  $statchr = "$badlinkmark";
 }
 elsif (! -f $destination)
 {
  # Final target not a file
  $statchr = $nofilemark;
 }
 elsif (-z $destination)
 {
  # File there, but no content
  $statchr = $zeromark;
 }
 return ($arrow,$destination,$statchr);
}

# ----------
# show other dirs we will search (if we should)
# &showother;
sub showother
{
 my ($key);

 # Now look for it in other "traditional" places, just in case ...
 if ($opt{'other'})
 {
  # Then list what other places we will look
  print "Will try to search these 'traditional' directories\n";
  foreach $key (sort keys %otherplaces)
  {
   print "    $key\n";
  }
 }
}

# --------------------
#
# Print syntax message
sub syntax_message
{
 my ($scriptleaf);

 $scriptleaf = $0;
 $scriptleaf =~ s/^.*\///; # strip leading path to see who we are

 print STDERR  qq{
Determine which command gets executed and where is it located

Syntax:

   $scriptleaf  [ options ] commandname(s)

Where 'options' are:

   -a, --alias
       Scan for an alias instance of the command.
       (Experimental code which is not completed.)
   -d, --dup
       Show duplicate links to the same instance on the command.
   -h, --help
       Print this help message.
   -i, --ignore
       Ignore case when looking for command.
   --lib
       If environment variable LD_LIBRARY_PATH is defined, add that
       to the list of locations searched so perhaps a libray by the
       specified name may be found
   -l, --long
       Show long status description for each command.
   -q, --quiet
       Do not show supporting info lines or warnings, just results.
   -n, --noexact
       Do not require an exact match. Command names
       listed may contain the specified string.
   -o, --other
       Display the other "traditional" places we look
       besides the user's PATH.
   -v, --verbose
       Verbose mode. Show additional information
       (unless quiet mode is also specified).
   --vv, --vverbose
       Very verbose mode. Show even more information
       (unless quiet mode is also specified).

The first instance encountered on your PATH is the one
which would be executed. It is marked with '$goodmark'.

Matching entries which are found but are not executable
are marked with '$noexecmark' while matching
entries which are neither files nor links are marked
'$nofilemark'. Links are indicated by '-->' followed by
the target path of the link. If more than one link was
followed to reach the target, it is indicated by '-X->'
where 'X' represents the number of links followed. If
the target does not exist, it is followed by
'$badlinkmark'.

With the -d option, multiple links which point to the same
final target file are shown. Each one after the first is
noted with '(X$waysmark)' at the end of its line.

EXAMPLES
--------

Find which 'tar' will be executed:

   \$ $scriptleaf  tar
     /opt/bin/tar --> /opt/tar/bin/tar ***
     /usr/bin/tar
     /bin/tar
   Found, but not on your PATH:
     /sbin/tar

Try to find commands containing 'Mosaic' in either upper or
lower case:

   \$ $scriptleaf  -i -n Mosaic
   Did not find an executable instance of 'mosaic' on your PATH
};

&showother; # show other dirs we will search (if we should)
}
