This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove bad advice from perllocale.pod
[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}.
12
13# This forces PL files to create target in same directory as PL file.
14# This is so that make depend always knows where to find PL derivatives.
44a8e56a
PP
15chdir dirname($0);
16$file = basename($0, '.PL');
37fa004c
PP
17
18open OUT,">$file" or die "Can't create $file: $!";
19
20print "Extracting $file (with variable substitutions)\n";
21
22# In this section, perl variables will be expanded during extraction.
23# You can use $Config{...} to use Configure variables.
24
25print OUT <<"!GROK!THIS!";
5f05dabc
PP
26$Config{startperl}
27 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
28 if \$running_under_some_shell;
37fa004c
PP
29!GROK!THIS!
30
31# In the following, perl variables are not expanded during extraction.
32
33print OUT <<'!NO!SUBS!';
34
35use Config;
37fa004c
PP
36use Getopt::Std;
37
c07a80fd
PP
38BEGIN {
39 eval "use Mail::Send;";
40 $::HaveSend = ($@ eq "");
41 eval "use Mail::Util;";
42 $::HaveUtil = ($@ eq "");
43};
44
45
37fa004c
PP
46use strict;
47
48sub paraprint;
49
c07a80fd 50
8ecf1a0c 51my($Version) = "1.15";
c07a80fd
PP
52
53# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
a5f75d66
AD
54# Changed in 1.07 to see more sendmail execs, and added pipe output.
55# Changed in 1.08 to use correct address for sendmail.
c07a80fd
PP
56# Changed in 1.09 to close the REP file before calling it up in the editor.
57# Also removed some old comments duplicated elsewhere.
58# Changed in 1.10 to run under VMS without Mail::Send; also fixed
a5f75d66 59# temp filename generation.
c07a80fd 60# Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
a5f75d66
AD
61# Changed in 1.12 to check for editor errors, make save/send distinction
62# clearer and add $ENV{REPLYTO}.
84478119
PP
63# Changed in 1.13 to hopefully make it more difficult to accidentally
64# send mail
ab3ef367
PP
65# Changed in 1.14 to make the prompts a little more clear on providing
66# helpful information. Also let file read fail gracefully.
8ecf1a0c
KA
67# Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
68# Also report selected environment variables.
c07a80fd
PP
69
70# TODO: Allow the user to re-name the file on mail failure, and
71# make sure failure (transmission-wise) of Mail::Send is
72# accounted for.
37fa004c 73
ab3ef367 74my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
37fa004c
PP
75 $subject, $from, $verbose, $ed,
76 $fh, $me, $Is_VMS, $msg, $body, $andcc );
77
78Init();
79
80if($::opt_h) { Help(); exit; }
81
84478119
PP
82if(!-t STDIN) {
83 paraprint <<EOF;
84Please use perlbug interactively. If you want to
85include a file, you can use the -f switch.
86EOF
87 die "\n";
88}
89
c07a80fd
PP
90if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
91
37fa004c 92Query();
ab3ef367 93Edit() unless $usefile;
37fa004c
PP
94NowWhat();
95Send();
96
97exit;
98
99sub Init {
100
101 # -------- Setup --------
102
84478119 103 $Is_VMS = $^O eq 'VMS';
37fa004c 104
c07a80fd 105 getopts("dhva:s:b:f:r:e:SCc:t");
37fa004c
PP
106
107
108 # This comment is needed to notify metaconfig that we are
109 # using the $perladmin, $cf_by, and $cf_time definitions.
110
111
112 # -------- Configuration ---------
113
114 # perlbug address
115 $perlbug = 'perlbug@perl.com';
116
117 # Test address
118 $testaddress = 'perlbug-test@perl.com';
119
120 # Target address
121 $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
122
123 # Possible administrator addresses, in order of confidence
124 # (Note that cf_email is not mentioned to metaconfig, since
125 # we don't really want it. We'll just take it if we have to.)
126 $cc = ($::opt_C ? "" : (
127 $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
128 ));
129
130 # Users address, used in message and in Reply-To header
131 $from = $::opt_r || "";
132
133 # Include verbose configuration information
134 $verbose = $::opt_v || 0;
135
136 # Subject of bug-report message
137 $subject = $::opt_s || "";
138
ab3ef367
PP
139 # Send a file
140 $usefile = ($::opt_f || 0);
141
37fa004c
PP
142 # File to send as report
143 $file = $::opt_f || "";
144
145 # Body of report
146 $body = $::opt_b || "";
147
148 # Editor
ab3ef367 149 $ed = ( $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
37fa004c 150 ($Is_VMS ? "edit/tpu" : "vi")
ab3ef367
PP
151 );
152
37fa004c
PP
153
154 # My username
155 $me = getpwuid($<);
156
157}
158
159
160sub Query {
161
162 # Explain what perlbug is
163
164 paraprint <<EOF;
8ecf1a0c
KA
165This program provides an easy way to create a message reporting a bug
166in perl, and e-mail it to $address. It is *NOT* intended for
167sending test messages or simply verifying that perl works. It is *ONLY*
168a means of reporting verifiable problems with perl, and any solutions to
169such problems, to the people who maintain perl.
37fa004c
PP
170
171EOF
172
173
174 # Prompt for subject of message, if needed
175 if(! $subject) {
176 paraprint <<EOF;
177First of all, please provide a subject for the
ab3ef367
PP
178message. It should be a concise description of
179the bug or problem.
37fa004c
PP
180
181EOF
182 print "Subject: ";
183
184 $subject = <>;
185 chop $subject;
186
187 my($err)=0;
188 while( $subject =~ /^\s*$/ ) {
189 print "\nPlease enter a subject: ";
190 $subject = <>;
191 chop $subject;
192 if($err++>5) {
193 die "Aborting.\n";
194 }
195 }
196 }
197
198
199 # Prompt for return address, if needed
200 if( !$from) {
201
202 # Try and guess return address
c07a80fd
PP
203 my($domain);
204
205 if($::HaveUtil) {
206 $domain = Mail::Util::maildomain();
207 } elsif ($Is_VMS) {
208 require Sys::Hostname;
209 $domain = Sys::Hostname::hostname();
210 } else {
211 $domain = `hostname`.".".`domainname`;
212 $domain =~ s/[\r\n]+//g;
213 }
37fa004c
PP
214
215 my($guess);
216
217 if( !$domain) {
218 $guess = "";
bf9e8eaa 219 } elsif ($Is_VMS && !$::Config{'d_socket'}) {
c07a80fd 220 $guess = "$domain\:\:$me";
37fa004c 221 } else {
c07a80fd
PP
222 $guess = "$me\@$domain" if $domain;
223 $guess = "$me\@unknown.addresss" unless $domain;
37fa004c 224 }
a5f75d66
AD
225
226 $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
227 $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
37fa004c
PP
228
229 if( $guess ) {
230 paraprint <<EOF;
231
232
a5f75d66
AD
233Your e-mail address will be useful if you need to be contacted. If the
234default shown is not your full internet e-mail address, please correct it.
37fa004c
PP
235
236EOF
237 } else {
238 paraprint <<EOF;
239
240So that you may be contacted if necessary, please enter
a5f75d66 241your full internet e-mail address here.
37fa004c
PP
242
243EOF
244 }
245 print "Your address [$guess]: ";
246
247 $from = <>;
248 chop $from;
249
250 if($from eq "") { $from = $guess }
251
252 }
253
254 #if( $from =~ /^(.*)\@(.*)$/ ) {
255 # $mailname = $1;
256 # $maildomain = $2;
257 #}
258
259 if( $from eq $cc or $me eq $cc ) {
260 # Try not to copy ourselves
c07a80fd 261 $cc = "yourself";
37fa004c
PP
262 }
263
264
265 # Prompt for administrator address, unless an override was given
266 if( !$::opt_C and !$::opt_c ) {
267 paraprint <<EOF;
268
269
270A copy of this report can be sent to your local
271perl administrator. If the address is wrong, please
c07a80fd
PP
272correct it, or enter 'none' or 'yourself' to not send
273a copy.
37fa004c
PP
274
275EOF
276
277 print "Local perl administrator [$cc]: ";
278
279 my($entry) = scalar(<>);
280 chop $entry;
281
282 if($entry ne "") {
283 $cc = $entry;
284 if($me eq $cc) { $cc = "" }
285 }
286
287 }
288
84478119 289 if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
37fa004c
PP
290
291 $andcc = " and $cc" if $cc;
292
ab3ef367
PP
293editor:
294
37fa004c
PP
295 # Prompt for editor, if no override is given
296 if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
297 paraprint <<EOF;
298
299
c07a80fd 300Now you need to supply the bug report. Try to make
37fa004c 301the report concise but descriptive. Include any
ab3ef367
PP
302relevant detail. If you are reporting something
303that does not work as you think it should, please
304try to include example of both the actual
305result, and what you expected.
306
307Some information about your local
37fa004c 308perl configuration will automatically be included
ab3ef367
PP
309at the end of the report. If you are using any
310unusual version of perl, please try and confirm
311exactly which versions are relevant.
37fa004c
PP
312
313You will probably want to use an editor to enter
314the report. If "$ed" is the editor you want
315to use, then just press Enter, otherwise type in
316the name of the editor you would like to use.
317
c07a80fd 318If you would like to use a prepared file, type
37fa004c
PP
319"file", and you will be asked for the filename.
320
321EOF
322
323 print "Editor [$ed]: ";
324
325 my($entry) =scalar(<>);
326 chop $entry;
ab3ef367
PP
327
328 $usefile = 0;
329 if($entry eq "file") {
330 $usefile = 1;
331 } elsif($entry ne "") {
37fa004c
PP
332 $ed = $entry;
333 }
334 }
335
336
337 # Generate scratch file to edit report in
338
c07a80fd
PP
339 {
340 my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
341 $filename = "bugrep0$$";
342 $filename++ while -e "$dir$filename";
343 $filename = "$dir$filename";
344 }
37fa004c
PP
345
346
347 # Prompt for file to read report from, if needed
348
ab3ef367
PP
349 if( $usefile and ! $file) {
350filename:
37fa004c
PP
351 paraprint <<EOF;
352
37fa004c
PP
353What is the name of the file that contains your report?
354
355EOF
356
357 print "Filename: ";
358
359 my($entry) = scalar(<>);
360 chop($entry);
361
ab3ef367
PP
362 if($entry eq "") {
363 paraprint <<EOF;
364
365No filename? I'll let you go back and choose an editor again.
366
367EOF
368 goto editor;
369 }
370
37fa004c 371 if(!-f $entry or !-r $entry) {
ab3ef367
PP
372 paraprint <<EOF;
373
374I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
375the file? If you don't want to send a file, just enter a blank line and you
376can get back to the editor selection.
377
378EOF
379 goto filename;
37fa004c
PP
380 }
381 $file = $entry;
382
383 }
384
385
386 # Generate report
387
388 open(REP,">$filename");
389
390 print REP <<EOF;
391This is a bug report for perl from $from,
392generated with the help of perlbug $Version running under perl $].
393
394EOF
395
396 if($body) {
397 print REP $body;
ab3ef367
PP
398 } elsif($usefile) {
399 open(F,"<$file") or die "Unable to read report file from `$file': $!\n";
37fa004c
PP
400 while(<F>) {
401 print REP $_
402 }
403 close(F);
404 } else {
405 print REP "[Please enter your report here]\n";
406 }
c07a80fd
PP
407
408 Dump(*REP);
409 close(REP);
37fa004c 410
c07a80fd
PP
411}
412
413sub Dump {
414 local(*OUT) = @_;
415
416 print OUT <<EOF;
37fa004c
PP
417
418
419
420Site configuration information for perl $]:
421
422EOF
423
424 if( $::Config{cf_by} and $::Config{cf_time}) {
c07a80fd 425 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
37fa004c
PP
426 }
427
c07a80fd 428 print OUT Config::myconfig;
37fa004c
PP
429
430 if($verbose) {
c07a80fd 431 print OUT "\nComplete configuration data for perl $]:\n\n";
37fa004c
PP
432 my($value);
433 foreach (sort keys %::Config) {
434 $value = $::Config{$_};
435 $value =~ s/'/\\'/g;
c07a80fd 436 print OUT "$_='$value'\n";
37fa004c
PP
437 }
438 }
8ecf1a0c
KA
439 print OUT <<EOF;
440
441
442Environment for perl $]:
443EOF
444 for my $env (qw(PATH LD_LIBRARY_PATH
445 PERL5LIB PERLLIB PERL5DB
446 LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME
447 LANG PERL_BADLANG
448 SHELL HOME LOGDIR)) {
449 print OUT " $env",
450 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
451 "\n";
452 }
37fa004c
PP
453}
454
455sub Edit {
456 # Edit the report
ab3ef367
PP
457
458 if($usefile) {
459 $usefile = 0;
460 paraprint <<EOF;
461
462Please make sure that the name of the editor you want to use is correct.
463
464EOF
465 print "Editor [$ed]: ";
466
467 my($entry) =scalar(<>);
468 chop $entry;
37fa004c 469
ab3ef367
PP
470 if($entry ne "") {
471 $ed = $entry;
472 }
473 }
474
475tryagain:
476 if(!$usefile and !$body) {
c07a80fd
PP
477 my($sts) = system("$ed $filename");
478 if( $Is_VMS ? !($sts & 1) : $sts ) {
a5f75d66
AD
479 #print "\nUnable to run editor!\n";
480 paraprint <<EOF;
481
482The editor you chose (`$ed') could apparently not be run!
483Did you mistype the name of your editor? If so, please
484correct it here, otherwise just press Enter.
485
486EOF
487 print "Editor [$ed]: ";
488
489 my($entry) =scalar(<>);
490 chop $entry;
491
492 if($entry ne "") {
493 $ed = $entry;
494 goto tryagain;
495 } else {
496
497 paraprint <<EOF;
498
499You may want to save your report to a file, so you can edit and mail it
500yourself.
501EOF
502 }
37fa004c
PP
503 }
504 }
505}
506
507sub NowWhat {
508
509 # Report is done, prompt for further action
510 if( !$::opt_S ) {
511 while(1) {
512
513 paraprint <<EOF;
514
515
516Now that you have completed your report, would you like to send
517the message to $address$andcc, display the message on
518the screen, re-edit it, or cancel without sending anything?
519You may also save the message as a file to mail at another time.
520
521EOF
522
a5f75d66 523 print "Action (Send/Display/Edit/Cancel/Save to File): ";
37fa004c
PP
524 my($action) = scalar(<>);
525 chop $action;
526
a5f75d66 527 if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
37fa004c
PP
528 print "\n\nName of file to save message in [perlbug.rep]: ";
529 my($file) = scalar(<>);
530 chop $file;
531 if($file eq "") { $file = "perlbug.rep" }
532
533 open(FILE,">$file");
534 open(REP,"<$filename");
535 print FILE "To: $address\nSubject: $subject\n";
536 print FILE "Cc: $cc\n" if $cc;
537 print FILE "Reply-To: $from\n" if $from;
538 print FILE "\n";
539 while(<REP>) { print FILE }
540 close(REP);
541 close(FILE);
542
543 print "\nMessage saved in `$file'.\n";
544 exit;
545
a5f75d66 546 } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
37fa004c
PP
547 # Display the message
548 open(REP,"<$filename");
549 while(<REP>) { print $_ }
550 close(REP);
84478119 551 } elsif( $action =~ /^se/i ) { # <S>end
a5f75d66 552 # Send the message
84478119
PP
553 print "\
554Are you certain you want to send this message?
555Please type \"yes\" if you are: ";
556 my($reply) = scalar(<STDIN>);
557 chop($reply);
558 if( $reply eq "yes" ) {
559 last;
ab3ef367
PP
560 } else {
561 paraprint <<EOF;
562
563That wasn't a clear "yes", so I won't send your message. If you are sure
564your message should be sent, type in "yes" (without the quotes) at the
565confirmation prompt.
566
567EOF
568
84478119 569 }
a5f75d66 570 } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
37fa004c 571 # edit the message
a5f75d66
AD
572 Edit();
573 #system("$ed $filename");
574 } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
37fa004c
PP
575 1 while unlink($filename); # remove all versions under VMS
576 print "\nCancelling.\n";
577 exit(0);
84478119
PP
578 } elsif( $action =~ /^s/ ) {
579 paraprint <<EOF;
580
581I'm sorry, but I didn't understand that. Please type "send" or "save".
582EOF
37fa004c
PP
583 }
584
585 }
586 }
587}
588
589
590sub Send {
591
592 # Message has been accepted for transmission -- Send the message
c07a80fd
PP
593
594 if($::HaveSend) {
37fa004c 595
c07a80fd 596 $msg = new Mail::Send Subject => $subject, To => $address;
37fa004c 597
c07a80fd
PP
598 $msg->cc($cc) if $cc;
599 $msg->add("Reply-To",$from) if $from;
37fa004c 600
c07a80fd
PP
601 $fh = $msg->open;
602
603 open(REP,"<$filename");
604 while(<REP>) { print $fh $_ }
605 close(REP);
37fa004c 606
c07a80fd
PP
607 $fh->close;
608
609 } else {
610 if ($Is_VMS) {
611 if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
612 ($cc =~ /@/ and $cc !~ /^\w+%"/) ){
613 my($prefix);
614 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
615 $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
616 }
617 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
618 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
619 }
620 $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
621 my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
622 if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
623 } else {
624 my($sendmail) = "";
625
626 foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
627 {
628 $sendmail = $_, last if -e $_;
629 }
630
631 paraprint <<"EOF" and die "\n" if $sendmail eq "";
632
633I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
634the perl package Mail::Send has not been installed, so I can't send your bug
635report. We apologize for the inconveniencence.
636
637So you may attempt to find some way of sending your message, it has
638been left in the file `$filename'.
639
640EOF
641
642 open(SENDMAIL,"|$sendmail -t");
643 print SENDMAIL "To: $address\n";
644 print SENDMAIL "Subject: $subject\n";
645 print SENDMAIL "Cc: $cc\n" if $cc;
646 print SENDMAIL "Reply-To: $from\n" if $from;
647 print SENDMAIL "\n\n";
648 open(REP,"<$filename");
649 while(<REP>) { print SENDMAIL $_ }
650 close(REP);
651
652 close(SENDMAIL);
653 }
37fa004c 654
c07a80fd 655 }
37fa004c
PP
656
657 print "\nMessage sent.\n";
658
659 1 while unlink($filename); # remove all versions under VMS
660
661}
662
663sub Help {
664 print <<EOF;
665
666A program to help generate bug reports about perl5, and mail them.
667It is designed to be used interactively. Normally no arguments will
668be needed.
669
670Usage:
671$0 [-v] [-a address] [-s subject] [-b body | -f file ]
672 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
673
c07a80fd 674Simplest usage: run "$0", and follow the prompts.
37fa004c
PP
675
676Options:
677
678 -v Include Verbose configuration data in the report
679 -f File containing the body of the report. Use this to
680 quickly send a prepared message.
681 -S Send without asking for confirmation.
682 -a Address to send the report to. Defaults to `$address'.
683 -c Address to send copy of report to. Defaults to `$cc'.
684 -C Don't send copy to administrator.
685 -s Subject to include with the message. You will be prompted
686 if you don't supply one on the command line.
687 -b Body of the report. If not included on the command line, or
688 in a file with -f, you will get a chance to edit the message.
689 -r Your return address. The program will ask you to confirm
690 this if you don't give it here.
691 -e Editor to use.
692 -t Test mode. The target address defaults to `$testaddress'.
c07a80fd
PP
693 -d Data mode (the default if you redirect or pipe output.)
694 This prints out your configuration data, without mailing
695 anything. You can use this with -v to get more complete data.
37fa004c
PP
696
697EOF
698}
699
700sub paraprint {
701 my @paragraphs = split /\n{2,}/, "@_";
c07a80fd 702 print "\n\n";
37fa004c
PP
703 for (@paragraphs) { # implicit local $_
704 s/(\S)\s*\n/$1 /g;
705 write;
706 print "\n";
707 }
708
709}
710
711
712format STDOUT =
713^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
714$_
715.
716!NO!SUBS!
717
718close OUT or die "Can't close $file: $!";
719chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
720exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';