As I mentioned in the CB im going to use this as a base for capturing %ENV changes after running utility scripts like VCVARS32.BAT and VSVARS32.BAT and committing their changes to the default system enviornment. Thanks a lot, ive been wanting to write the script youve posted and the extension I mention for a while. Now i only need to the latter.
@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;
my ($Reg,$UserEnv,$SysEnv);
use Win32::TieRegistry ( TiedRef => \$Reg,
ArrayValues => 1, Delimiter => "/", ":REG_" );
BEGIN{
$UserEnv= $Reg->{"CUser/Environment/"}
or die "Can't open Registry key, CUser/Environment/: $^E\n";
$SysEnv= $Reg->{"LMachine/System/CurrentControlSet/Control/"
. "Session Manager/Environment/"}
or die "Can't open Registry key, Session Manager/Environment: $
+^E\n";
}
exit(Main());
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;
}
}
@$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 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 );
}
}
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_EXPAND_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 CleanPathEntries {
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, $UserPath );
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 );
}
sub SimpleCleanPath {
my ($env,$k)=@_;
my %dupe;
my @path=grep { !$dupe{uc($_)}++ and -d $_ } split /;/,$env->{$k};
+
$env->{$k}=join ";",@path;
}
sub Main {
my $batch=shift @ARGV;
if ($batch) {
my $cmd=$batch.' >nul 2>&1 && perl -MData::Dumper -e"print Dum
+per(\\%ENV)"';
my $res=`$cmd 2>&1`;
my $env;
if ($res=~s/^\$VAR1 =/\$env =/) {
eval $res or die "$@\n$res";
} else {
die $res;
}
my %pathlike=map {$_=>1} qw( INCLUDE LIB PATH );
foreach my $k (keys %$env) {
SimpleCleanPath($env,$k)
if $pathlike{uc($k)};
if (!exists $ENV{$k} or uc($ENV{$k}) ne uc($env->{$k})) {
if ($SysEnv->{"/$k"}) {
warn "Updating system key '$k'.\n";
$SysEnv->{"/$k"}=[$env->{$k},$SysEnv->{"/$k"}[1]];
} else {
warn "Creating system key '$k'.\n";
$SysEnv->{"/$k"}=[$env->{$k},REG_SZ()];
}
if ($UserEnv->{"/$k"}) {
if( ! delete $UserEnv->{"/$k"} ) {
warn "Can't delete (now-useless) User $k ",
"from Registry: $^E\n";
} else {
warn "Now useless user $k successfully deleted
+.\n";
}
}
}
}
}
CleanPathEntries();
0
}
__END__
:endofperl
