From f36deffb742a8d801280606006807f2ad95f3849 Mon Sep 17 00:00:00 2001
From: Pascal Rigaux <pixel@mandriva.com>
Date: Fri, 29 Jun 2007 13:36:22 +0000
Subject: prepare merge

---
 lib/Youri/Submit/Test/Rpmlint.pm | 89 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 89 insertions(+)
 create mode 100644 lib/Youri/Submit/Test/Rpmlint.pm

(limited to 'lib/Youri/Submit/Test/Rpmlint.pm')

diff --git a/lib/Youri/Submit/Test/Rpmlint.pm b/lib/Youri/Submit/Test/Rpmlint.pm
new file mode 100644
index 0000000..a38f2ba
--- /dev/null
+++ b/lib/Youri/Submit/Test/Rpmlint.pm
@@ -0,0 +1,89 @@
+# $Id$
+package Youri::Submit::Check::Rpmlint;
+
+=head1 NAME
+
+Youri::Submit::Check::Rpmlint - Rpmlint-based check
+
+=head1 DESCRIPTION
+
+This check plugin wraps rpmlint, and reject packages triggering results
+declared as fatal.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base qw/Youri::Submit::Check/;
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Submit::Check::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 check" unless $options{results};
+    croak "fatal should be an arrayref" unless ref $options{results} eq 'ARRAY';
+
+    $self->{_config} = $options{config};
+    $self->{_path} = $options{path};
+    $self->{_pattern} = '^(?:' . join('|', @{$options{results}}) . ')$';
+}
+
+sub run {
+    my ($self, $package, $repository, $target, $define) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my @errors;
+
+    my $command = "$self->{_path} -f $self->{_config} " . $package->as_file();
+    open(RPMLINT, "$command |") or die "Can't run $command: $!";
+    while (my $line = <RPMLINT>) {
+        my ($id, $value) = $line =~ /^[EW]: \S+ (\S+)(.*)$/;
+	$id or next;
+        if ($id =~ /$self->{_pattern}/o) {
+            push(@errors, "$id$value");
+        }
+    }
+
+    return @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;
-- 
cgit v1.2.1