From c0bc2ddcbbc310dce145895881de11174ce6b4d1 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 17 Sep 2009 11:47:11 +0000 Subject: fix tl-update-tlpdb to deal with all kind of regressions git-svn-id: svn://tug.org/texlive/trunk@15333 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/bin/tl-update-tlpdb | 120 ++++++++++++++++++++++++++------------- 1 file changed, 81 insertions(+), 39 deletions(-) (limited to 'Master/tlpkg/bin') 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) { -- cgit v1.2.3