[SCM] Debian native package for Config::Model::Dpkg branch, master, updated. debian/2.036-17-gdc3acc3
Dominique Dumont
dod at debian.org
Mon May 20 14:21:15 UTC 2013
The following commit has been merged in the master branch:
commit d497d3dcdb1e493606f6ee2cdab08ff4c15d2876
Author: Dominique Dumont <dod at debian.org>
Date: Mon May 20 16:03:47 2013 +0200
now dependency check and fix is called *after* parsing
diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index 834ed34..bdd5e37 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -155,12 +155,6 @@ sub check_dependency {
my ($value, $check, $silent, $notify_change, $ok, $callback,$apply_fix)
= @args{qw/value check silent notify_change ok callback fix/} ;
- # check_value 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 ;
-
# value is one dependency, something like "perl ( >= 1.508 )"
# or exim | mail-transport-agent or gnumach-dev [hurd-i386]
@@ -169,52 +163,80 @@ sub check_dependency {
# to get package list
# wget -q -O - 'http://qa.debian.org/cgi-bin/madison.cgi?package=perl-doc&text=on'
- $value = $self->{data} if $apply_fix ; # check_value may have modified data in this case
-
- my $old = $value ;
- my @fixed_dep ; # filled by callback and used when applying fixes
-
- # this callback will be launched when all checks are done. this can be at
- # the 'end' call at this end of this sub if all calls of check_depend are
- # synchronous (which may be the case if all dependency informations are in cache)
- # or it can be in one of the call backs
- my $on_check_all_done = sub {
- if ($logger->is_debug) {
- my $new = $value // '<undef>' ;
- $async_log->debug("in check_dependency callback for ",$self->composite_name,
- " ($new) fix is $apply_fix")
- if $async_log->is_debug;
- no warnings 'uninitialized';
- $logger->debug("'$old' done".($apply_fix ? " changed to '$new'" : ''));
+ my @dep_chain ;
+ if (defined $value) {
+ $logger->debug("calling check_depend with Parse::RecDescent with '$value'");
+ my $ret = dep_parser->dependency ( $value ) ;
+ my $ok = shift @$ret ;
+ if ($ok) {
+ @dep_chain = @$ret ;
}
+ else {
+ $self->add_error(@$ret) ;
+ }
+ }
+
+ # 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 ;
- # "ideal" dependency is always computed, but it does not always change
- my $new = $self->struct_to_dep(@fixed_dep) ;
+ my $old = $value ;
- {
- no warnings 'uninitialized';
- $self->_store_fix($old, $new) if $apply_fix and $new ne $old;
- }
- $callback->(%args) if $callback ;
+ 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($on_check_all_done) ;
+ $pending_check->begin($check_depend_chain_cb) ;
- if (defined $value) {
- $logger->debug("calling check_depend with Parse::RecDescent with '$value'");
- dep_parser->check_depend ( $value,1,$self,$pending_check,$apply_fix, \@fixed_dep)
- // $self->add_error("dependency '$value' does not match grammar") ;
-
+ 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_pkg_name($apply_fix, $dep, $old, $cb) ; # async
}
+
$async_log->debug("end for ",$self->composite_name) if $async_log->is_debug;
$pending_check->end;
}
-sub check_debhelper {
+# this callback will be launched when all checks are done. this can be at
+# the 'end' call at this end of this sub if all calls of check_depend are
+# synchronous (which may be the case if all dependency informations are in cache)
+# or it can be in one of the call backs
+sub on_check_all_done {
+ my ($self, $apply_fix, $dep_chain, $old, $next) = @_ ;
+
+ # "ideal" dependency is always computed, but it does not always change
+ my $new = $self->struct_to_dep(@$dep_chain);
+
+ if ( $logger->is_debug ) {
+ my $new //= '<undef>';
+ $async_log->debug( "in on_check_all_done callback for ",
+ $self->composite_name, " ($new) fix is $apply_fix" )
+ if $async_log->is_debug;
+ no warnings 'uninitialized';
+ $logger->debug( "'$old' done" . ( $apply_fix ? " changed to '$new'" : '' ) );
+ }
+
+ {
+ no warnings 'uninitialized';
+ $self->_store_fix( $old, $new ) if $apply_fix and $new ne $old;
+ }
+ $next->();
+}
+
+sub check_debhelper_version {
my ($self, $apply_fix, $depend) = @_ ;
- my ( $dep_name, $oper, $dep_v ) = @$depend ;
+ my ( $dep_name, $oper, $dep_v, @archs ) = @$depend ;
my $dep_string = $self->struct_to_dep($depend) ;
my $lintian_dep = Lintian::Relation->new( $dep_string ) ;
@@ -282,11 +304,17 @@ sub struct_to_dep {
foreach my $d (@input) {
my $line = '';
# empty str or ref to empty array are skipped
- if( ref ($d) and @$d and @$d) {
+ if( ref ($d) and @$d) {
$line .= "$d->[0]";
+
# skip test for relations like << or <
$skip ++ if defined $d->[1] and $d->[1] =~ /</ ;
$line .= " ($d->[1] $d->[2])" if defined $d->[2];
+
+ if (@$d > 3) {
+ $line .= ' ['. join(' ',@$d[3..$#$d]) .']' ;
+ }
+
}
elsif (not ref($d) and $d) {
$line .= $d ;
@@ -300,13 +328,12 @@ sub struct_to_dep {
return wantarray ? ($actual_dep, $skip) : $actual_dep ;
}
-# called in Parse::RecDescent grammar
# @input contains the alternates dependencies (without '|') of one dependency values
# a bit like @input = split /|/, $dependency
# will modify @input (array of ref) when applying fix
sub check_depend_chain {
- my ($self, $pending_check, $apply_fix, $input) = @_ ;
+ my ($self, $apply_fix, $input, $old) = @_ ;
my ($actual_dep, $skip) = $self->struct_to_dep (@$input);
my $ret = 1 ;
@@ -320,7 +347,6 @@ sub check_depend_chain {
}
$async_log->debug("begin check alternate deps for $actual_dep") ;
- $pending_check->begin;
foreach my $depend (@$input) {
if (ref ($depend)) {
# is a dependency (not a variable a la ${perl-Depends})
@@ -329,14 +355,12 @@ 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
+ # 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;
}
}
}
- $async_log->debug("waiting end check alternate deps for $actual_dep") ;
- $pending_check->end ;
$async_log->debug("end check alternate deps for $actual_dep") ;
if ($logger->is_debug and $apply_fix) {
@@ -348,7 +372,7 @@ sub check_depend_chain {
return $ret ;
}
-# called in Parse::RecDescent grammar through check_depend_chain
+# called through check_depend_chain
# does modify $input when applying fix
sub check_perl_lib_dep {
my ($self, $apply_fix, $pname, $actual_dep, $depend, $input) = @_;
@@ -480,7 +504,8 @@ sub check_versioned_dep {
my $cb = sub {
my @dist_version = @_ ;
- $async_log->debug("in check_versioned_dep callback with @$dep_info -> @dist_version");
+ $async_log->debug("in check_versioned_dep callback with ". $self->struct_to_dep($dep_info)
+ ." -> @dist_version") if $async_log->is_debug;
if ( @dist_version # no older for unknow packages
and defined $oper
@@ -548,7 +573,7 @@ sub check_or_fix_essential_package {
my $is_essential = 0;
$is_essential++ if (defined $cache_item and $cache_item->get('Flags') =~ /essential/i);
- if ($is_essential and @$dep_info == 1) {
+ if ($is_essential and not defined $oper) {
$logger->debug( "found unversioned dependency on essential package: $pkg");
if ($apply_fix) {
@$dep_info = ();
@@ -569,9 +594,11 @@ my %pkg_replace = (
) ;
sub check_or_fix_pkg_name {
- my ( $self, $pending_check_cv, $apply_fix, $dep_info ) = @_;
+ my ( $self, $apply_fix, $dep_info, $old, $next ) = @_;
my ( $pkg, $oper, $vers ) = @$dep_info;
- $logger->debug("called with '", scalar $self->struct_to_dep($dep_info), "' and fix $apply_fix") if $logger->is_debug;
+
+ $logger->debug("called with '", scalar $self->struct_to_dep($dep_info), "' and fix $apply_fix")
+ if $logger->is_debug;
my $new = $pkg_replace{$pkg} ;
if ( $new ) {
@@ -590,55 +617,59 @@ sub check_or_fix_pkg_name {
# check if this package is defined in current control file
if ($self->grab(step => "- - binary:$pkg", qw/mode loose autoadd 0/)) {
$logger->debug("dependency $pkg provided in control file") ;
- return;
+ $next->() ;
}
+ else {
+ my $cb = sub {
+ if ( @_ == 0 ) {
+ # no version found for $pkg
+ # don't know how to distinguish virtual package from source package
+ $logger->debug("unknown package $pkg");
+ $self->add_warning(
+ "package $pkg is unknown. Check for typos if not a virtual package.");
+ }
+ $async_log->debug("callback for check_or_fix_pkg_name -> end for $pkg");
+ $next->( );
+ };
- my $cb = sub {
- if (@_ == 0) { # no version found for $pkg
- # don't know how to distinguish virtual package from source package
- $logger->debug("unknown package $pkg") ;
- $self->add_warning("package $pkg is unknown. Check for typos if not a virtual package.") ;
- }
- $async_log->debug("callback for check_or_fix_pkg_name -> end for $pkg") ;
- $pending_check_cv->end ;
- } ;
-
- # is asynchronous
- $async_log->debug("begin on $pkg") ;
- $pending_check_cv->begin ;
- $self->get_available_version($cb,$pkg ) ;
- # if no pkg was found
+ # is asynchronous
+ $async_log->debug("begin on $pkg");
+ $self->get_available_version( $cb, $pkg );
+
+ # if no pkg was found
+ }
}
# all subs but one there are synchronous
sub check_or_fix_dep {
- my ( $self, $pending_check_cv, $apply_fix, $dep_info ) = @_;
+ my ( $self, $apply_fix, $dep_info, $old, $next ) = @_;
my ( $pkg, $oper, $vers, @archs ) = @$dep_info;
- $logger->debug("called with '", scalar $self->struct_to_dep($dep_info), "' and fix $apply_fix") if $logger->is_debug;
+ $logger->debug("called with '", scalar $self->struct_to_dep($dep_info), "' and fix $apply_fix")
+ if $logger->is_debug;
- if ( $pkg eq 'debhelper' ) {
- $self->check_debhelper( $apply_fix, $dep_info );
- return;
+ if(not defined $pkg) {
+ # pkg may be cleaned up during fix
+ $next->() ;
}
+ elsif ( $pkg eq 'debhelper' ) {
+ $self->check_debhelper_version( $apply_fix, $dep_info );
+ $next->() ;
+ }
+ else {
+ my $cb = sub {
+ my ( $vers_dep_ok, @list ) = @_ ;
+ $async_log->debug("callback for check_or_fix_dep with @_") ;
+ $self->warn_or_remove_vers_dep ($apply_fix, $dep_info, \@list) unless $vers_dep_ok ;
- $self->check_or_fix_pkg_name($pending_check_cv, $apply_fix, $dep_info) ;
-
- my $cb = sub {
- my ( $vers_dep_ok, @list ) = @_ ;
- $async_log->debug("callback for check_or_fix_dep with @_") ;
- $self->warn_or_remove_vers_dep ($apply_fix, $dep_info, \@list) unless $vers_dep_ok ;
-
- $self->check_or_fix_essential_package ($apply_fix, $dep_info);
- $async_log->debug("callback for check_or_fix_dep -> end") ;
- $pending_check_cv->end ;
- } ;
- $async_log->debug("begin") ;
- $pending_check_cv->begin ;
- $self->check_versioned_dep($cb, $dep_info );
+ $async_log->debug("callback for check_or_fix_dep -> end") ;
+ $next->() ;
+ } ;
+ $async_log->debug("begin") ;
+ $self->check_versioned_dep($cb, $dep_info );
- return 1;
+ }
}
sub warn_or_remove_vers_dep {
--
Debian native package for Config::Model::Dpkg
More information about the Pkg-perl-cvs-commits
mailing list