path: root/Master/install-tl.pl

#!/usr/bin/env perl

# $Id: $
# install-tl.pl
#
# Copyright 2007 Reinhard Kotucha
# This file is licensed under the GNU General Public License version 2
# or any later version.

$texlive_release="2008";

BEGIN {
  $^W = 1;
  my $me=$0;
  $me=~s!\\!/!g if $^O=~/^MSWin(32|64)$/i;
  ($thisdir=$me)=~s!(.*)/.*$!$1!;
  unshift (@INC, "$thisdir/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);
use TeXLive::TLPOBJ;
use TeXLive::TLPDB;


$default_scheme='scheme-full';

###$texlive_url='http://localhost/texlive/Contents/inst';
$texlive_url='http://tug.org/svn/texlive/trunk/Master';

# The maximum number of binary systems on the CD.  This number must be
# smaller than the number of binaries available from the network.
$max_bins_on_CD=7; 

#$_platform_='win32';

initialize_installer;

my $system_tmpdir=get_system_tmpdir;

print "Platform: ", platform, " => \'", platform_desc(platform), "\'\n";
print "Media: ", media, "\n";
print "Directory for Temporary Files: '", get_system_tmpdir, "\'\n";

# The global variable %vars is an associative list which contains all 
# variables and their values which can be changed by the user.

my %vars;

sub dump_vars {
  my $filename=shift;
  open VARS, ">$filename";
  foreach $key (keys %vars) {
    print VARS "$key $vars{$key}\n";
  }
  close VARS;
  print "\n%vars dumped to '$filename'.\n";
}


# Determine which platforms are supported.
$trynet=0;
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; 
    }
  }
}


# 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) {
    if (-w getenv('CommonProgramFiles')) {
      $tex_prefix||=getenv('CommonProgramFiles') . '/texlive';
    } else {
      $tex_prefix||=getenv('ProgramFiles') . '/texlive';
    }
  } else {
    $tex_prefix||='/usr/local/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');
  if (win32) {
    $texmfhome||=getenv('USERPROFILE');
  } else {
    $texmfhome||=getenv('HOME');
  }
  $vars{'TEXMFHOME'}="$texmfhome/texmf";
}


%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,
        'selected_scheme' => $default_scheme,
    );


sub calc_depends {
  my $size;
  # First look for packages in the selected scheme.

  my $scheme=$tlpdb->get_package($vars{'selected_scheme'});

  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.
  
  my @collections;

  foreach my $key (keys %vars) {
    if ($key=~/^collection-/) {
      push @collections, $key if $vars{$key};
    }
  }

  # Now we look for packages in collections.  A collection can contain
  # other collections.  In this case we push it to the @collections
  # list if it doesn't exist already.  

  foreach my $selected_collection (@collections) {
    my $collection=$tlpdb->get_package($selected_collection);

    for my $package ($collection->depends) {
      if ($package=~/^collection-/) {
        push @collections, $package 
            unless member $package, @collections;
      } else {
        my $tlpobj = $tlpdb->{'tlps'}{$package};
        if ($tlpobj->category eq "Package") {
          $install{"$package"}=1;
          $size+=$tlpobj->docsize if $vars{'option_doc'};
          $size+=$tlpobj->srcsize if $vars{'option_src'};
          $size+=$tlpobj->runsize;
        } elsif ($tlpobj->category eq "TLCore") {
          if ($package=~/^bin-/) {
            my %binsizes = %{$tlpobj->binsize};
            foreach my $arch (keys %binsizes) {
              if ((defined $vars{"diskbin_$arch"} and 
                  $vars{"diskbin_$arch"}==1) ||
                  (defined $vars{"netbin_$arch"} and 
                  $vars{"netbin_$arch"}==1)) {
                $install{"$package"}=1;
                $size+=$binsizes{$arch};
              }
            }
          } else {
            $install{"$package"}=1;
          }
        }
      }
    }
  }
  $vars{'total_size'}=sprintf "%d", $size/1024**2;
#  printf "Total: %d MB\n", $size/1024**2;
}



sub clear_screen {
#   return 0;
  (unix)? system 'clear':system 'cls';
}

