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

BEGIN {
  $^W = 1;
  ($thisdir=$0)=~s/(.*)\/.*/$1/;
  unshift (@INC, "$thisdir/tlpkg");
}

use TeXLive::TLUtils qw(initialize_installer media platform platform_desc
   which getenv win32 unix program_exists binaries_available_from_disk
   binaries_available_from_net get_system_tmpdir);
use TeXLive::TLPOBJ;
use TeXLive::TLPDB;

###$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 {
   open VARS, ">./vars";
   foreach $key (keys %vars) {
      print VARS "$key $vars{$key}\n";
   }
   close VARS;
   print "\n%vars dumped to ./vars.\n";
}


# Determine which platforms are supported.  This code should be
# revised later.
$trynet=0;
sub set_platforms_supported {
   $vars{'n_systems_available'}=0;
   if (media=~/(CD|DVD)/) {
      my @binaries=binaries_available_from_disk;
      for my $binary (@binaries) {
         unless (defined $vars{"diskbin_$binary"}) {
            $vars{"diskbin_$binary"}=0;
            ++$vars{'n_systems_available'};
         }
      }
   }
   if (media eq 'NET' or $trynet==1) {
      print "\n\nLoading '$texlive_url/texlive.tlpdb' ...\n";
      my @binaries=binaries_available_from_net;
      for my $binary (@binaries) {
         unless (defined $vars{"diskbin_$binary"}) {
            $vars{"netbin_$binary"}=0; 
            ++$vars{'n_systems_available'};
         }
      }
   }
}

# 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,
        'o_altfontdir' => 0,
        'altfontdir' => "$system_tmpdir/texfonts",
        'o_symlinks' => 0,
        'sys_bin' => '/usr/local/bin',
        'sys_man' => '/usr/local/man',
        'sys_info' => '/usr/local/info',
        'o_doc' => 1,
        'o_src' => 1,
        'selected_scheme' => 'scheme-full',
    );


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 {
   print "\nOther options:\n", hbar, " <R> return to main menu\n <Q> quit\n\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");
}


# If we are on the CD and we want to download binaries for additional
# platforms, we need a second database which provides information
# about binary systems which can be downloaded from net but are not on
# the DVD, at least if we decide to support this.
#sub load_tlpdb_net {
#   my $database;
#   $database='http://www.tug.org/svn/texlive/trunk/Master/texlive.tlpdb';
#   $::tlpdb_net=TeXLive::TLPDB->new(location => "$database");
#}


# 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 (1) {
      $menu=$menu->();
   }
}


# Not yet implemented.  Will probably go away.
sub platform_menu {
   my %command=(
      'self' => \&platform_menu,
      'R' => \&main_menu,
      'Q' => \&quit
       );
   print "<<<<< PLATFORM MENU >>>>>>\n";

   return $command{'R'}->();    
}


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

   $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" .
          "\nOther Options:\n", hbar, " <-> deselect all\n" . 
          " <+> select all\n <N> add binaries from net\n" .
          " <R> return to main menu\n <Q> quit\n";
   } else {
      print "\n Network access is required to install binary systems " .
          "marked with '*'.\n" if (media eq 'CD');
      print    "\nOther Options:\n", hbar, " <-> deselect all\n". 
          " <+> select all\n <R> return to main menu\n <Q> quit\n";
   }

   print "\n Press key to select/deselect binary systems: ";
      
   chomp(my $answer=<STDIN>);
   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 "abcdefghijklmopstuvwxyz";
   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";
      printf " %s %s %s\n", $keys[$index], button($vars{"$scheme"}),
      $scheme;
      ++$index;
   }

   foreach $entry (keys %vars) {
      if ($entry=~/^inst-(Documentation|Package|TLCore)/) {
         $vars{"$entry"}=0;
      }
   }

   my $scheme_tlpobj = $tlpdb->get_package($vars{'selected_scheme'});
   if (defined ($scheme_tlpobj)) {
      foreach my $dependent ($scheme_tlpobj->depends) {
         $vars{"inst-$dependent"}=1;
      }
   }
   
   other_options;
   print 'Press key to select a scheme: ';

   chomp(my $answer=<STDIN>);

   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 {
   print "<<<<< COLLECTION MENU >>>>>>\n";
}

sub language_menu {
   print "<<<<< LANGUAGE MENU >>>>>>\n";
}


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;
   print 'Enter command: ';

   chomp(my $answer=<STDIN>);

   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_altfontdir=button($vars{'o_altfontdir'});
   my $b_symlinks=button($vars{'o_symlinks'});
   my $b_doc=button($vars{'o_doc'});
   my $b_src=button($vars{'o_src'});

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

   my $t_altfontdir=($vars{'o_altfontdir'})? $vars{'altfontdir'}:'';
   my $t_sys_bin=($vars{'o_symlinks'})? $vars{'sys_bin'}:'';
   my $t_sys_man=($vars{'o_symlinks'})? $vars{'sys_man'}:'';
   my $t_sys_info=($vars{'o_symlinks'})? $vars{'sys_info'}:'';

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

   clear_screen;
   menu_head "Current options setup:";

   print <<"EOF";
 <A> alternate directory for automatically generated fonts: $b_altfontdir
         directory name: $t_altfontdir
EOF
;
   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;
   print 'Enter command: ';

   chomp(my $answer=<STDIN>);
   if ("\u$answer" eq 'A') {
      toggle 'o_altfontdir';
      if ($vars{'o_altfontdir'}) {
         print "New value for alternate directory [$altfontdir]: ";
         chomp($answer=<STDIN>);
         $vars{'altfontdir'}="$answer" if (length $answer);
      }
      return $command{'self'};
   }
   if (unix) {
      if ("\u$answer" eq 'L') {
         toggle 'o_symlinks';
         if ($vars{'o_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 'o_src';
      return $command{'self'};
   }
   if ("\u$answer" eq 'D') {
      toggle 'o_doc';
      return $command{'self'};
   }
   if (defined $command{"\u$answer"}) {
      return $command{"\u$answer"};
   } else {
      return $command{'self'};
   }
}

sub install {
   print "<<<<< install >>>>>>\n";
}

sub quit {
   dump_vars;
   exit 0;
}

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

   my $b_symlinks=button($vars{'o_symlinks'}); 
   my $b_altfontdir=button($vars{'o_altfontdir'}); 
   my $b_doc=button($vars{'o_doc'}); 
   my $b_src=button($vars{'o_src'}); 
   my $t_altfontdir=($vars{'o_altfontdir'})? "($vars{'altfontdir'})":'';

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

   my %command=(
      'self' => \&main_menu,
      'P' => \&platform_menu,
      'O' => \&options_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
 <P> over-ride system detection and choose platform
 <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'} 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:
   $b_altfontdir alternate directory for generated fonts $t_altfontdir
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
 <I> start installation
 <H> help,  <Q> quit
EOF
;

   print 'Enter command: ';

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


load_tlpdb;
set_platforms_supported;
set_texlive_default_dirs;
run_menu;

__END__

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