This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
New utility.
[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.
15chdir(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
21open OUT,">$file" or die "Can't create $file: $!";
22
23print "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
28print 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
36print OUT <<'!NO!SUBS!';
37
38use Config;
39use Mail::Send;
40use Mail::Util;
41use Getopt::Std;
42
43use strict;
44
45sub paraprint;
46
47my($Version) = "1.06";
48
49my( $file, $cc, $address, $perlbug, $testaddress, $filename,
50 $subject, $from, $verbose, $ed,
51 $fh, $me, $Is_VMS, $msg, $body, $andcc );
52
53Init();
54
55if($::opt_h) { Help(); exit; }
56
57Query();
58Edit();
59NowWhat();
60Send();
61
62exit;
63
64sub Init {
65
66 # -------- Setup --------
67
68 $Is_VMS = $::Config{'osname'} eq 'VMS';
69
70 getopts("hva:s:b:f:r:e:SCc:t");
71
72
73 # This comment is needed to notify metaconfig that we are
74 # using the $perladmin, $cf_by, and $cf_time definitions.
75
76
77 # -------- Configuration ---------
78
79 # perlbug address
80 $perlbug = 'perlbug@perl.com';
81
82 # Test address
83 $testaddress = 'perlbug-test@perl.com';
84
85 # Target address
86 $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
87
88 # Possible administrator addresses, in order of confidence
89 # (Note that cf_email is not mentioned to metaconfig, since
90 # we don't really want it. We'll just take it if we have to.)
91 $cc = ($::opt_C ? "" : (
92 $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
93 ));
94
95 # Users address, used in message and in Reply-To header
96 $from = $::opt_r || "";
97
98 # Include verbose configuration information
99 $verbose = $::opt_v || 0;
100
101 # Subject of bug-report message
102 $subject = $::opt_s || "";
103
104 # File to send as report
105 $file = $::opt_f || "";
106
107 # Body of report
108 $body = $::opt_b || "";
109
110 # Editor
111 $ed = ($::opt_f ? "file" : (
112 $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
113 ($Is_VMS ? "edit/tpu" : "vi")
114 ));
115
116 # My username
117 $me = getpwuid($<);
118
119}
120
121
122sub Query {
123
124 # Explain what perlbug is
125
126 paraprint <<EOF;
127This program allows you to enter a bug report,
128which will be sent as an e-mail message to $address
129once you have filled in the report.
130
131EOF
132
133
134 # Prompt for subject of message, if needed
135 if(! $subject) {
136 paraprint <<EOF;
137First of all, please provide a subject for the
138message. It should be concise description of the bug,
139if at all possible.
140
141EOF
142 print "Subject: ";
143
144 $subject = <>;
145 chop $subject;
146
147 my($err)=0;
148 while( $subject =~ /^\s*$/ ) {
149 print "\nPlease enter a subject: ";
150 $subject = <>;
151 chop $subject;
152 if($err++>5) {
153 die "Aborting.\n";
154 }
155 }
156 }
157
158
159 # Prompt for return address, if needed
160 if( !$from) {
161
162 # Try and guess return address
163 my($domain) = Mail::Util::maildomain();
164
165 my($guess);
166
167 if( !$domain) {
168 $guess = "";
169 } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) {
170 $guess = "$domain$me";
171 } else {
172 $guess = "$me\@$domain" if $domain;
173 $guess = "$me\@unknown.addresss" unless $domain;
174 }
175
176 if( $guess ) {
177 paraprint <<EOF;
178
179
180Your e-mail address will be useful if you need to be contacted.
181If the default is not your proper address, please correct it here.
182
183EOF
184 } else {
185 paraprint <<EOF;
186
187So that you may be contacted if necessary, please enter
188your e-mail address here.
189
190EOF
191 }
192 print "Your address [$guess]: ";
193
194 $from = <>;
195 chop $from;
196
197 if($from eq "") { $from = $guess }
198
199 }
200
201 #if( $from =~ /^(.*)\@(.*)$/ ) {
202 # $mailname = $1;
203 # $maildomain = $2;
204 #}
205
206 if( $from eq $cc or $me eq $cc ) {
207 # Try not to copy ourselves
208 $cc = "none";
209 }
210
211
212 # Prompt for administrator address, unless an override was given
213 if( !$::opt_C and !$::opt_c ) {
214 paraprint <<EOF;
215
216
217A copy of this report can be sent to your local
218perl administrator. If the address is wrong, please
219correct it, or enter 'none' to not send a copy.
220
221EOF
222
223 print "Local perl administrator [$cc]: ";
224
225 my($entry) = scalar(<>);
226 chop $entry;
227
228 if($entry ne "") {
229 $cc = $entry;
230 if($me eq $cc) { $cc = "" }
231 }
232
233 }
234
235 if($cc eq "none") { $cc = "" }
236
237 $andcc = " and $cc" if $cc;
238
239
240 # Prompt for editor, if no override is given
241 if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
242 paraprint <<EOF;
243
244
245Now you need to enter the bug report. Try to make
246the report concise but descriptive. Include any
247relevant detail. Some information about your local
248perl configuration will automatically be included
249at the end of the report.
250
251You will probably want to use an editor to enter
252the report. If "$ed" is the editor you want
253to use, then just press Enter, otherwise type in
254the name of the editor you would like to use.
255
256If you would like to use a prepared file, just enter
257"file", and you will be asked for the filename.
258
259EOF
260
261 print "Editor [$ed]: ";
262
263 my($entry) =scalar(<>);
264 chop $entry;
265
266 if($entry ne "") {
267 $ed = $entry;
268 }
269 }
270
271
272 # Generate scratch file to edit report in
273
274 $filename = ($Is_VMS ? 'sys$scratch:' : '/tmp/') . "bugrep0$$";
275 $filename++ while -e $filename;
276
277
278 # Prompt for file to read report from, if needed
279
280 if( $ed eq "file" and ! $file) {
281 paraprint <<EOF;
282
283
284What is the name of the file that contains your report?
285
286EOF
287
288 print "Filename: ";
289
290 my($entry) = scalar(<>);
291 chop($entry);
292
293 if(!-f $entry or !-r $entry) {
294 print "\n\nUnable to read `$entry'.\nExiting.\n";
295 exit;
296 }
297 $file = $entry;
298
299 }
300
301
302 # Generate report
303
304 open(REP,">$filename");
305
306 print REP <<EOF;
307This is a bug report for perl from $from,
308generated with the help of perlbug $Version running under perl $].
309
310EOF
311
312 if($body) {
313 print REP $body;
314 } elsif($file) {
315 open(F,"<$file") or die "Unable to read report file: $!\n";
316 while(<F>) {
317 print REP $_
318 }
319 close(F);
320 } else {
321 print REP "[Please enter your report here]\n";
322 }
323
324 print REP <<EOF;
325
326
327
328Site configuration information for perl $]:
329
330EOF
331
332 if( $::Config{cf_by} and $::Config{cf_time}) {
333 print REP "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
334 }
335
336 print REP Config::myconfig;
337
338 if($verbose) {
339 print REP "\nComplete configuration data for perl $]:\n\n";
340 my($value);
341 foreach (sort keys %::Config) {
342 $value = $::Config{$_};
343 $value =~ s/'/\\'/g;
344 print REP "$_='$value'\n";
345 }
346 }
347
348 close(REP);
349}
350
351sub Edit {
352 # Edit the report
353
354 if(!$file and !$body) {
355 if( system("$ed $filename") ) {
356 print "\nUnabled to run editor!\n";
357 }
358 }
359}
360
361sub NowWhat {
362
363 # Report is done, prompt for further action
364 if( !$::opt_S ) {
365 while(1) {
366
367 paraprint <<EOF;
368
369
370Now that you have completed your report, would you like to send
371the message to $address$andcc, display the message on
372the screen, re-edit it, or cancel without sending anything?
373You may also save the message as a file to mail at another time.
374
375EOF
376
377 print "Action (Send/Display/Edit/Cancel/File): ";
378 my($action) = scalar(<>);
379 chop $action;
380
381 if($action =~ /^s/i) { # Send
382 # Send the message
383 last;
384 } elsif($action =~ /^f/i) { # File
385 print "\n\nName of file to save message in [perlbug.rep]: ";
386 my($file) = scalar(<>);
387 chop $file;
388 if($file eq "") { $file = "perlbug.rep" }
389
390 open(FILE,">$file");
391 open(REP,"<$filename");
392 print FILE "To: $address\nSubject: $subject\n";
393 print FILE "Cc: $cc\n" if $cc;
394 print FILE "Reply-To: $from\n" if $from;
395 print FILE "\n";
396 while(<REP>) { print FILE }
397 close(REP);
398 close(FILE);
399
400 print "\nMessage saved in `$file'.\n";
401 exit;
402
403 } elsif($action =~ /^[drl]/i) { # Display, Redisplay, List
404 # Display the message
405 open(REP,"<$filename");
406 while(<REP>) { print $_ }
407 close(REP);
408 } elsif($action =~ /^e/i) { # Edit
409 # edit the message
410 system("$ed $filename");
411 } elsif($action =~ /^[qc]/i) { # Cancel, Quit
412 1 while unlink($filename); # remove all versions under VMS
413 print "\nCancelling.\n";
414 exit(0);
415 }
416
417 }
418 }
419}
420
421
422sub Send {
423
424 # Message has been accepted for transmission -- Send the message
425
426 $msg = new Mail::Send Subject => $subject, To => $address;
427
428 $msg->cc($cc) if $cc;
429 $msg->add("Reply-To",$from) if $from;
430
431 $fh = $msg->open;
432
433 open(REP,"<$filename");
434 while(<REP>) { print $fh $_ }
435 close(REP);
436
437 $fh->close;
438
439 print "\nMessage sent.\n";
440
441 1 while unlink($filename); # remove all versions under VMS
442
443}
444
445sub Help {
446 print <<EOF;
447
448A program to help generate bug reports about perl5, and mail them.
449It is designed to be used interactively. Normally no arguments will
450be needed.
451
452Usage:
453$0 [-v] [-a address] [-s subject] [-b body | -f file ]
454 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
455
456Simplest usage: execute "$0", and follow the prompts.
457
458Options:
459
460 -v Include Verbose configuration data in the report
461 -f File containing the body of the report. Use this to
462 quickly send a prepared message.
463 -S Send without asking for confirmation.
464 -a Address to send the report to. Defaults to `$address'.
465 -c Address to send copy of report to. Defaults to `$cc'.
466 -C Don't send copy to administrator.
467 -s Subject to include with the message. You will be prompted
468 if you don't supply one on the command line.
469 -b Body of the report. If not included on the command line, or
470 in a file with -f, you will get a chance to edit the message.
471 -r Your return address. The program will ask you to confirm
472 this if you don't give it here.
473 -e Editor to use.
474 -t Test mode. The target address defaults to `$testaddress'.
475
476EOF
477}
478
479sub paraprint {
480 my @paragraphs = split /\n{2,}/, "@_";
481 print "\n";
482 for (@paragraphs) { # implicit local $_
483 s/(\S)\s*\n/$1 /g;
484 write;
485 print "\n";
486 }
487
488}
489
490
491format STDOUT =
492^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
493$_
494.
495!NO!SUBS!
496
497close OUT or die "Can't close $file: $!";
498chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
499exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';