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