#!/usr/bin/perl -w

# cpantest - sends test results to cpan-testers@perl.org
# Copyright (c) 2007 Adam J. Foxson. All rights reserved.
# Copyright (c) 2002 Autrijus Tang. All rights reserved.
# Copyright (c) 1999 Kurt Starsinic. All rights reserved.

# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of

use strict;
use Cwd;
use Getopt::Long;
use File::Temp;
use Test::Reporter;
use vars qw(
    $VERSION $Grade $Package $No_comment $Automatic $Comment_text $Comment_file
    %Grades $CC $Report $Tempfile $Subject $Reporter $From $Dump $Perl_version

$VERSION       = '1.36';
($Tempfile, $Report) = File::Temp::tempfile(UNLINK => 1);
$Reporter      = Test::Reporter->new();
%Grades        = (
    'pass'     => "all tests pass",
    'fail'     => "some tests fail",
    'na'       => "package will not work on this platform",
    'unknown'  => "package did not include tests",

&set_transport() if $Transport;
&get_comment_file() if $Comment_file;
&set_comment() if not $No_comment;
&start_editor() unless ($No_comment || ($Comment_text and !$Comment_file));
&get_comment() unless $No_comment;
&get_package() if not $Package;
&get_tested_perl() if $Perl_version;

if ($Dump) {
    my $fh; open($fh, '>-') or die "Can't open STDOUT: $!";
    print $fh "\n";
} else {
    &confirm_send() if not $Automatic;

sub usage {
    my ($message) = @_;

    print "Error:  $message\n" if defined $message;
    print "Usage:\n";
    print "  cpantest -g grade [ -nc ] [ -auto ] [ -p package ]\n";
    print "           [ -t text | -f file ] [ -from user\@example.com ]\n";
    print "           [ -perl-version path_to_perl ]\n";
    print "           [ -dump | email-addresses ]\n";
    print "           [ -x transport ]\n";
    print "  -g grade  Indicates the status of the tested package.\n";
    print "            Possible values for grade are:\n";

    for (keys %Grades) {
        printf "              %-10s  %s\n", $_, $Grades{$_};

    print "  -from         Specify the From: address.\n";
    print "  -t            Specify a short comment.\n";
    print "  -f            Specify a file containing comments.\n";
    print "  -p            Specify the name of the distribution tested\n";
    print "                (e.g.: Test-Reporter-1.27).\n";
    print "  -nc           No comment; you will not be prompted to comment on\n";
    print "                the package.\n";
    print "  -auto         Autosubmission (non-interactive); implies -nc.\n";
    print "  -dump         Print the report instead of emailing it.\n";
    print "  -perl-version Specify an alternate perl under which the distribution was tested.\n";
    print "  -x            Specify a transport: Net::SMTP or Mail::Send.\n";

    exit 1;

sub get_opts {
        'g=s',  \$Grade,
        'p=s',  \$Package,
        'nc',   \$No_comment,
        'auto', \$Automatic,
        't=s',  \$Comment_text,
        'f=s',  \$Comment_file,
        'from=s',  \$From,
        'dump', \$Dump,
        'perl-version=s', \$Perl_version,
        'x=s',  \$Transport,
    ) or usage();

    $CC         = join ' ', @ARGV;
    $No_comment = 1 if ($Automatic && !$Comment_text && !$Comment_file);
    $Reporter->from($From) if $From;

sub set_transport {

sub check_opts {
    usage("-g <grade> is required")    unless defined $Grade;
    usage("grade `$Grade' is invalid") unless defined $Grades{$Grade};
    usage("-p is required with -auto") if $Automatic and !$Package;
    usage("can't have both -f and -t") if $Comment_text and $Comment_file;

sub get_comment_file {
    local $/;
    open FH, $Comment_file or die "Can't open comment file: $!";
    $Comment_text = <FH>;
    close FH or die "Can't close comment file: $!";

sub set_comment {
    chomp $Comment_text if $Comment_text;

    my $comment = $Comment_text ?  $Comment_text : '[ insert comments here ]';

    print $Tempfile $Reporter->report();
    close $Tempfile;

# Given an author identifier (either a CPAN authorname or a proper
# email address), return a proper email address.
sub expand_author {
    my ($author) = @_;

    if ($author =~ /^[-A-Z]+$/) {   # Smells like a CPAN authorname
        eval { require CPAN } or return undef;

        my $cpan_author = CPAN::Shell->expand("Author", $author);

        return eval { $cpan_author->email };
    elsif ($author =~ /^\S+@[a-zA-Z0-9\.-]+$/) {
        return $author;

    return undef;

# Prompt for a new value for $label, given $default; return the user's
# selection.
sub prompt {
    my ($label, $default) = @_;

    printf "$label%s", (" [$default]: ");
    my $input = scalar <STDIN>;
    chomp $input;

    return (length $input) ? $input : $default;

sub ask_cc {
    my $cc = prompt('CC', 'none');

    return ($cc eq 'none') ? undef : expand_author($cc);

sub start_editor {
    my $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
                    || ($^O eq 'VMS'     and "edit/tpu")
                    || ($^O eq 'MSWin32' and "notepad")
                    || 'vi';

    $editor = prompt('Editor', $editor) unless $Automatic;

    die "The editor `$editor' could not be run" if system "$editor $Report";
    die "Empty report; terminated" unless -s $Report > 2;
    $CC ||= ask_cc() unless $Automatic;

sub get_comment {

    if ($Comment_text and not $Comment_file) {

    my $comment;
    my $skip = 1;

    open REPORT, $Report or die $!;
    while (<REPORT>) {
        if ($_ =~ /^--$/) {
            $skip = not $skip;
        next if $skip;
        $comment .= $_;
    close REPORT or die $!;

    chomp $comment if $comment;

    if ($comment and $comment ne '[ insert comments here ]')

sub get_package {
    $Package = cwd();
    $Package =~ s:.*/::;
    $Package = prompt('Package', $Package);

sub get_subject {
    $Subject = $Reporter->subject();

sub get_via {
    $Reporter->via("cpantest $VERSION");

sub get_tested_perl {

sub confirm_send {
    $Subject = prompt('Subject', $Subject);

    print "\n";
    print "Subject:  $Subject\n";
    print "To:  " . $Reporter->address() . "\n";
    print "Cc:  $CC\n" if defined $CC;

    if (prompt('S)end/I)gnore', 'Ignore') !~ /^[Ss]/) {
        print "Ignoring message.\n";
        exit 1;

sub send {
    if (defined $CC) {
        my @recipients = split /\s+/, $CC;
        $Reporter->send(@recipients) || die $Reporter->errstr();
    else {
        $Reporter->send() || die $Reporter->errstr();

    &log() if $ENV{CPANTEST_LOG};

sub log {
    open(LOG,">>$ENV{CPANTEST_LOG}") or
        die "Unable to open $ENV{CPANTEST_LOG}";
    my $time = localtime;
    print LOG "$Subject $time\n";


=head1 NAME

B<cpantest> - Report test results of a package retrieved from CPAN


B<cpantest> uniformly posts package test results in support of the
cpan-testers project.  See B<http://testers.cpan.org/> for details.

=head1 USAGE

    cpantest -g grade [ -nc ] [ -auto ] [ -p package ]
             [ -t text | -f file ] [ email-addresses ]
             [ -x transport ]

=head1 OPTIONS

=over 4

=item -g grade

I<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

=item -p package

I<package> is the name of the package you are testing.  If you don't
supply a value on the command line, you will be prompted for one.

For example: Test-Reporter-1.27

=item -nc

No comment; you will not be prompted to supply a comment about the

=item -t text

A short comment text line.

=item -f file

A file containing comments; '-' will make it read from STDIN. Note
that an editor will still appear after reading this file.

=item -auto

Autosubmission (non-interactive); you won't be prompted to supply any
information that you didn't provide on the command line.  Implies I<-nc>.

=item email-addresses

A list of additional email addresses that should be cc:'d in this
report (typically, the package's author).

=item perl-version perl

An alternate version of perl on which the distribution was tested.
This option allows reporting on versions of perl for which Test::Reporter
is not installed.

=item -x transport

Specify a transport: Net::SMTP or Mail::Send. This is optional. One will be
chosen for you automatically if not specified. See Test::Reporter docs for
further information.


=head1 AUTHORS

This version of the 'cpantest' script was adapted by Adam J. Foxson
E<lt>F<afoxson@pobox.com>E<gt> for Test::Reporter, and is based on
Autrijus Tang's E<lt>autrijus@autrijus.orgE<gt> adaptations for
CPANPLUS, which is in turn based upon the original script by Kurt
Starsinic E<lt>F<Kurt.Starsinic@isinet.com>E<gt> with various patches
from the CPAN Testers E<lt>F<cpan-testers@perl.org>E<gt>.


    Copyright (c) 2007 Adam J. Foxson. All rights reserved. 
    Copyright (c) 2002 Autrijus Tang. All rights reserved.
    Copyright (c) 1999 Kurt Starsinic. All rights reserved.

    This program is free software; you may redistribute it
    and/or modify it under the same terms as Perl itself.