summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm133
-rwxr-xr-xMaster/tlpkg/bin/tl-update-tlpdb120
2 files changed, 214 insertions, 39 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 757a3fb44fd..ba48ed0586e 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -90,6 +90,9 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::give_ctan_mirror();
TeXLive::TLUtils::give_ctan_mirror_base();
TeXLive::TLUtils::tlmd5($path);
+ TeXLive::TLUtils::compare_tlpobjs($tlpA, $tlpB);
+ TeXLive::TLUtils::compare_tlpdbs($tlpdbA, $tlpdbB);
+ TeXLive::TLUtils::report_tlpdb_differences(\%ret);
=head1 DESCRIPTION
@@ -148,6 +151,9 @@ BEGIN {
&w32_remove_from_path
&tlcmp
&time_estimate
+ &compare_tlpobjs
+ &compare_tlpdbs
+ &report_tlpdb_differences
);
@EXPORT = qw(setup_programs download_file process_logging_options
tldie tlwarn info log debug ddebug dddebug debug_hash
@@ -3012,6 +3018,133 @@ sub tlmd5 {
}
}
+#
+# compare_tlpobjs
+# returns a hash
+# $ret{'revision'} = "leftRev:rightRev" if revision differ
+# $ret{'removed'} = \[ list of files removed from A to B ]
+# $ret{'added'} = \[ list of files added from A to B ]
+#
+sub compare_tlpobjs {
+ my ($tlpA, $tlpB) = @_;
+ my %ret;
+ my @rem;
+ my @add;
+
+ my $rA = $tlpA->revision;
+ my $rB = $tlpB->revision;
+ if ($rA != $rB) {
+ $ret{'revision'} = "$rA:$rB";
+ }
+ 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 %removed;
+ my %added;
+ for my $f (@fA) { $removed{$f} = 1; }
+ for my $f (@fB) { delete($removed{$f}); $added{$f} = 1; }
+ for my $f (@fA) { delete($added{$f}); }
+ @rem = sort keys %removed;
+ @add = sort keys %added;
+ $ret{'removed'} = \@rem if @rem;
+ $ret{'added'} = \@add if @add;
+ return %ret;
+}
+
+#
+# compare_tlpdbs
+# return several hashes
+# @{$ret{'removed_packages'}} = list of removed packages from A to B
+# @{$ret{'added_packages'}} = list of added packages from A to B
+# $ret{'different_packages'}->{$package} = output of compare_tlpobjs
+#
+sub compare_tlpdbs {
+ my ($tlpdbA, $tlpdbB) = @_;
+ my @ignored_packs = qw/00texlive.installer 00texlive.image/;
+
+ my @inAnotinB;
+ my @inBnotinA;
+ my %diffpacks;
+ my %do_compare;
+ my %ret;
+
+ 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;
+ }
+ }
+ $ret{'removed_packages'} = \@inAnotinB if @inAnotinB;
+
+ 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;
+ }
+ }
+ $ret{'added_packages'} = \@inBnotinA if @inBnotinA;
+
+ for my $p (sort keys %do_compare) {
+ my $tlpA = $tlpdbA->get_package($p);
+ my $tlpB = $tlpdbB->get_package($p);
+ my %foo = compare_tlpobjs($tlpA, $tlpB);
+ if (keys %foo) {
+ # some diffs were found
+ $diffpacks{$p} = \%foo;
+ }
+ }
+ $ret{'different_packages'} = \%diffpacks if (keys %diffpacks);
+
+ return %ret;
+}
+
+sub report_tlpdb_differences {
+ my $rret = shift;
+ my %ret = %$rret;
+
+ if (defined($ret{'removed_packages'})) {
+ info ("removed packages from A to B:\n");
+ for my $f (@{$ret{'removed_packages'}}) {
+ info (" $f\n");
+ }
+ }
+ if (defined($ret{'added_packages'})) {
+ info ("added packages from A to B:\n");
+ for my $f (@{$ret{'added_packages'}}) {
+ info (" $f\n");
+ }
+ }
+ if (defined($ret{'different_packages'})) {
+ info ("different packages from A to B:\n");
+ for my $p (keys %{$ret{'different_packages'}}) {
+ info (" $p\n");
+ for my $k (keys %{$ret{'different_packages'}->{$p}}) {
+ if ($k eq "revision") {
+ info(" revision differ: $ret{'different_packages'}->{$p}->{$k}\n");
+ } elsif ($k eq "removed" || $k eq "added") {
+ info(" $k files:\n");
+ for my $f (@{$ret{'different_packages'}->{$p}->{$k}}) {
+ info(" $f\n");
+ }
+ } else {
+ info(" unknown differ $k\n");
+ }
+ }
+ }
+ }
+}
+
#############################################
#
# Taken from Text::ParseWords
diff --git a/Master/tlpkg/bin/tl-update-tlpdb b/Master/tlpkg/bin/tl-update-tlpdb
index 7498c6afc76..4984088cede 100755
--- a/Master/tlpkg/bin/tl-update-tlpdb
+++ b/Master/tlpkg/bin/tl-update-tlpdb
@@ -51,6 +51,8 @@ GetOptions(
"help|?" => \$help) or pod2usage(1);
pod2usage(-exitstatus => 0, -verbose => 2) if $help;
+my $progname = TeXLive::TLUtils::basename($0);
+
exit (&main ());
@@ -64,14 +66,14 @@ sub finish
if ($opt_output) {
if (open(OUT, ">$opt_output")) {
$tlpdb->writeout(\*OUT);
- info ("$0: wrote $pkgcount packages to $opt_output.\n");
+ info ("$progname: wrote $pkgcount packages to $opt_output.\n");
} else {
warn ("Cannot open $opt_output for writing");
exit 1;
}
} else {
$tlpdb->save;
- info ("$0: wrote $pkgcount packages to ". $tlpdb->root . ".\n");
+ info ("$progname: wrote $pkgcount packages to ". $tlpdb->root . ".\n");
}
exit(0);
}
@@ -79,14 +81,14 @@ sub finish
sub main
{
if (! -d $opt_master) {
- die "$0: Master $opt_master not a directory, goodbye.\n";
+ die "$progname: 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");
+ info ("$progname: -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");
+ info ("$progname: reading TeX Catalogue $opt_catalogue ...\n");
$tlc = TeXLive::TeXCatalogue->new ("location" => $opt_catalogue);
}
@@ -106,7 +108,7 @@ sub main
# compare_tlpdbs returns true if some reversed revisions have been found.
# If in addition the option --fix-reverse-revisions is given it tries
# to fix that, by committing changes.
- if (compare_tlpdbs($oldtlpdb, $newtlpdb)) {
+ if (compare_and_fix_tlpdbs($oldtlpdb, $newtlpdb)) {
# there have been reversed revision that have already been warned about
# and that have been (hopefully) fixed by compared_tlpdbs if
# --fix-reverse-revisions has been given
@@ -116,8 +118,12 @@ sub main
# the tlpdb
if (!$opt_fromfiles && $opt_fix_reverse_revisions) {
($newtlpdb, $pkgcount) = create_tlpdb($tlc);
- if (compare_tlpdbs($oldtlpdb, $newtlpdb)) {
- tldie("$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");
+ #
+ # now recheck, but do NOT try to check in changes again by unsetting
+ # $opt_fix_reverse_revisions
+ $opt_fix_reverse_revisions = 0;
+ if (compare_and_fix_tlpdbs($oldtlpdb, $newtlpdb)) {
+ tldie("$progname: 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");
}
}
}
@@ -125,44 +131,80 @@ sub main
finish ($newtlpdb, $pkgcount);
}
-sub compare_tlpdbs {
+sub compare_and_fix_tlpdbs {
my ($oldtlpdb, $newtlpdb) = @_;
- #
- # check that revisions are actually going forward
- my $recheck = 0;
- my $commitit = 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");
- if ($opt_fix_reverse_revisions) {
- tlwarn("$0: trying to fix it, running:\n");
- my $time = time();
- my $cmd = "svn propset texlive:force_incr_after_delete $time $opt_master/tlpkg/tlpsrc/$p.tlpsrc";
- $commitit = 1;
- tlwarn(" $cmd\n");
- TeXLive::TLUtils::xsystem($cmd);
+
+ my %ret = TeXLive::TLUtils::compare_tlpdbs($oldtlpdb, $newtlpdb);
+
+ # we only care for differences in packages. If a packages has been
+ # removed or added that is fine for here as this will be dealt with
+ # in tl-update-containers
+
+ # within the list of packages that differ the problematic ones are
+ # where there are either files added or removed, but the revision
+ # did not increase
+
+ my %packages_that_need_fixup;
+
+ if (defined($ret{'different_packages'})) {
+ for my $p (keys %{$ret{'different_packages'}}) {
+ if (defined($ret{'different_packages'}->{$p}->{'added'}) ||
+ defined($ret{'different_packages'}->{$p}->{'removed'})) {
+ if (!defined($ret{'different_packages'}->{$p}->{'revision'})) {
+ # no revision change reported, but files have been added
+ # or removed, try fixing it
+ $packages_that_need_fixup{$p} = 1;
+ } else {
+ # revision change has been reported, if the revision is increasing
+ # that is fine, otherwise try fixing it
+ my ($rA, $rB) = split (':',
+ $ret{'different_packages'}->{$p}->{'revision'});
+ if ($rA >= $rB) {
+ $packages_that_need_fixup{$p} = 1;
+ }
+ }
+ } else {
+ # there have been no changed filelists, but we still check that
+ # revision is not going backward out of some strange other reason
+ if (defined($ret{'different_packages'}->{$p}->{'revision'})) {
+ # revision change has been reported, if the revision is increasing
+ # that is fine, otherwise try fixing it
+ my ($rA, $rB) = split (':',
+ $ret{'different_packages'}->{$p}->{'revision'});
+ if ($rA > $rB) {
+ tlwarn("$progname: big warning for $p: file lists didn't change but "
+ . "revision is going backward! Very strange!\n");
+ $packages_that_need_fixup{$p} = 1;
+ }
}
}
}
}
+
+ my $commitit = 0;
+
+ for my $p (keys %packages_that_need_fixup) {
+ tlwarn("$progname: package $p has different files but same/decreasing revision number\n");
+ if ($opt_fix_reverse_revisions) {
+ tlwarn("$progname: trying to fix it by running:\n");
+ my $time = time();
+ my $cmd = "svn propset texlive:force_incr_after_delete $time $opt_master/tlpkg/tlpsrc/$p.tlpsrc";
+ $commitit = 1;
+ tlwarn(" $cmd\n");
+ TeXLive::TLUtils::xsystem($cmd);
+ }
+ }
if ($commitit) {
- tlwarn("$0: committing changes to tlpsrc files:\n");
+ tlwarn("$progname: committing changes to tlpsrc files:\n");
TeXLive::TLUtils::xsystem("svn commit "
- . "-m'($0) force increased revision after removal of files' "
+ . "-m'($progname) force increased revision after removal of files' "
. "$opt_master/tlpkg/tlpsrc/");
- # we do not check the outcome, we expect to see a positive result
- # after rebuilding the tlpdb
}
- return $recheck;
+ if (keys %packages_that_need_fixup) {
+ return 1;
+ } else {
+ return 0;
+ }
}
@@ -183,7 +225,7 @@ sub create_tlpdb
@ARGV = glob ("*.tlpsrc");
}
- info ("$0: reading Master $opt_master ...\n");
+ info ("$progname: reading Master $opt_master ...\n");
my $tltree = TeXLive::TLTREE->new ("svnroot" => $opt_master);
if ($opt_fromfiles) {
$tltree->init_from_files;
@@ -191,7 +233,7 @@ sub create_tlpdb
$tltree->init_from_svn;
}
- info ("$0: updating from tlpsrc ...\n");
+ info ("$progname: updating from tlpsrc ...\n");
my $tldb = TeXLive::TLPDB->new;
my $src_count = 0;
foreach my $f (@ARGV) {