From 953682564074001d5d88a5efa4c1b9eb0fb0d0a7 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 10 Sep 2009 00:32:39 +0000 Subject: add tl-compare-tlpdbs git-svn-id: svn://tug.org/texlive/trunk@15200 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/bin/tl-compare-tlpdbs | 207 +++++++++++++++++++++++++++++++++++++ 1 file changed, 207 insertions(+) create mode 100755 Master/tlpkg/bin/tl-compare-tlpdbs 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