add tl-compare-tlpdbs

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

1 files changed, 207 insertions, 0 deletions

diff --git a/Master/tlpkg/bin/tl-compare-tlpdbs b/Master/tlpkg/bin/tl-compare-tlpdbs
new file mode 100755
index 00000000000..2969545aca1
--- /dev/null
+++ b/Master/tlpkg/bin/tl-compare-tlpdbs
@@ -0,0 +1,207 @@
+#!/usr/bin/env perl
+# Copyright 2008, 2009 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# compare two tlpdbs
+#
+
+BEGIN {
+  $vc_id = '$Id$';
+  $^W = 1;
+  ($mydir = $0) =~ s,/[^/]*$,,;
+  unshift (@INC, "$mydir/..");
+}
+
+use strict;
+use TeXLive::TLConfig;
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
+use TeXLive::TLUtils;
+use Getopt::Long;
+use Pod::Usage;
+use File::Path;
+
+our ($mydir, $vc_id);
+my $opt_version = 0;
+my $opt_help = 0;
+
+TeXLive::TLUtils::process_logging_options();
+GetOptions(
+  "version"	=> \$opt_version,
+  "help|?"      => \$opt_help) or pod2usage(1);
+
+pod2usage("-exitstatus" => 0, "-verbose" => 2) if $opt_help;
+if ($opt_version) { print "$vc_id\n"; exit 0; } 
+
+exit (&main());
+
+
+sub main
+{
+  chomp(my $Master = `cd $mydir/../.. && pwd`);
+  #
+  # if tl-compare-tlpdbs was called with two arguments like
+  #   tl-compare-tlpdbs aaa bbb
+  # then aaa and bbb are assumed to be two .tlpdb files.
+  # if it was called with one argument only then this one is the tlpdb
+  # to be compared with the "self-defined" (i.e., the one in 
+  # $Master/tlpkg/texlive.tlpdb) one, where the "self-defined" is the
+  # first one, and the to be compared the second one
+
+  my $tlpdbAsrc;
+  my $tlpdbBsrc;
+
+  if ($#ARGV < 0) {
+    tlwarn("$0 expects either one or two arguments, exiting.\n");
+    exit 1;
+  }
+
+  if ($#ARGV == 0) {
+    # one argument
+    $tlpdbBsrc = $ARGV[0];
+    $tlpdbAsrc = "$Master/tlpkg/texlive.tlpdb";
+  } elsif ($#ARGV == 1) {
+    $tlpdbAsrc = $ARGV[0];
+    $tlpdbBsrc = $ARGV[1];
+  } else {
+    tlwarn("$0 expects either one or two arguments, exiting.\n");
+    exit 1;
+  }
+
+  if (! -r $tlpdbAsrc) {
+    tlwarn("$0: not readable $tlpdbAsrc, exiting.\n");
+    exit 1;
+  }
+  if (! -r $tlpdbBsrc) {
+    tlwarn("$0: not readable $tlpdbBsrc, exiting.\n");
+    exit 1;
+  }
+
+  my $tlpdbA = TeXLive::TLPDB->new();
+  my $tlpdbB = TeXLive::TLPDB->new();
+  $tlpdbA->from_file($tlpdbAsrc);
+  $tlpdbB->from_file($tlpdbBsrc);
+
+  my @inAnotinB;
+  my @inBnotinA;
+  my @revision_differ;
+
+  my %do_compare;
+  my %filedifferrors;
+
+  for my $p ($tlpdbA->list_packages()) {
+    my $tlpB = $tlpdbB->get_package($p);
+    if (!defined($tlpB)) {
+      push @inAnotinB, $p;
+    } else {
+      $do_compare{$p} = 1;
+    }
+  }
+  for my $p ($tlpdbB->list_packages()) {
+    my $tlpA = $tlpdbA->get_package($p);
+    if (!defined($tlpA)) {
+      push @inBnotinA, $p;
+    } else {
+      $do_compare{$p} = 1;
+    }
+  }
+  for my $p (sort keys %do_compare) {
+    my $tlpA = $tlpdbA->get_package($p);
+    my $tlpB = $tlpdbB->get_package($p);
+    my $rA = $tlpA->revision;
+    my $rB = $tlpB->revision;
+    if ($rA != $rB) {
+      push @revision_differ, "$p rev differ: revision left $rA, revision right $rB\n";
+    } else {
+      if ($tlpA->relocated) {
+        $tlpA->cancel_reloc_prefix;
+      }
+      if ($tlpB->relocated) {
+        $tlpB->cancel_reloc_prefix;
+      }
+      my @fA = $tlpA->all_files;
+      my @fB = $tlpB->all_files;
+      my @ret = compare_lists(\@fA, \@fB);
+      push @{$filedifferrors{$p}}, @ret if @ret;
+    }
+  }
+
+  if (@revision_differ) {
+    print "packages with revision discrepancy:\n";
+    for my $p (@revision_differ) {
+      print "$p";
+    }
+  }
+  for my $pkg (keys %filedifferrors) {
+    print "file differences in $pkg:\n";
+    for my $l (@{$filedifferrors{$pkg}}) {
+      print "  $l\n";
+    }
+  }
+}
+
+
+sub compare_lists {
+  my ($la, $lb) = @_;
+  my @la = @$la;
+  my @lb = @$lb;
+  my %onlyfirst;
+  my %onlysecond;
+  my @ret;
+  for my $f (@la) { $onlyfirst{$f} = 1; }
+  for my $f (@lb) { delete($onlyfirst{$f}); $onlysecond{$f} = 1; }
+  for my $f (@la) { delete($onlysecond{$f}); }
+  for my $f (sort keys %onlyfirst) { push @ret, "-$f"; }
+  for my $f (sort keys %onlysecond) { push @ret, "+$f"; }
+  return(@ret);
+}
+
+__END__
+
+=head1 NAME
+
+tl-compare-tlpdbs - compare two tlpdbs
+
+=head1 SYNOPSIS
+
+tl-compare-tlpdbs [I<option>]... <TLPDB1> [<TLPDB2>]
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-help>
+
+Print this documentation and exit.
+
+=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
+
+This program compares two tlpdbs. If two arguments are given both
+have to refer to a .tlpdb file and the two tlpdbs will be compared.
+If only one argument is given then the tlpdb from the tree of this
+program itself is compared with the tlpdb given on the command line.
+
+The comparision reports revision differences, and if the revision are
+the same, differences in the file lists.
+
+=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: #