update to download-package-repository script: options, help and activation only upon successful completion

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

4 files changed, 230 insertions, 100 deletions

diff --git a/Master/tlpkg/dev/download-package-repository b/Master/tlpkg/dev/download-package-repository
new file mode 100644
index 00000000000..97c78ac655c
--- /dev/null
+++ b/Master/tlpkg/dev/download-package-repository
@@ -0,0 +1,216 @@
+#!/usr/bin/env perl
+
+#
+# Originally written by T.M.Trzeciak in 2010
+#
+# Purpose: create/update a local package repository
+# How to use: place it tlpkg/installer and run
+#
+
+our $Master;
+our $location;
+
+BEGIN {
+  $^W = 1;
+  $Master = __FILE__;
+  $Master =~ s;\\;/;g if ($^O =~ /^MSWin/i);
+  $Master =~ s;/[^/]*$;/../..; unless ($Master =~ s;(/[^/]*){3,3}$;;i);
+  unshift (@INC, "$Master/tlpkg");
+  $::installerdir = $Master;
+  $::localrepo = $Master;
+  # $::localrepo = '.';
+  # $Master = $ENV{"TLINSTALLERDIR"};
+  # print "$Master\n";
+}
+
+use TeXLive::TLPDB;
+use TeXLive::TLPOBJ;
+use TeXLive::TLConfig;
+use TeXLive::TLUtils;
+use TeXLive::TLDownload;
+use Getopt::Long;
+use Pod::Usage;
+use File::Path;
+use Cwd;
+
+TeXLive::TLUtils::process_logging_options();
+
+my $opt_location;
+my $opt_destination;
+my $opt_persistent_downloads = 1;
+my $opt_help = 0;
+
+GetOptions(
+           "location|url|repository|repo=s" => \$opt_location,
+           # "destination=s"  => \$opt_destination,
+           "persistent-downloads!"      => \$opt_persistent_downloads,
+           "?|h|help"         => \$opt_help) or pod2usage(1);
+if ($opt_help) {
+  my @noperldoc = ("-noperldoc", "1") if ($^O =~ /^MSWin/i);
+  pod2usage(-exitstatus => 0, -verbose => 2, @noperldoc);
+}
+
+&main();
+
+sub main {
+  if ( !setup_programs( "$::installerdir/$InfraLocation/installer", 
+                         TeXLive::TLUtils::platform() ) ) {
+    die "$0: failed to set up necessary programs.\n";
+  }
+  if ($opt_persistent_downloads) {
+    TeXLive::TLUtils::setup_persistent_downloads() ;
+  }
+  $location = defined($opt_location) ? $opt_location :
+    TeXLive::TLUtils::give_ctan_mirror();
+  if (!defined($location)) {
+    die("$0: failed to obtain repository location.\n");
+  }
+  $::localrepo = $opt_destination if defined($opt_destination);
+  if ( $location eq $::localrepo ) {
+    die "destination and remote repository cannot be the same: $location";
+  }
+  
+  info("cloning package repository from $location\n");
+  if (!-d "$::localrepo/$InfraLocation" ) {
+    mkdir("$::localrepo/$InfraLocation") ||
+      die "$0: cannot create directory $::localrepo/$InfraLocation: $!";
+  }
+  my $tlpdbfile = "$InfraLocation/$DatabaseName";
+  my $tlpdbpacked = "$tlpdbfile.$DefaultContainerFormat";
+  my $md5there;
+  download_file("$location/$tlpdbfile.md5", "$::localrepo/$tlpdbfile.md5");
+  open MD5FILE, "$::localrepo/$tlpdbfile.md5" or 
+    die "cannot open $::localrepo/$tlpdbfile.md5: $!";
+  if (read (MD5FILE, $md5there, 32) != 32) {
+    die "cannot download remote TeX Live database from $location.\n";
+  }
+  close MD5FILE;
+  my $md5here = (!-r "$::localrepo/$tlpdbfile") ? "" : 
+                 TeXLive::TLUtils::tlmd5("$::localrepo/$tlpdbfile");
+  # debug("md5 hash mismatch\n") if ($md5there ne $md5here);
+  if ($md5there ne $md5here) {
+    download_file("$location/$tlpdbpacked", "$::localrepo/$tlpdbpacked");
+    if ( system("$::progs{'xzdec'} <\"$::localrepo/$tlpdbpacked\" >\"$::localrepo/$tlpdbfile\"") ) {
+      die "cannot decompress $::localrepo/$tlpdbpacked\n";
+    }
+  }
+
+  my $tlpdb = TeXLive::TLPDB->new ("root" => $::localrepo);
+  if ( !defined($tlpdb) ) {
+    die "unusable repository database at $location\n";
+  }
+  
+  $::archivedir = "__ARCHIVE__";
+  if (-d "$::localrepo/$Archive") {
+    rename("$::localrepo/$Archive", "$::archivedir") ||
+      die "unable to rename $::localrepo/$Archive: $!";
+  }
+  if (!-d "$::localrepo/$::archivedir") {
+    mkdir("$::localrepo/$::archivedir") ||
+      die "$0: could not create directory $::localrepo/$::archivedir: $!";
+  }
+  my $pkg_count = 0;
+  for my $pkgname ($tlpdb->list_packages) {
+    next if $pkgname =~ /^00texlive/;
+    my $tlp = $tlpdb->get_package($pkgname);
+    $pkg_count += get_container("$pkgname", $tlp->containermd5() );
+    get_container("$pkgname.doc", $tlp->doccontainermd5() ) 
+      if ($tlp->docfiles());
+    get_container("$pkgname.source", $tlp->srccontainermd5() ) 
+      if ($tlp->srcfiles());
+    # last if ($pkg_count > 2); # stop for testing
+  }
+  rename("$::localrepo/$::archivedir", "$Archive") ||
+    die "unable to rename $::localrepo/$::archivedir: $!";
+
+  sub get_container {
+    my ($pkgname, $md5there) = @_;
+    my $pkgcontainerfile = "$pkgname.$DefaultContainerExtension";
+    my $localfile = "$::localrepo/$::archivedir/$pkgcontainerfile";
+    my $remotefile = "$location/$Archive/$pkgcontainerfile";
+    if (!-r "$localfile" || 
+        TeXLive::TLUtils::tlmd5("$localfile") ne $md5there ) {
+      print("downloading $pkgname\n");
+      download_file("$remotefile", "$localfile");
+      # check downloaded file
+      my $md5here = TeXLive::TLUtils::tlmd5("$localfile");
+      die "md5 sum mismatch for package $pkgname:
+        database:  $md5there
+        dowloaded: $md5here\n" if ($md5here ne $md5there);
+      return 1;
+    }
+    # info("package container up to date: $pkgcontainerfile\n");
+    print("OK: $pkgname\n");
+    return 0;
+  }
+
+}
+
+__END__
+=head1 NAME
+
+download-package-repository - creates a local package repository
+
+=head1 SYNOPSIS
+
+download-package-repository [OPTION]...
+
+=head1 OPTIONS
+
+=item B<-repository> I<url|path>
+
+Remote package repository to be used as a source for the creation of 
+the local package repository.  This can be either a local directory via 
+C</path/to/directory> or a C<file:/> url, or a network location via 
+a C<http://> or C<ftp://> url. (No other protocols are supported.)
+
+The default is to pick a mirror automatically, using
+L<http://mirror.ctan.org/systems/texlive/tlnet>; the chosen mirror is
+used for the entire download.  See L<http://ctan.org> for more about CTAN
+and its mirrors.
+
+If the repository is on the network, trailing C</> characters and/or
+trailing C</tlpkg> and C</archive> components are ignored.  For example,
+you could choose a particular CTAN mirror with something like this:
+
+  -repository http://ctan.example.org/its/ctan/dir/systems/texlive/tlnet
+
+Of course a real hostname and its particular top-level CTAN path
+have to be specified.  The list of CTAN mirrors is available at
+L<http://ctan.org/mirrors>. For more information see install-tl -help.
+
+=item B<-persistent-downloads>
+
+=item B<-no-persistent-downloads>
+
+Activating this option attempts to set up a persistent connection
+using the Net::LWP Perl module.  This opens only one connection between 
+your computer and the server per session and reuses it, instead of 
+initiating a new download for each package.  
+
+This option is turned on by default, and this program will fall 
+back to using wget if this is not possible. If you want to disable 
+usage of LWP and persistent connections, please use
+B<-no-persistent-downloads>.
+
+The standard options B<-help> and B<-q>, B<-v>, and
+B<-logfile>=I<file> are accepted too; see the C<process_logging_options>
+function in L<TeXLive::TLUtils> for details.
+
+=head1 DESCRIPTION
+
+Creates or updates a local package repository within the installer 
+directory structure. Useful particularily on unstable internet 
+connentions to predownload all packages before the installation.
+The local repository will be picked up automatically by the installer 
+as a default one. The repository is not enabled untill all pacakges 
+has been downloaded and md5 sum checked. If downloading has been 
+interrupted for any reason, just rerun this script again to complete it.
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
diff --git a/Master/tlpkg/dev/download-package-repository.bat b/Master/tlpkg/dev/download-package-repository.bat
new file mode 100755
index 00000000000..c7fa272e111
--- /dev/null
+++ b/Master/tlpkg/dev/download-package-repository.bat
@@ -0,0 +1,14 @@
+@echo off

