#!/usr/bin/env perl

# $Id$
# install-tl.pl
#
# Copyright 2007 2008 Reinhard Kotucha, Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
# TODO:
#  - support option_paper (paper instead of A4)
#    missing

my $svnrev = '$Revision$';
$svnrev =~ m/: ([0-9]+) /;
$::installerrevision = $1;

# is now taken from 00texlive.config: release, $tlpdb->config_release;
our $texlive_release;

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

  if ($me=~m!/!) {
    ($::installerdir=$me)=~s!(.*)/.*$!$1!;
    # we have to chdir to the Master ...
    chdir($::installerdir);
  } else {
    $::installerdir='.';
  }
# The installer uses a minimal subset of Perl for Windows.  In order
# to avoid conflicts with other versions of Perl already installed on
# the system, we simply ignore them.  The installer has to execute
# $::installerdir/tlpkg/bin/perl.exe and should not rely on any other
# Perl executable.

  if ($^O=~/^MSWin(32|64)$/i) {
    @INC="$::installerdir/tlpkg/installer/perllib";
  }
  unshift (@INC, "$::installerdir/tlpkg");
}

use TeXLive::TLUtils qw(initialize_installer media platform platform_desc
   which getenv win32 unix program_exists architectures_available
   additional_architectures_available_from_net get_system_tmpdir member
   mkdirhier make_var_skeleton make_local_skeleton install_package copy
   install_packages dirname tllog);
use TeXLive::TLPOBJ;
use TeXLive::TLPDB;
use TeXLive::TLConfig qw($DefaultContainerExtension $InfraLocation);

if (win32) {
  require TeXLive::TLWinGoo;
  TeXLive::TLWinGoo->import( qw(
    &wg_error
    &admin
    &non_admin
    &reg_country
    &dir_writable
    &expand_string
    &global_tmpdir
    &get_system_path
    &get_user_path
    &add_texbindir_to_path
    &remove_texbindirs_from_path
    &register_script_type
    &unregister_script_type
    &broadcast_env
    &update_assocs
  ));
}
use Getopt::Long;
$Getopt::Long::autoabbrev=0;

use strict;

# debugging/logging cmd lines options:
# -q     shut up terminal output
# -qq    shut up also log file output
# -d     set $::LOGLEVELFILE to $::LOG_DEBUG
# -dd    set $::LOGLEVELFILE to $::LOG_DDEBUG
# -ddd   set $::LOGLEVELFILE to $::LOG_DDDEBUG
#
$::LOGLEVELFILE = $::LOG_NORMAL;
$::LOGLEVELTERMINAL = $::LOG_NORMAL;
@::LOGLINES = ();
#
# $install{$packagename} == 1 if it should be installed
my %install;
# if we should try to get additional binaries from the net
# needs our since for menu ...
our $trynet=0;
# the url of net location, can be changed with -url ....
#
# for my own testing in the virtual machine
#$::texlive_url = 'http://localhost/norbert/tltesting';
#$::texlive_url = 'http://10.0.2.2/norbert/tltesting';
$::texlive_url = 'ftp://tug.org/texlive/tlnet/tldev';

# the default scheme to be installed
my $default_scheme='scheme-full';

# some arrays where the lists of collections to be installed are saved
# our for menus
our @collections_std;
our @collections_lang;
our @collections_lang_doc;
# The maximum number of binary systems on the CD.  This number must be
# smaller than the number of binaries available from the network.
our $max_bins_on_CD=7;
# for win dealing
#our $Registry;
# The global variable %vars is an associative list which contains all
# variables and their values which can be changed by the user.
# needs to be our since TeXLive::TLUtils uses it
our %vars=( # 'n_' means 'number of'.
        'this_platform' => platform(),
        'n_systems_available' => 0,
        'n_systems_selected' => 0,
        'n_collections_selected' => 0,
        'n_collections_available' => 0,
        'total_size' => 0,
        'option_symlinks' => 0,
        'sys_bin' => '/usr/local/bin',
        'sys_man' => '/usr/local/man',
        'sys_info' => '/usr/local/info',
        'option_doc' => 1,
        'option_src' => 1,
        'option_fmt' => 0,
        'option_letter' => 0,
        'selected_scheme' => $default_scheme,
    );

# option handling
my $opt_media = "";
my $opt_url = "";
my $opt_profile = "";
my $opt_no_cls=0;
my $opt_gui = 0;
my $opt_debug = 0;
my $opt_ddebug = 0;
my $opt_dddebug = 0;
my $opt_quiet = 0;
my $opt_qquiet = 0;
my $opt_arch = 0;
my $opt_portable = 0;

$::netarchive = "tlpkg";
$::diskarchive = "archive";

# default language for GUI installer
$::lang = "en";

GetOptions("media=s" => \$opt_media,
           "profile=s"=> \$opt_profile,
           "no-cls",
           "gui", \$opt_gui,
           "netarchive=s" => \$::netarchive,
           "diskarchive=s" => \$::diskarchive,
           "lang=s" => \$::lang,
           "print-arch" => \$opt_arch,
           "portable" => \$opt_portable,
           "d" => \$opt_debug,
           "dd" => \$opt_ddebug,
           "ddd" => \$opt_dddebug,
           "q" => \$opt_quiet,
           "qq" => \$opt_qquiet,
           "url=s"   => \$opt_url ) or die("No pod doc till now!");

