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