mirror of
https://github.com/Perl/perl5.git
synced 2026-01-27 01:44:43 +00:00
perlbug - Change default behavior to save to file
Output filename now always defaults to "perlbug.rep". Sends by email only if an address is specified with -a, invoked as perlthanks or with -T, or the prompt is chosen to send the report to perl5-porters. Removed option -A as it no longer does anything. Clarified output to refer to "report" instead of "message".
This commit is contained in:
Dan Book
Todd Rinaldo
parent
e11072e081
commit
31fa749cfc
@ -69,7 +69,7 @@ like($result, qr/Please use perlbug interactively./,
|
||||
# test -okay (mostly noninteractive)
|
||||
$result = runperl( progfile => $extracted_program,
|
||||
args => ['-okay', '-F', $testreport] );
|
||||
like($result, qr/Message saved/, 'build report saved');
|
||||
like($result, qr/Report saved/, 'build report saved');
|
||||
like(_slurp($testreport), qr/Perl reported to build OK on this system/,
|
||||
'build report looks sane');
|
||||
unlink $testreport;
|
||||
@ -82,7 +82,7 @@ $result = runperl( progfile => $extracted_program,
|
||||
'-nokay',
|
||||
'-e', 'file',
|
||||
'-F', $testreport] );
|
||||
like($result, qr/Message saved/, 'build failure report saved');
|
||||
like($result, qr/Report saved/, 'build failure report saved');
|
||||
like(_slurp($testreport), qr/This is a build failure report for perl/,
|
||||
'build failure report looks sane');
|
||||
unlink $testreport;
|
||||
@ -104,7 +104,7 @@ $result = runperl( progfile => $extracted_program,
|
||||
'-b', 'testreportbody',
|
||||
'-e', 'file',
|
||||
'-F', $testreport] );
|
||||
like($result, qr/Message saved/, 'fake bug report saved');
|
||||
like($result, qr/Report saved/, 'fake bug report saved');
|
||||
my $contents = _slurp($testreport);
|
||||
like($contents, qr/Subject: testingperlbug/,
|
||||
'Subject included in fake bug report');
|
||||
@ -136,7 +136,7 @@ $result = runperl( progfile => $extracted_program,
|
||||
'-p', $attachment,
|
||||
'-e', 'file',
|
||||
'-F', $testreport] );
|
||||
like($result, qr/Message saved/, 'fake bug report saved');
|
||||
like($result, qr/Report saved/, 'fake bug report saved');
|
||||
my $contents = _slurp($testreport);
|
||||
unlink $testreport, $body, $attachment;
|
||||
like($contents, qr/Subject: testing perlbug/,
|
||||
|
||||
158
utils/perlbug.PL
158
utils/perlbug.PL
@ -86,14 +86,14 @@ BEGIN {
|
||||
$::HaveWrap = ($@ eq "");
|
||||
};
|
||||
|
||||
our $VERSION = "1.41";
|
||||
our $VERSION = "1.42";
|
||||
|
||||
#TODO:
|
||||
# make sure failure (transmission-wise) of Mail::Send is accounted for.
|
||||
# (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
|
||||
# - Test -b option
|
||||
|
||||
my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
|
||||
my( $file, $usefile, $cc, $address, $thanksaddress,
|
||||
$filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
|
||||
$fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
|
||||
$Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
|
||||
@ -122,9 +122,7 @@ EOF
|
||||
Query();
|
||||
Edit() unless $usefile || ($ok and not $opt{n});
|
||||
NowWhat();
|
||||
if ($outfile) {
|
||||
save_message_to_disk($outfile);
|
||||
} else {
|
||||
if ($address) {
|
||||
Send();
|
||||
if ($thanks) {
|
||||
print "\nThank you for taking the time to send a thank-you message!\n\n";
|
||||
@ -138,12 +136,13 @@ EOF
|
||||
|
||||
paraprint <<EOF
|
||||
Please note that mailing lists are moderated, your message may take a while to
|
||||
show up. If you do not receive an automated response acknowledging your message
|
||||
within a few hours (check your SPAM folder and outgoing mail) please consider
|
||||
sending an email directly from your mail client to perlbug\@perl.org.
|
||||
show up. Please consider submitting your report directly to the issue tracker
|
||||
at https://github.com/Perl/perl5/issues
|
||||
EOF
|
||||
}
|
||||
|
||||
} else {
|
||||
save_message_to_disk($outfile);
|
||||
}
|
||||
|
||||
exit;
|
||||
@ -201,17 +200,11 @@ sub Init {
|
||||
$Is_Linux = lc($^O) eq 'linux';
|
||||
$Is_OpenBSD = lc($^O) eq 'openbsd';
|
||||
|
||||
# perlbug address
|
||||
$bugaddress = 'perlbug@perl.org';
|
||||
|
||||
# Test address
|
||||
$testaddress = 'perlbug-test@perl.org';
|
||||
|
||||
# Thanks address
|
||||
$thanksaddress = 'perl-thanks@perl.org';
|
||||
|
||||
# Defaults if getopts fails.
|
||||
$address = (basename ($0) =~ /^perlthanks/i) ? $thanksaddress : $bugaddress;
|
||||
$outfile = (basename($0) =~ /^perlthanks/i) ? "perlthanks.rep" : "perlbug.rep";
|
||||
$cc = $::Config{'perladmin'} || $::Config{'cf_email'} || $::Config{'cf_by'} || '';
|
||||
|
||||
HELP_MESSAGE() unless getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt);
|
||||
@ -232,8 +225,7 @@ sub Init {
|
||||
|
||||
$progname = $thanks ? 'perlthanks' : 'perlbug';
|
||||
# Target address
|
||||
$address = $opt{a} || ($opt{t} ? $testaddress
|
||||
: $thanks ? $thanksaddress : $bugaddress);
|
||||
$address = $opt{a} || ($thanks ? $thanksaddress : "");
|
||||
|
||||
# Users address, used in message and in From and Reply-To headers
|
||||
$from = $opt{r} || "";
|
||||
@ -266,7 +258,7 @@ sub Init {
|
||||
}
|
||||
|
||||
# File to output to
|
||||
$outfile = $opt{F} || "";
|
||||
$outfile = $opt{F} || "$progname.rep";
|
||||
|
||||
# Body of report
|
||||
$body = $opt{b} || "";
|
||||
@ -361,18 +353,19 @@ sub Query {
|
||||
This program provides an easy way to send a thank-you message back to the
|
||||
authors and maintainers of perl.
|
||||
|
||||
If you wish to submit a bug report, please run it without the -T flag
|
||||
If you wish to generate a bug report, please run it without the -T flag
|
||||
(or run the program perlbug rather than perlthanks)
|
||||
EOF
|
||||
} else {
|
||||
paraprint <<"EOF";
|
||||
This program provides an easy way to create a message reporting a
|
||||
bug in the core perl distribution (along with tests or patches)
|
||||
to the volunteers who maintain perl at $address. To send a thank-you
|
||||
This program provides an easy way to generate a bug report for the core
|
||||
perl distribution (along with tests or patches). To send a thank-you
|
||||
note to $thanksaddress instead of a bug report, please run 'perlthanks'.
|
||||
|
||||
Please do not use $0 to send test messages, test whether perl
|
||||
works, or to report bugs in perl modules from CPAN.
|
||||
The GitHub issue tracker at https://github.com/Perl/perl5/issues is the
|
||||
best place to submit your report so it can be tracked and resolved.
|
||||
|
||||
Please do not use $0 to report bugs in perl modules from CPAN.
|
||||
|
||||
Suggestions for how to find help using Perl can be found at
|
||||
https://perldoc.perl.org/perlcommunity.html
|
||||
@ -388,7 +381,7 @@ EOF
|
||||
|
||||
unless ($subject) {
|
||||
print
|
||||
"First of all, please provide a subject for the message.\n";
|
||||
"First of all, please provide a subject for the report.\n";
|
||||
if ( not $thanks) {
|
||||
paraprint <<EOF;
|
||||
This should be a concise description of your bug or problem
|
||||
@ -466,7 +459,7 @@ EOF
|
||||
}
|
||||
|
||||
# Prompt for administrator address, unless an override was given
|
||||
if( !$opt{C} and !$opt{c} ) {
|
||||
if( $address and !$opt{C} and !$opt{c} ) {
|
||||
my $description = <<EOF;
|
||||
$0 can send a copy of this report to your local perl
|
||||
administrator. If the address below is wrong, please correct it,
|
||||
@ -694,11 +687,6 @@ EFF
|
||||
if ($report_about_module ) {
|
||||
print OUT <<EFF;
|
||||
module=$report_about_module
|
||||
EFF
|
||||
}
|
||||
if ($opt{A}) {
|
||||
print OUT <<EFF;
|
||||
ack=no
|
||||
EFF
|
||||
}
|
||||
print OUT <<EFF;
|
||||
@ -789,8 +777,7 @@ EOF
|
||||
next;
|
||||
} else {
|
||||
paraprint <<EOF;
|
||||
You may want to save your report to a file, so you can edit and
|
||||
mail it later.
|
||||
You can edit your report after saving it to a file.
|
||||
EOF
|
||||
return;
|
||||
}
|
||||
@ -820,7 +807,7 @@ EOF
|
||||
|
||||
sub Cancel {
|
||||
1 while unlink($filename); # remove all versions under VMS
|
||||
print "\nQuitting without sending your message.\n";
|
||||
print "\nQuitting without generating a report.\n";
|
||||
exit(0);
|
||||
}
|
||||
|
||||
@ -828,23 +815,24 @@ sub NowWhat {
|
||||
# Report is done, prompt for further action
|
||||
if( !$opt{S} ) {
|
||||
while(1) {
|
||||
my $send_to = $address || 'the Perl developers';
|
||||
my $menu = <<EOF;
|
||||
|
||||
|
||||
You have finished composing your message. At this point, you have
|
||||
You have finished composing your report. At this point, you have
|
||||
a few options. You can:
|
||||
|
||||
* [Se]nd the message to $address$andcc,
|
||||
* [D]isplay the message on the screen,
|
||||
* [R]e-edit the message
|
||||
* Display or change the message's [su]bject
|
||||
* Save the message to a [f]ile to mail at another time
|
||||
* [Q]uit without sending a message
|
||||
* Save the report to a [f]ile
|
||||
* [Se]nd the report to $send_to$andcc
|
||||
* [D]isplay the report on the screen
|
||||
* [R]e-edit the report
|
||||
* Display or change the report's [su]bject
|
||||
* [Q]uit without generating the report
|
||||
|
||||
EOF
|
||||
retry:
|
||||
print $menu;
|
||||
my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)",
|
||||
my $action = _prompt('', "Action (Save/Send/Display/Edit/Subject/Quit)",
|
||||
$opt{t} ? 'q' : '');
|
||||
print "\n";
|
||||
if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
|
||||
@ -866,12 +854,20 @@ EOF
|
||||
}
|
||||
} elsif ($action =~ /^se/i) { # <S>end
|
||||
# Send the message
|
||||
my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
|
||||
if (not $thanks) {
|
||||
print <<EOF
|
||||
To ensure your issue can be best tracked and resolved,
|
||||
you should submit it to the GitHub issue tracker at
|
||||
https://github.com/Perl/perl5/issues
|
||||
EOF
|
||||
}
|
||||
my $reply = _prompt( "Are you certain you want to send this report to $send_to$andcc?", 'Please type "yes" if you are','no');
|
||||
if ($reply =~ /^yes$/) {
|
||||
$address ||= 'perl5-porters@perl.org';
|
||||
last;
|
||||
} else {
|
||||
paraprint <<EOF;
|
||||
You didn't type "yes", so your message has not yet been sent.
|
||||
You didn't type "yes", so your report has not been sent.
|
||||
EOF
|
||||
}
|
||||
} elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
|
||||
@ -902,14 +898,9 @@ sub TrivialSubject {
|
||||
}
|
||||
|
||||
sub SaveMessage {
|
||||
my $file_save = $outfile || "$progname.rep";
|
||||
my $file = _prompt( '', "Name of file to save message in", $file_save );
|
||||
my $file = _prompt( '', "Name of file to save report in", $outfile );
|
||||
save_message_to_disk($file) || return undef;
|
||||
print "\n";
|
||||
paraprint <<EOF;
|
||||
A copy of your message has been saved in '$file' for you to
|
||||
send to '$address' with your normal mail client.
|
||||
EOF
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub Send {
|
||||
@ -945,7 +936,7 @@ EOF
|
||||
sub Help {
|
||||
print <<EOF;
|
||||
|
||||
This program is designed to help you generate and send bug reports
|
||||
This program is designed to help you generate bug reports
|
||||
(and thank-you notes) about perl5 and the modules which ship with it.
|
||||
|
||||
In most cases, you can just run "$0" interactively from a command
|
||||
@ -956,33 +947,33 @@ Advanced usage:
|
||||
$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
|
||||
[-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
|
||||
[-p patchfile ]
|
||||
$0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
|
||||
$0 [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
|
||||
|
||||
|
||||
Options:
|
||||
|
||||
-v Include Verbose configuration data in the report
|
||||
-f File containing the body of the report. Use this to
|
||||
quickly send a prepared message.
|
||||
quickly send a prepared report.
|
||||
-p File containing a patch or other text attachment. Separate
|
||||
multiple files with commas.
|
||||
-F File to output the resulting mail message to, instead of mailing.
|
||||
-S Send without asking for confirmation.
|
||||
-a Address to send the report to. Defaults to '$address'.
|
||||
-F File to output the resulting report to. Defaults to
|
||||
'$outfile'.
|
||||
-S Save or send the report without asking for confirmation.
|
||||
-a Send the report to this address, instead of saving to a file.
|
||||
-c Address to send copy of report to. Defaults to '$cc'.
|
||||
-C Don't send copy to administrator.
|
||||
-s Subject to include with the message. You will be prompted
|
||||
-s Subject to include with the report. You will be prompted
|
||||
if you don't supply one on the command line.
|
||||
-b Body of the report. If not included on the command line, or
|
||||
in a file with -f, you will get a chance to edit the message.
|
||||
in a file with -f, you will get a chance to edit the report.
|
||||
-r Your return address. The program will ask you to confirm
|
||||
this if you don't give it here.
|
||||
-e Editor to use.
|
||||
-t Test mode. The target address defaults to '$testaddress'.
|
||||
-t Test mode.
|
||||
-T Thank-you mode. The target address defaults to '$thanksaddress'.
|
||||
-d Data mode. This prints out your configuration data, without mailing
|
||||
anything. You can use this with -v to get more complete data.
|
||||
-A Don't send a bug received acknowledgement to the return address.
|
||||
-ok Report successful build on this system to perl porters
|
||||
(use alone or with -v). Only use -ok if *everything* was ok:
|
||||
if there were *any* problems at all, use -nok.
|
||||
@ -1049,7 +1040,7 @@ sub _build_header {
|
||||
}
|
||||
|
||||
sub _message_headers {
|
||||
my %headers = ( To => $address, Subject => $subject );
|
||||
my %headers = ( To => $address || 'perl5-porters@perl.org', Subject => $subject );
|
||||
$headers{'Cc'} = $cc if ($cc);
|
||||
$headers{'Message-Id'} = $messageid if ($messageid);
|
||||
$headers{'Reply-To'} = $from if ($from);
|
||||
@ -1134,7 +1125,7 @@ sub save_message_to_disk {
|
||||
|
||||
print OUTFILE build_complete_message();
|
||||
close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
|
||||
print "\nMessage saved.\n";
|
||||
print "\nReport saved to '$file'. Please submit it to https://github.com/Perl/perl5/issues\n";
|
||||
return 1;
|
||||
}
|
||||
|
||||
@ -1209,9 +1200,9 @@ EOT
|
||||
paraprint(<<"EOF"), die "\n";
|
||||
$message_start
|
||||
Because of this, there's no easy way to automatically send your
|
||||
message.
|
||||
report.
|
||||
|
||||
A copy of your message has been saved in '$filename' for you to
|
||||
A copy of your report has been saved in '$filename' for you to
|
||||
send to '$address' with your normal mail client.
|
||||
EOF
|
||||
}
|
||||
@ -1271,10 +1262,10 @@ B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
|
||||
S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
|
||||
S<[ B<-r> I<returnaddress> ]>
|
||||
S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
|
||||
S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]>
|
||||
S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]> S<[ B<-T> ]>
|
||||
|
||||
B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
|
||||
S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
|
||||
S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
|
||||
|
||||
B<perlthanks>
|
||||
|
||||
@ -1451,34 +1442,28 @@ if a new version of Perl is released and your bug is still present.
|
||||
|
||||
=item B<-a>
|
||||
|
||||
Address to send the report to. Defaults to B<perlbug@perl.org>.
|
||||
|
||||
=item B<-A>
|
||||
|
||||
Don't send a bug received acknowledgement to the reply address.
|
||||
Generally it is only a sensible to use this option if you are a
|
||||
perl maintainer actively watching perl porters for your message to
|
||||
arrive.
|
||||
Address to send the report to instead of saving to a file.
|
||||
|
||||
=item B<-b>
|
||||
|
||||
Body of the report. If not included on the command line, or
|
||||
in a file with B<-f>, you will get a chance to edit the message.
|
||||
in a file with B<-f>, you will get a chance to edit the report.
|
||||
|
||||
=item B<-C>
|
||||
|
||||
Don't send copy to administrator.
|
||||
Don't send copy to administrator when sending report by mail.
|
||||
|
||||
=item B<-c>
|
||||
|
||||
Address to send copy of report to. Defaults to the address of the
|
||||
Address to send copy of report to when sending report by mail.
|
||||
Defaults to the address of the
|
||||
local perl administrator (recorded when perl was built).
|
||||
|
||||
=item B<-d>
|
||||
|
||||
Data mode (the default if you redirect or pipe output). This prints out
|
||||
your configuration data, without mailing anything. You can use this
|
||||
with B<-v> to get more complete data.
|
||||
your configuration data, without saving or mailing anything. You can use
|
||||
this with B<-v> to get more complete data.
|
||||
|
||||
=item B<-e>
|
||||
|
||||
@ -1487,13 +1472,11 @@ Editor to use.
|
||||
=item B<-f>
|
||||
|
||||
File containing the body of the report. Use this to quickly send a
|
||||
prepared message.
|
||||
prepared report.
|
||||
|
||||
=item B<-F>
|
||||
|
||||
File to output the results to instead of sending as an email. Useful
|
||||
particularly when running perlbug on a machine with no direct internet
|
||||
connection.
|
||||
File to output the results to. Defaults to B<perlbug.rep>.
|
||||
|
||||
=item B<-h>
|
||||
|
||||
@ -1539,17 +1522,16 @@ if you don't use this option.
|
||||
|
||||
=item B<-S>
|
||||
|
||||
Send without asking for confirmation.
|
||||
Save or send the report without asking for confirmation.
|
||||
|
||||
=item B<-s>
|
||||
|
||||
Subject to include with the message. You will be prompted if you don't
|
||||
Subject to include with the report. You will be prompted if you don't
|
||||
supply one on the command line.
|
||||
|
||||
=item B<-t>
|
||||
|
||||
Test mode. The target address defaults to B<perlbug-test@perl.org>.
|
||||
Also makes it possible to command perlbug from a pipe or file, for
|
||||
Test mode. Makes it possible to command perlbug from a pipe or file, for
|
||||
testing purposes.
|
||||
|
||||
=item B<-T>
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user