X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FPackages.pm;h=f2ba789b14d1c0ccd149dddcf7172a49b351969a;hb=1f81df46999fc3699ce73aeba95af5095a5a413a;hp=f43e8b54e20cf9b00ad3948527ad7f7dbabeb74d;hpb=086b8b1bfed8d222bb6fdbd022b39fcb75a47a0c;p=debbugs.git diff --git a/Debbugs/Packages.pm b/Debbugs/Packages.pm index f43e8b5..f2ba789 100644 --- a/Debbugs/Packages.pm +++ b/Debbugs/Packages.pm @@ -12,7 +12,7 @@ package Debbugs::Packages; use warnings; use strict; -use base qw(Exporter); +use Exporter qw(import); use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT); use Carp; @@ -37,7 +37,7 @@ use Fcntl qw(O_RDONLY); use MLDBM qw(DB_File Storable); use Storable qw(dclone); use Params::Validate qw(validate_with :types); -use Debbugs::Common qw(make_list globify_scalar); +use Debbugs::Common qw(make_list globify_scalar sort_versions); use List::Util qw(min max); @@ -223,8 +223,8 @@ sub binary_to_source{ } # avoid autovivification my $bin = $_binarytosource{$binary}; + next unless defined $bin; if (not @versions) { - next unless defined $bin; for my $ver (keys %{$bin}) { for my $ar (keys %{$bin->{$ver}}) { my $src = $bin->{$ver}{$ar}; @@ -283,6 +283,9 @@ sub binary_to_source{ if ($param{source_only}) { my %uniq; for my $s (@source) { + # we shouldn't need to do this, but do this temporarily to + # stop the warning. + next unless defined $s->[0]; $uniq{$s->[0]} = 1; } @result = sort keys %uniq; @@ -390,6 +393,11 @@ may change in the future, so if you care, please code accordingly.) =item return_archs -- returns a version=>[archs] hash indicating which architectures are at which versions. +=item largest_source_version_only -- if there is more than one source +version in a particular distribution, discards all versions but the +largest in that distribution. Defaults to 1, as this used to be the +way that the Debian archive worked. + =back When called in scalar context, this function will return hashrefs or @@ -423,6 +431,9 @@ sub get_versions{ return_archs => {type => BOOLEAN, default => 0, }, + largest_source_version_only => {type => BOOLEAN, + default => 1, + }, }, ); my $versions; @@ -457,10 +468,16 @@ sub get_versions{ $_ ne 'source' } $source_only?'source':keys %{$version->{$dist}})) { next unless defined $version->{$dist}{$arch}; - for my $ver (ref $version->{$dist}{$arch} ? - keys %{$version->{$dist}{$arch}} : - $version->{$dist}{$arch} - ) { + my @vers = ref $version->{$dist}{$arch} eq 'HASH' ? + keys %{$version->{$dist}{$arch}} : + make_list($version->{$dist}{$arch}); + if ($param{largest_source_version_only} and + $arch eq 'source' and @vers > 1) { + # order the versions, then pick the biggest version number + @vers = sort_versions(@vers); + @vers = $vers[-1]; + } + for my $ver (@vers) { my $f_ver = $ver; if ($param{source}) { ($f_ver) = make_source_versions(package => $package, @@ -593,7 +610,7 @@ sub make_source_versions { my @bin_versions = sourcetobinary($1,$version); if (not @bin_versions or @{$bin_versions[0]} != 3) { - print {$warnings} "The source $1 and version $2 do not appear to match any binary packages\n"; + print {$warnings} "The source '$1' and version '$version' do not appear to match any binary packages\n"; } next; }