diff options
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 133 |
1 files changed, 133 insertions, 0 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 |