[libconfig-model-dpkg-perl] 01/04: Dependency: show why a value was fixed with apply_fix
dod at debian.org
dod at debian.org
Wed Apr 26 15:46:28 UTC 2017
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 cf9d4f0cc98a71967589aaba6b376176017b2ff7
Author: Dominique Dumont <dod at debian.org>
Date: Wed Apr 26 17:21:25 2017 +0200
Dependency: show why a value was fixed with apply_fix
---
lib/Config/Model/Dpkg/Dependency.pm | 48 +++++++++++++++++++++----------------
1 file changed, 28 insertions(+), 20 deletions(-)
diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index 05ab7da..346b3cb 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -336,16 +336,17 @@ sub check_dependency {
}
my $old = $value ;
+ my @msgs;
foreach my $dep (@dep_chain) {
next unless ref($dep) ; # no need to check variables
- $self->check_or_fix_pkg_name($apply_fix, $dep, $old) ;
- $self->check_or_fix_essential_package($apply_fix, $dep, $old) ;
- $self->check_or_fix_dep($apply_fix, $dep, $old) ;
+ $self->check_or_fix_pkg_name($apply_fix, $dep, $old, \@msgs) ;
+ $self->check_or_fix_essential_package($apply_fix, $dep, \@msgs) ;
+ $self->check_or_fix_dep($apply_fix, $dep, $old, \@msgs) ;
}
- $self->check_depend_chain($apply_fix, \@dep_chain, $old ) ;
+ $self->check_depend_chain($apply_fix, \@dep_chain, $old, \@msgs) ;
# "ideal" dependency is always computed, but it does not always change
my $new = $self->struct_to_dep(@dep_chain);
@@ -358,13 +359,14 @@ sub check_dependency {
{
no warnings 'uninitialized';
- $self->_store_fix( $old, $new ) if $apply_fix and $new ne $old;
+ my $msg = join('; ', @msgs);
+ $self->_store_fix( $old, $new, $msg ) if $apply_fix and @msgs and $new ne $old;
}
return ($ok, $new) ;
}
sub check_debhelper_version {
- my ($self, $apply_fix, $dep_info) = @_ ;
+ my ($self, $apply_fix, $dep_info, $msgs) = @_ ;
my $dep_name = $dep_info->{name};
my ($oper, $dep_v) = @{ $dep_info->{dep} || []};
@@ -396,14 +398,15 @@ sub check_debhelper_version {
# $show_rel avoids undef warnings
my $show_rel = join(' ', map { $_ || ''} ($oper, $dep_v));
+ my $msg = "should be (>= $compat_value) not ($show_rel) because compat is $compat_value" ;
if ($apply_fix) {
$dep_info->{dep} = [ '>=', $compat_value] ; # notify_change called in check_value
$logger->info("fixed debhelper dependency from "
."$dep_name $show_rel -> ".$min_dep->unparse." (for compat $compat_value)");
+ push $msgs->@*, $msg;
}
else {
$self->{nb_of_fixes}++ ;
- my $msg = "should be (>= $compat_value) not ($show_rel) because compat is $compat_value" ;
$self->add_warning( $msg );
$logger->info("will warn: $msg (fix++)");
}
@@ -465,7 +468,7 @@ sub struct_to_dep {
# will modify @input (array of ref) when applying fix
sub check_depend_chain {
- my ($self, $apply_fix, $input, $old) = @_ ;
+ my ($self, $apply_fix, $input, $old, $msgs) = @_ ;
my ($actual_dep, $skip) = $self->struct_to_dep (@$input);
my $ret = 1 ;
@@ -486,7 +489,7 @@ sub check_depend_chain {
$logger->debug("scanning dependency $dep_name"
.(defined $dep_v ? " $dep_v" : ''));
if ($dep_name =~ /lib[\w+\-]+-perl/) {
- $ret &&= $self->check_perl_lib_dep ($apply_fix, $actual_dep, $depend,$input);
+ $ret &&= $self->check_perl_lib_dep ($apply_fix, $actual_dep, $depend, $input, $msgs);
last;
}
}
@@ -511,7 +514,7 @@ sub extract_cpan_version {
# called through check_depend_chain
# does modify $input when applying fix
sub check_perl_lib_dep {
- my ($self, $apply_fix, $actual_dep, $depend, $input) = @_;
+ my ($self, $apply_fix, $actual_dep, $depend, $input, $msgs) = @_;
my $dep_name = $depend->{name};
my ($oper, $dep_v) = @{ $depend->{dep} || []};
@@ -625,11 +628,13 @@ sub check_perl_lib_dep {
unless defined $ideal_dep;
if ( $actual_dep ne $ideal_dep ) {
+ my $msg = "Dependency of dual life package should be '$ideal_dep' not '$actual_dep'";
if ($apply_fix) {
@$input = @ordered_ideal_dep ; # notify_change called in check_value
if ($logger->is_info) {
$logger->info("fixed dependency with: $ideal_dep, was ". $self->struct_to_dep($depend));
}
+ push $msgs->@*, $msg;
}
else {
$self->{nb_of_fixes}++;
@@ -711,7 +716,7 @@ sub has_older_version_than {
# New subroutine "check_essential_package" extracted - Thu Aug 30 14:14:32 2012.
#
sub check_or_fix_essential_package {
- my ( $self, $apply_fix, $dep_info ) = @_;
+ my ( $self, $apply_fix, $dep_info, $msgs ) = @_;
my $pkg = $dep_info->{name};
my ($oper, $vers) = @{ $dep_info->{dep} || []};
$logger->debug("called with '", scalar $self->struct_to_dep($dep_info), "' and fix $apply_fix") if $logger->is_debug;
@@ -725,12 +730,13 @@ sub check_or_fix_essential_package {
if ($is_essential and not defined $oper) {
$logger->debug( "found unversioned dependency on essential package: $pkg");
+ my $msg = "unnecessary unversioned dependency on essential package: $pkg";
if ($apply_fix) {
%$dep_info = ();
$logger->info("fix: removed unversioned essential dependency on $pkg");
+ push $msgs->@*, $msg;
}
else {
- my $msg = "unnecessary unversioned dependency on essential package: $pkg";
$self->add_warning($msg);
$self->{nb_of_fixes}++;
$logger->info("will warn: $msg (fix++)");
@@ -744,7 +750,7 @@ my %pkg_replace = (
) ;
sub check_or_fix_pkg_name {
- my ( $self, $apply_fix, $dep_info, $old ) = @_;
+ my ( $self, $apply_fix, $dep_info, $old, $msgs ) = @_;
my $pkg = $dep_info->{name};
$logger->debug("called with '", scalar $self->struct_to_dep($dep_info), "' and fix $apply_fix")
@@ -752,12 +758,13 @@ sub check_or_fix_pkg_name {
my $new = $pkg_replace{$pkg} ;
if ( $new ) {
+ my $msg = "dubious package name: $pkg. Preferred package is $new";
if ($apply_fix) {
$logger->info("fix: changed package name from $pkg to $new");
$dep_info->[0] = $pkg = $new;
+ push $msgs->@*, $msg;
}
else {
- my $msg = "dubious package name: $pkg. Preferred package is $new";
$self-> add_warning ($msg);
$self->{nb_of_fixes}++;
$logger->info("will warn: $msg (fix++)");
@@ -781,7 +788,7 @@ sub check_or_fix_pkg_name {
}
sub check_or_fix_dep {
- my ( $self, $apply_fix, $dep_info, $old ) = @_;
+ my ( $self, $apply_fix, $dep_info, $old, $msgs ) = @_;
my $pkg = $dep_info->{name};
$logger->debug("called with '", scalar $self->struct_to_dep($dep_info), "' and fix $apply_fix")
@@ -791,27 +798,28 @@ sub check_or_fix_dep {
# pkg may be cleaned up during fix
}
elsif ( $pkg eq 'debhelper' ) {
- $self->check_debhelper_version( $apply_fix, $dep_info );
+ $self->check_debhelper_version( $apply_fix, $dep_info, $msgs );
}
else {
my ( $vers_dep_ok, @list ) = $self->check_versioned_dep( $dep_info );
- $self->warn_or_remove_vers_dep ($apply_fix, $dep_info, \@list) unless $vers_dep_ok ;
+ $self->warn_or_remove_vers_dep ($apply_fix, $dep_info, \@list, $msgs) unless $vers_dep_ok ;
}
}
sub warn_or_remove_vers_dep {
- my ( $self, $apply_fix, $dep_info, $list ) = @_;
+ my ( $self, $apply_fix, $dep_info, $list, $msgs ) = @_;
my $pkg = $dep_info->{name};
my ($oper, $vers) = @{ $dep_info->{dep} || []};
+ my $msg = "unnecessary versioned dependency: ". $self-> struct_to_dep($dep_info)
+ . ". Debian has @$list";
if ($apply_fix) {
delete $dep_info->{dep}; # remove versioned dep, notify_change called in check_value
$logger->info("fix: removed versioned dependency from $dep_info->{name} -> $pkg");
+ push $msgs->@*, $msg;
}
else {
$self->{nb_of_fixes}++;
- my $msg = "unnecessary versioned dependency: ". $self-> struct_to_dep($dep_info)
- . ". Debian has @$list";
$self->add_warning( $msg);
$logger->info("will warn: $msg (fix++)");
}
--
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