keep copy of pm files under tests/, run built kpsewhich, redo updmap test

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

4 files changed, 4172 insertions, 0 deletions

diff --git a/Build/source/texk/tests/ChangeLog b/Build/source/texk/tests/ChangeLog
index 6e996a57d4c..e1c3cbd0f89 100644
--- a/Build/source/texk/tests/ChangeLog
+++ b/Build/source/texk/tests/ChangeLog
@@ -1,3 +1,7 @@
+2011-10-02  Karl Berry  <karl@tug.org>
+
+	* TeXLive: new subdir for TL*.pm copies to be used by tests.
+
 2010-04-11  Karl Berry  <karl@tug.org>
 
 	* common-test.pl (AFMFONTS): set also.
diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm
new file mode 100644
index 00000000000..8825b33e800
--- /dev/null
+++ b/Build/source/texk/tests/TeXLive/TLConfig.pm
@@ -0,0 +1,297 @@
+# $Id: TLConfig.pm 23084 2011-06-22 03:07:01Z preining $
+# TeXLive::TLConfig.pm - module exporting configuration values
+# Copyright 2007, 2008, 2009, 2010, 2011 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
+package TeXLive::TLConfig;
+
+my $svnrev = '$Revision: 23084 $';
+my $_modulerevision;
+if ($svnrev =~ m/: ([0-9]+) /) {
+  $_modulerevision = $1;
+} else {
+  $_modulerevision = "unknown";
+}
+sub module_revision {
+  return $_modulerevision;
+}
+
+BEGIN {
+  use Exporter ();
+  use vars qw( @ISA @EXPORT_OK @EXPORT );
+  @ISA = qw(Exporter);
+  @EXPORT_OK = qw(
+    $ReleaseYear
+    @MetaCategories
+    @NormalCategories
+    @Categories
+    $MetaCategoriesRegexp
+    $CategoriesRegexp
+    $DefaultCategory
+    $DefaultContainerFormat
+    $DefaultContainerExtension
+    $InfraLocation
+    $DatabaseName
+    $PackageBackupDir 
+    $BlockSize
+    $Archive
+    $TeXLiveServerURL
+    $TeXLiveServerPath
+    $TeXLiveURL
+    @CriticalPackagesList
+    $CriticalPackagesRegexp
+    $WindowsMainMenuName
+    $RelocPrefix
+    $RelocTree
+    %TLPDBOptions
+    %TLPDBSettings
+    %TLPDBConfigs
+    $NetworkTimeout
+  );
+  @EXPORT = @EXPORT_OK;
+}
+
+# the year of our release, will be used in the location of the
+# network packages, and in menu names, and other places.
+$ReleaseYear = 2011;
+
+# users can upgrade from this year to the current year; maybe a spread
+# of more than one year will be useful at some point, but not now.
+$MinRelease = $ReleaseYear - 1;
+
+# Meta Categories do not ship files, but only call for other packages.
+our @MetaCategories = qw/Collection Scheme/;
+our $MetaCategoriesRegexp = '(Collection|Scheme)';
+#
+# Normal Categories contain actial files and do not depend on other things.
+our @NormalCategories = qw/Package TLCore ConTeXt/;
+#
+# list of all Categories
+our @Categories = (@MetaCategories, @NormalCategories);
+
+# repeat, as a regexp.
+our $CategoriesRegexp = '(Collection|Scheme|Package|TLCore|ConTeXt)';
+
+our $DefaultCategory = "Package";
+
+# location of various infra files (texlive.tlpdb, .tlpobj etc)
+# relative to a root (e.g., the Master/, or the installation path)
+our $InfraLocation = "tlpkg";
+our $DatabaseName = "texlive.tlpdb";
+
+# location of backups in default autobackup setting (under tlpkg)
+our $PackageBackupDir = "$InfraLocation/backups";
+
+our $BlockSize = 4096;
+
+our $Archive = "archive";
+our $TeXLiveServerURL = "http://mirror.ctan.org";
+# from 2009 on we try to put them all into tlnet directly without any
+# release year since we hope that we can switch over to 2010 on the fly
+# our $TeXLiveServerPath = "systems/texlive/tlnet/$ReleaseYear";
+our $TeXLiveServerPath = "systems/texlive/tlnet";
+our $TeXLiveURL = "$TeXLiveServerURL/$TeXLiveServerPath";
+
+# Relocatable packages.
+our $RelocTree = "texmf-dist";
+our $RelocPrefix = "RELOC";
+
+our @CriticalPackagesList = qw/texlive.infra/;
+our $CriticalPackagesRegexp = '^(texlive\.infra)';
+if ($^O =~ /^MSWin(32|64)$/i) {
+  push (@CriticalPackagesList, "tlperl.win32");
+  $CriticalPackagesRegexp = '^(texlive\.infra|tlperl\.win32$)';
+}
+
+# the way we package things on the web
+our $DefaultContainerFormat = "xz";
+our $DefaultContainerExtension = "tar.$DefaultContainerFormat";
+
+# archive (not user) settings.
+our %TLPDBConfigs = (
+  "container_split_src_files" => 1,
+  "container_split_doc_files" => 1,
+  "container_format" => $DefaultContainerFormat,
+  "minrelease" => $MinRelease,
+  "release" => $ReleaseYear,
+);
+
+# definition of the option strings and their value types 
+# possible types are:
+# - u: url
+# - b: boolean, saved as 0/1
+# - p: path (local path)
+# - n: natural number
+#      it allows n:[a]..[b]
+#         if a is empty start at -infty
+#         if b is empty end at +infty
+#      so "n:.." is equivalent to "n"
+
+# $TLPDBOptions{"option"}->[0] --> type
+#                        ->[1] --> default value
+#                        ->[2] --> tlmgr name
+#                        ->[3] --> tlmgr description
+# the "option" is the value in the TLPDB
+
+our %TLPDBOptions = (
+  "autobackup" =>
+    [ "n:-1..", 1, "autobackup",
+      "Number of backups to keep" ],
+  "backupdir" =>
+    [ "p", $PackageBackupDir, "backupdir",
+      "Directory for backups" ],
+  "create_formats" =>
+    [ "b", 1, "formats",  
+      "Create formats on installation" ],
+  "desktop_integration" =>
+    [ "b", 1, "desktop_integration",
+      "Create Start menu shortcuts (w32)" ],
+  "file_assocs" =>
+    [ "n:0..2", 1, "fileassocs",
+      "Change file associations (w32)" ],
+  "install_docfiles" =>
+    [ "b", 1, "docfiles",
+      "Install documentation files" ],
+  "install_srcfiles" =>
+    [ "b", 1, "srcfiles",
+      "Install source files" ],
+  "location" =>
+    [ "u", "__MASTER__", "repository", 
+      "Default package repository" ],
+  "post_code" =>
+    [ "b", 1, "postcode",
+      "Run postinst code blobs" ],
+  "sys_bin" =>
+    [ "p", "/usr/local/bin", "sys_bin",
+      "Destination for symlinks for binaries" ],
+  "sys_info" =>
+    [ "p", "/usr/local/info", "sys_info",
+      "Destination for symlinks for info docs" ],
+  "sys_man" =>
+    [ "p", "/usr/local/man", "sys_man",
+      "Destination for symlinks for man pages" ],
+  "w32_multi_user" =>
+    [ "b", 0, "multiuser",
+      "Install for all users (w32)" ],
+  "generate_updmap" =>
+    [ "b", 0, "generate_updmap",
+      "Run tlmgr generate updmap after maps have changed" ],
+);
+
+
+our %TLPDBSettings = (
+  "platform" => [ "s", "Main platform for this computer" ],
+  "available_architectures" => [ "l", "All available/installed architectures" ]
+);
+
+our $WindowsMainMenuName = "TeX Live $ReleaseYear";
+
+#
+# timeout for network connections (wget, LWP) in seconds
+our $NetworkTimeout = 30;
+
+1;
+
+
+=head1 NAME
+
+C<TeXLive::TLConfig> -- TeX Live Configurations
+
+=head1 SYNOPSIS
+
+  use TeXLive::TLConfig;
+
+=head1 DESCRIPTION
+
+The L<TeXLive::TLConfig> module contains definitions of variables 
+configuring all of TeX Live.
+
+=over 4
+
+=head1 EXPORTED VARIABLES
+
+All of the following variables are pulled into the callers namespace,
+i.e., are declared with C<EXPORT> (and C<EXPORT_OK>).
+
+=item C<@TeXLive::TLConfig::MetaCategories>
+
+The list of meta categories, i.e., those categories whose packages only
+depend on other packages, but don't ship any files. Currently 
+C<Collection> and <Scheme>.
+
+=item C<@TeXLive::TLConfig::NormalCategories>
+
+The list of normal categories, i.e., those categories whose packages do
+ship files. Currently C<TLCore>, C<Package>, C<ConTeXt>.
+
+=item C<@TeXLive::TLConfig::Categories>
+
+The list of all categories, i.e., the union of the above.
+
+=item C<$TeXLive::TLConfig::CategoriesRegexp>
+
+A regexp matching any category.
+
+=item C<$TeXLive::TLConfig::DefaultCategory>
+
+The default category used when creating new packages.
+
+=item C<$TeXLive::TLConfig::InfraLocation>
+
+The subdirectory with various infrastructure files (C<texlive.tlpdb>,
+tlpobj files, ...) relative to the root of the installation; currently
+C<tlpkg>.
+
+=item C<$TeXLive::TLConfig::BlockSize>
+
+The assumed block size, currently 4k.
+
+=item C<$TeXLive::TLConfig::Archive>
+=item C<$TeXLive::TLConfig::TeXLiveURL>
+
+These values specify where to find packages.
+
+=item C<$TeXLive::TLConfig::TeXLiveServerURL>
+=item C<$TeXLive::TLConfig::TeXLiveServerPath>
+
+C<TeXLiveURL> is concatenated from these values, with a string between.
+The defaults are respectively, C<http://mirror.ctan.org> and
+C<systems/texlive/tlnet/>.
+
+=item C<@TeXLive::TLConfig::CriticalPackagesList>
+=item C<@TeXLive::TLConfig::CriticalPackagesRegexp>
+
+A list of all those packages which we do not update regularly since they
+are too central, currently texlive.infra and (for Windows) tlperl.win32.
+
+=item C<$TeXLive::TLConfig::RelocTree>
+
+The texmf-tree name that can be relocated, defaults to C<texmf-dist>.
+
+=item C<$TeXLive::TLConfig::RelocPrefix>
+
+The string that replaces the C<RelocTree> in the tlpdb if a package is
+relocated, defaults to C<RELOC>".
+
+=back
+
+=head1 SEE ALSO
+
+The modules L<TeXLive::TLUtils>, L<TeXLive::TLPSRC>,
+L<TeXLive::TLPDB>, L<TeXLive::TLTREE>, L<TeXLive::TeXCatalogue>.
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm
new file mode 100644
index 00000000000..ea26a1ed41d
--- /dev/null
+++ b/Build/source/texk/tests/TeXLive/TLUtils.pm
@@ -0,0 +1,3864 @@
+# $Id: TLUtils.pm 23990 2011-09-17 07:40:33Z preining $
+# TeXLive::TLUtils.pm - the inevitable utilities for TeX Live.
+# Copyright 2007, 2008, 2009, 2010, 2011 Norbert Preining, Reinhard Kotucha
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
+package TeXLive::TLUtils;
+
+my $svnrev = '$Revision: 23990 $';
+my $_modulerevision;
+if ($svnrev =~ m/: ([0-9]+) /) {
+  $_modulerevision = $1;
+} else {
+  $_modulerevision = "unknown";
+}
+sub module_revision {
+  return $_modulerevision;
+}
+
+=pod
+
+=head1 NAME
+
+C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
+
+=head1 SYNOPSIS
+
+  use TeXLive::TLUtils;
+
+=head2 Platform Detection
+
+  TeXLive::TLUtils::platform();
+  TeXLive::TLUtils::platform_name($canonical_host);
+  TeXLive::TLUtils::platform_desc($platform);
+  TeXLive::TLUtils::win32();
+  TeXLive::TLUtils::unix();
+
+=head2 System Tools
+
+  TeXLive::TLUtils::getenv($string);
+  TeXLive::TLUtils::which($string);
+  TeXLive::TLUtils::get_system_tmpdir();
+  TeXLive::TLUtils::tl_tmpdir();
+  TeXLive::TLUtils::xchdir($dir);
+  TeXLive::TLUtils::xsystem(@args);
+  TeXLive::TLUtils::run_cmd($cmd);
+
+=head2 File Utilities
+
+  TeXLive::TLUtils::dirname($path);
+  TeXLive::TLUtils::basename($path);
+  TeXLive::TLUtils::dirname_and_basename($path);
+  TeXLive::TLUtils::dir_writable($path);
+  TeXLive::TLUtils::dir_creatable($path);
+  TeXLive::TLUtils::mkdirhier($path);
+  TeXLive::TLUtils::rmtree($root, $verbose, $safe);
+  TeXLive::TLUtils::copy($file, $target_dir);
+  TeXLive::TLUtils::touch(@files);
+  TeXLive::TLUtils::collapse_dirs(@files);
+  TeXLive::TLUtils::removed_dirs(@files);
+  TeXLive::TLUtils::download_file($path, $destination [, $progs ]);
+  TeXLive::TLUtils::setup_programs($bindir, $platform);
+  TeXLive::TLUtils::tlcmp($file, $file);
+  TeXLive::TLUtils::nulldev();
+  TeXLive::TLUtils::get_full_line($fh);
+
+=head2 Installer Functions
+
+  TeXLive::TLUtils::make_var_skeleton($path);
+  TeXLive::TLUtils::make_local_skeleton($path);
+  TeXLive::TLUtils::create_fmtutil($tlpdb,$dest,$localconf);
+  TeXLive::TLUtils::create_updmap($tlpdb,$dest,$localconf);
+  TeXLive::TLUtils::create_language_dat($tlpdb,$dest,$localconf);
+  TeXLive::TLUtils::create_language_def($tlpdb,$dest,$localconf);
+  TeXLive::TLUtils::create_language_lua($tlpdb,$dest,$localconf);
+  TeXLive::TLUtils::time_estimate($totalsize, $donesize, $starttime)
+  TeXLive::TLUtils::install_packages($from_tlpdb,$media,$to_tlpdb,$what,$opt_src, $opt_doc)>);
+  TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform);
+  TeXLive::TLUtils::do_postaction($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script);
+  TeXLive::TLUtils::announce_execute_actions($how, @executes);
+  TeXLive::TLUtils::add_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info);
+  TeXLive::TLUtils::remove_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info);
+  TeXLive::TLUtils::w32_add_to_path($bindir, $multiuser);
+  TeXLive::TLUtils::w32_remove_from_path($bindir, $multiuser);
+  TeXLive::TLUtils::setup_persistent_downloads();
+
+=head2 Miscellaneous
+
+  TeXLive::TLUtils::sort_uniq(@list);
+  TeXLive::TLUtils::push_uniq(\@list, @items);
+  TeXLive::TLUtils::member($item, @list);
+  TeXLive::TLUtils::merge_into(\%to, \%from);
+  TeXLive::TLUtils::texdir_check($texdir);
+  TeXLive::TLUtils::quotify_path_with_spaces($path);
+  TeXLive::TLUtils::conv_to_w32_path($path);
+  TeXLive::TLUtils::native_slashify($internal_path);
+  TeXLive::TLUtils::forward_slashify($path_from_user);
+  TeXLive::TLUtils::give_ctan_mirror();
+  TeXLive::TLUtils::give_ctan_mirror_base();
+  TeXLive::TLUtils::tlmd5($path);
+  TeXLive::TLUtils::compare_tlpobjs($tlpA, $tlpB);
+  TeXLive::TLUtils::compare_tlpdbs($tlpdbA, $tlpdbB);
+  TeXLive::TLUtils::report_tlpdb_differences(\%ret);
+  TeXLive::TLUtils::mktexupd();
+
+=head1 DESCRIPTION
+
+=cut
+
+# avoid -warnings.
+our $PERL_SINGLE_QUOTE; # we steal code from Text::ParseWords
+use vars qw(
+  $::LOGFILENAME @::LOGLINES 
+  @::debug_hook @::ddebug_hook @::dddebug_hook @::info_hook @::warn_hook
+  @::install_packages_hook
+  $::machinereadable
+  $::no_execute_actions
+  $::regenerate_all_formats
+  $TeXLive::TLDownload::net_lib_avail
+);
+
+BEGIN {
+  use Exporter ();
+  use vars qw(@ISA @EXPORT_OK @EXPORT);
+  @ISA = qw(Exporter);
+  @EXPORT_OK = qw(
+    &platform
+    &platform_name
+    &platform_desc
+    &unix
+    &getenv
+    &which
+    &get_system_tmpdir
+    &dirname
+    &basename
+    &dirname_and_basename
+    &dir_writable
+    &dir_creatable
+    &mkdirhier
+    &rmtree
+    &copy
+    &touch
+    &collapse_dirs
+    &removed_dirs
+    &install_package
+    &install_packages
+    &make_var_skeleton
+    &make_local_skeleton
+    &create_fmtutil
+    &create_updmap
+    &create_language_dat
+    &create_language_def
+    &create_language_lua
+    &parse_AddFormat_line
+    &parse_AddHyphen_line
+    &sort_uniq
+    &push_uniq
+    &texdir_check
+    &member
+    &quotewords
+    &quotify_path_with_spaces
+    &conv_to_w32_path
+    &native_slashify
+    &forward_slashify
+    &conv_to_w32_path
+    &untar
+    &merge_into
+    &give_ctan_mirror
+    &give_ctan_mirror_base
+    &create_mirror_list
+    &extract_mirror_entry
+    &tlmd5
+    &xsystem
+    &run_cmd
+    &announce_execute_actions
+    &add_symlinks
+    &remove_symlinks
+    &w32_add_to_path
+    &w32_remove_from_path
+    &tlcmp
+    &time_estimate
+    &compare_tlpobjs
+    &compare_tlpdbs
+    &report_tlpdb_differences
+    &setup_persistent_downloads
+    &mktexupd
+    &nulldev
+    &get_full_line
+  );
+  @EXPORT = qw(setup_programs download_file process_logging_options
+               tldie tlwarn info log debug ddebug dddebug debug_hash
+               win32 xchdir xsystem run_cmd);
+}
+
+use Cwd;
+use Digest::MD5;
+use Getopt::Long;
+use File::Temp;
+
+use TeXLive::TLConfig;
+
+$::opt_verbosity = 0;  # see process_logging_options
+
+
+=head2 Platform Detection
+
+=over 4
+
+=item C<platform>
+
+If C<$^O=~/MSWin(32|64)$/i> is true we know that we're on
+Windows and we set the global variable C<$::_platform_> to C<win32>.
+Otherwise we call C<platform_name> with the output of C<config.guess>
+as argument.
+
+The result is stored in a global variable C<$::_platform_>, and
+subsequent calls just return that value.
+
+=cut
+
+sub platform {
+  unless (defined $::_platform_) {
+    if ($^O =~ /^MSWin/i) {
+      $::_platform_ = "win32";
+    } else {
+      my $config_guess = "$::installerdir/tlpkg/installer/config.guess";
+
+      # We cannot rely on #! in config.guess but have to call /bin/sh
+      # explicitly because sometimes the 'noexec' flag is set in
+      # /etc/fstab for ISO9660 file systems.
+      chomp (my $guessed_platform = `/bin/sh '$config_guess'`);
+
+      # For example, if the disc or reader has hardware problems.
+      die "$0: could not run $config_guess, cannot proceed, sorry"
+        if ! $guessed_platform;
+
+      $::_platform_ = platform_name($guessed_platform);
+    }
+  }
+  return $::_platform_;
+}
+
+
+=item C<platform_name($canonical_host)>
+
+Convert a canonical host names as returned by C<config.guess> into
+TeX Live platform names.
+
+CPU type is determined by a regexp, and any C</^i.86/> name is replaced
+by C<i386>.
+
+For OS we need a list because what's returned is not likely to match our
+historical names, e.g., C<config.guess> returns C<linux-gnu> but we need
+C<linux>.  This list might/should contain OSs which are not currently
+supported.
+
+If a particular platform is not found in this list we use the regexp
+C</.*-(.*$)/> as a last resort and hope it provides something useful.
+
+=cut
+
+sub platform_name {
+      my ($guessed_platform) = @_;
+
+      $guessed_platform =~ s/^x86_64-(.*-k?)freebsd/amd64-$1freebsd/;
+      my $CPU; # CPU type as reported by config.guess.
+      my $OS;  # O/S type as reported by config.guess.
+      ($CPU = $guessed_platform) =~ s/(.*?)-.*/$1/;
+      $CPU =~ s/^alpha(.*)/alpha/;   # alphaev56 or whatever
+      $CPU =~ s/powerpc64/powerpc/;  # we don't distinguish ppc64
+      $CPU =~ s/mips64el/mipsel/;    # we don't distinguish mips64 and 32 el
+
+      my @OSs = qw(aix cygwin darwin freebsd hpux irix
+                   kfreebsd linux netbsd openbsd solaris);
+      for my $os (@OSs) {
+        # Match word boundary at the beginning of the os name so that
+        #   freebsd and kfreebsd are distinguished.
+        # Do not match word boundary at the end of the os so that
+        #   solaris2 is matched.
+        $OS = $os if $guessed_platform =~ /\b$os/;
+      }
+      if ($OS eq "darwin") {
+        # We never want to guess x86_64-darwin even if config.guess
+        # does, because Leopard can be 64-bit but our x86_64-darwin
+        # binaries will only run on Snow Leopard.
+        $CPU = "universal";
+      } elsif ($CPU =~ /^i.86$/) {
+        $CPU = "i386";  # 586, 686, whatever
+      }
+
+      unless (defined $OS) {
+        ($OS = $guessed_platform) =~ s/.*-(.*)/$1/;
+      }
+
+      return "$CPU-$OS";
+}
+
+=item C<platform_desc($platform)>
+
+Return a string which describes a particular platform identifier, e.g.,
+given C<i386-linux> we return C<Intel x86 with GNU/Linux>.
+
+=cut
+
+sub platform_desc {
+  my ($platform) = @_;
+
+  my %platform_name = (
+    'alpha-linux'      => 'DEC Alpha with GNU/Linux',
+    'alphaev5-osf'     => 'DEC Alphaev5 OSF',
+    'amd64-freebsd'    => 'x86_64 with FreeBSD',
+    'amd64-kfreebsd'   => 'x86_64 with GNU/FreeBSD',
+    'hppa-hpux'        => 'HP-UX',
+    'i386-cygwin'      => 'Intel x86 with Cygwin',
+    'i386-darwin'      => 'Intel x86 with MacOSX/Darwin',
+    'i386-freebsd'     => 'Intel x86 with FreeBSD',
+    'i386-kfreebsd'    => 'Intel x86 with GNU/FreeBSD',
+    'i386-openbsd'     => 'Intel x86 with OpenBSD',
+    'i386-netbsd'      => 'Intel x86 with NetBSD',
+    'i386-linux'       => 'Intel x86 with GNU/Linux',
+    'i386-solaris'     => 'Intel x86 with Solaris',
+    'mips-irix'        => 'SGI IRIX',
+    'powerpc-aix'      => 'PowerPC with AIX',
+    'powerpc-darwin'   => 'PowerPC with MacOSX/Darwin',
+    'powerpc-linux'    => 'PowerPC with GNU/Linux',
+    'sparc-linux'      => 'Sparc with GNU/Linux',
+    'sparc-solaris'    => 'Sparc with Solaris',
+    'universal-darwin' => 'universal binaries for MacOSX/Darwin',
+    'win32'            => 'Windows',
+    'x86_64-darwin'    => 'x86_64 with MacOSX/Darwin',
+    'x86_64-linux'     => 'x86_64 with GNU/Linux',
+    'x86_64-solaris'   => 'x86_64 with Solaris',
+  );
+
+  # the inconsistency between amd64-freebsd and x86_64-linux is
+  # unfortunate (it's the same hardware), but the os people say those
+  # are the conventional names on the respective os's, so we follow suit.
+
+  if (exists $platform_name{$platform}) {
+    return "$platform_name{$platform}";
+  } else {
+    my ($CPU,$OS) = split ('-', $platform);
+    return "$CPU with " . ucfirst "$OS";
+  }
+}
+
+
+=item C<win32>
+
+Return C<1> if platform is Windows and C<0> otherwise.  The test is
+currently based on the value of Perl's C<$^O> variable.
+
+=cut
+
+sub win32
+{
+  if ($^O=~/^MSWin(32|64)$/i) {
+    return 1;
+  } else {
+    return 0;
+  }
+  # the following needs config.guess, which is quite bad ...
+  # return (&platform eq "win32")? 1:0;
+}
+
+
+=item C<unix>
+
+Return C<1> if platform is UNIX and C<0> otherwise.
+
+=cut
+
+sub unix {
+  return (&platform eq "win32")? 0:1;
+}
+
+
+=back
+
+=head2 System Tools
+
+=over 4
+
+=item C<getenv($string)>
+
+Get an environment variable.  It is assumed that the environment
+variable contains a path.  On Windows all backslashes are replaced by
+forward slashes as required by Perl.  If this behavior is not desired,
+use C<$ENV{"$variable"}> instead.  C<0> is returned if the
+environment variable is not set.
+
+=cut
+
+sub getenv {
+  my $envvar=shift;
+  my $var=$ENV{"$envvar"};
+  return 0 unless (defined $var);
+  if (&win32) {
+    $var=~s!\\!/!g;  # change \ -> / (required by Perl)
+  }
+  return "$var";
+}
+
+
+=item C<which($string)>
+
+C<which> does the same as the UNIX command C<which(1)>, but it is
+supposed to work on Windows too.  On Windows we have to try all the
+extensions given in the C<PATHEXT> environment variable.  We also try
+without appending an extension because if C<$string> comes from an
+environment variable, an extension might aleady be present.
+
+=cut
+
+sub which {
+  my ($prog) = @_;
+  my @PATH;
+  my $PATH = getenv('PATH');
+
+  if (&win32) {
+    my @PATHEXT = split (';', getenv('PATHEXT'));
+    push (@PATHEXT, '');  # in case argument contains an extension
+    @PATH = split (';', $PATH);
+    for my $dir (@PATH) {
+      for my $ext (@PATHEXT) {
+        if (-f "$dir/$prog$ext") {
+          return "$dir/$prog$ext";
+        }
+      }
+    }
+
+  } else { # not windows
+    @PATH = split (':', $PATH);
+    for my $dir (@PATH) {
+      if (-x "$dir/$prog") {
+        return "$dir/$prog";
+      }
+    }
+  }
+  return 0;
+}
+
+=item C<get_system_tmpdir>
+
+Evaluate the environment variables C<TMPDIR>, C<TMP>, and C<TEMP> in
+order to find the system temporary directory.
+
+=cut
+
+sub get_system_tmpdir {
+  my $systmp=0;
+  $systmp||=getenv 'TMPDIR';
+  $systmp||=getenv 'TMP';
+  $systmp||=getenv 'TEMP';
+  $systmp||='/tmp';
+  return "$systmp";
+}
+
+=item C<tl_tmpdir>
+
+Create a temporary directory which is cleaned up as soon as the program
+is terminated.
+
+=cut
+
+sub tl_tmpdir {
+  return (File::Temp::tempdir(CLEANUP => 1));
+}
+
+=item C<xchdir($dir)>
+
+C<chdir($dir)> or die.
+
+=cut
+
+sub xchdir
+{
+  my ($dir) = @_;
+  chdir($dir) || die "$0: chdir($dir) failed: $!";
+  ddebug("xchdir($dir) ok\n");
+}
+
+
+=item C<xsystem(@args)>
+
+Run C<system(@args)> and die if unsuccessful.
+
+=cut
+
+sub xsystem
+{
+  my (@args) = @_;
+  ddebug("running system(@args)\n");
+  my $retval = system(@args);
+  if ($retval != 0) {
+    $retval /= 256 if $retval > 0;
+    my $pwd = cwd ();
+    die "$0: system(@args) failed in $pwd, status $retval";
+  }
+}
+
+=item C<run_cmd($cmd)>
+
+runs a command and captures its output. Then returns a list with the
+output as first element and the return value (exit code) as second.
+
+=cut
+
+sub run_cmd {
+  my $cmd = shift;
+  my $output = `$cmd`;
+  my $retval = $?;
+  if ($retval != 0) {
+    $retval /= 256 if $retval > 0;
+  }
+  return ($output, $retval);
+}
+
+
+
+
+=back
+
+=head2 File Utilities
+
+=over 4
+
+=item C<dirname($path)>
+
+Return C<$path> with its trailing C</component> removed.
+
+=cut
+
+sub dirname {
+  my $path=shift;
+  if (win32) {
+    $path=~s!\\!/!g;
+  }
+  if ($path=~m!/!) {   # dirname("foo/bar/baz") -> "foo/bar"
+    $path=~m!(.*)/.*!; # works because of greedy matching
+    return $1;
+  } else {             # dirname("ignore") -> "."
+    return ".";
+  }
+}
+
+
+=item C<basename($path)>
+
+Return C<$path> with any leading directory components removed.
+
+=cut
+
+sub basename {
+  my $path=shift;
+  if (win32) {
+    $path=~s!\\!/!g;
+  }
+  if ($path=~m!/!) {  # basename("foo/bar") -> "bar"
+    $path=~m!.*/(.*)!;
+    return $1;
+  } else {            # basename("ignore") -> "ignore"
+    return $path;
+  }
+}
+
+
+=item C<dirname_and_basename($path)>
+
+Return both C<dirname> and C<basename>.  Example:
+
+  ($dirpart,$filepart) = dirname_and_basename ($path);
+
+=cut
+
+sub dirname_and_basename {
+  my $path=shift;
+  if (win32) {
+    $path=~s!\\!/!g;
+  }
+  $path=~/(.*)\/(.*)/;
+  return ("$1", "$2");
+}
+
+
+=item C<dir_creatable($path)>
+
+Tests whether its argument is a directory where we can create a directory.
+
+=cut
+
+sub dir_slash {
+  my $d = shift;
+  $d = "$d/" unless $d =~ m!/!;
+  return $d;
+}
+
+# test whether subdirectories can be created in the argument
+sub dir_creatable {
+  $path=shift;
+  #print STDERR "testing $path\n";
+  $path =~ s!\\!/!g if win32;
+  $path =~ s!/$!!;
+  return 0 unless -d dir_slash($path);
+  #print STDERR "testing $path\n";
+  my $i = 0;
+  while (-e $path . "/" . $i) { $i++; }
+  my $d = $path."/".$i;
+  #print STDERR "creating $d\n";
+  return 0 unless mkdir $d;
+  return 0 unless -d $d;
+  rmdir $d;
+  return 1;
+}
+
+
+=item C<dir_writable($path)>
+
+Tests whether its argument is writable by trying to write to
+it. This function is necessary because the built-in C<-w> test just
+looks at mode and uid/guid, which on Windows always returns true and
+even on Unix is not always good enough for directories mounted from
+a fileserver.
+
+=cut
+
+# Theoretically, the test below, which uses numbers as names, might
+# lead to a race condition. OTOH, it should work even on a very
+# broken Perl.
+
+# The Unix test gives the wrong answer when used under Windows Vista
+# with one of the `virtualized' directories such as Program Files:
+# lacking administrative permissions, it would write successfully to
+# the virtualized Program Files rather than fail to write to the
+# real Program Files. Ugh.
+
+sub dir_writable {
+  $path=shift;
+  return 0 unless -d dir_slash($path);
+  $path =~ s!\\!/!g if win32;
+  $path =~ s!/$!!;
+  my $i = 0;
+  while (-e $path . "/" . $i) { $i++; }
+  my $f = $path."/".$i;
+  return 0 unless open TEST, ">".$f;
+  my $written = 0;
+  $written = (print TEST "\n");
+  close TEST;
+  unlink $f;
+  return $written;
+}
+
+
+=item C<mkdirhier($path, [$mode])>
+
+The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>.
+The optional parameter sets the permission flags.
+
+=cut
+
+sub mkdirhier {
+  my ($tree,$mode) = @_;
+
+  return if (-d "$tree");
+  my $subdir = "";
+  # win32 is special as usual: we need to separate //servername/ part
+  # from the UNC path, since (! -d //servername/) tests true
+  $subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) );
+
+  @dirs = split (/\//, $tree);
+  for my $dir (@dirs) {
+    $subdir .= "$dir/";
+    if (! -d $subdir) {
+      if (defined $mode) {
+        mkdir ($subdir, $mode)
+        || die "$0: mkdir($subdir,$mode) failed, goodbye: $!\n";
+      } else {
+        mkdir ($subdir) || die "$0: mkdir($subdir) failed, goodbye: $!\n";
+      }
+    }
+  }
+}
+
+
+=item C<rmtree($root, $verbose, $safe)>
+
+The C<rmtree> function provides a convenient way to delete a
+subtree from the directory structure, much like the Unix command C<rm -r>.
+C<rmtree> takes three arguments:
+
+=over 4
+
+=item *
+
+the root of the subtree to delete, or a reference to
+a list of roots.  All of the files and directories
+below each root, as well as the roots themselves,
+will be deleted.
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+print a message each time it examines a file, giving the
+name of the file, and indicating whether it's using C<rmdir>
+or C<unlink> to remove it, or that it's skipping it.
+(defaults to FALSE)
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+skip any files to which you do not have delete access
+(if running under VMS) or write access (if running
+under another OS).  This will change in the future when
+a criterion for 'delete permission' under OSs other
+than VMS is settled.  (defaults to FALSE)
+
+=back
+
+It returns the number of files successfully deleted.  Symlinks are
+simply deleted and not followed.
+
+B<NOTE:> There are race conditions internal to the implementation of
+C<rmtree> making it unsafe to use on directory trees which may be
+altered or moved while C<rmtree> is running, and in particular on any
+directory trees with any path components or subdirectories potentially
+writable by untrusted users.
+
+Additionally, if the third parameter is not TRUE and C<rmtree> is
+interrupted, it may leave files and directories with permissions altered
+to allow deletion (and older versions of this module would even set
+files and directories to world-read/writable!)
+
+Note also that the occurrence of errors in C<rmtree> can be determined I<only>
+by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent
+from the return value.
+
+=cut
+
+#taken from File/Path.pm
+#
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
+
+# These OSes complain if you want to remove a file that you have no
+# write permission to:
+my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
+		       $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
+
+sub rmtree {
+  my($roots, $verbose, $safe) = @_;
+  my(@files);
+  my($count) = 0;
+  $verbose ||= 0;
+  $safe ||= 0;
+
+  if ( defined($roots) && length($roots) ) {
+    $roots = [$roots] unless ref $roots;
+  } else {
+    warn "No root path(s) specified";
+    return 0;
+  }
+
+  my($root);
+  foreach $root (@{$roots}) {
+    if ($Is_MacOS) {
+      $root = ":$root" if $root !~ /:/;
+      $root =~ s#([^:])\z#$1:#;
+    } else {
+      $root =~ s#/\z##;
+    }
+    (undef, undef, my $rp) = lstat $root or next;
+    $rp &= 07777;	# don't forget setuid, setgid, sticky bits
+    if ( -d _ ) {
+      # notabene: 0700 is for making readable in the first place,
+      # it's also intended to change it to writable in case we have
+      # to recurse in which case we are better than rm -rf for
+      # subtrees with strange permissions
+      chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+        or warn "Can't make directory $root read+writeable: $!"
+          unless $safe;
+
+      if (opendir my $d, $root) {
+        no strict 'refs';
+        if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
+          # Blindly untaint dir names
+          @files = map { /^(.*)$/s ; $1 } readdir $d;
+        } else {
+          @files = readdir $d;
+        }
+        closedir $d;
+      } else {
+        warn "Can't read $root: $!";
+        @files = ();
+      }
+      # Deleting large numbers of files from VMS Files-11 filesystems
+      # is faster if done in reverse ASCIIbetical order
+      @files = reverse @files if $Is_VMS;
+      ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
+      if ($Is_MacOS) {
+        @files = map("$root$_", @files);
+      } else {
+        @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
+      }
+      $count += rmtree(\@files,$verbose,$safe);
+      if ($safe &&
+            ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+        print "skipped $root\n" if $verbose;
+        next;
+      }
+      chmod $rp | 0700, $root
+        or warn "Can't make directory $root writeable: $!"
+          if $force_writeable;
+      print "rmdir $root\n" if $verbose;
+      if (rmdir $root) {
+	      ++$count;
+      } else {
+        warn "Can't remove directory $root: $!";
+        chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+          or warn("and can't restore permissions to "
+            . sprintf("0%o",$rp) . "\n");
+      }
+    } else {
+      if ($safe &&
+            ($Is_VMS ? !&VMS::Filespec::candelete($root)
+              : !(-l $root || -w $root)))
+      {
+        print "skipped $root\n" if $verbose;
+        next;
+      }
+      chmod $rp | 0600, $root
+        or warn "Can't make file $root writeable: $!"
+          if $force_writeable;
+      print "unlink $root\n" if $verbose;
+      # delete all versions under VMS
+      for (;;) {
+        unless (unlink $root) {
+          warn "Can't unlink file $root: $!";
+          if ($force_writeable) {
+            chmod $rp, $root
+              or warn("and can't restore permissions to "
+                . sprintf("0%o",$rp) . "\n");
+          }
+          last;
+        }
+        ++$count;
+        last unless $Is_VMS && lstat $root;
+      }
+    }
+  }
+  $count;
+}
+
+
+=item C<copy($file, $target_dir)>
+
+=item C<copy("-f", $file, $destfile)>
+
+Copy file C<$file> to directory C<$target_dir>, or to the C<$destfile>
+in the second case.  No external programs are involved.  Since we need
+C<sysopen()>, the Perl module C<Fcntl.pm> is required.  The time stamps
+are preserved and symlinks are created on Unix systems.  On Windows,
+C<(-l $file)> will never return 'C<true>' and so symlinks will be
+(uselessly) copied as regular files.
+
+C<copy> invokes C<mkdirhier> if target directories do not exist.  Files
+have mode C<0777> if they are executable and C<0666> otherwise, with
+the set bits in I<umask> cleared in each case.
+
+C<$file> can begin with a file:/ prefix.
+
+If C<$file> is not readable, we return without copying anything.  (This
+can happen when the database and files are not in perfect sync.)  On the
+other file, if the destination is not writable, or the writing fails,
+that is a fatal error.
+
+=cut
+
+sub copy
+{
+  my $infile = shift;
+  my $filemode = 0;
+  if ($infile eq "-f") { # second argument is a file
+    $filemode = 1;
+    $infile = shift;
+  }
+  my $destdir=shift;
+
+  my $outfile;
+  my @stat;
+  my $mode;
+  my $buffer;
+  my $offset;
+  my $filename;
+  my $dirmode = 0755;
+  my $blocksize = $TeXLive::TLConfig::BlockSize;
+
+  $infile =~ s!^file://*!/!i;  # remove file:/ url prefix
+  $filename = basename "$infile";
+  if ($filemode) {
+    # given a destination file
+    $outfile = $destdir;
+    $destdir = dirname($outfile);
+  } else {
+    $outfile = "$destdir/$filename";
+  }
+
+  mkdirhier ($destdir) unless -d "$destdir";
+
+  if (-l "$infile") {
+    symlink (readlink $infile, "$destdir/$filename");
+  } else {
+    if (! open (IN, $infile)) {
+      warn "open($infile) failed, not copying: $!";
+      return;
+    }
+    binmode IN;
+
+    $mode = (-x "$infile") ? oct("0777") : oct("0666");
+    $mode &= ~umask;
+
+    open (OUT, ">$outfile") || die "open(>$outfile) failed: $!";
+    binmode OUT;
+
+    chmod $mode, "$outfile";
+
+    while ($read = sysread (IN, $buffer, $blocksize)) {
+      die "read($infile) failed: $!\n" unless defined $read;
+      $offset = 0;
+      while ($read) {
+        $written = syswrite (OUT, $buffer, $read, $offset);
+        die "write($outfile) failed: $!" unless defined $written;
+        $read -= $written;
+        $offset += $written;
+      }
+    }
+    close (OUT) || warn "close($outfile) failed: $!";
+    close IN || warn "close($infile) failed: $!";;
+    @stat = lstat ("$infile");
+    utime ($stat[8], $stat[9], $outfile);
+  }
+}
+
+
+=item C<touch(@files)>
+
+Update modification and access time of C<@files>.  Non-existent files
+are created.
+
+=cut
+
+sub touch {
+  my @files=@_;
+
+  foreach my $file (@_) {
+    if (-e $file) {
+	    utime time, time, $file;
+    } else {
+	    open TMP, ">>$file" && close TMP
+          or warn "Can't update timestamps of $file: $!\n";
+    }
+  }
+}
+
+
+
+
+
+=item C<collapse_dirs(@files)>
+
+Return a (more or less) minimal list of directories and files, given an
+original list of files C<@files>.  That is, if every file within a given
+directory is included in C<@files>, replace all of those files with the
+absolute directory name in the return list.  Any files which have
+sibling files not included are retained and made absolute.
+
+We try to walk up the tree so that the highest-level directory
+containing only directories or files that are in C<@files> is returned.
+(This logic may not be perfect, though.)
+
+This is not just a string function; we check for other directory entries
+existing on disk within the directories of C<@files>.  Therefore, if the
+entries are relative pathnames, the current directory must be set by the
+caller so that file tests work.
+
+As mentioned above, the returned list is absolute paths to directories
+and files.
+
+For example, suppose the input list is
+
+  dir1/subdir1/file1
+  dir1/subdir2/file2
+  dir1/file3
+
+If there are no other entries under C<dir1/>, the result will be
+C</absolute/path/to/dir1>.
+
+=cut
+
+sub collapse_dirs
+{
+  my (@files) = @_;
+  my @ret = ();
+  my %by_dir;
+
+  # construct hash of all directories mentioned, values are lists of the
+  # files in that directory.
+  for my $f (@files) {
+    my $abs_f = Cwd::abs_path ($f);
+    die ("oops, no abs_path($f) from " . `pwd`) unless $abs_f;
+    (my $d = $abs_f) =~ s,/[^/]*$,,;
+    my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
+    push (@a, $abs_f);
+    $by_dir{$d} = \@a;
+  }
+
+  # for each of our directories, see if we are given everything in
+  # the directory.  if so, return the directory; else return the
+  # individual files.
+  for my $d (sort keys %by_dir) {
+    opendir (DIR, $d) || die "opendir($d) failed: $!";
+    my @dirents = readdir (DIR);
+    closedir (DIR) || warn "closedir($d) failed: $!";
+
+    # initialize test hash with all the files we saw in this dir.
+    # (These idioms are due to "Finding Elements in One Array and Not
+    # Another" in the Perl Cookbook.)
+    my %seen;
+    my @rmfiles = @{$by_dir{$d}};
+    @seen{@rmfiles} = ();
+
+    # see if everything is the same.
+    my $ok_to_collapse = 1;
+    for my $dirent (@dirents) {
+      next if $dirent =~ /^\.(\.|svn)?$/;  # ignore . .. .svn
+
+      my $item = "$d/$dirent";  # prepend directory for comparison
+      if (! exists $seen{$item}) {
+        $ok_to_collapse = 0;
+        last;  # no need to keep looking after the first.
+      }
+    }
+
+    push (@ret, $ok_to_collapse ? $d : @{$by_dir{$d}});
+  }
+
+  if (@ret != @files) {
+    @ret = &collapse_dirs (@ret);
+  }
+  return @ret;
+}
+
+=item C<removed_dirs(@files)>
+
+returns all the directories from which all content will be removed
+
+=cut
+
+# return all the directories from which all content will be removed
+#
+# idea:
+# - create a hashes by_dir listing all files that should be removed
+#   by directory, i.e., key = dir, value is list of files
+# - for each of the dirs (keys of by_dir and ordered deepest first)
+#   check that all actually contained files are removed
+#   and all the contained dirs are in the removal list. If this is the
+#   case put that directory into the removal list
+# - return this removal list
+#
+sub removed_dirs
+{
+  my (@files) = @_;
+  my %removed_dirs;
+  my %by_dir;
+
+  # construct hash of all directories mentioned, values are lists of the
+  # files/dirs in that directory.
+  for my $f (@files) {
+    # what should we do with not existing entries????
+    next if (! -r "$f");
+    my $abs_f = Cwd::abs_path ($f);
+    # the following is necessary because on win32,
+    #   abs_path("tl-portable")
+    # returns
+    #   c:\tl test\...
+    # and not forward slashes, while, if there is already a forward /
+    # in the path, also the rest is done with forward slashes.
+    $abs_f =~ s!\\!/!g if win32();
+    if (!$abs_f) {
+      warn ("oops, no abs_path($f) from " . `pwd`);
+      next;
+    }
+    (my $d = $abs_f) =~ s,/[^/]*$,,;
+    my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
+    push (@a, $abs_f);
+    $by_dir{$d} = \@a;
+  }
+
+  # for each of our directories, see if we are removing everything in
+  # the directory.  if so, return the directory; else return the
+  # individual files.
+  for my $d (reverse sort keys %by_dir) {
+    opendir (DIR, $d) || die "opendir($d) failed: $!";
+    my @dirents = readdir (DIR);
+    closedir (DIR) || warn "closedir($d) failed: $!";
+
+    # initialize test hash with all the files we saw in this dir.
+    # (These idioms are due to "Finding Elements in One Array and Not
+    # Another" in the Perl Cookbook.)
+    my %seen;
+    my @rmfiles = @{$by_dir{$d}};
+    @seen{@rmfiles} = ();
+
+    # see if everything is the same.
+    my $cleandir = 1;
+    for my $dirent (@dirents) {
+      next if $dirent =~ /^\.(\.|svn)?$/;  # ignore . .. .svn
+      my $item = "$d/$dirent";  # prepend directory for comparison
+      if (
+           ((-d $item) && (defined($removed_dirs{$item})))
+           ||
+           (exists $seen{$item})
+         ) {
+        # do nothing
+      } else {
+        $cleandir = 0;
+        last;
+      }
+    }
+    if ($cleandir) {
+      $removed_dirs{$d} = 1;
+    }
+  }
+  return keys %removed_dirs;
+}
+
+=item C<time_estimate($totalsize, $donesize, $starttime)>
+
+Returns the current running time and the estimated total time
+based on the total size, the already done size, and the start time.
+
+=cut
+
+sub time_estimate {
+  my ($totalsize, $donesize, $starttime) = @_;
+  if ($donesize <= 0) {
+    return ("??:??", "??:??");
+  }
+  my $curtime = time();
+  my $passedtime = $curtime - $starttime;
+  my $esttotalsecs = int ( ( $passedtime * $totalsize ) / $donesize );
+  #
+  # we change the display to show that passed time instead of the
+  # estimated remaining time. We keep the old code and naming and
+  # only initialize the $remsecs to the $passedtime instead.
+  # my $remsecs = $esttotalsecs - $passedtime;
+  my $remsecs = $passedtime;
+  my $min = int($remsecs/60);
+  my $hour;
+  if ($min >= 60) {
+    $hour = int($min/60);
+    $min %= 60;
+  }
+  my $sec = $remsecs % 60;
+  $remtime = sprintf("%02d:%02d", $min, $sec);
+  if ($hour) {
+    $remtime = sprintf("%02d:$remtime", $hour);
+  }
+  my $tmin = int($esttotalsecs/60);
+  my $thour;
+  if ($tmin >= 60) {
+    $thour = int($tmin/60);
+    $tmin %= 60;
+  }
+  my $tsec = $esttotalsecs % 60;
+  $tottime = sprintf("%02d:%02d", $tmin, $tsec);
+  if ($thour) {
+    $tottime = sprintf("%02d:$tottime", $thour);
+  }
+  return($remtime, $tottime);
+}
+
+
+=item C<install_packages($from_tlpdb, $media, $to_tlpdb, $what, $opt_src, $opt_doc)>
+
+Installs the list of packages found in C<@$what> (a ref to a list) into
+the TLPDB given by C<$to_tlpdb>. Information on files are taken from
+the TLPDB C<$from_tlpdb>.
+
+C<$opt_src> and C<$opt_doc> specify whether srcfiles and docfiles should be
+installed (currently implemented only for installation from uncompressed media).
+
+Returns 1 on success and 0 on error.
+
+=cut
+
+sub install_packages {
+  my ($fromtlpdb,$media,$totlpdb,$what,$opt_src,$opt_doc) = @_;
+  my $container_src_split = $fromtlpdb->config_src_container;
+  my $container_doc_split = $fromtlpdb->config_doc_container;
+  my $root = $fromtlpdb->root;
+  my @packs = @$what;
+  my $totalnr = $#packs + 1;
+  my $td = length("$totalnr");
+  my $n = 0;
+  my %tlpobjs;
+  my $totalsize = 0;
+  my $donesize = 0;
+  my %tlpsizes;
+  foreach my $p (@packs) {
+    $tlpobjs{$p} = $fromtlpdb->get_package($p);
+    if (!defined($tlpobjs{$p})) {
+      die "STRANGE: $p not to be found in ", $fromtlpdb->root;
+    }
+    if ($media ne 'local_uncompressed') {
+      # we use the container size as the measuring unit since probably
+      # downloading will be the limiting factor
+      $tlpsizes{$p} = $tlpobjs{$p}->containersize;
+      $tlpsizes{$p} += $tlpobjs{$p}->srccontainersize if $opt_src;
+      $tlpsizes{$p} += $tlpobjs{$p}->doccontainersize if $opt_doc;
+    } else {
+      # we have to add the respective sizes, that is checking for
+      # installation of src and doc file
+      $tlpsizes{$p} = $tlpobjs{$p}->runsize;
+      $tlpsizes{$p} += $tlpobjs{$p}->srcsize if $opt_src;
+      $tlpsizes{$p} += $tlpobjs{$p}->docsize if $opt_doc;
+      my %foo = %{$tlpobjs{$p}->binsize};
+      for my $k (keys %foo) { $tlpsizes{$p} += $foo{$k}; }
+      # all the packages sizes are in blocks, so transfer that to bytes
+      $tlpsizes{$p} *= $TeXLive::TLConfig::BlockSize;
+    }
+    $totalsize += $tlpsizes{$p};
+  }
+  my $starttime = time();
+  foreach my $package (@packs) {
+    my $tlpobj = $tlpobjs{$package};
+    my $reloc = $tlpobj->relocated;
+    $n++;
+    my ($estrem, $esttot) = time_estimate($totalsize, $donesize, $starttime);
+    my $infostr = sprintf("Installing [%0${td}d/$totalnr, "
+                     . "time/total: $estrem/$esttot]: $package [%dk]",
+                     $n, int($tlpsizes{$package}/1024) + 1);
+    info("$infostr\n");
+    foreach my $h (@::install_packages_hook) {
+      &$h($n,$totalnr);
+    }
+    my $real_opt_doc = $opt_doc;
+    my $container;
+    my @installfiles;
+    push @installfiles, $tlpobj->runfiles;
+    push @installfiles, $tlpobj->allbinfiles;
+    push @installfiles, $tlpobj->srcfiles if ($opt_src);
+    push @installfiles, $tlpobj->docfiles if ($real_opt_doc);
+    if ($media eq 'local_uncompressed') {
+      $container = [ $root, @installfiles ];
+    } elsif ($media eq 'local_compressed') {
+      if (-r "$root/$Archive/$package.zip") {
+        $container = "$root/$Archive/$package.zip";
+      } elsif (-r "$root/$Archive/$package.tar.xz") {
+        $container = "$root/$Archive/$package.tar.xz";
+      } else {
+        tlwarn("No package $package (.zip or .xz) in $root/$Archive\n");
+        next;
+      }
+    } elsif ($media eq 'NET') {
+      $container = "$root/$Archive/$package.$DefaultContainerExtension";
+    }
+    if (!install_package($container, $reloc, $tlpobj->containersize,
+                         $tlpobj->containermd5, \@installfiles,
+                         $totlpdb->root, $vars{'this_platform'})) {
+      # we already warn in install_package that something bad happened,
+      # so only return here
+      return 0;
+    }
+    # if we are installing from compressed media we have to fetch the respective
+    # source and doc packages $pkg.source and $pkg.doc and install them, too
+    if (($media eq 'NET') || ($media eq 'local_compressed')) {
+      # we install split containers under the following conditions:
+      # - the container were split generated
+      # - src/doc files should be installed
+      # (- the package is not already a split one (like .i386-linux))
+      # the above test has been removed since that would mean that packages
+      # with a dot like texlive.infra will never have the docfiles installed
+      # that is already happening ...bummer. But since we already check
+      # whether there are src/docfiles present at all that is fine
+      # - there are actually src/doc files present
+      if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
+        my $srccontainer = $container;
+        $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
+        if (!install_package($srccontainer, $reloc, $tlpobj->srccontainersize,
+                             $tlpobj->srccontainermd5, \@installfiles,
+                             $totlpdb->root, $vars{'this_platform'})) {
+          return 0;
+        }
+      }
+      if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
+        my $doccontainer = $container;
+        $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+        if (!install_package($doccontainer, $reloc,
+                             $tlpobj->doccontainersize,
+                             $tlpobj->doccontainermd5, \@installfiles,
+                             $totlpdb->root, $vars{'this_platform'})) {
+          return 0;
+        }
+      }
+    }
+    # we don't want to have wrong information in the tlpdb, so remove the
+    # src/doc files if they are not installed ...
+    if (!$opt_src) {
+      $tlpobj->clear_srcfiles;
+    }
+    if (!$real_opt_doc) {
+      $tlpobj->clear_docfiles;
+    }
+    # if a package is relocatable we have to cancel the reloc prefix
+    # before we save it to the local tlpdb
+    if ($tlpobj->relocated) {
+      $tlpobj->cancel_reloc_prefix;
+    }
+    $totlpdb->add_tlpobj($tlpobj);
+    # we have to write out the tlpobj file since it is contained in the
+    # archives (.tar.xz) but at uncompressed-media install time we don't have them
+    my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
+    mkdirhier( $tlpod );
+    open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") ||
+      die "$0: open tlpobj " . $tlpobj->name . "failed: $!";
+    $tlpobj->writeout(\*TMP);
+    close(TMP);
+    $donesize += $tlpsizes{$package};
+  }
+  my $totaltime = time() - $starttime;
+  my $totmin = int ($totaltime/60);
+  my $totsec = $totaltime % 60;
+  info(sprintf("Time used for installing the packages: %02d:%02d\n",
+       $totmin, $totsec));
+  $totlpdb->save;
+  return 1;
+}
+
+
+=item C<install_package($what, $reloc, $size, $md5, $filelistref, $target, $platform)>
+
+This function installs the files given in @$filelistref from C<$what>
+into C<$target>.
+
+C<$size> gives the size in bytes of the container, or -1 if we are
+installing from uncompressed media, i.e., from a list of files to be copied.
+
+If C<$what> is a reference to a list of files then these files are
+assumed to be readable and are copied to C<$target>, creating dirs on
+the way. In this case the list C<@$filelistref> is not taken into
+account.
+
+If C<$what> starts with C<http://> or C<ftp://> then C<$what> is
+downloaded from the net and piped through C<xzdec> and C<tar>.
+
+If $what ends with C<.tar.xz> (but does not start with C<http://> or
+C<ftp://>, but possibly with C<file:/>) it is assumed to be a readable
+file on the system and is likewise piped through C<xzdec> and C<tar>.
+
+In both of these cases currently the list C<$@filelistref> currently
+is not taken into account (should be fixed!).
+
+if C<$reloc> is true the container (NET or local_compressed mode) is packaged in a way
+that the initial texmf-dist is missing.
+
+Returns 1 on success and 0 on error.
+
+=cut
+
+sub install_package {
+  my ($what, $reloc,  $whatsize, $whatmd5, $filelistref, $target, $platform) = @_;
+
+  my @filelist = @$filelistref;
+
+  my $tempdir = "$target/temp";
+
+  # we assume that $::progs has been set up!
+  my $wget = $::progs{'wget'};
+  my $xzdec = quotify_path_with_spaces($::progs{'xzdec'});
+  if (!defined($wget) || !defined($xzdec)) {
+    tlwarn("install_package: wget/xzdec programs not set up properly.\n");
+    return 0;
+  }
+  if (ref $what) {
+    # we are getting a ref to a list of files, so install from uncompressed media
+    my ($root, @files) = @$what;
+    foreach my $file (@files) {
+      # @what is taken, not @filelist!
+      # is this still needed?
+      my $dn=dirname($file);
+      mkdirhier("$target/$dn");
+      copy "$root/$file", "$target/$dn";
+    }
+  } elsif ($what =~ m,\.tar.xz$,) {
+    # this is the case when we install from compressed media
+    #
+    # in all other cases we create temp files .tar.xz (or use the present
+    # one), xzdec them, and then call tar
+
+    # if we are unpacking a relocated container we adjust the target
+    if ($reloc) {
+      $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc;
+      mkdir($target) if (! -d $target);
+    }
+
+    my $fn = basename($what);
+    my $pkg = $fn;
+    $pkg =~ s/\.tar\.xz$//;
+    mkdirhier("$tempdir");
+    my $xzfile = "$tempdir/$fn";
+    my $tarfile  = "$tempdir/$fn"; $tarfile =~ s/\.xz$//;
+    my $xzfile_quote = $xzfile;
+    my $tarfile_quote = $tarfile;
+    if (win32()) {
+      $xzfile =~ s!/!\\!g;
+      $tarfile =~ s!/!\\!g;
+      $target =~ s!/!\\!g;
+    }
+    $xzfile_quote = "\"$xzfile\"";
+    $tarfile_quote = "\"$tarfile\"";
+    my $gotfiledone = 0;
+    if (-r $xzfile) {
+      # check that the downloaded file is not partial
+      if ($whatsize >= 0) {
+        # we have the size given, so check that first
+        my $size = (stat $xzfile)[7];
+        if ($size == $whatsize) {
+          # we want to check also the md5sum if we have it present
+          if ($whatmd5) {
+            if (tlmd5($xzfile) eq $whatmd5) {
+              $gotfiledone = 1;
+            } else {
+              tlwarn("Downloaded $what, size equal, but md5sum differs;\n",
+                     "downloading again.\n");
+            }
+          } else {
+            # size ok, no md5sum
+            tlwarn("Downloaded $what, size equal, but no md5sum available;\n",
+                   "continuing, with fingers crossed.");
+            $gotfiledone = 1;
+          }
+        } else {
+          tlwarn("Partial download of $what found, removing it.\n");
+          unlink($tarfile, $xzfile);
+        }
+      } else {
+        # ok no size information, hopefully we have md5 sums
+        if ($whatmd5) {
+          if (tlmd5($xzfile) eq $whatmd5) {
+            $gotfiledone = 1;
+          } else {
+            tlwarn("Downloaded file, but md5sum differs, removing it.\n");
+          }
+        } else {
+          tlwarn("Container found, but cannot verify size of md5sum;\n",
+                 "continuing, with fingers crossed.\n");
+          $gotfiledone = 1;
+        }
+      }
+      debug("Reusing already downloaded container $xzfile\n")
+        if ($gotfiledone);
+    }
+    if (!$gotfiledone) {
+      if ($what =~ m,http://|ftp://,) {
+        # we are installing from the NET
+        # download the file and put it into temp
+        if (!download_file($what, $xzfile) || (! -r $xzfile)) {
+          tlwarn("Downloading $what did not succeed.\n");
+          return 0;
+        }
+      } else {
+        # we are installing from local compressed media
+        # copy it to temp
+        copy($what, $tempdir);
+      }
+    }
+    debug("un-xzing $xzfile to $tarfile\n");
+    system("$xzdec < $xzfile_quote > $tarfile_quote");
+    if (! -f $tarfile) {
+      tlwarn("Unpacking $xzfile did not succeed.\n");
+      return 0;
+    }
+    if (!TeXLive::TLUtils::untar($tarfile, $target, 1)) {
+      tlwarn("untarring $tarfile failed, stopping install.\n");
+      return 0;
+    }
+    # we remove the created .tlpobj it is recreated anyway in
+    # install_packages above in the right place. This way we also
+    # get rid of the $pkg.source.tlpobj which are useless
+    unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj")
+      if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
+    if ($what =~ m,http://|ftp://,) {
+      # we downloaded the original .tar.lzma from the net, so we keep it
+    } else {
+      # we are downloading it from local compressed media, so we can unlink it to save
+      # disk space
+      unlink($xzfile);
+    }
+  } else {
+    tlwarn("Sorry, no idea how to install $what\n");
+    return 0;
+  }
+  return 1;
+}
+
+=item C<do_postaction($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script)>
+
+Evaluates the C<postaction> fields in the C<$tlpobj>. The first parameter
+can be either C<install> or C<remove>. The second gives the TLPOBJ whos
+postactions should be evaluated, and the last four arguments specify
+what type of postactions should (or shouldn't) be evaluated.
+
+Returns 1 on success, and 0 on failure.
+
+=cut
+
+sub do_postaction {
+  my ($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script) = @_;
+  my $ret = 1;
+  if (!defined($tlpobj)) {
+    tlwarn("do_postaction: didn't get a tlpobj\n");
+    return 0;
+  }
+  debug("running postaction=$how for " . $tlpobj->name . "\n")
+    if $tlpobj->postactions;
+  for my $pa ($tlpobj->postactions) {
+    if ($pa =~ m/^\s*shortcut\s+(.*)\s*$/) {
+      $ret &&= _do_postaction_shortcut($how, $tlpobj, $do_menu, $do_desktop, $1);
+    } elsif ($pa =~ m/\s*filetype\s+(.*)\s*$/) {
+      next unless $do_fileassocs;
+      $ret &&= _do_postaction_filetype($how, $tlpobj, $1);
+    } elsif ($pa =~ m/\s*fileassoc\s+(.*)\s*$/) {
+      $ret &&= _do_postaction_fileassoc($how, $do_fileassocs, $tlpobj, $1);
+      next;
+    } elsif ($pa =~ m/\s*progid\s+(.*)\s*$/) {
+      next unless $do_fileassocs;
+      $ret &&= _do_postaction_progid($how, $tlpobj, $1);
+    } elsif ($pa =~ m/\s*script\s+(.*)\s*$/) {
+      next unless $do_script;
+      $ret &&= _do_postaction_script($how, $tlpobj, $1);
+    } else {
+      tlwarn("do_postaction: don't know how to do $pa\n");
+      $ret = 0;
+    }
+  }
+  # nothing to do
+  return $ret;
+}
+
+sub _do_postaction_fileassoc {
+  my ($how, $mode, $tlpobj, $pa) = @_;
+  return 1 unless win32();
+  my ($errors, %keyval) =
+    parse_into_keywords($pa, qw/extension filetype/);
+
+  if ($errors) {
+    tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+    return 0;
+  }
+
+  # name can be an arbitrary string
+  if (!defined($keyval{'extension'})) {
+    tlwarn("extension of fileassoc postaction not given\n");
+    return 0;
+  }
+  my $extension = $keyval{'extension'};
+
+  # cmd can be an arbitrary string
+  if (!defined($keyval{'filetype'})) {
+    tlwarn("filetype of fileassoc postaction not given\n");
+    return 0;
+  }
+  my $filetype = $keyval{'filetype'};
+
+  &log("postaction $how fileassoc for " . $tlpobj->name .
+    ": $extension, $filetype\n");
+  if ($how eq "install") {
+    TeXLive::TLWinGoo::register_extension($mode, $extension, $filetype);
+  } elsif ($how eq "remove") {
+    TeXLive::TLWinGoo::unregister_extension($mode, $extension, $filetype);
+  } else {
+    tlwarn("Unknown mode $how\n");
+    return 0;
+  }
+  return 1;
+}
+
+sub _do_postaction_filetype {
+  my ($how, $tlpobj, $pa) = @_;
+  return 1 unless win32();
+  my ($errors, %keyval) =
+    parse_into_keywords($pa, qw/name cmd/);
+
+  if ($errors) {
+    tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+    return 0;
+  }
+
+  # name can be an arbitrary string
+  if (!defined($keyval{'name'})) {
+    tlwarn("name of filetype postaction not given\n");
+    return 0;
+  }
+  my $name = $keyval{'name'};
+
+  # cmd can be an arbitrary string
+  if (!defined($keyval{'cmd'})) {
+    tlwarn("cmd of filetype postaction not given\n");
+    return 0;
+  }
+  my $cmd = $keyval{'cmd'};
+
+  my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`;
+  chomp($texdir);
+  my $texdir_bsl = conv_to_w32_path($texdir);
+  $cmd =~ s!^("?)TEXDIR/!$1$texdir/!g;
+
+  &log("postaction $how filetype for " . $tlpobj->name .
+    ": $name, $cmd\n");
+  if ($how eq "install") {
+    TeXLive::TLWinGoo::register_file_type($name, $cmd);
+  } elsif ($how eq "remove") {
+    TeXLive::TLWinGoo::unregister_file_type($name);
+  } else {
+    tlwarn("Unknown mode $how\n");
+    return 0;
+  }
+  return 1;
+}
+
+# alternate filetype (= progid) for an extension;
+# associated program shows up in `open with' menu
+sub _do_postaction_progid {
+  my ($how, $tlpobj, $pa) = @_;
+  return 1 unless win32();
+  my ($errors, %keyval) =
+    parse_into_keywords($pa, qw/extension filetype/);
+
+  if ($errors) {
+    tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+    return 0;
+  }
+
+  if (!defined($keyval{'extension'})) {
+    tlwarn("extension of progid postaction not given\n");
+    return 0;
+  }
+  my $extension = $keyval{'extension'};
+
+  if (!defined($keyval{'filetype'})) {
+    tlwarn("filetype of progid postaction not given\n");
+    return 0;
+  }
+  my $filetype = $keyval{'filetype'};
+
+  &log("postaction $how progid for " . $tlpobj->name .
+    ": $extension, $filetype\n");
+  if ($how eq "install") {
+    TeXLive::TLWinGoo::add_to_progids($extension, $filetype);
+  } elsif ($how eq "remove") {
+    TeXLive::TLWinGoo::remove_from_progids($extension, $filetype);
+  } else {
+    tlwarn("Unknown mode $how\n");
+    return 0;
+  }
+  return 1;
+}
+
+sub _do_postaction_script {
+  my ($how, $tlpobj, $pa) = @_;
+  my ($errors, %keyval) =
+    parse_into_keywords($pa, qw/file filew32/);
+
+  if ($errors) {
+    tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+    return 0;
+  }
+
+  # file can be an arbitrary string
+  if (!defined($keyval{'file'})) {
+    tlwarn("filename of script not given\n");
+    return 0;
+  }
+  my $file = $keyval{'file'};
+  if (win32() && defined($keyval{'filew32'})) {
+    $file = $keyval{'filew32'};
+  }
+  my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`;
+  chomp($texdir);
+  my @syscmd;
+  if ($file =~ m/\.pl$/i) {
+    # we got a perl script, call it via perl
+    push @syscmd, "perl", "$texdir/$file";
+  } elsif ($file =~ m/\.texlua$/i) {
+    # we got a texlua script, call it via texlua
+    push @syscmd, "texlua", "$texdir/$file";
+  } else {
+    # we got anything else, call it directly and hope it is excutable
+    push @syscmd, "$texdir/$file";
+  }
+  &log("postaction $how script for " . $tlpobj->name . ": @syscmd\n");
+  push @syscmd, $how, $texdir;
+  my $ret = system (@syscmd);
+  if ($ret != 0) {
+    $ret /= 256 if $ret > 0;
+    my $pwd = cwd ();
+    warn "$0: calling post action script $file did not succeed in $pwd, status $ret";
+    return 0;
+  }
+  return 1;
+}
+
+sub _do_postaction_shortcut {
+  my ($how, $tlpobj, $do_menu, $do_desktop, $pa) = @_;
+  return 1 unless win32();
+  my ($errors, %keyval) =
+    parse_into_keywords($pa, qw/type name icon cmd args hide/);
+
+  if ($errors) {
+    tlwarn("parsing the postaction line >>$pa<< did not succeed!\n");
+    return 0;
+  }
+
+  # type can be either menu or desktop
+  if (!defined($keyval{'type'})) {
+    tlwarn("type of shortcut postaction not given\n");
+    return 0;
+  }
+  my $type = $keyval{'type'};
+  if (($type ne "menu") && ($type ne "desktop")) {
+    tlwarn("type of shortcut postaction $type is unknown (menu, desktop)\n");
+    return 0;
+  }
+
+  if (($type eq "menu") && !$do_menu) {
+    return 1;
+  }
+  if (($type eq "desktop") && !$do_desktop) {
+    return 1;
+  }
+
+  # name can be an arbitrary string
+  if (!defined($keyval{'name'})) {
+    tlwarn("name of shortcut postaction not given\n");
+    return 0;
+  }
+  my $name = $keyval{'name'};
+
+  # icon, cmd, args is optional
+  my $icon = (defined($keyval{'icon'}) ? $keyval{'icon'} : '');
+  my $cmd = (defined($keyval{'cmd'}) ? $keyval{'cmd'} : '');
+  my $args = (defined($keyval{'args'}) ? $keyval{'args'} : '');
+
+  # hide can be only 0 or 1, and defaults to 1
+  my $hide = (defined($keyval{'hide'}) ? $keyval{'hide'} : 1);
+  if (($hide ne "0") && ($hide ne "1")) {
+    tlwarn("hide of shortcut postaction $hide is unknown (0, 1)\n");
+    return 0;
+  }
+
+  &log("postaction $how shortcut for " . $tlpobj->name . "\n");
+  if ($how eq "install") {
+    my $texdir = `kpsewhich -var-value=SELFAUTOPARENT`;
+    chomp($texdir);
+    my $texdir_bsl = conv_to_w32_path($texdir);
+    $icon =~ s!^TEXDIR/!$texdir/!;
+    $cmd =~ s!^TEXDIR/!$texdir/!;
+    # $cmd can be an URL, in which case we do NOT want to convert it to
+    # w32 paths!
+    if ($cmd !~ m!^\s*(http://|ftp://)!) {
+      $cmd = conv_to_w32_path($cmd);
+    }
+    if ($type eq "menu") {
+      TeXLive::TLWinGoo::add_menu_shortcut(
+                        $TeXLive::TLConfig::WindowsMainMenuName,
+                        $name, $icon, $cmd, $args, $hide);
+    } elsif ($type eq "desktop") {
+      TeXLive::TLWinGoo::add_desktop_shortcut(
+                        $name, $icon, $cmd, $args, $hide);
+    } else {
+      tlwarn("Unknown type of shortcut: $type\n");
+      return 0;
+    }
+  } elsif ($how eq "remove") {
+    if ($type eq "menu") {
+      TeXLive::TLWinGoo::remove_menu_shortcut(
+        $TeXLive::TLConfig::WindowsMainMenuName, $name);
+    } elsif ($type eq "desktop") {
+      TeXLive::TLWinGoo::remove_desktop_shortcut($name);
+    } else {
+      tlwarn("Unknown type of shortcut: $type\n");
+      return 0;
+    }
+  } else {
+    tlwarn("Unknown mode $how\n");
+    return 0;
+  }
+  return 1;
+}
+
+sub parse_into_keywords {
+  my ($str, @keys) = @_;
+  my @words = quotewords('\s+', 0, $str);
+  my %ret;
+  my $error = 0;
+  while (@words) {
+    $_ = shift @words;
+    if (/^([^=]+)=(.*)$/) {
+      $ret{$1} = $2;
+    } else {
+      tlwarn("parser found a invalid word in parsing keys: $_\n");
+      $error++;
+      $ret{$_} = "";
+    }
+  }
+  for my $k (keys %ret) {
+    if (!member($k, @keys)) {
+      $error++;
+      tlwarn("parser found invalid keyword: $k\n");
+    }
+  }
+  return($error, %ret);
+}
+
+=item C<announce_execute_actions($how, $tlpobj)>
+
+Announces that the actions given in C<$tlpobj> should be executed
+after all packages have been unpacked.
+
+=cut
+
+sub announce_execute_actions {
+  my ($type, $tlp, $what) = @_;
+  # do simply return immediately if execute actions are suppressed
+  return if $::no_execute_actions;
+
+  if (defined($type) && ($type eq "regenerate-formats")) {
+    $::regenerate_all_formats = 1;
+    return;
+  }
+  if (defined($type) && ($type eq "files-changed")) {
+    $::files_changed = 1;
+    return;
+  }
+  if (defined($type) && ($type eq "latex-updated")) {
+    $::latex_updated = 1;
+    return;
+  }
+  if (defined($type) && ($type eq "tex-updated")) {
+    $::tex_updated = 1;
+    return;
+  }
+  if (!defined($type) || (($type ne "enable") && ($type ne "disable"))) {
+    die "announce_execute_actions: enable or disable, not type $type";
+  }
+  my (@maps, @formats, @dats);
+  if ($tlp->runfiles || $tlp->srcfiles || $tlp->docfiles) {
+    $::files_changed = 1;
+  }
+  $what = "map format hyphen" if (!defined($what));
+  foreach my $e ($tlp->executes) {
+    if ($e =~ m/^add((Mixed)?Map)\s+([^\s]+)\s*$/) {
+      # save the refs as we have another =~ grep in the following lines
+      my $a = $1;
+      my $b = $3;
+      $::execute_actions{$type}{'maps'}{$b} = $a if ($what =~ m/map/);
+    } elsif ($e =~ m/^AddFormat\s+(.*)\s*$/) {
+      my %r = TeXLive::TLUtils::parse_AddFormat_line("$1");
+      if (defined($r{"error"})) {
+        tlwarn ("$r{'error'} in parsing $e for return hash\n");
+      } else {
+        $::execute_actions{$type}{'formats'}{$r{'name'}} = \%r
+          if ($what =~ m/format/);
+      }
+    } elsif ($e =~ m/^AddHyphen\s+(.*)\s*$/) {
+      my %r = TeXLive::TLUtils::parse_AddHyphen_line("$1");
+      if (defined($r{"error"})) {
+        tlwarn ("$r{'error'} in parsing $e for return hash\n");
+      } else {
+        $::execute_actions{$type}{'hyphens'}{$r{'name'}} = \%r
+          if ($what =~ m/hyphen/);
+      }
+    } else {
+      tlwarn("Unknown execute $e in ", $tlp->name, "\n");
+    }
+  }
+}
+
+
+=pod
+
+=item C<add_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info)>
+=item C<remove_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info)>
+
+These two functions try to create/remove symlinks for binaries, man pages,
+and info files as specified by the options $sys_bin, $sys_man, $sys_info.
+
+The functions return 1 on success and 0 on error.
+On Windows it returns undefined.
+
+=cut
+
+sub add_link_dir_dir {
+  my ($from, $to) = @_;
+  mkdirhier $to;
+  if (-w  $to) {
+    debug("linking files from $from to $to\n");
+    chomp (@files = `ls "$from"`);
+    my $ret = 1;
+    for my $f (@files) {
+      # skip certain dangerous entries that should never be linked somewhere
+      if ($f eq "man") {
+        debug("not linking man into $to.\n");
+        next;
+      }
+      unlink("$to/$f");
+      if (system("ln -s \"$from/$f\" \"$to\"")) {
+        tlwarn("Linking $f from $from to $to failed: $!\n");
+        $ret = 0;
+      }
+    }
+    return $ret;
+  } else {
+    tlwarn("destination $to not writable, no linking files in $from done.\n");
+    return 0;
+  }
+}
+
+sub remove_link_dir_dir {
+  my ($from, $to) = @_;
+  if ((-d "$to") && (-w "$to")) {
+    debug("removing links from $from to $to\n");
+    chomp (@files = `ls "$from"`);
+    my $ret = 1;
+    foreach my $f (@files) {
+      next if (! -r "$to/$f");
+      if ($f eq "man") {
+        debug("not considering man in $to, it should not be from us!\n");
+        next;
+      }
+      if ((-l "$to/$f") &&
+          (readlink("$to/$f") =~ m;^$from/;)) {
+        $ret = 0 unless unlink("$to/$f");
+      } else {
+        $ret = 0;
+        tlwarn ("not removing $to/$f, not a link or wrong destination!\n");
+      }
+    }
+    # trry to remove the destination directory, it might be empty and
+    # we might have write permissions, ignore errors
+    `rmdir "$to" 2>/dev/null`;
+    return $ret;
+  } else {
+    tlwarn ("destination $to not writable, no removal of links done!\n");
+    return 0;
+  }
+}
+
+sub add_remove_symlinks {
+  my ($mode, $Master, $arch, $sys_bin, $sys_man, $sys_info) = @_;
+  my $errors = 0;
+  my $plat_bindir = "$Master/bin/$arch";
+  return if win32();
+  if ($mode eq "add") {
+    $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin);
+    if (-d "$Master/texmf/doc/info") {
+      $errors++ unless add_link_dir_dir("$Master/texmf/doc/info", $sys_info);
+    }
+  } elsif ($mode eq "remove") {
+    $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin);
+    if (-d "$Master/texmf/doc/info") {
+      $errors++ unless remove_link_dir_dir("$Master/texmf/doc/info", $sys_info);
+    }
+  } else {
+    die ("should not happen, unknown mode $mode in add_remove_symlinks!");
+  }
+  mkdirhier $sys_man if ($mode eq "add");
+  if (-w  $sys_man && -d "$Master/texmf/doc/man") {
+    debug("$mode symlinks for man pages in $sys_man\n");
+    my $foo = `(cd "$Master/texmf/doc/man" && echo *)`;
+    chomp (my @mans = split (' ', $foo));
+    foreach my $m (@mans) {
+      my $mandir = "$Master/texmf/doc/man/$m";
+      next unless -d $mandir;
+      if ($mode eq "add") {
+        $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m");
+      } else {
+        $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m");
+      }
+    }
+    `rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove");
+  } else {
+    tlwarn("destination of man symlink $sys_man not writable, "
+      . "cannot $mode symlinks.\n");
+    $errors++;
+  }
+  # we collected errors in $ret, so return the negation of it
+  if ($errors) {
+    info("$mode of symlinks failed $errors times, please see above messages.\n");
+    return 0;
+  } else {
+    return 1;
+  }
+}
+
+sub add_symlinks {
+  return (add_remove_symlinks("add", @_));
+}
+sub remove_symlinks {
+  return (add_remove_symlinks("remove", @_));
+}
+
+=pod
+
+=item C<w32_add_to_path($bindir, $multiuser)>
+=item C<w32_remove_from_path($bindir, $multiuser)>
+
+These two functions try to add/remove the binary directory $bindir
+on Windows to the registry PATH variable.
+
+If running as admin user and $multiuser is set, the system path will
+be adjusted, otherwise the user path.
+
+After calling these functions TeXLive::TLWinGoo::broadcast_env() should
+be called to make the changes immediately visible.
+
+=cut
+
+sub w32_add_to_path {
+  my ($bindir, $multiuser) = @_;
+  return if (!win32());
+
+  my $path = TeXLive::TLWinGoo::get_system_env() -> {'/Path'};
+  $path =~ s/[\s\x00]+$//;
+  &log("Old system path: $path\n");
+  $path = TeXLive::TLWinGoo::get_user_env() -> {'/Path'};
+  if ($path) {
+    $path =~ s/[\s\x00]+$//;
+    &log("Old user path: $path\n");
+  } else {
+    &log("Old user path: none\n");
+  }
+  my $mode = 'user';
+  if (TeXLive::TLWinGoo::admin() && $multiuser) {
+    $mode = 'system';
+  }
+  debug("TLUtils:w32_add_to_path: calling adjust_reg_path_for_texlive add $bindir $mode\n");
+  TeXLive::TLWinGoo::adjust_reg_path_for_texlive('add', $bindir, $mode);
+  $path = TeXLive::TLWinGoo::get_system_env() -> {'/Path'};
+  $path =~ s/[\s\x00]+$//;
+  &log("New system path: $path\n");
+  $path = TeXLive::TLWinGoo::get_user_env() -> {'/Path'};
+  if ($path) {
+    $path =~ s/[\s\x00]+$//;
+    &log("New user path: $path\n");
+  } else {
+    &log("New user path: none\n");
+  }
+}
+
+sub w32_remove_from_path {
+  my ($bindir, $multiuser) = @_;
+  my $mode = 'user';
+  if (TeXLive::TLWinGoo::admin() && $multiuser) {
+    $mode = 'system';
+  }
+  debug("w32_remove_from_path: trying to remove $bindir in $mode\n");
+  TeXLive::TLWinGoo::adjust_reg_path_for_texlive('remove', $bindir, $mode);
+}
+
+
+=pod
+
+=item C<untar($tarfile, $targetdir, $remove_tarfile)>
+
+Unpacke C<$tarfile> in C<$targetdir> (changing directories to
+C<$targetdir> and then back to the original directory).  If
+C<$remove_tarfile> is true, unlink C<$tarfile> after unpacking.
+
+Assumes the global C<$::progs{"tar"}> has been set up.
+
+=cut
+
+# return 1 if success, 0 if failure.
+sub untar {
+  my ($tarfile, $targetdir, $remove_tarfile) = @_;
+  my $ret;
+
+  my $tar = $::progs{'tar'};  # assume it's been set up
+
+  # don't use the -C option to tar since Solaris tar et al. don't support it.
+  # don't use system("cd ... && $tar ...") since that opens us up to
+  # quoting issues.
+  # so fall back on chdir in Perl.
+  #
+  debug("unpacking $tarfile in $targetdir\n");
+  my $cwd = cwd();
+  chdir($targetdir) || die "chdir($targetdir) failed: $!";
+
+  # on w32 don't extract file modified time, because AV soft can open
+  # files in the mean time causing time stamp modification to fail
+  if (system($tar, win32() ? "xmf" : "xf", $tarfile) != 0) {
+    tlwarn("untar: untarring $tarfile failed (in $targetdir)\n");
+    $ret = 0;
+  } else {
+    $ret = 1;
+  }
+  unlink($tarfile) if $remove_tarfile;
+
+  chdir($cwd) || die "chdir($cwd) failed: $!";
+  return $ret;
+}
+
+
+=item C<tlcmp($file, $file)>
+
+Compare two files considering CR, LF, and CRLF as equivalent.
+Returns 1 if different, 0 if the same.
+
+=cut
+
+sub tlcmp
+{
+  my ($filea, $fileb) = @_;
+  if (!defined($fileb)) {
+    die <<END_USAGE;
+tlcmp needs two arguments FILE1 FILE2.
+Compare as text files, ignoring line endings.
+Exit status is zero if the same, 1 if different, something else if trouble.
+END_USAGE
+  }
+  my $file1 = &read_file_ignore_cr ($filea);
+  my $file2 = &read_file_ignore_cr ($fileb);
+
+  return $file1 eq $file2 ? 0 : 1;
+}
+
+
+# Return contents of FNAME as a string, converting all of CR, LF, and
+# CRLF to just LF.
+#
+sub read_file_ignore_cr
+{
+  my ($fname) = @_;
+  my $ret = "";
+
+  local *FILE;
+  open (FILE, $fname) || die "open($fname) failed: $!";
+  while (<FILE>) {
+    s/\r\n?/\n/g;
+    #warn "line is |$_|";
+    $ret .= $_;
+  }
+  close (FILE) || warn "close($fname) failed: $!";
+
+  return $ret;
+}
+
+
+
+=item C<setup_programs($bindir, $platform)>
+
+Populate the global C<$::progs> hash containing the paths to the
+programs C<wget>, C<tar>, C<xzdec>. The C<$bindir> argument specifies
+the path to the location of the C<xzdec> binaries, the C<$platform>
+gives the TeX Live platform name, used as the extension on our
+executables.  If a program is not present in the TeX Live tree, we also
+check along PATH (without the platform extension.)
+
+Return 0 if failure, nonzero if success.
+
+=cut
+
+sub setup_programs {
+  my ($bindir, $platform) = @_;
+  my $ok = 1;
+
+  $::progs{'wget'} = "wget";
+  $::progs{'xzdec'} = "xzdec";
+  $::progs{'xz'} = "xz";
+  $::progs{'tar'} = "tar";
+
+  if ($^O =~ /^MSWin(32|64)$/i) {
+    $::progs{'wget'}    = conv_to_w32_path("$bindir/wget/wget.exe");
+    $::progs{'tar'}     = conv_to_w32_path("$bindir/tar.exe");
+    $::progs{'xzdec'} = conv_to_w32_path("$bindir/xz/xzdec.exe");
+    $::progs{'xz'}    = conv_to_w32_path("$bindir/xz/xz.exe");
+    for my $prog ("xzdec", "wget") {
+      my $opt = $prog eq "xzdec" ? "--help" : "--version";
+      my $ret = system("$::progs{$prog} $opt >nul 2>&1"); # on windows
+      if ($ret != 0) {
+        warn "TeXLive::TLUtils::setup_programs (w32) failed";  # no nl for perl
+        warn "$::progs{$prog} $opt failed (status $ret): $!\n";
+        warn "Output is:\n";
+        system ("$::progs{$prog} $opt");
+        warn "\n";
+        $ok = 0;
+      }
+    }
+  } else {
+    if (!defined($platform) || ($platform eq "")) {
+      # we assume that we run from uncompressed media, so we can call platform() and
+      # thus also the config.guess script
+      # but we have to setup $::installerdir because the platform script
+      # relies on it
+      $::installerdir = "$bindir/../..";
+      $platform = platform();
+    }
+    my $s = 0;
+    $s += setup_unix_one('wget', "$bindir/wget/wget.$platform", "--version");
+    $s += setup_unix_one('xzdec',"$bindir/xz/xzdec.$platform","--help");
+    $s += setup_unix_one('xz', "$bindir/xz/xz.$platform", "notest");
+    $ok = ($s == 3);  # failure return unless all are present.
+  }
+
+  return $ok;
+}
+
+
+# setup one prog on unix using the following logic:
+# - if the shipped one is -x and can be executed, use it
+# - if the shipped one is -x but cannot be executed, copy it. set -x
+#   . if the copy is -x and executable, use it
+#   . if the copy is not executable, GOTO fallback
+# - if the shipped one is not -x, copy it, set -x
+#   . if the copy is -x and executable, use it
+#   . if the copy is not executable, GOTO fallback
+# - if nothing shipped, GOTO fallback
+#
+# fallback:
+# if prog is found in PATH and can be executed, use it.
+#
+# Return 0 if failure, 1 if success.
+#
+sub setup_unix_one {
+  my ($p, $def, $arg) = @_;
+  our $tmp;
+  my $test_fallback = 0;
+  if (-r $def) {
+    my $ready = 0;
+    if (-x $def) {
+      # checking only for the executable bit is not enough, we have
+      # to check for actualy "executability" since a "noexec" mount
+      # option may interfere, which is not taken into account by
+      # perl's -x test.
+      $::progs{$p} = $def;
+      if ($arg ne "notest") {
+        my $ret = system("$def $arg > /dev/null 2>&1" ); # we are on Unix
+        if ($ret == 0) {
+          $ready = 1;
+          debug("Using shipped $def for $p (tested).\n");
+        } else {
+          ddebug("Shipped $def has -x but cannot be executed.\n");
+        }
+      } else {
+        # do not test, just return
+        $ready = 1;
+        debug("Using shipped $def for $p (not tested).\n");
+      }
+    }
+    if (!$ready) {
+      # out of some reasons we couldn't execute the shipped program
+      # try to copy it to a temp directory and make it executable
+      #
+      # create tmp dir only when necessary
+      $tmp = TeXLive::TLUtils::tl_tmpdir() unless defined($tmp);
+      # probably we are running from uncompressed media and want to copy it to
+      # some temporary location
+      copy($def, $tmp);
+      my $bn = basename($def);
+      $::progs{$p} = "$tmp/$bn";
+      chmod(0755,$::progs{$p});
+      # we do not check the return value of chmod, but check whether
+      # the -x bit is now set, the only thing that counts
+      if (! -x $::progs{$p}) {
+        # hmm, something is going really bad, not even the copy is
+        # executable. Fall back to normal path element
+        $test_fallback = 1;
+        ddebug("Copied $p $::progs{$p} does not have -x bit, strange!\n");
+      } else {
+        # check again for executability
+        if ($arg ne "notest") {
+          my $ret = system("$::progs{$p} $arg > /dev/null 2>&1");
+          if ($ret == 0) {
+            # ok, the copy works
+            debug("Using copied $::progs{$p} for $p (tested).\n");
+          } else {
+            # even the copied prog is not executable, strange
+            $test_fallback = 1;
+            ddebug("Copied $p $::progs{$p} has x bit but not executable, strange!\n");
+          }
+        } else {
+          debug("Using copied $::progs{$p} for $p (not tested).\n");
+        }
+      }
+    }
+  } else {
+    # hope that we can find in in the global PATH
+    $test_fallback = 1;
+  }
+  if ($test_fallback) {
+    # all our playing around and copying did not succeed, try the
+    # fallback
+    $::progs{$p} = $p;
+    if ($arg ne "notest") {
+      my $ret = system("$p $arg > /dev/null 2>&1");
+      if ($ret == 0) {
+        debug("Using system $p (tested).\n");
+      } else {
+        tlwarn("$0: Initialization failed (in setup_unix_one):\n");
+        tlwarn("$0: could not find a usable $p.\n");
+        tlwarn("$0: Please install $p and try again.\n");
+        return 0;
+      }
+    } else {
+      debug ("Using system $p (not tested).\n");
+    }
+  }
+  return 1;
+}
+
+=item C<download_file( $relpath, $destination [, $progs ] )>
+
+Try to download the file given in C<$relpath> from C<$TeXLiveURL>
+into C<$destination>, which can be either
+a filename of simply C<|>. In the latter case a file handle is returned.
+
+The optional argument C<$progs> is a reference to a hash giving full
+paths to the respective programs, at least C<wget>.  If C<$progs> is not
+given the C<%::progs> hash is consulted, and if this also does not exist
+we try a literal C<wget>.
+
+Downloading honors two environment variables: C<TL_DOWNLOAD_PROGRAM> and
+C<TL_DOWNLOAD_ARGS>. The former overrides the above specification
+devolving to C<wget>, and the latter overrides the default wget
+arguments.
+
+C<TL_DOWNLOAD_ARGS> must be defined so that the file the output goes to
+is the first argument after the C<TL_DOWNLOAD_ARGS>.  Thus, typically it
+would end in C<-O>.  Use with care.
+
+=cut
+
+sub download_file {
+  my ($relpath, $dest, $progs) = @_;
+  my $wget;
+  if (defined($progs) && defined($progs->{'wget'})) {
+    $wget = $progs->{'wget'};
+  } elsif (defined($::progs{'wget'})) {
+    $wget = $::progs{'wget'};
+  } else {
+    tlwarn ("download_file: Programs not set up, trying literal wget\n");
+    $wget = "wget";
+  }
+  my $url;
+  if ($relpath =~ m;^file://*(.*)$;) {
+    my $filetoopen = "/$1";
+    # $dest is a file name, we have to get the respective dirname
+    if ($dest eq "|") {
+      open(RETFH, "<$filetoopen") or
+        die("Cannot open $filetoopen for reading");
+      # opening to a pipe always succeeds, so we return immediately
+      return \*RETFH;
+    } else {
+      my $par = dirname ($dest);
+      if (-r $filetoopen) {
+        copy ($filetoopen, $par);
+        return 1;
+      }
+      return 0;
+    }
+  }
+  if ($relpath =~ /^(http|ftp):\/\//) {
+    $url = $relpath;
+  } else {
+    $url = "$TeXLiveURL/$relpath";
+  }
+  if (defined($::tldownload_server) && $::tldownload_server->enabled) {
+    debug("persistent connection set up, trying to get file.\n");
+    if (($ret = $::tldownload_server->get_file($url, $dest))) {
+      debug("downloading file via permanent connection succeeded\n");
+      return $ret;
+    } else {
+      tlwarn("permanent server connection set up, but downloading did not succeed!");
+      tlwarn("Retrying with wget.\n");
+    }
+  } else {
+    if (!defined($::tldownload_server)) {
+      debug("::tldownload_server not defined\n");
+    } else {
+      debug("::tldownload_server->enabled is not set\n");
+    }
+    debug("persistent connection not set up, using wget\n");
+  }
+  my $ret = _download_file($url, $dest, $wget);
+  return($ret);
+}
+
+sub _download_file
+{
+  my ($url, $dest, $wgetdefault) = @_;
+  if (win32()) {
+    $dest =~ s!/!\\!g;
+  }
+
+  my $wget = $ENV{"TL_DOWNLOAD_PROGRAM"} || $wgetdefault;
+  my $wgetargs = $ENV{"TL_DOWNLOAD_ARGS"}
+                 || "--user-agent=texlive/wget --tries=10 --timeout=$NetworkTimeout -q -O";
+
+  debug("downloading $url using $wget $wgetargs\n");
+  my $ret;
+  if ($dest eq "|") {
+    open(RETFH, "$wget $wgetargs - $url|")
+    || die "open($url) via $wget $wgetargs failed: $!";
+    # opening to a pipe always succeeds, so we return immediately
+    return \*RETFH;
+  } else {
+    my @wgetargs = split (" ", $wgetargs);
+    $ret = system ($wget, @wgetargs, $dest, $url);
+    # we have to reverse the meaning of ret because system has 0=success.
+    $ret = ($ret ? 0 : 1);
+  }
+  # return false/undef in case the download did not succeed.
+  return ($ret) unless $ret;
+  debug("download of $url succeeded\n");
+  if ($dest eq "|") {
+    return \*RETFH;
+  } else {
+    return 1;
+  }
+}
+
+=item C<nulldev ()>
+
+Return C</dev/null> on Unix and C<nul> on Windows.
+
+=cut
+
+sub nulldev {
+  return (&win32)? 'nul' : '/dev/null';
+}
+
+=item C<get_full_line ($fh)>
+
+returns the next line from the file handle $fh, taking 
+continuation lines into account (last character of a line is \, and 
+no quoting is parsed).
+
+=cut
+
+#     open my $f, '<', $file_name or die;
+#     while (my $l = get_full_line($f)) { ... }
+#     close $f or die;
+sub get_full_line {
+  my ($fh) = @_;
+  my $line = <$fh>;
+  return undef unless defined $line;
+  return $line unless $line =~ s/\\\r?\n$//;
+  my $cont = get_full_line($fh);
+  if (!defined($cont)) {
+    tlwarn('Continuation disallowed at end of file');
+    $cont = "";
+  }
+  $cont =~ s/^\s*//;
+  return $line . $cont;
+}
+
+
+=back
+
+=head2 Installer Functions
+
+=over 4
+
+=item C<make_var_skeleton($prefix)>
+
+Generate a skeleton of empty directories in the C<TEXMFSYSVAR> tree.
+
+=cut
+
+sub make_var_skeleton {
+  my $prefix=shift;
+
+  mkdirhier "$prefix/tex/generic/config";
+  mkdirhier "$prefix/fonts/map/dvipdfm/updmap";
+  mkdirhier "$prefix/fonts/map/dvips/updmap";
+  mkdirhier "$prefix/fonts/map/pdftex/updmap";
+  mkdirhier "$prefix/fonts/pk";
+  mkdirhier "$prefix/fonts/tfm";
+  mkdirhier "$prefix/web2c";
+  mkdirhier "$prefix/xdvi";
+  mkdirhier "$prefix/tex/context/config";
+}
+
+
+=item C<make_local_skeleton($prefix)>
+
+Generate a skeleton of empty directories in the C<TEXMFLOCAL> tree.
+
+=cut
+
+sub make_local_skeleton {
+  my $prefix=shift;
+
+  mkdirhier "$prefix/tex/latex/local";
+  mkdirhier "$prefix/tex/plain/local";
+  mkdirhier "$prefix/dvips/local";
+  mkdirhier "$prefix/bibtex/bib/local";
+  mkdirhier "$prefix/bibtex/bst/local";
+  mkdirhier "$prefix/fonts/tfm/local";
+  mkdirhier "$prefix/fonts/vf/local";
+  mkdirhier "$prefix/fonts/source/local";
+  mkdirhier "$prefix/fonts/type1/local";
+  mkdirhier "$prefix/metapost/local";
+  mkdirhier "$prefix/web2c";
+}
+
+
+
+=item C<create_fmtutil($tlpdb, $dest, $localconf)>
+
+=item C<create_updmap($tlpdb, $dest, $localconf)>
+
+=item C<create_language_dat($tlpdb, $dest, $localconf)>
+
+=item C<create_language_def($tlpdb, $dest, $localconf)>
+
+=item C<create_language_lua($tlpdb, $dest, $localconf)>
+
+These five functions create C<fmtutil.cnf>, C<updmap.cfg>, C<language.dat>,
+C<language.def>, and C<language.dat.lua> respectively, in C<$dest> (which by
+default is below C<$TEXMFSYSVAR>).  These functions merge the information
+present in the TLPDB C<$tlpdb> (formats, maps, hyphenations) with local
+configuration additions: C<$localconf>.
+
+Currently the merging is done by omitting disabled entries specified
+in the local file, and then appending the content of the local
+configuration files at the end of the file. We should also check for
+duplicates, maybe even error checking.
+
+=cut
+
+#
+# get_disabled_local_configs
+# returns the list of disabled formats/hyphenpatterns/maps
+# disabling is done by putting
+#    #!NAME
+# or
+#    %!NAME
+# into the respective foo-local.cnf/cfg file
+# 
+sub get_disabled_local_configs {
+  my $localconf = shift;
+  my $cc = shift;
+  my @disabled = ();
+  if (-r "$localconf") {
+    open FOO, "<$localconf"
+      or die "strange, -r ok but cannot open $localconf: $!";
+    my @tmp = <FOO>;
+    close(FOO) || warn("Closing $localconf did not succeed: $!");
+    @disabled = map { if (m/^$cc!(\S+)\s*$/) { $1 } else { }} @tmp;
+  }
+  return @disabled;
+}
+
+sub create_fmtutil {
+  my ($tlpdb,$dest,$localconf) = @_;
+  my @lines = $tlpdb->fmtutil_cnf_lines(
+                         get_disabled_local_configs($localconf, '#'));
+  _create_config_files($tlpdb, "texmf/web2c/fmtutil-hdr.cnf", $dest,
+                       $localconf, 0, '#', \@lines);
+}
+
+sub create_updmap {
+  my ($tlpdb,$dest,$localconf) = @_;
+  my @tlpdblines = $tlpdb->updmap_cfg_lines(
+                             get_disabled_local_configs($localconf, '#'));
+  # we do not use _create_config_files here because we want to
+  # parse the $localconf file for the five options in updmap.cfg
+  #_create_config_files($tlpdb, "texmf/web2c/updmap-hdr.cfg", $dest,
+  #                     $localconf, 0, '#', \@tlpdblines);
+  my $headfile = "texmf/web2c/updmap-hdr.cfg";
+  my $root = $tlpdb->root;
+  my @lines;
+  my @localconflines;
+  my %configs;
+  if (-r "$localconf") {
+    #
+    # this should be done more intelligently, but for now only add those
+    # lines without any duplication check ...
+    open FOO, "<$localconf"
+      or die "strange, -r ok but cannot open $localconf: $!";
+    my @bla = <FOO>;
+    close(FOO);
+    for my $l (@bla) {
+      my ($k, $v, @rest) = split(' ', $l);
+      if (check_updmap_config_value($k, $v, $localconf)) {
+        $configs{$k} = $v;
+      } else {
+        push @localconflines, $l;
+      }
+    }
+  }
+  #
+  # read the -hdr file and replace the options if given in the local
+  # config file
+  open(INFILE,"<$root/$headfile") or die("Cannot open $root/$headfile");
+  for my $l (<INFILE>) {
+    my ($k, $v, @rest) = split(' ', $l);
+    if (check_updmap_config_value($k, $v, "$root/$headfile")) {
+      if (defined($configs{$k})) {
+        push @lines, "$k $configs{$k}\n";
+      } else {
+        push @lines, $l;
+      }
+    } else {
+      push @lines, $l;
+    }
+  }
+  close (INFILE);
+
+  # add the lines from the tlpdb
+  push @lines, @tlpdblines;
+
+  # add additional local config lines
+  push @lines, @localconflines;
+
+  if ($#lines >= 0) {
+    open(OUTFILE,">$dest")
+      or die("Cannot open $dest for writing: $!");
+
+    printf OUTFILE "# Generated by %s on %s\n", "$0", scalar localtime;
+    print OUTFILE @lines;
+    close(OUTFILE) || warn "close(>$dest) failed: $!";
+  }
+}
+
+sub check_updmap_config_value {
+  my ($k, $v, $f) = @_;
+  return 0 if !defined($k);
+  return 0 if !defined($v);
+  if (member( $k, qw/dvipsPreferOutline dvipsDownloadBase35 
+                     pdftexDownloadBase14 dvipdfmDownloadBase14/)) {
+    if ($v eq "true" || $v eq "false") {
+      return 1;
+    } else {
+      tlwarn("Unknown setting for $k in $f: $v\n");
+      return 0;
+    }
+  } elsif ($k eq "LW35") {
+    if (member($v, qw/URW URWkb ADOBE ADOBEkb/)) {
+      return 1;
+    } else {
+      tlwarn("Unknown setting for LW35  in $f: $v\n");
+      return 0;
+    }
+  } else {
+    return 0;
+  }
+}
+
+sub create_language_dat {
+  my ($tlpdb,$dest,$localconf) = @_;
+  # no checking for disabled stuff for language.dat and .def
+  my @lines = $tlpdb->language_dat_lines(
+                         get_disabled_local_configs($localconf, '%'));
+  _create_config_files($tlpdb, "texmf/tex/generic/config/language.us", $dest,
+                       $localconf, 0, '%', \@lines);
+}
+
+sub create_language_def {
+  my ($tlpdb,$dest,$localconf) = @_;
+  # no checking for disabled stuff for language.dat and .def
+  my @lines = $tlpdb->language_def_lines(
+                         get_disabled_local_configs($localconf, '%'));
+  my @postlines;
+  push @postlines, "%%% No changes may be made beyond this point.\n";
+  push @postlines, "\n";
+  push @postlines, "\\uselanguage {USenglish}             %%% This MUST be the last line of the file.\n";
+  _create_config_files ($tlpdb, "texmf/tex/generic/config/language.us.def", $dest, $localconf, 1, '%', \@lines, @postlines);
+}
+
+sub create_language_lua {
+  my ($tlpdb,$dest,$localconf) = @_;
+  # no checking for disabled stuff for language.dat and .lua
+  my @lines = $tlpdb->language_lua_lines(
+                         get_disabled_local_configs($localconf, '--'));
+  my @postlines = ("}\n");
+  _create_config_files ($tlpdb, "texmf/tex/generic/config/language.us.lua",
+    $dest, $localconf, 0, '--', \@lines, @postlines);
+}
+
+sub _create_config_files {
+  my ($tlpdb, $headfile, $dest,$localconf, $keepfirstline, $cc, $tlpdblinesref, @postlines) = @_;
+  my $root = $tlpdb->root;
+  open(INFILE,"<$root/$headfile") or die("Cannot open $root/$headfile");
+  my @lines = <INFILE>;
+  push @lines, @$tlpdblinesref;
+  close (INFILE);
+  if (-r "$localconf") {
+    #
+    # this should be done more intelligently, but for now only add those
+    # lines without any duplication check ...
+    open FOO, "<$localconf"
+      or die "strange, -r ok but cannot open $localconf: $!";
+    my @tmp = <FOO>;
+    close (FOO);
+    push @lines, @tmp;
+  }
+  if (@postlines) {
+    push @lines, @postlines;
+  }
+  if ($#lines >= 0) {
+    open(OUTFILE,">$dest")
+      or die("Cannot open $dest for writing: $!");
+
+    if (!$keepfirstline) {
+      print OUTFILE $cc;
+      printf OUTFILE " Generated by %s on %s\n", "$0", scalar localtime;
+    }
+    print OUTFILE @lines;
+    close(OUTFILE) || warn "close(>$dest) failed: $!";
+  }
+}
+
+sub parse_AddHyphen_line {
+  my $line = shift;
+  my %ret;
+  # default values
+  my $default_lefthyphenmin = 2;
+  my $default_righthyphenmin = 3;
+  $ret{"lefthyphenmin"} = $default_lefthyphenmin;
+  $ret{"righthyphenmin"} = $default_righthyphenmin;
+  $ret{"synonyms"} = [];
+  for my $p (quotewords('\s+', 0, "$line")) {
+    my ($a, $b) = split /=/, $p;
+    if ($a eq "name") {
+      if (!$b) {
+        $ret{"error"} = "AddHyphen line needs name=something";
+        return %ret;
+      }
+      $ret{"name"} = $b;
+      next;
+    }
+    if ($a eq "lefthyphenmin") {
+      $ret{"lefthyphenmin"} = ( $b ? $b : $default_lefthyphenmin );
+      next;
+    }
+    if ($a eq "righthyphenmin") {
+      $ret{"righthyphenmin"} = ( $b ? $b : $default_righthyphenmin );
+      next;
+    }
+    if ($a eq "file") {
+      if (!$b) {
+        $ret{"error"} = "AddHyphen line needs file=something";
+        return %ret;
+      }
+      $ret{"file"} = $b;
+      next;
+    }
+    if ($a eq "file_patterns") {
+        $ret{"file_patterns"} = $b;
+        next;
+    }
+    if ($a eq "file_exceptions") {
+        $ret{"file_exceptions"} = $b;
+        next;
+    }
+    if ($a eq "luaspecial") {
+        $ret{"luaspecial"} = $b;
+        next;
+    }
+    if ($a eq "databases") {
+      @{$ret{"databases"}} = split /,/, $b;
+      next;
+    }
+    if ($a eq "synonyms") {
+      @{$ret{"synonyms"}} = split /,/, $b;
+      next;
+    }
+    if ($a eq "comment") {
+        $ret{"comment"} = $b;
+        next;
+    }
+    # should not be reached at all
+    $ret{"error"} = "Unknown language directive $a";
+    return %ret;
+  }
+  # this default value couldn't be set earlier
+  if (not defined($ret{"databases"})) {
+    if (defined $ret{"file_patterns"} or defined $ret{"file_exceptions"}
+        or defined $ret{"luaspecial"}) {
+      @{$ret{"databases"}} = qw(dat def lua);
+    } else {
+      @{$ret{"databases"}} = qw(dat def);
+    }
+  }
+  return %ret;
+}
+
+
+sub parse_AddFormat_line {
+  my $line = shift;
+  my %ret;
+  $ret{"options"} = "";
+  $ret{"patterns"} = "-";
+  $ret{"mode"} = 1;
+  for my $p (quotewords('\s+', 0, "$line")) {
+    my ($a, $b);
+    if ($p =~ m/^(name|engine|mode|patterns|options)=(.*)$/) {
+      $a = $1;
+      $b = $2;
+    } else {
+      $ret{"error"} = "Unknown format directive $p";
+      return %ret;
+    }
+    if ($a eq "name") {
+      if (!$b) {
+        $ret{"error"} = "AddFormat line needs name=something";
+        return %ret;
+      }
+      $ret{"name"} = $b;
+      next;
+    }
+    if ($a eq "engine") {
+      if (!$b) {
+        $ret{"error"} = "AddFormat line needs engine=something";
+        return %ret;
+      }
+      $ret{"engine"} = $b;
+      next;
+    }
+    if ($a eq "patterns") {
+      $ret{"patterns"} = ( $b ? $b : "-" );
+      next;
+    }
+    if ($a eq "mode") {
+      $ret{"mode"} = ( $b eq "disabled" ? 0 : 1 );
+      next;
+    }
+    if ($a eq "options") {
+      $ret{"options"} = ( $b ? $b : "" );
+      next;
+    }
+    # should not be reached at all
+    $ret{"error"} = "Unknown format directive $p";
+    return %ret;
+  }
+  return %ret;
+}
+
+
+=back
+
+=head2 Miscellaneous
+
+Ideas from Fabrice Popineau's C<FileUtils.pm>.
+
+=over 4
+
+=item C<sort_uniq(@list)>
+
+The C<sort_uniq> function sorts the given array and throws away multiple
+occurrences of elements. It returns a sorted and unified array.
+
+=cut
+
+sub sort_uniq {
+  my (@l) = @_;
+  my ($e, $f, @r);
+  $f = "";
+  @l = sort(@l);
+  foreach $e (@l) {
+    if ($e ne $f) {
+      $f = $e;
+      push @r, $e;
+    }
+  }
+  return @r;
+}
+
+
+=item C<push_uniq(\@list, @items)>
+
+The C<push_uniq> function pushes the last elements on the list referenced
+by the first argument.
+
+=cut
+
+sub push_uniq {
+  # can't we use $l as a reference, and then use my?  later ...
+  local (*l, @le) = @_;
+  foreach my $e (@le) {
+    if (! &member($e, @l)) {
+      push @l, $e;
+    }
+  }
+}
+
+
+=item C<member($item, @list)>
+
+The C<member> function returns true if the the first argument is contained
+in the list of the remaining arguments.
+
+=cut
+
+sub member {
+  my $what = shift;
+  return scalar grep($_ eq $what, @_);
+}
+
+
+=item C<merge_into(\%to, \%from)>
+
+Merges the keys of %from into %to.
+
+=cut
+
+sub merge_into {
+  my ($to, $from) = @_;
+  foreach my $k (keys %$from) {
+    if (defined($to->{$k})) {
+      push @{$to->{$k}}, @{$from->{$k}};
+    } else {
+      $to->{$k} = [ @{$from->{$k}} ];
+    }
+  }
+}
+
+
+=item C<texdir_check($texdir)>
+
+Test whether installation with TEXDIR set to $texdir would succeed due to
+writing permissions.
+
+Writable or not, we will not allow installation to the root
+directory (Unix) or the root of the system drive (Windows).
+
+=cut
+
+sub texdir_check {
+  my $texdir = shift;
+  my $texdirparent;
+  my $texdirpparent;
+  $texdir =~ s!/$!!; # remove final slash
+  #print STDERR "Checking $texdir".'[/]'."\n";
+  # disallow unix root
+  return 0 if $texdir eq "";
+  # disallow w32 systemdrive root
+  return 0 if (win32() and $texdir eq $ENV{SystemDrive});
+
+  return dir_writable($texdir) if (-d dir_slash($texdir));
+  ($texdirparent = $texdir) =~ s!/[^/]*$!!;
+  #print STDERR "Checking $texdirparent".'[/]'."\n";
+  return  dir_creatable($texdirparent) if -d dir_slash($texdirparent);
+  # try another level up the tree
+  ($texdirpparent = $texdirparent) =~ s!/[^/]*$!!;
+  #print STDERR "Checking $texdirpparent".'[/]'."\n";
+  return dir_creatable($texdirpparent) if -d dir_slash($texdirpparent);
+  return 0;
+}
+
+
+# no newlines or spaces are added, multiple args are just concatenated.
+#
+sub logit {
+  my ($out, $level, @rest) = @_;
+  _logit($out, $level, @rest) unless $::opt_quiet;
+  _logit('file', $level, @rest);
+}
+
+sub _logit {
+  my ($out, $level, @rest) = @_;
+  if ($::opt_verbosity >= $level) {
+    # if $out is a ref/glob to STDOUT or STDERR, print it there
+    if (ref($out) eq "GLOB") {
+      print $out @rest;
+    } else {
+      # we should log it into the logfile, but that might be not initialized
+      # so either print it to the filehandle $::LOGFILE, or push it onto
+      # the to be printed log lines @::LOGLINES
+      if (defined($::LOGFILE)) {
+        print $::LOGFILE @rest;
+      } else {
+        push (@::LOGLINES, join ("", @rest));
+      }
+    }
+  }
+}
+
+
+=item C<info ($str1, $str2, ...)>
+
+Write a normal informational message, the concatenation of the argument
+strings.  The message will be written unless C<-q> was specified.  If
+the global C<$::machinereadable> is set (the C<--machine-readable>
+option to C<tlmgr>), then output is written to stderr, else to stdout.
+If the log file (see L<process_logging_options>) is defined, it also
+writes there.
+
+It is best to use this sparingly, mainly to give feedback during lengthy
+operations and for final results.
+
+=cut
+
+sub info {
+  my $str = join("", @_);
+  my $fh = ($::machinereadable ? \*STDERR : \*STDOUT);
+  logit($fh, 0, $str);
+  for my $i (@::info_hook) {
+    &{$i}($str);
+  }
+}
+
+
+=item C<debug ($str1, $str2, ...)>
+
+Write a debugging message, the concatenation of the argument strings.
+The message will be omitted unless C<-v> was specified.  If the log
+file (see L<process_logging_options>) is defined, it also writes there.
+
+This first level debugging message reports on the overall flow of
+work, but does not include repeated messages about processing of each
+package.
+
+=cut
+
+sub debug {
+  my $str = "D:" . join("", @_);
+  return if ($::opt_verbosity < 1);
+  logit(\*STDOUT, 1, $str);
+  for my $i (@::debug_hook) {
+    &{$i}($str);
+  }
+}
+
+
+=item C<ddebug ($str1, $str2, ...)>
+
+Write a deep debugging message, the concatenation of the argument
+strings.  The message will be omitted unless C<-v -v> (or higher) was
+specified.  If the log file (see L<process_logging_options>) is defined,
+it also writes there.
+
+This second level debugging message reports messages about processing
+each package, in addition to the first level.
+
+=cut
+
+sub ddebug {
+  my $str = "DD:" . join("", @_);
+  return if ($::opt_verbosity < 2);
+  logit(\*STDOUT, 2, $str);
+  for my $i (@::ddebug_hook) {
+    &{$i}($str);
+  }
+}
+
+=item C<dddebug ($str1, $str2, ...)>
+
+Write the deepest debugging message, the concatenation of the argument
+strings.  The message will be omitted unless C<-v -v -v> was specified.
+If the log file (see L<process_logging_options>) is defined, it also
+writes there.
+
+This third level debugging message reports messages about processing
+each line of any tlpdb files read, in addition to the first and second
+levels.
+
+=cut
+
+sub dddebug {
+  my $str = "DDD:" . join("", @_);
+  return if ($::opt_verbosity < 3);
+  logit(\*STDOUT, 3, $str);
+  for my $i (@::dddebug_hook) {
+    &{$i}($str);
+  }
+}
+
+
+=item C<log ($str1, $str2, ...)>
+
+Write a message to the log file (and nowhere else), the concatenation of
+the argument strings.
+
+=cut
+
+sub log {
+  my $savequiet = $::opt_quiet;
+  $::opt_quiet = 0;
+  _logit('file', -100, @_);
+  $::opt_quiet = $savequiet;
+}
+
+
+=item C<tlwarn ($str1, $str2, ...)>
+
+Write a warning message, the concatenation of the argument strings.
+This always and unconditionally writes the message to standard error; if
+the log file (see L<process_logging_options>) is defined, it also writes
+there.
+
+=cut
+
+sub tlwarn {
+  my $savequiet = $::opt_quiet;
+  my $str = join("", @_);
+  $::opt_quiet = 0;
+  logit (\*STDERR, -100, $str);
+  $::opt_quiet = $savequiet;
+  for my $i (@::warn_hook) {
+    &{$i}($str);
+  }
+}
+
+=item C<tldie ($str1, $str2, ...)>
+
+Uses C<tlwarn> to issue a warning, then exits with exit code 1.
+
+=cut
+
+sub tldie {
+  tlwarn(@_);
+  exit(1);
+}
+
+=item C<debug_hash ($label, hash))>
+
+Write LABEL followed by HASH elements, all on one line, to stderr.
+If HASH is a reference, it is followed.
+
+=cut
+
+sub debug_hash
+{
+  my ($label) = shift;
+  my (%hash) = (ref $_[0] && $_[0] =~ /.*HASH.*/) ? %{$_[0]} : @_;
+
+  my $str = "$label: {";
+  my @items = ();
+  for my $key (sort keys %hash) {
+    my $val = $hash{$key};
+    $key =~ s/\n/\\n/g;
+    $val =~ s/\n/\\n/g;
+    push (@items, "$key:$val");
+  }
+  $str .= join (",", @items);
+  $str .= "}";
+
+  warn "$str\n";
+}
+
+
+=item C<process_logging_options ($texdir)>
+
+This function handles the common logging options for TeX Live scripts.
+It should be called before C<GetOptions> for any program-specific option
+handling.  For our conventional calling sequence, see (for example) the
+L<tlpfiles> script.
+
+These are the options handled here:
+
+=over 4
+
+=item B<-q>
+
+Omit normal informational messages.
+
+=item B<-v>
+
+Include debugging messages.  With one C<-v>, reports overall flow; with
+C<-v -v> (or C<-vv>), also reports per-package processing; with C<-v -v
+-v> (or C<-vvv>), also reports each line read from any tlpdb files.
+Further repeats of C<-v>, as in C<-v -v -v -v>, are accepted but
+ignored.  C<-vvvv> is an error.
+
+The idea behind these levels is to be able to specify C<-v> to get an
+overall idea of what is going on, but avoid terribly voluminous output
+when processing many packages, as we often are.  When debugging a
+specific problem with a specific package, C<-vv> can help.  When
+debugging problems with parsing tlpdb files, C<-vvv> gives that too.
+
+=item B<-logfile> I<file>
+
+Write all messages (informational, debugging, warnings) to I<file>, in
+addition to standard output or standard error.  In TeX Live, only the
+installer sets a log file by default; none of the other standard TeX
+Live scripts use this feature, but you can specify it explicitly.
+
+=back
+
+See also the L<info>, L<debug>, L<ddebug>, and L<tlwarn> functions,
+which actually write the messages.
+
+=cut
+
+sub process_logging_options {
+  $::opt_verbosity = 0;
+  $::opt_quiet = 0;
+  my $opt_logfile;
+  my $opt_Verbosity = 0;
+  my $opt_VERBOSITY = 0;
+  # check all the command line options for occurrences of -q and -v;
+  # do not report errors.
+  my $oldconfig = Getopt::Long::Configure(qw(pass_through permute));
+  GetOptions("logfile=s" => \$opt_logfile,
+             "v+"  => \$::opt_verbosity,
+             "vv"  => \$opt_Verbosity,
+             "vvv" => \$opt_VERBOSITY,
+             "q"   => \$::opt_quiet);
+  Getopt::Long::Configure($oldconfig);
+
+  # verbosity level, forcing -v -v instead of -vv is too annoying.
+  $::opt_verbosity = 2 if $opt_Verbosity;
+  $::opt_verbosity = 3 if $opt_VERBOSITY;
+
+  # open log file if one was requested.
+  if ($opt_logfile) {
+    open(TLUTILS_LOGFILE, ">$opt_logfile") || die "open(>$opt_logfile) failed: $!\n";
+    $::LOGFILE = \*TLUTILS_LOGFILE;
+    $::LOGFILENAME = $opt_logfile;
+  }
+}
+
+=pod
+
+This function takes a single argument I<path> and returns it with
+C<"> chars surrounding it on Unix.  On Windows, the C<"> chars are only
+added if I<path> a few special characters, since unconditional quoting
+leads to errors there.  In all cases, any C<"> chars in I<path> itself
+are (erroneously) eradicated.
+ 
+=cut
+
+sub quotify_path_with_spaces {
+  my $p = shift;
+  my $m = win32() ? '[+=^&();,!%\s]' : '.';
+  if ( $p =~ m/$m/ ) {
+    $p =~ s/"//g; # remove any existing double quotes
+    $p = "\"$p\""; 
+  }
+  return($p);
+}
+
+=pod
+
+This function returns a "Windows-ized" version of its single argument
+I<path>, i.e., replaces all forward slashes with backslashes, and adds
+an additional C<"> at the beginning and end if I<path> contains any
+spaces.  It also makes the path absolute. So if $path does not start
+with one (arbitrary) characer followed by C<:>, we add the output of
+C<`cd`>.
+
+The result is suitable for running in shell commands, but not file tests
+or other manipulations, since in such internal Perl contexts, the quotes
+would be considered part of the filename.
+
+=cut
+
+sub conv_to_w32_path {
+  my $p = shift;
+  $p =~ s!/!\\!g;
+  # we need absolute paths, too
+  if ($p !~ m!^.:!) {
+    my $cwd = `cd`;
+    die "sorry, could not find current working directory via cd?!" if ! $cwd;
+    chomp($cwd);
+    $p = "$cwd\\$p";
+  }
+  $p = quotify_path_with_spaces($p);
+  return($p);
+}
+
+=pod
+
+The next two functions are meant for user input/output in installer menus.
+They help making the windows user happy by turning slashes into backslashes
+before displaying a path, and our code happy by turning backslashes into forwars
+slashes after reading a path. They both are no-ops on Unix.
+
+=cut
+
+sub native_slashify {
+  my ($r) = @_;
+  $r =~ s!/!\\!g if win32();
+  return $r;
+}
+
+sub forward_slashify {
+  my ($r) = @_;
+  $r =~ s!\\!/!g if win32();
+  return $r;
+}
+
+=item C<setup_persistent_downloads()>
+
+Set up to use persistent connections using LWP/TLDownload, that is look
+for a download server.  Return the TLDownload object if successful, else
+false.
+
+=cut
+
+sub setup_persistent_downloads {
+  if ($TeXLive::TLDownload::net_lib_avail) {
+    ddebug("setup_persistent_downloads has net_lib_avail set\n");
+    $::tldownload_server = TeXLive::TLDownload->new;
+    if (!defined($::tldownload_server)) {
+      ddebug("TLUtils:setup_persistent_downloads: failed to get ::tldownload_server\n");
+    } else {
+      ddebug("TLUtils:setup_persistent_downloads: got ::tldownload_server\n");
+    }
+    return $::tldownload_server;
+  }
+  return 0;
+}
+
+
+=item C<query_ctan_mirror()>
+
+Return a particular mirror given by the generic CTAN auto-redirecting
+default (specified in L<$TLConfig::TexLiveServerURL>) if we get a
+response, else the empty string.
+
+Neither C<TL_DOWNLOAD_PROGRAM> nor <TL_DOWNLOAD_ARGS> is honored (see
+L<download_file>), since certain options have to be set to do the job
+and the program has to be C<wget> since we parse the output.
+
+=cut
+
+sub query_ctan_mirror
+{
+  my $wget = $::progs{'wget'};
+  if (!defined ($wget)) {
+    tlwarn("query_ctan_mirror: Programs not set up, trying wget\n");
+    $wget = "wget";
+  }
+
+  # we need the verbose output, so no -q.
+  # do not reduce retries here, but timeout still seems desirable.
+  my $mirror = $TeXLiveServerURL;
+  my $cmd = "$wget $mirror --timeout=$NetworkTimeout -O "
+            . (win32() ? "nul" : "/dev/null") . " 2>&1";
+
+  #
+  # since we are reading the output of wget to find a mirror
+  # we have to make sure that the locale is unset
+  my $saved_lcall;
+  if (defined($ENV{'LC_ALL'})) {
+    $saved_lcall = $ENV{'LC_ALL'};
+  }
+  $ENV{'LC_ALL'} = "C";
+  # we try 3 times to get a mirror from mirror.ctan.org in case we have
+  # bad luck with what gets returned.
+  my $max_trial = 3;
+  my $mhost;
+  for (my $i = 1; $i <= $max_trial; $i++) {
+    my @out = `$cmd`;
+    # analyze the output for the mirror actually selected.
+    foreach (@out) {
+      if (m/^Location: (\S*)\s*.*$/) {
+        (my $mhost = $1) =~ s,/*$,,;  # remove trailing slashes since we add it
+        return $mhost;
+      }
+    }
+    sleep(1);
+  }
+
+  # reset LC_ALL to undefined or the previous value
+  if (defined($saved_lcall)) {
+    $ENV{'LC_ALL'} = $saved_lcall;
+  } else {
+    delete($ENV{'LC_ALL'});
+  }
+
+  # we are still here, so three times we didn't get a mirror, give up 
+  # and return undefined
+  return;
+}
+  
+=item C<check_on_working_mirror($mirror)>
+
+Check if MIRROR is functional.
+
+=cut
+
+sub check_on_working_mirror
+{
+  my $mirror = shift;
+
+  my $wget = $::progs{'wget'};
+  if (!defined ($wget)) {
+    tlwarn ("check_on_working_mirror: Programs not set up, trying wget\n");
+    $wget = "wget";
+  }
+  $wget = quotify_path_with_spaces($wget);
+  #
+  # the test is currently not completely correct, because we do not
+  # use the LWP if it is set up for it, but I am currently too lazy
+  # to program it,
+  # so try wget and only check for the return value
+  # please KEEP the / after $mirror, some ftp mirrors do give back
+  # an error if the / is missing after ../CTAN/
+  my $cmd = "$wget $mirror/ --timeout=$NetworkTimeout -O "
+            . (win32() ? "nul" : "/dev/null")
+            . " 2>" . (win32() ? "nul" : "/dev/null");
+  my $ret = system($cmd);
+  # if return value is not zero it is a failure, so switch the meanings
+  return ($ret ? 0 : 1);
+}
+
+=item C<give_ctan_mirror_base()>
+
+ 1. get a mirror (retries 3 times to contact mirror.ctan.org)
+    - if no mirror found, use one of the backbone servers
+    - if it is an http server return it (no test is done)
+    - if it is a ftp server, continue
+ 2. if the ftp mirror is good, return it
+ 3. if the ftp mirror is bad, search for http mirror (5 times)
+ 4. if http mirror is found, return it (again, no test,)
+ 5. if no http mirror is found, return one of the backbone servers
+
+=cut
+
+sub give_ctan_mirror_base
+{
+  my @backbone = qw!http://www.ctan.org/tex-archive
+                    http://www.tex.ac.uk/tex-archive
+                    http://dante.ctan.org/tex-archive!;
+
+  # start by selecting a mirror and test its operationality
+  my $mirror = query_ctan_mirror();
+  if (!defined($mirror)) {
+    # three times calling mirror.ctan.org did not give anything useful,
+    # return one of the backbone servers
+    tlwarn("cannot contact mirror.ctan.org, returning a backbone server!\n");
+    return $backbone[int(rand($#backbone + 1))];
+  }
+
+  if ($mirror =~ m!^http://!) {  # if http mirror, assume good and return.
+    return $mirror;
+  }
+
+  # we are still here, so we got a ftp mirror from mirror.ctan.org
+  if (check_on_working_mirror($mirror)) {
+    return $mirror;  # ftp mirror is working, return.
+  }
+
+  # we are still here, so the ftp mirror failed, retry and hope for http.
+  # theory is that if one ftp fails, probably all ftp is broken.
+  my $max_mirror_trial = 5;
+  for (my $try = 1; $try <= $max_mirror_trial; $try++) {
+    my $m = query_ctan_mirror();
+    debug("querying mirror, got " . (defined($m) ? $m : "(nothing)") . "\n");
+    if (defined($m) && $m =~ m!^http://!) {
+      return $m;  # got http this time, assume ok.
+    }
+    # sleep to make mirror happy, but only if we are not ready to return
+    sleep(1) if $try < $max_mirror_trial;
+  }
+
+  # 5 times contacting the mirror service did not return a http server,
+  # use one of the backbone servers.
+  debug("no mirror found ... randomly selecting backbone\n");
+  return $backbone[int(rand($#backbone + 1))];
+}
+
+
+sub give_ctan_mirror
+{
+  return (give_ctan_mirror_base(@_) . "/$TeXLiveServerPath");
+}
+
+=item C<create_mirror_list()>
+
+=item C<extract_mirror_entry($listentry)>
+
+C<create_mirror_list> returns the lists of viable mirrors according to 
+ctan-mirrors.pl, in a list which also contains continents, and country headers.
+
+C<extract_mirror_entry> extracts the actual repository data from one
+of these entries.
+
+# KEEP THESE TWO FUNCTIONS IN SYNC!!!
+
+=cut
+
+sub create_mirror_list {
+  our $mirrors;
+  my @ret = ();
+  require("installer/ctan-mirrors.pl");
+  my @continents = sort keys %$mirrors;
+  for my $continent (@continents) {
+    # first push the name of the continent
+    push @ret, uc($continent);
+    my @countries = sort keys %{$mirrors->{$continent}};
+    for my $country (@countries) {
+      my @mirrors = sort keys %{$mirrors->{$continent}{$country}};
+      my $first = 1;
+      for my $mirror (@mirrors) {
+        my $mfull = $mirror;
+        $mfull =~ s!/$!!;
+        # do not append the server path part here, but add
+        # it down there in the extract mirror entry
+        #$mfull .= "/" . $TeXLive::TLConfig::TeXLiveServerPath;
+        #if ($first) {
+          my $country_str = sprintf "%-12s", $country;
+          push @ret, "  $country_str  $mfull";
+        #  $first = 0;
+        #} else {
+        #  push @ret, "    $mfull";
+        #}
+      }
+    }
+  }
+  return @ret;
+}
+
+# extract_mirror_entry is not very intelligent, it assumes that
+# the last "word" is the URL
+sub extract_mirror_entry {
+  my $ent = shift;
+  my @foo = split ' ', $ent;
+  return $foo[$#foo] . "/" . $TeXLive::TLConfig::TeXLiveServerPath;
+}
+
+sub tlmd5 {
+  my ($file) = @_;
+  if (-r $file) {
+    open(FILE, $file) || die "open($file) failed: $!";
+    binmode(FILE);
+    my $md5hash = Digest::MD5->new->addfile(*FILE)->hexdigest;
+    close(FILE);
+    return $md5hash;
+  } else {
+    tlwarn("tlmd5, given file not readable: $file\n");
+    return "";
+  }
+}
+
+#
+# compare_tlpobjs 
+# returns a hash
+#   $ret{'revision'} = "leftRev:rightRev"     if revision differ
+#   $ret{'removed'} = \[ list of files removed from A to B ]
+#   $ret{'added'} = \[ list of files added from A to B ]
+#
+sub compare_tlpobjs {
+  my ($tlpA, $tlpB) = @_;
+  my %ret;
+  my @rem;
+  my @add;
+
+  my $rA = $tlpA->revision;
+  my $rB = $tlpB->revision;
+  if ($rA != $rB) {
+    $ret{'revision'} = "$rA:$rB";
+  }
+  if ($tlpA->relocated) {
+    $tlpA->cancel_reloc_prefix;
+  }
+  if ($tlpB->relocated) {
+    $tlpB->cancel_reloc_prefix;
+  }
+  my @fA = $tlpA->all_files;
+  my @fB = $tlpB->all_files;
+  my %removed;
+  my %added;
+  for my $f (@fA) { $removed{$f} = 1; }
+  for my $f (@fB) { delete($removed{$f}); $added{$f} = 1; }
+  for my $f (@fA) { delete($added{$f}); }
+  @rem = sort keys %removed;
+  @add = sort keys %added;
+  $ret{'removed'} = \@rem if @rem;
+  $ret{'added'} = \@add if @add;
+  return %ret;
+}
+
+#
+# compare_tlpdbs
+# return several hashes
+# @{$ret{'removed_packages'}} = list of removed packages from A to B
+# @{$ret{'added_packages'}} = list of added packages from A to B
+# $ret{'different_packages'}->{$package} = output of compare_tlpobjs
+#
+sub compare_tlpdbs {
+  my ($tlpdbA, $tlpdbB, @add_ignored_packs) = @_;
+  my @ignored_packs = qw/00texlive.installer 00texlive.image/;
+  push @ignored_packs, @add_ignored_packs;
+
+  my @inAnotinB;
+  my @inBnotinA;
+  my %diffpacks;
+  my %do_compare;
+  my %ret;
+
+  for my $p ($tlpdbA->list_packages()) {
+    my $is_ignored = 0;
+    for my $ign (@ignored_packs) {
+      if (($p =~ m/^$ign$/) || ($p =~ m/^$ign\./)) {
+        $is_ignored = 1;
+        last;
+      }
+    }
+    next if $is_ignored;
+    my $tlpB = $tlpdbB->get_package($p);
+    if (!defined($tlpB)) {
+      push @inAnotinB, $p;
+    } else {
+      $do_compare{$p} = 1;
+    }
+  }
+  $ret{'removed_packages'} = \@inAnotinB if @inAnotinB;
+  
+  for my $p ($tlpdbB->list_packages()) {
+    my $is_ignored = 0;
+    for my $ign (@ignored_packs) {
+      if (($p =~ m/^$ign$/) || ($p =~ m/^$ign\./)) {
+        $is_ignored = 1;
+        last;
+      }
+    }
+    next if $is_ignored;
+    my $tlpA = $tlpdbA->get_package($p);
+    if (!defined($tlpA)) {
+      push @inBnotinA, $p;
+    } else {
+      $do_compare{$p} = 1;
+    }
+  }
+  $ret{'added_packages'} = \@inBnotinA if @inBnotinA;
+
+  for my $p (sort keys %do_compare) {
+    my $tlpA = $tlpdbA->get_package($p);
+    my $tlpB = $tlpdbB->get_package($p);
+    my %foo = compare_tlpobjs($tlpA, $tlpB);
+    if (keys %foo) {
+      # some diffs were found
+      $diffpacks{$p} = \%foo;
+    }
+  }
+  $ret{'different_packages'} = \%diffpacks if (keys %diffpacks);
+
+  return %ret;
+}
+
+sub report_tlpdb_differences {
+  my $rret = shift;
+  my %ret = %$rret;
+
+  if (defined($ret{'removed_packages'})) {
+    info ("removed packages from A to B:\n");
+    for my $f (@{$ret{'removed_packages'}}) {
+      info ("  $f\n");
+    }
+  }
+  if (defined($ret{'added_packages'})) {
+    info ("added packages from A to B:\n");
+    for my $f (@{$ret{'added_packages'}}) {
+      info ("  $f\n");
+    }
+  }
+  if (defined($ret{'different_packages'})) {
+    info ("different packages from A to B:\n");
+    for my $p (keys %{$ret{'different_packages'}}) {
+      info ("  $p\n");
+      for my $k (keys %{$ret{'different_packages'}->{$p}}) {
+        if ($k eq "revision") {
+          info("    revision differ: $ret{'different_packages'}->{$p}->{$k}\n");
+        } elsif ($k eq "removed" || $k eq "added") {
+          info("    $k files:\n");
+          for my $f (@{$ret{'different_packages'}->{$p}->{$k}}) {
+            info("      $f\n");
+          }
+        } else {
+          info("  unknown differ $k\n");
+        }
+      }
+    }
+  }
+}
+
+#############################################
+#
+# Taken from Text::ParseWords
+#
+sub quotewords {
+  my($delim, $keep, @lines) = @_;
+  my($line, @words, @allwords);
+
+  foreach $line (@lines) {
+    @words = parse_line($delim, $keep, $line);
+    return() unless (@words || !length($line));
+    push(@allwords, @words);
+  }
+  return(@allwords);
+}
+
+sub parse_line {
+  my($delimiter, $keep, $line) = @_;
+  my($word, @pieces);
+
+  no warnings 'uninitialized';	# we will be testing undef strings
+
+  $line =~ s/\s+$//; # kill trailing whitespace
+  while (length($line)) {
+    $line =~ s/^(["'])			# a $quote
+              ((?:\\.|(?!\1)[^\\])*)	# and $quoted text
+              \1				# followed by the same quote
+                |				# --OR--
+            ^((?:\\.|[^\\"'])*?)		# an $unquoted text
+            (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["']))
+                  # plus EOL, delimiter, or quote
+      //xs or return;		# extended layout
+    my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4);
+    return() unless( defined($quote) || length($unquoted) || length($delim));
+
+    if ($keep) {
+      $quoted = "$quote$quoted$quote";
+    } else {
+      $unquoted =~ s/\\(.)/$1/sg;
+      if (defined $quote) {
+        $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
+        $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
+      }
+    }
+    $word .= substr($line, 0, 0);	# leave results tainted
+    $word .= defined $quote ? $quoted : $unquoted;
+
+    if (length($delim)) {
+      push(@pieces, $word);
+      push(@pieces, $delim) if ($keep eq 'delimiters');
+      undef $word;
+    }
+    if (!length($line)) {
+      push(@pieces, $word);
+    }
+  }
+  return(@pieces);
+}
+
+=item C<mktexupd ()>
+
+Append entries to C<ls-R> files.  Usage example:
+
+  my $updLSR=&mktexupd();
+  $updLSR->{mustexist}(1);
+  $updLSR->{add}(file1);
+  $updLSR->{add}(file2);
+  $updLSR->{add}(file3);
+  $updLSR->{exec}();
+  
+The first line creates a new object.  Only one such object should be 
+created in a program in order to avoid duplicate entries in C<ls-R> files.
+
+C<add> pushes a filename or a list of filenames to a hash encapsulated 
+in a closure.  Filenames must be specified with the full (absolute) path.  
+Duplicate entries are ignored.  
+
+C<exec> checks for each component of C<$TEXMFDBS> whether there are files
+in the hash which have to be appended to the corresponding C<ls-R> files 
+and eventually updates the corresponding C<ls-R> files.  Files which are 
+in directories not stated in C<$TEXMFDBS> are silently ignored.
+
+If the flag C<mustexist> is set, C<exec> aborts with an error message 
+if a file supposed to be appended to an C<ls-R> file doesn't exist physically
+on the file system.  This option was added for compatibility with the 
+C<mktexupd> shell script.  This option shouldn't be enabled in scripts,
+except for testing, because it degrades performance on non-cached file
+systems.
+
+=cut
+
+sub mktexupd {
+  my %files;
+  my $mustexist=0;
+
+  my $hash={
+    "add" => sub {     
+      foreach my $file (@_) {
+        $file =~ s|\\|/|g;
+        $files{$file}=1;
+      }
+    },
+    # "reset" => sub { 
+    #    %files=();
+    # },
+    "mustexist" => sub {
+      $mustexist=shift;
+    },
+   "exec" => sub {
+      # check whether files exist
+      if ($mustexist) {
+        foreach my $file (keys %files) {
+          die "File \"$file\" doesn't exist.\n" if (! -f $file);
+        }
+      }
+      my $delim= (&win32)? ';' : ':';
+      my $TEXMFDBS;
+      chomp($TEXMFDBS=`kpsewhich --show-path="ls-R"`);
+
+      my @texmfdbs=split ($delim, "$TEXMFDBS");
+      my %dbs;
+     
+      foreach my $path (keys %files) {
+        foreach my $db (@texmfdbs) {
+          $db=substr($db, -1) if ($db=~m|/$|); # strip leading /
+          if (substr($path, 0, length("$db/")) eq "$db/") {
+            # we appended a / because otherwise "texmf" is recognized as a
+            # substring of "texmf-dist".
+            my $path='./' . substr($path, length("$db/"));
+            my ($dir, $file);
+            $_=$path;
+            ($dir, $file) = m|(.*)/(.*)|;
+            $dbs{$db}{$dir}{$file}=1;
+          }
+        }
+      }
+      foreach my $db (keys %dbs) {
+        if (! -f "$db" || ! -w "$db/ls-R") {
+          &mkdirhier ($db);
+        }
+        open LSR, ">>$db/ls-R";
+        foreach my $dir (keys %{$dbs{$db}}) {
+          print LSR "\n$dir:\n";
+          foreach my $file (keys %{$dbs{$db}{$dir}}) {
+            print LSR "$file\n";
+          }
+        }
+        close LSR;
+      }
+    }
+  };
+  return $hash;
+}
+
+
+=back
+=cut
+1;
+__END__
+
+=head1 SEE ALSO
+
+The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>,
+L<TeXLive::TLPDB>, L<TeXLive::TLTREE>, and the
+document L<Perl-API.txt> and the specification in the TeX Live
+repository trunk/Master/tlpkg/doc/.
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #
diff --git a/Build/source/texk/tests/common-test.pl b/Build/source/texk/tests/common-test.pl
index c2ab99c78a2..b720b064988 100644
--- a/Build/source/texk/tests/common-test.pl
+++ b/Build/source/texk/tests/common-test.pl
@@ -3,6 +3,9 @@
 # Common definitions for Perl tests in TeX Live.  We want to use Perl to
 # have a chance of running the tests on Windows.
 
+# absolute path
+chomp (my $TL_TESTS_DIR = `cd "$srcdir/../tests" && pwd`);
+
 # srcdir must be a sibling dir to kpathsea, e.g., web2c.
 $ENV{"TEXMFCNF"} = "$srcdir/../kpathsea";
 $ENV{"AFMFONTS"}
@@ -22,6 +25,10 @@ sub test_run {
   # want to run out of the build dir.  I think.
   die "$0: no program $prog in " . `pwd` if ! -x $prog;
   
+  # use local pm files and kpsewhich.
+  $ENV{"PERL5LIB"} = $TL_TESTS_DIR;
+  $ENV{"PATH"} = "../kpathsea:$ENV{PATH}";
+
   # Won't be copyable with weird names, but should get the info across.
   print "$0: running ", $prog, join (" ", @args), "\n";