path: root/Master/tlpkg/doc/wingoo-demo.pl

#!/usr/bin/env perl
# For testing, edit $ro_dir and $luaprog as needed;
# $ro_dir should be a read-only directory and
# $luaprog should be a working lua executable but not texlua.

# Under Unix/Linux, just test whether loading of win32 modules is skipped.

use strict;

BEGIN {
  $^W = 1;
  my $me=$0;
  $me=~s!\\!/!g if $^O=~/^MSWin(32|64)$/i;

  if ($me=~m!/!) {
    # wingoo-demo now in a subsubdirectory:
    ($::installerdir=$me)=~s!(.*)/[^/]+/[^/]+/[^/]*$!$1!;
  } else {
    # This shouldn't occur if called from batchfile
    $::installerdir='./../..';
  }
  @INC = ("$::installerdir/tlpkg/installer/perllib") if ($^O=~/^MSWin(32|64)$/i);
  unshift (@INC, "$::installerdir/tlpkg");
}

use TeXLive::TLUtils qw( get_system_tmpdir );
use TeXLive::TLWinGoo qw(
  win_version
  is_vista
  admin
  non_admin
  admin_again
  dir_writable
  reg_country
  get_system_path
  get_user_path
  get_system_env
  get_user_env
  expand_string
  win_which_dir
  global_tmpdir
  add_texbindir_to_path
  remove_texbindirs_from_path
  setenv_reg
  unsetenv_reg
  register_script_type
  unregister_script_type
  broadcast_env
  update_assocs
  wg_error
); # safe under Unix/Linux!

my $ro_dir = "z:/aps";
my $luadir = "x:/utils0";
my $luaprog;
my $pathsave = $ENV{'PATH'};
my $pathextsave = $ENV{'PATHEXT'};

$::LOGLEVELTERMINAL=$::LOG_DDDEBUG;
$::LOGLEVELFILE=$::LOG_ZERO;

#sub pathnew {
#  my $p = expand_string(get_system_path()).';'.
#    expand_string(get_user_path());
#  $p =~ s!/!\\!g;
#  return $p;
#}
#sub getenvnew {
#  # only use this for REG_SZ values!
#  my $env_var = shift;
#  return TeXLive::TLWinGoo::get_user_env()->{$env_var} or
#    TeXLive::TLWinGoo::get_system_env()->{$env_var} or "";
#  #my $env_data = TeXLive::TLWinGoo::get_user_env()->{$env_var};
#  #if (not $env_data) {
#  #  $env_data = TeXLive::TLWinGoo::get_system_env()->{$env_var};
#  #}
#  #if (not $env_data) { $env_data = ""; }
#  #return $env_data;
#}

sub pause {
  my $mess = shift;
  print( $mess."\nType any key..." );
  read STDIN,my $dummy, 1;
}


sub run_and_pause {
  my $command = shift;
  #my $setenv = "set PATH=".pathnew().
  #  " & set TEXBINDIR=".getenvnew('TEXBINDIR').
  #  " & set PATHEXT=".getenvnew('PATHEXT');
  #my $cmd_prompt = expand_string ($ENV{'COMSPEC'});
  #system ($cmd_prompt . ' /C "'.$setenv.' & '.$command.' & pause"');
  print "Type $command in a new command prompt\n";
  read STDIN,my $dummy, 1;
}

sub maybenot {
  my $bool = shift;
  return $bool ? " is " : " is not ";
}

# two uses:
# - is the parent directory writable?
# - is the script interpreted by lua or by texlua?

sub create_file {
  my $name = shift;
  return 1 if -e $name;
  return 0 unless open DUMMY, ">".$name;
  print DUMMY 's = tostring(0.0000001)'."\n"; # lua: 1e-7; texlua: 0
  print DUMMY 'print("0.0000001 becomes " .. s)'."\n";
  close DUMMY;
  return 1;
}

sub print_search_paths {
  print "System path: ".get_system_path()."\n";
  print "User path: ".get_user_path()."\n";
}

sub print_lua_out {
  my $luatest = expand_string( $ENV{'TEMP'} ) . "/testlua";
  my $luatestlua = $luatest . ".texlua";
  unlink $luatestlua if -e $luatestlua;
  create_file( $luatestlua );
  #$ENV{'PATH'} = expand_string($pathsave) . ";" . $ENV{'TEMP'};
  #my $usersave = get_user_path();
  #$userpath = ($usersave ? "$usersave;" .
  #run_and_pause ('testlua');
  $luatest =~ s!/!\\!g;
  #run_and_pause ("set PATHEXT=%PATHEXT%;.TEXLUA & set TEXBINDIR=".$luatest);
  run_and_pause ($luatest);
  #print "Lua[tex] result: ".`testlua`."\n";
  #$ENV{'PATH'} = $pathsave;
  unlink $luatestlua;
}

sub print_assoc_cmd {
  my $ext = shift;
  my $cmdout = `assoc $ext`;
  chomp $cmdout if $cmdout;
  if (!$cmdout) { print "Extension unknown says assoc\n"; return; }
  my $ftype = $cmdout;
  $ftype =~ s/.*=//;
  if (!$ftype) { print "Extension unknown says assoc\n"; return; }
  $cmdout = `ftype $ftype`;
  if (!$cmdout) { print "Filetype unknown says ftype\n"; return; }
  $cmdout =~ s/.*=//;
  print( $ext.' command is: '.$cmdout." says ftype\n" );
}

