[libconfig-model-dpkg-perl] 01/05: Use show_message instead of say for most user messages (require C::M 2.066)

dod at debian.org dod at debian.org
Fri Feb 20 12:54:23 UTC 2015


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 7cd31fd9cf1bd2f1fd4a263ff5821781d1454b28
Author: Dominique Dumont <dod at debian.org>
Date:   Wed Feb 18 19:55:28 2015 +0100

    Use show_message instead of say for most user messages (require C::M 2.066)
---
 lib/Config/Model/Backend/Dpkg/Control.pm |  6 ++----
 lib/Config/Model/Dpkg/Dependency.pm      | 14 +++++++++-----
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/lib/Config/Model/Backend/Dpkg/Control.pm b/lib/Config/Model/Backend/Dpkg/Control.pm
index 3108b01..a079d6f 100644
--- a/lib/Config/Model/Backend/Dpkg/Control.pm
+++ b/lib/Config/Model/Backend/Dpkg/Control.pm
@@ -37,9 +37,7 @@ sub read {
     # load dpkgctrl file
     my $c = $self -> parse_dpkg_file ($args{io_handle}, $args{check}, 1 ) ;
 
-    # hack to fix Debian #735000: ask for infos for all packages not in cache in one go. Thus
-    # the async code in Dependency is less likely to break since the cache is already up-to-date
-    # when dependencies are checked one by one
+    # fix Debian #735000: ask for infos for all packages not in cache in one go.
     $self->fill_package_cache ($c);
 
     my $root = $args{object} ;
@@ -97,7 +95,7 @@ sub fill_package_cache {
     }
 
     my @pkgs = keys %packages;
-    Config::Model::Dpkg::Dependency::cache_info_from_madison (@pkgs);
+    Config::Model::Dpkg::Dependency::cache_info_from_madison ($self->node->instance, at pkgs);
 }
 
 sub read_sections {
diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index 1d79ad8..fff5212 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -2,6 +2,8 @@ package Config::Model::Dpkg::Dependency ;
 
 use 5.10.1;
 
+use Config::Model 2.066; # for show_message
+
 use Mouse;
 use URI::Escape;
 
@@ -778,7 +780,7 @@ sub get_available_version {
     }
 
     my $url = "http://qa.debian.org/cgi-bin/madison.cgi?package=".uri_escape($pkg_name)."&text=on" ;
-    say "Connecting to qa.debian.org to check $pkg_name versions. Please wait..." ;
+    $self->instance->show_message("Connecting to qa.debian.org to check $pkg_name versions. Please wait...") ;
 	my $body = get($url);
 
 	warn "cannot get data for package $pkg_name. Check your proxy ?\n" unless defined $body ;
@@ -790,7 +792,7 @@ sub get_available_version {
 		$type =~ s/\s//g ;
 		push @res , $dist,  $available_v unless $type eq 'source';
 	}
-	say "got info for $pkg_name" ;
+    $self->instance->show_message("got info for $pkg_name") ;
 	$cache{$pkg_name} = time ." @res" ;
 	return @res;
 }
@@ -798,7 +800,7 @@ sub get_available_version {
 # this function queries *once* madison for package info not found in cache.
 # it should be called once when parsing control file
 sub cache_info_from_madison {
-    my (@pkg_names) = @_ ;
+    my ($instance, at pkg_names) = @_ ;
 
     $logger->debug("called on @pkg_names");
 
@@ -822,7 +824,9 @@ 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..." ;
+    $instance->show_message(
+        "Connecting to qa.debian.org to check ", scalar @needed, " package versions. Please wait..."
+    );
 	my $body = get($url);
 
 	warn "cannot get data from madison. Check your proxy ?\n" unless defined $body ;
@@ -835,7 +839,7 @@ sub cache_info_from_madison {
 		$res{$name} ||= [] ;
 		push @{$res{$name}} , $dist,  $available_v unless $type eq 'source';
 	}
-	say "got info for $necessary packages: ", join(' ',sort keys %res) ;
+	$instance->show_message( "Got info from qa.debian.org for $necessary packages.") ;
 	foreach my $pname (keys %res) {
 		$cache{$pname} = time ." ".join(' ',@{$res{$pname}}) ;
 	}

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



More information about the Pkg-perl-cvs-commits mailing list