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