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