if ($opt_quiet) {
  $::LOGLEVELTERMINAL = $::LOG_ZERO;
}
if ($opt_qquiet) {
  $::LOGLEVELTERMINAL = $::LOG_ZERO;
  $::LOGLEVELFILE = $::LOG_ZERO;
}
if ($opt_debug) {
  $::LOGLEVELFILE = $::LOG_DEBUG;
}
if ($opt_ddebug) {
  $::LOGLEVELFILE = $::LOG_DDEBUG;
}
if ($opt_dddebug) {
  $::LOGLEVELFILE = $::LOG_DDDEBUG;
}
if ("$opt_media" =~ m/^CD/i) {
  $::_media_ = "CD";
} elsif ("$opt_media" =~ m/^NET/i) {
  $::_media_ = "NET";
} elsif ("$opt_media" =~ m/^DVD/i) {
  $::_media_ = "DVD";
}

if ("$opt_profile" ne "") {
  if (-r "$opt_profile") {
    tllog($::LOG_NORMAL, "Using automated installation using $opt_profile!");
  } else {
    $opt_profile = "";
    tllog($::LOG_NORMAL, "Profile $opt_profile not readable, continuing in interactive mode!");
  }
}

if ("$opt_url" ne "") {
  $::texlive_url = "$opt_url";
}

# the TLPDB instances we will use. $tlpdb is for the one from the installation
# media, while $localtlpdb is for the new installation
# $tlpdb must be our because it is used in install-menu-text.pl
our $tlpdb;
my $localtlpdb;

# $finished == 1 if the menu call already did the installation
my $finished = 0;
@::start_install_hook = ();
@::end_install_hook = ();
@::start_postinst_hook = ();
@::start_install_hook = ();

my $system_tmpdir=get_system_tmpdir();

if ($opt_arch) {
  print platform;
  exit 0;
} elsif ($opt_portable) {
  $::LOGLEVELTERMINAL = $::LOG_ZERO;
  # initialize_installer:
  $::_media_ = "DVD";
  $::_platform_ = platform();
  $vars{'TEXDIR'} = getenv('TEXDIR');
  if (not -d $vars{'TEXDIR'}.'/bin/'.$::_platform_) { # shouldn't happen
    print "Platform ".$::_platform_." not supported\n";
    exit 1;
  }
  # set_platforms_supported();
  # set_texlive_default_dirs();
  $vars{'TEXMFSYSVAR'} = getenv('TEXMFSYSVAR');
  $vars{'TEXMFSYSCONFIG'} = getenv('TEXMFSYSCONFIG');
  $vars{'TEXMFLOCAL'} = getenv('TEXMFLOCAL');
  $vars{'TEXMFHOME'} = getenv('TEXMFHOME');
  $vars{'TEXMFVAR'} = getenv('TEXMFVAR');
  $vars{'TEXMFCONFIG'} = getenv('TEXMFCONFIG');
  # initialize_collections();
  # set_install_platform();
  $vars{'this_platform'} = platform();
  # do_installation();
  #   prepare_installation();
  if (win32()) {
    non_admin();
    my $winpath = "$vars{'TEXDIR'}/bin/win32";
    register_script_type(".texlua", $winpath."/texlua.exe");
    update_assocs();
  }
  mkdirhier "$vars{'TEXMFCONFIG'}";
  if (not -d "$vars{'TEXMFSYSVAR'}" ) {
    print "About to generate some files... Press <enter>";
    <STDIN>;
    load_tlpdb();
    $localtlpdb = $tlpdb;
    $texlive_release = $tlpdb->config_release;
    make_var_skeleton "$vars{'TEXMFSYSVAR'}";
    #$localtlpdb=new TeXLive::TLPDB;
    #$localtlpdb->root("$vars{'TEXDIR'}");
    do_postinst_stuff();
  }
  close($::LOGFILE) if defined($::LOGFILE);
  exit 0;
}

tllog($::LOG_NORMAL, "Platform: ", platform, " => \'", platform_desc(platform), "\'\n");
if (media() eq "DVD") {
  tllog($::LOG_NORMAL, "Distribution: live (uncompressed)\n");
} elsif (media() eq "CD") {
  tllog($::LOG_NORMAL, "Distribution: inst (compressed)\n");
} elsif (media() eq "NET") {
  tllog($::LOG_NORMAL, "Distribution: net  (downloading)\n");
} else {
  tllog($::LOG_NORMAL, "Distribution: ", media(), "\n");
}
tllog($::LOG_NORMAL, "Directory for Temporary Files: '", $system_tmpdir, "\'\n");
tllog($::LOG_NORMAL, "Installer Directory: '$::installerdir'\n");

