diff options
Diffstat (limited to 'lib/Youri/Check/Input/Missing.pm')
-rw-r--r-- | lib/Youri/Check/Input/Missing.pm | 138 |
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; |