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