initialize_installer();
load_tlpdb();
$texlive_release = $tlpdb->config_release;
set_platforms_supported();
set_texlive_default_dirs();
initialize_collections();
set_install_platform();
if ($opt_profile eq "") {
  # do the normal interactive installation!
  #
  # here we could load different menu systems. Currently several things
  # are "our" so that the menu implementation can use it. The $tlpdb, the
  # %var, and all the @collection*
  # install-menu-*.pl should implement a function run_menu() and should
  # change ONLY stuff in %vars
  # The allowed keys in %vars should be specified somewhere ...
  # the menu implementation should return
  #    MENU_INSTALL  do the installation
  #    MENU_ABORT    abort every action immediately, no cleanup
  #    MENU_QUIT     try to quit and clean up mess
  our $MENU_INSTALL = 0;
  our $MENU_ABORT   = 1;
  our $MENU_QUIT    = 2;
  our $MENU_ALREADYDONE = 3;
  if ($opt_gui) {
    # try to load Tk.pm, but don't die if it doesn't work
    eval { require Tk; };
    if ($@) {
      # that didn't work out, so warn the user and continue with text mode
      tllog($::LOG_NORMAL, "Cannot load Tk, maybe something is missing!\n");
      tllog($::LOG_NORMAL, "Error message from loading Tk:\n");
      tllog($::LOG_NORMAL, "$@\n");
      tllog($::LOG_NORMAL, "Continuing in Text Mode...\n");
      $opt_gui = 0;
    }
  }
  if ($opt_gui) {
    require("installer/install-menu-perltk.pl");
  } else {
    require("installer/install-menu-text.pl");
  }
  my $ret = run_menu();
  if ($ret == $MENU_QUIT) {
    # do_cleanup();  MISSING
    flushlog();
    exit(1);
  }
  if ($ret == $MENU_ABORT) {
    # NO do_cleanup()!
    flushlog();
    exit(2);
  }
  if ($ret == $MENU_ALREADYDONE) {
    tllog($::LOG_DEBUG, "run_menu has already done the work ... cleaning up!\n");
    $finished = 1;
  }
  if (!$finished && ($ret != $MENU_INSTALL)) {
    tllog($::LOG_NORMAL, "Unknown return value of run_menu: $ret\n");
    exit(3);
  }
} else {
  read_profile("$opt_profile");
}

if (!$finished) {
  # do the actual installation
  do_installation();
}

# now open the log file and write out the log lines
# try to open a log file
if ($::LOGLEVELFILE > $::LOG_ZERO) {
  if (open(LOGF,">$vars{'TEXDIR'}/install-tl.log")) {
    $::LOGFILE = \*LOGF;
    foreach my $line(@::LOGLINES) {
      print $::LOGFILE "$line";
    }
  } else {
    warn("Cannot create log file $vars{'TEXDIR'}/install-tl.log: $!\nNot writing out log lines!\n");
    $::LOGLEVELFILE = $::LOG_ZERO;
  }
}

# dump various things to the log file
if (defined($::LOGFILE)) {
  print $::LOGFILE "\nDump of vars:\n";
  foreach my $key (keys %vars) {
    print $::LOGFILE "$key $vars{$key}\n";
  }
  create_profile($::LOGFILE);
}

dump_vars("$system_tmpdir/texlive.vars");

# write the profile out
create_profile("$vars{'TEXDIR'}/$InfraLocation/texlive.profile");
tllog($::LOG_DEBUG, "Profile written to $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n");

# Close log file if present
close($::LOGFILE) if defined($::LOGFILE);


exit(0);

###################################################################
#
# FROM HERE ON ONLY SUBROUTINES
# NO VARIABLE DECLARATIONS
#
###################################################################

sub do_installation {
  # do the actual installation
  foreach my $h (@::start_install_hook) {
    &$h();
  }
  calc_depends();
  prepare_installation();
  do_install_packages();
  if (win32()) {
    do_win_registry_magic();
  }
  foreach my $h (@::start_postinst_hook) {
    &$h();
  }
  do_postinst_stuff();
  save_options_into_tlpdb();
  $localtlpdb->save;
  foreach my $h (@::end_install_hook) {
    &$h();
  }
}

sub dump_vars {
  my $filename=shift;
  my $fh;
  if (ref($filename)) {
    $fh = $filename;
  } else {
    open VARS, ">$filename";
    $fh = \*VARS;
  }
  foreach my $key (keys %vars) {
    print $fh "$key $vars{$key}\n";
  }
  close VARS if (!ref($filename));
  tllog($::LOG_DEBUG, "\n%vars dumped to '$filename'.\n");
}


# Determine which platforms are supported.
sub set_platforms_supported {
  my @binaries=architectures_available;
  for my $binary (@binaries) {
    unless (defined $vars{"diskbin_$binary"}) {
      $vars{"diskbin_$binary"}=0;
    }
  }
  if ($trynet==1) {
    my @binaries=additional_architectures_available_from_net \%vars;
    for my $binary (@binaries) {
      $vars{"netbin_$binary"}=0;
    }
  }
  for my $key (keys %vars) {
    ++$vars{'n_systems_available'} if ($key=~/^(disk|net)bin/);
  }
}

# Environment variables and default values on UNIX:
#   TEXLIVE_INSTALL_PREFIX         /usr/local/texlive   => $tex_prefix
#   TEXLIVE_INSTALL_TEXDIR         $tex_prefix/2007     => $TEXDIR
#   TEXLIVE_INSTALL_TEXMFSYSVAR    $TEXDIR/texmf-var
#   TEXLIVE_INSTALL_TEXMFLOCAL     $tex_prefix/texmf-local
#   TEXLIVE_INSTALL_TEXMFHOME      '$HOME/texmf'

