[libconfig-model-dpkg-perl] 02/24: Dpkg::Dep: removed AnyEvent, all methods are now synchronous
dod at debian.org
dod at debian.org
Sun Apr 20 13:07:45 UTC 2014
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 f6c25898612f51731947ba30a1bf7fe7fbae8876
Author: Dominique Dumont <dod at debian.org>
Date: Mon Apr 14 20:48:44 2014 +0200
Dpkg::Dep: removed AnyEvent, all methods are now synchronous
---
lib/Config/Model/Dpkg/Dependency.pm | 101 ++++++------------------------------
1 file changed, 16 insertions(+), 85 deletions(-)
diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index 01f8d9f..47b53d5 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -17,9 +17,6 @@ use version ;
use Parse::RecDescent ;
-use AnyEvent;
-use AnyEvent::HTTP ;
-
# available only in debian. Black magic snatched from
# /usr/share/doc/libapt-pkg-perl/examples/apt-version
use AptPkg::Config '$_config';
@@ -289,36 +286,24 @@ sub check_dependency {
}
}
- # check_dependency is always called with a callback. This callback must
- # must called *after* all asynchronous calls are done (which depends on the
- # packages listed in the dependency). So use begin and end on this condvar and
- # nothing else, not send/recv
- my $pending_check = AnyEvent->condvar ;
-
my $old = $value ;
- my $check_depend_chain_cb = sub {
- # blocking with inner async calls
- $self->check_depend_chain($apply_fix, \@dep_chain, $old ) ;
- $self->on_check_all_done($apply_fix,\@dep_chain,$old, sub { $callback->(%args) if $callback; });
- } ;
-
$async_log->debug("begin for ",$self->composite_name, " fix is $apply_fix") if $async_log->is_debug;
- $pending_check->begin($check_depend_chain_cb) ;
foreach my $dep (@dep_chain) {
next unless ref($dep) ; # no need to check variables
- $pending_check->begin ;
my $cb = sub {
$self->check_or_fix_essential_package($apply_fix, $dep, $old) ; # sync
- $self->check_or_fix_dep($apply_fix, $dep, $old, sub { $pending_check -> end}) ; # async
+ $self->check_or_fix_dep($apply_fix, $dep, $old, sub { }) ;
};
$self->check_or_fix_pkg_name($apply_fix, $dep, $old, $cb) ; # async
}
$async_log->debug("end for ",$self->composite_name) if $async_log->is_debug;
- $pending_check->end;
+
+ $self->check_depend_chain($apply_fix, \@dep_chain, $old ) ;
+ $self->on_check_all_done($apply_fix,\@dep_chain,$old, sub { $callback->(%args) if $callback; });
}
# this callback will be launched when all checks are done. this can be at
@@ -468,7 +453,6 @@ sub check_depend_chain {
.(defined $dep_v ? " $dep_v" : ''));
if ($dep_name =~ /lib([\w+\-]+)-perl/) {
my $pname = $1 ;
- # AnyEvent condvar is involved in this method, blocks while inner async call are in progress
$ret &&= $self->check_perl_lib_dep ($apply_fix, $pname, $actual_dep, $depend,$input);
last;
}
@@ -508,11 +492,6 @@ sub check_perl_lib_dep {
return $ret if defined $dep_v && $dep_v =~ m/^\$/ ;
- # here we have async consecutive calls to get_available_version, check_versioned_dep
- # and get_available_version. Must block and return once they are done
- # hence the condvar
- my $perl_dep_cv = AnyEvent->condvar ;
-
my @ideal_perl_dep = qw/perl/ ;
my @ideal_lib_dep ;
my @ideal_dep_chain = (\@ideal_perl_dep);
@@ -530,7 +509,6 @@ sub check_perl_lib_dep {
my ($oldest_debian_with_lib,$oldest_lib_version_in_debian) = @_[0,1] ;
if (not defined $oldest_lib_version_in_debian or not defined $oldest_debian_with_lib) {
# no need to check further. Call send to unblock wait done with recv
- AnyEvent::postpone { $perl_dep_cv->send };
return;
}
# lob off debian release number
@@ -561,10 +539,6 @@ sub check_perl_lib_dep {
}
$self->check_versioned_dep( $on_perl_check_done , ['perl', '>=', $v_normal] );
}
- else {
- # no need to check further. Call send to unblock wait done with recv
- AnyEvent::postpone { $perl_dep_cv->send };
- }
};
@@ -629,16 +603,12 @@ sub check_perl_lib_dep {
}
$ret = 0;
}
- $perl_dep_cv->send ;
} ;
# start the whole async stuff
$self->get_available_version($on_get_lib_version, $dep_name);
- $async_log->debug("waiting for $actual_dep") ;
- $perl_dep_cv->recv ;
- $async_log->debug("waiting done for $actual_dep") ;
return $ret ;
}
@@ -851,22 +821,6 @@ END {
untie %cache ;
}
-my %requested ;
-
-sub push_cb {
- my $pkg = shift;
- my $ref = $requested{$pkg} ||= [] ;
- push @$ref, @_ ;
-}
-
-sub call_cbs {
- my $pkg = shift;
- return unless $requested{$pkg} ;
- my $ref = delete $requested{$pkg} ;
- map { $_->(@_) } @$ref ;
-}
-
-
# asynchronous method
my $cache_expire_date = time - 24 * 60 * 60 * 7 ;
sub get_available_version {
@@ -895,44 +849,21 @@ sub get_available_version {
return;
}
- # package info was requested but info is still not there
- # this may be called twice for the same package: one for source, one
- # for binary package
- if ($requested{$pkg_name}){
- push_cb($pkg_name,$callback) ;
- return ;
- } ;
-
my $url = "http://qa.debian.org/cgi-bin/madison.cgi?package=".uri_escape($pkg_name)."&text=on" ;
-
- push_cb($pkg_name,$callback);
-
say "Connecting to qa.debian.org to check $pkg_name versions. Please wait..." ;
+ my $body = get($url);
- http_request(
- GET => $url,
- timeout => 20, # seconds
- sub {
- my ($body, $hdr) = @_;
- $async_log->debug("callback of get_available_version called on $pkg_name");
- 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 ;
- push @res , $dist, $available_v unless $type eq 'source';
- }
- say "got info for $pkg_name" ;
- $cache{$pkg_name} = time ." @res" ;
- call_cbs($pkg_name, at res) ;
- }
- else {
- say "Error for $url: ($hdr->{Status}) $hdr->{Reason}";
- delete $requested{$pkg_name} ; # trash the callbacks
- }
- }
- );
+ warn "cannot get data for package $pkg_name. Check your proxy ?\n" unless defined $body ;
+
+ @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 ;
+ push @res , $dist, $available_v unless $type eq 'source';
+ }
+ say "got info for $pkg_name" ;
+ $cache{$pkg_name} = time ." @res" ;
}
# this function queries *once* madison for package info not found in cache.
--
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