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