1 files changed, 97 insertions, 0 deletions
diff --git a/lib/Youri/Submit/Test/Rpmlint.pm b/lib/Youri/Submit/Test/Rpmlint.pm
new file mode 100644
index 0000000..170d4c3
--- /dev/null
+++ b/lib/Youri/Submit/Test/Rpmlint.pm
@@ -0,0 +1,97 @@
+# $Id: Rpmlint.pm 1687 2007-06-28 22:44:07Z guillomovitch $
+package Youri::Submit::Test::Rpmlint;
+
+=head1 NAME
+
+Youri::Submit::Test::Rpmlint - Rpmlint-based test
+
+=head1 DESCRIPTION
+
+This test plugin wraps rpmlint, and reject packages triggering results
+declared as fatal.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base qw/Youri::Submit::Step/;
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Submit::Test::Rpmlint object.
+
+Specific parameters:
+
+=over
+
+=item results $results
+
+List of rpmlint result id considered as fatal.
+
+=item path $path
+
+Path to the rpmlint executable (default: /usr/bin/rpmlint)
+
+=item config $config
+
+Specific rpmlint configuration.
+
+=back
+
+=cut
+
+
+sub _init {
+    my $self   = shift;
+    my %options = (
+        results  => undef,
+        path   => '/usr/bin/rpmlint',
+        config => '',
+        @_
+    );
+
+    croak "no results to test" unless $options{results};
+    croak "results should be an arrayref" unless ref $options{results} eq 'ARRAY';
+
+    $self->{_results} = map { $_ => 1 } @{$options{results}};
+    $self->{_path} = $options{path};
+    $self->{_config} = $options{config};
+}
+
+sub process_packages {
+    my ($self, $packages, $repository, $target, $context) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $errors;
+
+    foreach my $package (@$packages) {
+        my $command =
+            $self->{_path} . ' ' .
+            ($self->{_config} ? "-f $self->{_config} " : '' ) . 
+            $package->as_file();
+
+        open(my $input, '-|', $command) or croak "Can't run $command: $!";
+        my $pattern = qr/^[EW]: \S+ (\S+) (.*)$/;
+        while (my $line = <$input>) {
+            next unless $line =~ $pattern;
+            my $id = $1;
+            my $value = $2;
+            $errors .= "$id $value"
+                if $self->{_results}->{$id};
+        }
+        close $input;
+    }
+
+    croak $errors if $errors;
+}
+=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;