# $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;