+setlocal

+if exist "%~dpn0" (

+  set TLROOT=%~dp0..\..

+  set TLPROG=%~dpn0

+) else (

+  set TLROOT=%~f0\..

+  set TLPROG=%~dp0tlpkg\installer\%~n0

+)

+for %%I in ("%TLROOT%") do set TLROOT=%%~fI

+rem set TLINSTALLERDIR=%TLROOT%\install-tl-20100317

+rem set PERL5LIB=%TLROOT%\tlpkg

+"%TLROOT%\tlpkg\tlperl\bin\perl.exe" "%TLPROG%" %*

+pause

diff --git a/Master/tlpkg/dev/download-repo-archive.bat b/Master/tlpkg/dev/download-repo-archive.bat
deleted file mode 100755
index b11caebfc49..00000000000
--- a/Master/tlpkg/dev/download-repo-archive.bat
+++ /dev/null
@@ -1,6 +0,0 @@
-@echo off

-setlocal

-set PERL5LIB=%~dp0tlpkg\tlperl\lib

-set PERL5LIB=%PERL5LIB:\=/%

-set TL_DOWNLOAD_ARGS=--user-agent=texlive --tries=1 --timeout=9 -v -O

-"%~dp0tlpkg\tlperl\bin\perl.exe" "%~dpn0.pl" %*
\ No newline at end of file
diff --git a/Master/tlpkg/dev/download-repo-archive.pl b/Master/tlpkg/dev/download-repo-archive.pl
deleted file mode 100644
index 22d1b0038d9..00000000000
--- a/Master/tlpkg/dev/download-repo-archive.pl
+++ /dev/null
@@ -1,94 +0,0 @@
-#!/usr/bin/env perl
-
-# Purpose: create/update a local package repository
-# How to use: place it along the install-tl script and run
-
-our $Master;
-our $location;
-
-BEGIN {
-  $^W = 1;
-  $Master = __FILE__;
-  $Master =~ s,\\,/,g if ($^O =~ /^MSWin/i);
-  $Master =~ s,/[^/]*$,, unless ($Master =~ s,/download-repo-archive\.pl$,,i);
-  # print "$Master\n";
-  unshift (@INC, "$Master/tlpkg");
-  $::installerdir = $Master;
-}
-
-# use TeXLive::TLWinGoo if ($^O =~ /^MSWin/i);
-use TeXLive::TLPDB;
-use TeXLive::TLPOBJ;
-use TeXLive::TLConfig;
-use TeXLive::TLUtils;
-
-$::opt_verbosity = -1;
-
-&main();
-
-sub main {
-  if ( !setup_programs( "$::installerdir/$InfraLocation/installer", 
-                         TeXLive::TLUtils::platform() ) ) {
-    tldie("$0: failed to set up necessary programs.\n");
-  }
-  $location = TeXLive::TLUtils::give_ctan_mirror() unless defined($location);
-  # $location = "http://www.tex.ac.uk/ctan/systems/texlive/tlnet";
-  if (!defined($location)) {
-    die("$0: failed to obtain repository location.\n");
-  }
-  if ( $location eq $::installerdir ) {
-    die "bad remote repository: $location";
-  }
-  info("cloning package repository from: $location\n");
-  my $tlpdbfile = "$InfraLocation/$DatabaseName";
-  my $tlpdbpacked = "$tlpdbfile.$DefaultContainerFormat";
-  download_file("$location/$tlpdbfile.md5", "$::installerdir/$tlpdbfile.md5");
-  open MD5FILE, "$::installerdir/$tlpdbfile.md5" or 
-    die "cloud not open $::installerdir/$tlpdbfile.md5: $!";
-  if (read (MD5FILE, $md5there, 32) != 32) {
-    die "Unable to download the remote TeX Live database from $location.\n";
-  }
-  close MD5FILE;
-  my $get_tlpdb = (!-r "$::installerdir/$tlpdbfile");
-  my $md5here = $get_tlpdb ? "" : TeXLive::TLUtils::tlmd5("$::installerdir/$tlpdbfile");
-  info("md5there: $md5there\nmd5here:  $md5here\n");
-  info("md5 hash mismatch\n") if ($md5there ne $md5here);
-  if ($get_tlpdb || ($md5there ne $md5here)) {
-    download_file("$location/$tlpdbpacked", "$::installerdir/$tlpdbpacked");
-    if ( system("$::progs{'xzdec'} <\"$::installerdir/$tlpdbpacked\" >\"$::installerdir/$tlpdbfile\"") ) {
-      die "unable to decompress $::installerdir/$tlpdbpacked\n";
-    }
-  }
-
-  my $tlpdb = TeXLive::TLPDB->new ("root" => $::installerdir);
-  
-  my $archivedir = "$::installerdir/$Archive";
-  if (!-d $archivedir) {
-    mkdir $archivedir or die "$0: could not create directory $archivedir: $!";
-  }
-  my $pkg_count = 0;
-  for my $pkgname ($tlpdb->list_packages) {
-    next if $pkgname =~ /^00texlive/;
-    my $tlp = $tlpdb->get_package($pkgname);
-    $pkg_count += get_container("$pkgname", $tlp->containermd5() );
-    get_container("$pkgname.doc", $tlp->doccontainermd5() ) if ($tlp->docfiles());
-    get_container("$pkgname.source", $tlp->srccontainermd5() ) if ($tlp->srcfiles());
-    # last if ($pkg_count > 2); # stop for testing
-  }
-  
-  sub get_container {
-    my ($pkgname, $md5hash) = @_;
-    my $pkgcontainerfile = "$Archive/$pkgname.$DefaultContainerExtension";
-    if (!-r "$::installerdir/$pkgcontainerfile" || 
-        TeXLive::TLUtils::tlmd5("$::installerdir/$pkgcontainerfile") ne $md5hash ) {
-      print("downloading $pkgname\n");
-      download_file("$location/$pkgcontainerfile", "$::installerdir/$pkgcontainerfile");
-      return 1;
-    }
-    # info("package container up to date: $pkgcontainerfile\n");
-    print("OK: $pkgname\n");
-    return 0;
-  }
-
-}
-