### end of subs ###

my $real_admin = admin();

print( "\nGENERAL; ALSO UNIX\n" );

print ( "\nINC\n" . (join "\n", @INC) . "\n\n");

# admin

if (admin()) {
  print "Admin or not_on_Windows\n";
} else {
  print "Not admin\n";
}

# global_tmpdir

print "\nGlobal tempdir: " . global_tmpdir()."\n";

# Windows version

print "Windows version: ".win_version()."\n";
print maybenot(is_vista()). " Vista\n";

if ($^O !~ /^MSWin(32|64)$/i) {
  print "Not Windows; bailing out...\n";
  exit;
}

### end of non-windows

#my @winversion = Win32::GetOSVersion();
#print "Windows version: " . $winversion[1] . "\n";

# country

print "\n***\nCountry: " . reg_country() . "\n";

# dir_writable

my $wr_dir = $ENV{'USERPROFILE'};
$wr_dir =~ s/\\/\//g;
mkdir $wr_dir unless -e $wr_dir;
print "\n***\nTesting for writability\n";
print $wr_dir . maybenot(dir_writable($wr_dir)) . "writable\n";
print $ro_dir . maybenot(dir_writable($ro_dir)) . "writable\n";

# expand_string

print( "\n***\nExpansion\n" );
print expand_string("pre\\%systemROOT%\\post")."\n";

# win_which_dir

print( "\n***\nFinding an executable\n" );
print "cmd.exe found in " . win_which_dir("cmd.exe") . "\n";

my $system_tmpdir=get_system_tmpdir();

print( "\n***\nPath; admin and user\n\n" );

my ($wr_dir1, $wr_dir2);

foreach ("admin", "user") {
  if ($_ eq "admin") {
    next unless $real_admin;
    admin_again();
  } else {
    non_admin();
  }
  print "\n***\n" . ((admin() ? "Is" : "Not") . " an admin\n");

  # adding and removing texbindir

  print( "\ntexbindir on searchpath:\n" );
  $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( "Take 1\n" );
  print_search_paths();
  print "tex.exe found in " . win_which_dir("tex.exe") . "\n";

  $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( "Take 2\n" );
  print_search_paths();
  print "tex.exe found in " . win_which_dir("tex.exe") . "\n";

  print( "Mopping up...\n" );
  remove_texbindirs_from_path();
  print_search_paths();

  # broadcast environment changes

  broadcast_env();
  pause( maybenot(admin())." admin; check environment in new dosbox\n\n" );
}
remove_texbindirs_from_path();
rmdir $wr_dir1 if unlink $wr_dir1.'/tex.exe';
rmdir $wr_dir2 if unlink $wr_dir2.'/tex.exe';
print( "Dummy texs removed from path\n");

# the problem case: no admin, but TeX on system path

print( "\nNon-admin path problem\n" );
my $fn = expand_string("%windir%")."/TEX.EXE";
$fn =~ s/\\/\//g;
non_admin();
if (create_file($fn)) { # a tex.exe on the system path!
  add_texbindir_to_path(expand_string($wr_dir2));
  my @wge = wg_error();
  if (@wge) {
    print $wge[1]."\n";
  }
  print( "Cannot remove tex from system searchpath\n" );
  print_search_paths();
  print "Wrong tex.exe found in " . win_which_dir("tex.exe") . "\n";
  unlink $fn;
  remove_texbindirs_from_path();
  broadcast_env();
  pause( "Non-admin: check environment in new dosbox" );
} else {
  print "Cannot test; cannot create $fn\n";
}

# texlua filetype: plain lua for user, texlua for admin.
# differentiation: texlua rounds .0000001 to 0, lua doesn't
# The texlua command is REG_EXPAND_SZ, parameterized with %TEXBINDIR%.

print( "\n***\nRegistering and unregistering filetypes\n\n" );

unregister_script_type(".texlua");
unsetenv_reg('TEXBINDIR');
update_assocs();
broadcast_env();
print_assoc_cmd( '.texlua' );

foreach ("admin", "user") {
  if ($_ eq "admin") {
    next unless $real_admin;
    admin_again();
  } else {
    non_admin();
  }
  print "\n***\n" . ((admin() ? "Is" : "Not") . " an admin\n");

  # adding a filetype

  my $luaprog = admin() ? "texlua.exe" : "lua.exe";
  my $texbindir = admin() ? $::installerdir."/bin/win32" : $luadir;
  $texbindir =~ s!/!\\!g;
  setenv_reg("TEXBINDIR", $texbindir);
  register_script_type(".texlua", "%TEXBINDIR%\\".$luaprog );
  broadcast_env();
  update_assocs();
  print "\n***\nAfter registering script type\n";
  print_assoc_cmd( '.texlua' );
  print_lua_out();
  print( "\***\nNow unregister\n" );
  unregister_script_type(".texlua");
  update_assocs();
  print_assoc_cmd( '.texlua' );
  print_lua_out();
  print( "Now re-register (not shown)\n" );
  register_script_type(".texlua", "%TEXBINDIR%\\".$luaprog );
  update_assocs();

  # broadcast environment changes

  broadcast_env();
}

unregister_script_type(".texlua");
unsetenv_reg('TEXBINDIR');
update_assocs();
broadcast_env();
print_assoc_cmd( '.texlua' );