first take on a script for creating/updating a local repository

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

2 files changed, 100 insertions, 0 deletions

diff --git a/Master/tlpkg/dev/download-repo-archive.bat b/Master/tlpkg/dev/download-repo-archive.bat
new file mode 100755
index 00000000000..b11caebfc49
--- /dev/null
+++ b/Master/tlpkg/dev/download-repo-archive.bat
@@ -0,0 +1,6 @@
+@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
new file mode 100644
index 00000000000..22d1b0038d9
--- /dev/null
+++ b/Master/tlpkg/dev/download-repo-archive.pl
@@ -0,0 +1,94 @@
+#!/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;
+  }
+
+}
+