@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
In reply to CleanPath
by tye
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.