#!/opt/perl/bin/perl -w
#
$vernum = "1.3 - 18 Feb 2010" ;             # 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-2010 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;
$opt{'vvverbose'} = $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
 vvverbose|vvv
);
$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:
 print "DWE: doing aliases\n" if ($opt{'vvverbose'});
 if (! open (ALIAS, "sh -i -c alias |"))
 {
  print "Cannot access alias\n" if ($opt{'verbose'});
 }
 else
 {
  # Ok, opened fine ... get back the results
  print "DWE:2 analyzing aliases\n" if ($opt{'vvverbose'});
  @aliases = <ALIAS>;
#  while (defined($line=<ALIAS>))
#  {
#   chomp ($line);
#print "DWE:3 $line\n";
#   push (@aliases, $line);
#  }
  $num=scalar(@aliases);
  print "DWE:4 '$num'\n" if ($opt{'vvverbose'});
  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)
   {
    print "DWE: $aliases[0]\n" if ($opt{'vvverbose'});
    ($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 library 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).
   --vvv, --vvverbose
       Very verbose mode. Used for additional debug info.

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)
}
