diff options
Diffstat (limited to 'Master/tlpkg/doc/wingoo-demo.pl')
-rw-r--r-- | Master/tlpkg/doc/wingoo-demo.pl | 242 |
1 files changed, 154 insertions, 88 deletions
diff --git a/Master/tlpkg/doc/wingoo-demo.pl b/Master/tlpkg/doc/wingoo-demo.pl index 84c0a455a77..1e29d201c82 100644 --- a/Master/tlpkg/doc/wingoo-demo.pl +++ b/Master/tlpkg/doc/wingoo-demo.pl @@ -5,8 +5,6 @@ # Under Unix/Linux, just test whether loading of win32 modules is skipped. -#!/usr/bin/env perl - use strict; BEGIN { @@ -26,36 +24,78 @@ BEGIN { } use TeXLive::TLUtils qw( get_system_tmpdir ); -use TeXLive::TLWinGooTry qw( - &win_version - &is_vista - &admin - &non_admin - &admin_again - &dir_writable - ®_country - &get_system_path - &get_user_path - &get_system_env - &get_user_env - &expand_string - &win_which_dir - &global_tmpdir - &add_texbindir_to_path - &remove_texbindirs_from_path - ®ister_script_type - &unregister_script_type - &broadcast_env - &update_assocs - &wg_error +use TeXLive::TLWinGoo qw( + win_version + is_vista + admin + non_admin + admin_again + dir_writable + reg_country + get_system_path + get_user_path + get_system_env + get_user_env + expand_string + win_which_dir + global_tmpdir + add_texbindir_to_path + remove_texbindirs_from_path + setenv_reg + unsetenv_reg + register_script_type + unregister_script_type + broadcast_env + update_assocs + wg_error ); # safe under Unix/Linux! my $ro_dir = "z:/aps"; -my $luaprog = "x:/utils0/lua.exe"; +my $luadir = "x:/utils0"; +my $luaprog; +my $pathsave = $ENV{'PATH'}; +my $pathextsave = $ENV{'PATHEXT'}; $::LOGLEVELTERMINAL=$::LOG_DDDEBUG; $::LOGLEVELFILE=$::LOG_ZERO; +#sub pathnew { +# my $p = expand_string(get_system_path()).';'. +# expand_string(get_user_path()); +# $p =~ s!/!\\!g; +# return $p; +#} +#sub getenvnew { +# # only use this for REG_SZ values! +# my $env_var = shift; +# return TeXLive::TLWinGoo::get_user_env()->{$env_var} or +# TeXLive::TLWinGoo::get_system_env()->{$env_var} or ""; +# #my $env_data = TeXLive::TLWinGoo::get_user_env()->{$env_var}; +# #if (not $env_data) { +# # $env_data = TeXLive::TLWinGoo::get_system_env()->{$env_var}; +# #} +# #if (not $env_data) { $env_data = ""; } +# #return $env_data; +#} + +sub pause { + my $mess = shift; + print( $mess."\nType any key..." ); + read STDIN,my $dummy, 1; +} + + +sub run_and_pause { + my $command = shift; + #my $setenv = "set PATH=".pathnew(). + # " & set TEXBINDIR=".getenvnew('TEXBINDIR'). + # " & set PATHEXT=".getenvnew('PATHEXT'); + #my $cmd_prompt = expand_string ($ENV{'COMSPEC'}); + #system ($cmd_prompt . ' /C "'.$setenv.' & '.$command.' & pause"'); + print "Type $command in a new command prompt\n"; + read STDIN,my $dummy, 1; +} + sub maybenot { my $bool = shift; return $bool ? " is " : " is not "; @@ -69,8 +109,8 @@ sub create_file { my $name = shift; return 1 if -e $name; return 0 unless open DUMMY, ">".$name; - print DUMMY 's = tostring(0.0000001)'; # lua: 1e-7; texlua: 0 - print DUMMY ('print("0.0000001 becomes " .. s)'); + print DUMMY 's = tostring(0.0000001)'."\n"; # lua: 1e-7; texlua: 0 + print DUMMY 'print("0.0000001 becomes " .. s)'."\n"; close DUMMY; return 1; } @@ -85,9 +125,15 @@ sub print_lua_out { my $luatestlua = $luatest . ".texlua"; unlink $luatestlua if -e $luatestlua; create_file( $luatestlua ); - my $cmd = 'set PATHEXT=%PATHEXT%;.TEXLUA & "'.$luatest.'"'; - $cmd =~ s/\//\\/g; - print "Lua[tex] result: ".`$cmd`."\n"; + #$ENV{'PATH'} = expand_string($pathsave) . ";" . $ENV{'TEMP'}; + #my $usersave = get_user_path(); + #$userpath = ($usersave ? "$usersave;" . + #run_and_pause ('testlua'); + $luatest =~ s!/!\\!g; + #run_and_pause ("set PATHEXT=%PATHEXT%;.TEXLUA & set TEXBINDIR=".$luatest); + run_and_pause ($luatest); + #print "Lua[tex] result: ".`testlua`."\n"; + #$ENV{'PATH'} = $pathsave; unlink $luatestlua; } @@ -102,13 +148,7 @@ sub print_assoc_cmd { $cmdout = `ftype $ftype`; if (!$cmdout) { print "Filetype unknown says ftype\n"; return; } $cmdout =~ s/.*=//; - print( $ext.' command is: '.$cmdout."\n" ); -} - -sub pause { - my $mess = shift; - print( $mess."\nType any key..." ); - read STDIN,my $dummy, 1; + print( $ext.' command is: '.$cmdout." says ftype\n" ); } ### end of subs ### @@ -148,34 +188,41 @@ if ($^O !~ /^MSWin(32|64)$/i) { # country -print "Country: " . reg_country() . "\n"; +print "\n***\nCountry: " . reg_country() . "\n"; # dir_writable my $wr_dir = $ENV{'USERPROFILE'}; $wr_dir =~ s/\\/\//g; mkdir $wr_dir unless -e $wr_dir; +print "\n***\nTesting for writability\n"; print $wr_dir . maybenot(dir_writable($wr_dir)) . "writable\n"; print $ro_dir . maybenot(dir_writable($ro_dir)) . "writable\n"; # expand_string -print( "\nExpansion\n" ); +print( "\n***\nExpansion\n" ); print expand_string("pre\\%systemROOT%\\post")."\n"; # win_which_dir -print( "\nFinding an executable\n" ); +print( "\n***\nFinding an executable\n" ); print "cmd.exe found in " . win_which_dir("cmd.exe") . "\n"; my $system_tmpdir=get_system_tmpdir(); -print( "\n\nHKCU and HKLM\n\n" ); +print( "\n***\nPath; admin and user\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"); +foreach ("admin", "user") { + if ($_ eq "admin") { + next unless $real_admin; + admin_again(); + } else { + non_admin(); + } + print "\n***\n" . ((admin() ? "Is" : "Not") . " an admin\n"); # adding and removing texbindir @@ -200,69 +247,88 @@ while (1) { # running this first as admin (if possible) and then as non-admin remove_texbindirs_from_path(); print_search_paths(); + # broadcast environment changes + + broadcast_env(); + pause( maybenot(admin())." admin; check environment in new dosbox\n\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"); + +# the problem case: no admin, but TeX on system path + +print( "\nNon-admin path problem\n" ); +my $fn = expand_string("%windir%")."/TEX.EXE"; +$fn =~ s/\\/\//g; +non_admin(); +if (create_file($fn)) { # a tex.exe on the system path! + add_texbindir_to_path(expand_string($wr_dir2)); + my @wge = wg_error(); + if (@wge) { + print $wge[1]."\n"; + } + print( "Cannot remove tex from system searchpath\n" ); + print_search_paths(); + print "Wrong tex.exe found in " . win_which_dir("tex.exe") . "\n"; + unlink $fn; + remove_texbindirs_from_path(); + broadcast_env(); + pause( "Non-admin: check environment in new dosbox" ); +} else { + print "Cannot test; cannot create $fn\n"; +} + +# texlua filetype: plain lua for user, texlua for admin. +# differentiation: texlua rounds .0000001 to 0, lua doesn't +# The texlua command is REG_EXPAND_SZ, parameterized with %TEXBINDIR%. + +print( "\n***\nRegistering and unregistering filetypes\n\n" ); + +unregister_script_type(".texlua"); +unsetenv_reg('TEXBINDIR'); +update_assocs(); +broadcast_env(); +print_assoc_cmd( '.texlua' ); + +foreach ("admin", "user") { + if ($_ eq "admin") { + next unless $real_admin; + admin_again(); + } else { + non_admin(); + } + print "\n***\n" . ((admin() ? "Is" : "Not") . " an admin\n"); + # adding a filetype - print( "\nRegistering and unregistering filetypes\n" ); - my $testlua = admin() ? $::installerdir."/bin/win32/texlua.exe" : $luaprog; - update_assocs(); # just to be sure - print_assoc_cmd( '.texlua' ); - print_lua_out(); - register_script_type(".texlua", $testlua ); + my $luaprog = admin() ? "texlua.exe" : "lua.exe"; + my $texbindir = admin() ? $::installerdir."/bin/win32" : $luadir; + $texbindir =~ s!/!\\!g; + setenv_reg("TEXBINDIR", $texbindir); + register_script_type(".texlua", "%TEXBINDIR%\\".$luaprog ); + broadcast_env(); update_assocs(); + print "\n***\nAfter registering script type\n"; print_assoc_cmd( '.texlua' ); print_lua_out(); - print( "Now unregister\n" ); + print( "\***\nNow unregister\n" ); unregister_script_type(".texlua"); update_assocs(); print_assoc_cmd( '.texlua' ); print_lua_out(); print( "Now re-register (not shown)\n" ); - register_script_type(".texlua", $testlua ); + register_script_type(".texlua", "%TEXBINDIR%\\".$luaprog ); update_assocs(); # broadcast environment changes broadcast_env(); - pause( maybenot(admin())." admin; check environment in new dosbox\n\n" ); - - if (admin()) { - non_admin(); - next; - } - - # the problem case: no admin, but TeX on system path - - print( "\nNon-admin path problem\n" ); - my $fn = expand_string("%windir%")."/TEX.EXE"; - $fn =~ s/\\/\//g; - if (create_file($fn)) { # a tex.exe on the system path! - add_texbindir_to_path(expand_string($wr_dir2)); - my @wge = wg_error(); - if (@wge) { - print $wge[1]."\n"; - } - print( "Cannot remove tex from system searchpath\n" ); - print_search_paths(); - print "Wrong tex.exe found in " . win_which_dir("tex.exe") . "\n"; - unlink $fn; - remove_texbindirs_from_path(); - broadcast_env(); - pause( "Non-admin: check environment in new dosbox" ); - } else { - print "Cannot test; cannot create $fn\n"; - } - - # broadcast environment changes - - 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"); +unsetenv_reg('TEXBINDIR'); update_assocs(); broadcast_env(); print_assoc_cmd( '.texlua' ); |