if [ $# -eq 0 ]; then exec perl -x -S $0; exit $? ; else exec perl -x -S $0 "$@"; exit $? ; fi
#!/bin/perl
#optpath - eliminate path components that do not exist on this host.
 
#################################### MAIN ######################################
 
&init_pathname();
&parse_args;
 
&init_env($VAR_ARG, $SEP_ARG);
 
$newpath = "";
%upath = ();
 
#for each path component...
foreach $pp (@PATH)
{
#printf STDERR "pp=%s\n", $pp;
	next if (defined($upaths{$pp}));	#been there, done that
	next if (!(-d $pp) && !(-f $pp) && $DELETE_OPTION);
 
	if ($RM_OPT == 1) {
		$yesmatch = 0;
		foreach $pat (@RM_LIST) {
			$yesmatch = ($pp =~ /$pat/);
#printf STDERR "pat=%s pp=%s yesmatch=%d\n", $pat, $pp, $yesmatch;
			last if ($yesmatch);
		}
 
		next if ($yesmatch);
	}
 
	$upaths{$pp} = 1;
	$newpath = ($newpath eq "") ? $pp : "${newpath}$SEP_ARG${pp}";
}
 
print "$newpath\n";
exit 0;
 
################################# INIT,USAGE ###################################
 
sub usage
{
	local($status) = @_;
 
    print STDERR <<"!";
Usage:  $p [-help] [-d] -var PATHVAR -sep PATHSEP
           [-rm pattern[,pattern ...]]
 
Synopsis:
 Edit a PATH variable, eliminating redundant components,
 while preserving precedence.
 
Options:
 -help display usage message.
 -d    delete non-existent components from path.
 -var PATHVAR
       use <PATHVAR> instead of the standard command PATH variable.
 -sep PATHSEP
       use <PATHSEP> instead of the standard command PATH separator char.
 -rm pattern[,pattern ...]
       remove path components matching any pattern in the supplied
       pattern list.  Individual patterns are interpreted as perl
       regular-expressions.
 
Examples:
 Typical use at end of .cshrc or .tcshrc:
 
    set opt=`$p` >& /dev/null
    if (\$status == 0) then
        setenv PATH \$opt
    else
        echo path not optimized
    endif
 
 At end of .profile (/bin/sh) or profile.ksh (mks shell):
 
    opt=`optpath`
    if [ $? -eq 0 ]; then
        PATH=$opt
    else
        echo path not optimized
    fi
 
 Delete components that begin with "/home/d/tools",
 or end with "/bin/cmn", "/bin/\$OWARE_ROOT", or "/install/bin".
 Note the careful quoting.  This allows the shell to interpolate
 \$OWARE_ROOT, while passing \$ as part of the perl pattern:
 
    set opt=`$p -rm '^/home/d/tools,/install/bin\$,/bin/'\${OWARE_ROOT}'\$'`
 
 Edit the Java CLASSPATH variable, deleting non-existent
 class directories and archives:
 
    set opt=`$p -d -var CLASSPATH -sep ':'`
 
NOTES:
 Please check the status of the $p command
 before resetting your path - otherwise your shell
 may become unusable.
 
 Care must be taken with the -d option.  Sometimes
 path components are not present because they have
 not been built yet, or because the network is
 temporarily unavailable.
 
!
    exit($status);
}
 
sub parse_args
#proccess command-line aguments
{
	local ($flag, $parm);
	$DELETE_OPTION = 0;
	$RM_OPT = 0;
	$SEP_OPT = 0;
	$VAR_OPT = 0;
 
	#default to standard path var & separator:
	$VAR_ARG = $PATHVAR;
	$SEP_ARG = $CPS;
 
    #eat up flag args:
    while ($#ARGV+1 > 0 && $ARGV[0] =~ /^-/) {
		$flag = shift(@ARGV);
 
		if ($flag eq '-d') {
			$DELETE_OPTION = 1;
		} elsif ($flag =~ '^-h') {
			&usage(0);
		} elsif ($flag eq '-var') {
			if ($#ARGV < 0 || $ARGV[0] eq "") {
				printf STDERR "%s:  -var requires an argument\n", $p;
				&usage(1);
			}
			$VAR_OPT = 1;
			$VAR_ARG = shift(@ARGV);
		} elsif ($flag eq '-sep') {
			if ($#ARGV < 0 || $ARGV[0] eq "") {
				printf STDERR "%s:  -sep requires an argument\n", $p;
				&usage(1);
			}
			$SEP_OPT = 1;
			$SEP_ARG = shift(@ARGV);
		} elsif ($flag eq '-rm') {
			if ($#ARGV < 0 || $ARGV[0] eq "") {
				printf STDERR "%s:  -rm requires an argument\n", $p;
				&usage(1);
			}
			$RM_OPT = 1;
			@RM_LIST = split(',', shift(@ARGV));
		} else {
			&usage(1);
		}
    }
 
	#ignore any other args...
}
 
sub init_env
{
	local($pathvar, $pathsep) = @_;
	local ($path) = $ENV{$pathvar};
 
#printf STDERR "init_env:  OS=%d pathvar='%s'\n", $OS, $pathvar;
 
	#convert to lower case if NT:
	$path =~ tr/A-Z/a-z/ if ($OS == $NT);
 
    #get path environment var:
    @PATH = split($pathsep, $path);
 
    if ($#PATH < 0) {
		printf STDERR ("%s:  can't get path variable!\n", $p);
		exit(1);
    }
}
 
################################ PATH UTILITIES ###############################
 
sub pickfiles
#pick the plain file entries from a directory listing.
#<lsout> must be in CWD or contain full path refs.
#list returned in <thefiles>.
{
	local (*thefiles, *lsout) = @_;
 
	@thefiles = grep(!(-d $_), @lsout);
}
 
sub pwd
#return full pathname of current working directory.
{
	local ($tmp);
	if ($OS == $UNIX) {
		$tmp = (`pwd`);
		chop $tmp;
		return($tmp);
	}
 
	return("NULL");		#not handled
}
 
sub ls
#<lsout> <-- `ls <dir>`
{
	local (*lsout, $dir) = @_;
 
	if (!opendir(DIR, $dir)) {
		@lsout = ();
		return;
	}
 
	#skip  '.' & '..' on unix
	@lsout = grep(!/^\.\.?$/,readdir(DIR));
 
	closedir(DIR);
}
 
sub path_separator
#what is the separator char used by this filesystem, and how is
#the current directory indicated?
#Returns 9-tuple:
# (current_dir_symbol,
#	volume_separator,
#	input_path_separator,
#	output_path_separator,
#	up_directory,
#	command_PATH_env_var_separator,
#	command_LIBPATH_env_var_separator,
#	PATH_ENV_VAR_NAME
# )
{
	$UNIX = 1; $NT=2;
 
	$OSENV = $ENV{'OS'};
##	if ((defined($OSENV) &&  $OSENV eq 'Windows_NT') || $0 =~ /\.ksh$/) {
##		$OS = $NT;
##		return('.', ':', '[\\\/]', '/', '..', ';', ';', 'PATH');
##	}
 
 
 
	#default is unix:
	$OS = $UNIX;
	return('.', '/', '/', '/', '..', ':', ';', 'PATH');
}
 
sub init_pathname
#initialize standard pathname variables.
{
    ($DOT, $VOLSEP, $PS_IN, $PS_OUT, $UPDIR, $CPS, $LIBPS, $PATHVAR) = &path_separator;
 
    #set up program name argument:
    local(@tmp) = split($PS_IN, $0);
    # figure out the program name and put it into p
    $p = $tmp[$#tmp];
	$p =~ s/\.ksh$// if ($OS == $NT);
}
 
sub mkpathname
#convert a list of pathname components to a local path name.
{
	local (@plist) = @_;
 
	#strip trailing input path-separators:
	for ($ii=0; $ii<=$#plist; $ii++) {
		$plist[$ii] =~ s/${PS_IN}$//;
	}
	
	return(join($PS_OUT, @plist));
}