diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLWinGoo.pm')
| -rw-r--r-- | Master/tlpkg/TeXLive/TLWinGoo.pm | 154 |
1 files changed, 117 insertions, 37 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm index 0a5bbba2908..de2f6255b60 100644 --- a/Master/tlpkg/TeXLive/TLWinGoo.pm +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -5,6 +5,11 @@ # This file is licensed under the GNU General Public License version 2 # or any later version. +# code for broadcast_env adopted from Win32::Env: +# Copyright 2006 Oleg "Rowaa[SR13]" V. Volkov, all rights reserved. +# This program is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. + package TeXLive::TLWinGoo; =pod @@ -17,15 +22,18 @@ C<TeXLive::TLWinGoo> -- Additional utilities for Windows use TeXLive::TLWinGoo; + TeXLive::TLWinGoo::wg_error; TeXLive::TLWinGoo::admin; TeXLive::TLWinGoo::dir_writable($d); TeXLive::TLWinGoo::expand_string($s); TeXLive::TLWinGoo::global_tmpdir; TeXLive::TLWinGoo::get_system_path; TeXLive::TLWinGoo::get_user_path; - TeXLive::TLWinGoo::win_which_dir($prog); TeXLive::TLWinGoo::add_texbindir_to_path($texpath); TeXLive::TLWinGoo::register_script_type($extension, $command); + TeXLive::TLWinGoo::broadcast_env; + +All exported functions return forward slashes. =head2 DESCRIPTION @@ -38,18 +46,20 @@ BEGIN { use vars qw( @ISA @EXPORT $Registry); @ISA = qw( Exporter ); @EXPORT = qw( + &wg_error &admin &dir_writable &expand_string &global_tmpdir &get_system_path &get_user_path - &win_which_dir &add_texbindir_to_path ®ister_script_type + &broadcast_env ); if ($^O=~/^MSWin(32|64)$/i) { + require Win32::API; require Win32::TieRegistry; Win32::TieRegistry->import( qw( $Registry REG_SZ REG_EXPAND_SZ KEY_READ KEY_WRITE KEY_ALL_ACCESS @@ -60,6 +70,14 @@ BEGIN { } } +######################################### +# Variables storing status information. + +# error status stored in wg_errno and wg_errmess + +my $wg_error = 0; +my $wg_error_message = ""; + my $is_win = $^O=~/^MSWin(32|64)$/i; # Under Windows, the variables below are calculated while loading this module. @@ -80,9 +98,10 @@ sub get_system_env { {Access => sys_access_permissions()}); } -# $is_admin was set to true. With this value, sys-access_permissions returns -# full access permissions. If that doesn't work out then apparently -# we aren't administrator, so we set $is_admin to 0. +# $is_admin was set to true originally. With this value, +# sys-access_permissions returns full access permissions. If that +# doesn't work out then apparently we aren't administrator, so we +# set $is_admin to 0. if ($is_win) { $is_admin = 0 if not get_system_env(); @@ -92,6 +111,24 @@ 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 numer 0 + +=cut + +sub wg_error { + my @retval = ($wg_error, $wg_error_message); + $wg_error = 0; + $wg_error_message = ""; + return @retval; +} + =pod =item C<admin> @@ -173,12 +210,12 @@ sub global_tmpdir { return $global_tmp; } sub is_a_texdir { my $d = shift; - my $xd = expand_string($d); - $xd =~ s/\\/\//g; - $xd =~ s/\/$//; - my $xd1 = $xd . '/pdftex.exe'; - my $xd2 = $xd . '/tex.exe'; - return ((-e $xd1) or (-e $xd2)); + #my $xd = expand_string($d); + $d =~ s/\\/\//g; + $d =~ s/\/$//; + my $d1 = $d . '/pdftex.exe'; + my $d2 = $d . '/tex.exe'; + return ((-e $d1) or (-e $d2)); } =pod @@ -193,6 +230,8 @@ forward slashes. sub get_system_path { my $value = get_system_env() -> {'/Path'}; $value =~ s/\\/\//g; + # Remove terminating zero bytes; there may be several, at least + # under w2k, and the FixSzNulls option only removes one. $value =~ s/[\s\x00]+$//; return $value; } @@ -215,16 +254,16 @@ 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. - -=cut +#=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 not used. +# +#=cut sub win_which_dir { my $prog = shift; @@ -240,14 +279,14 @@ 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<add_to_path> +# +#Returns its arguments joined with C<;> as separator, or returns the second +#argument if the first is an empty string. +# +#=cut sub add_to_path { my $old_path = shift @_; @@ -262,18 +301,29 @@ sub add_to_path { Remove any TeX directories from system path (if possible) and user path. A directory is a TeX directory if it contains tex.exe or pdftex.exe. Then add desired TeX directory; to system path if -admin, otherwise to user path. +admin, otherwise to user path. wg_error gets set if there is a +connflicting tex directory which cannot be removed from the path. =cut sub add_texbindir_to_path { + $wg_error = 0; # clear error status $texbindir = shift; my $syspath_temp = ""; + my $d_exp; foreach $d (split (';', get_system_path())) { - print "Warning: possibly conflicting [pdf]TeX program found at ". - expand_string($d)."\n" if is_a_texdir($d) and !$is_admin; - $syspath_temp = add_to_path($syspath_temp, $d) - if (not is_a_texdir($d)) and $is_admin; + $d_exp = expand_string($d); + $d_exp =~ s/\\/\//g; + $d_exp =~ s/\/$//; + if (is_a_texdir($d_exp)) { + if (!$is_admin and (uc($d_exp) ne uc($texbindir))) { + $wg_error = 1; + $wg_error_message = + "Warning: possibly conflicting [pdf]TeX program found at $d_exp\n"; + } + } elsif ($is_admin) { + $syspath_temp = add_to_path($syspath_temp, $d); + } } if ($is_admin) { @@ -290,11 +340,13 @@ sub add_texbindir_to_path { my $userpath_temp = ""; foreach $d (split (';', get_user_path())) { - $userpath_temp = add_to_path($userpath_temp, $d) if (not is_a_texdir($d)); + $d_exp = expand_string($d); + $userpath_temp = add_to_path($userpath_temp, $d) if (not is_a_texdir($d_exp)); } $userpath_temp = add_to_path($userpath_temp, $texbindir) if !$is_admin; if ($userpath_temp) { + $userpath_temp =~ s/\//\\/g; my $user_env = get_user_env(); $user_env->ArrayValues(1); # use value_data, value_type pairs $user_env -> {"/Path"} = [ $userpath_temp, @@ -311,8 +363,6 @@ sub add_texbindir_to_path { Add registry entries to associate $extension with $command and make $extension an executable file type. Slashes are flipped where necessary. -=back - =cut sub register_script_type { @@ -350,6 +400,36 @@ sub register_script_type { SetValue("", $command.' "%1" %*'); } +=pod + +=item C<broadcast_env> + +Broadcasts system message that enviroment has changed. This only has +an effect on newly-started programs, not on running programs and the +processes they spawn. + +=cut + +sub broadcast_env() { + use constant HWND_BROADCAST => 0xffff; + use constant WM_SETTINGCHANGE => 0x001A; + my @proto = ('SendMessage', 'LLPP', 'L'); + my $result = ""; + my $SendMessage; + $wg_error = 0; + print "Broadcasting \"Enviroment settings changed\" message...\n"; + $SendMessage = new Win32::API('user32', @proto); + $result = $SendMessage->Call(HWND_BROADCAST, WM_SETTINGCHANGE, + 0, 'Environment') if $SendMessage; + print "Broadcast complete; result: $result.\n"; +} + +=pod + +=back + +=cut + # needs a terminal 1 for require to succeed! 1; |