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