sub string_to_list {
  my $string=shift;
  return split(//, $string);
}

sub button {
  my $val=shift;
  return ($val)? '[X]':'[ ]';
}

sub hbar {
  return '=' x79, "\n";
}

sub toggle {
  my $var=shift;
  my $val=$vars{$var};
  ++$val;
  $vars{$var}=$val%2;;
}

sub menu_head {
  my $text=shift;
  clear_screen;
  print "$text\n", hbar, "\n";
}

sub other_options {
  my @options=@_;
  my %opts=(
    '-' => 'deselect all',
    '+' => 'select all',
    'H' => 'help',
    'I' => 'start installation',
    'N' => 'add binaries from net',
    'R' => 'return to main menu',
    'Q' => 'quit'
      );

  print "\nOther options:\n", hbar;
  for my $option (@options) {
    if (defined $opts{"$option"}) {
      printf " <%s> %s\n", $option, $opts{$option};
    } else {
      die "other_options: $opts{$option} undefined.\n";
    }
  }
}

sub prompt {
  my $prompt=shift;
  print "\n$prompt: ";
  chomp(my $answer=<STDIN>);
  return "$answer";
}

sub load_tlpdb {
  my $database;
  if (media eq 'NET') {
    $database='http://www.tug.org/svn/texlive/trunk/Master/texlive.tlpdb';
  } else {
    $database='./texlive.tlpdb';
  }
  print "Loading $database ...\n";
  $::tlpdb=TeXLive::TLPDB->new(location => "$database");
}


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)) {
      foreach my $dependent ($scheme_tlpobj->depends) {
        if ($dependent=~/^(collection-.*)/) {
          $vars{"$1"}=1;
        }
      }
    }
  }
}

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";

  if (defined $vars{"diskbin_$detected_platform"}) {
    $vars{"diskbin_$detected_platform"}=1;
    $vars{'inst_platform'}=$detected_platform;
    return $nowarn;
  } elsif (defined $vars{"netbin_$detected_platform"}) {
    $vars{"netbin_$detected_platform"}=1;
    $vars{'inst_platform'}=$detected_platform;
    return $nowarn;
  } elsif ($detected_platform eq 'x86_64-linux') {
    $vars{'diskbin_i386-linux'}=1;
    $vars{'inst_platform'}='i386-linux';
    return $warn_nobin_x86_64_linux;
  } else {
    return $warn_nobin;
  }
}


# The menu loop. A menu is a function.  Its return value is a
# reference to another menu or to itself.
sub run_menu {
  my $menu=\&main_menu;
  while ($menu!=\&install) {
    $menu=$menu->();
  }
}


sub binary_menu {
  my %command=(
    'self' => \&binary_menu,
    'R' => \&main_menu,
    'Q' => \&quit
      );

  my @diskbins;
  my @netbins;
  my %from_net;
  my @keys=string_to_list "abcdefghijklmopstuvwxyz";
  my $index=0;
  my $diskbin='';
  my %keyval; 
  my $selected_platform;

  menu_head "Available sets of binaries:";

  foreach my $key (keys %vars) {
    if ($key=~/diskbin_(.*)/) {
      push @diskbins, $1;
      $from_net{"$1"}=0;
    }
    if ($key=~/netbin_(.*)/) {
      push @netbins, $1;
      $from_net{"$1"}=1;
    }
  }
  my @binaries=sort(@diskbins,@netbins);

  set_install_platform;

  $vars{'n_systems_available'}=0;
  for my $key (keys %vars) {
    ++$vars{'n_systems_available'} if ($key=~/^(disk|net)bin/);
  }

  $diskbin='  ' 
      if (media eq 'CD' and $vars{'n_systems_available'}>$max_bins_on_CD);

  foreach my $binary (@binaries) {
    if (media eq 'CD' and $vars{'n_systems_available'}>$max_bins_on_CD) {
      $diskbin=$from_net{"$binary"}? "* ":"  ";
    }
    printf " %s %s %s%-16s %s\n", $keys[$index], 
    button($from_net{"$binary"}? 
           $vars{"netbin_$binary"}:$vars{"diskbin_$binary"}),
        $diskbin, "$binary" . ":",
        platform_desc "$binary";
    $keyval{"$keys[$index]"}=$from_net{"$binary"}?
        "netbin_$binary":"diskbin_$binary";
    ++$index;
  }
  if ($vars{'n_systems_available'}<=$max_bins_on_CD ) {
    print "\n Binaries for additional systems are available on the DVD.\n" .
        " If you have network access, try option <N>.\n";

    other_options qw(- + N R Q);
  } else {
    print "\n Network access is required to install binary systems " .
        "marked with '*'.\n" if (media eq 'CD');

    other_options qw(- + R Q);
  }

  my $answer=prompt 'Press key to select/deselect binary systems';
  
  my @keystrokes=string_to_list $answer;
  
  foreach my $keystroke (@keystrokes) {
    if ($keystroke eq '-') {
      for my $binary (@binaries) {
        $vars{"netbin_$binary"}=0 if defined $vars{"netbin_$binary"};
        $vars{"diskbin_$binary"}=0 if defined $vars{"diskbin_$binary"};
      }
    }
    if ($keystroke eq '+') {
      for my $binary (@binaries) {
        $vars{"netbin_$binary"}=1 if defined $vars{"netbin_$binary"};
        $vars{"diskbin_$binary"}=1 if defined $vars{"diskbin_$binary"};
      }
    }
    if (defined $keyval{$keystroke}) {
      toggle "$keyval{$keystroke}";
    }
  }
  if ("\u$answer" eq 'N' and media eq 'CD') {
    $trynet=1;
    set_platforms_supported;
    $trynet=0;
    return $command{'self'};
  }
  if (defined $command{"\u$answer"}) {
    return $command{"\u$answer"}->();
  } else {
    return $command{'self'}->();
  }
}


