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