2 big changes:

- tlpdb initialization tries the lzma compressed one from the net
- download_file honors $TL_DOWNLOAD_PROG and $TL_DOWNLOAD_ARGS


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

3 files changed, 82 insertions, 52 deletions

diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm
index f7dbc6c8cda..557098e1163 100644
--- a/Master/tlpkg/TeXLive/TLConfig.pm
+++ b/Master/tlpkg/TeXLive/TLConfig.pm
@@ -25,6 +25,7 @@ BEGIN {
     $DiskArchive
     $TeXLiveURL
     $TeXLiveAlternativeURL
+    $DefaultWgetArgs
   );
   @EXPORT = @EXPORT_OK;
 }
@@ -61,6 +62,12 @@ our $TeXLiveAlternativeURL;
 #our $TeXLiveURL = 'http://mirror.ctan.org/systems/texlive/tlnet/2008';
 #our $TeXLiveAlternativeURL = 'http://www.ctan.org/systems/texlive/tlnet/2008';
 
+
+# defualt wget args
+# we assume that the FIRST argument given AFTER the default args is the 
+# destination, ie where to put the file!
+our $DefaultWgetArgs = "--tries=2 --timeout=60 -q -O";
+
 1;
 
 
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 857d4370b81..ad97970de46 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -54,7 +54,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
 
 use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
       $DatabaseName $MetaCategoriesRegexp);
-use TeXLive::TLUtils qw(dirname mkdirhier tllog member);
+use TeXLive::TLUtils qw(dirname mkdirhier tllog member win32);
 use TeXLive::TLPOBJ;
 
 my $_listdir;
