summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm283
1 files changed, 210 insertions, 73 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm
index 4f4d974a217..8e4c79a5303 100644
--- a/Master/tlpkg/TeXLive/TLWinGoo.pm
+++ b/Master/tlpkg/TeXLive/TLWinGoo.pm
@@ -22,18 +22,34 @@ C<TeXLive::TLWinGoo> -- Additional utilities for Windows
use TeXLive::TLWinGoo;
+=head2 ERROR HANDLING
+
TeXLive::TLWinGoo::wg_error;
+
+=head2 DIAGNOSTICS
+
+ TeXLive::TLWinGoo::win_version;
+ TeXLive::TLWinGoo::is_vista;
TeXLive::TLWinGoo::admin;
TeXLive::TLWinGoo::non_admin;
TeXLive::TLWinGoo::reg_country;
TeXLive::TLWinGoo::dir_writable($d);
+
+=head2 ENVIRONMENT AND REGISTRY
+
TeXLive::TLWinGoo::expand_string($s);
TeXLive::TLWinGoo::global_tmpdir;
TeXLive::TLWinGoo::get_system_path;
TeXLive::TLWinGoo::get_user_path;
+ TeXLive::TLWinGoo::setenv_reg($env_var, $env_data);
+ TeXLive::TLWinGoo::unsetenv_reg($env_var);
TeXLive::TLWinGoo::add_texbindir_to_path($texpath);
+ TeXLive::TLWinGoo::remove_texbindirs_from_path;
TeXLive::TLWinGoo::register_script_type($extension, $command);
TeXLive::TLWinGoo::unregister_script_type($extension);
+
+=head2 ACTIVATING CHANGES IMMEDIATELY
+
TeXLive::TLWinGoo::broadcast_env;
TeXLive::TLWinGoo::update_assocs;
@@ -51,6 +67,8 @@ BEGIN {
@ISA = qw( Exporter );
@EXPORT = qw(
&wg_error
+ &win_version
+ &is_vista
&admin
&non_admin
&reg_country
@@ -59,6 +77,8 @@ BEGIN {
&global_tmpdir
&get_system_path
&get_user_path
+ &setenv_reg
+ &unsetenv_reg
&add_texbindir_to_path
&remove_texbindirs_from_path
&register_script_type
@@ -75,6 +95,8 @@ BEGIN {
&global_tmpdir
);
if ($^O=~/^MSWin(32|64)$/i) {
+ #require Win32;
+ #Win32->import( qw( GetOSVersion ) );
require Win32::API;
require Win32::TieRegistry;
Win32::TieRegistry->import( qw( $Registry
@@ -88,24 +110,71 @@ BEGIN {
use TeXLive::TLUtils;
-#########################################
-# Variables storing status information.
+my $is_win = $^O=~/^MSWin(32|64)$/i;
-# error status stored in wg_errno and wg_errmess
+=pod
+
+=back
+
+=head2 ERROR HANDLING
+
+=over 6
+
+=item C<wg_error>
+
+Returns WinGoo error status, in the shape of an array (number,
+message) and clears the error status. No error <=> error number 0
+
+=cut
my $wg_error = 0;
my $wg_error_message = "";
-my $is_win = $^O=~/^MSWin(32|64)$/i;
+sub wg_error {
+ my @retval = ($wg_error, $wg_error_message);
+ $wg_error = 0;
+ $wg_error_message = "";
+ return @retval;
+}
-# Under Windows, the variables below are calculated while loading this module.
-# The functions &admin and &global_tmpdir simply return these variables.
+=pod
-my $is_admin = 1;
-my $global_tmp = "/tmp";
+=back
+
+=head2 DIAGNOSTICS
+
+=over 6
+
+=item C<win_version>
+
+C<win_version> returns the Windows version number as stored in the
+registry: 5.0 for Windows 2000, 5.1 for Windows XP and 6.0 for Vista.
+
+=cut
+
+my $windows_version = 0;
+
+if ($is_win) {
+ my $tempkey = $Registry->Open(
+ "LMachine/software/Microsoft/Windows NT/CurrentVersion/",
+ {Access => KEY_READ() });
+ $windows_version = $tempkey -> { "/CurrentVersion" };
+}
+
+sub win_version { return $windows_version; }
+
+=item C<is_vista>
+
+C<is_vista> returns 1 if win_version is >= 6.0, otherwise 0.
+
+=cut
+
+sub is_vista { return $windows_version >= 6; }
# permissions with which we try to access the system environment
+my $is_admin = 1;
+
sub sys_access_permissions {
$is_admin ? KEY_ALL_ACCESS() : KEY_READ() | KEY_ENUMERATE_SUB_KEYS();
}
@@ -129,24 +198,6 @@ sub get_user_env {
return $Registry -> Open("CUser/Environment", {Access => KEY_ALL_ACCESS()});
}
-# error handling
-
-=pod
-
-=item C<wg_error>
-
-Returns WinGoo error status, in the shape of an array (number,
-message) and clears the error status. No error <=> error number 0
-
-=cut
-
-sub wg_error {
- my @retval = ($wg_error, $wg_error_message);
- $wg_error = 0;
- $wg_error_message = "";
- return @retval;
-}
-
=pod
=item C<admin>
@@ -162,8 +213,8 @@ sub admin { return $is_admin; }
=item C<non_admin>
-Renounce admin privileges, to enforce a user- rather than a system
-install.
+Pretend not to have admin privileges, to enforce a user- rather than
+a system install.
Currently only used for testing.
@@ -195,7 +246,7 @@ sub reg_country {
=pod
-=item C<dir_writable>
+=item C<dir_writable($d)>
Tests whether its argument is writable by trying to write to
it. This function is necessary because the built-in C<-w> test
@@ -221,7 +272,28 @@ sub dir_writable {
=pod
-=item C<expand_string>
+=back
+
+=head2 ENVIRONMENT AND REGISTRY
+
+=over 6
+
+Most settings can be made for a user and for the system. User
+settings override system settings.
+
+For admin users, the functions below affect both user- and system
+settings. For non-admin users, only user settings are changed.
+
+An exception is the search path: the effective searchpath consists
+of the system searchpath in front concatenated with the user
+searchpath at the back.
+
+Note that in a roaming profile network setup, users take only user
+settings with them to other systems, not system settings. In this
+case, with a TeXLive on the network, a nonadmin install makes the
+most sense.
+
+=item C<expand_string($s)>
This function replaces substrings C<%env_var%> with their current
values as environment variable and returns the result.
@@ -255,6 +327,8 @@ if ($is_win) {
$global_tmp = expand_string(get_system_env()->{'TEMP'}) if $is_win;
}
+my $global_tmp = "/tmp";
+
sub global_tmpdir { return $global_tmp; }
sub is_a_texdir {
@@ -328,24 +402,64 @@ sub win_which_dir {
return 0;
}
-#=pod
-#
-#=item C<add_to_path>
-#
-#Returns its arguments joined with C<;> as separator, or returns the second
-#argument if the first is an empty string.
-#
-#=cut
+=pod
+
+=item C<setenv_reg($env_var, $env_data[, $mode]);>
-sub add_to_path {
- my $old_path = shift @_;
- my $addition = shift @_;
- return ($old_path eq "") ? $addition : $old_path . ";" . $addition;
+Set an environment variable $env_var to $env_data.
+
+$mode="user": set for current user. $mode="system": set for all
+users. Default: both if admin, current user otherwise.
+
+=cut
+
+sub setenv_reg {
+ my $env_var = shift;
+ my $env_data = shift;
+ my $mode = @_ ? shift : "default";
+ die "setenv_reg: Invalid mode"
+ if ($mode ne "user" and $mode ne "system" and $mode ne "default");
+ die "setenv_reg: mode 'system' only available for admin"
+ if ($mode eq "system" and !$is_admin);
+ my $env;
+ if ($mode ne "system") {
+ my $env = get_user_env();
+ $env->ArrayValues(1);
+ $env->{'/'.$env_var} =
+ [ $env_data, ($env_data =~ /%/) ? REG_EXPAND_SZ : REG_SZ ];
+ }
+ if ($mode ne "user" and $is_admin) {
+ $env = get_system_env();
+ $env->ArrayValues(1);
+ $env->{'/'.$env_var} =
+ [ $env_data, ($env_data =~ /%/) ? REG_EXPAND_SZ : REG_SZ ];
+ }
+}
+
+=pod
+
+=item C<unsetenv_reg($env_var[, $mode]);>
+
+Unset an environment variable $env_var
+
+=cut
+
+sub unsetenv_reg {
+ my $env_var = shift;
+ my $env = get_user_env();
+ my $mode = @_ ? shift : "default";
+ print "Unsetenv_reg: unset $env_var with mode $mode\n";
+ die "unsetenv_reg: Invalid mode"
+ if ($mode ne "user" and $mode ne "system" and $mode ne "default");
+ die "unsetenv_reg: mode 'system' only available for admin"
+ if ($mode eq "system" and !$is_admin);
+ delete get_user_env()->{'/'.$env_var} if $mode ne "system";
+ delete get_system_env()->{'/'.$env_var} if ($mode ne "user" and $is_admin);
}
=pod
-=item C<add_texbindir_to_path>
+=item C<add_texbindir_to_path($texpath)>
Remove wrong TeX directories from system path (if possible) and user
path. A directory is a TeX directory if it contains tex.exe or
@@ -385,8 +499,9 @@ sub add_texbindir_to_path {
$found = 1;
$newp = join (';', @newpt);
$newp =~ s/\//\\/g;
- $system_env->ArrayValues(1); # use value_data, value_type pairs
- $system_env -> {"/Path"} = [ $newp, REG_EXPAND_SZ ];
+ setenv_reg("Path", $newp, "system");
+ #$system_env->ArrayValues(1); # use value_data, value_type pairs
+ #$system_env -> {"/Path"} = [ $newp, REG_EXPAND_SZ ];
} else { # non-admin
# system path
foreach $d (split (';', get_system_path())) {
@@ -422,13 +537,24 @@ sub add_texbindir_to_path {
$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 ];
+ #$user_env -> {"/Path"} = [ $newp,
+ # ($newp =~ /%/) ? REG_EXPAND_SZ : REG_SZ ];
+ setenv_reg("Path", $newp, "user");
} else {
- delete $user_env -> {'/Path'};
+ unsetenv_reg("PAth", "user");
}
}
+=pod
+
+=item C<remove_texbindirs_from_path>
+
+Remove all directories from the searchpath which contain tex.exe or
+pdftex.exe. Do this with the user path and if admin also with the
+system path.
+
+=cut
+
sub remove_texbindirs_from_path {
$wg_error = 0; # clear error status
@@ -447,8 +573,7 @@ sub remove_texbindirs_from_path {
}
$newp = join (';', @newpt);
$newp =~ s/\//\\/g;
- $system_env->ArrayValues(1); # use value_data, value_type pairs
- $system_env -> {"/Path"} = [ $newp, REG_EXPAND_SZ ];
+ setenv_reg("Path", $newp, "system");
}
# user path
@@ -462,11 +587,9 @@ sub remove_texbindirs_from_path {
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 ];
+ setenv_reg("Path", $newp, "user");
} else {
- delete $user_env -> {"/Path"};
+ unsetenv_reg("Path", "user");
}
}
@@ -494,7 +617,9 @@ sub reg_delete_recurse {
=pod
-=item C<register_script_type>
+=pod
+
+=item C<register_script_type($extension, $command)>
Add registry entries to associate $extension with $command and make
$extension an executable file type. Slashes are flipped where necessary.
@@ -510,7 +635,7 @@ sub register_script_type {
tllog ($::LOG_DDEBUG, "Linking $extension to $command\n");
my $user_env = get_user_env();
my $system_env = get_system_env();
- my ($pathext, $found, $e, $classes_key);
+ my ($pathext, $found, $e, $classes_key, $k);
# pathext
if ($is_admin) {
@@ -520,7 +645,7 @@ sub register_script_type {
foreach $e (split(/;/,$pathext)) {
$found = 1 if (uc($e) eq $extension);
}
- $system_env -> {'/PATHEXT'} = $pathext.";".$extension unless $found;
+ setenv_reg("PATHEXT", $pathext.";".$extension, "system") unless $found;
# user pathext
$pathext = $user_env -> {'/PATHEXT'};
if ($pathext) {
@@ -528,7 +653,7 @@ sub register_script_type {
foreach $e (split(/;/,$pathext)) {
$found = 1 if (uc($e) eq $extension);
}
- $user_env -> {'/PATHEXT'} = $pathext.";".$extension unless $found;
+ setenv_reg("PATHEXT", $pathext.";".$extension, "user") unless $found;
}
} else { # non-admin
$pathext = $user_env -> {'/PATHEXT'};
@@ -537,7 +662,7 @@ sub register_script_type {
foreach $e (split(/;/,$pathext)) {
$found = 1 if (uc($e) eq $extension);
}
- $user_env -> {"/PATHEXT"} = $pathext.";".$extension unless $found;
+ setenv_reg("PATHEXT", $pathext.";".$extension, "user") unless $found;
}
# file type
@@ -545,10 +670,13 @@ sub register_script_type {
if ($is_admin) {
$classes_key = $Registry -> Open("LMachine/Software/Classes/",
{Access => KEY_ALL_ACCESS()}) or die "Cannot open classpath";
- $classes_key->ArrayValues(0);
- $classes_key->CreateKey($extension)->SetValue("","script".$extension);
- $classes_key->CreateKey("script".$extension."/Shell/Open/Command/")->
- SetValue("", '"'.$command.'" "%1" %*');
+ $k = $classes_key->CreateKey($extension);
+ $k -> ArrayValues(0);
+ $k -> {"/"} = "script".$extension;
+ $k = $classes_key->CreateKey("script".$extension."/Shell/Open/Command/");
+ $k -> ArrayValues(1);
+ $k -> {"/"} = [ '"'.$command.'" "%1" %*',
+ ($command =~ /%/) ? REG_EXPAND_SZ : REG_SZ ];
# delete possibly conflicting values from HKCU/software
$classes_key = $Registry -> Open("CUser/Software/Classes/",
{Access => KEY_ALL_ACCESS()});
@@ -557,16 +685,19 @@ sub register_script_type {
} else {
$classes_key = $Registry -> Open("CUser/Software/Classes/",
{Access => KEY_ALL_ACCESS()});
- $classes_key->ArrayValues(0);
- $classes_key->CreateKey($extension)->SetValue("","script".$extension);
- $classes_key->CreateKey("script".$extension."/Shell/Open/Command/")->
- SetValue("", '"'.$command.'" "%1" %*');
+ $k = $classes_key->CreateKey($extension);
+ $k -> ArrayValues(0);
+ $k -> {"/"} = "script".$extension;
+ $k = $classes_key->CreateKey("script".$extension."/Shell/Open/Command/");
+ $k -> ArrayValues(1);
+ $k -> {"/"} = [ '"'.$command.'" "%1" %*',
+ ($command =~ /%/) ? REG_EXPAND_SZ : REG_SZ ];
}
}
=pod
-=item C<unregister_script_type>
+=item C<unregister_script_type($extension)>
Reversal of register_script_type.
@@ -591,7 +722,7 @@ sub unregister_script_type {
push @newpe, $e unless (uc($e) eq $extension);
}
$newpex = join(";",@newpe);
- $system_env -> {"/PATHEXT"} = $newpex;
+ setenv_reg("PATHEXT", $newpex, "system");
$pathext = $user_env -> {'/PATHEXT'};
if ($pathext) {
@@ -601,9 +732,9 @@ sub unregister_script_type {
}
$newpex = join(";",@newpe);
if ($newpex eq ($system_env -> {"/PATHEXT"})) {
- delete $user_env->{"/PATHEXT"};
+ unsetenv_reg("PATHEXT", "user");
} else {
- $user_env -> {"/PATHEXT"} = $newpex;
+ setenv_reg("PATHEXT", $newpex, "user");
}
}
} else {
@@ -615,9 +746,9 @@ sub unregister_script_type {
}
$newpex = join(";",@newpe);
if ($newpex eq ($system_env -> {"/PATHEXT"})) {
- delete $user_env->{"/PATHEXT"};
+ unsetenv_reg("PATHEXT", "user");
} else {
- $user_env -> {"/PATHEXT"} = $newpex;
+ setenv_reg("PATHEXT", $newpex, "user");
}
}
@@ -647,6 +778,12 @@ sub unregister_script_type {
=pod
+=back
+
+=head2 ACTIVATING CHANGES IMMEDIATELY
+
+=over 6
+
=item C<broadcast_env>
Broadcasts system message that enviroment has changed. This only has
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 23:56:28 +0000