sub set_texlive_default_dirs {
  my $tex_prefix;
  my $texmfsysvar;
  my $texmflocal;
  my $texmfhome;

  $tex_prefix=getenv('TEXLIVE_INSTALL_PREFIX');
  if (win32) {
    my $prog = getenv('ProgramFiles');
    $tex_prefix ||= $prog . '/texlive' if TeXLive::TLWinGoo::dir_writable($prog);
    $tex_prefix||=getenv('USERPROFILE') . '/texlive';
  } else {
    $tex_prefix||='/usr/local/texlive';
    # $tex_prefix||='/usr/local/texlive' if (-w '/usr/local');
    # $tex_prefix||='/usr/local/texlive' if ( (-d '/usr/local/texlive') && (-w '/usr/local/texlive') );
    # $tex_prefix||=getenv('HOME') . '/texlive';
  }
  $vars{'TEXDIR'}="$tex_prefix/$texlive_release";

  $texmfsysvar=getenv('TEXLIVE_INSTALL_TEXMFSYSVAR');
  $texmfsysvar||=$vars{'TEXDIR'} . '/texmf-var';
  $vars{'TEXMFSYSVAR'}="$texmfsysvar";

  $texmflocal=getenv('TEXLIVE_INSTALL_TEXMFLOCAL');
  $texmflocal||="$tex_prefix/texmf-local";
  $vars{'TEXMFLOCAL'}="$texmflocal";

  $texmfhome=getenv('TEXLIVE_INSTALL_TEXMFHOME');
  $texmfhome ||= "~";
  $vars{'TEXMFHOME'}="$texmfhome/texmf";
}

sub calc_depends {
  # we have to reset the install hash EVERY TIME otherwise everything will
  # always be installed since the default is scheme-full which selects
  # all packages and never deselects it
  %install=();

  # initialize the %install hash with what should be installed

  # First look for packages in the selected scheme.
  my $scheme=$tlpdb->get_package($vars{'selected_scheme'});
  if (!defined($scheme)) {
    dump_vars(\*STDOUT);
    die ("Scheme $vars{'selected_scheme'} not defined!\n");
  }

  for my $scheme_content ($scheme->depends) {
    $install{"$scheme_content"}=1 unless ($scheme_content=~/^collection-/);
  }

  # Now look for collections in the %vars hash.  These are not
  # necessarily the collections required by a scheme.  The final
  # decision is made in the collections/languages menu.
  foreach my $key (keys %vars) {
    if ($key=~/^collection-/) {
      $install{$key} = 1 if $vars{$key};
    }
  }

  # compute the list of archs to be installed
  my @archs;
  foreach (keys %vars) {
    if (m/^diskbin_(.*)$/ ) {
      if ($vars{$_}) { push @archs, $1; }
    }
    if (m/^netbin_(.*)$/ ) {
      if ($vars{$_}) { push @archs, $1; }
    }
  }

  # if programs for arch=win32 are installed we also have to install
  # bin-tlperl.win32 which provides the "hidden" perl that will be used
  # to run all the perl scripts.
  # Furthermore we install bin-tlgs.win32, too
  if (grep(/^win32$/,@archs)) {
    $install{"bin-tlperl.win32"} = 1;
    $install{"bin-tlgs.win32"} = 1;
  }

  # loop over all the packages until it is getting stable
  my $changed = 1;
  while ($changed) {
    # set $changed to 0
    $changed = 0;

    # collect the already selected packages
    my @pre_selected = keys %install;
    tllog($::LOG_DDEBUG, "initial number of installations: $#pre_selected\n");

    # loop over all the pre_selected and add them
    foreach my $p (@pre_selected) {
      tllog($::LOG_DDEBUG, "pre_selected $p\n");
      foreach my $p_dep ($tlpdb->get_package($p)->depends) {
        if ($p_dep =~ m/^(.*)\.ARCH$/) {
          my $foo = "$1";
          foreach my $a (@archs) {
            $install{"$foo.$a"} = 1;
          }
        } elsif ($p_dep =~ m/^(.*)\.win32$/) {
          # a win32 package should *only* be installed if we are installing
          # the win32 arch
          if (grep(/^win32$/,@archs)) {
            $install{$p_dep} = 1;
          }
        } else {
          $install{$p_dep} = 1;
        }
      }
    }

    # check for newly selected packages
    my @post_selected = keys %install;
    tllog($::LOG_DDEBUG, "number of post installations: $#post_selected\n");

    # set repeat condition
    if ($#pre_selected != $#post_selected) {
      $changed = 1;
    }
  }

  # now do the size computation
  my $size = 0;
  foreach my $p (keys %install) {
    my $tlpobj = $tlpdb->get_package($p);
    if (not(defined($tlpobj))) {
      die "Cannot find $p in texlive.tlpdb, strange!\n";
    }
    $size+=$tlpobj->docsize if $vars{'option_doc'};
    $size+=$tlpobj->srcsize if $vars{'option_src'};
    $size+=$tlpobj->runsize;
    foreach my $a (@archs) {
      $size += $tlpobj->binsize->{$a} if defined($tlpobj->binsize->{$a});
    }
  }
  $vars{'total_size'} =
    sprintf "%d", ($size * $TeXLive::TLConfig::BlockSize)/1024**2;
}

sub load_tlpdb {
  my $master;
  if (media eq 'NET') {
    $master="$::texlive_url";
  } else {
    $master="$::installerdir";
  }
  tllog($::LOG_NORMAL, "Loading $master/$TeXLive::TLConfig::InfraLocation/$TeXLive::TLConfig::DatabaseName ...\n");
  $tlpdb=TeXLive::TLPDB->new(root => "$master");
}

