diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2008-02-29 16:02:26 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2008-02-29 16:02:26 +0000 |
commit | f79f8dc28a02eb586b4cb2eecfe693a201c0725c (patch) | |
tree | 5b6b7d8e9a07b4bd980e799660a42995533eb1bf /Master | |
parent | 2b049d253dc2dfcbddc656ee3bffedf9f65a67b2 (diff) |
TeXLive::TLWinGoo::dir_writable now also works for Vista.
git-svn-id: svn://tug.org/texlive/trunk@6774 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rw-r--r-- | Master/tlpkg/TeXLive/TLWinGoo.pm | 70 | ||||
-rwxr-xr-x | Master/tlpkg/doc/wingoo-demo.bat | 1 | ||||
-rw-r--r-- | Master/tlpkg/doc/wingoo-demo.pl | 33 |
3 files changed, 47 insertions, 57 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm index 95e41aa4ef8..2bb9384b2a8 100644 --- a/Master/tlpkg/TeXLive/TLWinGoo.pm +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -208,19 +208,15 @@ sub dir_writable { return 0 unless -d $d; $d =~ s!\\!/!g; $d =~ s!/$!!g; - my $i=0; + my $i = 0; while (-e $d . "/" . $i) { $i++; } my $f = $d."/".$i; - #print $f."\n"; - return 0 unless open TEST, ">".$f; - my $written = 0; - $written = (print TEST "\n"); - close TEST; - # -s: non-zero size - # -e (exists) is not good enough - return 0 unless -s $f; - unlink $f; - return $written; + my $fb = $f; + $fb =~ s!/!\\!g; + return 0 if + system('copy /b ' . $ENV{'COMSPEC'} . ' "' . $fb . '" >nul 2>&1'); + unlink $f if -e $f; + return 1; } =pod @@ -368,26 +364,26 @@ sub add_texbindir_to_path { my $d; my $d_exp; my $found = 0; - my @newp; + my @newpt; my $newp; # system path if ($is_admin) { - @newp = (); + @newpt = (); foreach $d (split (';', get_system_path())) { $d_exp = expand_string($d); $d_exp =~ s/\\/\//g; $d_exp =~ s/\/$//; if (uc($d_exp) eq uc($texbindir)) { - push @newp, $d unless $found; + push @newpt, $d unless $found; $found = 1; } elsif (!is_a_texdir($d_exp)) { - push @newp, $d; + push @newpt, $d; } } - push @newp, $texbindir unless $found; + push @newpt, $texbindir unless $found; $found = 1; - $newp = join (';', @newp); + $newp = join (';', @newpt); $newp =~ s/\//\\/g; $system_env->ArrayValues(1); # use value_data, value_type pairs $system_env -> {"/Path"} = [ $newp, REG_EXPAND_SZ ]; @@ -409,21 +405,21 @@ sub add_texbindir_to_path { } # user path - @newp = (); + @newpt = (); foreach $d (split (';', get_user_path())) { $d_exp = expand_string($d); $d_exp =~ s/\\/\//g; $d_exp =~ s/\/$//; if (uc($d_exp) eq uc($texbindir)) { - push @newp, $d unless $found; # admin case: always $found + push @newpt, $d unless $found; # admin case: always $found $found = 1; } elsif (!is_a_texdir($d_exp)) { - push @newp, $d; + push @newpt, $d; } } - push @newp, $texbindir unless $found; - if (@newp) { - $newp = join ';', @newp; + push @newpt, $texbindir unless $found; + if (@newpt) { + $newp = join ';', @newpt; $newp =~ s/\//\\/g; $user_env->ArrayValues(1); # use value_data, value_type pairs $user_env -> {"/Path"} = [ $newp, @@ -438,42 +434,39 @@ sub remove_texbindirs_from_path { my $system_env = get_system_env(); my $user_env = get_user_env(); - my $d; - my $d_exp; - my @newp; - my $newp; + my ($d, $d_exp, @newpt, $newp); # system path if ($is_admin) { - @newp = (); + @newpt = (); foreach $d (split (';', get_system_path())) { $d_exp = expand_string($d); $d_exp =~ s/\\/\//g; $d_exp =~ s/\/$//; - push @newp, $d unless is_a_texdir($d_exp); + push @newpt, $d unless is_a_texdir($d_exp); } - $newp = join (';', @newp); + $newp = join (';', @newpt); $newp =~ s/\//\\/g; $system_env->ArrayValues(1); # use value_data, value_type pairs $system_env -> {"/Path"} = [ $newp, REG_EXPAND_SZ ]; } # user path - @newp = (); + @newpt = (); foreach $d (split (';', get_user_path())) { $d_exp = expand_string($d); $d_exp =~ s/\\/\//g; $d_exp =~ s/\/$//; - push @newp, $d unless is_a_texdir($d_exp); + push @newpt, $d unless is_a_texdir($d_exp); } - if (@newp) { - $newp = join(';', @newp); + if (@newpt) { + $newp = join(';', @newpt); $newp =~ s/\//\\/g; $user_env->ArrayValues(1); # use value_data, value_type pairs $user_env -> {"/Path"} = [ $newp, ($newp =~ /%/) ? REG_EXPAND_SZ : REG_SZ ]; } else { - delete $user_env -> {'/Path'}; + delete $user_env -> {"/Path"}; } } @@ -706,10 +699,3 @@ sub update_assocs() { 1; __END__ - -http://www.robvanderwoude.com/rundll.html: - -Activate registry changes in HKEY_CURRENT_USER without logging off -(Windows 2000 and later): - -RUNDLL32.EXE USER32.DLL,UpdatePerUserSystemParameters ,1 ,True diff --git a/Master/tlpkg/doc/wingoo-demo.bat b/Master/tlpkg/doc/wingoo-demo.bat index d9a2eb68d06..15fd0d5d5c2 100755 --- a/Master/tlpkg/doc/wingoo-demo.bat +++ b/Master/tlpkg/doc/wingoo-demo.bat @@ -5,6 +5,7 @@ rem This should also work with UNC names set tlsubsub=%~dp0
set tlprog=
set tldrive=%~d0
+set pathsave=%path%
%tldrive%
cd %tlsubsub%
diff --git a/Master/tlpkg/doc/wingoo-demo.pl b/Master/tlpkg/doc/wingoo-demo.pl index 112d2bc1e69..1b2944e9385 100644 --- a/Master/tlpkg/doc/wingoo-demo.pl +++ b/Master/tlpkg/doc/wingoo-demo.pl @@ -66,10 +66,12 @@ sub maybenot { sub create_file { my $name = shift; return if -e $name; - open DUMMY, ">".$name; - print DUMMY 's = tostring(0.0000001)'; # lua: 1e-7; texlua: 0 - print DUMMY ('print("0.0000001 becomes " .. s)'); - close DUMMY; + eval { + open DUMMY, ">".$name; + print DUMMY 's = tostring(0.0000001)'; # lua: 1e-7; texlua: 0 + print DUMMY ('print("0.0000001 becomes " .. s)'); + close DUMMY; + } ; } sub print_search_paths { @@ -111,10 +113,7 @@ sub pause { ### end of subs ### my $real_admin = admin(); -my $userpath_orig; -my $systempath_orig; -my $userpathext_orig; -my $systempathext_orig; + print( "\nGENERAL; ALSO UNIX\n" ); print ( "\nINC\n" . (join "\n", @INC) . "\n\n"); @@ -138,6 +137,9 @@ if ($^O !~ /^MSWin(32|64)$/i) { ### end of non-windows +my @winversion = Win32::GetOSVersion(); +print "Windows version: " . $winversion[1] . "\n"; + # country print "Country: " . reg_country() . "\n"; @@ -164,6 +166,7 @@ my $system_tmpdir=get_system_tmpdir(); print( "\n\nHKCU and HKLM\n\n" ); +my ($wr_dir1, $wr_dir2); while (1) { # running this first as admin (if possible) and then as non-admin print ((admin() ? "Is" : "Not") . " an admin\n"); @@ -171,7 +174,7 @@ while (1) { # running this first as admin (if possible) and then as non-admin # adding and removing texbindir print( "\ntexbindir on searchpath:\n" ); - my $wr_dir1 = $wr_dir . "/tex1"; + $wr_dir1 = $wr_dir . "/tex1"; mkdir $wr_dir1 unless -e $wr_dir1; create_file( $wr_dir1."/tex.exe" ); add_texbindir_to_path($wr_dir1); @@ -179,7 +182,7 @@ while (1) { # running this first as admin (if possible) and then as non-admin print_search_paths(); print "tex.exe found in " . win_which_dir("tex.exe") . "\n"; - my $wr_dir2 = $wr_dir . "/tex2"; + $wr_dir2 = $wr_dir . "/tex2"; mkdir $wr_dir2 unless -e $wr_dir2; create_file( $wr_dir2."/tex.exe" ); add_texbindir_to_path($wr_dir2); @@ -189,9 +192,6 @@ while (1) { # running this first as admin (if possible) and then as non-admin print( "Mopping up...\n" ); remove_texbindirs_from_path(); - rmdir $wr_dir1 if unlink $wr_dir1.'/tex.exe'; - rmdir $wr_dir2 if unlink $wr_dir2.'/tex.exe'; - print( "Dummy texs removed from path\n"); print_search_paths(); # adding a filetype @@ -222,7 +222,8 @@ while (1) { # running this first as admin (if possible) and then as non-admin if (admin()) { non_admin(); next; - } + } elsif ($winversion[1]>=6) { last; } + #vista: don't try this # the problem case: no admin, but TeX on system path @@ -240,7 +241,6 @@ while (1) { # running this first as admin (if possible) and then as non-admin print "Wrong tex.exe found in " . win_which_dir("tex.exe") . "\n"; unlink $fn; remove_texbindirs_from_path(); - rmdir $wr_dir2 if unlink $wr_dir2.'/tex.exe'; # broadcast environment changes @@ -249,6 +249,9 @@ while (1) { # running this first as admin (if possible) and then as non-admin if (!admin()) { last; } } +rmdir $wr_dir1 if unlink $wr_dir1.'/tex.exe'; +rmdir $wr_dir2 if unlink $wr_dir2.'/tex.exe'; +print( "Dummy texs removed from path\n"); admin_again() if $real_admin; unregister_script_type(".texlua"); |