sub scheme_menu {
  my %command=(
    'self' => \&scheme_menu,
    'R' => \&main_menu,
    'Q' => \&quit
      );

  my @schemes;
  my @keys=string_to_list "abcdefghijklmnopstuvwxyz";
  my %keyval;
  my $index=0;

  menu_head 'Select a scheme:';

  foreach my $pkg ($tlpdb->list_packages) {
    my $tlpobj = $tlpdb->{'tlps'}{$pkg};
    if ($tlpobj->category eq "Scheme") {
      push @schemes, $pkg;
      $vars{"$pkg"}=($vars{'selected_scheme'} eq $pkg)? 1:0;
    }
  }
  @schemes=sort @schemes;

  foreach my $scheme (@schemes) {
    $keyval{$keys[$index]}="$scheme";
    my $tlpobj = $tlpdb->get_package("$scheme");
    printf " %s %s %s\n", $keys[$index], button($vars{"$scheme"}),
    $tlpobj->shortdesc;
    ++$index;
  }

  foreach $entry (keys %vars) {
    if ($entry=~/^(collection-.*)/) {
      $vars{"$1"}=0;
    }
  }

  my $scheme_tlpobj = $tlpdb->get_package($vars{'selected_scheme'});
  if (defined ($scheme_tlpobj)) {
    foreach my $dependent ($scheme_tlpobj->depends) {
      if ($dependent=~/^(collection-.*)/) {
        $vars{"$1"}=1;
      }
    }
  }
  
  other_options qw(R Q);
  my $answer=prompt 'Press key to select a scheme';

  if (defined $keyval{"$answer"}) {
    $vars{'selected_scheme'}=$keyval{"$answer"};
    return $command{'self'}->();
  }
  if (defined $command{"\u$answer"}) {
    return $command{"\u$answer"}->();
  } else {
    return $command{'self'}->();
  }
}


sub collection_menu {
  my %command=(
    'self' => \&collection_menu,
    'R' => \&main_menu,
    'Q' => \&quit
      );

  my @collections;
  my @keys=string_to_list "abcdefghijklmnopstuvwxyzABCDEFGHIJKLMNOPSTUVWXYZ";
  my %keyval;
  my $index=0;
  my @coll_short_desc;
  my @coll_long_desc;

  menu_head 'Select collections:';

  @collections=sort @collections_std;

  foreach my $collection (@collections) {
    my $tlpobj = $tlpdb->get_package("$collection");
    if (length $tlpobj->shortdesc>30) {
      push @coll_long_desc, $collection;
    } else {
      push @coll_short_desc, $collection;
    }
  }
  my $singlecolumn_index=@coll_short_desc-1;

##<cols=2>
  my $lines=@coll_short_desc/2;
  ++$lines if (@coll_short_desc%2);
  for (0..$lines-1) {
    $index=$_;
    my $collection=$coll_short_desc[$index];
    my $tlpobj = $tlpdb->get_package("$collection");
    $keyval{$keys[$index]}="$collection";
    printf " %s %s %-33s", $keys[$index], button($vars{"$collection"}),
    substr($tlpobj->shortdesc,0,33);
    if (defined $coll_short_desc[$index+$lines]) {
      my $collection=$coll_short_desc[$index+$lines];
      my $tlpobj=$tlpdb->get_package("$collection");
      $keyval{$keys[$index+$lines]}="$collection";
      printf " %s %s %-32s\n", $keys[$index+$lines], 
      button($vars{"$collection"}), substr($tlpobj->shortdesc,0,32);
    } else {
      print "\n";
    }
  }
##</cols=2>
  $index=$singlecolumn_index;
#  print "\n$index\n\n";
  foreach my $collection (@coll_long_desc) {
    my $tlpobj=$tlpdb->get_package("$collection");
    $keyval{$keys[$index+1]}="$collection";
    printf " %s %s %s\n", $keys[$index+1], button($vars{"$collection"}),
    $tlpobj->shortdesc;
    ++$index;
  }
##</cols=1>

  other_options qw(- + R Q);
  my $answer=prompt 'Press key to select collections';

  my @keystrokes=string_to_list $answer;
  
  foreach my $keystroke (@keystrokes) {
    if ($keystroke eq '-') {
      for my $collection (@collections) {
        $vars{"$collection"}=0 if defined $vars{"$collection"};
      }
    }
    if ($keystroke eq '+') {
      for my $collection (@collections) {
        $vars{"$collection"}=1 if defined $vars{"$collection"};
      }
    }
    if (defined $keyval{$keystroke}) {
      toggle "$keyval{$keystroke}";
    }
  }

  if (defined $command{"\u$answer"}) {
    return $command{"\u$answer"}->();
  } else {
    return $command{'self'}->();
  }
}

