This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add File::Temp v0.08 from CPAN, with small tweaks to testsuite
[perl5.git] / utils / perlbug.PL
CommitLineData
37fa004c
PP
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
8a5546a1 5use Cwd;
1948c06a 6use File::Spec::Functions;
37fa004c
PP
7
8# List explicitly here the variables you want Configure to
9# generate. Metaconfig only looks for shell variables, so you
10# have to mention them as if they were shell variables, not
11# %Config entries. Thus you write
12# $startperl
13# to ensure Configure will look for $Config{startperl}.
84902520 14# $perlpath
37fa004c
PP
15
16# This forces PL files to create target in same directory as PL file.
17# This is so that make depend always knows where to find PL derivatives.
8a5546a1 18$origdir = cwd;
44a8e56a
PP
19chdir dirname($0);
20$file = basename($0, '.PL');
774d564b 21$file .= '.com' if $^O eq 'VMS';
37fa004c 22
55d729e4 23open OUT, ">$file" or die "Can't create $file: $!";
37fa004c 24
84902520
TB
25# extract patchlevel.h information
26
1948c06a
CN
27open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
28 or die "Can't open patchlevel.h: $!";
84902520
TB
29
30my $patchlevel_date = (stat PATCH_LEVEL)[9];
31
32while (<PATCH_LEVEL>) {
fb73857a 33 last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
55d729e4 34}
84902520 35
fb73857a 36my @patches;
84902520 37while (<PATCH_LEVEL>) {
fb73857a 38 last if /^\s*}/;
84902520 39 chomp;
5963b987
GS
40 s/^\s+,?\s*"?//;
41 s/"?\s*,?$//;
84902520 42 s/(['\\])/\\$1/g;
fb73857a 43 push @patches, $_ unless $_ eq 'NULL';
55d729e4
GS
44}
45my $patch_desc = "'" . join("',\n '", @patches) . "'";
46my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
84902520
TB
47
48close PATCH_LEVEL;
49
5edeba26
TB
50# TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
51# used, compare $Config::config_sh with the stored version. If they differ then
52# append a list of individual differences to the bug report.
53
84902520 54
37fa004c
PP
55print "Extracting $file (with variable substitutions)\n";
56
57# In this section, perl variables will be expanded during extraction.
58# You can use $Config{...} to use Configure variables.
59
b22c7a20 60my $extract_version = sprintf("v%vd", $^V);
1ec03f31 61
37fa004c 62print OUT <<"!GROK!THIS!";
5f05dabc
PP
63$Config{startperl}
64 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
65 if \$running_under_some_shell;
84902520 66
1ec03f31 67my \$config_tag1 = '$extract_version - $Config{cf_time}';
fb73857a 68
84902520 69my \$patchlevel_date = $patchlevel_date;
fb73857a
PP
70my \$patch_tags = '$patch_tags';
71my \@patches = (
55d729e4 72 $patch_desc
fb73857a 73);
37fa004c
PP
74!GROK!THIS!
75
76# In the following, perl variables are not expanded during extraction.
77
78print OUT <<'!NO!SUBS!';
79
80use Config;
1ec03f31 81use File::Spec; # keep perlbug Perl 5.005 compatible
37fa004c 82use Getopt::Std;
37fa004c
PP
83use strict;
84
85sub paraprint;
86
55d729e4
GS
87BEGIN {
88 eval "use Mail::Send;";
89 $::HaveSend = ($@ eq "");
90 eval "use Mail::Util;";
91 $::HaveUtil = ($@ eq "");
92};
c07a80fd 93
50d3c28b 94my $Version = "1.28";
c07a80fd
PP
95
96# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
a5f75d66
AD
97# Changed in 1.07 to see more sendmail execs, and added pipe output.
98# Changed in 1.08 to use correct address for sendmail.
c07a80fd
PP
99# Changed in 1.09 to close the REP file before calling it up in the editor.
100# Also removed some old comments duplicated elsewhere.
101# Changed in 1.10 to run under VMS without Mail::Send; also fixed
a5f75d66 102# temp filename generation.
c07a80fd 103# Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
a5f75d66
AD
104# Changed in 1.12 to check for editor errors, make save/send distinction
105# clearer and add $ENV{REPLYTO}.
84478119
PP
106# Changed in 1.13 to hopefully make it more difficult to accidentally
107# send mail
ab3ef367
PP
108# Changed in 1.14 to make the prompts a little more clear on providing
109# helpful information. Also let file read fail gracefully.
8ecf1a0c
KA
110# Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
111# Also report selected environment variables.
774d564b 112# Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
137443ea 113# Changed in 1.17 Win32 support added. GSAR 97-04-12
1b0e3b9e 114# Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18
84902520
TB
115# Changed in 1.19 '-ok' default not '-v'
116# add local patch information
117# warn on '-ok' if this is an old system; add '-okay'
fb73857a 118# Changed in 1.20 Added patchlevel.h reading and version/config checks
55d729e4
GS
119# Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
120# Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
cca87523 121# Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt
105f9295 122# Changed in 1.24 Added '-F<file>' to save report HVDS 98-07-01
8b49bb9a 123# Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
eedd3c36 124# Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
1948c06a 125# Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
50d3c28b 126# Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
c07a80fd 127
1b0e3b9e 128# TODO: - Allow the user to re-name the file on mail failure, and
55d729e4 129# make sure failure (transmission-wise) of Mail::Send is
c07a80fd 130# accounted for.
1b0e3b9e 131# - Test -b option
37fa004c 132
ab3ef367 133my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
50d3c28b 134 $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
1b0e3b9e 135 $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
37fa004c 136
b22c7a20 137my $perl_version = $^V ? sprintf("v%vd", $^V) : $];
1ec03f31
GS
138
139my $config_tag2 = "$perl_version - $Config{cf_time}";
fb73857a 140
37fa004c
PP
141Init();
142
55d729e4
GS
143if ($::opt_h) { Help(); exit; }
144if ($::opt_d) { Dump(*STDOUT); exit; }
eedd3c36 145if (!-t STDIN && !($ok and not $::opt_n)) {
55d729e4
GS
146 paraprint <<EOF;
147Please use perlbug interactively. If you want to
84478119
PP
148include a file, you can use the -f switch.
149EOF
55d729e4 150 die "\n";
84478119 151}
105f9295 152if (!-t STDOUT && !$outfile) { Dump(*STDOUT); exit; }
c07a80fd 153
37fa004c 154Query();
cca87523 155Edit() unless $usefile || ($ok and not $::opt_n);
37fa004c
PP
156NowWhat();
157Send();
158
159exit;
160
50d3c28b
GS
161sub ask_for_alternatives {
162 my $name = shift;
163 my $default = shift;
164 my @alts = @_;
165 my $alt = "";
166 paraprint <<EOF;
167Please pick a \u$name from the following:
168
169 @alts
170
171EOF
172 my $err = 0;
173 my $joined_alts = join('|', @alts);
174 do {
175 if ($err++ > 5) {
176 die "Invalid $name: aborting.\n";
177 }
178 print "Please enter a \u$name [$default]: ";
179 $alt = <>;
180 chomp $alt;
181 if ($alt =~ /^\s*$/) {
182 $alt = $default;
183 }
184 } while ($alt !~ /^($joined_alts)$/i);
185 lc $alt;
186}
187
37fa004c 188sub Init {
55d729e4
GS
189 # -------- Setup --------
190
191 $Is_MSWin32 = $^O eq 'MSWin32';
192 $Is_VMS = $^O eq 'VMS';
1948c06a
CN
193 $Is_MacOS = $^O eq 'MacOS';
194
195 @ARGV = split m/\s+/,
196 MacPerl::Ask('Provide command-line args here (-h for help):')
197 if $Is_MacOS && $MacPerl::Version =~ /App/;
55d729e4 198
f3260bf1 199 if (!getopts("dhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
55d729e4
GS
200
201 # This comment is needed to notify metaconfig that we are
202 # using the $perladmin, $cf_by, and $cf_time definitions.
203
204 # -------- Configuration ---------
205
206 # perlbug address
207 $perlbug = 'perlbug@perl.com';
208
209 # Test address
210 $testaddress = 'perlbug-test@perl.com';
211
212 # Target address
213 $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
214
215 # Users address, used in message and in Reply-To header
216 $from = $::opt_r || "";
217
218 # Include verbose configuration information
219 $verbose = $::opt_v || 0;
220
221 # Subject of bug-report message
222 $subject = $::opt_s || "";
223
224 # Send a file
225 $usefile = ($::opt_f || 0);
226
227 # File to send as report
228 $file = $::opt_f || "";
229
105f9295
HS
230 # File to output to
231 $outfile = $::opt_F || "";
232
55d729e4
GS
233 # Body of report
234 $body = $::opt_b || "";
235
236 # Editor
237 $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
238 || ($Is_VMS && "edit/tpu")
239 || ($Is_MSWin32 && "notepad")
1948c06a 240 || ($Is_MacOS && '')
55d729e4
GS
241 || "vi";
242
243 # Not OK - provide build failure template by finessing OK report
244 if ($::opt_n) {
245 if (substr($::opt_n, 0, 2) eq 'ok' ) {
246 $::opt_o = substr($::opt_n, 1);
247 } else {
248 Help();
249 exit();
250 }
251 }
252
253 # OK - send "OK" report for build on this system
254 $ok = 0;
255 if ($::opt_o) {
256 if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
257 my $age = time - $patchlevel_date;
258 if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
259 my $date = localtime $patchlevel_date;
260 print <<"EOF";
261"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
262are more than 60 days old. This Perl version was constructed on
263$date. If you really want to report this, use
264"perlbug -okay" or "perlbug -nokay".
84902520 265EOF
1b0e3b9e
CR
266 exit();
267 }
55d729e4
GS
268 # force these options
269 unless ($::opt_n) {
270 $::opt_S = 1; # don't prompt for send
271 $::opt_b = 1; # we have a body
272 $body = "Perl reported to build OK on this system.\n";
273 }
274 $::opt_C = 1; # don't send a copy to the local admin
275 $::opt_s = 1; # we have a subject line
276 $subject = ($::opt_n ? 'Not ' : '')
1ec03f31 277 . "OK: perl $perl_version ${patch_tags}on"
55d729e4 278 ." $::Config{'archname'} $::Config{'osvers'} $subject";
158f8ee5
GS
279 $category = "install";
280 $severity = "none";
55d729e4
GS
281 $ok = 1;
282 } else {
283 Help();
284 exit();
1b0e3b9e 285 }
55d729e4 286 }
37fa004c 287
55d729e4
GS
288 # Possible administrator addresses, in order of confidence
289 # (Note that cf_email is not mentioned to metaconfig, since
290 # we don't really want it. We'll just take it if we have to.)
291 #
292 # This has to be after the $ok stuff above because of the way
293 # that $::opt_C is forced.
294 $cc = $::opt_C ? "" : (
295 $::opt_c || $::Config{'perladmin'}
296 || $::Config{'cf_email'} || $::Config{'cf_by'}
297 );
298
299 # My username
300 $me = $Is_MSWin32 ? $ENV{'USERNAME'}
301 : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
1948c06a 302 : $Is_MacOS ? $ENV{'USER'}
55d729e4 303 : eval { getpwuid($<) }; # May be missing
c0830f08
RB
304
305 $from = $::Config{'cf_email'}
306 if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
307 ($me eq $::Config{'cf_by'});
55d729e4 308} # sub Init
37fa004c
PP
309
310sub Query {
55d729e4
GS
311 # Explain what perlbug is
312 unless ($ok) {
37fa004c 313 paraprint <<EOF;
8ecf1a0c
KA
314This program provides an easy way to create a message reporting a bug
315in perl, and e-mail it to $address. It is *NOT* intended for
54310121
PP
316sending test messages or simply verifying that perl works, *NOR* is it
317intended for reporting bugs in third-party perl modules. It is *ONLY*
318a means of reporting verifiable problems with the core perl distribution,
319and any solutions to such problems, to the people who maintain perl.
320
321If you're just looking for help with perl, try posting to the Usenet
322newsgroup comp.lang.perl.misc. If you're looking for help with using
323perl with CGI, try posting to comp.infosystems.www.programming.cgi.
37fa004c 324EOF
1b0e3b9e 325 }
37fa004c 326
55d729e4
GS
327 # Prompt for subject of message, if needed
328 unless ($subject) {
329 paraprint <<EOF;
330First of all, please provide a subject for the
331message. It should be a concise description of
774d564b
PP
332the bug or problem. "perl bug" or "perl problem"
333is not a concise description.
37fa004c 334EOF
55d729e4
GS
335 print "Subject: ";
336 $subject = <>;
337
338 my $err = 0;
339 while ($subject !~ /\S/) {
340 print "\nPlease enter a subject: ";
341 $subject = <>;
342 if ($err++ > 5) {
343 die "Aborting.\n";
344 }
37fa004c 345 }
55d729e4
GS
346 chop $subject;
347 }
348
349 # Prompt for return address, if needed
350 unless ($from) {
351 # Try and guess return address
352 my $guess;
353
354 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || '';
1948c06a
CN
355 if ($Is_MacOS) {
356 require Mac::InternetConfig;
357 $guess = $Mac::InternetConfig::InternetConfig{
358 Mac::InternetConfig::kICEmail()
359 };
360 }
361
55d729e4
GS
362 unless ($guess) {
363 my $domain;
364 if ($::HaveUtil) {
365 $domain = Mail::Util::maildomain();
366 } elsif ($Is_MSWin32) {
367 $domain = $ENV{'USERDOMAIN'};
368 } else {
369 require Sys::Hostname;
370 $domain = Sys::Hostname::hostname();
371 }
372 if ($domain) {
373 if ($Is_VMS && !$::Config{'d_socket'}) {
374 $guess = "$domain\:\:$me";
41f926b8 375 } else {
55d729e4 376 $guess = "$me\@$domain" if $domain;
c07a80fd 377 }
55d729e4
GS
378 }
379 }
37fa004c 380
55d729e4
GS
381 if ($guess) {
382 unless ($ok) {
383 paraprint <<EOF;
a5f75d66
AD
384Your e-mail address will be useful if you need to be contacted. If the
385default shown is not your full internet e-mail address, please correct it.
37fa004c 386EOF
55d729e4
GS
387 }
388 } else {
389 paraprint <<EOF;
390So that you may be contacted if necessary, please enter
a5f75d66 391your full internet e-mail address here.
37fa004c 392EOF
37fa004c 393 }
37fa004c 394
55d729e4
GS
395 if ($ok && $guess) {
396 # use it
397 $from = $guess;
398 } else {
399 # verify it
400 print "Your address [$guess]: ";
401 $from = <>;
402 chop $from;
403 $from = $guess if $from eq '';
404 }
405 }
37fa004c 406
55d729e4
GS
407 if ($from eq $cc or $me eq $cc) {
408 # Try not to copy ourselves
409 $cc = "yourself";
410 }
37fa004c 411
55d729e4
GS
412 # Prompt for administrator address, unless an override was given
413 if( !$::opt_C and !$::opt_c ) {
414 paraprint <<EOF;
37fa004c 415A copy of this report can be sent to your local
55d729e4 416perl administrator. If the address is wrong, please
c07a80fd
PP
417correct it, or enter 'none' or 'yourself' to not send
418a copy.
37fa004c 419EOF
55d729e4
GS
420 print "Local perl administrator [$cc]: ";
421 my $entry = scalar <>;
422 chop $entry;
37fa004c 423
55d729e4
GS
424 if ($entry ne "") {
425 $cc = $entry;
426 $cc = '' if $me eq $cc;
37fa004c 427 }
55d729e4 428 }
37fa004c 429
55d729e4
GS
430 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
431 $andcc = " and $cc" if $cc;
37fa004c 432
55d729e4 433 # Prompt for editor, if no override is given
ab3ef367 434editor:
55d729e4
GS
435 unless ($::opt_e || $::opt_f || $::opt_b) {
436 paraprint <<EOF;
c07a80fd 437Now you need to supply the bug report. Try to make
55d729e4 438the report concise but descriptive. Include any
ab3ef367
PP
439relevant detail. If you are reporting something
440that does not work as you think it should, please
55d729e4 441try to include example of both the actual
ab3ef367
PP
442result, and what you expected.
443
444Some information about your local
55d729e4 445perl configuration will automatically be included
ab3ef367
PP
446at the end of the report. If you are using any
447unusual version of perl, please try and confirm
448exactly which versions are relevant.
37fa004c
PP
449
450You will probably want to use an editor to enter
451the report. If "$ed" is the editor you want
452to use, then just press Enter, otherwise type in
453the name of the editor you would like to use.
454
c07a80fd 455If you would like to use a prepared file, type
37fa004c 456"file", and you will be asked for the filename.
37fa004c 457EOF
55d729e4
GS
458 print "Editor [$ed]: ";
459 my $entry =scalar <>;
460 chop $entry;
461
462 $usefile = 0;
463 if ($entry eq "file") {
464 $usefile = 1;
465 } elsif ($entry ne "") {
466 $ed = $entry;
37fa004c 467 }
55d729e4 468 }
37fa004c 469
50d3c28b
GS
470 # Prompt for category of bug
471 $category ||= ask_for_alternatives("category", "core",
472 qw(core docs install
473 library utilities));
474
475 # Prompt for severity of bug
476 $severity ||= ask_for_alternatives("severity", "low",
477 qw(critical high medium
478 low wishlist none));
479
55d729e4
GS
480 # Generate scratch file to edit report in
481 $filename = filename();
37fa004c 482
55d729e4
GS
483 # Prompt for file to read report from, if needed
484 if ($usefile and !$file) {
ab3ef367 485filename:
55d729e4 486 paraprint <<EOF;
37fa004c 487What is the name of the file that contains your report?
37fa004c 488EOF
55d729e4
GS
489 print "Filename: ";
490 my $entry = scalar <>;
491 chop $entry;
37fa004c 492
55d729e4
GS
493 if ($entry eq "") {
494 paraprint <<EOF;
495No filename? I'll let you go back and choose an editor again.
ab3ef367 496EOF
55d729e4
GS
497 goto editor;
498 }
499
500 unless (-f $entry and -r $entry) {
501 paraprint <<EOF;
ab3ef367
PP
502I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
503the file? If you don't want to send a file, just enter a blank line and you
504can get back to the editor selection.
ab3ef367 505EOF
55d729e4 506 goto filename;
37fa004c 507 }
55d729e4
GS
508 $file = $entry;
509 }
37fa004c 510
55d729e4
GS
511 # Generate report
512 open(REP,">$filename");
cca87523 513 my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
37fa004c 514
55d729e4 515 print REP <<EOF;
84902520 516This is a $reptype report for perl from $from,
1ec03f31 517generated with the help of perlbug $Version running under perl $perl_version.
37fa004c
PP
518
519EOF
520
55d729e4
GS
521 if ($body) {
522 print REP $body;
523 } elsif ($usefile) {
524 open(F, "<$file")
525 or die "Unable to read report file from `$file': $!\n";
526 while (<F>) {
527 print REP $_
528 }
529 close(F);
530 } else {
531 print REP <<EOF;
774d564b
PP
532
533-----------------------------------------------------------------
534[Please enter your report here]
535
536
537
538[Please do not change anything below this line]
539-----------------------------------------------------------------
540EOF
55d729e4
GS
541 }
542 Dump(*REP);
543 close(REP);
544
545 # read in the report template once so that
546 # we can track whether the user does any editing.
547 # yes, *all* whitespace is ignored.
548 open(REP, "<$filename");
549 while (<REP>) {
550 s/\s+//g;
551 $REP{$_}++;
552 }
553 close(REP);
554} # sub Query
c07a80fd
PP
555
556sub Dump {
55d729e4 557 local(*OUT) = @_;
37fa004c 558
50d3c28b
GS
559 print OUT <<EFF;
560---
561Flags:
562 category=$category
563 severity=$severity
564---
565EFF
566 print OUT "This perlbug was built using Perl $config_tag1\n",
1ec03f31 567 "It is being executed now by Perl $config_tag2.\n\n"
55d729e4 568 if $config_tag2 ne $config_tag1;
fb73857a 569
55d729e4 570 print OUT <<EOF;
1ec03f31 571Site configuration information for perl $perl_version:
37fa004c
PP
572
573EOF
55d729e4
GS
574 if ($::Config{cf_by} and $::Config{cf_time}) {
575 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
576 }
577 print OUT Config::myconfig;
37fa004c 578
55d729e4
GS
579 if (@patches) {
580 print OUT join "\n ", "Locally applied patches:", @patches;
581 print OUT "\n";
582 };
84902520 583
55d729e4 584 print OUT <<EOF;
8ecf1a0c 585
774d564b 586---
1ec03f31 587\@INC for perl $perl_version:
774d564b 588EOF
55d729e4
GS
589 for my $i (@INC) {
590 print OUT " $i\n";
591 }
774d564b 592
55d729e4 593 print OUT <<EOF;
8ecf1a0c 594
774d564b 595---
1ec03f31 596Environment for perl $perl_version:
8ecf1a0c 597EOF
5cf1d1f1
JH
598 my @env =
599 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
600 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
8876aa85
JH
601 push @env, grep /^(?:PERL|LC_|LANG)/, keys %ENV;
602 my %env;
603 @env{@env} = @env;
604 for my $env (sort keys %env) {
55d729e4
GS
605 print OUT " $env",
606 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
607 "\n";
608 }
609 if ($verbose) {
1ec03f31 610 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
55d729e4
GS
611 my $value;
612 foreach (sort keys %::Config) {
613 $value = $::Config{$_};
614 $value =~ s/'/\\'/g;
615 print OUT "$_='$value'\n";
84902520 616 }
55d729e4
GS
617 }
618} # sub Dump
37fa004c
PP
619
620sub Edit {
55d729e4
GS
621 # Edit the report
622 if ($usefile || $body) {
623 paraprint <<EOF;
ab3ef367 624Please make sure that the name of the editor you want to use is correct.
ab3ef367 625EOF
55d729e4
GS
626 print "Editor [$ed]: ";
627 my $entry =scalar <>;
628 chop $entry;
629 $ed = $entry unless $entry eq '';
630 }
a5f75d66 631
55d729e4 632tryagain:
1948c06a
CN
633 my $sts = system("$ed $filename") unless $Is_MacOS;
634 if ($Is_MacOS) {
635 require ExtUtils::MakeMaker;
636 ExtUtils::MM_MacOS::launch_file($filename);
637 paraprint <<EOF;
638Press Enter when done.
639EOF
640 scalar <>;
641 }
55d729e4
GS
642 if ($sts) {
643 paraprint <<EOF;
a5f75d66
AD
644The editor you chose (`$ed') could apparently not be run!
645Did you mistype the name of your editor? If so, please
55d729e4 646correct it here, otherwise just press Enter.
a5f75d66 647EOF
55d729e4
GS
648 print "Editor [$ed]: ";
649 my $entry =scalar <>;
650 chop $entry;
a5f75d66 651
55d729e4
GS
652 if ($entry ne "") {
653 $ed = $entry;
654 goto tryagain;
655 } else {
656 paraprint <<EOF;
a5f75d66
AD
657You may want to save your report to a file, so you can edit and mail it
658yourself.
659EOF
774d564b 660 }
55d729e4 661 }
774d564b 662
55d729e4
GS
663 return if ($ok and not $::opt_n) || $body;
664 # Check that we have a report that has some, eh, report in it.
665 my $unseen = 0;
666
667 open(REP, "<$filename");
668 # a strange way to check whether any significant editing
669 # have been done: check whether any new non-empty lines
670 # have been added. Yes, the below code ignores *any* space
671 # in *any* line.
672 while (<REP>) {
673 s/\s+//g;
674 $unseen++ if $_ ne '' and not exists $REP{$_};
675 }
774d564b 676
55d729e4
GS
677 while ($unseen == 0) {
678 paraprint <<EOF;
774d564b 679I am sorry but it looks like you did not report anything.
774d564b 680EOF
55d729e4
GS
681 print "Action (Retry Edit/Cancel) ";
682 my ($action) = scalar(<>);
683 if ($action =~ /^[re]/i) { # <R>etry <E>dit
684 goto tryagain;
685 } elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
686 Cancel();
687 }
688 }
689} # sub Edit
774d564b
PP
690
691sub Cancel {
692 1 while unlink($filename); # remove all versions under VMS
693 print "\nCancelling.\n";
694 exit(0);
37fa004c
PP
695}
696
697sub NowWhat {
55d729e4
GS
698 # Report is done, prompt for further action
699 if( !$::opt_S ) {
700 while(1) {
701 paraprint <<EOF;
702Now that you have completed your report, would you like to send
703the message to $address$andcc, display the message on
37fa004c
PP
704the screen, re-edit it, or cancel without sending anything?
705You may also save the message as a file to mail at another time.
37fa004c 706EOF
8b49bb9a 707 retry:
55d729e4
GS
708 print "Action (Send/Display/Edit/Cancel/Save to File): ";
709 my $action = scalar <>;
710 chop $action;
711
712 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
713 print "\n\nName of file to save message in [perlbug.rep]: ";
714 my $file = scalar <>;
715 chop $file;
716 $file = "perlbug.rep" if $file eq "";
717
8b49bb9a
HS
718 unless (open(FILE, ">$file")) {
719 print "\nError opening $file: $!\n\n";
720 goto retry;
721 }
55d729e4
GS
722 open(REP, "<$filename");
723 print FILE "To: $address\nSubject: $subject\n";
724 print FILE "Cc: $cc\n" if $cc;
725 print FILE "Reply-To: $from\n" if $from;
726 print FILE "\n";
727 while (<REP>) { print FILE }
728 close(REP);
729 close(FILE);
730
731 print "\nMessage saved in `$file'.\n";
732 exit;
733 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
734 # Display the message
735 open(REP, "<$filename");
736 while (<REP>) { print $_ }
737 close(REP);
738 } elsif ($action =~ /^se/i) { # <S>end
739 # Send the message
740 print "Are you certain you want to send this message?\n"
741 . 'Please type "yes" if you are: ';
742 my $reply = scalar <STDIN>;
743 chop $reply;
744 if ($reply eq "yes") {
745 last;
746 } else {
747 paraprint <<EOF;
ab3ef367
PP
748That wasn't a clear "yes", so I won't send your message. If you are sure
749your message should be sent, type in "yes" (without the quotes) at the
750confirmation prompt.
ab3ef367 751EOF
55d729e4
GS
752 }
753 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
754 # edit the message
755 Edit();
756 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
757 Cancel();
758 } elsif ($action =~ /^s/) {
759 paraprint <<EOF;
84478119
PP
760I'm sorry, but I didn't understand that. Please type "send" or "save".
761EOF
55d729e4 762 }
37fa004c 763 }
55d729e4
GS
764 }
765} # sub NowWhat
37fa004c
PP
766
767sub Send {
55d729e4 768 # Message has been accepted for transmission -- Send the message
105f9295
HS
769 if ($outfile) {
770 open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
771 goto sendout;
772 }
55d729e4
GS
773 if ($::HaveSend) {
774 $msg = new Mail::Send Subject => $subject, To => $address;
775 $msg->cc($cc) if $cc;
776 $msg->add("Reply-To",$from) if $from;
777
778 $fh = $msg->open;
779 open(REP, "<$filename");
780 while (<REP>) { print $fh $_ }
781 close(REP);
782 $fh->close;
783
784 print "\nMessage sent.\n";
785 } elsif ($Is_VMS) {
786 if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
787 ($cc =~ /@/ and $cc !~ /^\w+%"/) ) {
788 my $prefix;
789 foreach (qw[ IN MX SMTP UCX PONY WINS ], '') {
790 $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
791 }
792 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
793 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
794 }
795 $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
796 my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
797 if ($sts) {
798 die <<EOF;
799Can't spawn off mail
800 (leaving bug report in $filename): $sts
801EOF
802 }
803 } else {
804 my $sendmail = "";
805 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
806 $sendmail = $_, last if -e $_;
807 }
808 if ($^O eq 'os2' and $sendmail eq "") {
809 my $path = $ENV{PATH};
810 $path =~ s:\\:/: ;
811 my @path = split /$Config{'path_sep'}/, $path;
812 for (@path) {
813 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
814 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
815 }
816 }
37fa004c 817
55d729e4 818 paraprint(<<"EOF"), die "\n" if $sendmail eq "";
c07a80fd
PP
819I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
820the perl package Mail::Send has not been installed, so I can't send your bug
d121ca8c 821report. We apologize for the inconvenience.
c07a80fd
PP
822
823So you may attempt to find some way of sending your message, it has
824been left in the file `$filename'.
c07a80fd 825EOF
55d729e4 826 open(SENDMAIL, "|$sendmail -t") || die "'|$sendmail -t' failed: $!";
105f9295 827sendout:
55d729e4
GS
828 print SENDMAIL "To: $address\n";
829 print SENDMAIL "Subject: $subject\n";
830 print SENDMAIL "Cc: $cc\n" if $cc;
831 print SENDMAIL "Reply-To: $from\n" if $from;
832 print SENDMAIL "\n\n";
833 open(REP, "<$filename");
834 while (<REP>) { print SENDMAIL $_ }
835 close(REP);
37fa004c 836
55d729e4 837 if (close(SENDMAIL)) {
105f9295 838 printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
55d729e4
GS
839 } else {
840 warn "\nSendmail returned status '", $? >> 8, "'\n";
841 }
842 }
843 1 while unlink($filename); # remove all versions under VMS
844} # sub Send
37fa004c
PP
845
846sub Help {
55d729e4 847 print <<EOF;
37fa004c 848
55d729e4 849A program to help generate bug reports about perl5, and mail them.
37fa004c
PP
850It is designed to be used interactively. Normally no arguments will
851be needed.
55d729e4 852
37fa004c 853Usage:
105f9295 854$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
d121ca8c 855 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
55d729e4
GS
856$0 [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
857
c07a80fd 858Simplest usage: run "$0", and follow the prompts.
37fa004c
PP
859
860Options:
861
862 -v Include Verbose configuration data in the report
55d729e4 863 -f File containing the body of the report. Use this to
37fa004c 864 quickly send a prepared message.
1948c06a 865 -F File to output the resulting mail message to, instead of mailing.
37fa004c
PP
866 -S Send without asking for confirmation.
867 -a Address to send the report to. Defaults to `$address'.
868 -c Address to send copy of report to. Defaults to `$cc'.
869 -C Don't send copy to administrator.
55d729e4 870 -s Subject to include with the message. You will be prompted
37fa004c
PP
871 if you don't supply one on the command line.
872 -b Body of the report. If not included on the command line, or
873 in a file with -f, you will get a chance to edit the message.
874 -r Your return address. The program will ask you to confirm
875 this if you don't give it here.
55d729e4 876 -e Editor to use.
37fa004c 877 -t Test mode. The target address defaults to `$testaddress'.
1948c06a 878 -d Data mode (the default if you redirect or pipe output.)
c07a80fd
PP
879 This prints out your configuration data, without mailing
880 anything. You can use this with -v to get more complete data.
84902520 881 -ok Report successful build on this system to perl porters
55d729e4
GS
882 (use alone or with -v). Only use -ok if *everything* was ok:
883 if there were *any* problems at all, use -nok.
fb73857a 884 -okay As -ok but allow report from old builds.
55d729e4
GS
885 -nok Report unsuccessful build on this system to perl porters
886 (use alone or with -v). You must describe what went wrong
887 in the body of the report which you will be asked to edit.
888 -nokay As -nok but allow report from old builds.
889 -h Print this help message.
890
37fa004c
PP
891EOF
892}
893
55d729e4
GS
894sub filename {
895 my $dir = $Is_VMS ? 'sys$scratch:'
896 : ($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'}
1948c06a
CN
897 : $Is_MacOS ? $ENV{'TMPDIR'}
898 : '/tmp';
55d729e4 899 $filename = "bugrep0$$";
1948c06a 900# $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
1ec03f31
GS
901 $filename++ while -e File::Spec->catfile($dir, $filename);
902 $filename = File::Spec->catfile($dir, $filename);
55d729e4
GS
903}
904
37fa004c
PP
905sub paraprint {
906 my @paragraphs = split /\n{2,}/, "@_";
c07a80fd 907 print "\n\n";
37fa004c 908 for (@paragraphs) { # implicit local $_
55d729e4
GS
909 s/(\S)\s*\n/$1 /g;
910 write;
911 print "\n";
37fa004c 912 }
37fa004c 913}
37fa004c
PP
914
915format STDOUT =
916^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
917$_
918.
d121ca8c
CS
919
920__END__
921
922=head1 NAME
923
924perlbug - how to submit bug reports on Perl
925
926=head1 SYNOPSIS
927
928B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
105f9295
HS
929S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
930S<[ B<-r> I<returnaddress> ]>
d121ca8c
CS
931S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
932S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]>
933
55d729e4
GS
934B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
935S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1b0e3b9e 936
d121ca8c
CS
937=head1 DESCRIPTION
938
939A program to help generate bug reports about perl or the modules that
55d729e4 940come with it, and mail them.
d121ca8c
CS
941
942If you have found a bug with a non-standard port (one that was not part
943of the I<standard distribution>), a binary distribution, or a
944non-standard module (such as Tk, CGI, etc), then please see the
945documentation that came with that distribution to determine the correct
946place to report bugs.
947
948C<perlbug> is designed to be used interactively. Normally no arguments
949will be needed. Simply run it, and follow the prompts.
950
951If you are unable to run B<perlbug> (most likely because you don't have
952a working setup to send mail that perlbug recognizes), you may have to
953compose your own report, and email it to B<perlbug@perl.com>. You might
954find the B<-d> option useful to get summary information in that case.
955
956In any case, when reporting a bug, please make sure you have run through
957this checklist:
958
959=over 4
960
884baa66 961=item What version of Perl you are running?
d121ca8c
CS
962
963Type C<perl -v> at the command line to find out.
964
965=item Are you running the latest released version of perl?
966
967Look at http://www.perl.com/ to find out. If it is not the latest
968released version, get that one and see whether your bug has been
884baa66 969fixed. Note that bug reports about old versions of Perl, especially
d121ca8c
CS
970those prior to the 5.0 release, are likely to fall upon deaf ears.
971You are on your own if you continue to use perl1 .. perl4.
972
973=item Are you sure what you have is a bug?
974
975A significant number of the bug reports we get turn out to be documented
884baa66 976features in Perl. Make sure the behavior you are witnessing doesn't fall
d121ca8c 977under that category, by glancing through the documentation that comes
884baa66 978with Perl (we'll admit this is no mean task, given the sheer volume of
d121ca8c
CS
979it all, but at least have a look at the sections that I<seem> relevant).
980
981Be aware of the familiar traps that perl programmers of various hues
982fall into. See L<perltrap>.
983
f27fa58d
G
984Check in L<perldiag> to see what any Perl error message(s) mean.
985If message isn't in perldiag, it probably isn't generated by Perl.
986Consult your operating system documentation instead.
bdcdfa19 987
1948c06a
CN
988If you are on a non-UNIX platform check also L<perlport>, as some
989features may be unimplemented or work differently.
bdcdfa19 990
884baa66 991Try to study the problem under the Perl debugger, if necessary.
d121ca8c
CS
992See L<perldebug>.
993
994=item Do you have a proper test case?
995
996The easier it is to reproduce your bug, the more likely it will be
997fixed, because if no one can duplicate the problem, no one can fix it.
998A good test case has most of these attributes: fewest possible number
999of lines; few dependencies on external commands, modules, or
1000libraries; runs on most platforms unimpeded; and is self-documenting.
1001
1002A good test case is almost always a good candidate to be on the perl
1003test suite. If you have the time, consider making your test case so
1004that it will readily fit into the standard test suite.
1005
bdcdfa19
JH
1006Remember also to include the B<exact> error messages, if any.
1007"Perl complained something" is not an exact error message.
1008
1009If you get a core dump (or equivalent), you may use a debugger
1010(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
1011report. NOTE: unless your Perl has been compiled with debug info
1012(often B<-g>), the stack trace is likely to be somewhat hard to use
884baa66 1013because it will most probably contain only the function names and not
bdcdfa19
JH
1014their arguments. If possible, recompile your Perl with debug info and
1015reproduce the dump and the stack trace.
1016
d121ca8c
CS
1017=item Can you describe the bug in plain English?
1018
1019The easier it is to understand a reproducible bug, the more likely it
1020will be fixed. Anything you can provide by way of insight into the
884baa66
JH
1021problem helps a great deal. In other words, try to analyze the
1022problem (to the extent you can) and report your discoveries.
d121ca8c
CS
1023
1024=item Can you fix the bug yourself?
1025
1026A bug report which I<includes a patch to fix it> will almost
1027definitely be fixed. Use the C<diff> program to generate your patches
1028(C<diff> is being maintained by the GNU folks as part of the B<diffutils>
1029package, so you should be able to get it from any of the GNU software
1030repositories). If you do submit a patch, the cool-dude counter at
1031perlbug@perl.com will register you as a savior of the world. Your
1032patch may be returned with requests for changes, or requests for more
1033detailed explanations about your fix.
1034
1035Here are some clues for creating quality patches: Use the B<-c> or
1036B<-u> switches to the diff program (to create a so-called context or
1037unified diff). Make sure the patch is not reversed (the first
1038argument to diff is typically the original file, the second argument
1039your changed file). Make sure you test your patch by applying it with
1040the C<patch> program before you send it on its way. Try to follow the
1041same style as the code you are trying to patch. Make sure your patch
1042really does work (C<make test>, if the thing you're patching supports
1043it).
1044
1045=item Can you use C<perlbug> to submit the report?
1046
1047B<perlbug> will, amongst other things, ensure your report includes
1048crucial information about your version of perl. If C<perlbug> is unable
1049to mail your report after you have typed it in, you may have to compose
1050the message yourself, add the output produced by C<perlbug -d> and email
1051it to B<perlbug@perl.com>. If, for some reason, you cannot run
1052C<perlbug> at all on your system, be sure to include the entire output
1053produced by running C<perl -V> (note the uppercase V).
1054
bdcdfa19 1055Whether you use C<perlbug> or send the email manually, please make
884baa66
JH
1056your Subject line informative. "a bug" not informative. Neither is
1057"perl crashes" nor "HELP!!!". These don't help.
1058A compact description of what's wrong is fine.
bdcdfa19 1059
d121ca8c
CS
1060=back
1061
1062Having done your bit, please be prepared to wait, to be told the bug
884baa66 1063is in your code, or even to get no reply at all. The Perl maintainers
84902520
TB
1064are busy folks, so if your problem is a small one or if it is difficult
1065to understand or already known, they may not respond with a personal reply.
d121ca8c
CS
1066If it is important to you that your bug be fixed, do monitor the
1067C<Changes> file in any development releases since the time you submitted
1068the bug, and encourage the maintainers with kind words (but never any
1069flames!). Feel free to resend your bug report if the next released
1070version of perl comes out and your bug is still present.
1071
1072=head1 OPTIONS
1073
1074=over 8
1075
1076=item B<-a>
1077
1078Address to send the report to. Defaults to `perlbug@perl.com'.
1079
1080=item B<-b>
1081
1082Body of the report. If not included on the command line, or
1083in a file with B<-f>, you will get a chance to edit the message.
1084
1085=item B<-C>
1086
1087Don't send copy to administrator.
1088
1089=item B<-c>
1090
1091Address to send copy of report to. Defaults to the address of the
1092local perl administrator (recorded when perl was built).
1093
1094=item B<-d>
1095
1096Data mode (the default if you redirect or pipe output). This prints out
1097your configuration data, without mailing anything. You can use this
1098with B<-v> to get more complete data.
1099
1100=item B<-e>
1101
55d729e4 1102Editor to use.
d121ca8c
CS
1103
1104=item B<-f>
1105
1106File containing the body of the report. Use this to quickly send a
1107prepared message.
1108
105f9295
HS
1109=item B<-F>
1110
1111File to output the results to instead of sending as an email. Useful
1112particularly when running perlbug on a machine with no direct internet
1113connection.
1114
d121ca8c
CS
1115=item B<-h>
1116
1117Prints a brief summary of the options.
1118
1b0e3b9e
CR
1119=item B<-ok>
1120
84902520
TB
1121Report successful build on this system to perl porters. Forces B<-S>
1122and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1b0e3b9e 1123prompts for a return address if it cannot guess it (for use with
84902520
TB
1124B<make>). Honors return address specified with B<-r>. You can use this
1125with B<-v> to get more complete data. Only makes a report if this
1126system is less than 60 days old.
1127
1128=item B<-okay>
1129
1130As B<-ok> except it will report on older systems.
1b0e3b9e 1131
55d729e4
GS
1132=item B<-nok>
1133
1134Report unsuccessful build on this system. Forces B<-C>. Forces and
1135supplies a value for B<-s>, then requires you to edit the report
1136and say what went wrong. Alternatively, a prepared report may be
1137supplied using B<-f>. Only prompts for a return address if it
1138cannot guess it (for use with B<make>). Honors return address
1139specified with B<-r>. You can use this with B<-v> to get more
1140complete data. Only makes a report if this system is less than 60
1141days old.
1142
1143=item B<-nokay>
1144
1145As B<-nok> except it will report on older systems.
1146
d121ca8c
CS
1147=item B<-r>
1148
1149Your return address. The program will ask you to confirm its default
1150if you don't use this option.
1151
1152=item B<-S>
1153
1154Send without asking for confirmation.
1155
1156=item B<-s>
1157
1158Subject to include with the message. You will be prompted if you don't
1159supply one on the command line.
1160
1161=item B<-t>
1162
1163Test mode. The target address defaults to `perlbug-test@perl.com'.
1164
1165=item B<-v>
1166
1167Include verbose configuration data in the report.
1168
1169=back
1170
1171=head1 AUTHORS
1172
1173Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
6e238990 1174by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>), Tom Christiansen
1b0e3b9e 1175(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
55d729e4 1176Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
bdcdfa19 1177(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
1948c06a 1178Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>),
50d3c28b
GS
1179Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1180(E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
1181and Richard Foley (E<lt>richard@rfi.netE<gt>).
d121ca8c
CS
1182
1183=head1 SEE ALSO
1184
bdcdfa19
JH
1185perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1186diff(1), patch(1), dbx(1), gdb(1)
d121ca8c
CS
1187
1188=head1 BUGS
1189
1190None known (guess what must have been used to report them?)
1191
1192=cut
1193
37fa004c
PP
1194!NO!SUBS!
1195
1196close OUT or die "Can't close $file: $!";
1197chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1198exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 1199chdir $origdir;