Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

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.

--- 2003-09-05 18:32:14.000000000 +0200 +++ 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.


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


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}\\" ) ) { 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}\\ $!\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


<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

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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?

    What's my password?
    Create A New User
    [Corion]: A good daystart to everybody!
    [GrandFather]: It's a good day end here Corion. The start was somewhat less than average!
    [Corion]: GrandFather: All's well that ends well? ;)
    [GrandFather]: I'm fighting with a third party device our software is to support. The documentation for the device's SDK is quite a lot less than average and most of today was spent ...

    How do I use this? | Other CB clients
    Other Users?
    Others wandering the Monastery: (6)
    As of 2017-08-24 07:02 GMT
    Find Nodes?
      Voting Booth?
      Who is your favorite scientist and why?

      Results (365 votes). Check out past polls.