File Coverage

lib/CPAN/Test/Reporter.pm

Criterion	Covered	Total	%
statement	11	35	31.4
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	15	39	38.4

#!/usr/bin/perl -w

#
# Kirrily "Skud" Robert
# $Id$

use strict;

package CPAN::Test::Reporter;

use Getopt::Long;
use Mail::Send;
use Config;
use Carp;
use CPAN;

use vars '$VERSION';
$VERSION = '0.02';

=pod

=head1 NAME

CPAN::Test::Reporter - Report test results of a package retrieved from CPAN

=head1 SYNOPSIS

    my $report = CPAN::Test::Reporter->new;
    $report->which_perl(path to the perl binary we tested with);
    $report->grade(pass|fail|na|unknown);
    $report->package(module name);
    $report->test_results(our build and/or make test results);
    $report->comments(other commentary on the module);
    $report->send(to whom);

=head1 DESCRIPTION

CPAN::Test::Reporter uniformly posts package test results in support of the
cpan-testers project.  See B
for details.

NOTE TO TESTERS: this module will currently send its output email to
[e-mail], which might not be what you want.  You can set
$CPAN::Test::Reporters::CPAN_TESTERS to another email address if you
prefer.

=cut

my $CPAN_TESTERS = '[e-mail]';
use vars '%Config';

=head2 new()

Creates a new reporter object.

=for testing
BEGIN: use_ok('CPAN::Test::Reporter', "use CPAN::Test::Reporter");
my $r = new CPAN::Test::Reporter;
ok($r->isa('CPAN::Test::Reporter'), "Got a CPAN::Test::Reporter object");

=cut

sub new  {
    my $self = {};

    $self->{comments} = "[ None ]";
    bless $self;
    return $self;
}


=head2 grade($grade)

grade($grade) indicates the success or failure of the package's builtin
tests, and is one of:

    grade     meaning
    -----     -------
    pass      all tests included with the package passed
    fail      some tests failed
    na        the package does not work on this platform
    unknown   the package did not include tests

=for testing
my $r = new CPAN::Test::Reporter;
$r->grade('pass');
is($r->{grade}, 'pass', "Set the grade");

=cut

sub grade {
    my ($self, $grade) = @_;
    my %grades = (     # Legal grades:
        'pass'      => "all tests pass",
        'fail'      => "some tests fail",
        'na'        => "package will not work on this platform",
        'unknown'   => "package did not include tests",
    );

    Carp::carp "grade argument is required" unless $grade;
    Carp::carp "grade '$grade' is invalid" unless $grades{$grade};

    $self->{grade} = $grade;
}

=head2 which_perl($path)

Specifies the version of perl you just used to test the module.

my $r = new CPAN::Test::Reporter;
$r->which_perl('5.6.1');
is($r->{which_perl}, '5.6.1', "Set the perl version");

=cut

sub which_perl {
    my ($self, $version) = @_;
    $self->{which_perl} = $version;
}

=head2 package($module)

Sets the name of the package you're working on, for example Foo-Bar-0.01
There are no restrictions on what you put here -- it was found that even
requiring it to end in a dash and a version number was too restrictive
for use in the wild.

=for testing
my $r = new CPAN::Test::Reporter;
$r->package("Foo-Bar-0.01");
is($r->{package}, "Foo-Bar-0.01", "Set the package");

=cut

sub package {
    my ($self, $package) = @_;
    $self->{package} = $package;
}

=head2 test_results($results)

Sets the results for the test.  $results is in the form of a string,
presumably as provided by CPAN::Smoke.

=for testing
my $r = new CPAN::Test::Reporter;
$r->test_results("here are my test results");
is($r->{test_results}, "here are my test results", "Set the test results");

=cut

sub test_results {
    my ($self, $test_results) = @_;
    $self->{test_results} = $test_results;
}

=head2 comments($comments)

Sets your comments on the test.

=for testing
my $r = new CPAN::Test::Reporter;
$r->comments("here are my comments");
is($r->{comments}, "here are my comments", "Set the comments");

=cut

sub comments {
    my ($self, $comments) = @_;
    $self->{comments} = $comments;
}

=head2 send(@recipients)

Sends the email to cpan-testers and Cc's the mail to the recipients
listed.  Uses full email addresses.

=cut

sub send {
    my ($self, @recipients) = @_;

    my $report = qq(
This distribution has been tested as part of the cpan-testers
effort to test as many new uploads to CPAN as possible.  See
http://testers.cpan.org/

Please cc any replies to cpan-testers\@perl.org to keep other
test volunteers informed and to prevent any duplicate effort.

Comments:

$self->{comments}

Test results:

$self->{test_results}

Perl version: $self->{which_perl}

);

    $report .= Config::myconfig();

    my $subject    = uc($self->{grade})
        . " $self->{package} $Config{archname} $Config{osvers}";
    my $msg = new Mail::Send Subject => $subject, To => $CPAN_TESTERS;

    if (@recipients) {
        $msg->cc(build_cc(@recipients));
    }

    $msg->set('X-reported-via', "CPAN::Test::Reporter version $VERSION");

    my $fh = $msg->open;
    print $fh $report;
    $fh->close;
}

=for testing
is(CPAN::Test::Reporter::build_cc('[e-mail]', '[e-mail]'), '[e-mail], [e-mail]', "Building CC list from email addresses");

=cut

sub build_cc {
    my @recipients = @_;
    return join(", ", @recipients);
}


=head1 COPYRIGHT

    Copyright (c) 1999 Kurt Starsinic, 2001 Kirrily Robert.
    This program is free software; you may redistribute it
    and/or modify it under the same terms as Perl itself.

=head1 SEE ALSO

L

=head1 AUTHOR

Kirrily "Skud" Robert , based on the cpantest script
by Kurt Starsinic EFE

=cut

return "FALSE";     # true value ;)