Add tl-update-tlpdb (not finished)

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

1 files changed, 264 insertions, 0 deletions

diff --git a/Master/tlpkg/bin/tl-update-tlpdb b/Master/tlpkg/bin/tl-update-tlpdb
new file mode 100755
index 00000000000..ab3b17d5f0c
--- /dev/null
+++ b/Master/tlpkg/bin/tl-update-tlpdb
@@ -0,0 +1,264 @@
+#!/usr/bin/env perl
+# $Id$
+# convert a set of tlpsrc files (given as arguments) into tlpdb
+# 
+# Copyright 2007, 2008, 2009 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
+BEGIN {
+  $^W = 1;
+  chomp ($mydir = `dirname $0`);
+  unshift (@INC, "$mydir/..");
+}
+
+use strict;
+
+use TeXLive::TLConfig;
+use TeXLive::TLPSRC;
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
+use TeXLive::TLTREE;
+use TeXLive::TLUtils;
+use Getopt::Long;
+use Pod::Usage;
+use File::Path;
+
+my $opt_catalogue = "";
+chomp (my $opt_master = `cd $::mydir/../.. && pwd`);
+my $help = 0;
+my $opt_nobinsplit = 0;
+my $opt_winwarning;
+my $opt_fromfiles = 0;
+my $opt_noautopatterns = 0;
+
+TeXLive::TLUtils::process_logging_options();
+GetOptions(
+    "master=s" => \$opt_master,	# location of the TL tree
+    "catalogue=s" => \$opt_catalogue, # location of the TeX Catalogue
+    "no-bin-split!" => \$opt_nobinsplit,
+    "no-autopatterns" => \$opt_noautopatterns,
+    "from-files" => \$opt_fromfiles,
+    "with-win-pattern-warning" => \$opt_winwarning,
+    "help|?" => \$help) or pod2usage(1);
+pod2usage(-exitstatus => 0, -verbose => 2) if $help;
+
+exit (&main ());
+
+
+
+
+
+
+sub finish
+{
+  my ($tlpdb, $pkgcount) = @_;
+  $tlpdb->save;
+  info ("$0: wrote $pkgcount packages to ". $tlpdb->root . ".\n");
+  exit(0);
+}
+
+sub main
+{
+  if (! -d $opt_master) {
+    die "$0: Master $opt_master not a directory, goodbye.\n";
+  }
+  my $tlc = undef;
+  if (! -d $opt_catalogue) {
+    info ("$0: -c /Cat/a/logue not given, continuing without it.\n");
+  } else {
+    require TeXLive::TeXCatalogue;  # not at compile time, for now anyway.
+    info ("$0: reading TeX Catalogue $opt_catalogue ...\n");
+    $tlc = TeXLive::TeXCatalogue->new ("location" => $opt_catalogue);
+  }
+
+  my $oldtlpdb = TeXLive::TLPDB->new ("root" => $opt_master);
+  my ($newtlpdb, $pkgcount) = create_tlpdb($tlc);
+  if (!defined($oldtlpdb)) {
+    info("No checking on increasing revisions, no old tlpdb found\n");
+    finish($newtlpdb, $pkgcount);
+  }
+  if (compare_tlpdbs($oldtlpdb, $newtlpdb)) {
+    # compare_tlpdbs checks in dummy changes to the tlpsrc files
+    # now we check again and that should not give any changes!
+    ($newtlpdb, $pkgcount) = create_tlpdb($tlc);
+    if (compare_tlpdbs($oldtlpdb, $newtlpdb)) {
+      tlwarn("$0: That should not happen, after one iteration of compare_tlpdbs\nthe newly created tlpdb is still going backwards in time.\nPlease check output above!\n");
+      exit(1);
+    }
+  }
+  # new $newtlpdb points to the right one
+  finish ($newtlpdb, $pkgcount);
+}
+
+sub compare_tlpdbs {
+  my ($oldtlpdb, $newtlpdb) = @_;
+  #
+  # check that revisions are actually going forward
+  my $recheck = 0;
+  for my $p ($newtlpdb->list_packages) {
+    my $newrev = $newtlpdb->get_package($p)->revision;
+    my $oldtlp = $oldtlpdb->get_package($p);
+    if (defined($oldtlp)) {
+      my $oldrev = $oldtlp->revision;
+      if ($oldrev > $newrev) {
+        # that is the bad case
+        $recheck = 1;
+        # here we should do a change to
+        #   $opt_master/tlpkg/tlpsrc/$p.tlpsrc
+        # and commit it!
+        tlwarn("$0: revision going backwards in $p!\n");
+      }
+    }
+  }
+  return($recheck);
+}
+
+  
+
+sub create_tlpdb
+{
+  my $tlc = shift;
+  if (defined($opt_winwarning)) {
+    $::tlpsrc_pattern_warn_win = 1;
+  }
+  my $tlpsrc_dir = "$opt_master/tlpkg/tlpsrc";
+  # if we're regenerating the whole thing, get all our tlpsrc files.
+  chdir ($tlpsrc_dir) || die "chdir($tlpsrc_dir) failed: $!";
+  @ARGV = glob ("*.tlpsrc");
+  
+  info ("$0: reading Master $opt_master ...\n");
+  my $tltree = TeXLive::TLTREE->new ("svnroot" => $opt_master);
+  if ($opt_fromfiles) {
+    $tltree->init_from_files;
+  } else {
+    $tltree->init_from_svn;
+  }
+
+  info ("$0: updating from tlpsrc ...\n");
+  my $tldb = TeXLive::TLPDB->new;
+  my $src_count = 0;
+  foreach my $f (@ARGV) {
+    next if ($f =~ m/^00texlive\.autopatterns/);
+    $src_count++;
+
+    my $tlsrc = new TeXLive::TLPSRC;
+    $tlsrc->from_file ($f);
+    my $tlp = $tlsrc->make_tlpobj ($tltree, $opt_master);
+
+    (my $base_f = $f) =~ s/\.tlpsrc$//;
+    warn "$f: package name " . $tlp->name . " does not match filename\n"
+      if $tlp->name ne $base_f;
+      
+    if ($tlc) {
+      # merge TeX Catalogue information
+      $tlp->update_from_catalogue ($tlc);
+    }
+   
+    # split bin packages off unless requested otherwise (no reason to so
+    # request these days).
+    unless ($opt_nobinsplit) {
+      # packages which have already a .win32 extension or the 
+      # 00texlive.something package are NOT split, never!
+      if ($tlp->name !~ m/\.win32/
+          && $tlp->name !~ m/^00texlive/) {
+        my @binobjs = $tlp->split_bin_package;
+        foreach my $binobj (@binobjs) {
+          # we recompute the revision numbers of the binary packages
+          # since that might be much smaller, and we don't want to 
+          # update every package only because one binary for one arch
+          # was changed
+          $binobj->recompute_revision ($tltree, $tltree->file_svn_lastrevision("tlpkg/tlpsrc/$f"));
+          $tldb->add_tlpobj ($binobj);
+        }
+        # we have to recompute the revision of the package itself 
+        # since the binfiles have been removed and that might lower the
+        # revision number
+        $tlp->recompute_revision ($tltree, $tltree->file_svn_lastrevision("tlpkg/tlpsrc/$f"));
+      }
+    }
+    if ($tlp->name eq "00texlive.config") {
+      my @bar = $tlp->depends;
+      push @bar, "revision/".$tltree->revision;
+      $tlp->depends (@bar);
+    }
+    $tldb->add_tlpobj ($tlp);
+  }
+  $tldb->root ($opt_master);
+  # do set the option_archs from the dirs in Master/bin
+  $tldb->option_available_architectures ($tltree->architectures);
+
+  return($tldb, $src_count);
+}
+
+__END__
+
+=head1 NAME
+
+tlpsrc2tlpdb - generate a TeX Live database from tlpsrc files
+
+=head1 SYNOPSIS
+
+tlpsrc2tlpdb [OPTION]... [TLPSRC]...
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-all>
+Use all .tlpsrc files in C<Master/tlpkg/tlpsrc/*.tlpsrc>, and update the
+live database in C<Master/tlpkg/texlive.tlpdb>.  
+(No repository operations are done.)
+
+=item B<-catalogue> I<Catalogue_dir>
+The location given by B<-catalogue> must point to a valid TeX Catalogue.
+No default value.  If given, the generated tlpobj files will contain
+information gathered from the TeX Catalogue.
+
+=item B<-master> I<Master/dir>
+The location I<Master/dir> must point to a valid svn repository of TeX
+Live's Master directory.  Defaults to C<../..> of C<$0>.
+
+=item B<-no-bin-split>
+Do NOT split files with binaries into several packages (one for the arch
+independent and one for each of the architectures with only the respective
+binaries).  There is no reason to use this option.
+
+=item B<-with-win-pattern-warning>
+Normally, this program issues a warning for all patterns without a matching
+file, but does I<not> warn for binpatterns when working on the win32 
+architecture. Giving this option makes it issues all warnings, i.e., also
+those where a binpattern on win32 does not hit.
+
+=item B<-from-files>
+Use find instead of svn -status to create the list of files.
+
+=back
+
+The standard options B<-q>, B<-v>, and B<-logfile>=I<file> are also
+accepted; see the C<process_logging_options> function in
+L<TeXLive::TLUtils> for details.
+
+=head1 DESCRIPTION
+
+B<tlpsrc2tlpdb> converts TeX Live source package files (tlpsrc) files into a
+TeX Live package database (tlpdb).
+
+If a TeX Catalogue hierarchy is specified, additional information from
+the catalogue are merged into the database (see L<TeXLive::TLPOBJ> for
+the list of included information from the TeX Catalogue).
+
+=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
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #