summaryrefslogtreecommitdiff
path: root/Master
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2008-01-10 22:56:04 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2008-01-10 22:56:04 +0000
commita085c27f4e2244e388b7cac1fc3eacd6bc2b90f6 (patch)
tree445cadf77db143dbadfde75c003c9a46dd9e53f6 /Master
parentbe3452a1329d292353703349c6aee8715c6eb6ac (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')
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm323
-rwxr-xr-xMaster/wingoo-demo.bat27
-rw-r--r--Master/wingoo-demo.pl106
3 files changed, 456 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: #
diff --git a/Master/wingoo-demo.bat b/Master/wingoo-demo.bat
new file mode 100755
index 00000000000..629daae3495
--- /dev/null
+++ b/Master/wingoo-demo.bat
@@ -0,0 +1,27 @@
+@echo off
+
+rem TeX Live Root; ends with backslash
+rem This should also work with UNC names
+set tlroot=%~dp0
+set tldrive=%~d0
+
+%tldrive%
+cd %tlroot%
+
+rem we need wget in the path, so add tlpkg\bin to the path
+path %path%;%tlroot%tlpkg\bin
+
+rem use provided Perl
+
+set PERL5SAVE=%PERL5LIB%
+
+set PERL5LIB=%tlroot%tlpkg\lib\Perl5_lib-TL_inst
+"%tlroot%tlpkg\bin\perl" "%tlroot%wingoo-demo.pl"
+pause Done
+
+rem cleanup in case of start from command-line
+
+set PERL5LIB=%PERL5SAVE%
+set PERL5SAVE=
+set tldrive=
+set tlroot=
diff --git a/Master/wingoo-demo.pl b/Master/wingoo-demo.pl
new file mode 100644
index 00000000000..373a8cc8c04
--- /dev/null
+++ b/Master/wingoo-demo.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/env perl
+# For testing, edit $ro_dir and $wr_dir as needed.
+
+# $ro_dir should be read-only.
+# $wr_dir should be writable.
+
+#!/usr/bin/env perl
+
+use strict;
+
+BEGIN {
+ $^W = 1;
+ my $me=$0;
+ $me=~s!\\!/!g if $^O=~/^MSWin(32|64)$/i;
+
+ if ($me=~m!/!) {
+ ($::installerdir=$me)=~s!(.*)/.*$!$1!;
+ } else {
+ # This shouldn't occur if called from batchfile
+ $::installerdir='.';
+ }
+ unshift (@INC, "$::installerdir/tlpkg");
+}
+
+use TeXLive::TLWinGoo; # safe under Unix/Linux!
+
+my $ro_dir = "z:/aps";
+
+sub maybenot {
+ my $bool = shift;
+ return $bool ? " is " : " is not ";
+}
+
+sub create_file {
+ my $name = shift;
+ return if -e $name;
+ open DUMMY, ">".$name;
+ print DUMMY "Hello";
+ close DUMMY;
+}
+
+sub print_search_paths {
+ print "System path: ".get_system_path()."\n";
+ print "User path: ".get_user_path()."\n";
+}
+
+# admin
+
+if (admin()) {
+ print "Admin or not on Windows\n";
+} else {
+ print "Not admin\n";
+}
+
+# global_tmpdir
+
+print "Global tempdir: " . global_tmpdir()."\n";
+
+if ($^O !~ /^MSWin(32|64)$/i) {
+ print "Not Windows; bailing out...\n";
+ exit;
+}
+
+# dir_writable
+
+my $wr_dir = $ENV{'USERPROFILE'};
+$wr_dir =~ s/\\/\//g;
+mkdir $wr_dir unless -e $wr_dir;
+print $wr_dir . maybenot(dir_writable($wr_dir)) . "writable\n";
+print $ro_dir . maybenot(dir_writable($ro_dir)) . "writable\n";
+
+# expand_string
+
+print expand_string("pre\\%systemROOT%\\post")."\n";
+
+# win_which_dir
+
+print "cmd.exe found in " . win_which_dir("cmd.exe") . "\n";
+
+# adding and removing texbindir
+
+my $wr_dir1 = $wr_dir . "/tex1";
+mkdir $wr_dir1 unless -e $wr_dir1;
+create_file( $wr_dir1."/tex.exe" );
+add_texbindir_to_path($wr_dir1);
+print_search_paths();
+print "tex.exe found in " . win_which_dir("tex.exe") . "\n";
+
+my $wr_dir2 = $wr_dir . "/tex2";
+mkdir $wr_dir2 unless -e $wr_dir2;
+create_file( $wr_dir2."/tex.exe" );
+add_texbindir_to_path($wr_dir2);
+print_search_paths();
+print "tex.exe found in " . win_which_dir("tex.exe") . "\n";
+
+# the problem case: no admin, but TeX on system path
+
+if (!admin()) {
+ my $fn = expand_string("%windir%")."/tex.exe";
+ $fn =~ s/\\/\//g;
+ create_file($fn);
+ add_texbindir_to_path(expand_string($wr_dir2));
+ print_search_paths();
+ print "tex.exe found in " . win_which_dir("tex.exe") . "\n";
+ unlink $fn;
+}