perl5.002beta3
[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 ($Config{'osname'} eq 'VMS' or
19             $Config{'osname'} eq 'OS2');  # "case-forgiving"
20
21 open OUT,">$file" or die "Can't create $file: $!";
22
23 print "Extracting $file (with variable substitutions)\n";
24
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
27
28 print OUT <<"!GROK!THIS!";
29 $Config{'startperl'}
30     eval 'exec perl -S \$0 "\$@"'
31         if 0;
32 !GROK!THIS!
33
34 # In the following, perl variables are not expanded during extraction.
35
36 print OUT <<'!NO!SUBS!';
37
38 use Config;
39 use Getopt::Std;
40
41 BEGIN {
42         eval "use Mail::Send;";
43         $::HaveSend = ($@ eq "");
44         eval "use Mail::Util;";
45         $::HaveUtil = ($@ eq "");
46 };
47
48
49 use strict;
50
51 sub paraprint;
52
53
54 my($Version) = "1.11";
55
56 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
57 # Changed in 1.07 to see more sendmail execs, and added pipe output
58 # Changed in 1.08 to use correct address for sendmail
59 # Changed in 1.09 to close the REP file before calling it up in the editor.
60 #                 Also removed some old comments duplicated elsewhere.
61 # Changed in 1.10 to run under VMS without Mail::Send; also fixed
62 #                 temp filename generation
63 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
64
65 # TODO: Allow the user to re-name the file on mail failure, and
66 #       make sure failure (transmission-wise) of Mail::Send is 
67 #       accounted for.
68
69 my( $file, $cc, $address, $perlbug, $testaddress, $filename,
70     $subject, $from, $verbose, $ed, 
71     $fh, $me, $Is_VMS, $msg, $body, $andcc );
72
73 Init();
74
75 if($::opt_h) { Help(); exit; }
76
77 if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
78
79 Query();
80 Edit();
81 NowWhat();
82 Send();
83
84 exit;
85
86 sub Init {
87  
88         # -------- Setup --------
89
90         $Is_VMS = $::Config{'osname'} eq 'VMS';
91
92         getopts("dhva:s:b:f:r:e:SCc:t");
93         
94
95         # This comment is needed to notify metaconfig that we are
96         # using the $perladmin, $cf_by, and $cf_time definitions.
97
98
99         # -------- Configuration ---------
100         
101         # perlbug address
102         $perlbug = 'perlbug@perl.com';
103         
104         # Test address
105         $testaddress = 'perlbug-test@perl.com';
106         
107         # Target address
108         $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
109
110         # Possible administrator addresses, in order of confidence
111         # (Note that cf_email is not mentioned to metaconfig, since
112         # we don't really want it. We'll just take it if we have to.)
113         $cc = ($::opt_C ? "" : (
114                 $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
115                 ));
116         
117         # Users address, used in message and in Reply-To header
118         $from = $::opt_r || "";
119
120         # Include verbose configuration information
121         $verbose = $::opt_v || 0;
122
123         # Subject of bug-report message
124         $subject = $::opt_s || "";
125
126         # File to send as report
127         $file = $::opt_f || "";
128
129         # Body of report
130         $body = $::opt_b || "";
131
132         # Editor
133         $ed = ($::opt_f ? "file" : (
134                         $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} || 
135                       ($Is_VMS ? "edit/tpu" : "vi")
136               ));
137       
138         # My username
139         $me = getpwuid($<);
140
141 }
142
143
144 sub Query {
145
146         # Explain what perlbug is
147         
148         paraprint <<EOF;
149 This program allows you to create a bug report,
150 which will be sent as an e-mail message to $address
151 once you have filled in the report.
152
153 EOF
154
155
156         # Prompt for subject of message, if needed
157         if(! $subject) {
158                 paraprint <<EOF;
159 First of all, please provide a subject for the 
160 message. It should be as a concise description of 
161 the bug as is possible.
162
163 EOF
164                 print "Subject: ";
165         
166                 $subject = <>;
167                 chop $subject;
168         
169                 my($err)=0;
170                 while( $subject =~ /^\s*$/ ) {
171                         print "\nPlease enter a subject: ";
172                         $subject = <>;
173                         chop $subject;
174                         if($err++>5) {
175                                 die "Aborting.\n";
176                         }
177                 }
178         }
179         
180
181         # Prompt for return address, if needed
182         if( !$from) {
183
184                 # Try and guess return address
185                 my($domain);
186                 
187                 if($::HaveUtil) {
188                         $domain = Mail::Util::maildomain();
189                 } elsif ($Is_VMS) {
190                         require Sys::Hostname;
191                         $domain = Sys::Hostname::hostname();
192                 } else {
193                         $domain = `hostname`.".".`domainname`;
194                         $domain =~ s/[\r\n]+//g;
195                 }
196             
197             my($guess);
198                              
199                 if( !$domain) {
200                         $guess = "";
201                 } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) { 
202                         $guess = "$domain\:\:$me";
203                 } else {
204                         $guess = "$me\@$domain" if $domain;
205                         $guess = "$me\@unknown.addresss" unless $domain;
206                         }
207         
208                 if( $guess ) {
209                         paraprint <<EOF;
210
211
212 Your e-mail address will be useful if you need to be contacted.
213 If the default shown is not your proper address, please correct it.
214
215 EOF
216                 } else {
217                         paraprint <<EOF;
218
219 So that you may be contacted if necessary, please enter 
220 your e-mail address here.
221
222 EOF
223                 }
224                 print "Your address [$guess]: ";
225         
226                 $from = <>;
227                 chop $from;
228         
229                 if($from eq "") { $from = $guess }
230         
231         }
232         
233         #if( $from =~ /^(.*)\@(.*)$/ ) {
234         #       $mailname = $1;
235         #       $maildomain = $2;
236         #}
237
238         if( $from eq $cc or $me eq $cc ) {
239                 # Try not to copy ourselves
240                 $cc = "yourself";
241         }
242
243
244         # Prompt for administrator address, unless an override was given
245         if( !$::opt_C and !$::opt_c ) {
246                 paraprint <<EOF;
247
248
249 A copy of this report can be sent to your local
250 perl administrator. If the address is wrong, please 
251 correct it, or enter 'none' or 'yourself' to not send
252 a copy.
253
254 EOF
255
256                 print "Local perl administrator [$cc]: ";
257         
258                 my($entry) = scalar(<>);
259                 chop $entry;
260         
261                 if($entry ne "") {
262                         $cc = $entry;
263                         if($me eq $cc) { $cc = "" }
264                 }
265         
266         }
267
268         if($cc =~ /^(none|yourself|myself|ourselves)$/i) { $cc = "" }
269
270         $andcc = " and $cc" if $cc;
271
272
273         # Prompt for editor, if no override is given
274         if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
275                 paraprint <<EOF;
276
277
278 Now you need to supply the bug report. Try to make
279 the report concise but descriptive. Include any 
280 relevant detail. Some information about your local
281 perl configuration will automatically be included 
282 at the end of the report. 
283
284 You will probably want to use an editor to enter
285 the report. If "$ed" is the editor you want
286 to use, then just press Enter, otherwise type in
287 the name of the editor you would like to use.
288
289 If you would like to use a prepared file, type
290 "file", and you will be asked for the filename.
291
292 EOF
293
294                 print "Editor [$ed]: ";
295         
296                 my($entry) =scalar(<>);
297                 chop $entry;
298         
299                 if($entry ne "") {
300                         $ed = $entry;
301                 } 
302         }
303
304
305         # Generate scratch file to edit report in
306         
307         {
308         my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
309         $filename = "bugrep0$$";
310         $filename++ while -e "$dir$filename";
311         $filename = "$dir$filename";
312         }
313         
314         
315         # Prompt for file to read report from, if needed
316         
317         if( $ed eq "file" and ! $file) {
318                 paraprint <<EOF;
319
320
321 What is the name of the file that contains your report?
322
323 EOF
324
325                 print "Filename: ";
326         
327                 my($entry) = scalar(<>);
328                 chop($entry);
329
330                 if(!-f $entry or !-r $entry) {
331                         print "\n\nUnable to read from `$entry'.\nExiting.\n";
332                         exit;
333                 }
334                 $file = $entry;
335
336         }
337
338
339         # Generate report
340
341         open(REP,">$filename");
342
343         print REP <<EOF;
344 This is a bug report for perl from $from,
345 generated with the help of perlbug $Version running under perl $].
346
347 EOF
348
349         if($body) {
350                 print REP $body;
351         } elsif($file) {
352                 open(F,"<$file") or die "Unable to read report file: $!\n";
353                 while(<F>) {
354                 print REP $_
355                 }
356                 close(F);
357         } else {
358                 print REP "[Please enter your report here]\n";
359         }
360         
361         Dump(*REP);
362         close(REP);
363
364 }
365
366 sub Dump {
367         local(*OUT) = @_;
368         
369         print OUT <<EOF;
370
371
372
373 Site configuration information for perl $]:
374
375 EOF
376
377         if( $::Config{cf_by} and $::Config{cf_time}) {
378                 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
379         }
380
381         print OUT Config::myconfig;
382
383         if($verbose) {
384                 print OUT "\nComplete configuration data for perl $]:\n\n";
385                 my($value);
386                 foreach (sort keys %::Config) {
387                         $value = $::Config{$_};
388                         $value =~ s/'/\\'/g;
389                         print OUT "$_='$value'\n";
390                 }
391         }
392 }
393
394 sub Edit {
395         # Edit the report
396         
397         if(!$file and !$body) {
398                 my($sts) = system("$ed $filename");
399                 if( $Is_VMS ? !($sts & 1) : $sts ) {
400                         print "\nUnable to run editor!\n";
401                 } 
402         }
403 }
404
405 sub NowWhat {
406
407         # Report is done, prompt for further action
408         if( !$::opt_S ) {
409                 while(1) {
410
411                         paraprint <<EOF;
412
413
414 Now that you have completed your report, would you like to send 
415 the message to $address$andcc, display the message on 
416 the screen, re-edit it, or cancel without sending anything?
417 You may also save the message as a file to mail at another time.
418
419 EOF
420
421                         print "Action (Send/Display/Edit/Cancel/File): ";
422                         my($action) = scalar(<>);
423                         chop $action;
424
425                         if($action =~ /^s/i) { # Send
426                                 # Send the message
427                                 last;
428                         } elsif($action =~ /^f/i) { # File
429                                 print "\n\nName of file to save message in [perlbug.rep]: ";
430                                 my($file) = scalar(<>);
431                                 chop $file;
432                                 if($file eq "") { $file = "perlbug.rep" }
433                         
434                                 open(FILE,">$file");
435                                 open(REP,"<$filename");
436                                 print FILE "To: $address\nSubject: $subject\n";
437                                 print FILE "Cc: $cc\n" if $cc;
438                                 print FILE "Reply-To: $from\n" if $from;
439                                 print FILE "\n";
440                                 while(<REP>) { print FILE }
441                                 close(REP);
442                                 close(FILE);
443         
444                                 print "\nMessage saved in `$file'.\n";
445                                 exit;
446
447                         } elsif($action =~ /^[drl]/i) { # Display, Redisplay, List
448                                 # Display the message
449                                 open(REP,"<$filename");
450                                 while(<REP>) { print $_ }
451                                 close(REP);
452                         } elsif($action =~ /^e/i) { # Edit
453                                 # edit the message
454                                 system("$ed $filename");
455                         } elsif($action =~ /^[qc]/i) { # Cancel, Quit
456                                 1 while unlink($filename);  # remove all versions under VMS
457                                 print "\nCancelling.\n";
458                                 exit(0);
459                         }
460                 
461                 }
462         }
463 }
464
465
466 sub Send {
467
468         # Message has been accepted for transmission -- Send the message
469         
470         if($::HaveSend) {
471
472                 $msg = new Mail::Send Subject => $subject, To => $address;
473         
474                 $msg->cc($cc) if $cc;
475                 $msg->add("Reply-To",$from) if $from;
476             
477                 $fh = $msg->open;
478
479                 open(REP,"<$filename");
480                 while(<REP>) { print $fh $_ }
481                 close(REP);
482         
483                 $fh->close;  
484         
485         } else {
486                 if ($Is_VMS) {
487                         if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
488                              ($cc      =~ /@/ and $cc      !~ /^\w+%"/) ){
489                                 my($prefix);
490                                 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
491                                         $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
492                                 }
493                                 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
494                                 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
495                         }
496                         $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
497                         my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
498                         if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
499                 } else {
500                         my($sendmail) = "";
501                         
502                         foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
503                         {
504                                 $sendmail = $_, last if -e $_;
505                         }
506                         
507                         paraprint <<"EOF" and die "\n" if $sendmail eq "";
508                         
509 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
510 the perl package Mail::Send has not been installed, so I can't send your bug
511 report. We apologize for the inconveniencence.
512
513 So you may attempt to find some way of sending your message, it has
514 been left in the file `$filename'.
515
516 EOF
517                         
518                         open(SENDMAIL,"|$sendmail -t");
519                         print SENDMAIL "To: $address\n";
520                         print SENDMAIL "Subject: $subject\n";
521                         print SENDMAIL "Cc: $cc\n" if $cc;
522                         print SENDMAIL "Reply-To: $from\n" if $from;
523                         print SENDMAIL "\n\n";
524                         open(REP,"<$filename");
525                         while(<REP>) { print SENDMAIL $_ }
526                         close(REP);
527                         
528                         close(SENDMAIL);
529                 }
530         
531         }
532         
533         print "\nMessage sent.\n";
534
535         1 while unlink($filename);  # remove all versions under VMS
536
537 }
538
539 sub Help {
540         print <<EOF; 
541
542 A program to help generate bug reports about perl5, and mail them. 
543 It is designed to be used interactively. Normally no arguments will
544 be needed.
545         
546 Usage:
547 $0  [-v] [-a address] [-s subject] [-b body | -f file ]
548     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
549     
550 Simplest usage:  run "$0", and follow the prompts.
551
552 Options:
553
554   -v    Include Verbose configuration data in the report
555   -f    File containing the body of the report. Use this to 
556         quickly send a prepared message.
557   -S    Send without asking for confirmation.
558   -a    Address to send the report to. Defaults to `$address'.
559   -c    Address to send copy of report to. Defaults to `$cc'.
560   -C    Don't send copy to administrator.
561   -s    Subject to include with the message. You will be prompted 
562         if you don't supply one on the command line.
563   -b    Body of the report. If not included on the command line, or
564         in a file with -f, you will get a chance to edit the message.
565   -r    Your return address. The program will ask you to confirm
566         this if you don't give it here.
567   -e    Editor to use. 
568   -t    Test mode. The target address defaults to `$testaddress'.
569   -d    Data mode (the default if you redirect or pipe output.) 
570         This prints out your configuration data, without mailing
571         anything. You can use this with -v to get more complete data.
572   
573 EOF
574 }
575
576 sub paraprint {
577     my @paragraphs = split /\n{2,}/, "@_";
578     print "\n\n";
579     for (@paragraphs) {   # implicit local $_
580         s/(\S)\s*\n/$1 /g;
581             write;
582             print "\n";
583     }
584                        
585 }
586                             
587
588 format STDOUT =
589 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
590 $_
591 .
592 !NO!SUBS!
593
594 close OUT or die "Can't close $file: $!";
595 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
596 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';