summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLWinGoo.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLWinGoo.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm615
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
&register_file_type
&unregister_file_type
+ &register_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";
}
}