diff options
| -rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 133 | ||||
| -rwxr-xr-x | Master/tlpkg/bin/tl-update-tlpdb | 120 |
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) { |