sub language_menu {
  my %command=(
    'self' => \&language_menu,
    'R' => \&main_menu,
    'Q' => \&quit
      );

  my @languages;
  my @lang_docs;
  my @lang_keys=string_to_list "abcdefghijklmnopstuvwxyz0123456789";
  my @lang_doc_keys=string_to_list "ABCDEFGHIJKLMNOPSTUVWXYZ";
  my %keyval;
  my $lang_index=0;
  my $lang_doc_index=0;
  my $lines;

  menu_head 'Select languages:';

  @languages=sort @collections_lang;
  @lang_docs=sort @collections_lang_doc;

  $lines=@languages/2;
  ++$lines if (@languages%2);
  for my $index (0..$lines-1) {
    my $language=$languages[$index];
    my $tlpobj = $tlpdb->get_package("$language");
    $keyval{$lang_keys[$index]}="$language";
    printf " %s %s %-33s", $lang_keys[$index], button($vars{"$language"}),
    substr($tlpobj->shortdesc,0,33);
    if (defined $languages[$index+$lines]) {
      my $language=$languages[$index+$lines];
      my $tlpobj = $tlpdb->get_package("$language");
      $keyval{$lang_keys[$index+$lines]}="$language";
      printf " %s %s %-33s\n", $lang_keys[$index+$lines], 
      button($vars{"$language"}), substr($tlpobj->shortdesc,0,33);
    } else {
      print "\n";
    }
  }

  print "\nLanguage specific documentation.  Select languages first.\n\n";

  $lines=@lang_docs/2;
  ++$lines if (@lang_docs%2);
  for my $index (0..$lines-1) {
    my $lang_doc=$lang_docs[$index];
    my $tlpobj = $tlpdb->get_package("$lang_doc");
    $keyval{$lang_doc_keys[$index]}="$lang_doc";
    printf " %s %s %-33s", $lang_doc_keys[$index], button($vars{"$lang_doc"}),
    substr($tlpobj->shortdesc,0,33);
    if (defined $lang_docs[$index+$lines]) {
      my $lang_doc=$lang_docs[$index+$lines];
      my $tlpobj = $tlpdb->get_package("$lang_doc");
      $keyval{$lang_doc_keys[$index+$lines]}="$lang_doc";
      printf " %s %s %-33s\n", $lang_doc_keys[$index+$lines], 
      button($vars{"$lang_doc"}), substr($tlpobj->shortdesc,0,33);
    } else {
      print "\n";
    }
  }

  other_options qw (+ - R Q);
  my $answer=prompt 'Press key to select language';

  my @keystrokes=string_to_list $answer;
  
  foreach my $keystroke (@keystrokes) {
    if ($keystroke eq '-') {
      for my $collection (@languages,@lang_docs) {
        $vars{"$collection"}=0 if defined $vars{"$collection"};
      }
    }
    if ($keystroke eq '+') {
      for my $collection (@languages,@lang_docs) {
        $vars{"$collection"}=1 if defined $vars{"$collection"};
      }
    }
    if (defined $keyval{$keystroke}) {
      toggle "$keyval{$keystroke}";
    }
  }

  if (defined $keyval{"$answer"}) {
    $vars{'selected_scheme'}=$keyval{"$answer"};
    return $command{'self'}->();
  }
  if (defined $command{"\u$answer"}) {
    return $command{"\u$answer"}->();
  } else {
    return $command{'self'}->();
  }
}