@@ -184,11 +184,45 @@ sub from_file {
   my $retfh;
   if ($path =~ /^(http|ftp):\/\//) {
     tllog($::LOG_DDDEBUG, "TLPDB.pm: trying to initialize from $path\n");
-    $retfh = TeXLive::TLUtils::download_file($path, "|");
-    #open(TMP, "wget -q --output-document=- $path|") 
-    #   || die("Cannot open tlpdb file: $path"); 
-    if (!$retfh) {
-      die("Cannot open tlpdb file: $path");
+    # if we have lzmadec available we try the lzma file
+    if (defined($::progs{'lzmadec'})) {
+      # we first try the lzma compressed file
+      my $tmpdir = TeXLive::TLUtils::get_system_tmpdir();
+      my $bn = TeXLive::TLUtils::basename("$path");
+      my $lzmafile = "$tmpdir/$bn.lzma";
+      my $lzmafile_quote = $lzmafile;
+      my $tlpdbfile = "$tmpdir/$bn";
+      my $tlpdbfile_quote = $tlpdbfile;
+      if (win32()) {
+        $lzmafile  =~ s!/!\\!g;
+        $tlpdbfile =~ s!/!\\!g;
+      }
+      $lzmafile_quote = "\"$lzmafile\"";
+      $tlpdbfile_quite = "\"$tlpdbfile\"";
+      tllog($::LOG_DEBUG, "trying to download $path.lzma to $lzmafile\n");
+      my $ret = TeXLive::TLUtils::download_file("$path.lzma", "$lzmafile");
+      # better to check both, the return value AND the existence of the file
+      if ($ret && (-r "$lzmafile")) {
+        # ok, let the fun begin
+        tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tlpdbfile\n");
+        system("$::progs{'lzmadec'} < $lzmafile_quote > $tlpdbfile_quote");
+        if (! -r $tlpdbfile) {
+          tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile did not succeed, try normally\n");
+        } else {
+          unlink($lzmafile);
+          open $retfh, "<$tlpdbfile" or die"Cannot open $tlpdbfile!";
+          tllog($::LOG_DEBUG, "Ok, found the uncompressed lzma file!\n");
+        }
+      }
+    } else {
+      tllog($::LOG_DEBUG, "no lzmadec defined, not trying tlpdb.lzma ...\n");
+    }
+    if (!defined($retfh)) {
+      # lzma did not succeed, so try the normal file
+      $retfh = TeXLive::TLUtils::download_file($path, "|");
+      if (!$retfh) {
+        die("Cannot open tlpdb file: $path");
+      }
     }
   } else {
     open(TMP,"<$path") || die("Cannot open tlpdb file: $path");
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 4e7b187e4ce..988562b6ba8 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -712,9 +712,10 @@ sub setup_programs {
 Try to download the file given in C<$relpath> from either C<$TeXLiveURL>
 or C<TeXLiveAlternativeURL> into C<$destination> (a filename!). 
 
-The optional argument C<$progs> is a hash giving full pathes to the 
-respective programs, at least C<wget>. In case that C<$progs> is not given
-the C<%::progs> is consulted, and if this also does not exist we try "wget".
+The optional argument C<$progs> is a reference to a hash giving full pathes 
+to the respective programs, at least C<wget>. In case that C<$progs> is not
+given the C<%::progs> is consulted, and if this also does not exist we
+try "wget".
 
 =cut
 
@@ -729,67 +730,55 @@ sub download_file {
     warn ("Programs have not been set up, trying simply wget");
     $wget = "wget";
   }
-  if (win32()) {
-    $dest =~ s!/!\\!g;
-  }
   my $url;
   if ($relpath =~ /^(http|ftp):\/\//) {
     $url = $relpath;
   } else {
     $url = "$TeXLiveURL/$relpath";
   }
+  my $ret = _download_file($url, $dest, $wget);
+  return($ret) if $ret;
+  # if we have a full url given do NOT try an alternative url
+  if ($relpath =~ /^(http|ftp):\/\//) {
+    # we did get a full url, give up immediately
+    return undef;
+  }
+  # we are still here ... try it with Alternative URL:
+  return undef unless ($TeXLiveAlternativeURL);
+  # we are still here and TeXLiveAlternativeURL is defined
+  $url = "$TeXLiveAlternativeURL/$relpath";
+  $ret = _download_file($url, $dest, $wget);
+  return($ret) if $ret;
+  # still not found, give up
+  return undef;
+}
+
+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"} || $DefaultWgetArgs;
+
 
   tllog($::LOG_DEBUG, "Trying to download $url\n");
   my $ret;
   if ($dest eq "|") {
-    open(RETFH, "$wget --tries=2 --timeout=60 -q --output-document=- $url|") or 
+    open(RETFH, "$wget $wgetargs - $url|") or 
       die("Cannot open $url via wget for reading");
     # opening to a pipe always succeeds, so we return immediately
     return \*RETFH;
   } else {
-    $ret = system $wget, "-q", "--tries=2", "--timeout=60", "-O", $dest, $url;
+    my @wgetargs = split ' ', $wgetargs;
+    $ret = system $wget, @wgetargs, $dest, $url;
     # we have to reverse the meaning of ret because systems returns
     # the inverse
     $ret = ($ret ? 0 : 1);
   }
-  if (!$ret) {
-    tllog($::LOG_DEBUG, "Download/Opening $url did not succeed\n");
-    if ($relpath =~ /^(http|ftp):\/\//) {
-      # we did get a full url, give up immediately
-      return undef;
-    }
-
-    # First we try the alternative URL
-    if ($TeXLiveAlternativeURL) {
-      $url = "$TeXLiveAlternativeURL/$relpath";
-      tllog($::LOG_DEBUG, "Trying to download $url\n");
-      if ($dest eq "|") {
-        open(RETFH, "$wget --tries=2 --timeout=60 -q --output-document=- $url|") or
-          die("Cannot open $url via wget for reading");
-        # opening to a pipe always succeeds, so we return immediately
-        return \*RETFH;
-      } else {
-        $ret = system $wget, "-q", "--tries=2", "--timeout=60", "-O", $dest, $url;
-        if ($ret) {
-          $ret = 0;
-        }
-      }
-      if ($ret) {
-        # ok, we give up
-        tllog($::LOG_DEBUG, "Download/Open $url did not succeed, giving up\n");
-        return;
-      } else {
-        tllog($::LOG_DEBUG, "Download/Open $url did succeed\n");
-        if ($dest eq "|") {
-          return \*RETFH;
-        } else {
-          return 1;
-        }
-      }
-    }
-    # could we try something else?
-    return undef;
-  }
+  # return false/undef in case the download did not succeed.
+  return ($ret) unless $ret;
   tllog($::LOG_DEBUG, "Download $url did succeed\n");
   if ($dest eq "|") {
     return \*RETFH;