sub initialize_collections {
  foreach my $pkg ($tlpdb->list_packages) {
    my $tlpobj = $tlpdb->{'tlps'}{$pkg};
    if ($tlpobj->category eq "Collection") {
      $vars{"$pkg"}=0;
      ++$vars{'n_collections_available'};
      if ($pkg=~/collection-lang/) {
        push @collections_lang, $pkg;
      } elsif ($pkg=~/documentation/) {
        if ($pkg=~/documentation-base/) {
          push @collections_std, $pkg;
        } else {
          push @collections_lang_doc, $pkg;
        }
      } else {
        push @collections_std, $pkg;
      }
    }
  }
  my $scheme_tlpobj = $tlpdb->get_package($default_scheme);
  if (defined ($scheme_tlpobj)) {
    $vars{'n_collections_selected'}=0;
    foreach my $dependent ($scheme_tlpobj->depends) {
      if ($dependent=~/^(collection-.*)/) {
        $vars{"$1"}=1;
        ++$vars{'n_collections_selected'};
      }
    }
  }
}

sub set_install_platform {
  my @available_platforms;
  my $detected_platform=platform;
  my $warn_nobin;
  my $warn_nobin_x86_64_linux;
  my $nowarn="";
  my $wp='##'; # warning prefix

  $warn_nobin="\n$wp WARNING!  No binaries for your platform found!  ";
  if (media eq 'CD') {
    $warn_nobin.="More binaries are available\n$wp on the DVD.  The binary "
        . "systems menu allows you to download extra binaries\n"
        . "$wp from the network.\n";
  }
  $warn_nobin_x86_64_linux="$warn_nobin" .
      "$wp No binaries for x86_64-linux found, using i386-linux instead.\n";

  my $ret = $warn_nobin;
  if (defined $vars{"diskbin_$detected_platform"}) {
    $vars{"diskbin_$detected_platform"}=1;
    $vars{'inst_platform'}=$detected_platform;
    $ret = $nowarn;
  } elsif (defined $vars{"netbin_$detected_platform"}) {
    $vars{"netbin_$detected_platform"}=1;
    $vars{'inst_platform'}=$detected_platform;
    $ret = $nowarn;
  } elsif ($detected_platform eq 'x86_64-linux') {
    $vars{'diskbin_i386-linux'}=1;
    $vars{'inst_platform'}='i386-linux';
    $ret = $warn_nobin_x86_64_linux;
  } else {
    $ret = $warn_nobin;
  }
  foreach my $key (keys %vars) {
    if ($key=~/^diskbin.*/ or $key=~/^netbin.*/) {
       ++$vars{'n_systems_selected'} if $vars{$key}==1;
    }
  }
  return($ret);
}

sub create_profile {
  my $profilepath = shift;
  # The file "TLprofile" is created at the beginning of the
  # installation process and contains information about the current
  # setup.  The purpose is to allow non-interactive installations.
  my $fh;
  if (ref($profilepath)) {
    $fh = $profilepath;
  } else {
    open PROFILE, ">$profilepath";
    $fh = \*PROFILE;
  }
  my $tim = gmtime(time);
  print $fh "# texlive.profile written on $tim UTC\n";
  print $fh "# it will NOT be overwritten and reflects only the\n";
  print $fh "# installation profile at installation time\n";
  print $fh "selected_scheme $vars{selected_scheme}\n";
  foreach my $key (keys %vars) {
    print $fh "$key $vars{$key}\n"
        if $key=~/^collection/ and $vars{$key}==1;
    print $fh "$key $vars{$key}\n" if $key=~/^option_letter/;
    print $fh "$key $vars{$key}\n" if $key=~/^option_doc/;
    print $fh "$key $vars{$key}\n" if $key=~/^option_fmt/;
    print $fh "$key $vars{$key}\n" if $key=~/^option_src/;
    print $fh "$key $vars{$key}\n" if $key=~/^option_symlinks/;
    print $fh "$key $vars{$key}\n" if $key=~/^TEXDIR/;
    print $fh "$key $vars{$key}\n" if $key=~/^TEXMFSYSVAR/;
    print $fh "$key $vars{$key}\n" if $key=~/^TEXMFLOCAL/;
    print $fh "$key $vars{$key}\n" if $key=~/^TEXMFHOME/;
  }
  if (!ref($profilepath)) {
    close PROFILE;
  }
}

sub read_profile {
  my $profilepath = shift;
  open PROFILE, "<$profilepath"
    or die "Cannot open profile $profilepath for reading!\n";
  my %pro;
  while (<PROFILE>) {
    next if m/^[[:space:]]*$/; # skip empty lines
    next if m/^[[:space:]]*#/; # skip comment lines
    my ($k,$v) = split;
    $pro{$k} = $v;
  }
  foreach (keys %vars) {
    # clear out collections from var
    if (m/^collection-/) { $vars{$_} = 0; }
    if (defined($pro{$_})) { $vars{$_} = $pro{$_}; }
  }
}

sub prepare_installation {
  make_var_skeleton "$vars{'TEXMFSYSVAR'}";
  make_local_skeleton "$vars{'TEXMFLOCAL'}";
  mkdirhier "$vars{'TEXDIR'}/texmf-config";

  $localtlpdb=new TeXLive::TLPDB;
  $localtlpdb->root("$vars{'TEXDIR'}");
}


