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