@rem = '--*-Perl-*--
@echo off
if "%OS%" == "" goto Win95
perl -x -S "%0" %*
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
goto endofperl
:Win95
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 13

use strict;

exit main();

sub CleanPath (\@;\%)
{
    my( $aPath, $hUser )= @_;
    my( $path, $dir );
    my @GoodPath= ();
    my %GoodPath= ();
DIR:
    while(  @$aPath  ) {
        $path= shift(@$aPath);
        print STDERR qq<  "$path"- >;
        $dir= $path;
        while(  $dir =~ /%([^\s=]+)%/  ) {
            my $repl= $ENV{$1};
            if(  ! defined( $repl )  ) {
                warn "%$1% not set in environment -- dropping.\n";
                next DIR;
            }
            $dir =~ s//$repl/;
        }
        $dir =~ s#([^:/\\])[/\\]$#$1#;
        print STDERR qq<is "$dir"; >
          if  $dir ne $path;
        $path =~ s#([^:/\\])[/\\]$#$1#;
        if(  ! -d $dir  ) {
            warn "does not exist -- dropping.\n";
        } elsif(  $dir !~ /^([a-z]:|\\\\)/i  ) {
            warn "isn't absolute -- dropping.\n";
        } elsif(  $GoodPath{uc $dir}  ) {
            warn "is a repeat -- dropping.\n";
        } elsif(  defined($hUser)  &&  $hUser->{uc $dir}  ) {
            warn "is user-specific -- dropping.\n";
        } else {
            if(  $path =~ /^\Q$ENV{SYSTEMROOT}\E/io  ) {
                $path =~ s/^\Q$ENV{SYSTEMROOT}\E/%SystemRoot%/;
                print STDERR qq<changed to "$path">;
            }
            warn "is good -- keeping!\n";
            push( @GoodPath, $path );
            $GoodPath{uc $path}= $path;
        }
    }
    @$aPath= @GoodPath;
}

sub main
{
    my $Reg;
    use Win32::TieRegistry ( TiedRef => \$Reg,
        ArrayValues => 1, Delimiter => "/", ":REG_" );
    my $UserEnv= $Reg->{"CUser/Environment/"}
      or  die "Can't open Registry key, CUser/Environment/: $^E\n";
    my $SysEnv= $Reg->{"LMachine/System/CurrentControlSet/Control/"
                     . "Session Manager/Environment/"}
      or  die "Can't open Registry key, Session Manager/Environment: $^E\n";
    my $UserPath= $UserEnv->{"/PATH"} || [ "", REG_EXPAND_SZ() ];
    my $SysPath= $SysEnv->{"/PATH"}
      or  die "Can't read system PATH from Registry: $^E\n";
    my @SysPath= split( /;/, $SysPath->[0], -1 );
    my @UserPath= split( /;/, $UserPath->[0], -1 );
    my $dir;
    foreach $dir (  @ARGV  ) {
        if(  $dir !~ m#^[a-z]:[/\\]#i  ) {
            die qq<Usage:  $0 ["x:\\dir_to_add" [...]]\n>,
              "Cleans invalid and repeated directories from the system\n",
              "and user-specific PATH environment settings.\n",
              "Prepends any listed directories to the system PATH.\n";
        } elsif(  ! -d $dir  ) {
            die "No such directory ($dir): $!\n";
        } else {
            warn "Prepending directory ($dir) to system path.\n";
            unshift( @SysPath, $dir );
        }
    }
    my $UserName= $ENV{USERNAME} || "user";
    if(  open( TEMP, ">> $ENV{TEMP}\\CleanPath.save" )  ) {
        print TEMP "Old system PATH=$SysPath\n";
        print TEMP "Old $UserName PATH=$UserPath\n";
        close TEMP;
    } else {
        warn "Can't write to $ENV{TEMP}\\CleanPath.save: $!\n";
        warn "Old system PATH=$SysPath\n";
        warn "Old $UserName PATH=$UserPath\n";
    }
    warn "Cleaning user-specific PATH:\n";
    CleanPath( @UserPath );
    my %UserPath= map {uc $_, $_} @UserPath;
    warn "Cleaning system PATH:\n";
    CleanPath( @SysPath, %UserPath );
    if(  $SysPath->[0] eq join( ";", @SysPath )
     &&  $SysPath->[1] != REG_SZ()  ) {
        warn "System PATH required no changes.\n";
    } else {
        if(  $SysPath->[1] == REG_SZ()  ) {
            warn "System PATH changed from REG_SZ to REG_EXPAND_SZ.\n";
            $SysPath->[1]= REG_EXPAND_SZ()
        }
        $SysPath->[0]= join( ";", @SysPath );
        $SysEnv->{"/PATH"}= $SysPath
          or  die "Can't set system PATH in Registry: $^E\n";
        warn "System PATH successfully updated.\n";
    }
    if(  $UserPath->[0] eq join( ";", @UserPath )  ) {
        warn "User-specific PATH required no changes.\n";
    } elsif(  @UserPath  ) {
        $UserPath->[0]= join( ";", @UserPath );
        $UserEnv->{"/PATH"}= $UserPath
          or  die "Can't set user-specific PATH in Registry: $^E\n";
        warn "User-specific PATH successfully updated.\n";
    } elsif(  "" ne $UserPath->[0]  ) {
        if(  ! delete $UserEnv->{"/PATH"}  ) {
            warn "Can't delete (now-useless) $UserName-specific PATH ",
                 "from Registry: $^E\n";
        } else {
            warn "Now-empty $UserName-specific PATH successfully deleted.\n";
        }
    }
    return 0;
}

__END__
:endofperl