sub do_install_packages {
  my @what;
  foreach my $package (sort keys %install) {
    push @what, $package if ($install{$package} == 1);
  }
  my @netarchs;
  foreach my $k (keys %vars) {
    if ($k =~ m/^netbin_(.*)$/) {
      my $a = $1;
      if ($vars{$k}) { push @netarchs, $a; }
    }
  }
  install_packages($tlpdb,$localtlpdb,\@what,\@netarchs,$vars{'option_src'},$vars{'option_doc'});
}

# for later complete removal we want to save some options and values
# into the local tlpdb:
# - should links be set, and if yes, the destination (bin,man,info)
sub save_options_into_tlpdb {
  my $tlp = new TeXLive::TLPOBJ;
  $tlp->name("00texlive-installation.config");
  $tlp->category("TLCore");
  my @deps;
  if ($vars{'option_letter'}) {
    push @deps, "option_letter";
  }
  if ($vars{'option_fmt'}) {
    push @deps, "option_fmt";
  }
  if ($vars{'option_symlinks'}) {
    push @deps, "option_symlinks";
    push @deps, "sys_bin/$vars{'sys_bin'}";
    push @deps, "sys_info/$vars{'sys_info'}";
    push @deps, "sys_man/$vars{'sys_man'}";
  }
  if ($vars{'option_doc'}) {
    push @deps, "option_doc";
  }
  if ($vars{'option_src'}) {
    push @deps, "option_src";
  }
  push @deps, "TEXDIR/$vars{'TEXDIR'}";
  push @deps, "TEXMFSYSVAR/$vars{'TEXMFSYSVAR'}";
  push @deps, "TEXMFLOCAL/$vars{'TEXMFLOCAL'}";
  push @deps, "TEXMFHOME/$vars{'TEXMFHOME'}";
  $tlp->depends(@deps);
  $localtlpdb->add_tlpobj($tlp);
  $localtlpdb->save();
}

