my @patches;
while (<PATCH_LEVEL>) {
last if /^\s*}/;
+ next if /^\s*#/; # preprocessor stuff
+ next if /PERL_GIT_UNPUSHED_COMMITS/; # XXX expand instead
+ next if /"uncommitted-changes"/; # XXX determine if active instead
chomp;
s/^\s+,?\s*"?//;
s/"?\s*,?$//;
print OUT <<'!NO!SUBS!';
+use warnings;
+no warnings 'once'; # Eventually, the $::opt_ stuff should get cleaned up
use strict;
use Config;
use File::Spec; # keep perlbug Perl 5.005 compatible
$::HaveCoreList = ($@ eq "");
};
-my $Version = "1.37";
+my $Version = "1.39";
# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
# Changed in 1.07 to see more sendmail execs, and added pipe output.
# Changed in 1.34 Added Message-Id RFOLEY 18-06-2002
# Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004
# Changed in 1.36 Initial Module::CoreList support Alexandr Ciornii 11-07-2007
-# Changed in 1.37 Killed some string evals, rewrote most prose JESSE 06-08-2008
-#
-# TODO: - Allow the user to re-name the file on mail failure, and
-# make sure failure (transmission-wise) of Mail::Send is
-# accounted for.
+# Changed in 1.37 Killed some string evals, rewrote most prose JESSE 2008-06-08
+# Changed in 1.38 Actually enforce the CoreList check,
+# Record the module the user enters if they do so
+# Refactor prompts to use common code JESSE 2008-06-08
+# Changed in 1.39 Trap mail sending failures (simple ones) so JESSE 2008-06-08
+# users might be able to recover their bug reports
+# Refactor mail sending routines
+# Unify message building code
+# Unify message header building
+# Fix "module" prompting to not squish "category" prompting
+# use warnings; (except 'once' warnings)
+# Unified report fingerprint/change detection code
+# Removed some labeled 'gotos'
+#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,
$filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
- $Is_MacOS, $category, $severity, $fh, $me, $Is_MSWin32, $Is_Linux, $Is_VMS,
- $msg, $body, $andcc, %REP, $ok, $thanks, $Is_OpenBSD, $progname);
+ $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
+ $Is_MacOS, $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
+ $report_about_module, $category, $severity,
+
+);
my $perl_version = $^V ? sprintf("%vd", $^V) : $];
Query();
Edit() unless $usefile || ($ok and not $::opt_n);
NowWhat();
-Send();
+if ($outfile) {
+ save_message_to_disk($outfile);
+} else {
+ Send();
+ if ($thanks) {
+ print "\nThank you for taking the time to send a thank-you message!\n\n";
+ } else {
+ print "\nThank you for taking the time to file a bug report!\n\n";
+ }
+}
exit;
'opts' => [qw(critical high medium low wishlist none)], # zero
},
);
- die "Invalid alternative($name) requested\n" unless grep(/^$name$/, keys %alts);
+ die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
my $alt = "";
my $what = $ok || $thanks;
if ($what) {
$alt = $alts{$name}{$what};
} else {
my @alts = @{$alts{$name}{'opts'}};
+ print "\n\n";
paraprint <<EOF;
-Please pick a \u$name from the following:
+Please pick a $name from the following list:
@alts
-
EOF
my $err = 0;
do {
if ($err++ > 5) {
die "Invalid $name: aborting.\n";
}
- print "Please enter a \u$name [$alts{$name}{'default'}]: ";
- $alt = <>;
- chomp $alt;
- if ($alt =~ /^\s*$/) {
- $alt = $alts{$name}{'default'};
- }
+ $alt = _prompt('', "\u$name", $alts{$name}{'default'});
+ $alt ||= $alts{$name}{'default'};
} while !((($alt) = grep(/^$alt/i, @alts)));
}
lc $alt;
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 use it to report bugs in external perl modules.
+works, or to report bugs in perl modules from CPAN.
For help using perl, try posting to the Usenet newsgroup
comp.lang.perl.misc.
my $err = 0;
do {
- print "Subject: ";
- $subject = <>;
- chomp $subject;
+ $subject = _prompt('','Subject');
if ($err++ == 5) {
if ($thanks) {
$subject = 'Thanks for Perl';
# Try and guess return address
my $guess;
- $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || '';
+ $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'} || '';
if ($Is_MacOS) {
require Mac::InternetConfig;
$guess = $Mac::InternetConfig::InternetConfig{
paraprint <<EOF;
Perl's developers may need your email address to contact you for
further information about your issue or to inform you when it is
-resolved. If the default shown is not your e-mail address, please
+resolved. If the default shown is not your email address, please
correct it.
EOF
}
} else {
paraprint <<EOF;
-Please enter your full internet e-mail addressaso that Perl's
+Please enter your full internet email address so that Perl's
developers can contact you with questions about your issue or to
inform you that it has been resolved.
EOF
$from = $guess;
} else {
# verify it
- print "Your address [$guess]: ";
- $from = <>;
- chomp $from;
+ $from = _prompt('','Your address',$guess);
$from = $guess if $from eq '';
}
}
# Prompt for administrator address, unless an override was given
if( !$::opt_C and !$::opt_c ) {
- paraprint <<EOF;
-This tool can send a copy of this report to your local perl
+ 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,
-or enter 'none' or 'yourself' to stop Perlbug from sending a copy.
+or enter 'none' or 'yourself' to not send a copy.
EOF
- print "Local perl administrator [$cc]: ";
- my $entry = scalar <>;
- chomp $entry;
+ my $entry = _prompt($description, "Local perl administrator", $cc);
if ($entry ne "") {
$cc = $entry;
}
$cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
- $andcc = " and $cc" if $cc;
+ if ($cc) {
+ $andcc = " and $cc"
+ } else {
+ $andcc = ''
+ }
# Prompt for editor, if no override is given
editor:
unless ($::opt_e || $::opt_f || $::opt_b) {
+
+ my $description;
+
chomp (my $common_end = <<"EOF");
You will probably want to use a text editor to enter the body of
your report. If "$ed" is the editor you want to use, then just press
use.
If you have already composed the body of your report, you may enter
-"file" "file", and Perlbug will prompt you for to enter the name
-of the file containing your report.
+"file", and $0 will prompt you to enter the name of the file
+containing your report.
EOF
if ($thanks) {
- paraprint <<"EOF";
+ $description = <<"EOF";
It's now time to compose your thank-you message.
Some information about your local perl configuration will automatically
$common_end
EOF
} else {
- paraprint <<"EOF";
+ $description = <<"EOF";
It's now time to compose your bug report. Try to make the report
concise but descriptive. Please include any detail which you think
might be relevant or might help the volunteers working to improve
perl. If you are reporting something that does not work as you think
-it should, please try to include example of both the actual result,
-and what you expected.
+it should, please try to include examples of the actual result and of
+what you expected.
Some information about your local perl configuration will automatically
be included at the end of your report. If you are using an unusual
EOF
}
- print "Editor [$ed]: ";
- my $entry =scalar <>;
- chomp $entry;
-
+ my $entry = _prompt($description, "Editor", $ed);
$usefile = 0;
if ($entry eq "file") {
$usefile = 1;
$ed = $entry;
}
}
- my $report_about_module = '';
if ($::HaveCoreList && !$ok && !$thanks) {
- paraprint <<EOF;
+ my $description = <<EOF;
If your bug is about a Perl module rather than a core language
-feature, please enter it's name here. If it's not, just hit Enter
+feature, please enter its name here. If it's not, just hit Enter
to skip this question.
EOF
- print "Module []: ";
- my $entry = scalar <>;
- $entry =~ s/^\s+//s;
- $entry =~ s/\s+$//s;
- if ($entry ne q{}) {
- $category ||= 'library';
- $report_about_module = $entry;
+
+ my $entry = '';
+ while ($entry eq '') {
+ $entry = _prompt($description, 'Module');
my $first_release = Module::CoreList->first_release($entry);
- unless ($first_release) {
+ if ($entry and not $first_release) {
paraprint <<EOF;
$entry is not a "core" Perl module. Please check that you entered
its name correctly. If it is correct, quit this program, try searching
-for $entry on rt.cpan.org, and report your issue there.
+for $entry on http://rt.cpan.org, and report your issue there.
EOF
- }
+
+ $entry = '';
+ } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
+ paraprint <<"EOF";
+$entry included with core Perl is copied directly from the CPAN distribution.
+Please report bugs in $entry directly to its maintainers using $bug_tracker
+EOF
+ $entry = '';
+ } elsif ($entry) {
+ $category ||= 'library';
+ $report_about_module = $entry;
+ last;
+ } else {
+ last;
+ }
}
}
# Prompt for file to read report from, if needed
if ($usefile and !$file) {
filename:
- paraprint <<EOF;
+ my $description = <<EOF;
What is the name of the file that contains your report?
EOF
- print "Filename: ";
- my $entry = scalar <>;
- chomp $entry;
+ my $entry = _prompt($description, "Filename");
if ($entry eq "") {
paraprint <<EOF;
Dump(*REP);
close(REP) or die "Error closing report file: $!";
- # read in the report template once so that
- # we can track whether the user does any editing.
- # yes, *all* whitespace is ignored.
- open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
- while (<REP>) {
- s/\s+//g;
- $REP{$_}++;
- }
- close(REP) or die "Error closing report file '$filename': $!";
+ # Set up an initial report fingerprint so we can compare it later
+ _fingerprint_lines_in_report();
+
} # sub Query
sub Dump {
category=$category
severity=$severity
EFF
+
+ if ($report_about_module ) {
+ print OUT <<EFF;
+ module=$report_about_module
+EFF
+ }
if ($::opt_A) {
print OUT <<EFF;
ack=no
sub Edit {
# Edit the report
if ($usefile || $body) {
- paraprint <<EOF;
-Please make sure that the name of the editor you want to use is correct.
-EOF
- print "Editor [$ed]: ";
- my $entry =scalar <>;
- chomp $entry;
+ my $description = "Please make sure that the name of the editor you want to use is correct.";
+ my $entry = _prompt($description, 'Editor', $ed);
$ed = $entry unless $entry eq '';
}
-tryagain:
- my $sts;
- $sts = system("$ed $filename") unless $Is_MacOS;
- if ($Is_MacOS) {
- require ExtUtils::MakeMaker;
- ExtUtils::MM_MacOS::launch_file($filename);
- paraprint <<EOF;
-Press Enter when done.
-EOF
- scalar <>;
- }
- if ($sts) {
- paraprint <<EOF;
-The editor you chose ('$ed') could not be run!
+ _edit_file($ed);
+}
-If you mistyped its name, please enter it now, otherwise just press
-Enter.
-EOF
- print "Editor [$ed]: ";
- my $entry =scalar <>;
- chomp $entry;
+sub _edit_file {
+ my $editor = shift;
- if ($entry ne "") {
- $ed = $entry;
- goto tryagain;
- } else {
- paraprint <<EOF;
+ my $report_written = 0;
+
+ while ( !$report_written ) {
+ if ($Is_MacOS) {
+ require ExtUtils::MakeMaker;
+ ExtUtils::MM_MacOS::launch_file($filename);
+ _prompt('', "Press Enter when done." );
+ } else { # we're not on oldschool mac os
+ my $exit_status = system("$editor $filename");
+ if ($exit_status) {
+ my $desc = <<EOF;
+The editor you chose ('$editor') could not be run!
+
+If you mistyped its name, please enter it now, otherwise just press Enter.
+EOF
+ my $entry = _prompt( $desc, 'Editor', $editor );
+ if ( $entry ne "" ) {
+ $editor = $entry;
+ next;
+ } else {
+ paraprint <<EOF;
You may want to save your report to a file, so you can edit and
mail it later.
EOF
- }
- }
-
- return if ($ok and not $::opt_n) || $body;
- # Check that we have a report that has some, eh, report in it.
- my $unseen = 0;
+ return;
+ }
+ }
+ }
+ return if ( $ok and not $::opt_n ) || $body;
- open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
- # a strange way to check whether any significant editing
- # have been done: check whether any new non-empty lines
- # have been added. Yes, the below code ignores *any* space
- # in *any* line.
- while (<REP>) {
- s/\s+//g;
- $unseen++ if $_ ne '' and not exists $REP{$_};
- }
+ # Check that we have a report that has some, eh, report in it.
- while ($unseen == 0) {
- paraprint <<EOF;
+ unless ( _fingerprint_lines_in_report() ) {
+ my $description = <<EOF;
It looks like you didn't enter a report. You may [r]etry your edit
or [c]ancel this report.
EOF
- print "Action (Retry Edit/Cancel) ";
- my ($action) = scalar(<>);
- if ($action =~ /^[re]/i) { # <R>etry <E>dit
- goto tryagain;
- } elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
- Cancel();
- }
+ my $action = _prompt( $description, "Action (Retry/Cancel) " );
+ if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
+ next;
+ } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
+ Cancel(); # cancel exits
+ }
+ }
+ # Ok. the user did what they needed to;
+ return;
+
}
-} # sub Edit
+}
+
sub Cancel {
1 while unlink($filename); # remove all versions under VMS
- print "\nCancelling.\n";
+ print "\nQuitting without sending your message.\n";
exit(0);
}
# Report is done, prompt for further action
if( !$::opt_S ) {
while(1) {
- print <<EOF;
+ my $menu = <<EOF;
+
+
You have finished composing your message. At this point, you have
a few options. You can:
- * [Se]end the message to $address$andcc,
+ * [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
- * [C]ancel your report without sending anything
* Save the message to a [f]ile to mail at another time
+ * [Q]uit without sending a message
EOF
retry:
- print "Action (Send/Display/Edit/Subject/Save to File): ";
- my $action = scalar <>;
- chomp $action;
+ print $menu;
+ my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
print "\n";
if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
- my $file_save = $outfile || "$progname.rep";
- print "\n\nName of file to save message in [$file_save]: ";
- my $file = scalar <>;
- chomp $file;
- $file = $file_save if $file eq "";
-
- unless (open(FILE, ">$file")) {
- print "\nError opening $file: $!\n\n";
- goto retry;
- }
- open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
- print FILE "To: $address\nSubject: $subject\n";
- print FILE "Cc: $cc\n" if $cc;
- print FILE "Reply-To: $from\n" if $from;
- print FILE "Message-Id: $messageid\n" if $messageid;
- print FILE "\n";
- while (<REP>) { print FILE }
- close(REP) or die "Error closing report file '$filename': $!";
- close(FILE) or die "Error closing $file: $!";
-
- paraprint <<EOF;
-A copy of your message has been saved in '$file' for you to
-send to '$address' with your normal mail client.
-EOF
- exit;
+ if ( SaveMessage() ) { exit }
} elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
# Display the message
open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
while (<REP>) { print $_ }
close(REP) or die "Error closing report file '$filename': $!";
} elsif ($action =~ /^su/i) { # <Su>bject
- print "Subject: $subject\n\n";
- print "If the above subject is fine, press Enter. Otherwise, type a replacement now\n";
- print "Subject: ";
- my $reply = scalar <STDIN>;
- chomp $reply;
+ my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
if ($reply ne '') {
unless (TrivialSubject($reply)) {
$subject = $reply;
}
} elsif ($action =~ /^se/i) { # <S>end
# Send the message
- print "Are you certain you want to send this message?\n"
- . 'Please type "yes" if you are: ';
- my $reply = scalar <STDIN>;
- chomp $reply;
+ my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
if ($reply =~ /^yes$/) {
last;
} else {
paraprint <<EOF;
You didn't type "yes", so your message has not yet been sent.
-If you are sure your message is ready to be sent, type "yes"
-(without the quotes).
EOF
}
} elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
Cancel();
} elsif ($action =~ /^s/i) {
paraprint <<EOF;
-The command you entered was ambiguous. Please type "send" or "save".
+The command you entered was ambiguous. Please type "send", "save" or "subject".
EOF
}
}
}
}
+sub SaveMessage {
+ my $file_save = $outfile || "$progname.rep";
+ my $file = _prompt( '', "Name of file to save message in", $file_save );
+ 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
+}
+
sub Send {
+
# Message has been accepted for transmission -- Send the message
- if ($outfile) {
- open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
- goto sendout;
- }
- # on linux certain mail implementations won't accept the subject
+ # on linux certain "mail" implementations won't accept the subject
# as "~s subject" and thus the Subject header will be corrupted
# so don't use Mail::Send to be safe
- if ($::HaveSend && !$Is_Linux && !$Is_OpenBSD) {
- $msg = new Mail::Send Subject => $subject, To => $address;
- $msg->cc($cc) if $cc;
- $msg->add("Reply-To",$from) if $from;
-
- $fh = $msg->open;
- open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
- while (<REP>) { print $fh $_ }
- close(REP) or die "Error closing $filename: $!";
- $fh->close;
-
- print "\nMessage sent.\n";
- } elsif ($Is_VMS) {
- if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
- ($cc =~ /@/ and $cc !~ /^\w+%"/) ) {
- my $prefix;
- foreach (qw[ IN MX SMTP UCX PONY WINS ], '') {
- $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
- }
- $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
- $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
- }
- $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
- my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
- if ($sts) {
- die <<EOF;
-Can't spawn off mail
- (leaving bug report in $filename): $sts
-EOF
- }
- } else {
- my $sendmail = "";
- for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
- $sendmail = $_, last if -e $_;
- }
- if ($^O eq 'os2' and $sendmail eq "") {
- my $path = $ENV{PATH};
- $path =~ s:\\:/: ;
- my @path = split /$Config{'path_sep'}/, $path;
- for (@path) {
- $sendmail = "$_/sendmail", last if -e "$_/sendmail";
- $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
- }
- }
+ eval {
+ if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
+ _send_message_mailsend();
+ } elsif ($Is_VMS) {
+ _send_message_vms();
+ } else {
+ _send_message_sendmail();
+ }
+ };
- paraprint(<<"EOF"), die "\n" if $sendmail eq "";
-It appears that there is no program which looks like "sendmail" on
-your system and that the Mail::Send library from CPAN isn't available.
-Because of this, there's no easy way to automatically send your
-message.
+ if ( my $error = $@ ) {
+ paraprint <<EOF;
+$0 has detected an error while trying to send your message: $error.
-A copy of your message has been saved in '$filename' for you to
-send to '$address' with your normal mail client.
+Your message may not have been sent. You will now have a chance to save a copy to disk.
EOF
- open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
-sendout:
- print SENDMAIL "To: $address\n";
- print SENDMAIL "Subject: $subject\n";
- print SENDMAIL "Cc: $cc\n" if $cc;
- print SENDMAIL "Reply-To: $from\n" if $from;
- print SENDMAIL "Message-Id: $messageid\n" if $messageid;
- print SENDMAIL "\n\n";
- open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
- while (<REP>) { print SENDMAIL $_ }
- close(REP) or die "Error closing $filename: $!";
-
- if (close(SENDMAIL)) {
- printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
- } else {
- warn "\nSendmail returned status '", $? >> 8, "'\n";
- }
+ SaveMessage();
+ return;
}
- 1 while unlink($filename); # remove all versions under VMS
-} # sub Send
+
+ 1 while unlink($filename); # remove all versions under VMS
+} # sub Send
sub Help {
print <<EOF;
EOF
}
-
-
-
sub filename {
if ($::HaveTemp) {
# Good. Use a secure temp file
}
}
+sub _prompt {
+ my ($explanation, $prompt, $default) = (@_);
+ if ($explanation) {
+ print "\n\n";
+ paraprint $explanation;
+ }
+ print $prompt. ($default ? " [$default]" :''). ": ";
+ my $result = scalar(<>);
+ chomp($result);
+ $result =~ s/^\s*(.*?)\s*$/$1/s;
+ if ($default && $result eq '') {
+ return $default;
+ } else {
+ return $result;
+ }
+}
+
+sub _build_header {
+ my %attr = (@_);
+
+ my $head = '';
+ for my $header (keys %attr) {
+ $head .= "$header: ".$attr{$header}."\n";
+ }
+ return $head;
+}
+
+sub _message_headers {
+ my %headers = ( To => $address, Subject => $subject );
+ $headers{'Cc'} = $cc if ($cc);
+ $headers{'Message-Id'} = $messageid if ($messageid);
+ $headers{'Reply-To'} = $from if ($from);
+ return \%headers;
+}
+
+sub build_complete_message {
+ my $content = _build_header(%{_message_headers()}) . "\n\n";
+ open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
+ while (<REP>) { $content .= $_; }
+ close(REP) or die "Error closing report file '$filename': $!";
+ return $content;
+}
+
+sub save_message_to_disk {
+ my $file = shift;
+
+ open OUTFILE, ">$file" or do { warn "Couldn't open '$file': $!\n"; return undef};
+ print OUTFILE build_complete_message();
+ close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
+ print "\nMessage saved.\n";
+ return 1;
+}
+
+sub _send_message_vms {
+ if ( ( $address =~ /@/ and $address !~ /^\w+%"/ )
+ or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
+ my $prefix;
+ foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
+ $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
+ }
+ $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
+ $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
+ }
+ $subject =~ s/"/""/g;
+ $address =~ s/"/""/g;
+ $cc =~ s/"/""/g;
+ my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
+ if ($sts) {
+ die "Can't spawn off mail (leaving bug report in $filename): $sts";
+ }
+}
+
+sub _send_message_mailsend {
+ my $msg = Mail::Send->new();
+ my %headers = %{_message_headers()};
+ for my $key ( keys %headers) {
+ $msg->add($key => $headers{$key});
+ }
+
+ $fh = $msg->open;
+ open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
+ while (<REP>) { print $fh $_ }
+ close(REP) or die "Error closing $filename: $!";
+ $fh->close or die "Error sending mail: $!";
+
+ print "\nMessage sent.\n";
+}
+
+sub _probe_for_sendmail {
+ my $sendmail = "";
+ for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
+ $sendmail = $_, last if -e $_;
+ }
+ if ( $^O eq 'os2' and $sendmail eq "" ) {
+ my $path = $ENV{PATH};
+ $path =~ s:\\:/:;
+ my @path = split /$Config{'path_sep'}/, $path;
+ for (@path) {
+ $sendmail = "$_/sendmail", last if -e "$_/sendmail";
+ $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
+ }
+ }
+ return $sendmail;
+}
+
+sub _send_message_sendmail {
+ my $sendmail = _probe_for_sendmail();
+ unless ($sendmail) {
+ my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
+It appears that there is no program which looks like "sendmail" on
+your system and that the Mail::Send library from CPAN isn't available.
+EOT
+It appears that there is no program which looks like "sendmail" on
+your system.
+EOT
+ paraprint(<<"EOF"), die "\n";
+$message_start
+Because of this, there's no easy way to automatically send your
+message.
+
+A copy of your message has been saved in '$filename' for you to
+send to '$address' with your normal mail client.
+EOF
+ }
+
+ open( SENDMAIL, "|$sendmail -t -oi" )
+ || die "'|$sendmail -t -oi' failed: $!";
+ print SENDMAIL build_complete_message();
+ if ( close(SENDMAIL) ) {
+ print "\nMessage sent\n";
+ } else {
+ warn "\nSendmail returned status '", $? >> 8, "'\n";
+ }
+}
+
+
+
+# a strange way to check whether any significant editing
+# has been done: check whether any new non-empty lines
+# have been added.
+
+sub _fingerprint_lines_in_report {
+ my $new_lines = 0;
+ # read in the report template once so that
+ # we can track whether the user does any editing.
+ # yes, *all* whitespace is ignored.
+
+ open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
+ while (my $line = <REP>) {
+ $line =~ s/\s+//g;
+ $new_lines++ if (!$REP{$line});
+
+ }
+ close(REP) or die "Error closing report file '$filename': $!";
+ # returns the number of lines with content that wasn't there when last we looked
+ return $new_lines;
+}
+
+
+
format STDOUT =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$_
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<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> 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> ]>
+B<perlthanks>
+
=head1 DESCRIPTION
documentation that came with that distribution to determine the
correct place to report bugs.
-If you are unable to send your report using B<perlbug> (most likely
-because your system doesn't have a way to send mail that perlbug recognizes), you may be able to use this tool to compose your report and save it to a file
-which you can then send to B<perlbug@perl.org> using your regular mail client.
+If you are unable to send your report using B<perlbug> (most likely
+because your system doesn't have a way to send mail that perlbug
+recognizes), you may be able to use this tool to compose your report
+and save it to a file which you can then send to B<perlbug@perl.org>
+using your regular mail client.
-In extreme cases, B<perlbug> may not work well enough on your system to
-guide you through composing a bug report. In those cases, you may be able to
-use B<perlbug -d> to get system configuration information to include in a manually composed bug report to B<perlbug@perl.org>.
+In extreme cases, B<perlbug> may not work well enough on your system
+to guide you through composing a bug report. In those cases, you
+may be able to use B<perlbug -d> to get system configuration
+information to include in a manually composed bug report to
+B<perlbug@perl.org>.
When reporting a bug, please run through this checklist:
latest released version, please try to replicate your bug on the
latest stable release.
-Note that bug reports about old versions of Perl, especially those
-tested only on versions of Perl prior to the current stable release,
-are likely to receive less attention from the volunteers who build
-and maintain Perl than bugs in the current release.
+Note that reports about bugs in old versions of Perl, especially
+those which indicate you haven't also tested the current stable
+release of Perl, are likely to receive less attention from the
+volunteers who build and maintain Perl than reports about bugs in
+the current release.
-This tool isn't apropriate for reporting bugs in any version of
+This tool isn't apropriate for reporting bugs in any version
prior to Perl 5.0.
=item Are you sure what you have is a bug?
L<perltrap> for pointers to common traps that new (and experienced)
Perl programmers run into.
-If you're unsure of them meaning of an error message you've run
-across, B<perldoc> L<perldiag> for an explanation. If message isn't
-in perldiag, it probably isn't generated by Perl. You may have
-luck consulting your operating system documentation instead.
+If you're unsure of the meaning of an error message you've run
+across, B<perldoc> L<perldiag> for an explanation. If the message
+isn't in perldiag, it probably isn't generated by Perl. You may
+have luck consulting your operating system documentation instead.
If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
features may be unimplemented or work differently.
=item Do you have a proper test case?
The easier it is to reproduce your bug, the more likely it will be
-fixed -- If nobody can duplicate your problem, it probably won't be
+fixed -- if nobody can duplicate your problem, it probably won't be
addressed.
A good test case has most of these attributes: short, simple code;
entire output produced by running C<perl -V> (note the uppercase V).
Whether you use C<perlbug> or send the email manually, please make
-your Subject line informative. "a bug" not informative. Neither
+your Subject line informative. "a bug" is not informative. Neither
is "perl crashes" nor is "HELP!!!". These don't help. A compact
description of what's wrong is fine.
-=back
+=item Can you use C<perlbug> to submit a thank-you note?
-Having done your bit, please be prepared to wait, to be told the bug
-is in your code, or possibly to get no reply at all. The volunteers who
-maintain Perl are busy folks, so if your problem is an obvious bug in your own code, is difficult to understand or is a duplicate of an existing report, you
-may not receive a personal reply.
+Yes, you can do this by either using the C<-T> option, or by invoking
+the program as C<perlthanks>. Thank-you notes are good. It makes people
+smile.
-If it is important to you that your bug be fixed, do monitor the perl5-porters@perl.org mailing list, the commit logs to development versions of Perl
-and encourage the maintainers with kind words or offers of frosty beverages.
-(Please do be kind to the maintainers. Harassing or flaming them is likely to
-have the opposite effect of the one you want.)
+=back
-Feel free update the ticket about your bug on http://rt.perl.org
+Having done your bit, please be prepared to wait, to be told the
+bug is in your code, or possibly to get no reply at all. The
+volunteers who maintain Perl are busy folks, so if your problem is
+an obvious bug in your own code, is difficult to understand or is
+a duplicate of an existing report, you may not receive a personal
+reply.
+
+If it is important to you that your bug be fixed, do monitor the
+perl5-porters@perl.org mailing list and the commit logs to development
+versions of Perl, and encourage the maintainers with kind words or
+offers of frosty beverages. (Please do be kind to the maintainers.
+Harassing or flaming them is likely to have the opposite effect of
+the one you want.)
+
+Feel free to update the ticket about your bug on http://rt.perl.org
if a new version of Perl is released and your bug is still present.
=head1 OPTIONS
Test mode. The target address defaults to B<perlbug-test@perl.org>.
+=item B<-T>
+
+Send a thank-you note instead of a bug report.
+
=item B<-v>
Include verbose configuration data in the report.
(E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.org<gt>),
Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
(E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
-Richard Foley (E<lt>richard@rfi.netE<gt>), and Jesse Vincent
+Richard Foley (E<lt>richard.foley@rfi.netE<gt>), and Jesse Vincent
(E<lt>jesse@bestpractical.com<gt>).
=head1 SEE ALSO
projects / p5sagit/p5-mst-13.2.git / blobdiff