TLWinGoo:

- added broadcast_env
- exports fewer functions, but maybe still too many
- added error flag; not yet used in install-tl



git-svn-id: svn://tug.org/texlive/trunk@6345 c570f23f-e606-0410-a88d-b1316a301751

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
     &register_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;