summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-04-19 10:22:03 +0000
committerNorbert Preining <preining@logic.at>2008-04-19 10:22:03 +0000
commitae800c9ec7b6edbb316da1a84bb10161410302f6 (patch)
treebc1faa709fefb32faf2e83950bb0e33faaefe3d9
parentba27f568a1af1d55353f4deb35d9d839fc762287 (diff)
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
-rw-r--r--Master/tlpkg/TeXLive/TLConfig.pm7
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm46
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm81
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;