File: cpantest

package info (click to toggle)
libtest-reporter-perl 1.27-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 140 kB
  • ctags: 107
  • sloc: perl: 1,295; makefile: 50
file content (390 lines) | stat: -rw-r--r-- 10,078 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
#!/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
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

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

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) {
		DoMacOptions();
	}
	else {
		GetOptions(
			'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 ]';

	$Reporter->comments($comment);
	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') {
		&start_editor_mac($editor);
	}
	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 {
	$Reporter->comments('');

	if ($Comment_text and not $Comment_file) {
		$Reporter->comments($Comment_text);
		return;
	}
	
	my $comment;
	my $skip = 1;

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

	chomp $comment if $comment;

	if ($comment and $comment ne '[ insert comments here ]')
	{
		$Reporter->comments($comment);
	}
}

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

sub get_subject {
	$Reporter->grade($Grade);
	$Reporter->distribution($Package);
	$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";
	close(LOG);
}

__END__

=head1 NAME

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

=head1 DESCRIPTION

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

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

=back

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

=head1 COPYRIGHT

	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.

=cut