# ! D:/Program Files/Perl/bin/Perl.exe -w
# Do a "which" command the way it should be done (in Windows)
# ** *********************************************************************
# ** ************************* Perforce Information *********************
# ** *********************************************************************
# **
# ** $Id: //Tools/Odds-Ends/which.pl#1 $
# ** $File: //Tools/Odds-Ends/which.pl $
# ** $Revision: #1 $
# ** $Change: 5047 $
# **
# ** $DateTime: 2006/05/23 06:48:59 $
# ** $Author: paul.m.thompson $
# **
# ** *********************************************************************
# ** ********************** End of Perforce Information ******************
# ** *********************************************************************
# ---------------------------------------------------------------------------
# pragmas
use strict ;
use diagnostics ;
use warnings ;
# ---------------------------------------------------------------------------
# modules used
use Getopt::Long qw( :config bundling ) ;
# use Win32 qw/SetCwd/ ;
# use Win32 qw/Setcwd/ ;
use Win32 ;
# ---------------------------------------------------------------------------
# prototypes
sub Usage(;$) ;
# ---------------------------------------------------------------------------
# Constants
# use constant X => "X" ;
# ---------------------------------------------------------------------------
# globals
our $PERL_ID = sprintf "Perl v%vd for '$^O'", $^V ;
our $PERFORCE_REVISION = sprintf("%d", q$Revision: #1 $ =~ /.+#(\d+)/);
our %Options ;
# ---------------------------------------------------------------------------
# Special blocks
# ---------------------------------------------------------------------------
# BEGIN {}
# CHECK {}
# INIT {}
# END {}
# ---------------------------------------------------------------------------
# Main
# ---------------------------------------------------------------------------
$Options{Check} = 1 ;
# OptionName OptionSpec
# OptionName ::= text [ | alias ...]
# OptionSpec ::= =|:[s|i|f]
# <none> option does not take an argument
# =s :s option takes a mandatory (=) or optional (:) string argument
# =i :i option takes a mandatory (=) or optional (:) integer argument
# =f :f option takes a mandatory (=) or optional (:) real number argument
# >new option is a synonym for option `new'
# -h --help ::= Print help and quit.
Win32::SetCwd('C:\\');
exit;
GetOptions
(
\%Options,
'All' ,
'List' ,
'Cd:i' ,
'Run:s' ,
'Check' ,
'Verbose' ,
'Version' ,
'Help|?',
) ;
Usage if $Options{Help} ;
print "Found ",scalar(keys(%Options))," command line options.\n\t",map("$_ == $Options{$_}\n\t",keys(%Options)),"\n" if $Options{Verbose} ;
# Get all executable extensions once & split to array.
my @Exts = split /;/,$ENV{PATHEXT} ;
print "Found ",scalar(@Exts)," executable extensions in env var PATHEXT.\n\t",join("\n\t",@Exts),"\n" if $Options{Verbose} ;
# Extensions are ".WHATEVER". Extensions include the leading DOT ('.')
# which needs to be escaped so that our REGEX will work as desired.
s/\./\\./g foreach @Exts ;
# Get and normalize all directories in the PATH env var. We want to eliminate
# trailing "." and "/" (or "\") chars. Make sure each path exists as a dir.
my @Paths = split /;/,$ENV{PATH} ;
print "Found ",scalar(@Paths)," paths in env var PATH.\n\t",join("\n\t",@Paths),"\n" if $Options{Verbose} ;
# Strip trailing ".", "\" and WHITESPACE.
s/[\.\\\s\/]+$// foreach (@Paths) ;
my %NormPaths ;
my $InstanceCtr = 0 ;
# Iterate each directory in the PATH env var. Get a list of files in that
# dir. See if the user-specified string is there with one of the extensions
# listed in the PATHEXT env var.
foreach my $Path (@Paths)
{
# If it exists as a directory, normalize the name and check it for uniqueness.
# NOTE: GetLongPathName() requires the pathname to exist!
if (-d $Path)
{
my $LongPath = Win32::GetLongPathName($Path) ;
my $LcLongPath = lc $LongPath ;
print "\n","-"x72,"\nGetLongPathName($Path) = $LongPath\n" if $Options{Verbose} ;
# If path not unique, warn user.
if ($NormPaths{$LcLongPath})
{
print "WARNING: directory '$Path' already listed in PATH (as $LongPath)\n" if $Options{Check} ;
}
else
{
$NormPaths{$LcLongPath} = $Path ;
# Read all files from specified dir.
opendir DIRHANDLE,$Path or die "Can't open directory '$Path'\n" ;
my @Flist = readdir DIRHANDLE ;
closedir DIRHANDLE ;
print "\t found ",scalar(@Flist)," files.\n",join(" ; ",@Flist),"\n" if $Options{Verbose} ;
# Iterate all the extensions in PATHEXT.
# Extensions include the leading DOT ('.') which we have already escaped.
foreach my $ExecutableExt (@Exts)
{
# print "\t\tpath ext = $ExecutableExt\n";
# Iterate all the user supplied things to search for
foreach my $Arg (@ARGV)
{
# print "\t\t\tSearch for $Arg$ExecutableExt\n" ;
if (my @Matches = grep m/$Arg.*$ExecutableExt/i,@Flist)
{
print "Found ",scalar(@Matches)," match of $Arg and $ExecutableExt.\n" if $Options{Verbose} ;
print "$Path\\$_\n" foreach @Matches ;
print "DEBUGINFO: getcwd=" . getcwd() . " CD env var = ",$ENV{CD}||'aint no such thing',"\n" ;
print "DEBUGINFO: getcwd=" . getcwd() . "\n" ;
print "DEBUGINFO: exec(\"$Path\\$Matches[0]\",\"$Options{Run}\")\n" if exists($Options{Run}) ;
exec("$Path\\$Matches[0]","$Options{Run}") if exists($Options{Run}) ;
exit 0 unless $Options{All} ;
}
}
}
}
}
else
{
print "WARNING: PATH directory '$Path' not found\n" if $Options{Check} ;
}
}
# ---------------------------------------------------------------------------
# Subroutines
# ---------------------------------------------------------------------------
# Optional param will print "special" messages first.
sub Usage(;$)
{
print "\n",shift(),"\n" if $#_ >= 0 ;
print "\n$0 : rev $PERFORCE_REVISION ($PERL_ID) \n" ;
print "\nSearch your PATH for executable files (determined by PATHEXT env var).\n" ,
"--All : Print all instances in all paths Default is to print first encountered.\n" ,
"--List : Print all instances as a comma-delimited list (inplies --All).\n" ,
"--Cd[=n] : CD to the dir of instance 'n' (default=0) \n" ,
"--Run --: Run the first instance found\n" ,
"or\n",
"--Run=s --: Run the first instance found with string 's' as params to that instance.\n" ,
" String 's' must be quoted if it contains white space\n",
" NOTE: You *MUST* include '--' after the --Run string unless --Run is specified after the searchfor!!\n" ,
"--Check : Print warnings for non-existant dirs and dup dir in PATH.\n" ,
" On by default. Use +Check or --Check=0 to disable.\n" ,
"--Verbose : Print more info.\n" ,
"--Version : Print program version info and quit.\n" ,
"\n"
;
exit ;
}
# ---------------------------------------------------------------------------
# End of script
# ---------------------------------------------------------------------------
# Data
# ---------------------------------------------------------------------------
__DATA__
__END__