X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FPackages.pm;h=62d26827ab10e037df67d27e4e2c8e71493c0c75;hb=867420593c939cf9585bd42f558778ad598076b9;hp=fc86b6c7f867607d0591932ba0c48db299ebb065;hpb=870763abb7ef2942fb443f3b23e181ddbf75ef75;p=debbugs.git diff --git a/Debbugs/Packages.pm b/Debbugs/Packages.pm index fc86b6c..62d2682 100644 --- a/Debbugs/Packages.pm +++ b/Debbugs/Packages.pm @@ -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); @@ -139,6 +139,9 @@ arch(s), and verion(s) passed. In SCALAR context, only the corresponding source packages are returned, concatenated with ', ' if necessary. +If no source can be found, returns undef in scalar context, or the +empty list in list context. + =over =item binary -- binary package name(s) as a SCALAR or ARRAYREF @@ -162,7 +165,10 @@ binary_to_source. =cut +# the two global variables below are used to tie the source maps; we +# probably should be retying them in long lived processes. our %_binarytosource; +our %_sourcetobinary; sub binary_to_source{ my %param = validate_with(params => \@_, spec => {binary => {type => SCALAR|ARRAYREF, @@ -217,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}; @@ -249,11 +255,37 @@ sub binary_to_source{ } } } + + if (not @source and not @versions and not @archs) { + # ok, we haven't found any results at all. If we weren't given + # a specific version and architecture, then we should try + # really hard to figure out the right source + + # if any the packages we've been given are a valid source + # package name, and there's no binary of the same name (we got + # here, so there isn't), return it. + + if (not tied %_sourcetobinary) { + tie %_sourcetobinary, MLDBM => $config{source_binary_map}, O_RDONLY or + die "Unable top open $gSourceBinaryMap for reading"; + } + for my $maybe_sourcepkg (@binaries) { + if (exists $_sourcetobinary{$maybe_sourcepkg}) { + push @source,[$maybe_sourcepkg,$_] for keys %{$_sourcetobinary{$maybe_sourcepkg}}; + } + } + # if @source is still empty here, it's probably a non-existant + # source package, so don't return anything. + } + my @result; 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; @@ -288,13 +320,12 @@ returned, without the architecture. =cut -our %_sourcetobinary; sub sourcetobinary { my ($srcname, $srcver) = @_; if (not tied %_sourcetobinary) { - tie %_sourcetobinary, MLDBM => $gSourceBinaryMap, O_RDONLY or - die "Unable top open $gSourceBinaryMap for reading"; + tie %_sourcetobinary, MLDBM => $config{source_binary_map}, O_RDONLY or + die "Unable top open $config{source_binary_map} for reading"; } @@ -362,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 @@ -395,6 +431,9 @@ sub get_versions{ return_archs => {type => BOOLEAN, default => 0, }, + largest_source_version_only => {type => BOOLEAN, + default => 1, + }, }, ); my $versions; @@ -416,6 +455,10 @@ sub get_versions{ } my %versions; for my $package (make_list($param{package})) { + my $source_only = 0; + if ($package =~ s/^src://) { + $source_only = 1; + } my $version = $versions->{$package}; next unless defined $version; for my $dist (make_list($param{dist})) { @@ -423,12 +466,18 @@ sub get_versions{ make_list($param{arch}): (grep {not $param{no_source_arch} or $_ ne 'source' - } keys %{$version->{$dist}})) { + } $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, @@ -561,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; } @@ -583,7 +632,7 @@ sub make_source_versions { } my @srcinfo = binary_to_source(binary => $pkg, version => $version, - arch => $arch); + length($arch)?(arch => $arch):()); if (not @srcinfo) { # We don't have explicit information about the # binary-to-source mapping for this version