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