properly support src: packages in make_source_versions

[debbugs.git] / Debbugs / Packages.pm

diff --git a/Debbugs/Packages.pm b/Debbugs/Packages.pm
index 54885aedc5dee1fdff397cb27e77df3f45952ed2..47c37f9f7bbd6bb0dba0bd4d9e5e72f497452962 100644 (file)
--- a/Debbugs/Packages.pm
+++ b/Debbugs/Packages.pm
@@ -144,6 +144,9 @@ sub binarytosource {
     # need an extra cache for speed here.
     return () unless defined $gBinarySourceMap;
 
+    if ($binname =~ m/^src:(.+)$/) {
+       return $1;
+    }
     if (not tied %_binarytosource) {
         tie %_binarytosource, MLDBM => $gBinarySourceMap, O_RDONLY or
              die "Unable to open $gBinarySourceMap for reading";
@@ -460,19 +463,31 @@ sub make_source_versions {
     my %sourceversions;
     for my $version (make_list($param{versions})) {
         if ($version =~ m{(.+)/([^/]+)$}) {
+           # Already a source version.
+            $sourceversions{$version} = 1;
+           next unless exists $param{warnings};
            # check to see if this source version is even possible
            my @bin_versions = sourcetobinary($1,$2);
            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";
            }
-            # Already a source version.
-            $sourceversions{$version} = 1;
         } else {
            if (not @packages) {
                croak "You must provide at least one package if the versions are not fully qualified";
            }
            for my $pkg (@packages) {
+               if ($pkg =~ /^src:(.+)/) {
+                   $sourceversions{"$1/$version"} = 1;
+                   next unless exists $param{warnings};
+                   # check to see if this source version is even possible
+                   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";
+                   }
+                   next;
+               }
                for my $arch (@archs) {
                    my $cachearch = (defined $arch) ? $arch : '';
                    my $cachekey = "$pkg/$cachearch/$version";
@@ -484,7 +499,7 @@ sub make_source_versions {
                    }
                    elsif ($param{guess_source} and
                           exists$param{source_version_cache}{$cachekey.'/guess'}) {
-                       for my $v (@{$param{source_version_cache}{$cachekey}}) {
+                       for my $v (@{$param{source_version_cache}{$cachekey.'/guess'}}) {
                            $sourceversions{$v} = 1;
                        }
                        next;