sub directories_menu {
  my %command=(
    'self' => \&directories_menu,
    'R' => \&main_menu,
    'Q' => \&quit
      );

  menu_head "Current directories setup:";
  print <<"EOF";
  <1>  TEXDIR:       $vars{'TEXDIR'}
       support tree: $vars{'TEXDIR'}/texmf

  <2>  TEXMFLOCAL:   $vars{'TEXMFLOCAL'}
  <3>  TEXMFSYSVAR:  $vars{'TEXMFSYSVAR'}
  <4>  TEXMFHOME:    $vars{'TEXMFHOME'}
EOF
;

  other_options qw (R Q);
  my $answer=prompt 'Enter command';

  if ("\u$answer" eq '1') {
    print "New value TEXDIR [$vars{'TEXDIR'}]: ";
    chomp($answer=<STDIN>);
    $vars{'TEXDIR'}="$answer" if (length $answer);
    $vars{'TEXDIR'}=~s@\\@/@g if (win32);
    if ($vars{'TEXDIR'}=~/^(.*)\/texlive\/$texlive_release$/) {
      $vars{'TEXMFLOCAL'}="$1/texlive/texmf-local";
      $vars{'TEXMFSYSVAR'}="$1/texlive/$texlive_release/texmf-var";
      return $command{'self'};
    }
  }
  if ("\u$answer" eq '2') {
    print "New value TEXMFLOCAL [$vars{'TEXMFLOCAL'}]: ";
    chomp($answer=<STDIN>);
    $vars{'TEXMFLOCAL'}="$answer" if (length $answer);
    $vars{'TEXMFLOCAL'}=~s@\\@/@g if (win32);
    return $command{'self'};
  }
  if ("\u$answer" eq '3') {
    print "New value TEXMFSYSVAR [$vars{'TEXMFSYSVAR'}]: ";
    chomp($answer=<STDIN>);
    $vars{'TEXMFSYSVAR'}="$answer" if (length $answer);
    $vars{'TEXMFSYSVAR'}=~s@\\@/@g if (win32);
    return $command{'self'};
  }
  if ("\u$answer" eq '4') {
    print "New value TEXMFHOME [$vars{'TEXMFHOME'}]: ";
    chomp($answer=<STDIN>);
    $vars{'TEXMFHOME'}="$answer" if (length $answer);
    $vars{'TEXMFHOME'}=~s@\\@/@g if (win32);
    return $command{'self'};
  }

  if (defined $command{"\u$answer"}) {
    return $command{"\u$answer"}->();
  } else {
    return $command{'self'}->();
  }
}


sub options_menu {
  my $b_symlinks=button($vars{'option_symlinks'});
  my $b_doc=button($vars{'option_doc'});
  my $b_src=button($vars{'option_src'});

  my $sys_bin=$vars{'sys_bin'};
  my $sys_man=$vars{'sys_man'};
  my $sys_info=$vars{'sys_info'};

  my $t_sys_bin=($vars{'option_symlinks'})? $vars{'sys_bin'}:'';
  my $t_sys_man=($vars{'option_symlinks'})? $vars{'sys_man'}:'';
  my $t_sys_info=($vars{'option_symlinks'})? $vars{'sys_info'}:'';

  my %command=(
    'self' => \&options_menu,
    'R' => \&main_menu,
    'Q' => \&quit
      );

  clear_screen;
  menu_head "Current options setup:";

  if (unix) {
    print <<"EOF";
 <L> create symlinks in standard directories:               $b_symlinks
            binaries to: $t_sys_bin
            manpages to: $t_sys_man
                info to: $t_sys_info
EOF
;
  }
  print <<"EOF";
 <D> install font/macro doc tree:    $b_doc
 <S> install font/macro source tree: $b_src
EOF
;

  other_options qw(R Q);
  my $answer=prompt 'Enter command';

  if (unix) {
    if ("\u$answer" eq 'L') {
      toggle 'option_symlinks';
      if ($vars{'option_symlinks'}) {
        print "New value for binary directory [$sys_bin]: ";
        chomp($answer=<STDIN>);
        $vars{'sys_bin'}="$answer" if (length $answer);
        
        if ($vars{'sys_bin'}=~/^(.*)\/bin$/) {
          $vars{'sys_man'}="$1/man";
          $vars{'sys_info'}="$1/info";
        }
        print "New value for man directory    [$vars{'sys_man'}]: ";
        chomp($answer=<STDIN>);
        $vars{'sys_man'}="$answer" if (length $answer);
        
        print "New value for info directory   [$vars{'sys_info'}]: ";
        chomp($answer=<STDIN>);
        $vars{'sys_info'}="$answer" if (length $answer);
      }
      return $command{'self'};
    }
  }
  if ("\u$answer" eq 'S') {
    toggle 'option_src';
    return $command{'self'};
  }
  if ("\u$answer" eq 'D') {
    toggle 'option_doc';
    return $command{'self'};
  }
  if (defined $command{"\u$answer"}) {
    return $command{"\u$answer"};
  } else {
    return $command{'self'};
  }
}


