bin/cpantest

   1 #!/usr/bin/perl -w
   2
   3 # cpantest - sends test results to cpan-testers@perl.org
   4 # Copyright (c) 2007 Adam J. Foxson. All rights reserved.
   5 # Copyright (c) 2002 Autrijus Tang. All rights reserved.
   6 # Copyright (c) 1999 Kurt Starsinic. All rights reserved.
   7
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the same terms as Perl itself.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14
  15 use strict;
  16 use Cwd;
  17 use Getopt::Long;
  18 use File::Temp;
  19 use Test::Reporter;
  20 use vars qw(
  21     $VERSION $Grade $Package $No_comment $Automatic $Comment_text $Comment_file
  22     %Grades $CC $Report $Tempfile $Subject $Reporter $From $Dump $Perl_version
  23     $Transport
  24 );
  25
  26 $VERSION       = '1.38';
  27 ($Tempfile, $Report) = File::Temp::tempfile(UNLINK => 1);
  28 $Reporter      = Test::Reporter->new();
  29 %Grades        = (
  30     'pass'     => "all tests pass",
  31     'fail'     => "some tests fail",
  32     'na'       => "package will not work on this platform",
  33     'unknown'  => "package did not include tests",
  34 );
  35
  36 &get_opts();
  37 &check_opts();
  38 &set_transport() if $Transport;
  39 &get_comment_file() if $Comment_file;
  40 &set_comment() if not $No_comment;
  41 &start_editor() unless ($No_comment || ($Comment_text and !$Comment_file));
  42 &get_comment() unless $No_comment;
  43 &get_package() if not $Package;
  44 &get_subject();
  45 &get_via();
  46 &get_tested_perl() if $Perl_version;
  47
  48 if ($Dump) {
  49     my $fh; open($fh, '>-') or die "Can't open STDOUT: $!";
  50     $Reporter->write($fh);
  51     print $fh "\n";
  52 } else {
  53     &confirm_send() if not $Automatic;
  54     &send();
  55 }
  56
  57 sub usage {
  58     my ($message) = @_;
  59
  60     print "Error:  $message\n" if defined $message;
  61     print "Usage:\n";
  62     print "  cpantest -g grade [ -nc ] [ -auto ] [ -p package ]\n";
  63     print "           [ -t text | -f file ] [ -from user\@example.com ]\n";
  64     print "           [ -perl-version path_to_perl ]\n";
  65     print "           [ -dump | email-addresses ]\n";
  66     print "           [ -x transport ]\n";
  67     print "  -g grade  Indicates the status of the tested package.\n";
  68     print "            Possible values for grade are:\n";
  69
  70     for (keys %Grades) {
  71         printf "              %-10s  %s\n", $_, $Grades{$_};
  72     }
  73
  74     print "  -from         Specify the From: address.\n";
  75     print "  -t            Specify a short comment.\n";
  76     print "  -f            Specify a file containing comments.\n";
  77     print "  -p            Specify the name of the distribution tested\n";
  78     print "                (e.g.: Test-Reporter-1.27).\n";
  79     print "  -nc           No comment; you will not be prompted to comment on\n";
  80     print "                the package.\n";
  81     print "  -auto         Autosubmission (non-interactive); implies -nc.\n";
  82     print "  -dump         Print the report instead of emailing it.\n";
  83     print "  -perl-version Specify an alternate perl under which the distribution was tested.\n";
  84     print "  -x            Specify a transport: Net::SMTP or Mail::Send.\n";
  85
  86     exit 1;
  87 }
  88
  89 sub get_opts {
  90     GetOptions(
  91         'g=s',  \$Grade,
  92         'p=s',  \$Package,
  93         'nc',   \$No_comment,
  94         'auto', \$Automatic,
  95         't=s',  \$Comment_text,
  96         'f=s',  \$Comment_file,
  97         'from=s',  \$From,
  98         'dump', \$Dump,
  99         'perl-version=s', \$Perl_version,
 100         'x=s',  \$Transport,
 101     ) or usage();
 102
 103     $CC         = join ' ', @ARGV;
 104     $No_comment = 1 if ($Automatic && !$Comment_text && !$Comment_file);
 105     $Reporter->from($From) if $From;
 106 }
 107
 108 sub set_transport {
 109     $Reporter->transport($Transport);
 110 }
 111
 112 sub check_opts {
 113     usage("-g <grade> is required")    unless defined $Grade;
 114     usage("grade `$Grade' is invalid") unless defined $Grades{$Grade};
 115     usage("-p is required with -auto") if $Automatic and !$Package;
 116     usage("can't have both -f and -t") if $Comment_text and $Comment_file;
 117 }
 118
 119 sub get_comment_file {
 120     local $/;
 121     open FH, $Comment_file or die "Can't open comment file: $!";
 122     $Comment_text = <FH>;
 123     close FH or die "Can't close comment file: $!";
 124 }
 125
 126 sub set_comment {
 127     chomp $Comment_text if $Comment_text;
 128
 129     my $comment = $Comment_text ?  $Comment_text : '[ insert comments here ]';
 130
 131     $Reporter->comments($comment);
 132     print $Tempfile $Reporter->report();
 133     close $Tempfile;
 134 }
 135
 136 # Given an author identifier (either a CPAN authorname or a proper
 137 # email address), return a proper email address.
 138 sub expand_author {
 139     my ($author) = @_;
 140
 141     if ($author =~ /^[-A-Z]+$/) {   # Smells like a CPAN authorname
 142         eval { require CPAN } or return undef;
 143
 144         my $cpan_author = CPAN::Shell->expand("Author", $author);
 145
 146         return eval { $cpan_author->email };
 147     }
 148     elsif ($author =~ /^\S+@[a-zA-Z0-9\.-]+$/) {
 149         return $author;
 150     }
 151
 152     return undef;
 153 }
 154
 155 # Prompt for a new value for $label, given $default; return the user's
 156 # selection.
 157 sub prompt {
 158     my ($label, $default) = @_;
 159
 160     printf "$label%s", (" [$default]: ");
 161     my $input = scalar <STDIN>;
 162     chomp $input;
 163
 164     return (length $input) ? $input : $default;
 165 }
 166
 167 sub ask_cc {
 168     my $cc = prompt('CC', 'none');
 169
 170     return ($cc eq 'none') ? undef : expand_author($cc);
 171 }
 172
 173 sub start_editor {
 174     my $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
 175                     || ($^O eq 'VMS'     and "edit/tpu")
 176                     || ($^O eq 'MSWin32' and "notepad")
 177                     || 'vi';
 178
 179     $editor = prompt('Editor', $editor) unless $Automatic;
 180
 181     die "The editor `$editor' could not be run" if system "$editor $Report";
 182     die "Empty report; terminated" unless -s $Report > 2;
 183     $CC ||= ask_cc() unless $Automatic;
 184 }
 185
 186 sub get_comment {
 187     $Reporter->comments('');
 188
 189     if ($Comment_text and not $Comment_file) {
 190         $Reporter->comments($Comment_text);
 191         return;
 192     }
 193
 194     my $comment;
 195     my $skip = 1;
 196
 197     open REPORT, $Report or die $!;
 198     while (<REPORT>) {
 199         if ($_ =~ /^--$/) {
 200             $skip = not $skip;
 201             next;
 202         }
 203         next if $skip;
 204         $comment .= $_;
 205     }
 206     close REPORT or die $!;
 207
 208     chomp $comment if $comment;
 209
 210     if ($comment and $comment ne '[ insert comments here ]')
 211     {
 212         $Reporter->comments($comment);
 213     }
 214 }
 215
 216 sub get_package {
 217     $Package = cwd();
 218     $Package =~ s:.*/::;
 219     $Package = prompt('Package', $Package);
 220 }
 221
 222 sub get_subject {
 223     $Reporter->grade($Grade);
 224     $Reporter->distribution($Package);
 225     $Subject = $Reporter->subject();
 226 }
 227
 228 sub get_via {
 229     $Reporter->via("cpantest $VERSION");
 230 }
 231
 232 sub get_tested_perl {
 233    $Reporter->perl_version($Perl_version);
 234 }
 235
 236 sub confirm_send {
 237     $Subject = prompt('Subject', $Subject);
 238
 239     print "\n";
 240     print "Subject:  $Subject\n";
 241     print "To:  " . $Reporter->address() . "\n";
 242     print "Cc:  $CC\n" if defined $CC;
 243
 244     if (prompt('S)end/I)gnore', 'Ignore') !~ /^[Ss]/) {
 245         print "Ignoring message.\n";
 246         exit 1;
 247     }
 248 }
 249
 250 sub send {
 251     if (defined $CC) {
 252         my @recipients = split /\s+/, $CC;
 253         $Reporter->send(@recipients) || die $Reporter->errstr();
 254     }
 255     else {
 256         $Reporter->send() || die $Reporter->errstr();
 257     }
 258
 259     &log() if $ENV{CPANTEST_LOG};
 260 }
 261
 262 sub log {
 263     open(LOG,">>$ENV{CPANTEST_LOG}") or
 264         die "Unable to open $ENV{CPANTEST_LOG}";
 265     my $time = localtime;
 266     print LOG "$Subject $time\n";
 267     close(LOG);
 268 }
 269
 270 __END__
 271
 272 =head1 NAME
 273
 274 B<cpantest> - Report test results of a package retrieved from CPAN
 275
 276 =head1 DESCRIPTION
 277
 278 B<cpantest> uniformly posts package test results in support of the
 279 cpan-testers project.  See B<http://testers.cpan.org/> for details.
 280
 281 =head1 USAGE
 282
 283     cpantest -g grade [ -nc ] [ -auto ] [ -p package ]
 284              [ -t text | -f file ] [ email-addresses ]
 285              [ -x transport ]
 286
 287 =head1 OPTIONS
 288
 289 =over 4
 290
 291 =item -g grade
 292
 293 I<grade> indicates the success or failure of the package's builtin
 294 tests, and is one of:
 295
 296     grade     meaning
 297     -----     -------
 298     pass      all tests included with the package passed
 299     fail      some tests failed
 300     na        the package does not work on this platform
 301     unknown   the package did not include tests
 302
 303 =item -p package
 304
 305 I<package> is the name of the package you are testing.  If you don't
 306 supply a value on the command line, you will be prompted for one.
 307
 308 For example: Test-Reporter-1.27
 309
 310 =item -nc
 311
 312 No comment; you will not be prompted to supply a comment about the
 313 package.
 314
 315 =item -t text
 316
 317 A short comment text line.
 318
 319 =item -f file
 320
 321 A file containing comments; '-' will make it read from STDIN. Note
 322 that an editor will still appear after reading this file.
 323
 324 =item -auto
 325
 326 Autosubmission (non-interactive); you won't be prompted to supply any
 327 information that you didn't provide on the command line.  Implies I<-nc>.
 328
 329 =item email-addresses
 330
 331 A list of additional email addresses that should be cc:'d in this
 332 report (typically, the package's author).
 333
 334 =item perl-version perl
 335
 336 An alternate version of perl on which the distribution was tested.
 337 This option allows reporting on versions of perl for which Test::Reporter
 338 is not installed.
 339
 340 =item -x transport
 341
 342 Specify a transport: Net::SMTP or Mail::Send. This is optional. One will be
 343 chosen for you automatically if not specified. See Test::Reporter docs for
 344 further information.
 345
 346 =back
 347
 348 =head1 AUTHORS
 349
 350 This version of the 'cpantest' script was adapted by Adam J. Foxson
 351 E<lt>F<afoxson@pobox.com>E<gt> for Test::Reporter, and is based on
 352 Autrijus Tang's E<lt>autrijus@autrijus.orgE<gt> adaptations for
 353 CPANPLUS, which is in turn based upon the original script by Kurt
 354 Starsinic E<lt>F<Kurt.Starsinic@isinet.com>E<gt> with various patches
 355 from the CPAN Testers E<lt>F<cpan-testers@perl.org>E<gt>.
 356
 357 =head1 COPYRIGHT
 358
 359     Copyright (c) 2007 Adam J. Foxson. All rights reserved.
 360     Copyright (c) 2002 Autrijus Tang. All rights reserved.
 361     Copyright (c) 1999 Kurt Starsinic. All rights reserved.
 362
 363     This program is free software; you may redistribute it
 364     and/or modify it under the same terms as Perl itself.
 365
 366 =cut