[libconfig-model-dpkg-perl] 01/02: relevant pkg version is found in arch all or amd64 (Closes: #841667)

[dod]

This is an automated email from the git hooks/post-receive script.

dod pushed a commit to branch master
in repository libconfig-model-dpkg-perl.

commit 5d5ed51a272763fe58d3aa8666d8a051ff37748a
Author: Dominique Dumont <d...@debian.org>
Date:   Mon Dec 5 19:45:34 2016 +0100

    relevant pkg version is found in arch all or amd64 (Closes: #841667)
    
    Tx gregoa for the report and preliminary patch
---
 lib/Config/Model/Dpkg/Dependency.pm | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Dependency.pm 
b/lib/Config/Model/Dpkg/Dependency.pm
index 44b2854..225bf46 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -853,7 +853,7 @@ sub get_available_version {
         return @res;
     }
 
-    my $url = "$madison_endpoint?package=".uri_escape($pkg_name).'&f' ;
+    my $url = "$madison_endpoint?package=".uri_escape($pkg_name).'&f&b=deb' ;
     $self->instance->show_message("Connecting to $madison_host to check 
$pkg_name versions. Please wait...") ;
        my $body = get($url);
     my $res ;
@@ -897,7 +897,7 @@ sub cache_info_from_madison {
         return;
     }
 
-    my $url = "$madison_endpoint?package=".uri_escape(join(' ',@needed)).'&f' ;
+    my $url = "$madison_endpoint?package=".uri_escape(join(' 
',@needed)).'&f&b=deb' ;
     $instance->show_message(
         "Connecting to $madison_host to check ", scalar @needed, " package 
versions. Please wait..."
     );
@@ -922,10 +922,21 @@ sub extract_madison_info ($json) {
         my %avail;
         foreach my $dist (keys $data->{$name}->%*) {
             foreach my $available_v (keys $data->{$name}{$dist}->%*) {
-                $avail{$available_v} = $dist;
+                my $arches = 
$data->{$name}{$dist}{$available_v}{architectures};
+                # see #841667: relevant pkg version is found in arch all or 
arch amd64
+                my @keep = grep { $_ eq 'all' or $_ eq 'amd64'} $arches->@*;
+
+                # the same version may be available in several
+                # distributions (testing and unstable are more likely
+                # to have the same version for a package)
+                $avail{$available_v} //= [];
+                push $avail{$available_v}->@*, $dist, $available_v if @keep;
             }
         }
-        my @res = map { ($avail{$_}, $_) ; } sort { $vs->compare($a,$b) } keys 
%avail ;
+
+        # @res contains something like 'oldstable 5.10.1-17 stable 5.14.2-21 
testing 5.18.1-3 unstable 5.18.1-4'
+        my @res = map { $avail{$_}->@* ; } sort { $vs->compare($a,$b) } keys 
%avail ;
+
         $ref{$name} = \@res ;
         $cache{$name} = join(' ',time, @res) ;
        }

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits