This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Also guess $ENV{EMAIL}, if present, as the originating address
[perl5.git] / utils / perlbug.PL
CommitLineData
37fa004c
PP
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
8a5546a1 5use Cwd;
1948c06a 6use File::Spec::Functions;
37fa004c
PP
7
8# List explicitly here the variables you want Configure to
9# generate. Metaconfig only looks for shell variables, so you
10# have to mention them as if they were shell variables, not
11# %Config entries. Thus you write
12# $startperl
13# to ensure Configure will look for $Config{startperl}.
84902520 14# $perlpath
37fa004c
PP
15
16# This forces PL files to create target in same directory as PL file.
17# This is so that make depend always knows where to find PL derivatives.
8a5546a1 18$origdir = cwd;
44a8e56a
PP
19chdir dirname($0);
20$file = basename($0, '.PL');
774d564b 21$file .= '.com' if $^O eq 'VMS';
37fa004c 22
55d729e4 23open OUT, ">$file" or die "Can't create $file: $!";
37fa004c 24
84902520
TB
25# extract patchlevel.h information
26
1948c06a
CN
27open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
28 or die "Can't open patchlevel.h: $!";
84902520
TB
29
30my $patchlevel_date = (stat PATCH_LEVEL)[9];
31
32while (<PATCH_LEVEL>) {
548074df
YST
33 last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
34}
35
36if (! defined($_)) {
37 warn "Warning: local_patches section not found in patchlevel.h\n";
55d729e4 38}
84902520 39
fb73857a 40my @patches;
84902520 41while (<PATCH_LEVEL>) {
fb73857a 42 last if /^\s*}/;
3bcc0c4b 43 next if /^\s*#/; # preprocessor stuff
7acb6aa6 44 next if /PERL_GIT_UNPUSHED_COMMITS/; # XXX expand instead
691ce773 45 next if /"uncommitted-changes"/; # XXX determine if active instead
84902520 46 chomp;
5963b987
GS
47 s/^\s+,?\s*"?//;
48 s/"?\s*,?$//;
84902520 49 s/(['\\])/\\$1/g;
fb73857a 50 push @patches, $_ unless $_ eq 'NULL';
55d729e4
GS
51}
52my $patch_desc = "'" . join("',\n '", @patches) . "'";
53my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
84902520 54
c0a6bf09 55close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
84902520 56
5edeba26
TB
57# TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
58# used, compare $Config::config_sh with the stored version. If they differ then
59# append a list of individual differences to the bug report.
60
84902520 61
37fa004c
PP
62print "Extracting $file (with variable substitutions)\n";
63
64# In this section, perl variables will be expanded during extraction.
65# You can use $Config{...} to use Configure variables.
66
fa510083 67my $extract_version = sprintf("%vd", $^V);
1ec03f31 68
37fa004c 69print OUT <<"!GROK!THIS!";
5f05dabc
PP
70$Config{startperl}
71 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
72 if \$running_under_some_shell;
84902520 73
1ec03f31 74my \$config_tag1 = '$extract_version - $Config{cf_time}';
fb73857a 75
84902520 76my \$patchlevel_date = $patchlevel_date;
fb73857a
PP
77my \$patch_tags = '$patch_tags';
78my \@patches = (
55d729e4 79 $patch_desc
fb73857a 80);
37fa004c
PP
81!GROK!THIS!
82
83# In the following, perl variables are not expanded during extraction.
84
85print OUT <<'!NO!SUBS!';
86
54c90be1
J
87use warnings;
88no warnings 'once'; # Eventually, the $::opt_ stuff should get cleaned up
721e2275 89use strict;
37fa004c 90use Config;
1ec03f31 91use File::Spec; # keep perlbug Perl 5.005 compatible
37fa004c 92use Getopt::Std;
721e2275 93use File::Basename 'basename';
37fa004c
PP
94
95sub paraprint;
96
55d729e4 97BEGIN {
54c90be1 98 eval { require Mail::Send;};
55d729e4 99 $::HaveSend = ($@ eq "");
54c90be1 100 eval { require Mail::Util; } ;
55d729e4 101 $::HaveUtil = ($@ eq "");
003a92ef 102 # use secure tempfiles wherever possible
54c90be1 103 eval { require File::Temp; };
003a92ef 104 $::HaveTemp = ($@ eq "");
13f4c5e4
AC
105 eval { require Module::CoreList; };
106 $::HaveCoreList = ($@ eq "");
55d729e4 107};
c07a80fd 108
54c90be1 109my $Version = "1.39";
c07a80fd
PP
110
111# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
a5f75d66
AD
112# Changed in 1.07 to see more sendmail execs, and added pipe output.
113# Changed in 1.08 to use correct address for sendmail.
c07a80fd
PP
114# Changed in 1.09 to close the REP file before calling it up in the editor.
115# Also removed some old comments duplicated elsewhere.
116# Changed in 1.10 to run under VMS without Mail::Send; also fixed
a5f75d66 117# temp filename generation.
c07a80fd 118# Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
a5f75d66
AD
119# Changed in 1.12 to check for editor errors, make save/send distinction
120# clearer and add $ENV{REPLYTO}.
84478119
PP
121# Changed in 1.13 to hopefully make it more difficult to accidentally
122# send mail
ab3ef367
PP
123# Changed in 1.14 to make the prompts a little more clear on providing
124# helpful information. Also let file read fail gracefully.
8ecf1a0c
KA
125# Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
126# Also report selected environment variables.
774d564b 127# Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
137443ea 128# Changed in 1.17 Win32 support added. GSAR 97-04-12
1b0e3b9e 129# Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18
84902520
TB
130# Changed in 1.19 '-ok' default not '-v'
131# add local patch information
132# warn on '-ok' if this is an old system; add '-okay'
fb73857a 133# Changed in 1.20 Added patchlevel.h reading and version/config checks
55d729e4
GS
134# Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
135# Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
cca87523 136# Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt
105f9295 137# Changed in 1.24 Added '-F<file>' to save report HVDS 98-07-01
8b49bb9a 138# Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
eedd3c36 139# Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
1948c06a 140# Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
50d3c28b 141# Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
975b416b 142# Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
b0c10877 143# Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
c0a6bf09 144# Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
93b42772 145# Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
489b74f8 146# Changed in 1.33 Don't require -t STDOUT for -ok.
de94c9df 147# Changed in 1.34 Added Message-Id RFOLEY 18-06-2002
003a92ef 148# Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004
13f4c5e4 149# Changed in 1.36 Initial Module::CoreList support Alexandr Ciornii 11-07-2007
54c90be1
J
150# Changed in 1.37 Killed some string evals, rewrote most prose JESSE 2008-06-08
151# Changed in 1.38 Actually enforce the CoreList check,
152# Record the module the user enters if they do so
153# Refactor prompts to use common code JESSE 2008-06-08
154# Changed in 1.39 Trap mail sending failures (simple ones) so JESSE 2008-06-08
155# users might be able to recover their bug reports
156# Refactor mail sending routines
157# Unify message building code
158# Unify message header building
159# Fix "module" prompting to not squish "category" prompting
160# use warnings; (except 'once' warnings)
161# Unified report fingerprint/change detection code
162# Removed some labeled 'gotos'
163#TODO:
164# make sure failure (transmission-wise) of Mail::Send is accounted for.
165# (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
1b0e3b9e 166# - Test -b option
37fa004c 167
721e2275
NC
168my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
169 $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
54c90be1
J
170 $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
171 $Is_MacOS, $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
172 $report_about_module, $category, $severity,
173
174);
37fa004c 175
fa510083 176my $perl_version = $^V ? sprintf("%vd", $^V) : $];
1ec03f31
GS
177
178my $config_tag2 = "$perl_version - $Config{cf_time}";
fb73857a 179
37fa004c
PP
180Init();
181
55d729e4
GS
182if ($::opt_h) { Help(); exit; }
183if ($::opt_d) { Dump(*STDOUT); exit; }
eedd3c36 184if (!-t STDIN && !($ok and not $::opt_n)) {
721e2275
NC
185 paraprint <<"EOF";
186Please use $progname interactively. If you want to
84478119
PP
187include a file, you can use the -f switch.
188EOF
55d729e4 189 die "\n";
84478119 190}
c07a80fd 191
37fa004c 192Query();
cca87523 193Edit() unless $usefile || ($ok and not $::opt_n);
37fa004c 194NowWhat();
54c90be1
J
195if ($outfile) {
196 save_message_to_disk($outfile);
197} else {
198 Send();
4dbf56a0
NC
199 if ($thanks) {
200 print "\nThank you for taking the time to send a thank-you message!\n\n";
201 } else {
202 print "\nThank you for taking the time to file a bug report!\n\n";
203 }
54c90be1 204}
37fa004c
PP
205
206exit;
207
975b416b 208sub ask_for_alternatives { # (category|severity)
50d3c28b 209 my $name = shift;
975b416b
GS
210 my %alts = (
211 'category' => {
212 'default' => 'core',
213 'ok' => 'install',
721e2275
NC
214 # Inevitably some of these will end up in RT whatever we do:
215 'thanks' => 'thanks',
975b416b
GS
216 'opts' => [qw(core docs install library utilities)], # patch, notabug
217 },
218 'severity' => {
219 'default' => 'low',
220 'ok' => 'none',
dda32041 221 'thanks' => 'none',
975b416b 222 'opts' => [qw(critical high medium low wishlist none)], # zero
7f2de2d2 223 },
975b416b 224 );
54c90be1 225 die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
50d3c28b 226 my $alt = "";
721e2275
NC
227 my $what = $ok || $thanks;
228 if ($what) {
229 $alt = $alts{$name}{$what};
975b416b
GS
230 } else {
231 my @alts = @{$alts{$name}{'opts'}};
54c90be1 232 print "\n\n";
975b416b 233 paraprint <<EOF;
54c90be1 234Please pick a $name from the following list:
50d3c28b
GS
235
236 @alts
50d3c28b 237EOF
975b416b
GS
238 my $err = 0;
239 do {
240 if ($err++ > 5) {
241 die "Invalid $name: aborting.\n";
242 }
54c90be1
J
243 $alt = _prompt('', "\u$name", $alts{$name}{'default'});
244 $alt ||= $alts{$name}{'default'};
975b416b
GS
245 } while !((($alt) = grep(/^$alt/i, @alts)));
246 }
50d3c28b
GS
247 lc $alt;
248}
249
37fa004c 250sub Init {
55d729e4
GS
251 # -------- Setup --------
252
253 $Is_MSWin32 = $^O eq 'MSWin32';
254 $Is_VMS = $^O eq 'VMS';
afc5e478 255 $Is_Linux = lc($^O) eq 'linux';
8843dda6 256 $Is_OpenBSD = lc($^O) eq 'openbsd';
1948c06a
CN
257 $Is_MacOS = $^O eq 'MacOS';
258
259 @ARGV = split m/\s+/,
54c90be1 260 MacPerl::Ask('Provide command line args here (-h for help):')
1948c06a 261 if $Is_MacOS && $MacPerl::Version =~ /App/;
55d729e4 262
721e2275 263 if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T")) { Help(); exit; };
55d729e4
GS
264
265 # This comment is needed to notify metaconfig that we are
266 # using the $perladmin, $cf_by, and $cf_time definitions.
267
268 # -------- Configuration ---------
269
270 # perlbug address
721e2275 271 $bugaddress = 'perlbug@perl.org';
55d729e4
GS
272
273 # Test address
3e79b69b 274 $testaddress = 'perlbug-test@perl.org';
55d729e4 275
721e2275
NC
276 # Thanks address
277 $thanksaddress = 'perl-thanks@perl.org';
278
279 if (basename ($0) =~ /^perlthanks/i) {
280 # invoked as perlthanks
281 $::opt_T = 1;
282 $::opt_C = 1; # don't send a copy to the local admin
283 }
284
285 if ($::opt_T) {
286 $thanks = 'thanks';
287 }
288
289 $progname = $thanks ? 'perlthanks' : 'perlbug';
55d729e4 290 # Target address
721e2275
NC
291 $address = $::opt_a || ($::opt_t ? $testaddress
292 : $thanks ? $thanksaddress : $bugaddress);
55d729e4
GS
293
294 # Users address, used in message and in Reply-To header
295 $from = $::opt_r || "";
296
297 # Include verbose configuration information
298 $verbose = $::opt_v || 0;
299
300 # Subject of bug-report message
301 $subject = $::opt_s || "";
302
303 # Send a file
304 $usefile = ($::opt_f || 0);
305
306 # File to send as report
307 $file = $::opt_f || "";
308
105f9295
HS
309 # File to output to
310 $outfile = $::opt_F || "";
311
55d729e4
GS
312 # Body of report
313 $body = $::opt_b || "";
de94c9df 314
55d729e4
GS
315 # Editor
316 $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
317 || ($Is_VMS && "edit/tpu")
318 || ($Is_MSWin32 && "notepad")
1948c06a 319 || ($Is_MacOS && '')
55d729e4
GS
320 || "vi";
321
322 # Not OK - provide build failure template by finessing OK report
323 if ($::opt_n) {
324 if (substr($::opt_n, 0, 2) eq 'ok' ) {
325 $::opt_o = substr($::opt_n, 1);
326 } else {
327 Help();
328 exit();
329 }
330 }
331
332 # OK - send "OK" report for build on this system
721e2275 333 $ok = '';
55d729e4
GS
334 if ($::opt_o) {
335 if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
336 my $age = time - $patchlevel_date;
337 if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
338 my $date = localtime $patchlevel_date;
339 print <<"EOF";
340"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
341are more than 60 days old. This Perl version was constructed on
342$date. If you really want to report this, use
343"perlbug -okay" or "perlbug -nokay".
84902520 344EOF
1b0e3b9e
CR
345 exit();
346 }
55d729e4
GS
347 # force these options
348 unless ($::opt_n) {
349 $::opt_S = 1; # don't prompt for send
350 $::opt_b = 1; # we have a body
351 $body = "Perl reported to build OK on this system.\n";
352 }
353 $::opt_C = 1; # don't send a copy to the local admin
354 $::opt_s = 1; # we have a subject line
355 $subject = ($::opt_n ? 'Not ' : '')
1ec03f31 356 . "OK: perl $perl_version ${patch_tags}on"
55d729e4 357 ." $::Config{'archname'} $::Config{'osvers'} $subject";
721e2275 358 $ok = 'ok';
55d729e4
GS
359 } else {
360 Help();
361 exit();
1b0e3b9e 362 }
55d729e4 363 }
37fa004c 364
55d729e4
GS
365 # Possible administrator addresses, in order of confidence
366 # (Note that cf_email is not mentioned to metaconfig, since
367 # we don't really want it. We'll just take it if we have to.)
368 #
369 # This has to be after the $ok stuff above because of the way
370 # that $::opt_C is forced.
371 $cc = $::opt_C ? "" : (
372 $::opt_c || $::Config{'perladmin'}
373 || $::Config{'cf_email'} || $::Config{'cf_by'}
374 );
375
de94c9df
RF
376 if ($::HaveUtil) {
377 $domain = Mail::Util::maildomain();
378 } elsif ($Is_MSWin32) {
379 $domain = $ENV{'USERDOMAIN'};
380 } else {
381 require Sys::Hostname;
382 $domain = Sys::Hostname::hostname();
383 }
384
385 # Message-Id - rjsf
386 $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
387
55d729e4
GS
388 # My username
389 $me = $Is_MSWin32 ? $ENV{'USERNAME'}
390 : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
1948c06a 391 : $Is_MacOS ? $ENV{'USER'}
55d729e4 392 : eval { getpwuid($<) }; # May be missing
c0830f08
RB
393
394 $from = $::Config{'cf_email'}
395 if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
396 ($me eq $::Config{'cf_by'});
55d729e4 397} # sub Init
37fa004c
PP
398
399sub Query {
55d729e4
GS
400 # Explain what perlbug is
401 unless ($ok) {
721e2275
NC
402 if ($thanks) {
403 paraprint <<'EOF';
404This program provides an easy way to send a thank-you message back to the
405authors and maintainers of perl.
406
407If you wish to submit a bug report, please run it without the -T flag
408(or run the program perlbug rather than perlthanks)
409EOF
410 } else {
411 paraprint <<"EOF";
54c90be1
J
412This program provides an easy way to create a message reporting a
413bug in the core perl distribution (along with tests or patches)
414to the volunteers who maintain perl at $address. To send a thank-you
415note to $thanksaddress instead of a bug report, please run 'perlthanks'.
416
417Please do not use $0 to send test messages, test whether perl
418works, or to report bugs in perl modules from CPAN.
419
420For help using perl, try posting to the Usenet newsgroup
421comp.lang.perl.misc.
37fa004c 422EOF
721e2275 423 }
1b0e3b9e 424 }
37fa004c 425
55d729e4 426 # Prompt for subject of message, if needed
2e7f46bf 427
54c90be1 428 if ($subject && TrivialSubject($subject)) {
2e7f46bf
JH
429 $subject = '';
430 }
431
55d729e4 432 unless ($subject) {
54c90be1
J
433 print
434"First of all, please provide a subject for the message.\n";
435 if ( not $thanks) {
721e2275 436 paraprint <<EOF;
54c90be1
J
437This should be a concise description of your bug or problem
438which will help the volunteers working to improve perl to categorize
439and resolve the issue. Be as specific and descriptive as
440you can. A subject like "perl bug" or "perl problem" will make it
441much less likely that your issue gets the attention it deserves.
37fa004c 442EOF
721e2275 443 }
55d729e4
GS
444
445 my $err = 0;
2e7f46bf 446 do {
54c90be1 447 $subject = _prompt('','Subject');
2e7f46bf 448 if ($err++ == 5) {
721e2275
NC
449 if ($thanks) {
450 $subject = 'Thanks for Perl';
451 } else {
452 die "Aborting.\n";
453 }
55d729e4 454 }
2e7f46bf 455 } while (TrivialSubject($subject));
55d729e4
GS
456 }
457
458 # Prompt for return address, if needed
459 unless ($from) {
460 # Try and guess return address
461 my $guess;
462
c8a80d16 463 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'} || '';
1948c06a
CN
464 if ($Is_MacOS) {
465 require Mac::InternetConfig;
466 $guess = $Mac::InternetConfig::InternetConfig{
467 Mac::InternetConfig::kICEmail()
468 };
469 }
470
55d729e4 471 unless ($guess) {
de94c9df
RF
472 # move $domain to where we can use it elsewhere
473 if ($domain) {
55d729e4
GS
474 if ($Is_VMS && !$::Config{'d_socket'}) {
475 $guess = "$domain\:\:$me";
41f926b8 476 } else {
55d729e4 477 $guess = "$me\@$domain" if $domain;
c07a80fd 478 }
55d729e4
GS
479 }
480 }
37fa004c 481
55d729e4
GS
482 if ($guess) {
483 unless ($ok) {
484 paraprint <<EOF;
54c90be1
J
485Perl's developers may need your email address to contact you for
486further information about your issue or to inform you when it is
487resolved. If the default shown is not your email address, please
488correct it.
37fa004c 489EOF
55d729e4
GS
490 }
491 } else {
492 paraprint <<EOF;
54c90be1
J
493Please enter your full internet email address so that Perl's
494developers can contact you with questions about your issue or to
495inform you that it has been resolved.
37fa004c 496EOF
37fa004c 497 }
37fa004c 498
55d729e4
GS
499 if ($ok && $guess) {
500 # use it
501 $from = $guess;
502 } else {
503 # verify it
54c90be1 504 $from = _prompt('','Your address',$guess);
55d729e4
GS
505 $from = $guess if $from eq '';
506 }
507 }
37fa004c 508
55d729e4
GS
509 if ($from eq $cc or $me eq $cc) {
510 # Try not to copy ourselves
511 $cc = "yourself";
512 }
37fa004c 513
55d729e4
GS
514 # Prompt for administrator address, unless an override was given
515 if( !$::opt_C and !$::opt_c ) {
54c90be1
J
516 my $description = <<EOF;
517$0 can send a copy of this report to your local perl
518administrator. If the address below is wrong, please correct it,
519or enter 'none' or 'yourself' to not send a copy.
37fa004c 520EOF
54c90be1 521 my $entry = _prompt($description, "Local perl administrator", $cc);
37fa004c 522
55d729e4
GS
523 if ($entry ne "") {
524 $cc = $entry;
525 $cc = '' if $me eq $cc;
37fa004c 526 }
55d729e4 527 }
37fa004c 528
55d729e4 529 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
54c90be1
J
530 if ($cc) {
531 $andcc = " and $cc"
532 } else {
533 $andcc = ''
534 }
37fa004c 535
55d729e4 536 # Prompt for editor, if no override is given
ab3ef367 537editor:
55d729e4 538 unless ($::opt_e || $::opt_f || $::opt_b) {
26ab4e07 539
54c90be1 540 my $description;
26ab4e07 541
54c90be1
J
542 chomp (my $common_end = <<"EOF");
543You will probably want to use a text editor to enter the body of
544your report. If "$ed" is the editor you want to use, then just press
545Enter, otherwise type in the name of the editor you would like to
546use.
547
548If you have already composed the body of your report, you may enter
549"file", and $0 will prompt you to enter the name of the file
550containing your report.
721e2275
NC
551EOF
552
553 if ($thanks) {
54c90be1
J
554 $description = <<"EOF";
555It's now time to compose your thank-you message.
721e2275 556
54c90be1
J
557Some information about your local perl configuration will automatically
558be included at the end of your message, because we're curious about
559the different ways that people build and use perl. If you'd rather
560not share this information, you're welcome to delete it.
721e2275
NC
561
562$common_end
563EOF
564 } else {
54c90be1
J
565 $description = <<"EOF";
566It's now time to compose your bug report. Try to make the report
567concise but descriptive. Please include any detail which you think
568might be relevant or might help the volunteers working to improve
569perl. If you are reporting something that does not work as you think
570it should, please try to include examples of the actual result and of
571what you expected.
572
573Some information about your local perl configuration will automatically
574be included at the end of your report. If you are using an unusual
575version of perl, it would be useful if you could confirm that you
576can replicate the problem on a standard build of perl as well.
37fa004c 577
721e2275 578$common_end
37fa004c 579EOF
721e2275
NC
580 }
581
54c90be1 582 my $entry = _prompt($description, "Editor", $ed);
55d729e4
GS
583 $usefile = 0;
584 if ($entry eq "file") {
585 $usefile = 1;
586 } elsif ($entry ne "") {
587 $ed = $entry;
37fa004c 588 }
55d729e4 589 }
721e2275 590 if ($::HaveCoreList && !$ok && !$thanks) {
54c90be1
J
591 my $description = <<EOF;
592If your bug is about a Perl module rather than a core language
593feature, please enter its name here. If it's not, just hit Enter
594to skip this question.
13f4c5e4 595EOF
54c90be1
J
596
597 my $entry = '';
598 while ($entry eq '') {
599 $entry = _prompt($description, 'Module');
13f4c5e4 600 my $first_release = Module::CoreList->first_release($entry);
54c90be1 601 if ($entry and not $first_release) {
13f4c5e4 602 paraprint <<EOF;
54c90be1
J
603$entry is not a "core" Perl module. Please check that you entered
604its name correctly. If it is correct, quit this program, try searching
605for $entry on http://rt.cpan.org, and report your issue there.
13f4c5e4 606EOF
54c90be1
J
607
608 $entry = '';
0accdd48
NC
609 } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
610 paraprint <<"EOF";
611$entry included with core Perl is copied directly from the CPAN distribution.
612Please report bugs in $entry directly to its maintainers using $bug_tracker
613EOF
614 $entry = '';
54c90be1
J
615 } elsif ($entry) {
616 $category ||= 'library';
617 $report_about_module = $entry;
618 last;
619 } else {
620 last;
621 }
13f4c5e4
AC
622 }
623 }
37fa004c 624
50d3c28b 625 # Prompt for category of bug
975b416b 626 $category ||= ask_for_alternatives('category');
50d3c28b
GS
627
628 # Prompt for severity of bug
975b416b 629 $severity ||= ask_for_alternatives('severity');
50d3c28b 630
55d729e4
GS
631 # Generate scratch file to edit report in
632 $filename = filename();
37fa004c 633
55d729e4
GS
634 # Prompt for file to read report from, if needed
635 if ($usefile and !$file) {
ab3ef367 636filename:
54c90be1 637 my $description = <<EOF;
37fa004c 638What is the name of the file that contains your report?
37fa004c 639EOF
54c90be1 640 my $entry = _prompt($description, "Filename");
37fa004c 641
55d729e4
GS
642 if ($entry eq "") {
643 paraprint <<EOF;
54c90be1
J
644It seems you didn't enter a filename. Please choose to use a text
645editor or enter a filename.
ab3ef367 646EOF
55d729e4
GS
647 goto editor;
648 }
649
650 unless (-f $entry and -r $entry) {
651 paraprint <<EOF;
54c90be1
J
652'$entry' doesn't seem to be a readable file. You may have mistyped
653its name or may not have permission to read it.
654
655If you don't want to use a file as the content of your report, just
656hit Enter and you'll be able to select a text editor instead.
ab3ef367 657EOF
55d729e4 658 goto filename;
37fa004c 659 }
55d729e4
GS
660 $file = $entry;
661 }
37fa004c 662
55d729e4 663 # Generate report
c9967ac8 664 open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
721e2275
NC
665 my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
666 : $::opt_n ? "build failure" : "success";
37fa004c 667
55d729e4 668 print REP <<EOF;
84902520 669This is a $reptype report for perl from $from,
1ec03f31 670generated with the help of perlbug $Version running under perl $perl_version.
37fa004c
PP
671
672EOF
673
55d729e4
GS
674 if ($body) {
675 print REP $body;
676 } elsif ($usefile) {
677 open(F, "<$file")
c9967ac8 678 or die "Unable to read report file from '$file': $!\n";
55d729e4
GS
679 while (<F>) {
680 print REP $_
681 }
c9967ac8 682 close(F) or die "Error closing '$file': $!";
55d729e4 683 } else {
721e2275
NC
684 if ($thanks) {
685 print REP <<'EOF';
686
687-----------------------------------------------------------------
54c90be1 688[Please enter your thank-you message here]
721e2275
NC
689
690
691
54c90be1 692[You're welcome to delete anything below this line]
721e2275
NC
693-----------------------------------------------------------------
694EOF
695 } else {
696 print REP <<'EOF';
774d564b
PP
697
698-----------------------------------------------------------------
54c90be1 699[Please describe your issue here]
774d564b
PP
700
701
702
703[Please do not change anything below this line]
704-----------------------------------------------------------------
705EOF
721e2275 706 }
55d729e4
GS
707 }
708 Dump(*REP);
c0a6bf09 709 close(REP) or die "Error closing report file: $!";
55d729e4 710
54c90be1
J
711 # Set up an initial report fingerprint so we can compare it later
712 _fingerprint_lines_in_report();
713
55d729e4 714} # sub Query
c07a80fd
PP
715
716sub Dump {
55d729e4 717 local(*OUT) = @_;
37fa004c 718
50d3c28b
GS
719 print OUT <<EFF;
720---
721Flags:
722 category=$category
723 severity=$severity
890b8eb0 724EFF
54c90be1
J
725
726 if ($report_about_module ) {
727 print OUT <<EFF;
728 module=$report_about_module
729EFF
730 }
890b8eb0
NC
731 if ($::opt_A) {
732 print OUT <<EFF;
733 ack=no
734EFF
735 }
736 print OUT <<EFF;
50d3c28b
GS
737---
738EFF
739 print OUT "This perlbug was built using Perl $config_tag1\n",
1ec03f31 740 "It is being executed now by Perl $config_tag2.\n\n"
55d729e4 741 if $config_tag2 ne $config_tag1;
fb73857a 742
55d729e4 743 print OUT <<EOF;
1ec03f31 744Site configuration information for perl $perl_version:
37fa004c
PP
745
746EOF
55d729e4
GS
747 if ($::Config{cf_by} and $::Config{cf_time}) {
748 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
749 }
750 print OUT Config::myconfig;
37fa004c 751
55d729e4
GS
752 if (@patches) {
753 print OUT join "\n ", "Locally applied patches:", @patches;
754 print OUT "\n";
755 };
84902520 756
55d729e4 757 print OUT <<EOF;
8ecf1a0c 758
774d564b 759---
1ec03f31 760\@INC for perl $perl_version:
774d564b 761EOF
55d729e4
GS
762 for my $i (@INC) {
763 print OUT " $i\n";
764 }
774d564b 765
55d729e4 766 print OUT <<EOF;
8ecf1a0c 767
774d564b 768---
1ec03f31 769Environment for perl $perl_version:
8ecf1a0c 770EOF
5cf1d1f1
JH
771 my @env =
772 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
773 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
27414c22 774 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
8876aa85
JH
775 my %env;
776 @env{@env} = @env;
777 for my $env (sort keys %env) {
55d729e4
GS
778 print OUT " $env",
779 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
780 "\n";
781 }
782 if ($verbose) {
1ec03f31 783 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
55d729e4
GS
784 my $value;
785 foreach (sort keys %::Config) {
786 $value = $::Config{$_};
787 $value =~ s/'/\\'/g;
788 print OUT "$_='$value'\n";
84902520 789 }
55d729e4
GS
790 }
791} # sub Dump
37fa004c
PP
792
793sub Edit {
55d729e4
GS
794 # Edit the report
795 if ($usefile || $body) {
54c90be1
J
796 my $description = "Please make sure that the name of the editor you want to use is correct.";
797 my $entry = _prompt($description, 'Editor', $ed);
55d729e4
GS
798 $ed = $entry unless $entry eq '';
799 }
a5f75d66 800
54c90be1
J
801 _edit_file($ed);
802}
803
804sub _edit_file {
805 my $editor = shift;
806
807 my $report_written = 0;
808
809 while ( !$report_written ) {
810 if ($Is_MacOS) {
811 require ExtUtils::MakeMaker;
812 ExtUtils::MM_MacOS::launch_file($filename);
813 _prompt('', "Press Enter when done." );
814 } else { # we're not on oldschool mac os
815 my $exit_status = system("$editor $filename");
816 if ($exit_status) {
817 my $desc = <<EOF;
818The editor you chose ('$editor') could not be run!
819
820If you mistyped its name, please enter it now, otherwise just press Enter.
1948c06a 821EOF
54c90be1
J
822 my $entry = _prompt( $desc, 'Editor', $editor );
823 if ( $entry ne "" ) {
824 $editor = $entry;
825 next;
826 } else {
827 paraprint <<EOF;
828You may want to save your report to a file, so you can edit and
829mail it later.
a5f75d66 830EOF
54c90be1
J
831 return;
832 }
833 }
834 }
835 return if ( $ok and not $::opt_n ) || $body;
a5f75d66 836
54c90be1 837 # Check that we have a report that has some, eh, report in it.
774d564b 838
54c90be1
J
839 unless ( _fingerprint_lines_in_report() ) {
840 my $description = <<EOF;
841It looks like you didn't enter a report. You may [r]etry your edit
842or [c]ancel this report.
843EOF
844 my $action = _prompt( $description, "Action (Retry/Cancel) " );
845 if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
846 next;
847 } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
848 Cancel(); # cancel exits
849 }
850 }
851 # Ok. the user did what they needed to;
852 return;
55d729e4 853
55d729e4 854 }
54c90be1 855}
774d564b 856
774d564b
PP
857
858sub Cancel {
859 1 while unlink($filename); # remove all versions under VMS
54c90be1 860 print "\nQuitting without sending your message.\n";
774d564b 861 exit(0);
37fa004c
PP
862}
863
864sub NowWhat {
55d729e4
GS
865 # Report is done, prompt for further action
866 if( !$::opt_S ) {
867 while(1) {
54c90be1
J
868 my $menu = <<EOF;
869
870
871You have finished composing your message. At this point, you have
872a few options. You can:
873
6821e383 874 * [Se]nd the message to $address$andcc,
54c90be1
J
875 * [D]isplay the message on the screen,
876 * [R]e-edit the message
877 * Display or change the message's [su]bject
878 * Save the message to a [f]ile to mail at another time
879 * [Q]uit without sending a message
880
37fa004c 881EOF
8b49bb9a 882 retry:
54c90be1
J
883 print $menu;
884 my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
885 print "\n";
55d729e4 886 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
54c90be1 887 if ( SaveMessage() ) { exit }
55d729e4
GS
888 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
889 # Display the message
c9967ac8 890 open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
55d729e4 891 while (<REP>) { print $_ }
c9967ac8 892 close(REP) or die "Error closing report file '$filename': $!";
2e7f46bf 893 } elsif ($action =~ /^su/i) { # <Su>bject
54c90be1 894 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
2e7f46bf
JH
895 if ($reply ne '') {
896 unless (TrivialSubject($reply)) {
897 $subject = $reply;
898 print "Subject: $subject\n";
899 }
900 }
55d729e4
GS
901 } elsif ($action =~ /^se/i) { # <S>end
902 # Send the message
54c90be1
J
903 my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
904 if ($reply =~ /^yes$/) {
55d729e4
GS
905 last;
906 } else {
907 paraprint <<EOF;
54c90be1 908You didn't type "yes", so your message has not yet been sent.
ab3ef367 909EOF
55d729e4
GS
910 }
911 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
912 # edit the message
913 Edit();
914 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
915 Cancel();
01544859 916 } elsif ($action =~ /^s/i) {
55d729e4 917 paraprint <<EOF;
54c90be1 918The command you entered was ambiguous. Please type "send", "save" or "subject".
84478119 919EOF
55d729e4 920 }
37fa004c 921 }
55d729e4
GS
922 }
923} # sub NowWhat
37fa004c 924
2e7f46bf
JH
925sub TrivialSubject {
926 my $subject = shift;
927 if ($subject =~
928 /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
929 length($subject) < 4 ||
930 $subject !~ /\s/) {
54c90be1 931 print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
2e7f46bf
JH
932 return 1;
933 } else {
934 return 0;
935 }
936}
937
54c90be1
J
938sub SaveMessage {
939 my $file_save = $outfile || "$progname.rep";
940 my $file = _prompt( '', "Name of file to save message in", $file_save );
941 save_message_to_disk($file) || return undef;
942 print "\n";
943 paraprint <<EOF;
944A copy of your message has been saved in '$file' for you to
945send to '$address' with your normal mail client.
946EOF
947}
948
37fa004c 949sub Send {
54c90be1 950
55d729e4 951 # Message has been accepted for transmission -- Send the message
afc5e478 952
54c90be1 953 # on linux certain "mail" implementations won't accept the subject
afc5e478
SB
954 # as "~s subject" and thus the Subject header will be corrupted
955 # so don't use Mail::Send to be safe
54c90be1
J
956 eval {
957 if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
958 _send_message_mailsend();
959 } elsif ($Is_VMS) {
960 _send_message_vms();
961 } else {
962 _send_message_sendmail();
963 }
964 };
37fa004c 965
54c90be1
J
966 if ( my $error = $@ ) {
967 paraprint <<EOF;
968$0 has detected an error while trying to send your message: $error.
c07a80fd 969
54c90be1 970Your message may not have been sent. You will now have a chance to save a copy to disk.
c07a80fd 971EOF
54c90be1
J
972 SaveMessage();
973 return;
55d729e4 974 }
54c90be1
J
975
976 1 while unlink($filename); # remove all versions under VMS
977} # sub Send
37fa004c
PP
978
979sub Help {
55d729e4 980 print <<EOF;
37fa004c 981
54c90be1
J
982This program is designed to help you generate and send bug reports
983(and thank-you notes) about perl5 and the modules which ship with it.
984
985In most cases, you can just run "$0" interactively from a command
986line without any special arguments and follow the prompts.
987
988Advanced usage:
55d729e4 989
105f9295 990$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
d121ca8c 991 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
890b8eb0 992$0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
55d729e4 993
37fa004c
PP
994
995Options:
996
997 -v Include Verbose configuration data in the report
55d729e4 998 -f File containing the body of the report. Use this to
37fa004c 999 quickly send a prepared message.
1948c06a 1000 -F File to output the resulting mail message to, instead of mailing.
37fa004c 1001 -S Send without asking for confirmation.
c9967ac8
NC
1002 -a Address to send the report to. Defaults to '$address'.
1003 -c Address to send copy of report to. Defaults to '$cc'.
37fa004c 1004 -C Don't send copy to administrator.
55d729e4 1005 -s Subject to include with the message. You will be prompted
37fa004c
PP
1006 if you don't supply one on the command line.
1007 -b Body of the report. If not included on the command line, or
1008 in a file with -f, you will get a chance to edit the message.
1009 -r Your return address. The program will ask you to confirm
1010 this if you don't give it here.
55d729e4 1011 -e Editor to use.
c9967ac8
NC
1012 -t Test mode. The target address defaults to '$testaddress'.
1013 -T Thank-you mode. The target address defaults to '$thanksaddress'.
489b74f8 1014 -d Data mode. This prints out your configuration data, without mailing
c07a80fd 1015 anything. You can use this with -v to get more complete data.
890b8eb0 1016 -A Don't send a bug received acknowledgement to the return address.
84902520 1017 -ok Report successful build on this system to perl porters
55d729e4
GS
1018 (use alone or with -v). Only use -ok if *everything* was ok:
1019 if there were *any* problems at all, use -nok.
fb73857a 1020 -okay As -ok but allow report from old builds.
55d729e4
GS
1021 -nok Report unsuccessful build on this system to perl porters
1022 (use alone or with -v). You must describe what went wrong
1023 in the body of the report which you will be asked to edit.
1024 -nokay As -nok but allow report from old builds.
1025 -h Print this help message.
1026
37fa004c
PP
1027EOF
1028}
1029
55d729e4 1030sub filename {
003a92ef
NC
1031 if ($::HaveTemp) {
1032 # Good. Use a secure temp file
1033 my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
1034 close($fh);
1035 return $filename;
1036 } else {
1037 # Bah. Fall back to doing things less securely.
1038 my $dir = File::Spec->tmpdir();
1039 $filename = "bugrep0$$";
1040 $filename++ while -e File::Spec->catfile($dir, $filename);
1041 $filename = File::Spec->catfile($dir, $filename);
1042 }
55d729e4
GS
1043}
1044
37fa004c
PP
1045sub paraprint {
1046 my @paragraphs = split /\n{2,}/, "@_";
37fa004c 1047 for (@paragraphs) { # implicit local $_
55d729e4
GS
1048 s/(\S)\s*\n/$1 /g;
1049 write;
1050 print "\n";
37fa004c 1051 }
37fa004c 1052}
37fa004c 1053
54c90be1
J
1054sub _prompt {
1055 my ($explanation, $prompt, $default) = (@_);
1056 if ($explanation) {
1057 print "\n\n";
1058 paraprint $explanation;
1059 }
1060 print $prompt. ($default ? " [$default]" :''). ": ";
1061 my $result = scalar(<>);
1062 chomp($result);
1063 $result =~ s/^\s*(.*?)\s*$/$1/s;
1064 if ($default && $result eq '') {
1065 return $default;
1066 } else {
1067 return $result;
1068 }
1069}
1070
1071sub _build_header {
1072 my %attr = (@_);
1073
1074 my $head = '';
1075 for my $header (keys %attr) {
1076 $head .= "$header: ".$attr{$header}."\n";
1077 }
1078 return $head;
1079}
1080
1081sub _message_headers {
1082 my %headers = ( To => $address, Subject => $subject );
1083 $headers{'Cc'} = $cc if ($cc);
1084 $headers{'Message-Id'} = $messageid if ($messageid);
1085 $headers{'Reply-To'} = $from if ($from);
1086 return \%headers;
1087}
1088
1089sub build_complete_message {
1090 my $content = _build_header(%{_message_headers()}) . "\n\n";
1091 open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
1092 while (<REP>) { $content .= $_; }
1093 close(REP) or die "Error closing report file '$filename': $!";
1094 return $content;
1095}
1096
1097sub save_message_to_disk {
1098 my $file = shift;
1099
1100 open OUTFILE, ">$file" or do { warn "Couldn't open '$file': $!\n"; return undef};
1101 print OUTFILE build_complete_message();
1102 close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
1103 print "\nMessage saved.\n";
1104 return 1;
1105}
1106
1107sub _send_message_vms {
1108 if ( ( $address =~ /@/ and $address !~ /^\w+%"/ )
1109 or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
1110 my $prefix;
1111 foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
1112 $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
1113 }
1114 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
1115 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
1116 }
1117 $subject =~ s/"/""/g;
1118 $address =~ s/"/""/g;
1119 $cc =~ s/"/""/g;
1120 my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
1121 if ($sts) {
1122 die "Can't spawn off mail (leaving bug report in $filename): $sts";
1123 }
1124}
1125
1126sub _send_message_mailsend {
1127 my $msg = Mail::Send->new();
1128 my %headers = %{_message_headers()};
1129 for my $key ( keys %headers) {
1130 $msg->add($key => $headers{$key});
1131 }
1132
1133 $fh = $msg->open;
1134 open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
1135 while (<REP>) { print $fh $_ }
1136 close(REP) or die "Error closing $filename: $!";
e90b02b9 1137 $fh->close or die "Error sending mail: $!";
54c90be1
J
1138
1139 print "\nMessage sent.\n";
1140}
1141
1142sub _probe_for_sendmail {
1143 my $sendmail = "";
1144 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1145 $sendmail = $_, last if -e $_;
1146 }
1147 if ( $^O eq 'os2' and $sendmail eq "" ) {
1148 my $path = $ENV{PATH};
1149 $path =~ s:\\:/:;
1150 my @path = split /$Config{'path_sep'}/, $path;
1151 for (@path) {
1152 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
1153 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1154 }
1155 }
1156 return $sendmail;
1157}
1158
1159sub _send_message_sendmail {
1160 my $sendmail = _probe_for_sendmail();
1161 unless ($sendmail) {
e90d6148 1162 my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
54c90be1
J
1163It appears that there is no program which looks like "sendmail" on
1164your system and that the Mail::Send library from CPAN isn't available.
e90d6148
A
1165EOT
1166It appears that there is no program which looks like "sendmail" on
1167your system.
1168EOT
1169 paraprint(<<"EOF"), die "\n";
1170$message_start
54c90be1
J
1171Because of this, there's no easy way to automatically send your
1172message.
1173
1174A copy of your message has been saved in '$filename' for you to
1175send to '$address' with your normal mail client.
1176EOF
1177 }
1178
1179 open( SENDMAIL, "|$sendmail -t -oi" )
1180 || die "'|$sendmail -t -oi' failed: $!";
1181 print SENDMAIL build_complete_message();
1182 if ( close(SENDMAIL) ) {
1183 print "\nMessage sent\n";
1184 } else {
1185 warn "\nSendmail returned status '", $? >> 8, "'\n";
1186 }
1187}
1188
1189
1190
1191# a strange way to check whether any significant editing
1192# has been done: check whether any new non-empty lines
1193# have been added.
1194
1195sub _fingerprint_lines_in_report {
1196 my $new_lines = 0;
1197 # read in the report template once so that
1198 # we can track whether the user does any editing.
1199 # yes, *all* whitespace is ignored.
1200
1201 open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
1202 while (my $line = <REP>) {
1203 $line =~ s/\s+//g;
1204 $new_lines++ if (!$REP{$line});
1205
1206 }
1207 close(REP) or die "Error closing report file '$filename': $!";
1208 # returns the number of lines with content that wasn't there when last we looked
1209 return $new_lines;
1210}
1211
1212
1213
37fa004c
PP
1214format STDOUT =
1215^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1216$_
1217.
d121ca8c
CS
1218
1219__END__
1220
1221=head1 NAME
1222
1223perlbug - how to submit bug reports on Perl
1224
1225=head1 SYNOPSIS
1226
54c90be1
J
1227B<perlbug>
1228
d121ca8c 1229B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
105f9295
HS
1230S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1231S<[ B<-r> I<returnaddress> ]>
d121ca8c 1232S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
985dc10a 1233S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]>
d121ca8c 1234
55d729e4 1235B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
890b8eb0 1236 S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1b0e3b9e 1237
985dc10a
SP
1238B<perlthanks>
1239
d121ca8c
CS
1240=head1 DESCRIPTION
1241
d121ca8c 1242
54c90be1
J
1243This program is designed to help you generate and send bug reports
1244(and thank-you notes) about perl5 and the modules which ship with it.
1245
1246In most cases, you can just run it interactively from a command
1247line without any special arguments and follow the prompts.
1248
1249If you have found a bug with a non-standard port (one that was not
1250part of the I<standard distribution>), a binary distribution, or a
1251non-core module (such as Tk, DBI, etc), then please see the
1252documentation that came with that distribution to determine the
1253correct place to report bugs.
d121ca8c 1254
54c90be1
J
1255If you are unable to send your report using B<perlbug> (most likely
1256because your system doesn't have a way to send mail that perlbug
1257recognizes), you may be able to use this tool to compose your report
1258and save it to a file which you can then send to B<perlbug@perl.org>
1259using your regular mail client.
d121ca8c 1260
54c90be1
J
1261In extreme cases, B<perlbug> may not work well enough on your system
1262to guide you through composing a bug report. In those cases, you
1263may be able to use B<perlbug -d> to get system configuration
1264information to include in a manually composed bug report to
1265B<perlbug@perl.org>.
d121ca8c 1266
54c90be1
J
1267
1268When reporting a bug, please run through this checklist:
d121ca8c
CS
1269
1270=over 4
1271
884baa66 1272=item What version of Perl you are running?
d121ca8c
CS
1273
1274Type C<perl -v> at the command line to find out.
1275
1276=item Are you running the latest released version of perl?
1277
54c90be1
J
1278Look at http://www.perl.org/ to find out. If you are not using the
1279latest released version, please try to replicate your bug on the
1280latest stable release.
1281
1282Note that reports about bugs in old versions of Perl, especially
1283those which indicate you haven't also tested the current stable
1284release of Perl, are likely to receive less attention from the
1285volunteers who build and maintain Perl than reports about bugs in
1286the current release.
1287
1288This tool isn't apropriate for reporting bugs in any version
1289prior to Perl 5.0.
d121ca8c
CS
1290
1291=item Are you sure what you have is a bug?
1292
54c90be1
J
1293A significant number of the bug reports we get turn out to be
1294documented features in Perl. Make sure the issue you've run into
1295isn't intentional by glancing through the documentation that comes
1296with the Perl distribution.
d121ca8c 1297
54c90be1
J
1298Given the sheer volume of Perl documentation, this isn't a trivial
1299undertaking, but if you can point to documentation that suggests
1300the behaviour you're seeing is I<wrong>, your issue is likely to
1301receive more attention. You may want to start with B<perldoc>
1302L<perltrap> for pointers to common traps that new (and experienced)
1303Perl programmers run into.
d121ca8c 1304
54c90be1
J
1305If you're unsure of the meaning of an error message you've run
1306across, B<perldoc> L<perldiag> for an explanation. If the message
1307isn't in perldiag, it probably isn't generated by Perl. You may
1308have luck consulting your operating system documentation instead.
bdcdfa19 1309
54c90be1 1310If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1948c06a 1311features may be unimplemented or work differently.
bdcdfa19 1312
54c90be1
J
1313You may be able to figure out what's going wrong using the Perl
1314debugger. For information about how to use the debugger B<perldoc>
1315L<perldebug>.
d121ca8c
CS
1316
1317=item Do you have a proper test case?
1318
1319The easier it is to reproduce your bug, the more likely it will be
985dc10a 1320fixed -- if nobody can duplicate your problem, it probably won't be
54c90be1
J
1321addressed.
1322
1323A good test case has most of these attributes: short, simple code;
1324few dependencies on external commands, modules, or libraries; no
1325platform-dependent code (unless it's a platform-specific bug);
1326clear, simple documentation.
1327
1328A good test case is almost always a good candidate to be included in
1329Perl's test suite. If you have the time, consider writing your test case so
1330that it can be easily included into the standard test suite.
d121ca8c 1331
54c90be1 1332=item Have you included all relevant information?
d121ca8c 1333
54c90be1
J
1334Be sure to include the B<exact> error messages, if any.
1335"Perl gave an error" is not an exact error message.
bdcdfa19
JH
1336
1337If you get a core dump (or equivalent), you may use a debugger
1338(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
54c90be1
J
1339report.
1340
1341NOTE: unless your Perl has been compiled with debug info
bdcdfa19 1342(often B<-g>), the stack trace is likely to be somewhat hard to use
884baa66 1343because it will most probably contain only the function names and not
bdcdfa19 1344their arguments. If possible, recompile your Perl with debug info and
54c90be1 1345reproduce the crash and the stack trace.
bdcdfa19 1346
d121ca8c
CS
1347=item Can you describe the bug in plain English?
1348
54c90be1
J
1349The easier it is to understand a reproducible bug, the more likely
1350it will be fixed. Any insight you can provide into the problem
1351will help a great deal. In other words, try to analyze the problem
1352(to the extent you can) and report your discoveries.
d121ca8c
CS
1353
1354=item Can you fix the bug yourself?
1355
1356A bug report which I<includes a patch to fix it> will almost
54c90be1
J
1357definitely be fixed. When sending a patch, please use the C<diff>
1358program with the C<-u> option to generate "unified" diff files.
1359Bug reports with patches are likely to receive significantly more
1360attention and interest than those without patches.
1361
1362Your patch may be returned with requests for changes, or requests for more
d121ca8c
CS
1363detailed explanations about your fix.
1364
54c90be1
J
1365Here are a few hints for creating high-quality patches:
1366
1367Make sure the patch is not reversed (the first argument to diff is
1368typically the original file, the second argument your changed file).
1369Make sure you test your patch by applying it with the C<patch>
1370program before you send it on its way. Try to follow the same style
1371as the code you are trying to patch. Make sure your patch really
1372does work (C<make test>, if the thing you're patching is covered
1373by Perl's test suite).
d121ca8c
CS
1374
1375=item Can you use C<perlbug> to submit the report?
1376
1377B<perlbug> will, amongst other things, ensure your report includes
54c90be1
J
1378crucial information about your version of perl. If C<perlbug> is
1379unable to mail your report after you have typed it in, you may have
1380to compose the message yourself, add the output produced by C<perlbug
1381-d> and email it to B<perlbug@perl.org>. If, for some reason, you
1382cannot run C<perlbug> at all on your system, be sure to include the
1383entire output produced by running C<perl -V> (note the uppercase V).
d121ca8c 1384
bdcdfa19 1385Whether you use C<perlbug> or send the email manually, please make
54c90be1
J
1386your Subject line informative. "a bug" is not informative. Neither
1387is "perl crashes" nor is "HELP!!!". These don't help. A compact
1388description of what's wrong is fine.
bdcdfa19 1389
985dc10a
SP
1390=item Can you use C<perlbug> to submit a thank-you note?
1391
1392Yes, you can do this by either using the C<-T> option, or by invoking
1393the program as C<perlthanks>. Thank-you notes are good. It makes people
1394smile.
1395
d121ca8c
CS
1396=back
1397
54c90be1
J
1398Having done your bit, please be prepared to wait, to be told the
1399bug is in your code, or possibly to get no reply at all. The
1400volunteers who maintain Perl are busy folks, so if your problem is
1401an obvious bug in your own code, is difficult to understand or is
1402a duplicate of an existing report, you may not receive a personal
1403reply.
1404
26ab4e07 1405If it is important to you that your bug be fixed, do monitor the
54c90be1
J
1406perl5-porters@perl.org mailing list and the commit logs to development
1407versions of Perl, and encourage the maintainers with kind words or
1408offers of frosty beverages. (Please do be kind to the maintainers.
1409Harassing or flaming them is likely to have the opposite effect of
1410the one you want.)
1411
1412Feel free to update the ticket about your bug on http://rt.perl.org
1413if a new version of Perl is released and your bug is still present.
d121ca8c
CS
1414
1415=head1 OPTIONS
1416
1417=over 8
1418
1419=item B<-a>
1420
3e79b69b 1421Address to send the report to. Defaults to B<perlbug@perl.org>.
d121ca8c 1422
890b8eb0
NC
1423=item B<-A>
1424
1425Don't send a bug received acknowledgement to the reply address.
1426Generally it is only a sensible to use this option if you are a
1427perl maintainer actively watching perl porters for your message to
1428arrive.
1429
d121ca8c
CS
1430=item B<-b>
1431
1432Body of the report. If not included on the command line, or
1433in a file with B<-f>, you will get a chance to edit the message.
1434
1435=item B<-C>
1436
1437Don't send copy to administrator.
1438
1439=item B<-c>
1440
1441Address to send copy of report to. Defaults to the address of the
1442local perl administrator (recorded when perl was built).
1443
1444=item B<-d>
1445
1446Data mode (the default if you redirect or pipe output). This prints out
1447your configuration data, without mailing anything. You can use this
1448with B<-v> to get more complete data.
1449
1450=item B<-e>
1451
55d729e4 1452Editor to use.
d121ca8c
CS
1453
1454=item B<-f>
1455
1456File containing the body of the report. Use this to quickly send a
1457prepared message.
1458
105f9295
HS
1459=item B<-F>
1460
1461File to output the results to instead of sending as an email. Useful
1462particularly when running perlbug on a machine with no direct internet
1463connection.
1464
d121ca8c
CS
1465=item B<-h>
1466
1467Prints a brief summary of the options.
1468
1b0e3b9e
CR
1469=item B<-ok>
1470
84902520
TB
1471Report successful build on this system to perl porters. Forces B<-S>
1472and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1b0e3b9e 1473prompts for a return address if it cannot guess it (for use with
84902520
TB
1474B<make>). Honors return address specified with B<-r>. You can use this
1475with B<-v> to get more complete data. Only makes a report if this
1476system is less than 60 days old.
1477
1478=item B<-okay>
1479
1480As B<-ok> except it will report on older systems.
1b0e3b9e 1481
55d729e4
GS
1482=item B<-nok>
1483
1484Report unsuccessful build on this system. Forces B<-C>. Forces and
1485supplies a value for B<-s>, then requires you to edit the report
1486and say what went wrong. Alternatively, a prepared report may be
1487supplied using B<-f>. Only prompts for a return address if it
1488cannot guess it (for use with B<make>). Honors return address
1489specified with B<-r>. You can use this with B<-v> to get more
1490complete data. Only makes a report if this system is less than 60
1491days old.
1492
1493=item B<-nokay>
1494
1495As B<-nok> except it will report on older systems.
1496
d121ca8c
CS
1497=item B<-r>
1498
1499Your return address. The program will ask you to confirm its default
1500if you don't use this option.
1501
1502=item B<-S>
1503
1504Send without asking for confirmation.
1505
1506=item B<-s>
1507
1508Subject to include with the message. You will be prompted if you don't
1509supply one on the command line.
1510
1511=item B<-t>
1512
3e79b69b 1513Test mode. The target address defaults to B<perlbug-test@perl.org>.
d121ca8c 1514
985dc10a
SP
1515=item B<-T>
1516
1517Send a thank-you note instead of a bug report.
1518
d121ca8c
CS
1519=item B<-v>
1520
1521Include verbose configuration data in the report.
1522
1523=back
1524
1525=head1 AUTHORS
1526
54c90be1
J
1527Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
1528I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
1529Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
1530(E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
1531Mike Guy (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop
1532(E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.org<gt>),
50d3c28b
GS
1533Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1534(E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
2402d92a 1535Richard Foley (E<lt>richard.foley@rfi.netE<gt>), and Jesse Vincent
54c90be1 1536(E<lt>jesse@bestpractical.com<gt>).
d121ca8c
CS
1537
1538=head1 SEE ALSO
1539
bdcdfa19
JH
1540perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1541diff(1), patch(1), dbx(1), gdb(1)
d121ca8c
CS
1542
1543=head1 BUGS
1544
1545None known (guess what must have been used to report them?)
1546
1547=cut
1548
37fa004c
PP
1549!NO!SUBS!
1550
1551close OUT or die "Can't close $file: $!";
1552chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1553exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 1554chdir $origdir;