4 use File::Basename qw(&basename &dirname);
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
11 # to ensure Configure will look for $Config{startperl}.
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.
16 $file = basename($0, '.PL');
18 open OUT,">$file" or die "Can't create $file: $!";
20 print "Extracting $file (with variable substitutions)\n";
22 # In this section, perl variables will be expanded during extraction.
23 # You can use $Config{...} to use Configure variables.
25 print OUT <<"!GROK!THIS!";
27 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
28 if \$running_under_some_shell;
31 # In the following, perl variables are not expanded during extraction.
33 print OUT <<'!NO!SUBS!';
39 eval "use Mail::Send;";
40 $::HaveSend = ($@ eq "");
41 eval "use Mail::Util;";
42 $::HaveUtil = ($@ eq "");
51 my($Version) = "1.14";
53 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
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.
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
59 # temp filename generation.
60 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
61 # Changed in 1.12 to check for editor errors, make save/send distinction
62 # clearer and add $ENV{REPLYTO}.
63 # Changed in 1.13 to hopefully make it more difficult to accidentally
65 # Changed in 1.14 to make the prompts a little more clear on providing
66 # helpful information. Also let file read fail gracefully.
68 # TODO: Allow the user to re-name the file on mail failure, and
69 # make sure failure (transmission-wise) of Mail::Send is
72 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
73 $subject, $from, $verbose, $ed,
74 $fh, $me, $Is_VMS, $msg, $body, $andcc );
78 if($::opt_h) { Help(); exit; }
82 Please use perlbug interactively. If you want to
83 include a file, you can use the -f switch.
88 if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
91 Edit() unless $usefile;
99 # -------- Setup --------
101 $Is_VMS = $^O eq 'VMS';
103 getopts("dhva:s:b:f:r:e:SCc:t");
106 # This comment is needed to notify metaconfig that we are
107 # using the $perladmin, $cf_by, and $cf_time definitions.
110 # -------- Configuration ---------
113 $perlbug = 'perlbug@perl.com';
116 $testaddress = 'perlbug-test@perl.com';
119 $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
121 # Possible administrator addresses, in order of confidence
122 # (Note that cf_email is not mentioned to metaconfig, since
123 # we don't really want it. We'll just take it if we have to.)
124 $cc = ($::opt_C ? "" : (
125 $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
128 # Users address, used in message and in Reply-To header
129 $from = $::opt_r || "";
131 # Include verbose configuration information
132 $verbose = $::opt_v || 0;
134 # Subject of bug-report message
135 $subject = $::opt_s || "";
138 $usefile = ($::opt_f || 0);
140 # File to send as report
141 $file = $::opt_f || "";
144 $body = $::opt_b || "";
147 $ed = ( $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
148 ($Is_VMS ? "edit/tpu" : "vi")
160 # Explain what perlbug is
163 This program provides an easy way to create a message reporting a bug in
164 perl, and e-mail it to $address.
169 # Prompt for subject of message, if needed
172 First of all, please provide a subject for the
173 message. It should be a concise description of
183 while( $subject =~ /^\s*$/ ) {
184 print "\nPlease enter a subject: ";
194 # Prompt for return address, if needed
197 # Try and guess return address
201 $domain = Mail::Util::maildomain();
203 require Sys::Hostname;
204 $domain = Sys::Hostname::hostname();
206 $domain = `hostname`.".".`domainname`;
207 $domain =~ s/[\r\n]+//g;
214 } elsif ($Is_VMS && !$::Config{'d_socket'}) {
215 $guess = "$domain\:\:$me";
217 $guess = "$me\@$domain" if $domain;
218 $guess = "$me\@unknown.addresss" unless $domain;
221 $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
222 $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
228 Your e-mail address will be useful if you need to be contacted. If the
229 default shown is not your full internet e-mail address, please correct it.
235 So that you may be contacted if necessary, please enter
236 your full internet e-mail address here.
240 print "Your address [$guess]: ";
245 if($from eq "") { $from = $guess }
249 #if( $from =~ /^(.*)\@(.*)$/ ) {
254 if( $from eq $cc or $me eq $cc ) {
255 # Try not to copy ourselves
260 # Prompt for administrator address, unless an override was given
261 if( !$::opt_C and !$::opt_c ) {
265 A copy of this report can be sent to your local
266 perl administrator. If the address is wrong, please
267 correct it, or enter 'none' or 'yourself' to not send
272 print "Local perl administrator [$cc]: ";
274 my($entry) = scalar(<>);
279 if($me eq $cc) { $cc = "" }
284 if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
286 $andcc = " and $cc" if $cc;
290 # Prompt for editor, if no override is given
291 if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
295 Now you need to supply the bug report. Try to make
296 the report concise but descriptive. Include any
297 relevant detail. If you are reporting something
298 that does not work as you think it should, please
299 try to include example of both the actual
300 result, and what you expected.
302 Some information about your local
303 perl configuration will automatically be included
304 at the end of the report. If you are using any
305 unusual version of perl, please try and confirm
306 exactly which versions are relevant.
308 You will probably want to use an editor to enter
309 the report. If "$ed" is the editor you want
310 to use, then just press Enter, otherwise type in
311 the name of the editor you would like to use.
313 If you would like to use a prepared file, type
314 "file", and you will be asked for the filename.
318 print "Editor [$ed]: ";
320 my($entry) =scalar(<>);
324 if($entry eq "file") {
326 } elsif($entry ne "") {
332 # Generate scratch file to edit report in
335 my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
336 $filename = "bugrep0$$";
337 $filename++ while -e "$dir$filename";
338 $filename = "$dir$filename";
342 # Prompt for file to read report from, if needed
344 if( $usefile and ! $file) {
348 What is the name of the file that contains your report?
354 my($entry) = scalar(<>);
360 No filename? I'll let you go back and choose an editor again.
366 if(!-f $entry or !-r $entry) {
369 I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
370 the file? If you don't want to send a file, just enter a blank line and you
371 can get back to the editor selection.
383 open(REP,">$filename");
386 This is a bug report for perl from $from,
387 generated with the help of perlbug $Version running under perl $].
394 open(F,"<$file") or die "Unable to read report file from `$file': $!\n";
400 print REP "[Please enter your report here]\n";
415 Site configuration information for perl $]:
419 if( $::Config{cf_by} and $::Config{cf_time}) {
420 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
423 print OUT Config::myconfig;
426 print OUT "\nComplete configuration data for perl $]:\n\n";
428 foreach (sort keys %::Config) {
429 $value = $::Config{$_};
431 print OUT "$_='$value'\n";
443 Please make sure that the name of the editor you want to use is correct.
446 print "Editor [$ed]: ";
448 my($entry) =scalar(<>);
457 if(!$usefile and !$body) {
458 my($sts) = system("$ed $filename");
459 if( $Is_VMS ? !($sts & 1) : $sts ) {
460 #print "\nUnable to run editor!\n";
463 The editor you chose (`$ed') could apparently not be run!
464 Did you mistype the name of your editor? If so, please
465 correct it here, otherwise just press Enter.
468 print "Editor [$ed]: ";
470 my($entry) =scalar(<>);
480 You may want to save your report to a file, so you can edit and mail it
490 # Report is done, prompt for further action
497 Now that you have completed your report, would you like to send
498 the message to $address$andcc, display the message on
499 the screen, re-edit it, or cancel without sending anything?
500 You may also save the message as a file to mail at another time.
504 print "Action (Send/Display/Edit/Cancel/Save to File): ";
505 my($action) = scalar(<>);
508 if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
509 print "\n\nName of file to save message in [perlbug.rep]: ";
510 my($file) = scalar(<>);
512 if($file eq "") { $file = "perlbug.rep" }
515 open(REP,"<$filename");
516 print FILE "To: $address\nSubject: $subject\n";
517 print FILE "Cc: $cc\n" if $cc;
518 print FILE "Reply-To: $from\n" if $from;
520 while(<REP>) { print FILE }
524 print "\nMessage saved in `$file'.\n";
527 } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
528 # Display the message
529 open(REP,"<$filename");
530 while(<REP>) { print $_ }
532 } elsif( $action =~ /^se/i ) { # <S>end
535 Are you certain you want to send this message?
536 Please type \"yes\" if you are: ";
537 my($reply) = scalar(<STDIN>);
539 if( $reply eq "yes" ) {
544 That wasn't a clear "yes", so I won't send your message. If you are sure
545 your message should be sent, type in "yes" (without the quotes) at the
551 } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
554 #system("$ed $filename");
555 } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
556 1 while unlink($filename); # remove all versions under VMS
557 print "\nCancelling.\n";
559 } elsif( $action =~ /^s/ ) {
562 I'm sorry, but I didn't understand that. Please type "send" or "save".
573 # Message has been accepted for transmission -- Send the message
577 $msg = new Mail::Send Subject => $subject, To => $address;
579 $msg->cc($cc) if $cc;
580 $msg->add("Reply-To",$from) if $from;
584 open(REP,"<$filename");
585 while(<REP>) { print $fh $_ }
592 if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
593 ($cc =~ /@/ and $cc !~ /^\w+%"/) ){
595 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
596 $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
598 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
599 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
601 $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
602 my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
603 if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
607 foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
609 $sendmail = $_, last if -e $_;
612 paraprint <<"EOF" and die "\n" if $sendmail eq "";
614 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
615 the perl package Mail::Send has not been installed, so I can't send your bug
616 report. We apologize for the inconveniencence.
618 So you may attempt to find some way of sending your message, it has
619 been left in the file `$filename'.
623 open(SENDMAIL,"|$sendmail -t");
624 print SENDMAIL "To: $address\n";
625 print SENDMAIL "Subject: $subject\n";
626 print SENDMAIL "Cc: $cc\n" if $cc;
627 print SENDMAIL "Reply-To: $from\n" if $from;
628 print SENDMAIL "\n\n";
629 open(REP,"<$filename");
630 while(<REP>) { print SENDMAIL $_ }
638 print "\nMessage sent.\n";
640 1 while unlink($filename); # remove all versions under VMS
647 A program to help generate bug reports about perl5, and mail them.
648 It is designed to be used interactively. Normally no arguments will
652 $0 [-v] [-a address] [-s subject] [-b body | -f file ]
653 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
655 Simplest usage: run "$0", and follow the prompts.
659 -v Include Verbose configuration data in the report
660 -f File containing the body of the report. Use this to
661 quickly send a prepared message.
662 -S Send without asking for confirmation.
663 -a Address to send the report to. Defaults to `$address'.
664 -c Address to send copy of report to. Defaults to `$cc'.
665 -C Don't send copy to administrator.
666 -s Subject to include with the message. You will be prompted
667 if you don't supply one on the command line.
668 -b Body of the report. If not included on the command line, or
669 in a file with -f, you will get a chance to edit the message.
670 -r Your return address. The program will ask you to confirm
671 this if you don't give it here.
673 -t Test mode. The target address defaults to `$testaddress'.
674 -d Data mode (the default if you redirect or pipe output.)
675 This prints out your configuration data, without mailing
676 anything. You can use this with -v to get more complete data.
682 my @paragraphs = split /\n{2,}/, "@_";
684 for (@paragraphs) { # implicit local $_
694 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
699 close OUT or die "Can't close $file: $!";
700 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
701 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';