# do_postinst_stuff has to fix up the texmf tree and install some missing
# files. The things to do are taken from the install-live.sh installer
# of former times, and should be critically checked.
sub do_postinst_stuff {
  my $TEXDIR="$vars{'TEXDIR'}";
  my $TEXMFSYSVAR="$vars{'TEXMFSYSVAR'}";
  my $TEXMFLOCAL="$vars{'TEXMFLOCAL'}";

  # install some copies from texmf(-dist) into texmf-var
  copy ("$TEXDIR/texmf-dist/tex/plain/config/language.def",
        "$TEXMFSYSVAR/tex/plain/config")
       if (-f "$TEXDIR/texmf-dist/tex/plain/config/language.def");
  copy ("$TEXDIR/texmf/xdvi/XDvi",
        "$TEXMFSYSVAR/xdvi")
       if (-f "$TEXDIR/texmf/xdvi/XDvi");

  # those files must exist
  copy ("$TEXDIR/texmf/dvips/config/config.ps",
        "$TEXMFSYSVAR/dvips/config");
  copy ("$TEXDIR/texmf/dvipdfm/config/config",
        "$TEXMFSYSVAR/dvipdfm/config");
  copy ("$TEXDIR/texmf/web2c/mktex.cnf",
        "$TEXMFSYSVAR/web2c");

  # the old installer copied from CDDIR, but shouldn't this be installed
  # in ANY case since it is in bin-pdftex???
  copy ("$TEXDIR/texmf/tex/generic/config/pdftexconfig.tex",
        "$TEXMFSYSVAR/tex/generic/config");

  # old installer did this, should we do this, TOO????
  #cp $CDDIR/texmf-dist/tex/context/config/cont-usr.tex $TEXMFSYSVAR/tex/context/config/cont-usr.tex

  do_texmf_cnf() unless $opt_portable;


  # final program execution
  # we have to do several things:
  # - clean the environment from spurious TEXMF related variables
  # - add the bin dir to the PATH
  # - select perl interpreter and set the correct perllib
  # - run the programs

  # Step 1: Clean the environment
  #my @TMFVARS=qw(VARTEXFONTS TEXMFMAIN TEXMFDIST TEXMFLOCAL TEXMFSYSVAR
  #  TEXMFSYSCONFIG TEXMFHOME TEXMFVAR TEXMFCONFIG TEXMF SYSTEXMF VARTEXFONTS
  #  TEXMFDBS WEB2C TEXINPUTS TEXFORMATS MFBASES MPMEMS TEXPOOL MFPOOL MPPOOL
  #  PSHEADERS TEXFONTMAPS TEXPSHEADERS TEXCONFIG TEXMFCNF);
  my @TMFVARS0=qw(VARTEXFONTS
    TEXMF SYSTEXMF VARTEXFONTS
    TEXMFDBS WEB2C TEXINPUTS TEXFORMATS MFBASES MPMEMS TEXPOOL MFPOOL MPPOOL
    PSHEADERS TEXFONTMAPS TEXPSHEADERS TEXCONFIG TEXMFCNF);
  my @TMFVARS1=qw(TEXMFMAIN TEXMFDIST TEXMFLOCAL TEXMFSYSVAR TEXMFSYSCONFIG
    TEXMFHOME TEXMFVAR TEXMFCONFIG);

  foreach my $tmv (@TMFVARS0) {
    delete $ENV{$tmv} if (defined($ENV{$tmv}));
  }
  if (!$opt_portable) { foreach my $tmv (@TMFVARS1) {
    delete $ENV{$tmv} if (defined($ENV{$tmv}));
  }}

  # Step 2: Setup the PATH, PATHEXT, switch to the new Perl

  my $pathsep=(win32)? ';' : ':';
  my $plat_bindir="$TEXDIR/bin/$vars{'this_platform'}";
  my $perl_bindir="$TEXDIR/tlpkg/tlperl/bin";
  my $perl_libdir="$TEXDIR/tlpkg/tlperl/lib";

  tllog($::LOG_NORMAL, "Prepending $plat_bindir to PATH\n");

  $ENV{'PATH'}="$plat_bindir" . "$pathsep" . "$ENV{'PATH'}";

  if (win32) {
    tllog($::LOG_NORMAL, "Prepending $perl_bindir to PATH\n");
    $ENV{'PATH'}="$perl_bindir" . "$pathsep" . "$ENV{'PATH'}";
  }

  tllog($::LOG_NORMAL, "\nNew PATH is now:\n");
  foreach my $dir (split $pathsep, $ENV{'PATH'}) {
    tllog($::LOG_NORMAL, "  $dir\n");
  }
  tllog($::LOG_NORMAL, "\n");

  if (win32) {
    $ENV{'PATHEXT'}=".texlua;" . "$ENV{'PATHEXT'}";
    $ENV{'PERL5LIB'}="$perl_libdir";
  }


  # Step 4: run the programs

  if (!$opt_portable) {
    tllog($::LOG_NORMAL, "running mktexlsr $TEXDIR/texmf-dist $TEXDIR/texmf\n");
    system('mktexlsr', "$TEXDIR/texmf-dist", "$TEXDIR/texmf");
  }

  # we have to generate the various config file. That could be done with
  # texconfig generate * but Win32 does not have texconfig. But we have
  # $localtlpdb and this is simple code, so do it directly, i.e., duplicate
  # the code from the various generate-*.pl scripts
  tllog($::LOG_NORMAL, "writing fmtutil.cnf data to $TEXMFSYSVAR/web2c/fmtutil.cnf\n");
  TeXLive::TLUtils::create_fmtutil($localtlpdb,
    "$TEXMFSYSVAR/web2c/fmtutil.cnf",
    "$TEXMFLOCAL/web2c/fmtutil-local.cnf");

  tllog($::LOG_NORMAL, "writing updmap.cfg to $TEXMFSYSVAR/web2c/updmap.cfg\n");
  TeXLive::TLUtils::create_updmap ($localtlpdb,
    "$TEXMFSYSVAR/web2c/updmap.cfg",
    "$TEXMFLOCAL/web2c/updmap-local.cfg");

  tllog($::LOG_NORMAL, "writing language.dat data to $TEXMFSYSVAR/tex/generic/config/language.dat\n");
  TeXLive::TLUtils::create_language($localtlpdb,
    "$TEXMFSYSVAR/tex/generic/config/language.dat",
    "$TEXMFLOCAL/tex/generic/config/language-local.dat");

  tllog($::LOG_NORMAL, "running updmap-sys\n");
  system('updmap-sys', '--nohash');

  tllog($::LOG_NORMAL, "re-running mktexlsr $TEXMFSYSVAR\n");
  system('mktexlsr', "$TEXMFSYSVAR");

  # now work through the options if specified at all

  # letter instead of a4
  if ($vars{'option_letter'}) {
    tllog($::LOG_NORMAL, "letter option not implemented yet, please wait\n");
  }

  # all formats option
  if ($vars{'option_fmt'}) {
    tllog($::LOG_NORMAL, "pre-generation all format file (fmtutil-sys --all)\n");
    system('fmtutil-sys','--all');
  }

  # option_links
  if ($vars{'option_symlinks'}) {
    # bin files
    my @files;
    mkdirhier $vars{'sys_bin'};
    if (-w $vars{'sys_bin'}) {
      tllog($::LOG_NORMAL, "linking binaries to $vars{'sys_bin'}\n");
      @files = `ls $plat_bindir`;
      chomp(@files);
      `cd "$vars{'sys_bin'}" && rm -f @files`;
      `ln -s "$plat_bindir/"* "$vars{'sys_bin'}"`;
    } else {
      tllog($::LOG_NORMAL, "destination of bin symlink $vars{'sys_bin'} not writable, no linking of bin files done!\n");
    }
    # info files
    mkdirhier $vars{'sys_info'};
    if (-w  $vars{'sys_info'}) {
      tllog($::LOG_NORMAL, "linking info pages to $vars{'sys_info'}\n");
      @files = `ls "$TEXDIR/texmf/doc/info"`;
      chomp(@files);
      `cd "$vars{'sys_info'}" && rm -f @files`;
      `ln -s "$TEXDIR/texmf/doc/info/"*info* "$vars{'sys_info'}"`;
    } else {
      tllog($::LOG_NORMAL, "destination of info symlink $vars{'sys_info'} not writable, no linking of info files done!\n");
    }
    # man files
    mkdirhier $vars{'sys_man'};
    if (-w  $vars{'sys_man'}) {
      tllog($::LOG_NORMAL, "linking man pages to $vars{'sys_man'}\n");
      my $foo = `(cd "$TEXDIR/texmf/doc/man" && echo *)`;
      my @mans = split ' ', $foo;
      chomp(@mans);
      foreach my $m (@mans) {
        my $mandir = "$TEXDIR/texmf/doc/man/$m";
        next unless -d $mandir;
        mkdirhier "$vars{'sys_man'}/$m";
        next unless -w "$vars{'sys_man'}/$m";
        @files = `ls "$mandir"`;
        chomp(@files);
        `cd "$vars{'sys_man'}/$m" && rm -f @files`;
        `ln -s "$mandir/"* "$vars{'sys_man'}/$m"`;
      }
    } else {
      tllog($::LOG_NORMAL, "destination of man symlink $vars{'sys_man'} not writable, no linking of man files done!\n");
    }
  }

  # old installer:
  #$config && texconfig-sys init
  #$config || echo "PLEASE RUN texconfig or texconfig-sys to make new formats."
}


