diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2008-01-10 22:56:04 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2008-01-10 22:56:04 +0000 |
commit | a085c27f4e2244e388b7cac1fc3eacd6bc2b90f6 (patch) | |
tree | 445cadf77db143dbadfde75c003c9a46dd9e53f6 /Master/tlpkg/TeXLive/TLWinGoo.pm | |
parent | be3452a1329d292353703349c6aee8715c6eb6ac (diff) |
Added: module TLWinGoo.pm with Windows stuff plus test/demo
wingoo-demo.[pl|bat].
git-svn-id: svn://tug.org/texlive/trunk@6184 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLWinGoo.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLWinGoo.pm | 323 |
1 files changed, 323 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm new file mode 100644 index 00000000000..3629d49007c --- /dev/null +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -0,0 +1,323 @@ +# TeXLive::TLWinGoo.pm +# Windows nastiness +# +# Copyright 2007 Siep Kroonenberg +# This file is licensed under the GNU General Public License version 2 +# or any later version. + +package TeXLive::TLWinGoo; + +=pod + +=head1 NAME + +C<TeXLive::TLWinGoo> -- Additional utilities for Windows + +=head2 SYNOPSIS + + use TeXLive::TLWinGoo; + + 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); + +=head2 DESCRIPTION + +=over 6 + +=cut + +BEGIN { + use Exporter; + use vars qw( @ISA @EXPORT $Registry); + @ISA = qw( Exporter ); + @EXPORT = qw( + &admin + &dir_writable + &expand_string + &global_tmpdir + &get_system_path + &get_user_path + &win_which_dir + &add_texbindir_to_path + ); + + if ($^O=~/^MSWin(32|64)$/i) { + require Win32::TieRegistry; + Win32::TieRegistry->import( qw( $Registry + REG_SZ REG_EXPAND_SZ KEY_READ KEY_WRITE KEY_ALL_ACCESS + KEY_ENUMERATE_SUB_KEYS ) ); + $Registry->Delimiter('/'); + $Registry->ArrayValues(0); + $Registry->FixSzNulls(1); + } +} + +my $is_win = $^O=~/^MSWin(32|64)$/i; + +# Under Windows, the variables below are calculated while loading this module. +# The functions &admin and &global_tmpdir simply return these variables. + +my $is_admin = 1; +my $global_tmp = "/tmp"; + +# permissions with which we try to access the system environment + +sub sys_access_permissions { + $is_admin ? KEY_ALL_ACCESS() : KEY_READ() | KEY_ENUMERATE_SUB_KEYS(); +} + +sub get_system_env { + return $Registry -> Open( + "LMachine/system/currentcontrolset/control/session manager/Environment/", + {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. + +if ($is_win) { + $is_admin = 0 if not get_system_env(); +} + +sub get_user_env { + return $Registry -> Open("CUser/Environment", {Access => KEY_ALL_ACCESS()}); +} + +=pod + +=item C<admin> + +Our test for being an administrator is the ability to change the +system environment. + +It would be nice to have an install/menu option to set admin to +false in case the user wants to install just for himself. + +=cut + +sub admin { return $is_admin; } + +=pod + +=item C<dir_writable> + +Tests whether its argument is writable by trying to write to +it. This function is necessary because the built-in C<-w> test +apparently doesn't work under Windows. + +=cut + +sub dir_writable { + $d=shift; + return 0 unless -d $d; + $d =~ s!\\!/!g; + $d =~ s!/$!!g; + my $i=0; + while (-e $d . "/" . $i) { $i++; } + my $f = $d."/".$i; + #print $f."\n"; + return 0 unless open TEST, ">".$f; + my $written = 0; + $written = (print TEST "\n"); + close TEST; + unlink $f; + return $written; +} + +=pod + +=item C<expand_string> + +This function replaces substrings C<%env_var%> with their current +values as environment variable and returns the result. + +=cut + +sub expand_string { + $s = shift @_; + while ($s =~ /^([^%]*)%([^%]+)%(.*)$/) { + foreach $k (keys %ENV) { + if (uc($k) eq uc($2)) { + $s = $1 . $ENV{$k} . $3; + last; + } + } + } + $s; +} + +=pod + +=item C<global_tmpdir> + +Returns the expanded value of C<%TEMP%> from the system environment, +usually C<%SystemRoot%/Temp>. This value is normally not available +from C<%ENV>. + +=cut + +if ($is_win) { + $global_tmp = expand_string(get_system_env()->{'TEMP'}) if $is_win; +} + +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)); +} + +=pod + +=item C<get_system_path> + +Returns unexpanded system path, as stored in the registry, but with +forward slashes. + +=cut + +sub get_system_path { + $Registry->ArrayValues(0); + my $value = get_system_env() -> {'/Path'}; + $value =~ s/\\/\//g; + $value =~ s/[\s\x00]+$//; + return $value; +} + +=pod + +=item C<get_user_path> + +Returns unexpanded user path, as stored in the registry, but with +forward slashes. The user path often does not exist, and is rarely +expandable. + +=cut + +sub get_user_path { + $Registry->ArrayValues(0); + my $value = get_user_env() -> {'/Path'}; + return "" if not $value; + $value =~ s/\\/\//g; + $value =~ s/[\s\x00]+$//; + 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 + +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; + foreach $d (split (';',$path)) { + $d =~ s/\/$//; + return $d if -e $d.'/'.$prog; + } + 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 + +sub add_to_path { + my $old_path = shift @_; + my $addition = shift @_; + return ($old_path eq "") ? $addition : $old_path . ";" . $addition; +} + +=pod + +=item C<add_texbindir_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. + +=back + +=cut + +sub add_texbindir_to_path { + $texbindir = shift; + my $syspath_temp = ""; + 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; + } + + if ($is_admin) { + $syspath_temp = add_to_path($syspath_temp, $texbindir); + $syspath_temp =~ s/\//\\/g; + my $system_env = get_system_env(); + $system_env->ArrayValues(1); # use value_data, value_type pairs + $system_env -> {"/Path"} = [ $syspath_temp, REG_EXPAND_SZ ]; + } + + # fix user path + # admin: remove any texdir but don't add anything + # user: remove any texdir and append new texdir + + my $userpath_temp = ""; + foreach $d (split (';', get_user_path())) { + $userpath_temp = add_to_path($userpath_temp, $d) if (not is_a_texdir($d)); + } + + $userpath_temp = add_to_path($userpath_temp, $texbindir) if !$is_admin; + if ($userpath_temp) { + my $user_env = get_user_env(); + $user_env->ArrayValues(1); # use value_data, value_type pairs + $user_env -> {"/Path"} = [ $userpath_temp, + ($userpath_temp =~ /%/) ? REG_EXPAND_SZ : REG_SZ ]; + } else { + delete $user_env -> {'Path'}; + } +} + + + + + +# needs a terminal 1 for require to succeed! +1; + +__END__ + +### Local Variables: +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil +### End: +# vim:set tabstop=2 expandtab: # |