[libconfig-model-dpkg-perl] 03/03: Fix alternate dependency corner case (Closes: #719225)

[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 bdc198a83abd2e903c77bf04a627eac05eead0c3
Author: Dominique Dumont <dod at debian.org>
Date:   Fri Aug 23 12:42:13 2013 +0200

    Fix alternate dependency corner case (Closes: #719225)
    
    Corner case was a dual life module where the oldest version in Debian
    is not yet shipped with Debian Perl. The trick is to use the first
    version available in Debian as a required version. Of course this must
    not be added in the fixed dependency ...
---
 lib/Config/Model/Dpkg/Dependency.pm |   78 ++++++++++++++++++++++-------------
 1 file changed, 49 insertions(+), 29 deletions(-)

diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index 0c577d9..3f92e3a 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -395,35 +395,19 @@ sub check_perl_lib_dep {
 
     $pname =~ s/-/::/g;
 
-    # check for dual life module, module name follows debian convention...
-    my @dep_name_as_perl = Module::CoreList->find_modules(qr/^$pname$/i) ; 
-    return $ret unless @dep_name_as_perl;
-
-    return $ret if defined $dep_v && $dep_v =~ m/^\$/ ;
-
-    my ($cpan_dep_v, $epoch_dep_v) ;
-    ($cpan_dep_v, $epoch_dep_v) = reverse split /:/ ,$dep_v if defined $dep_v ;
-    my $v_decimal = Module::CoreList->first_release( 
-        $dep_name_as_perl[0], 
-        version->parse( $cpan_dep_v )
-    );
-
-    return $ret unless defined $v_decimal;
-
-    my $v_normal = version->new($v_decimal)->normal;
-    $v_normal =~ s/^v//;    # loose the v prefix
-    if ( $logger->debug ) {
-        my $dep_str = $dep_name . ( defined $dep_v ? ' ' . $dep_v : '' );
-        $logger->debug("dual life $dep_str aka $dep_name_as_perl[0] found in Perl core $v_normal");
-    }
-
-    # Here the dependency should be in the form perl (>= 5.10.1) | libtest-simple-perl (>= 0.88)".
+    # The dependency should be in the form perl (>= 5.10.1) | libtest-simple-perl (>= 0.88)".
     # cf http://pkg-perl.alioth.debian.org/policy.html#debian_control_handling
     # If the Perl version is not available in sid, the order of the dependency should be reversed
     # libcpan-meta-perl | perl (>= 5.13.10)
     # because buildd will use the first available alternative
 
-    # here we have 3 async consecutive calls to check_versioned_dep 
+    # check for dual life module, module name follows debian convention...
+    my @dep_name_as_perl = Module::CoreList->find_modules(qr/^$pname$/i) ;
+    return $ret unless @dep_name_as_perl;
+
+    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 ;
@@ -432,9 +416,43 @@ sub check_perl_lib_dep {
     my @ideal_lib_dep ;
     my @ideal_dep_chain = (\@ideal_perl_dep);
 
-    my ($check_perl_lib, $get_perl_versions, $on_get_perl_versions) ;
+    my ($on_get_lib_version, $on_perl_check_done, $check_perl_lib, $get_perl_versions, $on_get_perl_versions) ;
+
+    my ($v_normal) ;
+
+    # check version for the first available version in Debian: debian
+    # dep may have no version specified but older versions can be found
+    # in CPAN that were never packaged in Debian
+    $on_get_lib_version = sub {
+        $async_log->debug("on_get_lib_version called with @_") ;
+        # get_available_version returns oldest first, like (etch,1.2,...)
+        my $oldest_lib_version_in_debian = $_[1] ;
+        # lob off debian release number
+        $oldest_lib_version_in_debian =~ s/-.*//;
+        my $check_v = $dep_v || $oldest_lib_version_in_debian ;
+        $logger->debug("dual life $dep_name has oldest debian $oldest_lib_version_in_debian, using $check_v");
+        my ($cpan_dep_v, $epoch_dep_v) ;
+
+        ($cpan_dep_v, $epoch_dep_v) = reverse split /:/ ,$check_v if defined $check_v ;
+        my $v_decimal = Module::CoreList->first_release(
+            $dep_name_as_perl[0],
+            version->parse( $cpan_dep_v )
+        );
+
+        return unless defined $v_decimal;
+
+        $v_normal = version->new($v_decimal)->normal;
+        $v_normal =~ s/^v//;    # loose the v prefix
+        if ( $logger->is_debug ) {
+            my $dep_str = $dep_name . ( defined $check_v ? ' ' . $check_v : '' );
+            $logger->debug("dual life $dep_str aka $dep_name_as_perl[0] found in Perl core $v_normal");
+        }
+        $self->check_versioned_dep( $on_perl_check_done , ['perl', '>=', $v_normal] );
+
+    };
+
     
-    my $on_perl_check_done =  sub {
+    $on_perl_check_done =  sub {
         my $has_older_perl = shift ;
         $async_log->debug("on_perl_check_done called") ;
         push @ideal_perl_dep, '>=', $v_normal if $has_older_perl;
@@ -497,8 +515,10 @@ sub check_perl_lib_dep {
         }
         $perl_dep_cv->send ;
     } ;
-    
-    $self->check_versioned_dep( $on_perl_check_done , ['perl', '>=', $v_normal] );
+
+    # 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 ;
@@ -509,7 +529,7 @@ sub check_perl_lib_dep {
 sub check_versioned_dep {
     my ($self, $callback ,$dep_info) = @_ ;
     my ( $pkg,  $oper,      $vers )    = @$dep_info;
-    $logger->debug("called with '", $self->struct_to_dep($dep_info),"'") if $logger->is_debug;
+    $logger->debug("called with '" . $self->struct_to_dep($dep_info) ."'") if $logger->is_debug;
 
     # special case to keep lintian happy
     $callback->(1) if $pkg eq 'debhelper' ;

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