#!/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; my @ignored_packs = qw/00texlive.installer 00texlive.image/; 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()) { next if TeXLive::TLUtils::member($p, @ignored_packs); my $tlpB = $tlpdbB->get_package($p); if (!defined($tlpB)) { push @inAnotinB, $p; } else { $do_compare{$p} = 1; } } for my $p ($tlpdbB->list_packages()) { next if TeXLive::TLUtils::member($p, @ignored_packs); 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; } } my $ret = 0; if (@revision_differ) { $ret = 1; print "packages with revision discrepancy:\n"; for my $p (@revision_differ) { print "$p"; } } if (@inAnotinB) { $ret = 1; print "packages which occur in the left tlpdb but not in the right:\n"; for my $p (@inAnotinB) { print "$p\n"; } } if (@inBnotinA) { $ret = 1; print "packages which occur in the right tlpdb but not in the left:\n"; for my $p (@inBnotinA) { print "$p\n"; } } for my $pkg (keys %filedifferrors) { $ret = 1; print "file differences in $pkg:\n"; for my $l (@{$filedifferrors{$pkg}}) { print " $l\n"; } } return($ret); } 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