1 files changed, 138 insertions, 0 deletions
diff --git a/lib/Youri/Check/Input/Missing.pm b/lib/Youri/Check/Input/Missing.pm
new file mode 100644
index 0000000..ece034d
--- /dev/null
+++ b/lib/Youri/Check/Input/Missing.pm
@@ -0,0 +1,138 @@
+package Youri::Check::Input::Missing;
+
+=head1 NAME
+
+Youri::Check::Input::Missing - Check components consistency
+
+=head1 DESCRIPTION
+
+This plugin checks consistency between package components, and report outdated
+ones.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use List::MoreUtils qw/all any/;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        component
+        arch
+        revision
+        error
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Missing object.
+
+No specific parameters.
+
+=cut
+
+sub prepare {
+    my ($self, @medias)  = @_;
+    croak "Not a class method" unless ref $self;
+    $self->{_srcs} = ();
+    foreach my $media (@medias) {
+        # only index source media
+        next unless $media->get_type() eq 'source';
+
+        my $media_id = $media->get_id();
+        $self->{_medias}->{$media_id} = 1;
+        print STDERR "Indexing media $media_id packages\n" if $self->{_verbose};
+
+        my $index = sub {
+            my ($package) = @_;
+            $self->{_srcs}->{$media_id}->{$package->get_name()} =
+                $package->get_version() . '-' . $package->get_release();
+        };
+
+        $media->traverse_headers($index);
+    }
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    # this is a binary media check only
+    return unless $media->get_type() eq 'binary';
+
+    my @allowed_ids = $media->allow_srcs();
+
+    # abort unless all allowed medias are present
+    foreach my $id (@allowed_ids) {
+    unless ($self->{_medias}->{$id}) {
+            carp "Missing media $id, aborting";
+            return;
+        }
+    }
+
+    my $class = $media->get_package_class();
+
+    my $check_package = sub {
+        my ($package) = @_;
+        my $canonical_name = $package->get_canonical_name();
+
+        my $bin_revision =
+            $package->get_version() . '-' . $package->get_release();
+
+        my $src_revision;
+        foreach my $id (@allowed_ids) {
+            $src_revision = $self->{_srcs}->{$id}->{$canonical_name};
+            last if $src_revision;
+        }
+
+        if ($src_revision) {
+            # check if revision match
+            unless ($src_revision eq $bin_revision) {
+                if ($class->compare_versions($src_revision, $bin_revision) > 0) {
+                    # binary package is obsolete
+                    $resultset->add_result($self->{_id}, $media, $package, {
+                        component => $package->get_name(),
+                        arch      => $package->get_arch(),
+                        revision  => $bin_revision,
+                        error     => "Obsolete binaries (source $src_revision found)",
+                    });
+                } else {
+                    # source package is obsolete
+                    $resultset->add_result($self->{_id}, $media, $package, {
+                        component => $package->get_canonical_name(),
+                        arch      => 'src',
+                        revision  => $src_revision,
+                        error     => "Obsolete source (binaries $bin_revision found)",
+                    });
+                }
+            }
+        } else {
+            $resultset->add_result($self->{_id}, $media, $package, {
+                component => $package->get_name(),
+                arch      => $package->get_arch(),
+                revision  => $bin_revision,
+                error     => "Missing source package",
+            });
+        }
+    };
+
+    $media->traverse_headers($check_package);
+}
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;