diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-04-24 15:44:14 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-04-24 15:44:14 +0000 |
commit | 9d5bc14f41bbd9219da5d024b1d6a164b51c8525 (patch) | |
tree | dbd8181781a4ca5641a7544de85da8ad8e57d3ef /Master/tlpkg/TeXLive/TLWinGoo.pm | |
parent | 1604514ddb81e4dbd0a8f91892afa04cd2c7c07e (diff) |
Proposed updates TLWinGoo and install-tl now in place; old tlperl removed
git-svn-id: svn://tug.org/texlive/trunk@22184 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLWinGoo.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLWinGoo.pm | 615 |
1 files changed, 354 insertions, 261 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm index 08c86c58480..26fdaf42d56 100644 --- a/Master/tlpkg/TeXLive/TLWinGoo.pm +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -1,6 +1,6 @@ # $Id$ # TeXLive::TLWinGoo.pm - Windows nastiness -# Copyright 2008, 2009, 2010 Siep Kroonenberg, Norbert Preining +# Copyright 2008, 2009, 2010, 2011 Siep Kroonenberg, Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. @@ -46,14 +46,17 @@ C<TeXLive::TLWinGoo> -- Additional utilities for Windows TeXLive::TLWinGoo::global_tmpdir; TeXLive::TLWinGoo::get_system_path; TeXLive::TLWinGoo::get_user_path; - TeXLive::TLWinGoo::win_which_dir($prog); TeXLive::TLWinGoo::setenv_reg($env_var, $env_data); TeXLive::TLWinGoo::unsetenv_reg($env_var); TeXLive::TLWinGoo::adjust_reg_path_for_texlive($action, $texbindir, $mode); - TeXLive::TLWinGoo::register_extension($extension, $file_type); - TeXLive::TLWinGoo::unregister_extension($extension); + TeXLive::TLWinGoo::register_extension($mode, $extension, $file_type); + TeXLive::TLWinGoo::unregister_extension($mode, $extension); TeXLive::TLWinGoo::register_file_type($file_type, $command); TeXLive::TLWinGoo::unregister_file_type($file_type); + TeXLive::TLWinGoo::register_application($prog, $path, $exts); + TeXLive::TLWinGoo::unregister_application($prog); + TeXLive::TLWinGoo::add_to_openwithlist($ext, $prog); + TeXLive::TLWinGoo::remove_from_openwithlist($ext, $prog); =head2 ACTIVATING CHANGES IMMEDIATELY @@ -104,6 +107,10 @@ BEGIN { &unregister_extension ®ister_file_type &unregister_file_type + ®ister_application + &unregister_application + &add_to_openwithlist + &remove_from_openwithlist &broadcast_env &update_assocs &shell_folder @@ -120,7 +127,6 @@ BEGIN { &admin_again &get_system_env &get_user_env - &win_which_dir &global_tmpdir &is_a_texdir &tex_dirs_on_path @@ -378,31 +384,31 @@ sub get_user_path { return $value; } -=pod - -=item C<win_which_dir> - -More or less the same as which, except that 1. it returns a -directory, 2. it consults the path stored in the registry rather -than the path of the current process, and 3. it assumes that the -filename includes an extension. Currently only used for testing. - -=cut - -sub win_which_dir { - my $prog = shift; - my $d; - # first check system path - my $path = expand_string(get_system_path()); - my $user_path = expand_string(get_user_path()); - $path = $path . ';' . $user_path if $user_path; - $path =~ s/\\/\//g; - foreach $d (split (';',$path)) { - $d =~ s/\/$//; - return $d if -e $d.'/'.$prog; - } - return 0; -} +#=pod +# +#=item C<win_which_dir> +# +#More or less the same as which, except that 1. it returns a +#directory, 2. it consults the path stored in the registry rather +#than the path of the current process, and 3. it assumes that the +#filename includes an extension. Currently only used for testing. +# +#=cut +# +#sub win_which_dir { +# my $prog = shift; +# my $d; +# # first check system path +# my $path = expand_string(get_system_path()); +# my $user_path = expand_string(get_user_path()); +# $path = $path . ';' . $user_path if $user_path; +# $path =~ s/\\/\//g; +# foreach $d (split (';',$path)) { +# $d =~ s/\/$//; +# return $d if -e $d.'/'.$prog; +# } +# return 0; +#} =pod @@ -425,7 +431,7 @@ sub setenv_reg { if ($mode eq "system" and !$is_admin); my $env; if ($mode ne "system") { - my $env = get_user_env(); + $env = get_user_env(); $env->ArrayValues(1); $env->{'/'.$env_var} = [ $env_data, ($env_data =~ /%/) ? REG_EXPAND_SZ : REG_SZ ]; @@ -545,16 +551,28 @@ sub adjust_reg_path_for_texlive { return 0; } +### helper subs for file types ### + # delete a registry key recursively. # the key parameter should be a string, not a registry object. -# We shall use this with file types. + +sub getans { + my $prompt = shift; + my $ans; + print STDERR "$prompt\n"; + $ans = <STDIN>; + if ($ans =~ /^y/i) {return 1;} + die "Aborting as requested"; +} sub reg_delete_recurse { my $parent = shift; my $childname = shift; - ddebug("Deleting $childname regkey\n"); + my $parentpath = $parent->Path; + ddebug("Deleting $parentpath$childname\n"); + my $child; if ($childname !~ '^/') { # subkey - my $child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()}); + $child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()}); return unless $child; foreach my $v (keys %$child) { if ($v =~ '^/') { # value @@ -568,106 +586,214 @@ sub reg_delete_recurse { delete $parent->{$childname}; } -=pod - -=item C<register_extension($mode, $extension, $file_type)> - -Add registry entry to associate $extension with $file_type. Slashes -are flipped where necessary. +sub cu_root { + my $k = $Registry -> Open("CUser", { + Access => KEY_ALL_ACCESS(), Delimiter => '/' + }); + die "Cannot open HKCU for writing" unless $k; + return $k; +} -If $mode is 0, nothing is actually done. If $mode is 1, only not-present -keys of keys that are matching the given key are (re)created. If $mode -is 2 then keys are (re)created in any case. +sub lm_root { + my $k = $Registry -> Open("LMachine", { + Access => ($is_admin ? KEY_ALL_ACCESS() : KEY_READ()), + Delimiter => '/' + }); + die "Cannot open HKLM for ".($is_admin ? "writing" : "reading") + unless $k; + return $k; +} -=cut +# write a registry key or not, depending on +# mode, existing keys and privilege level -sub register_extension { +sub do_write_regkey { my $mode = shift; - return if ($mode == 0); - - my $extension = shift; - $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot - $extension = uc($extension); + my $keypath = shift; # modulo cu/lm + my $keyhash = shift; # ref to a possibly nested hash + die "No regkey specified" unless $keypath && defined($keyhash); + # for error reporting: + my $hivename = $is_admin ? 'HKLM' : 'HKCU'; + + if ($mode == 0) { + ddebug "Mode 0: not writing $hivename/$keypath key\n"; + return 1; + } - my $file_type = shift; - debug("Linking $extension to $file_type\n"); - my ($classes_key_path, $classes_key, $k); - my ($admin_classes_key_path, $admin_classes_key); + # split into parent and final subkey + # remove initial slash from parent + # ensure subkey ends with slash + my ($parentpath, $keyname); + if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) { + ($parentpath, $keyname) = ($1, $2); + $keyname .= '/'; + debug "key - $hivename - $parentpath - $keyname\n"; + } else { + die "Cannot determine final component of $keypath"; + } - $extension = lc($extension); + my $cu_key = cu_root(); + my $lm_key = lm_root(); + # cu_root() and lm_root() already die upon failure + my $do_create = 1; + if ($mode == 1) { + if ($is_admin) { + if ($lm_key->{$keypath}) { + $do_create = 0; + debug "Not writing HKLM/$keypath because already present\n"; + } + } else { + if ($cu_key->{$keypath}) { + $do_create = 0; + debug "Not writing HKCU/$keypath because already present\n"; + } elsif ($lm_key->{$keypath}) { + $do_create = 0; + debug "Not writing HKCU/$keypath because ". + "HKLM/$keypath already present\n"; + } + } + }; + return 1 unless $do_create; + my $parentkey; if ($is_admin) { - $classes_key_path = "LMachine/Software/Classes/"; + $parentkey = $lm_key->Open($parentpath); + if (!$parentkey) { + # in most cases, this probably shouldn't happen for lm + $parentkey = $lm_key->CreateKey($parentpath); + } } else { - $classes_key_path = "CUser/Software/Classes/"; - $admin_classes_key_path = "LMachine/Software/Classes/"; + $parentkey = $cu_key->Open($parentpath); + if (!$parentkey) { + $parentkey = $cu_key->CreateKey($parentpath); + } } - - $classes_key = $Registry -> Open($classes_key_path, - {Access => KEY_ALL_ACCESS()}); - - if (!$is_admin) { - $admin_classes_key = $Registry -> Open($admin_classes_key_path, - {Access => KEY_READ()}); + if (!$parentkey) { + tlwarn "Cannot create parent of $hivename/$keypath\n"; + return 0; } + if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);} + $parentkey->{$keyname} = $keyhash; + if (!$parentkey->{$keyname}) { + tlwarn "Failure to create HKLM/$keypath\n"; + return 0; + } + if ($is_admin and $cu_key->{$keypath}) { + # delete possibly conflicting cu key + reg_delete_recurse ($cu_key->{$parentpath}, $keyname); + } + if (!$parentkey) { + $parentkey = $cu_key->CreateKey($parentpath); + if (!$parentkey) { + tlwarn "Cannot create parentpath of HKCU/$keypath\n"; + return 0; + } + } + if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);} + $parentkey->{$keyname} = $keyhash; + if (!$parentkey->{$keyname}) { + tlwarn "Failure to create $hivename/$keypath\n"; + return 0; + } + return 1; +} - if (!defined($classes_key)) { - tlwarn("Cannot get key to $classes_key\n" . - "Cannot continue setting up associations.\n"); - # should we die here in the admin case? - # so it was before, but that is probably not the best idea - return; +sub do_remove_regkey { + my $mode = shift; + my $keypath = shift; + my $testhash = shift; + # hashref of subkey/value => data pairs + # mode 1: if any is present and does not match, then do not remove + # ATM we assume REG_SZ data + # In future, a we might use a subroutine reference instead. + my $hivename = $is_admin ? 'HKLM' : 'HKCU'; + + if ($mode == 0) { + ddebug "Mode 0: not removing $hivename/$keypath key\n"; + return 1; } - my $do_create_key = 0; + my ($parentpath, $keyname); + if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) { + ($parentpath, $keyname) = ($1, $2); + $keyname .= '/'; + } else { + die "Cannot determine final component of $keypath"; + } + my $cu_key = cu_root(); + my $lm_key = lm_root(); + if ($is_admin) { + return 0 unless $lm_key; + } else { + return 0 unless $cu_key; + } + my $do_remove = 1; + my ($parentkey, $k, $skv, $d); + if ($is_admin) { + $parentkey = $lm_key->Open($parentpath); + } else { + $parentkey = $cu_key->Open($parentpath); + } + if (!$parentkey) { + $do_remove = 0; + tlwarn "Unable to open $roothive/$parentpath for writing\n"; + return 0; + } if ($mode == 1) { - if (defined($classes_key->{$extension})) { - if (defined($classes_key->{$extension}->{'/'})) { - if ($classes_key->{$extension}->{'/'} eq $file_type) { - debug("register_extension: already same key $extension $file_type present, recreate it\n"); - # delete it so that it is recreated ... - delete $classes_key -> {$extension}; - $do_create_key = 1; - } else { - debug("register_extension: old foreign key" . $classes_key->{$extension}->{'/'} . " found, not changing\n"); + $k = $parentkey->{$keyname}; + if ($k) { + if ($testhash) {foreach $skv (keys %$testhash) { + $d = $k->{$keyname.$skv}; + if ($d and $d ne $test->{$skv}) { + $do_remove = 0; + debug "$hivename/$keypath modified; not deleting\n"; + last; } - } + }} } else { - if (!$is_admin) { - # if we are not admin, we check whether the key is associated - # in the admin keys, and if yes, do NOT associate it again - if (defined($admin_classes_key->{$extension})) { - debug("register_extension: old key $extension found in admins keys, not changing it\n"); - } else { - $do_create_key = 1; - } - } else { - $do_create_key = 1; - } - debug("register_extension: old key $extension not found, recreating it\n") - if $do_create_key; + $do_remove = 0; + debug "$hivename/$keypath not present or not writable so not removed\n"; } - } elsif ($mode == 2) { - $do_create_key = 1; - } else { - die "Unknown mode $mode for register_extension"; + }; + return 1 unless $do_remove; + #getans("Deleting $parentpath$keyname regkey? "); + reg_delete_recurse($parentkey, $keyname); + if ($parentkey->{$keyname}) { + tlwarn "Failure to delete $roothive/$keypath\n"; + return 0; } - - if ($do_create_key) { - $k = $classes_key->CreateKey($extension); - if (!defined($k)) { - tlwarn("Cannot create key for $extension in $classes_key_path.\n"); - return; - } - $k -> ArrayValues(0); - $k -> {"/"} = $file_type; - if (admin()) { - # delete possibly conflicting value from HKCU/software - $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - delete $classes_key -> {$extension}; - } + if ($is_admin and $cu_key->{$parentpath}) { + reg_delete_recurse($cu_key->{$parentpath}, $keyname); + # no errorchecking this once } + return 1; +} + +=pod + +=item C<register_extension($mode, $extension, $file_type)> + +Add registry entry to associate $extension with $file_type. Slashes +are flipped where necessary. + +If $mode is 0, nothing is actually done. If $mode is 1, only not-present +keys of keys that are matching the given key are (re)created. If $mode +is 2 then keys are (re)created in any case. + +=cut + +sub register_extension { + my $mode = shift; + my $extension = shift; + # ensure leading dot + $extension = '.'.$extension unless $extension =~ /^\./; + $extension = lc($extension); + + my $file_type = shift; + debug("Linking $extension to $file_type\n"); + + my $regkey = {'/' => $file_type}; + do_write_regkey($mode, "Software/Classes/$extension/", $regkey); } =pod @@ -679,67 +805,17 @@ Reversal of register_extension. =cut sub unregister_extension { - my $mode = shift; - return if ($mode == 0); - # we don't error check; we just do the best we can. + my $mode = shift; + # mode 0: continue anyhow and let do_remove_regkey + # bail out with a debug message. my $extension = shift; my $filetype = shift; - $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot - $extension = uc($extension); + $extension = '.'.$extension unless $extension =~ /^\./; debug("unregistering $extension\n"); - my $classes_key; - - my $HKLMclasses_key = $Registry -> Open("LMachine/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - my $HKCUclasses_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - if (admin()) { - $classes_key = $HKLMclasses_key; - } else { - $classes_key = $HKCUclasses_key; - } - if ($classes_key) { - my $do_remove_key = 0; - if ($mode == 1) { - if (defined($classes_key->{$extension})) { - if (defined($classes_key->{$extension}->{'/'})) { - if ($classes_key->{$extension}->{'/'} eq $filetype) { - debug("unregister_extension: correct key/value $extension/$filetype found, removing\n"); - $do_remove_key = 1; - } else { - debug("unregister_extension: foreign value for $extension found, keeping it\n"); - } - } else { - $do_remove_key = 1; - } - } else { - # nothing necessary, this key wasn't found - } - } elsif ($mode == 2) { - $do_remove_key = 1; - } else { - die "Unknown mode $mode for unregister_extension"; - } - - if ($do_remove_key) { - reg_delete_recurse ($classes_key, $extension."/"); - if (admin()) { - if ($HKCUclasses_key) { - reg_delete_recurse ($HKCUclasses_key, $extension."/"); - } else { - debug("Cannot open HKCU classes for write\n"); - } - } - } - } else { - if (admin()) { - debug("Cannot open HKLM classes for write\n"); - } else { - debug("Cannot open HKCU classes for write\n"); - } - } + $testhash = {"/" => $filetype}; + do_remove_regkey($mode, "Software/Classes/".$extension, $testhash); } =pod @@ -757,25 +833,16 @@ sub register_file_type { my $command = shift; $command =~s/\//\\/g; debug ("Linking $file_type to $command\n"); - my ($classes_key, $k); - - if ($is_admin) { - $classes_key = $Registry -> Open("LMachine/Software/Classes/", - {Access => KEY_ALL_ACCESS()}) or die "Cannot open classpath"; - $k = $classes_key->CreateKey($file_type."/Shell/Open/Command/"); - $k -> {"/"} = $command; - $k -> ArrayValues(0); - # delete possibly conflicting values from HKCU/software - $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - reg_delete_recurse($classes_key, $file_type); - } else { - $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - $k = $classes_key->CreateKey($file_type."/Shell/Open/Command/"); - $k -> ArrayValues(0); - $k -> {"/"} = $command; - } + my $keyhash = { + "shell/" => { + "open/" => { + "command/" => { + "/" => $command + } + } + } + }; + do_write_regkey(2, "Software/Classes/$file_type", $keyhash); } =pod @@ -790,24 +857,80 @@ sub unregister_file_type { # we don't error check; we just do the best we can. my $file_type = shift; debug ("unregistering $file_type\n"); + do_remove_regkey(2, "Software/Classes/$file_type/"); +} - my $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - if ($classes_key) { - reg_delete_recurse ($classes_key, $file_type."/"); - } else { - tlwarn("Cannot open HKCU classes for write\n"); - } - if ($is_admin) { - $classes_key = $Registry -> Open("LMachine/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - if ($classes_key) { - reg_delete_recurse ($classes_key, $file_type."/"); - } else { - debug ("Cannot open HKLM classes for write\n"); - } - #reg_delete_recurse ($classes_key, $file_type); - } +=pod + +=item C<register_application($prog, $path, $exts)> + +Add registry entry to set full path of $prog to $path and optionally +specify which extensions it handles + +=cut + +sub register_application { + my $prog = shift; # redundant, but more natural than just $path + my $path = shift; + my $exts = shift; + + my $hsh; + foreach my $e (@$exts) {$hsh->{"/$e"} = "";} + #my $prog = TeXLive::TLUtils::basename($path); + $cmd = "\"$path\" \"%1\""; + $cmd =~ s!/!\\!g; + my $keyhash = { + "shell/" => { + "open/" => { + "command/" => { + "/" => $cmd + } + } + }, + "SupportedTypes" => $hsh + }; + do_write_regkey(2, "Software/Classes/Applications/$prog", $keyhash); +} + +=pod + +=item C<unregister_application($prog)> + +Reversal of register_application + +=cut + +sub unregister_application { + my $prog = shift; + do_remove_regkey(2, "Software/Classes/Applications/$prog/"); +} + +=pod + +=item C<add_to_openwithlist($ext, $prog)> + +Add $prog to the list of programs which open $ext files + +=cut + +sub add_to_openwithlist { + my $ext = shift; + my $prog = shift; + do_write_regkey(2, "Software/Classes/$ext/OpenWithList/$prog", {}); +} + +=pod + +=item C<remove_from_openwithlist($ext, $prog)> + +Remove $prog from the list of programs which open $ext files + +=cut + +sub remove_from_openwithlist { + my $ext = shift; + my $prog = shift; + do_remove_regkey(2, "Software/Classes/$ext/OpenWithList/$prog"); } =pod @@ -907,14 +1030,16 @@ sub shell_folder { if (admin()) { return 0 unless $admin_name; $shell_key = $Registry->Open( - "LMachine/software/microsoft/windows/currentversion/explorer/shell folders/", - {Access => KEY_READ}); - $sh_folder = short_name($shell_key -> {"/$admin_name"}); + "LMachine/software/microsoft/windows/currentversion/explorer/user shell folders/", + {Access => KEY_READ}) or return 0; + $sh_folder = $shell_key -> {"/$admin_name"}; + $sh_folder = short_name(expand_string($sh_folder)); } else { $shell_key = $Registry->Open( - "CUser/software/microsoft/windows/currentversion/explorer/shell folders/", - {Access => KEY_READ}); - $sh_folder = short_name($shell_key -> {"/$user_name"}); + "CUser/software/microsoft/windows/currentversion/explorer/user shell folders/", + {Access => KEY_READ}) or return 0; + $sh_folder = $shell_key -> {"/$user_name"}; + $sh_folder = short_name(expand_string($sh_folder)); } $sh_folder =~ s!\\!/!g; return $sh_folder; @@ -922,38 +1047,10 @@ sub shell_folder { sub desktop_path() { return shell_folder('Desktop'); - #my ($shell_key, $deskpath); - #if (admin()) { - # $shell_key = $Registry->Open( - # "LMachine/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $deskpath = short_name($shell_key -> {"/Common Desktop"}); - #} else { - # $shell_key = $Registry->Open( - # "CUser/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $deskpath = short_name($shell_key -> {"/Desktop"}); - #} - #$deskpath =~ s!\\!/!g; - #return $deskpath; } sub menu_path() { return shell_folder('Programs', 'Common Programs'); - #my ($shell_key, $menupath); - #if (admin()) { - # $shell_key = $Registry->Open( - # "LMachine/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $menupath = short_name($shell_key -> {"/Common Programs"}); - #} else { - # $shell_key = $Registry->Open( - # "CUser/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $menupath = short_name($shell_key -> {"/Programs"}); - #} - #$menupath =~ s!\\!/!g; - #return $menupath; } =pod @@ -1063,16 +1160,12 @@ the job. =cut sub create_uninstaller { - my ($tdfw, $tdwfw, $tdsvfw, $tdscfw) = @_; - # TEXDIR, TEXDIRW, TEXMFSYSVAR, TEXMFSYSCONFIG + my ($tdfw, $tdsvfw, $tdscfw) = @_; + # TEXDIR, TEXMFSYSVAR, TEXMFSYSCONFIG $tdfw =~ s![\\/]$!!; my $td = $tdfw; $td =~ s!/!\\!g; - $tdwfw =~ s![\\/]$!!; - my $tdw = $tdwfw; - $tdw =~ s!/!\\!g; - $tdsvfw =~ s![\\/]$!!; my $tdsv = $tdsvfw; $tdsv =~ s!/!\\!g; @@ -1087,12 +1180,12 @@ sub create_uninstaller { my $k = $uninst_key->CreateKey( "uninstall/TeXLive$::TeXLive::TLConfig::ReleaseYear/"); $k->{"/DisplayName"} = "TeX Live $::TeXLive::TLConfig::ReleaseYear"; - $k->{"/UninstallString"} = "\"$tdw\\tlpkg\\installer\\uninst.bat\""; + $k->{"/UninstallString"} = "\"$td\\tlpkg\\installer\\uninst.bat\""; $k->{'/DisplayVersion'} = $::TeXLive::TLConfig::ReleaseYear; $k->{'/URLInfoAbout'} = "http://www.tug.org/texlive"; - mkdirhier("$tdwfw/tlpkg/installer"); # wasn't this done yet? - if (open UNINST, ">$tdwfw/tlpkg/installer/uninst.bat") { + mkdirhier("$tdfw/tlpkg/installer"); # wasn't this done yet? + if (open UNINST, ">$tdfw/tlpkg/installer/uninst.bat") { print UNINST <<UNEND; \@echo off setlocal @@ -1101,18 +1194,18 @@ path $td\\tlpkg\\tlperl\\bin;$td\\bin\\win32;%path% set PERL5LIB=$td\\tlpkg\\tlperl\\lib perl.exe \"$td\\texmf\\scripts\\texlive\\uninstall-win32.pl\" if errorlevel 1 goto :eof -copy \"$tdw\\tlpkg\\installer\\uninst2.bat\" \"\%TEMP\%\" +copy \"$td\\tlpkg\\installer\\uninst2.bat\" \"\%TEMP\%\" rem pause \"\%TEMP\%\\uninst2.bat\" UNEND ; close UNINST; } else { - warn "Cannot open $tdwfw/tlpkg/installer/uninst.bat for append"; + warn "Cannot open $tdfw/tlpkg/installer/uninst.bat for append"; } - if (open UNINST2, ">$tdwfw/tlpkg/installer/uninst2.bat") { - print UNINST2 <<UNEND2 if ($td eq $tdw); + if (open UNINST2, ">$tdfw/tlpkg/installer/uninst2.bat") { + print UNINST2 <<UNEND2; rmdir /s /q \"$td\\texmf-dist\" rmdir /s /q \"$td\\texmf-doc\" rmdir /s /q \"$td\\texmf\" @@ -1135,14 +1228,14 @@ UNEND2 print UNINST2 <<UNEND2; rmdir /s /q \"$tdsv\" rmdir /s /q \"$tdsc\" -rmdir /s /q \"$tdw\\temp\" -rmdir /s /q \"$tdw\\tlpkg\" -del \"$tdw\\install-tl.log\" -del \"$tdw\\texlive.profile\" 2>nul -del \"$tdw\\release-texlive.txt\" +rmdir /s /q \"$td\\temp\" +rmdir /s /q \"$td\\tlpkg\" +del \"$td\\install-tl.log\" +del \"$td\\texlive.profile\" 2>nul +del \"$td\\release-texlive.txt\" set test= -for \%\%f in (\"$tdw\\*.*\") do \@set test=nonempty -if x\%test\%==x rd \"$tdw\" +for \%\%f in (\"$td\\*.*\") do \@set test=nonempty +if x\%test\%==x rd \"$td\" \@echo Done uninstalling TeXLive. rem \@pause del %0 @@ -1150,7 +1243,7 @@ UNEND2 ; close UNINST2; } else { - warn "Cannot open $tdwfw/tlpkg/installer/uninst2.bat for writing"; + warn "Cannot open $tdfw/tlpkg/installer/uninst2.bat for writing"; } } |