use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
+use File::Spec::Functions;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
# extract patchlevel.h information
-open PATCH_LEVEL, "<../patchlevel.h" or die "Can't open patchlevel.h: $!";
+open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
+ or die "Can't open patchlevel.h: $!";
my $patchlevel_date = (stat PATCH_LEVEL)[9];
while (<PATCH_LEVEL>) {
- last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
+ last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
+}
+
+if (! defined($_)) {
+ warn "Warning: local_patches section not found in patchlevel.h\n";
}
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+,?\s*"?//;
+ s/"?\s*,?$//;
s/(['\\])/\\$1/g;
push @patches, $_ unless $_ eq 'NULL';
}
my $patch_desc = "'" . join("',\n '", @patches) . "'";
my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
-close PATCH_LEVEL;
+close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
# TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
# used, compare $Config::config_sh with the stored version. If they differ then
# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.
+my $extract_version = sprintf("%vd", $^V);
+
print OUT <<"!GROK!THIS!";
$Config{startperl}
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
-my \$config_tag1 = '$] - $Config{cf_time}';
+my \$config_tag1 = '$extract_version - $Config{cf_time}';
my \$patchlevel_date = $patchlevel_date;
my \$patch_tags = '$patch_tags';
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
use Getopt::Std;
-use strict;
+use File::Basename 'basename';
sub paraprint;
BEGIN {
- eval "use Mail::Send;";
+ eval { require Mail::Send;};
$::HaveSend = ($@ eq "");
- eval "use Mail::Util;";
+ eval { require Mail::Util; } ;
$::HaveUtil = ($@ eq "");
+ # use secure tempfiles wherever possible
+ eval { require File::Temp; };
+ $::HaveTemp = ($@ eq "");
+ eval { require Module::CoreList; };
+ $::HaveCoreList = ($@ eq "");
};
-my $Version = "1.22";
+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.20 Added patchlevel.h reading and version/config checks
# Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
# Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
-
-# 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.23 Restore -ok(ay): say 'success'; don't prompt
+# Changed in 1.24 Added '-F<file>' to save report HVDS 98-07-01
+# Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
+# Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
+# Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
+# Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
+# Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
+# Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
+# Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
+# Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
+# Changed in 1.33 Don't require -t STDOUT for -ok.
+# 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 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, $perlbug, $testaddress, $filename,
- $subject, $from, $verbose, $ed,
- $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
+my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
+ $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
+ $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) : $];
-my $config_tag2 = "$] - $Config{cf_time}";
+my $config_tag2 = "$perl_version - $Config{cf_time}";
Init();
if ($::opt_h) { Help(); exit; }
if ($::opt_d) { Dump(*STDOUT); exit; }
-if (!-t STDIN) {
- paraprint <<EOF;
-Please use perlbug interactively. If you want to
+if (!-t STDIN && !($ok and not $::opt_n)) {
+ paraprint <<"EOF";
+Please use $progname interactively. If you want to
include a file, you can use the -f switch.
EOF
die "\n";
}
-if (!-t STDOUT) { Dump(*STDOUT); exit; }
Query();
-Edit() unless $usefile;
+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;
+sub ask_for_alternatives { # (category|severity)
+ my $name = shift;
+ my %alts = (
+ 'category' => {
+ 'default' => 'core',
+ 'ok' => 'install',
+ # Inevitably some of these will end up in RT whatever we do:
+ 'thanks' => 'thanks',
+ 'opts' => [qw(core docs install library utilities)], # patch, notabug
+ },
+ 'severity' => {
+ 'default' => 'low',
+ 'ok' => 'none',
+ 'thanks' => 'none',
+ 'opts' => [qw(critical high medium low wishlist none)], # zero
+ },
+ );
+ 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 $name from the following list:
+
+ @alts
+EOF
+ my $err = 0;
+ do {
+ if ($err++ > 5) {
+ die "Invalid $name: aborting.\n";
+ }
+ $alt = _prompt('', "\u$name", $alts{$name}{'default'});
+ $alt ||= $alts{$name}{'default'};
+ } while !((($alt) = grep(/^$alt/i, @alts)));
+ }
+ lc $alt;
+}
+
sub Init {
# -------- Setup --------
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_VMS = $^O eq 'VMS';
+ $Is_Linux = lc($^O) eq 'linux';
+ $Is_OpenBSD = lc($^O) eq 'openbsd';
+ $Is_MacOS = $^O eq 'MacOS';
+
+ @ARGV = split m/\s+/,
+ MacPerl::Ask('Provide command line args here (-h for help):')
+ if $Is_MacOS && $MacPerl::Version =~ /App/;
- getopts("dhva:s:b:f:r:e:SCc:to:n:");
+ if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T")) { Help(); exit; };
# This comment is needed to notify metaconfig that we are
# using the $perladmin, $cf_by, and $cf_time definitions.
# -------- Configuration ---------
# perlbug address
- $perlbug = 'perlbug@perl.com';
+ $bugaddress = 'perlbug@perl.org';
# Test address
- $testaddress = 'perlbug-test@perl.com';
+ $testaddress = 'perlbug-test@perl.org';
+ # Thanks address
+ $thanksaddress = 'perl-thanks@perl.org';
+
+ if (basename ($0) =~ /^perlthanks/i) {
+ # invoked as perlthanks
+ $::opt_T = 1;
+ $::opt_C = 1; # don't send a copy to the local admin
+ }
+
+ if ($::opt_T) {
+ $thanks = 'thanks';
+ }
+
+ $progname = $thanks ? 'perlthanks' : 'perlbug';
# Target address
- $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
+ $address = $::opt_a || ($::opt_t ? $testaddress
+ : $thanks ? $thanksaddress : $bugaddress);
# Users address, used in message and in Reply-To header
$from = $::opt_r || "";
# File to send as report
$file = $::opt_f || "";
+ # File to output to
+ $outfile = $::opt_F || "";
+
# Body of report
$body = $::opt_b || "";
-
+
# Editor
$ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
|| ($Is_VMS && "edit/tpu")
|| ($Is_MSWin32 && "notepad")
+ || ($Is_MacOS && '')
|| "vi";
# Not OK - provide build failure template by finessing OK report
}
# OK - send "OK" report for build on this system
- $ok = 0;
+ $ok = '';
if ($::opt_o) {
if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
my $age = time - $patchlevel_date;
$::opt_C = 1; # don't send a copy to the local admin
$::opt_s = 1; # we have a subject line
$subject = ($::opt_n ? 'Not ' : '')
- . "OK: perl $] ${patch_tags}on"
+ . "OK: perl $perl_version ${patch_tags}on"
." $::Config{'archname'} $::Config{'osvers'} $subject";
- $ok = 1;
+ $ok = 'ok';
} else {
Help();
exit();
|| $::Config{'cf_email'} || $::Config{'cf_by'}
);
+ if ($::HaveUtil) {
+ $domain = Mail::Util::maildomain();
+ } elsif ($Is_MSWin32) {
+ $domain = $ENV{'USERDOMAIN'};
+ } else {
+ require Sys::Hostname;
+ $domain = Sys::Hostname::hostname();
+ }
+
+ # Message-Id - rjsf
+ $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
+
# My username
$me = $Is_MSWin32 ? $ENV{'USERNAME'}
: $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
+ : $Is_MacOS ? $ENV{'USER'}
: eval { getpwuid($<) }; # May be missing
+
+ $from = $::Config{'cf_email'}
+ if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
+ ($me eq $::Config{'cf_by'});
} # sub Init
sub Query {
# Explain what perlbug is
unless ($ok) {
- paraprint <<EOF;
-This program provides an easy way to create a message reporting a bug
-in perl, and e-mail it to $address. It is *NOT* intended for
-sending test messages or simply verifying that perl works, *NOR* is it
-intended for reporting bugs in third-party perl modules. It is *ONLY*
-a means of reporting verifiable problems with the core perl distribution,
-and any solutions to such problems, to the people who maintain perl.
-
-If you're just looking for help with perl, try posting to the Usenet
-newsgroup comp.lang.perl.misc. If you're looking for help with using
-perl with CGI, try posting to comp.infosystems.www.programming.cgi.
+ if ($thanks) {
+ paraprint <<'EOF';
+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
+(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
+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.
+
+For help using perl, try posting to the Usenet newsgroup
+comp.lang.perl.misc.
EOF
+ }
}
# Prompt for subject of message, if needed
+
+ if ($subject && TrivialSubject($subject)) {
+ $subject = '';
+ }
+
unless ($subject) {
- paraprint <<EOF;
-First of all, please provide a subject for the
-message. It should be a concise description of
-the bug or problem. "perl bug" or "perl problem"
-is not a concise description.
+ print
+"First of all, please provide a subject for the message.\n";
+ if ( not $thanks) {
+ paraprint <<EOF;
+This should be a concise description of your bug or problem
+which will help the volunteers working to improve perl to categorize
+and resolve the issue. Be as specific and descriptive as
+you can. A subject like "perl bug" or "perl problem" will make it
+much less likely that your issue gets the attention it deserves.
EOF
- print "Subject: ";
- $subject = <>;
+ }
my $err = 0;
- while ($subject !~ /\S/) {
- print "\nPlease enter a subject: ";
- $subject = <>;
- if ($err++ > 5) {
- die "Aborting.\n";
+ do {
+ $subject = _prompt('','Subject');
+ if ($err++ == 5) {
+ if ($thanks) {
+ $subject = 'Thanks for Perl';
+ } else {
+ die "Aborting.\n";
+ }
}
- }
- chop $subject;
+ } while (TrivialSubject($subject));
}
# Prompt for return address, if needed
# 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{
+ Mac::InternetConfig::kICEmail()
+ };
+ }
+
unless ($guess) {
- my $domain;
- if ($::HaveUtil) {
- $domain = Mail::Util::maildomain();
- } elsif ($Is_MSWin32) {
- $domain = $ENV{'USERDOMAIN'};
- } else {
- require Sys::Hostname;
- $domain = Sys::Hostname::hostname();
- }
- if ($domain) {
+ # move $domain to where we can use it elsewhere
+ if ($domain) {
if ($Is_VMS && !$::Config{'d_socket'}) {
$guess = "$domain\:\:$me";
} else {
if ($guess) {
unless ($ok) {
paraprint <<EOF;
-Your e-mail address will be useful if you need to be contacted. If the
-default shown is not your full internet e-mail address, please correct it.
+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 email address, please
+correct it.
EOF
}
} else {
paraprint <<EOF;
-So that you may be contacted if necessary, please enter
-your full internet e-mail address here.
+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 = <>;
- chop $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;
-A copy of this report can be sent to your local
-perl administrator. If the address is wrong, please
-correct it, or enter 'none' or 'yourself' to not send
-a copy.
+ 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 not send a copy.
EOF
- print "Local perl administrator [$cc]: ";
- my $entry = scalar <>;
- chop $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) {
- paraprint <<EOF;
-Now you need to supply the bug report. Try to make
-the report concise but descriptive. Include any
-relevant detail. 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.
-
-Some information about your local
-perl configuration will automatically be included
-at the end of the report. If you are using any
-unusual version of perl, please try and confirm
-exactly which versions are relevant.
-
-You will probably want to use an editor to enter
-the report. If "$ed" is the editor you want
-to use, then just press Enter, otherwise type in
-the name of the editor you would like to use.
-
-If you would like to use a prepared file, type
-"file", and you will be asked for the filename.
+
+ 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
+Enter, otherwise type in the name of the editor you would like to
+use.
+
+If you have already composed the body of your report, you may enter
+"file", and $0 will prompt you to enter the name of the file
+containing your report.
+EOF
+
+ if ($thanks) {
+ $description = <<"EOF";
+It's now time to compose your thank-you message.
+
+Some information about your local perl configuration will automatically
+be included at the end of your message, because we're curious about
+the different ways that people build and use perl. If you'd rather
+not share this information, you're welcome to delete it.
+
+$common_end
+EOF
+ } else {
+ $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 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
+version of perl, it would be useful if you could confirm that you
+can replicate the problem on a standard build of perl as well.
+
+$common_end
EOF
- print "Editor [$ed]: ";
- my $entry =scalar <>;
- chop $entry;
+ }
+ my $entry = _prompt($description, "Editor", $ed);
$usefile = 0;
if ($entry eq "file") {
$usefile = 1;
$ed = $entry;
}
}
+ if ($::HaveCoreList && !$ok && !$thanks) {
+ my $description = <<EOF;
+If your bug is about a Perl module rather than a core language
+feature, please enter its name here. If it's not, just hit Enter
+to skip this question.
+EOF
+
+ my $entry = '';
+ while ($entry eq '') {
+ $entry = _prompt($description, 'Module');
+ my $first_release = Module::CoreList->first_release($entry);
+ 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 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 category of bug
+ $category ||= ask_for_alternatives('category');
+
+ # Prompt for severity of bug
+ $severity ||= ask_for_alternatives('severity');
# Generate scratch file to edit report in
$filename = filename();
# 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 <>;
- chop $entry;
+ my $entry = _prompt($description, "Filename");
if ($entry eq "") {
paraprint <<EOF;
-No filename? I'll let you go back and choose an editor again.
+It seems you didn't enter a filename. Please choose to use a text
+editor or enter a filename.
EOF
goto editor;
}
unless (-f $entry and -r $entry) {
paraprint <<EOF;
-I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
-the file? If you don't want to send a file, just enter a blank line and you
-can get back to the editor selection.
+'$entry' doesn't seem to be a readable file. You may have mistyped
+its name or may not have permission to read it.
+
+If you don't want to use a file as the content of your report, just
+hit Enter and you'll be able to select a text editor instead.
EOF
goto filename;
}
}
# Generate report
- open(REP,">$filename");
- my $reptype = $ok ? "build failure" : "bug";
+ open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
+ my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
+ : $::opt_n ? "build failure" : "success";
print REP <<EOF;
This is a $reptype report for perl from $from,
-generated with the help of perlbug $Version running under perl $].
+generated with the help of perlbug $Version running under perl $perl_version.
EOF
print REP $body;
} elsif ($usefile) {
open(F, "<$file")
- or die "Unable to read report file from `$file': $!\n";
+ or die "Unable to read report file from '$file': $!\n";
while (<F>) {
print REP $_
}
- close(F);
+ close(F) or die "Error closing '$file': $!";
} else {
- print REP <<EOF;
+ if ($thanks) {
+ print REP <<'EOF';
-----------------------------------------------------------------
-[Please enter your report here]
+[Please enter your thank-you message here]
+
+
+
+[You're welcome to delete anything below this line]
+-----------------------------------------------------------------
+EOF
+ } else {
+ print REP <<'EOF';
+
+-----------------------------------------------------------------
+[Please describe your issue here]
[Please do not change anything below this line]
-----------------------------------------------------------------
EOF
+ }
}
Dump(*REP);
- close(REP);
+ close(REP) or die "Error closing report file: $!";
+
+ # Set up an initial report fingerprint so we can compare it later
+ _fingerprint_lines_in_report();
- # 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");
- while (<REP>) {
- s/\s+//g;
- $REP{$_}++;
- }
- close(REP);
} # sub Query
sub Dump {
local(*OUT) = @_;
- print REP "\n---\n";
- print REP "This perlbug was built using Perl $config_tag1\n",
+ # these won't have been set if run with -d
+ $category ||= 'core';
+ $severity ||= 'low';
+
+ print OUT <<EFF;
+---
+Flags:
+ 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
+EFF
+ }
+ print OUT <<EFF;
+---
+EFF
+ print OUT "This perlbug was built using Perl $config_tag1\n",
"It is being executed now by Perl $config_tag2.\n\n"
if $config_tag2 ne $config_tag1;
print OUT <<EOF;
-Site configuration information for perl $]:
+Site configuration information for perl $perl_version:
EOF
if ($::Config{cf_by} and $::Config{cf_time}) {
print OUT <<EOF;
---
-\@INC for perl $]:
+\@INC for perl $perl_version:
EOF
for my $i (@INC) {
print OUT " $i\n";
print OUT <<EOF;
---
-Environment for perl $]:
+Environment for perl $perl_version:
EOF
- for my $env (sort
- (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR),
- grep /^(?:PERL|LC_)/, keys %ENV)
- ) {
+ my @env =
+ qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
+ push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
+ push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
+ my %env;
+ @env{@env} = @env;
+ for my $env (sort keys %env) {
print OUT " $env",
exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
"\n";
}
if ($verbose) {
- print OUT "\nComplete configuration data for perl $]:\n\n";
+ print OUT "\nComplete configuration data for perl $perl_version:\n\n";
my $value;
foreach (sort keys %::Config) {
$value = $::Config{$_};
+ $value = '' unless defined $value;
$value =~ s/'/\\'/g;
print OUT "$_='$value'\n";
}
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 <>;
- chop $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 = system("$ed $filename");
- if ($sts) {
- paraprint <<EOF;
-The editor you chose (`$ed') could apparently not be run!
-Did you mistype the name of your editor? If so, please
-correct it here, otherwise just press Enter.
-EOF
- print "Editor [$ed]: ";
- my $entry =scalar <>;
- chop $entry;
+ _edit_file($ed);
+}
- if ($entry ne "") {
- $ed = $entry;
- goto tryagain;
- } else {
- paraprint <<EOF;
-You may want to save your report to a file, so you can edit and mail it
-yourself.
-EOF
- }
- }
+sub _edit_file {
+ my $editor = shift;
- return if ($ok and not $::opt_n) || $body;
- # Check that we have a report that has some, eh, report in it.
- my $unseen = 0;
-
- open(REP, "<$filename");
- # 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{$_};
- }
+ my $report_written = 0;
- while ($unseen == 0) {
- paraprint <<EOF;
-I am sorry but it looks like you did not report anything.
+ 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
- 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 $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;
+ }
+ }
+ }
+ return if ( $ok and not $::opt_n ) || $body;
+
+ # Check that we have a report that has some, eh, report in it.
+
+ 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
+ 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) {
- paraprint <<EOF;
-Now that you have completed your report, would you like to send
-the message to $address$andcc, display the message on
-the screen, re-edit it, or cancel without sending anything?
-You may also save the message as a file to mail at another time.
-EOF
- print "Action (Send/Display/Edit/Cancel/Save to File): ";
- my $action = scalar <>;
- chop $action;
+ my $menu = <<EOF;
+
+
+You have finished composing your message. 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
+
+EOF
+ retry:
+ print $menu;
+ my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
+ print "\n";
if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
- print "\n\nName of file to save message in [perlbug.rep]: ";
- my $file = scalar <>;
- chop $file;
- $file = "perlbug.rep" if $file eq "";
-
- open(FILE, ">$file");
- open(REP, "<$filename");
- print FILE "To: $address\nSubject: $subject\n";
- print FILE "Cc: $cc\n" if $cc;
- print FILE "Reply-To: $from\n" if $from;
- print FILE "\n";
- while (<REP>) { print FILE }
- close(REP);
- close(FILE);
-
- print "\nMessage saved in `$file'.\n";
- exit;
+ if ( SaveMessage() ) { exit }
} elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
# Display the message
- open(REP, "<$filename");
+ open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
while (<REP>) { print $_ }
- close(REP);
+ close(REP) or die "Error closing report file '$filename': $!";
+ } elsif ($action =~ /^su/i) { # <Su>bject
+ 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;
+ print "Subject: $subject\n";
+ }
+ }
} 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>;
- chop $reply;
- if ($reply eq "yes") {
+ 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;
-That wasn't a clear "yes", so I won't send your message. If you are sure
-your message should be sent, type in "yes" (without the quotes) at the
-confirmation prompt.
+You didn't type "yes", so your message has not yet been sent.
EOF
}
} elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
Edit();
} elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
Cancel();
- } elsif ($action =~ /^s/) {
+ } elsif ($action =~ /^s/i) {
paraprint <<EOF;
-I'm sorry, but I didn't understand that. Please type "send" or "save".
+The command you entered was ambiguous. Please type "send", "save" or "subject".
EOF
}
}
}
} # sub NowWhat
+sub TrivialSubject {
+ my $subject = shift;
+ if ($subject =~
+ /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
+ length($subject) < 4 ||
+ $subject !~ /\s/) {
+ print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+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 ($::HaveSend) {
- $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");
- while (<REP>) { print $fh $_ }
- close(REP);
- $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";
- }
- }
- paraprint(<<"EOF"), die "\n" if $sendmail eq "";
-I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
-the perl package Mail::Send has not been installed, so I can't send your bug
-report. We apologize for the inconvenience.
+ # 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
+ eval {
+ if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
+ _send_message_mailsend();
+ } elsif ($Is_VMS) {
+ _send_message_vms();
+ } else {
+ _send_message_sendmail();
+ }
+ };
+
+ if ( my $error = $@ ) {
+ paraprint <<EOF;
+$0 has detected an error while trying to send your message: $error.
-So you may attempt to find some way of sending your message, it has
-been left in the file `$filename'.
+Your message may not have been sent. You will now have a chance to save a copy to disk.
EOF
- open(SENDMAIL, "|$sendmail -t") || die "'|$sendmail -t' failed: $!";
- 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 "\n\n";
- open(REP, "<$filename");
- while (<REP>) { print SENDMAIL $_ }
- close(REP);
-
- if (close(SENDMAIL)) {
- print "\nMessage sent.\n";
- } 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;
-A program to help generate bug reports about perl5, and mail them.
-It is designed to be used interactively. Normally no arguments will
-be needed.
+This program is designed to help you generate and send 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
+line without any special arguments and follow the prompts.
-Usage:
-$0 [-v] [-a address] [-s subject] [-b body | -f file ]
+Advanced usage:
+
+$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
[-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
-$0 [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
+$0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
-Simplest usage: run "$0", and follow the prompts.
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.
+ -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'.
- -c Address to send copy of report to. Defaults to `$cc'.
+ -a Address to send the report to. Defaults to '$address'.
+ -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
if you don't supply one on the command line.
-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'.
- -d Data mode (the default if you redirect or pipe output.)
- This prints out your configuration data, without mailing
+ -t Test mode. The target address defaults to '$testaddress'.
+ -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.
}
sub filename {
- my $dir = $Is_VMS ? 'sys$scratch:'
- : ($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'}
- : '/tmp/';
- $filename = "bugrep0$$";
- $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
- $filename++ while -e "$dir$filename";
- $filename = "$dir$filename";
+ if ($::HaveTemp) {
+ # Good. Use a secure temp file
+ my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
+ close($fh);
+ return $filename;
+ } else {
+ # Bah. Fall back to doing things less securely.
+ my $dir = File::Spec->tmpdir();
+ $filename = "bugrep0$$";
+ $filename++ while -e File::Spec->catfile($dir, $filename);
+ $filename = File::Spec->catfile($dir, $filename);
+ }
}
sub paraprint {
my @paragraphs = split /\n{2,}/, "@_";
- print "\n\n";
for (@paragraphs) { # implicit local $_
s/(\S)\s*\n/$1 /g;
write;
}
}
+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 =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$_
=head1 SYNOPSIS
+B<perlbug>
+
B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
-S<[ B<-b> I<body> | B<-f> I<file> ]> S<[ B<-r> I<returnaddress> ]>
+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<-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<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
+ S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
+
+B<perlthanks>
=head1 DESCRIPTION
-A program to help generate bug reports about perl or the modules that
-come with it, and mail them.
-If you have found a bug with a non-standard port (one that was not part
-of the I<standard distribution>), a binary distribution, or a
-non-standard module (such as Tk, CGI, etc), then please see the
-documentation that came with that distribution to determine the correct
-place to report bugs.
+This program is designed to help you generate and send bug reports
+(and thank-you notes) about perl5 and the modules which ship with it.
-C<perlbug> is designed to be used interactively. Normally no arguments
-will be needed. Simply run it, and follow the prompts.
+In most cases, you can just run it interactively from a command
+line without any special arguments and follow the prompts.
-If you are unable to run B<perlbug> (most likely because you don't have
-a working setup to send mail that perlbug recognizes), you may have to
-compose your own report, and email it to B<perlbug@perl.com>. You might
-find the B<-d> option useful to get summary information in that case.
+If you have found a bug with a non-standard port (one that was not
+part of the I<standard distribution>), a binary distribution, or a
+non-core module (such as Tk, DBI, etc), then please see the
+documentation that came with that distribution to determine the
+correct place to report bugs.
-In any case, when reporting a bug, please make sure you have run through
-this checklist:
+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>.
+
+
+When reporting a bug, please run through this checklist:
=over 4
-=item What version of perl you are running?
+=item What version of Perl you are running?
Type C<perl -v> at the command line to find out.
=item Are you running the latest released version of perl?
-Look at http://www.perl.com/ to find out. If it is not the latest
-released version, get that one and see whether your bug has been
-fixed. Note that bug reports about old versions of perl, especially
-those prior to the 5.0 release, are likely to fall upon deaf ears.
-You are on your own if you continue to use perl1 .. perl4.
+Look at http://www.perl.org/ to find out. If you are not using the
+latest released version, please try to replicate your bug on the
+latest stable 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
+prior to Perl 5.0.
=item Are you sure what you have is a bug?
-A significant number of the bug reports we get turn out to be documented
-features in perl. Make sure the behavior you are witnessing doesn't fall
-under that category, by glancing through the documentation that comes
-with perl (we'll admit this is no mean task, given the sheer volume of
-it all, but at least have a look at the sections that I<seem> relevant).
+A significant number of the bug reports we get turn out to be
+documented features in Perl. Make sure the issue you've run into
+isn't intentional by glancing through the documentation that comes
+with the Perl distribution.
+
+Given the sheer volume of Perl documentation, this isn't a trivial
+undertaking, but if you can point to documentation that suggests
+the behaviour you're seeing is I<wrong>, your issue is likely to
+receive more attention. You may want to start with B<perldoc>
+L<perltrap> for pointers to common traps that new (and experienced)
+Perl programmers run into.
-Be aware of the familiar traps that perl programmers of various hues
-fall into. See L<perltrap>.
+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.
-Try to study the problem under the perl debugger, if necessary.
-See L<perldebug>.
+If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
+features may be unimplemented or work differently.
+
+You may be able to figure out what's going wrong using the Perl
+debugger. For information about how to use the debugger B<perldoc>
+L<perldebug>.
=item Do you have a proper test case?
The easier it is to reproduce your bug, the more likely it will be
-fixed, because if no one can duplicate the problem, no one can fix it.
-A good test case has most of these attributes: fewest possible number
-of lines; few dependencies on external commands, modules, or
-libraries; runs on most platforms unimpeded; and is self-documenting.
+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;
+few dependencies on external commands, modules, or libraries; no
+platform-dependent code (unless it's a platform-specific bug);
+clear, simple documentation.
+
+A good test case is almost always a good candidate to be included in
+Perl's test suite. If you have the time, consider writing your test case so
+that it can be easily included into the standard test suite.
+
+=item Have you included all relevant information?
+
+Be sure to include the B<exact> error messages, if any.
+"Perl gave an error" is not an exact error message.
-A good test case is almost always a good candidate to be on the perl
-test suite. If you have the time, consider making your test case so
-that it will readily fit into the standard test suite.
+If you get a core dump (or equivalent), you may use a debugger
+(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
+report.
+
+NOTE: unless your Perl has been compiled with debug info
+(often B<-g>), the stack trace is likely to be somewhat hard to use
+because it will most probably contain only the function names and not
+their arguments. If possible, recompile your Perl with debug info and
+reproduce the crash and the stack trace.
=item Can you describe the bug in plain English?
-The easier it is to understand a reproducible bug, the more likely it
-will be fixed. Anything you can provide by way of insight into the
-problem helps a great deal. In other words, try to analyse the
-problem to the extent you feel qualified and report your discoveries.
+The easier it is to understand a reproducible bug, the more likely
+it will be fixed. Any insight you can provide into the problem
+will help a great deal. In other words, try to analyze the problem
+(to the extent you can) and report your discoveries.
=item Can you fix the bug yourself?
A bug report which I<includes a patch to fix it> will almost
-definitely be fixed. Use the C<diff> program to generate your patches
-(C<diff> is being maintained by the GNU folks as part of the B<diffutils>
-package, so you should be able to get it from any of the GNU software
-repositories). If you do submit a patch, the cool-dude counter at
-perlbug@perl.com will register you as a savior of the world. Your
-patch may be returned with requests for changes, or requests for more
+definitely be fixed. When sending a patch, please use the C<diff>
+program with the C<-u> option to generate "unified" diff files.
+Bug reports with patches are likely to receive significantly more
+attention and interest than those without patches.
+
+Your patch may be returned with requests for changes, or requests for more
detailed explanations about your fix.
-Here are some clues for creating quality patches: Use the B<-c> or
-B<-u> switches to the diff program (to create a so-called context or
-unified diff). Make sure the patch is not reversed (the first
-argument to diff is typically the original file, the second argument
-your changed file). Make sure you test your patch by applying it with
-the C<patch> program before you send it on its way. Try to follow the
-same style as the code you are trying to patch. Make sure your patch
-really does work (C<make test>, if the thing you're patching supports
-it).
+Here are a few hints for creating high-quality patches:
+
+Make sure the patch is not reversed (the first argument to diff is
+typically the original file, the second argument your changed file).
+Make sure you test your patch by applying it with the C<patch>
+program before you send it on its way. Try to follow the same style
+as the code you are trying to patch. Make sure your patch really
+does work (C<make test>, if the thing you're patching is covered
+by Perl's test suite).
=item Can you use C<perlbug> to submit the report?
B<perlbug> will, amongst other things, ensure your report includes
-crucial information about your version of perl. If C<perlbug> is unable
-to mail your report after you have typed it in, you may have to compose
-the message yourself, add the output produced by C<perlbug -d> and email
-it to B<perlbug@perl.com>. If, for some reason, you cannot run
-C<perlbug> at all on your system, be sure to include the entire output
-produced by running C<perl -V> (note the uppercase V).
+crucial information about your version of perl. If C<perlbug> is
+unable to mail your report after you have typed it in, you may have
+to compose the message yourself, add the output produced by C<perlbug
+-d> and email it to B<perlbug@perl.org>. If, for some reason, you
+cannot run C<perlbug> at all on your system, be sure to include the
+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" is not informative. Neither
+is "perl crashes" nor is "HELP!!!". These don't help. A compact
+description of what's wrong is fine.
+
+=item Can you use C<perlbug> to submit a thank-you note?
+
+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.
=back
-Having done your bit, please be prepared to wait, to be told the bug
-is in your code, or even to get no reply at all. The perl maintainers
-are busy folks, so if your problem is a small one or if it is difficult
-to understand or already known, they may not respond with a personal reply.
+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
-C<Changes> file in any development releases since the time you submitted
-the bug, and encourage the maintainers with kind words (but never any
-flames!). Feel free to resend your bug report if the next released
-version of perl comes out and your bug is still present.
+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
=item B<-a>
-Address to send the report to. Defaults to `perlbug@perl.com'.
+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.
=item B<-b>
File containing the body of the report. Use this to quickly send a
prepared message.
+=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.
+
=item B<-h>
Prints a brief summary of the options.
=item B<-t>
-Test mode. The target address defaults to `perlbug-test@perl.com'.
+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>
=head1 AUTHORS
-Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
-by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
-(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
-Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
-(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>)
-and Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>).
+Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
+I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
+Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
+(E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
+Mike Guy (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop
+(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.foley@rfi.netE<gt>), and Jesse Vincent
+(E<lt>jesse@bestpractical.com<gt>).
=head1 SEE ALSO
-perl(1), perldebug(1), perltrap(1), diff(1), patch(1)
+perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
+diff(1), patch(1), dbx(1), gdb(1)
=head1 BUGS
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
-
+chdir $origdir;
https://perl5.git.perl.org / perl5.git / blobdiff