summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2008-02-29 16:02:26 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2008-02-29 16:02:26 +0000
commitf79f8dc28a02eb586b4cb2eecfe693a201c0725c (patch)
tree5b6b7d8e9a07b4bd980e799660a42995533eb1bf
parent2b049d253dc2dfcbddc656ee3bffedf9f65a67b2 (diff)
TeXLive::TLWinGoo::dir_writable now also works for Vista.
git-svn-id: svn://tug.org/texlive/trunk@6774 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm70
-rwxr-xr-xMaster/tlpkg/doc/wingoo-demo.bat1
-rw-r--r--Master/tlpkg/doc/wingoo-demo.pl33
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");