warn or fix about too old package relationship

i.e. a dependency or a conflicts on a package that is no longer in
oldstable.

1 files changed, 38 insertions, 3 deletions

diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index 7b6769f9..bd55ec33 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -382,6 +382,7 @@ sub check_dependency ($self, %args){
     foreach my $dep (@dep_chain) {
         next unless ref($dep) ; # no need to check debhelper variables
         $self->check_or_fix_pkg_name($apply_fix, $dep, $old, \@msgs) ;
+        $self->check_or_fix_too_old_pkg($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) ;
     }
@@ -672,8 +673,7 @@ sub has_older_version_than {
         my ($d,$v) = splice @$dist_version,0,2 ;
 
         push @list, "$d -> $v;" ;
-
-        if ($vs->compare($vers,$v) > 0 ) {
+        if ($d !~ /oldold/ and $vs->compare($vers,$v) > 0 ) {
             $has_older = 1 ;
         }
     }
@@ -761,6 +761,42 @@ sub check_or_fix_pkg_name {
     return;
 }
 
+sub check_or_fix_too_old_pkg ( $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")
+        if $logger->is_debug;
+
+    if (not defined $pkg) {
+        # pkg may be cleaned up during fix
+        return;
+    }
+
+    my @dist_version = $self->get_available_version( $pkg ) ;
+
+    my $is_too_old = scalar @dist_version ? 1 : 0;
+    while (@dist_version) {
+        my ($d,$v) = splice @dist_version,0,2 ;
+        $is_too_old = 0 unless $d =~ /oldold/;
+    }
+
+    if ($is_too_old) {
+        $logger->debug("Found dependency on too old package: $pkg");
+        my $msg = "applied on too old package: $pkg";
+        if ($apply_fix) {
+            %$dep_info = ();
+            $logger->info("fix: removed relation with too old $pkg package");
+            push $msgs->@*, $msg;
+        }
+        else {
+            $self->add_warning($msg);
+            $self->{nb_of_fixes}++;
+            $logger->info("will warn: $msg (fix++)");
+        }
+    }
+    return $is_too_old;
+}
+
 sub check_or_fix_dep {
     my ( $self, $apply_fix, $dep_info, $old, $msgs ) = @_;
     my $pkg = $dep_info->{name};
@@ -956,7 +992,6 @@ sub extract_madison_info ($json) {
 	foreach my $name ( keys $data->%* ) {
         my %avail;
         foreach my $dist (keys $data->{$name}->%*) {
-            next if $dist =~ /oldold/; # skip too old versions
             foreach my $available_v (keys $data->{$name}{$dist}->%*) {
                 my $arches = $data->{$name}{$dist}{$available_v}{architectures};
                 # see #841667: relevant pkg version is found in arch all or arch amd64