[libconfig-model-dpkg-perl] 01/24: dpkg::dep: cache_info_from_madison is now synchronous

[dod at debian.org]

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 e474be05f768955061badd6b743787d0a58b2fbc
Author: Dominique Dumont <dod at debian.org>
Date:   Mon Apr 14 19:16:01 2014 +0200

    dpkg::dep: cache_info_from_madison is now synchronous
---
 lib/Config/Model/Dpkg/Dependency.pm | 45 +++++++++++++++----------------------
 1 file changed, 18 insertions(+), 27 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index d398f61..01f8d9f 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -26,6 +26,7 @@ use AptPkg::Config '$_config';
 use AptPkg::System '$_system';
 use AptPkg::Version;
 use AptPkg::Cache ;
+use LWP::Simple ;
 
 # list of virtual packages
 # See https://www.debian.org/doc/packaging-manuals/virtual-package-names-list.txt
@@ -963,33 +964,23 @@ sub cache_info_from_madison {
 
     my $url = "http://qa.debian.org/cgi-bin/madison.cgi?package=".join('+',map { uri_escape($_) } @needed)."&text=on" ;
     say "Connecting to qa.debian.org to check ", scalar @needed, " package versions. Please wait..." ;
-
-    http_request(
-        GET => $url,
-        timeout => 20, # seconds
-        sub {
-            my ($body, $hdr) = @_;
-            $async_log->debug("callback of get_available_version called on @needed");
-            if ($hdr->{Status} =~ /^2/) {
-                my %res ;
-                foreach my $line (split /\n/, $body) {
-                    $line =~ s/^\s+|\s+$//g;
-                    my ($name,$available_v,$dist,$type) = split /\s*\|\s*/, $line ;
-                    $type =~ s/\s//g ;
-                    $res{$name} ||= [] ;
-                    push @{$res{$name}} , $dist,  $available_v unless $type eq 'source';
-                }
-                say "got info for $necessary packages: ", join(' ',sort keys %res) ;
-                foreach my $pname (keys %res) {
-                    $cache{$pname} = time ." ".join(' ',@{$res{$pname}}) ;
-                }
-                $callback->();
-            }
-            else {
-                say "Error for $url: ($hdr->{Status}) $hdr->{Reason}";
-            }
-        }
-    );
+	my $body = get($url);
+
+	warn "cannot get data from madison. Check your proxy ?\n" unless defined $body ;
+
+	my %res ;
+	foreach my $line (split /\n/, $body) {
+		$line =~ s/^\s+|\s+$//g;
+		my ($name,$available_v,$dist,$type) = split /\s*\|\s*/, $line ;
+		$type =~ s/\s//g ;
+		$res{$name} ||= [] ;
+		push @{$res{$name}} , $dist,  $available_v unless $type eq 'source';
+	}
+	say "got info for $necessary packages: ", join(' ',sort keys %res) ;
+	foreach my $pname (keys %res) {
+		$cache{$pname} = time ." ".join(' ',@{$res{$pname}}) ;
+	}
+	$callback->();
 }
 
 __PACKAGE__->meta->make_immutable;

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