@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;

Main();
exit( 0 );

sub ExpandEnv {
    my( $str )= @_;
    while(  $str =~ /%([^\s=]+)%/  ) {
        my $repl= $ENV{$1};
        if(  ! defined( $repl )  ) {
            warn "%$1% not set in environment -- dropping.\n";
            return "";
        }
        $str =~ s//$repl/;
    }
    return $str;
}


sub CleanPath {
    my( $aPath, $hUser )= @_;
    my( $path, $dir );
    my @GoodPath= ();
    my %GoodPath= ();
    while(  @$aPath  ) {
        $path= shift(@$aPath);
        print STDERR qq<  "$path"- >;
        $dir= ExpandEnv( $path )
            or  next;
        $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;
            $GoodPath{uc $dir}= $path
                if  $dir ne $path;
        }
    }
    @$aPath= @GoodPath;
}


sub SplitSysPath {
    my( $SysPath, @dirs )= @_;
    my @SysPath= split( /;/, $SysPath->[0], -1 );
    my $dir;
    foreach $dir (  @dirs  ) {
        if(  $dir !~ m#^[a-z]:[/\\]#i  ) {
            die qq<Usage:  $0 ["x:\\dir_to_add" [...]]\n>,
                "Cleans invalid and repeated directories from the syst
+em\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 );
        }
    }
    return @SysPath;
}


sub SaveChanges {
    my( $keyEnv, $keyPath, $avPath, $type )= @_;
    if(     $keyPath->[0] eq join( ";", @$avPath )
        &&  $keyPath->[1] != REG_SZ()
    ) {
        warn "\u$type PATH required no changes.\n";
    } elsif(  @$avPath  ) {
        if(  $keyPath->[1] == REG_SZ()  ) {
            warn "\u$type PATH changed from REG_SZ to REG_EXPAND_SZ.\n
+";
            $keyPath->[1]= REG_EXPAND_SZ()
        }
        $keyPath->[0]= join( ";", @$avPath );
        $keyEnv->{"/PATH"}= $keyPath
            or  die "Can't set $type PATH in Registry: $^E\n";
        warn "\u$type PATH successfully updated.\n";
    } elsif(  "" ne $keyPath->[0]  ) {
        if(  ! delete $keyEnv->{"/PATH"}  ) {
            warn "Can't delete (now-useless) $type PATH ",
                 "from Registry: $^E\n";
        } else {
            warn "Now-empty $type PATH successfully deleted.\n";
        }
    }
}


sub SaveState {
    my( $SysPath, $UserPath )= @_;
    my $UserName= $ENV{USERNAME} || "user";

    if(  open( TEMP, ">> $ENV{TEMP}\\CleanPath.save" )  ) {
        printf TEMP "On %d/%02d/%02d %02d:%02d:%02d:\n",
            sub { $_[0]+=1900; $_[1]++; return @_ }
                ->( (localtime)[5,4,3,2,1,0] );
        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";
    }
}


sub SetParentPath {
    my( $path )= @_;

    my $start= tell(DATA)
        or  die "Can't tell(DATA): $!";
    open DATA, "+< $0"  or  die "Can't read self ($0): $!\n";
    seek( DATA, $start, 0 )
        or  die "Can't fseek(DATA,$start,0): $!";
    die "Expected :endofperl after __END__ of $0.\n"
        unless  <DATA> =~ /^\s*:endofperl\s*$/i;
    seek( DATA, 0, 1 )
        or  die "Can't fseek(DATA,0,1): $!";

    if(  $path ne $ENV{PATH}  ) {
        warn "Updating current command shell's PATH...\n";
        print DATA "set PATH=$path\n";
    }

    truncate DATA, tell(DATA);
}


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 $SysPath= $SysEnv->{"/PATH"}
        or  die "Can't read system PATH from Registry: $^E\n";

    my @SysPath= SplitSysPath( $SysPath, @ARGV );

    my $UserPath= $UserEnv->{"/PATH"} || [ "", REG_EXPAND_SZ() ];
    my @UserPath= split( /;/, $UserPath->[0], -1 );

    SaveState( $SysPath->[0], $UserPath->[0] );

    warn "Cleaning user-specific PATH:\n";
    CleanPath( \@UserPath );

    my %UserPath= map {uc $_, $_} @UserPath;
    warn "Cleaning system PATH:\n";
    CleanPath( \@SysPath, \%UserPath );

    SaveChanges( $SysEnv, $SysPath, \@SysPath, "system" );
    SaveChanges( $UserEnv, $UserPath, \@UserPath, "user-specific" );

    my $path= join ";", map { ExpandEnv($_) || () } @UserPath, @SysPat
+h;
    SetParentPath( $path );
}

__END__
:endofperl