TLUtils.pm: fixed $0 for Windows and architectures stuff.

install-tl.pl: Menus, platform detection, dependencies...


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

1 files changed, 43 insertions, 43 deletions

diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 43eeaad84f1..a4144fa0d8a 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -46,8 +46,8 @@ C<TeXLive::TLUtils> -- Utilities used in the TeX Live Infrastructure Modules
 
   TeXLive::TLUtils::media;
   TeXLive::TLUtils::initialze_installer;
-  TeXLive::TLUtils::binaries_available_from_disk;
-  TeXLive::TLUtils::binaries_available_from_net;
+  TeXLive::TLUtils::architectures_available;
+  TeXLive::TLUtils::additional_architectures_available_from_net;
   TeXLive::TLUtils::make_var_skeleton($path);
   TeXLive::TLUtils::make_local_skeleton($path);
 
@@ -85,8 +85,8 @@ BEGIN {
     &copy
     &media
     &initialize_installer
-    &binaries_available_from_disk
-    &binaries_available_from_net
+    &architectures_available
+    &additional_architectures_available_from_net
     &make_var_skeleton
     &sub make_local_skeleton
     &sort_uniq
@@ -104,9 +104,9 @@ BEGIN {
 
 =item C<platform>
 
-If the directory C</usr/bin> doesn't exist we know that we're on
+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>.
-If it exists we call C<config.guess>.  The output of C<config.guess>
+Otherwise we call C<config.guess>.  The output of C<config.guess>
 is filtered as described below.
 
 CPU type is determined by a regexp.  And it's necessary to
@@ -131,7 +131,9 @@ sub platform {
              solaris); 
 
   unless (defined $::_platform_) {
-    if (-d "/usr/bin") {
+    if ($^O=~/^MSWin(32|64)$/i) {
+      $::_platform_="win32";
+    } else {
       my $CPU; # CPU type as reported by config.guess.
       my $OS;  # O/S type as reported by config.guess.
       # We cannot rely on #! in config.guess but have to call /bin/sh
@@ -150,8 +152,6 @@ sub platform {
         ($OS=$guessed_platform)=~s/.*-(.*)/$1/;
       }
       $::_platform_="$CPU-$OS";
-    } else {
-      $::_platform_="win32";
     }
   }
   return $::_platform_;
@@ -436,17 +436,11 @@ sub copy {
   @stat=lstat "$infile";
   $mode=$stat[2];
   
-  # set write bit for user if necessary.
-  #$mode+=128 if ($mode%256<128);
-
   mkdirhier ("$destdir") unless -d "$destdir";
 
   $filename=basename "$infile";
   $outfile="$destdir/$filename";
   
-#    print "copy $infile => $outfile\n";
-#    print "$infile\n";
-  
   if (-l "$infile") {
     symlink readlink "$infile", "$destdir/$filename";
   } else {
@@ -515,74 +509,80 @@ which tl-install.pl resides (which is C<`dirname $0`> on UNIX).  Then
 it calls C<media> and C<platform> in order to set the variables
 C<$::_media_> and C<$::_platform_>.
 
+Note that C<$0> contains backslashes as path separators on Windows.
+
 Repeatedly calls to C<media> or C<platform> do not access the CD/DVD
 again.
 
 =cut
 
 sub initialize_installer {
-  ($::_installerdir_=$0)=~s/(.*)\/.*$/$1/;
+  my $me=$0;
+  $me=~s!\\!/!g if $^O=~/^MSWin(32|64)$/i;
+  ($::_installerdir_=$me)=~s!(.*)/.*$!$1!;
   &media;
   &platform;
 }
 
 =pod
 
-=item C<binaries_available_from_disk>
+=item C<architectures_available>
 
-The function C<binaries_available_from_disk> returns a list of
-supported platforms.  Media type has to be either C<CD> or C<DVD>.
+The function C<architectures_available> returns a list of
+supported platforms.
 
 =cut
 
-sub binaries_available_from_disk {
+sub architectures_available {
   my @dir;
   my @platforms;
 	if (&media eq "CD") {
     opendir DIR, "$::_installerdir_/archive";
-  } elsif (&media eq "DVD") {
-    opendir DIR, "$::_installerdir_/bin";
-  } else {
-    die "Media type must be CD or DVD.\n";
-  }
-  @dir=readdir DIR;
-  chomp @dir;
-  if (&media eq "CD") {
+    @dir=readdir DIR;
+    chomp @dir;
     for (@dir) {
       if (/bin-kpathsea.(.*).zip$/) {
         push @platforms, $1;
       }
     }
   } elsif (&media eq "DVD") {
+    opendir DIR, "$::_installerdir_/bin";
+    @dir=readdir DIR;
+    chomp @dir;
     for my $platform (@dir) {
       push @platforms, $platform unless ($platform=~/^\./);
     }
   } else {
-    die "Media type must be CD or DVD.\n";
+    foreach my $arch ($::tlpdb->available_architectures) {
+      push @platforms, $arch;
+    }
   }
   return @platforms;
 }
-  
+ 
 =pod
 
-=item C<binaries_available_from_net>
+=item C<additional_architectures_available_from_net (\%vars)>
 
-The function C<binaries_available_from_net> returns a list of
-platforms supported by the TeX Live server.  It downloads the file
-C<$::texlive_url/texlive.tlpdb> and looks for files
-C</^bin\/(.*)\/kpsewhich/>.
+The function C<additional_architectures_available_from_net> returns a
+list of additional platforms supported by the TeX Live server.  It
+downloads the file C<$::texlive_url/texlive.tlpdb> and creates a new
+object c<$::tlpdb_netbin>.  The argument is a reference of the global
+C<%vars> hash.
 
 =cut
                
-sub binaries_available_from_net {
+sub additional_architectures_available_from_net {
+  my $vars=shift;
   my @platforms;
-  open TLPDB, "wget -q --output-document=- $::texlive_url/texlive.tlpdb|"
-       or die "Can't open $::texlive_url/texlive.tlpdb";
-  while (<TLPDB>) {
-    if (/^ bin\/(.*)\/kpsewhich/) {
-      push @platforms, $1;
-    }
-  }
+  my $database="$::texlive_url/texlive.tlpdb";
+  print "\nLoading '$database' ...\n";
+  $::tlpdb_netbin=TeXLive::TLPDB->new(location => "$database");
+   foreach my $arch ($::tlpdb_netbin->available_architectures) {
+     unless (defined $vars->{"diskbin_$arch"}) {
+       push @platforms, $arch;
+     }
+   }
   return @platforms;
 }