# 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 -- 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 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 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 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 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 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 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 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 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 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: #