Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

Minor nit around the %SystemRoot% handling. First off why does this only occur with %SystemRoot% is there something special about this variable that I am unaware of? Or does the OS do the correct handling if any %Env% vars are in the path? But more importantly there is a minor bug in that if two identical paths get a %SystemRoot% translation then they arent treated as dupes and both are kept. The following patch resolves this.

--- cleanpath.orig.pl 2003-09-05 18:32:14.000000000 +0200 +++ cleanpath.pl 2003-09-05 18:32:43.000000000 +0200 @@ -59,7 +59,7 @@ } warn "is good -- keeping!\n"; push( @GoodPath, $path ); - $GoodPath{uc $path}= $path; + $GoodPath{uc $path} = $GoodPath{uc $dir} = $path; } } @$aPath= @GoodPath;

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.

Cheers.

Oh, and I really do think the use Tie::Registry bit should go at the top of the file. Miaow. ;-)

Update

This is a hack i did of tyes code. It runs a batch file and then extracts the info out and compares it to the current enviornment. Any changes are written into the SYSTEM enviornment registry data.

@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

---
demerphq

<Elian> And I do take a kind of perverse pleasure in having an OO assembly language...

In reply to Re: CleanPath by demerphq
in thread CleanPath by tye

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others exploiting the Monastery: (7)
    As of 2015-07-08 08:13 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (96 votes), past polls