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