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 <d...@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,@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

_______________________________________________
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

Reply via email to