# we have to adjust the texmf.cnf file to the paths set in the configuration!
sub do_texmf_cnf {
  open(TMF,"<$vars{'TEXDIR'}/texmf/web2c/texmf.cnf")
      or die("$vars{'TEXDIR'}/texmf/web2c/texmf.cnf not found: $!\n");
  my @texmfcnflines = <TMF>;
  close(TMF);
  my @newtmf;
  # we have to find TEXMFLOCAL TEXMFSYSVAR and TEXMFHOME
  foreach my $line (@texmfcnflines) {
    if ($line =~ m/^TEXMFLOCAL/) {
      # by default TEXMFLOCAL = TEXDIR/../texmf-local, if this is the case
      # we don't have to change anything from the default
      my $deftmlocal = dirname($vars{'TEXDIR'});
      $deftmlocal .= "/texmf-local";
      if ("$vars{'TEXMFLOCAL'}" eq "$deftmlocal") {
        push @newtmf, $line;
      } else {
        push @newtmf, "TEXMFLOCAL = $vars{'TEXMFLOCAL'}\n";
      }
    } elsif ($line =~ m/^TEXMFSYSVAR/) {
      # by default TEXMFSYSVAR = TEXDIR/texmf-var, if this is the case
      # we don't have to change anything from the default
      if ("$vars{'TEXMFSYSVAR'}" eq "$vars{'TEXDIR'}/texmf-var") {
        push @newtmf, $line;
      } else {
        push @newtmf, "TEXMFSYSVAR = $vars{'TEXMFSYSVAR'}\n";
      }
    } elsif ($line =~ m/^TEXMFHOME/) {
      # kpse now expands ~ to USERPROFILE, so we don't treat win32 and
      # unix differently
      push @newtmf, "TEXMFHOME = $vars{'TEXMFHOME'}\n";
    } elsif ($line =~ m/^OSFONTDIR/) {
      if (win32()) {
        push @newtmf, "OSFONTDIR = \$SystemRoot/fonts//\n";
      } else {
        push @newtmf, $line;
      }
    } else {
      push @newtmf, $line;
    }
  }
  open(TMF,">$vars{'TEXDIR'}/texmf/web2c/texmf.cnf")
      or die("Can't open $vars{'TEXDIR'}/texmf/web2c/texmf.cnf for writing: $!\n");
  foreach (@newtmf) { print TMF; }
  close(TMF);
}

# register texlua handlers etc etc
sub do_win_registry_magic {
  # we are called under if (win32()) !!
  my $winpath = "$vars{'TEXDIR'}/bin/win32";
  #$winpath =~ s!/!\\!g;
  add_texbindir_to_path($winpath);
  register_script_type(".texlua", $winpath."/texlua.exe");
  broadcast_env();
  update_assocs();
}

#
# do everything to select a scheme
#
sub select_scheme {
  my $s = shift;
  # set the selected scheme to $s
  $vars{'selected_scheme'} = $s;
  # remove the selection of all collections
  foreach my $entry (keys %vars) {
    if ($entry=~/^(collection-.*)/) {
      $vars{"$1"}=0;
    }
  }
  # select the collections belonging to the scheme
  my $scheme_tlpobj = $tlpdb->get_package($s);
  if (defined ($scheme_tlpobj)) {
    $vars{'n_collections_selected'}=0;
    foreach my $dependent ($scheme_tlpobj->depends) {
      if ($dependent=~/^(collection-.*)/) {
        $vars{"$1"}=1;
        ++$vars{'n_collections_selected'};
      }
    }
  }
  # for good measure, update the deps
  calc_depends();
}

sub update_numbers {
  $vars{'n_collections_selected'}=0;
  $vars{'n_systems_available'} = 0;
  $vars{'n_collections_selected'} = 0;
  $vars{'n_systems_selected'} = 0;
  foreach my $key (keys %vars) {
    if ($key =~ /^(disk|net)bin/) {
      ++$vars{'n_systems_available'};
      ++$vars{'n_systems_selected'} if $vars{$key} == 1;
    }
    if ($key =~ /^collection-/) {
      ++$vars{'n_collections_available'};
      ++$vars{'n_collections_selected'} if $vars{$key} == 1;
    }
  }
}

sub flushlog {
  my $fh;
  if (open(LOG,">install-tl.log")) {
    warn "Writing log file to current working directory!\n";
    $fh = \*LOG;
  } else {
    $fh = \*STDERR;
    warn "Not creating a log file but flushing messages to stderr:\n";
  }

  foreach my $l (@::LOGLINES) {
    print $fh $l;
  }
}

__END__

### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #