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