#!/usr/bin/perl -w

# $Id: cpantest,v 1.7 2003/02/25 08:45:05 afoxson Exp $
# $Revision: 1.7 $

# cpantest - sends test results to cpan-testers@perl.org
# Copyright (c) 2003 Adam J. Foxson. All rights reserved.
# Copyright (c) 2002 Autrijus Tango. 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 1.23;
use vars qw(
	$VERSION $Grade $Package $No_comment $Automatic $Comment_text $Comment_file
	$MacMPW $MacApp %Grades $CC $Report $Tempfile $Subject $Reporter $From $Dump

$VERSION       = 1.8;
($Tempfile, $Report) = File::Temp::tempfile(UNLINK => 1);
$MacMPW        = $^O eq 'MacOS' && $MacPerl::Version =~ /MPW/;
$MacApp        = $^O eq 'MacOS' && $MacPerl::Version =~ /Application/;
$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",

&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;
if ($Dump) {
	my $fh; open($fh, '>-') or die "Can't open STDOUT: $!";
	print $Reporter->write($fh);
} else {
	&confirm_send() if not $Automatic;

sub DoMacOptions {
	require File::Basename;

	if ($ARGV[0]) {
		($Package = File::Basename::basename($ARGV[0])) =~ s/\.t(?:ar\.)?gz$//;

	$Package    = MacPerl::Ask('Package Name?', $Package);
	$Grade      = MacPerl::Pick('What Grade?', qw(pass fail unknown na));
	$No_comment = MacPerl::Answer('Comment on submission?', qw(No Yes));
	$From	    = MacPerl::Ask('From what address?');
	$CC         = MacPerl::Ask('Cc: to address?');
	$Automatic  = 1;

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 "           [ -dump | email-addresses ]\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 "  -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";

	exit 1;

sub get_opts {
	if ($MacApp) {
	else {
			'g=s',  \$Grade,
			'p=s',  \$Package,
			'nc',   \$No_comment,
			'auto', \$Automatic,
			't=s',  \$Comment_text,
			'f=s',  \$Comment_file,
			'from=s',  \$From,
			'dump', \$Dump,
		) or usage();

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

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", ($MacMPW ? ":\n$default" : " [$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_mac {
	my $editor = shift;

	use vars '%Application';
	for my $mod (qw(Mac::MoreFiles Mac::AppleEvents::Simple Mac::AppleEvents)) {
		eval qq(require $mod) or die "die: Can't load $mod.\n";
		eval qq($mod->import());

	my $app = $Application{$editor};
	die "Application with ID '$editor' not found.\n" if !$app;

	my $obj = 'obj {want:type(cobj), from:null(), ' .
				'form:enum(name), seld:TEXT(@)}';
	my $evt = do_event(qw/aevt odoc MACS/,
				"'----': $obj, usin: $obj", $Report, $app);

	if (my $err = AEGetParamDesc($evt->{REP}, 'errn')) {
		die "AppleEvent error: ${\AEPrint($err)}.\n";

	prompt('Done?', 'Yes') if $MacMPW;
	MacPerl::Answer('Done?') if $MacApp;

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

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

	if ($^O eq 'MacOS') {
	else {
		die "The editor `$editor' could not be run" if system "$editor $Report";
		die "Empty report; terminated" unless -s $Report > 2;
	$CC ||= ask_cc() unless $MacApp or $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 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 ]

For MacPerl, save as a droplet, and drop a module archive
or unpacked folder on the droplet.

=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.

=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).


=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) 2003 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.