1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
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;
|