sub quit {
  dump_vars './vars';
  exit 0;
}

sub main_menu {
  my $this_platform=platform_desc($vars{'this_platform'});

  my $b_symlinks=button($vars{'option_symlinks'}); 
  my $b_doc=button($vars{'option_doc'}); 
  my $b_src=button($vars{'option_src'}); 

  my $warn_nobin;

  $vars{'n_systems_available'}=0;
  for my $key (keys %vars) {
    ++$vars{'n_systems_available'} if ($key=~/^(disk|net)bin/);
  }

  $warn_nobin=set_install_platform;

  $vars{'n_systems_selected'}=0;
  $vars{'n_collections_selected'}=0;
  foreach my $key (keys %vars) {
    if ($key=~/^diskbin.*/ or $key=~/^netbin.*/) {
      ++$vars{'n_systems_selected'} if $vars{$key}==1;
    }
    if ($key=~/^collection/) {
      ++$vars{'n_collections_selected'} if $vars{$key}==1;
    }
  }
  calc_depends;

  my %command=(
    'self' => \&main_menu,
    'P' => \&platform_menu,
    'O' => \&options_menu,
    'I' => \&install,
    'C' => \&collection_menu,
    'L' => \&language_menu,
    'D' => \&directories_menu,
    'S' => \&scheme_menu,
    'B' => \&binary_menu,
    'Q' => \&quit
      );

  clear_screen;
  
  print <<"EOF";
======================> TeX Live installation procedure <=====================

=======> Note: Letters/digits in <angle brackets> indicate menu items <=======
=======>       for commands or configurable options                   <=======

 Proposed platform: $this_platform
 $warn_nobin
 <B> binary systems: $vars{'n_systems_selected'} out of $vars{'n_systems_available'}

 <S> Installation scheme ($vars{'selected_scheme'})

 Customizing installation scheme:
   <C> standard collections
   <L> language collections
   $vars{'n_collections_selected'} collections out of $vars{'n_collections_available'}, disk space required: $vars{'total_size'} MB

 <D> directories:
   TEXDIR      (The main TeX directory)        : $vars{'TEXDIR'}     
   TEXMFLOCAL  (Directory for local styles etc): $vars{'TEXMFLOCAL'}
   TEXMFSYSVAR (Directory for local config)    : $vars{'TEXMFSYSVAR'}

 <O> options:
EOF
;
   print <<"EOF" if (unix);
   $b_symlinks create symlinks in standard directories
EOF
;
print <<"EOF";
   $b_doc install macro/font doc tree
   $b_src install macro/font source tree
EOF
;

  other_options qw (I H Q);
  my $answer=prompt 'Enter command';

#  chomp(my $answer=<STDIN>);
  if (defined $command{"\u$answer"}) {
    return $command{"\u$answer"};
  } else {
    return $command{'self'};
  }
}



sub create_profile {
  # 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.    
  open PROFILE, ">$profilepath/texlive.profile";
  print PROFILE "selected_scheme $vars{selected_scheme}\n";
  foreach my $key (keys %vars) {
    print PROFILE "$key $vars{$key}\n"
        if $key=~/^collection/ and $vars{$key}==1;
    print PROFILE "$key $vars{$key}\n" if $key=~/^option_doc/;
    print PROFILE "$key $vars{$key}\n" if $key=~/^option_src/;
    print PROFILE "$key $vars{$key}\n" if $key=~/^option_symlinks/;
  }
  close PROFILE;
}


load_tlpdb;
set_platforms_supported;
set_texlive_default_dirs;
initialize_collections;
set_install_platform;
run_menu;
calc_depends;


dump_vars './vars';
$profilepath='.';
create_profile;
print "Profile written to $profilepath/texlive.profile\n";

__END__

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