This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlbug did not previously generate a From: header. While some MTAs do
[perl5.git] / utils / perlbug.PL
CommitLineData
37fa004c 1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
8a5546a1 5use Cwd;
1948c06a 6use File::Spec::Functions;
37fa004c 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 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 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 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 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 77my \$patch_tags = '$patch_tags';
78my \@patches = (
55d729e4 79 $patch_desc
fb73857a 80);
37fa004c 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 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 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 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 121# Changed in 1.13 to hopefully make it more difficult to accidentally
122# send mail
ab3ef367 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 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 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 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 293
e4ef3332 294 # Users address, used in message and in From and Reply-To headers
55d729e4
GS
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 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
e6eb9020 459 unless ($::opt_r) {
55d729e4
GS
460 # Try and guess return address
461 my $guess;
462
e6eb9020
DM
463 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'}
464 || $from || '';
1948c06a
CN
465 if ($Is_MacOS) {
466 require Mac::InternetConfig;
467 $guess = $Mac::InternetConfig::InternetConfig{
468 Mac::InternetConfig::kICEmail()
469 };
470 }
471
55d729e4 472 unless ($guess) {
de94c9df
RF
473 # move $domain to where we can use it elsewhere
474 if ($domain) {
55d729e4
GS
475 if ($Is_VMS && !$::Config{'d_socket'}) {
476 $guess = "$domain\:\:$me";
41f926b8 477 } else {
55d729e4 478 $guess = "$me\@$domain" if $domain;
c07a80fd 479 }
55d729e4
GS
480 }
481 }
37fa004c 482
55d729e4
GS
483 if ($guess) {
484 unless ($ok) {
485 paraprint <<EOF;
54c90be1
J
486Perl's developers may need your email address to contact you for
487further information about your issue or to inform you when it is
488resolved. If the default shown is not your email address, please
489correct it.
37fa004c 490EOF
55d729e4
GS
491 }
492 } else {
493 paraprint <<EOF;
54c90be1
J
494Please enter your full internet email address so that Perl's
495developers can contact you with questions about your issue or to
496inform you that it has been resolved.
37fa004c 497EOF
37fa004c 498 }
37fa004c 499
55d729e4
GS
500 if ($ok && $guess) {
501 # use it
502 $from = $guess;
503 } else {
504 # verify it
54c90be1 505 $from = _prompt('','Your address',$guess);
55d729e4
GS
506 $from = $guess if $from eq '';
507 }
508 }
37fa004c 509
55d729e4
GS
510 if ($from eq $cc or $me eq $cc) {
511 # Try not to copy ourselves
512 $cc = "yourself";
513 }
37fa004c 514
55d729e4
GS
515 # Prompt for administrator address, unless an override was given
516 if( !$::opt_C and !$::opt_c ) {
54c90be1
J
517 my $description = <<EOF;
518$0 can send a copy of this report to your local perl
519administrator. If the address below is wrong, please correct it,
520or enter 'none' or 'yourself' to not send a copy.
37fa004c 521EOF
54c90be1 522 my $entry = _prompt($description, "Local perl administrator", $cc);
37fa004c 523
55d729e4
GS
524 if ($entry ne "") {
525 $cc = $entry;
526 $cc = '' if $me eq $cc;
37fa004c 527 }
55d729e4 528 }
37fa004c 529
55d729e4 530 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
54c90be1
J
531 if ($cc) {
532 $andcc = " and $cc"
533 } else {
534 $andcc = ''
535 }
37fa004c 536
55d729e4 537 # Prompt for editor, if no override is given
ab3ef367 538editor:
55d729e4 539 unless ($::opt_e || $::opt_f || $::opt_b) {
26ab4e07 540
54c90be1 541 my $description;
26ab4e07 542
54c90be1
J
543 chomp (my $common_end = <<"EOF");
544You will probably want to use a text editor to enter the body of
545your report. If "$ed" is the editor you want to use, then just press
546Enter, otherwise type in the name of the editor you would like to
547use.
548
549If you have already composed the body of your report, you may enter
550"file", and $0 will prompt you to enter the name of the file
551containing your report.
721e2275
NC
552EOF
553
554 if ($thanks) {
54c90be1
J
555 $description = <<"EOF";
556It's now time to compose your thank-you message.
721e2275 557
54c90be1
J
558Some information about your local perl configuration will automatically
559be included at the end of your message, because we're curious about
560the different ways that people build and use perl. If you'd rather
561not share this information, you're welcome to delete it.
721e2275
NC
562
563$common_end
564EOF
565 } else {
54c90be1
J
566 $description = <<"EOF";
567It's now time to compose your bug report. Try to make the report
568concise but descriptive. Please include any detail which you think
569might be relevant or might help the volunteers working to improve
570perl. If you are reporting something that does not work as you think
571it should, please try to include examples of the actual result and of
572what you expected.
573
574Some information about your local perl configuration will automatically
575be included at the end of your report. If you are using an unusual
576version of perl, it would be useful if you could confirm that you
577can replicate the problem on a standard build of perl as well.
37fa004c 578
721e2275 579$common_end
37fa004c 580EOF
721e2275
NC
581 }
582
54c90be1 583 my $entry = _prompt($description, "Editor", $ed);
55d729e4
GS
584 $usefile = 0;
585 if ($entry eq "file") {
586 $usefile = 1;
587 } elsif ($entry ne "") {
588 $ed = $entry;
37fa004c 589 }
55d729e4 590 }
721e2275 591 if ($::HaveCoreList && !$ok && !$thanks) {
54c90be1
J
592 my $description = <<EOF;
593If your bug is about a Perl module rather than a core language
594feature, please enter its name here. If it's not, just hit Enter
595to skip this question.
13f4c5e4 596EOF
54c90be1
J
597
598 my $entry = '';
599 while ($entry eq '') {
600 $entry = _prompt($description, 'Module');
13f4c5e4 601 my $first_release = Module::CoreList->first_release($entry);
54c90be1 602 if ($entry and not $first_release) {
13f4c5e4 603 paraprint <<EOF;
54c90be1
J
604$entry is not a "core" Perl module. Please check that you entered
605its name correctly. If it is correct, quit this program, try searching
606for $entry on http://rt.cpan.org, and report your issue there.
13f4c5e4 607EOF
54c90be1
J
608
609 $entry = '';
0accdd48
NC
610 } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
611 paraprint <<"EOF";
612$entry included with core Perl is copied directly from the CPAN distribution.
613Please report bugs in $entry directly to its maintainers using $bug_tracker
614EOF
615 $entry = '';
54c90be1
J
616 } elsif ($entry) {
617 $category ||= 'library';
618 $report_about_module = $entry;
619 last;
620 } else {
621 last;
622 }
13f4c5e4
AC
623 }
624 }
37fa004c 625
50d3c28b 626 # Prompt for category of bug
975b416b 627 $category ||= ask_for_alternatives('category');
50d3c28b
GS
628
629 # Prompt for severity of bug
975b416b 630 $severity ||= ask_for_alternatives('severity');
50d3c28b 631
55d729e4
GS
632 # Generate scratch file to edit report in
633 $filename = filename();
37fa004c 634
55d729e4
GS
635 # Prompt for file to read report from, if needed
636 if ($usefile and !$file) {
ab3ef367 637filename:
54c90be1 638 my $description = <<EOF;
37fa004c 639What is the name of the file that contains your report?
37fa004c 640EOF
54c90be1 641 my $entry = _prompt($description, "Filename");
37fa004c 642
55d729e4
GS
643 if ($entry eq "") {
644 paraprint <<EOF;
54c90be1
J
645It seems you didn't enter a filename. Please choose to use a text
646editor or enter a filename.
ab3ef367 647EOF
55d729e4
GS
648 goto editor;
649 }
650
651 unless (-f $entry and -r $entry) {
652 paraprint <<EOF;
54c90be1
J
653'$entry' doesn't seem to be a readable file. You may have mistyped
654its name or may not have permission to read it.
655
656If you don't want to use a file as the content of your report, just
657hit Enter and you'll be able to select a text editor instead.
ab3ef367 658EOF
55d729e4 659 goto filename;
37fa004c 660 }
55d729e4
GS
661 $file = $entry;
662 }
37fa004c 663
55d729e4 664 # Generate report
c9967ac8 665 open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
721e2275
NC
666 my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
667 : $::opt_n ? "build failure" : "success";
37fa004c 668
55d729e4 669 print REP <<EOF;
84902520 670This is a $reptype report for perl from $from,
1ec03f31 671generated with the help of perlbug $Version running under perl $perl_version.
37fa004c 672
673EOF
674
55d729e4
GS
675 if ($body) {
676 print REP $body;
677 } elsif ($usefile) {
678 open(F, "<$file")
c9967ac8 679 or die "Unable to read report file from '$file': $!\n";
55d729e4
GS
680 while (<F>) {
681 print REP $_
682 }
c9967ac8 683 close(F) or die "Error closing '$file': $!";
55d729e4 684 } else {
721e2275
NC
685 if ($thanks) {
686 print REP <<'EOF';
687
688-----------------------------------------------------------------
54c90be1 689[Please enter your thank-you message here]
721e2275
NC
690
691
692
54c90be1 693[You're welcome to delete anything below this line]
721e2275
NC
694-----------------------------------------------------------------
695EOF
696 } else {
697 print REP <<'EOF';
774d564b 698
699-----------------------------------------------------------------
54c90be1 700[Please describe your issue here]
774d564b 701
702
703
704[Please do not change anything below this line]
705-----------------------------------------------------------------
706EOF
721e2275 707 }
55d729e4
GS
708 }
709 Dump(*REP);
c0a6bf09 710 close(REP) or die "Error closing report file: $!";
55d729e4 711
54c90be1
J
712 # Set up an initial report fingerprint so we can compare it later
713 _fingerprint_lines_in_report();
714
55d729e4 715} # sub Query
c07a80fd 716
717sub Dump {
55d729e4 718 local(*OUT) = @_;
37fa004c 719
4ea8010a
DM
720 # these won't have been set if run with -d
721 $category ||= 'core';
722 $severity ||= 'low';
723
50d3c28b
GS
724 print OUT <<EFF;
725---
726Flags:
727 category=$category
728 severity=$severity
890b8eb0 729EFF
54c90be1
J
730
731 if ($report_about_module ) {
732 print OUT <<EFF;
733 module=$report_about_module
734EFF
735 }
890b8eb0
NC
736 if ($::opt_A) {
737 print OUT <<EFF;
738 ack=no
739EFF
740 }
741 print OUT <<EFF;
50d3c28b
GS
742---
743EFF
744 print OUT "This perlbug was built using Perl $config_tag1\n",
1ec03f31 745 "It is being executed now by Perl $config_tag2.\n\n"
55d729e4 746 if $config_tag2 ne $config_tag1;
fb73857a 747
55d729e4 748 print OUT <<EOF;
1ec03f31 749Site configuration information for perl $perl_version:
37fa004c 750
751EOF
55d729e4
GS
752 if ($::Config{cf_by} and $::Config{cf_time}) {
753 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
754 }
755 print OUT Config::myconfig;
37fa004c 756
55d729e4
GS
757 if (@patches) {
758 print OUT join "\n ", "Locally applied patches:", @patches;
759 print OUT "\n";
760 };
84902520 761
55d729e4 762 print OUT <<EOF;
8ecf1a0c 763
774d564b 764---
1ec03f31 765\@INC for perl $perl_version:
774d564b 766EOF
55d729e4
GS
767 for my $i (@INC) {
768 print OUT " $i\n";
769 }
774d564b 770
55d729e4 771 print OUT <<EOF;
8ecf1a0c 772
774d564b 773---
1ec03f31 774Environment for perl $perl_version:
8ecf1a0c 775EOF
5cf1d1f1
JH
776 my @env =
777 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
778 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
27414c22 779 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
8876aa85
JH
780 my %env;
781 @env{@env} = @env;
782 for my $env (sort keys %env) {
55d729e4
GS
783 print OUT " $env",
784 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
785 "\n";
786 }
787 if ($verbose) {
1ec03f31 788 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
55d729e4
GS
789 my $value;
790 foreach (sort keys %::Config) {
791 $value = $::Config{$_};
4ea8010a 792 $value = '' unless defined $value;
55d729e4
GS
793 $value =~ s/'/\\'/g;
794 print OUT "$_='$value'\n";
84902520 795 }
55d729e4
GS
796 }
797} # sub Dump
37fa004c 798
799sub Edit {
55d729e4
GS
800 # Edit the report
801 if ($usefile || $body) {
54c90be1
J
802 my $description = "Please make sure that the name of the editor you want to use is correct.";
803 my $entry = _prompt($description, 'Editor', $ed);
55d729e4
GS
804 $ed = $entry unless $entry eq '';
805 }
a5f75d66 806
54c90be1
J
807 _edit_file($ed);
808}
809
810sub _edit_file {
811 my $editor = shift;
812
813 my $report_written = 0;
814
815 while ( !$report_written ) {
816 if ($Is_MacOS) {
817 require ExtUtils::MakeMaker;
818 ExtUtils::MM_MacOS::launch_file($filename);
819 _prompt('', "Press Enter when done." );
820 } else { # we're not on oldschool mac os
821 my $exit_status = system("$editor $filename");
822 if ($exit_status) {
823 my $desc = <<EOF;
824The editor you chose ('$editor') could not be run!
825
826If you mistyped its name, please enter it now, otherwise just press Enter.
1948c06a 827EOF
54c90be1
J
828 my $entry = _prompt( $desc, 'Editor', $editor );
829 if ( $entry ne "" ) {
830 $editor = $entry;
831 next;
832 } else {
833 paraprint <<EOF;
834You may want to save your report to a file, so you can edit and
835mail it later.
a5f75d66 836EOF
54c90be1
J
837 return;
838 }
839 }
840 }
841 return if ( $ok and not $::opt_n ) || $body;
a5f75d66 842
54c90be1 843 # Check that we have a report that has some, eh, report in it.
774d564b 844
54c90be1
J
845 unless ( _fingerprint_lines_in_report() ) {
846 my $description = <<EOF;
847It looks like you didn't enter a report. You may [r]etry your edit
848or [c]ancel this report.
849EOF
850 my $action = _prompt( $description, "Action (Retry/Cancel) " );
851 if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
852 next;
853 } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
854 Cancel(); # cancel exits
855 }
856 }
857 # Ok. the user did what they needed to;
858 return;
55d729e4 859
55d729e4 860 }
54c90be1 861}
774d564b 862
774d564b 863
864sub Cancel {
865 1 while unlink($filename); # remove all versions under VMS
54c90be1 866 print "\nQuitting without sending your message.\n";
774d564b 867 exit(0);
37fa004c 868}
869
870sub NowWhat {
55d729e4
GS
871 # Report is done, prompt for further action
872 if( !$::opt_S ) {
873 while(1) {
54c90be1
J
874 my $menu = <<EOF;
875
876
877You have finished composing your message. At this point, you have
878a few options. You can:
879
6821e383 880 * [Se]nd the message to $address$andcc,
54c90be1
J
881 * [D]isplay the message on the screen,
882 * [R]e-edit the message
883 * Display or change the message's [su]bject
884 * Save the message to a [f]ile to mail at another time
885 * [Q]uit without sending a message
886
37fa004c 887EOF
8b49bb9a 888 retry:
54c90be1
J
889 print $menu;
890 my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
891 print "\n";
55d729e4 892 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
54c90be1 893 if ( SaveMessage() ) { exit }
55d729e4
GS
894 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
895 # Display the message
c9967ac8 896 open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
55d729e4 897 while (<REP>) { print $_ }
c9967ac8 898 close(REP) or die "Error closing report file '$filename': $!";
2e7f46bf 899 } elsif ($action =~ /^su/i) { # <Su>bject
54c90be1 900 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
2e7f46bf
JH
901 if ($reply ne '') {
902 unless (TrivialSubject($reply)) {
903 $subject = $reply;
904 print "Subject: $subject\n";
905 }
906 }
55d729e4
GS
907 } elsif ($action =~ /^se/i) { # <S>end
908 # Send the message
54c90be1
J
909 my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
910 if ($reply =~ /^yes$/) {
55d729e4
GS
911 last;
912 } else {
913 paraprint <<EOF;
54c90be1 914You didn't type "yes", so your message has not yet been sent.
ab3ef367 915EOF
55d729e4
GS
916 }
917 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
918 # edit the message
919 Edit();
920 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
921 Cancel();
01544859 922 } elsif ($action =~ /^s/i) {
55d729e4 923 paraprint <<EOF;
54c90be1 924The command you entered was ambiguous. Please type "send", "save" or "subject".
84478119 925EOF
55d729e4 926 }
37fa004c 927 }
55d729e4
GS
928 }
929} # sub NowWhat
37fa004c 930
2e7f46bf
JH
931sub TrivialSubject {
932 my $subject = shift;
933 if ($subject =~
934 /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
935 length($subject) < 4 ||
936 $subject !~ /\s/) {
54c90be1 937 print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
2e7f46bf
JH
938 return 1;
939 } else {
940 return 0;
941 }
942}
943
54c90be1
J
944sub SaveMessage {
945 my $file_save = $outfile || "$progname.rep";
946 my $file = _prompt( '', "Name of file to save message in", $file_save );
947 save_message_to_disk($file) || return undef;
948 print "\n";
949 paraprint <<EOF;
950A copy of your message has been saved in '$file' for you to
951send to '$address' with your normal mail client.
952EOF
953}
954
37fa004c 955sub Send {
54c90be1 956
55d729e4 957 # Message has been accepted for transmission -- Send the message
afc5e478 958
54c90be1 959 # on linux certain "mail" implementations won't accept the subject
afc5e478
SB
960 # as "~s subject" and thus the Subject header will be corrupted
961 # so don't use Mail::Send to be safe
54c90be1
J
962 eval {
963 if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
964 _send_message_mailsend();
965 } elsif ($Is_VMS) {
966 _send_message_vms();
967 } else {
968 _send_message_sendmail();
969 }
970 };
37fa004c 971
54c90be1
J
972 if ( my $error = $@ ) {
973 paraprint <<EOF;
974$0 has detected an error while trying to send your message: $error.
c07a80fd 975
54c90be1 976Your message may not have been sent. You will now have a chance to save a copy to disk.
c07a80fd 977EOF
54c90be1
J
978 SaveMessage();
979 return;
55d729e4 980 }
54c90be1
J
981
982 1 while unlink($filename); # remove all versions under VMS
983} # sub Send
37fa004c 984
985sub Help {
55d729e4 986 print <<EOF;
37fa004c 987
54c90be1
J
988This program is designed to help you generate and send bug reports
989(and thank-you notes) about perl5 and the modules which ship with it.
990
991In most cases, you can just run "$0" interactively from a command
992line without any special arguments and follow the prompts.
993
994Advanced usage:
55d729e4 995
105f9295 996$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
d121ca8c 997 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
890b8eb0 998$0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
55d729e4 999
37fa004c 1000
1001Options:
1002
1003 -v Include Verbose configuration data in the report
55d729e4 1004 -f File containing the body of the report. Use this to
37fa004c 1005 quickly send a prepared message.
1948c06a 1006 -F File to output the resulting mail message to, instead of mailing.
37fa004c 1007 -S Send without asking for confirmation.
c9967ac8
NC
1008 -a Address to send the report to. Defaults to '$address'.
1009 -c Address to send copy of report to. Defaults to '$cc'.
37fa004c 1010 -C Don't send copy to administrator.
55d729e4 1011 -s Subject to include with the message. You will be prompted
37fa004c 1012 if you don't supply one on the command line.
1013 -b Body of the report. If not included on the command line, or
1014 in a file with -f, you will get a chance to edit the message.
1015 -r Your return address. The program will ask you to confirm
1016 this if you don't give it here.
55d729e4 1017 -e Editor to use.
c9967ac8
NC
1018 -t Test mode. The target address defaults to '$testaddress'.
1019 -T Thank-you mode. The target address defaults to '$thanksaddress'.
489b74f8 1020 -d Data mode. This prints out your configuration data, without mailing
c07a80fd 1021 anything. You can use this with -v to get more complete data.
890b8eb0 1022 -A Don't send a bug received acknowledgement to the return address.
84902520 1023 -ok Report successful build on this system to perl porters
55d729e4
GS
1024 (use alone or with -v). Only use -ok if *everything* was ok:
1025 if there were *any* problems at all, use -nok.
fb73857a 1026 -okay As -ok but allow report from old builds.
55d729e4
GS
1027 -nok Report unsuccessful build on this system to perl porters
1028 (use alone or with -v). You must describe what went wrong
1029 in the body of the report which you will be asked to edit.
1030 -nokay As -nok but allow report from old builds.
1031 -h Print this help message.
1032
37fa004c 1033EOF
1034}
1035
55d729e4 1036sub filename {
003a92ef
NC
1037 if ($::HaveTemp) {
1038 # Good. Use a secure temp file
1039 my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
1040 close($fh);
1041 return $filename;
1042 } else {
1043 # Bah. Fall back to doing things less securely.
1044 my $dir = File::Spec->tmpdir();
1045 $filename = "bugrep0$$";
1046 $filename++ while -e File::Spec->catfile($dir, $filename);
1047 $filename = File::Spec->catfile($dir, $filename);
1048 }
55d729e4
GS
1049}
1050
37fa004c 1051sub paraprint {
1052 my @paragraphs = split /\n{2,}/, "@_";
37fa004c 1053 for (@paragraphs) { # implicit local $_
55d729e4
GS
1054 s/(\S)\s*\n/$1 /g;
1055 write;
1056 print "\n";
37fa004c 1057 }
37fa004c 1058}
37fa004c 1059
54c90be1
J
1060sub _prompt {
1061 my ($explanation, $prompt, $default) = (@_);
1062 if ($explanation) {
1063 print "\n\n";
1064 paraprint $explanation;
1065 }
1066 print $prompt. ($default ? " [$default]" :''). ": ";
1067 my $result = scalar(<>);
1068 chomp($result);
1069 $result =~ s/^\s*(.*?)\s*$/$1/s;
1070 if ($default && $result eq '') {
1071 return $default;
1072 } else {
1073 return $result;
1074 }
1075}
1076
1077sub _build_header {
1078 my %attr = (@_);
1079
1080 my $head = '';
1081 for my $header (keys %attr) {
1082 $head .= "$header: ".$attr{$header}."\n";
1083 }
1084 return $head;
1085}
1086
1087sub _message_headers {
1088 my %headers = ( To => $address, Subject => $subject );
1089 $headers{'Cc'} = $cc if ($cc);
1090 $headers{'Message-Id'} = $messageid if ($messageid);
1091 $headers{'Reply-To'} = $from if ($from);
e4ef3332 1092 $headers{'From'} = $from if ($from);
54c90be1
J
1093 return \%headers;
1094}
1095
1096sub build_complete_message {
1097 my $content = _build_header(%{_message_headers()}) . "\n\n";
1098 open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
1099 while (<REP>) { $content .= $_; }
1100 close(REP) or die "Error closing report file '$filename': $!";
1101 return $content;
1102}
1103
1104sub save_message_to_disk {
1105 my $file = shift;
1106
1107 open OUTFILE, ">$file" or do { warn "Couldn't open '$file': $!\n"; return undef};
1108 print OUTFILE build_complete_message();
1109 close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
1110 print "\nMessage saved.\n";
1111 return 1;
1112}
1113
1114sub _send_message_vms {
1115 if ( ( $address =~ /@/ and $address !~ /^\w+%"/ )
1116 or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
1117 my $prefix;
1118 foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
1119 $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
1120 }
1121 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
1122 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
1123 }
1124 $subject =~ s/"/""/g;
1125 $address =~ s/"/""/g;
1126 $cc =~ s/"/""/g;
1127 my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
1128 if ($sts) {
1129 die "Can't spawn off mail (leaving bug report in $filename): $sts";
1130 }
1131}
1132
1133sub _send_message_mailsend {
1134 my $msg = Mail::Send->new();
1135 my %headers = %{_message_headers()};
1136 for my $key ( keys %headers) {
1137 $msg->add($key => $headers{$key});
1138 }
1139
1140 $fh = $msg->open;
1141 open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
1142 while (<REP>) { print $fh $_ }
1143 close(REP) or die "Error closing $filename: $!";
e90b02b9 1144 $fh->close or die "Error sending mail: $!";
54c90be1
J
1145
1146 print "\nMessage sent.\n";
1147}
1148
1149sub _probe_for_sendmail {
1150 my $sendmail = "";
1151 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1152 $sendmail = $_, last if -e $_;
1153 }
1154 if ( $^O eq 'os2' and $sendmail eq "" ) {
1155 my $path = $ENV{PATH};
1156 $path =~ s:\\:/:;
1157 my @path = split /$Config{'path_sep'}/, $path;
1158 for (@path) {
1159 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
1160 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1161 }
1162 }
1163 return $sendmail;
1164}
1165
1166sub _send_message_sendmail {
1167 my $sendmail = _probe_for_sendmail();
1168 unless ($sendmail) {
e90d6148 1169 my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
54c90be1
J
1170It appears that there is no program which looks like "sendmail" on
1171your system and that the Mail::Send library from CPAN isn't available.
e90d6148
A
1172EOT
1173It appears that there is no program which looks like "sendmail" on
1174your system.
1175EOT
1176 paraprint(<<"EOF"), die "\n";
1177$message_start
54c90be1
J
1178Because of this, there's no easy way to automatically send your
1179message.
1180
1181A copy of your message has been saved in '$filename' for you to
1182send to '$address' with your normal mail client.
1183EOF
1184 }
1185
1186 open( SENDMAIL, "|$sendmail -t -oi" )
1187 || die "'|$sendmail -t -oi' failed: $!";
1188 print SENDMAIL build_complete_message();
1189 if ( close(SENDMAIL) ) {
1190 print "\nMessage sent\n";
1191 } else {
1192 warn "\nSendmail returned status '", $? >> 8, "'\n";
1193 }
1194}
1195
1196
1197
1198# a strange way to check whether any significant editing
1199# has been done: check whether any new non-empty lines
1200# have been added.
1201
1202sub _fingerprint_lines_in_report {
1203 my $new_lines = 0;
1204 # read in the report template once so that
1205 # we can track whether the user does any editing.
1206 # yes, *all* whitespace is ignored.
1207
1208 open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
1209 while (my $line = <REP>) {
1210 $line =~ s/\s+//g;
1211 $new_lines++ if (!$REP{$line});
1212
1213 }
1214 close(REP) or die "Error closing report file '$filename': $!";
1215 # returns the number of lines with content that wasn't there when last we looked
1216 return $new_lines;
1217}
1218
1219
1220
37fa004c 1221format STDOUT =
1222^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1223$_
1224.
d121ca8c
CS
1225
1226__END__
1227
1228=head1 NAME
1229
1230perlbug - how to submit bug reports on Perl
1231
1232=head1 SYNOPSIS
1233
54c90be1
J
1234B<perlbug>
1235
d121ca8c 1236B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
105f9295
HS
1237S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1238S<[ B<-r> I<returnaddress> ]>
d121ca8c 1239S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
985dc10a 1240S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]>
d121ca8c 1241
55d729e4 1242B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
890b8eb0 1243 S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1b0e3b9e 1244
985dc10a
SP
1245B<perlthanks>
1246
d121ca8c
CS
1247=head1 DESCRIPTION
1248
d121ca8c 1249
54c90be1
J
1250This program is designed to help you generate and send bug reports
1251(and thank-you notes) about perl5 and the modules which ship with it.
1252
1253In most cases, you can just run it interactively from a command
1254line without any special arguments and follow the prompts.
1255
1256If you have found a bug with a non-standard port (one that was not
1257part of the I<standard distribution>), a binary distribution, or a
1258non-core module (such as Tk, DBI, etc), then please see the
1259documentation that came with that distribution to determine the
1260correct place to report bugs.
d121ca8c 1261
54c90be1
J
1262If you are unable to send your report using B<perlbug> (most likely
1263because your system doesn't have a way to send mail that perlbug
1264recognizes), you may be able to use this tool to compose your report
1265and save it to a file which you can then send to B<perlbug@perl.org>
1266using your regular mail client.
d121ca8c 1267
54c90be1
J
1268In extreme cases, B<perlbug> may not work well enough on your system
1269to guide you through composing a bug report. In those cases, you
1270may be able to use B<perlbug -d> to get system configuration
1271information to include in a manually composed bug report to
1272B<perlbug@perl.org>.
d121ca8c 1273
54c90be1
J
1274
1275When reporting a bug, please run through this checklist:
d121ca8c
CS
1276
1277=over 4
1278
884baa66 1279=item What version of Perl you are running?
d121ca8c
CS
1280
1281Type C<perl -v> at the command line to find out.
1282
1283=item Are you running the latest released version of perl?
1284
54c90be1
J
1285Look at http://www.perl.org/ to find out. If you are not using the
1286latest released version, please try to replicate your bug on the
1287latest stable release.
1288
1289Note that reports about bugs in old versions of Perl, especially
1290those which indicate you haven't also tested the current stable
1291release of Perl, are likely to receive less attention from the
1292volunteers who build and maintain Perl than reports about bugs in
1293the current release.
1294
1295This tool isn't apropriate for reporting bugs in any version
1296prior to Perl 5.0.
d121ca8c
CS
1297
1298=item Are you sure what you have is a bug?
1299
54c90be1
J
1300A significant number of the bug reports we get turn out to be
1301documented features in Perl. Make sure the issue you've run into
1302isn't intentional by glancing through the documentation that comes
1303with the Perl distribution.
d121ca8c 1304
54c90be1
J
1305Given the sheer volume of Perl documentation, this isn't a trivial
1306undertaking, but if you can point to documentation that suggests
1307the behaviour you're seeing is I<wrong>, your issue is likely to
1308receive more attention. You may want to start with B<perldoc>
1309L<perltrap> for pointers to common traps that new (and experienced)
1310Perl programmers run into.
d121ca8c 1311
54c90be1
J
1312If you're unsure of the meaning of an error message you've run
1313across, B<perldoc> L<perldiag> for an explanation. If the message
1314isn't in perldiag, it probably isn't generated by Perl. You may
1315have luck consulting your operating system documentation instead.
bdcdfa19 1316
54c90be1 1317If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1948c06a 1318features may be unimplemented or work differently.
bdcdfa19 1319
54c90be1
J
1320You may be able to figure out what's going wrong using the Perl
1321debugger. For information about how to use the debugger B<perldoc>
1322L<perldebug>.
d121ca8c
CS
1323
1324=item Do you have a proper test case?
1325
1326The easier it is to reproduce your bug, the more likely it will be
985dc10a 1327fixed -- if nobody can duplicate your problem, it probably won't be
54c90be1
J
1328addressed.
1329
1330A good test case has most of these attributes: short, simple code;
1331few dependencies on external commands, modules, or libraries; no
1332platform-dependent code (unless it's a platform-specific bug);
1333clear, simple documentation.
1334
1335A good test case is almost always a good candidate to be included in
1336Perl's test suite. If you have the time, consider writing your test case so
1337that it can be easily included into the standard test suite.
d121ca8c 1338
54c90be1 1339=item Have you included all relevant information?
d121ca8c 1340
54c90be1
J
1341Be sure to include the B<exact> error messages, if any.
1342"Perl gave an error" is not an exact error message.
bdcdfa19
JH
1343
1344If you get a core dump (or equivalent), you may use a debugger
1345(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
54c90be1
J
1346report.
1347
1348NOTE: unless your Perl has been compiled with debug info
bdcdfa19 1349(often B<-g>), the stack trace is likely to be somewhat hard to use
884baa66 1350because it will most probably contain only the function names and not
bdcdfa19 1351their arguments. If possible, recompile your Perl with debug info and
54c90be1 1352reproduce the crash and the stack trace.
bdcdfa19 1353
d121ca8c
CS
1354=item Can you describe the bug in plain English?
1355
54c90be1
J
1356The easier it is to understand a reproducible bug, the more likely
1357it will be fixed. Any insight you can provide into the problem
1358will help a great deal. In other words, try to analyze the problem
1359(to the extent you can) and report your discoveries.
d121ca8c
CS
1360
1361=item Can you fix the bug yourself?
1362
1363A bug report which I<includes a patch to fix it> will almost
54c90be1
J
1364definitely be fixed. When sending a patch, please use the C<diff>
1365program with the C<-u> option to generate "unified" diff files.
1366Bug reports with patches are likely to receive significantly more
1367attention and interest than those without patches.
1368
1369Your patch may be returned with requests for changes, or requests for more
d121ca8c
CS
1370detailed explanations about your fix.
1371
54c90be1
J
1372Here are a few hints for creating high-quality patches:
1373
1374Make sure the patch is not reversed (the first argument to diff is
1375typically the original file, the second argument your changed file).
1376Make sure you test your patch by applying it with the C<patch>
1377program before you send it on its way. Try to follow the same style
1378as the code you are trying to patch. Make sure your patch really
1379does work (C<make test>, if the thing you're patching is covered
1380by Perl's test suite).
d121ca8c
CS
1381
1382=item Can you use C<perlbug> to submit the report?
1383
1384B<perlbug> will, amongst other things, ensure your report includes
54c90be1
J
1385crucial information about your version of perl. If C<perlbug> is
1386unable to mail your report after you have typed it in, you may have
1387to compose the message yourself, add the output produced by C<perlbug
1388-d> and email it to B<perlbug@perl.org>. If, for some reason, you
1389cannot run C<perlbug> at all on your system, be sure to include the
1390entire output produced by running C<perl -V> (note the uppercase V).
d121ca8c 1391
bdcdfa19 1392Whether you use C<perlbug> or send the email manually, please make
54c90be1
J
1393your Subject line informative. "a bug" is not informative. Neither
1394is "perl crashes" nor is "HELP!!!". These don't help. A compact
1395description of what's wrong is fine.
bdcdfa19 1396
985dc10a
SP
1397=item Can you use C<perlbug> to submit a thank-you note?
1398
1399Yes, you can do this by either using the C<-T> option, or by invoking
1400the program as C<perlthanks>. Thank-you notes are good. It makes people
1401smile.
1402
d121ca8c
CS
1403=back
1404
54c90be1
J
1405Having done your bit, please be prepared to wait, to be told the
1406bug is in your code, or possibly to get no reply at all. The
1407volunteers who maintain Perl are busy folks, so if your problem is
1408an obvious bug in your own code, is difficult to understand or is
1409a duplicate of an existing report, you may not receive a personal
1410reply.
1411
26ab4e07 1412If it is important to you that your bug be fixed, do monitor the
54c90be1
J
1413perl5-porters@perl.org mailing list and the commit logs to development
1414versions of Perl, and encourage the maintainers with kind words or
1415offers of frosty beverages. (Please do be kind to the maintainers.
1416Harassing or flaming them is likely to have the opposite effect of
1417the one you want.)
1418
1419Feel free to update the ticket about your bug on http://rt.perl.org
1420if a new version of Perl is released and your bug is still present.
d121ca8c
CS
1421
1422=head1 OPTIONS
1423
1424=over 8
1425
1426=item B<-a>
1427
3e79b69b 1428Address to send the report to. Defaults to B<perlbug@perl.org>.
d121ca8c 1429
890b8eb0
NC
1430=item B<-A>
1431
1432Don't send a bug received acknowledgement to the reply address.
1433Generally it is only a sensible to use this option if you are a
1434perl maintainer actively watching perl porters for your message to
1435arrive.
1436
d121ca8c
CS
1437=item B<-b>
1438
1439Body of the report. If not included on the command line, or
1440in a file with B<-f>, you will get a chance to edit the message.
1441
1442=item B<-C>
1443
1444Don't send copy to administrator.
1445
1446=item B<-c>
1447
1448Address to send copy of report to. Defaults to the address of the
1449local perl administrator (recorded when perl was built).
1450
1451=item B<-d>
1452
1453Data mode (the default if you redirect or pipe output). This prints out
1454your configuration data, without mailing anything. You can use this
1455with B<-v> to get more complete data.
1456
1457=item B<-e>
1458
55d729e4 1459Editor to use.
d121ca8c
CS
1460
1461=item B<-f>
1462
1463File containing the body of the report. Use this to quickly send a
1464prepared message.
1465
105f9295
HS
1466=item B<-F>
1467
1468File to output the results to instead of sending as an email. Useful
1469particularly when running perlbug on a machine with no direct internet
1470connection.
1471
d121ca8c
CS
1472=item B<-h>
1473
1474Prints a brief summary of the options.
1475
1b0e3b9e
CR
1476=item B<-ok>
1477
84902520
TB
1478Report successful build on this system to perl porters. Forces B<-S>
1479and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1b0e3b9e 1480prompts for a return address if it cannot guess it (for use with
84902520
TB
1481B<make>). Honors return address specified with B<-r>. You can use this
1482with B<-v> to get more complete data. Only makes a report if this
1483system is less than 60 days old.
1484
1485=item B<-okay>
1486
1487As B<-ok> except it will report on older systems.
1b0e3b9e 1488
55d729e4
GS
1489=item B<-nok>
1490
1491Report unsuccessful build on this system. Forces B<-C>. Forces and
1492supplies a value for B<-s>, then requires you to edit the report
1493and say what went wrong. Alternatively, a prepared report may be
1494supplied using B<-f>. Only prompts for a return address if it
1495cannot guess it (for use with B<make>). Honors return address
1496specified with B<-r>. You can use this with B<-v> to get more
1497complete data. Only makes a report if this system is less than 60
1498days old.
1499
1500=item B<-nokay>
1501
1502As B<-nok> except it will report on older systems.
1503
d121ca8c
CS
1504=item B<-r>
1505
1506Your return address. The program will ask you to confirm its default
1507if you don't use this option.
1508
1509=item B<-S>
1510
1511Send without asking for confirmation.
1512
1513=item B<-s>
1514
1515Subject to include with the message. You will be prompted if you don't
1516supply one on the command line.
1517
1518=item B<-t>
1519
3e79b69b 1520Test mode. The target address defaults to B<perlbug-test@perl.org>.
d121ca8c 1521
985dc10a
SP
1522=item B<-T>
1523
1524Send a thank-you note instead of a bug report.
1525
d121ca8c
CS
1526=item B<-v>
1527
1528Include verbose configuration data in the report.
1529
1530=back
1531
1532=head1 AUTHORS
1533
54c90be1
J
1534Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
1535I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
1536Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
1537(E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
1538Mike Guy (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop
1539(E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.org<gt>),
50d3c28b
GS
1540Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1541(E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
2402d92a 1542Richard Foley (E<lt>richard.foley@rfi.netE<gt>), and Jesse Vincent
54c90be1 1543(E<lt>jesse@bestpractical.com<gt>).
d121ca8c
CS
1544
1545=head1 SEE ALSO
1546
bdcdfa19
JH
1547perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1548diff(1), patch(1), dbx(1), gdb(1)
d121ca8c
CS
1549
1550=head1 BUGS
1551
1552None known (guess what must have been used to report them?)
1553
1554=cut
1555
37fa004c 1556!NO!SUBS!
1557
1558close OUT or die "Can't close $file: $!";
1559chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1560exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 1561chdir $origdir;