From a4f149873af1e9cff9ab0829adfcd3eca1a3780d Mon Sep 17 00:00:00 2001
From: Nicolas Vigier <boklm@mageia.org>
Date: Thu, 6 Jan 2011 01:07:55 +0000
Subject: search in core, nonfree, tainted instead of main, contrib

---
 lib/Youri/Check/Input/Dependencies.pm | 162 ++++++++++++++++++++++++++++++++++
 1 file changed, 162 insertions(+)
 create mode 100644 lib/Youri/Check/Input/Dependencies.pm

(limited to 'lib/Youri/Check/Input/Dependencies.pm')

diff --git a/lib/Youri/Check/Input/Dependencies.pm b/lib/Youri/Check/Input/Dependencies.pm
new file mode 100644
index 0000000..6f148d5
--- /dev/null
+++ b/lib/Youri/Check/Input/Dependencies.pm
@@ -0,0 +1,162 @@
+# $Id: Dependencies.pm 1179 2006-08-05 08:30:57Z warly $
+package Youri::Check::Input::Dependencies;
+
+=head1 NAME
+
+Youri::Check::Input::Dependencies - Check dependencies consistency
+
+=head1 DESCRIPTION
+
+This class checks dependencies consistency.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use Youri::Package;
+use base 'Youri::Check::Input';
+
+use constant MEDIA => 0;
+use constant RANGE => 1;
+
+sub columns {
+    return qw/
+        arch
+        file
+        error
+        level
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+sub prepare {
+    my ($self, @medias) = @_;
+    croak "Not a class method" unless ref $self;
+
+    foreach my $media (@medias) {
+        my $media_id = $media->get_id();
+        $self->{_medias}->{$media_id} = 1;
+        print STDERR "Indexing media $media_id dependencies\n"
+            if $self->{_verbose};
+
+        my $index = sub {
+            my ($package) = @_;
+
+            # index provides
+            foreach my $provide ($package->get_provides()) {
+                push(
+                    @{$self->{_provides}->{$provide->[Youri::Package::DEPENDENCY_NAME]}},
+                    [ $media_id, $provide->[Youri::Package::DEPENDENCY_RANGE] ]
+                );
+            }
+
+            # index files
+            foreach my $file ($package->get_files()) {
+                push(
+                    @{$self->{_files}->{$file->[Youri::Package::FILE_NAME]}},
+                    [ $media_id, undef ]
+                );
+            }
+        };
+        $media->traverse_headers($index);
+    }
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my @allowed_ids = $media->allow_deps();
+
+    # abort unless all allowed medias are present
+    foreach my $id (@allowed_ids) {
+        unless ($self->{_medias}->{$id}) {
+            carp "Missing media $id, aborting";
+            return;
+        }
+    }
+
+    # index allowed medias
+    my %allowed_ids = map { $_ => 1 } @allowed_ids;
+    my $allowed_ids = join(",", @allowed_ids);
+
+    my $class = $media->get_package_class();
+
+    my $check = sub {
+        my ($package) = @_;
+
+        my $arch = $package->get_arch();
+        my $name = $package->get_name();
+
+        foreach my $require ($package->get_requires()) {
+
+            my $found =
+                substr($require->[Youri::Package::DEPENDENCY_NAME], 0, 1) eq '/' ?
+                    $self->{_files}->{$require->[Youri::Package::DEPENDENCY_NAME]} :
+                    $self->{_provides}->{$require->[Youri::Package::DEPENDENCY_NAME]};
+
+            my @found = $found ? @$found : ();
+
+            if (!@found) {
+                $resultset->add_result($self->{_id}, $media, $package, {
+                    arch  => $arch,
+                    file  => $name,
+                    error => "$require->[Youri::Package::DEPENDENCY_NAME] not found",
+                    level => Youri::Check::Input::ERROR
+                });
+                next;
+            }
+
+            my @found_in_media =
+                grep { $allowed_ids{$_->[MEDIA]} }
+                @found;
+
+            if (!@found_in_media) {
+                $resultset->add_result($self->{_id}, $media, $package, {
+                    arch  => $arch,
+                    file  => $name,
+                    error => "$require->[Youri::Package::DEPENDENCY_NAME] found in incorrect media $_->[MEDIA] (allowed $allowed_ids)",
+                    level => Youri::Check::Input::ERROR
+                }) foreach @found;
+                next;
+            }
+
+            next unless $require->[Youri::Package::DEPENDENCY_RANGE];
+
+            my @found_in_range =
+                grep {
+                    !$_->[RANGE] ||
+                    $class->compare_ranges(
+                        $require->[Youri::Package::DEPENDENCY_RANGE],
+                        $_->[RANGE]
+                    )
+                } @found_in_media;
+
+            if (!@found_in_range) {
+                $resultset->add_result($self->{_id}, $media, $package, {
+                    arch  => $arch,
+                    file  => $name,
+                    error => "$require->[Youri::Package::DEPENDENCY_NAME] found with incorrect range $_->[RANGE] (needed $require->[Youri::Package::DEPENDENCY_RANGE])",
+                    level => Youri::Check::Input::ERROR
+                }) foreach @found_in_media;
+                next;
+            }
+        }
+    };
+
+    $media->traverse_headers($check);
+}
+
+=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;
-- 
cgit v1.2.1