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)) =~ s/\.PL$//;
18 if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
20 open OUT,">$file" or die "Can't create $file: $!";
22 print "Extracting $file (with variable substitutions)\n";
24 # In this section, perl variables will be expanded during extraction.
25 # You can use $Config{...} to use Configure variables.
27 print OUT <<"!GROK!THIS!";
29 eval 'exec perl -S \$0 "\$@"'
33 # In the following, perl variables are not expanded during extraction.
35 print OUT <<'!NO!SUBS!';
41 eval "use Mail::Send;";
42 $::HaveSend = ($@ eq "");
43 eval "use Mail::Util;";
44 $::HaveUtil = ($@ eq "");
53 my($Version) = "1.14";
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
67 # Changed in 1.14 to make the prompts a little more clear on providing
68 # helpful information. Also let file read fail gracefully.
70 # TODO: Allow the user to re-name the file on mail failure, and
71 # make sure failure (transmission-wise) of Mail::Send is
74 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
75 $subject, $from, $verbose, $ed,
76 $fh, $me, $Is_VMS, $msg, $body, $andcc );
80 if($::opt_h) { Help(); exit; }
84 Please use perlbug interactively. If you want to
85 include a file, you can use the -f switch.
90 if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
93 Edit() unless $usefile;
101 # -------- Setup --------
103 $Is_VMS = $^O eq 'VMS';
105 getopts("dhva:s:b:f:r:e:SCc:t");
108 # This comment is needed to notify metaconfig that we are
109 # using the $perladmin, $cf_by, and $cf_time definitions.
112 # -------- Configuration ---------
115 $perlbug = 'perlbug@perl.com';
118 $testaddress = 'perlbug-test@perl.com';
121 $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
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}
130 # Users address, used in message and in Reply-To header
131 $from = $::opt_r || "";
133 # Include verbose configuration information
134 $verbose = $::opt_v || 0;
136 # Subject of bug-report message
137 $subject = $::opt_s || "";
140 $usefile = ($::opt_f || 0);
142 # File to send as report
143 $file = $::opt_f || "";
146 $body = $::opt_b || "";
149 $ed = ( $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
150 ($Is_VMS ? "edit/tpu" : "vi")
162 # Explain what perlbug is
165 This program provides an easy way to create a message reporting a bug in
166 perl, and e-mail it to $address.
171 # Prompt for subject of message, if needed
174 First of all, please provide a subject for the
175 message. It should be a concise description of
185 while( $subject =~ /^\s*$/ ) {
186 print "\nPlease enter a subject: ";
196 # Prompt for return address, if needed
199 # Try and guess return address
203 $domain = Mail::Util::maildomain();
205 require Sys::Hostname;
206 $domain = Sys::Hostname::hostname();
208 $domain = `hostname`.".".`domainname`;
209 $domain =~ s/[\r\n]+//g;
216 } elsif ($Is_VMS && !$::Config{'has_sockets'}) {
217 $guess = "$domain\:\:$me";
219 $guess = "$me\@$domain" if $domain;
220 $guess = "$me\@unknown.addresss" unless $domain;
223 $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
224 $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
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.
237 So that you may be contacted if necessary, please enter
238 your full internet e-mail address here.
242 print "Your address [$guess]: ";
247 if($from eq "") { $from = $guess }
251 #if( $from =~ /^(.*)\@(.*)$/ ) {
256 if( $from eq $cc or $me eq $cc ) {
257 # Try not to copy ourselves
262 # Prompt for administrator address, unless an override was given
263 if( !$::opt_C and !$::opt_c ) {
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
274 print "Local perl administrator [$cc]: ";
276 my($entry) = scalar(<>);
281 if($me eq $cc) { $cc = "" }
286 if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
288 $andcc = " and $cc" if $cc;
292 # Prompt for editor, if no override is given
293 if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
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.
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.
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.
315 If you would like to use a prepared file, type
316 "file", and you will be asked for the filename.
320 print "Editor [$ed]: ";
322 my($entry) =scalar(<>);
326 if($entry eq "file") {
328 } elsif($entry ne "") {
334 # Generate scratch file to edit report in
337 my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
338 $filename = "bugrep0$$";
339 $filename++ while -e "$dir$filename";
340 $filename = "$dir$filename";
344 # Prompt for file to read report from, if needed
346 if( $usefile and ! $file) {
350 What is the name of the file that contains your report?
356 my($entry) = scalar(<>);
362 No filename? I'll let you go back and choose an editor again.
368 if(!-f $entry or !-r $entry) {
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.
385 open(REP,">$filename");
388 This is a bug report for perl from $from,
389 generated with the help of perlbug $Version running under perl $].
396 open(F,"<$file") or die "Unable to read report file from `$file': $!\n";
402 print REP "[Please enter your report here]\n";
417 Site configuration information for perl $]:
421 if( $::Config{cf_by} and $::Config{cf_time}) {
422 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
425 print OUT Config::myconfig;
428 print OUT "\nComplete configuration data for perl $]:\n\n";
430 foreach (sort keys %::Config) {
431 $value = $::Config{$_};
433 print OUT "$_='$value'\n";
445 Please make sure that the name of the editor you want to use is correct.
448 print "Editor [$ed]: ";
450 my($entry) =scalar(<>);
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";
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.
470 print "Editor [$ed]: ";
472 my($entry) =scalar(<>);
482 You may want to save your report to a file, so you can edit and mail it
492 # Report is done, prompt for further action
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.
506 print "Action (Send/Display/Edit/Cancel/Save to File): ";
507 my($action) = scalar(<>);
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(<>);
514 if($file eq "") { $file = "perlbug.rep" }
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;
522 while(<REP>) { print FILE }
526 print "\nMessage saved in `$file'.\n";
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 $_ }
534 } elsif( $action =~ /^se/i ) { # <S>end
537 Are you certain you want to send this message?
538 Please type \"yes\" if you are: ";
539 my($reply) = scalar(<STDIN>);
541 if( $reply eq "yes" ) {
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
553 } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-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";
561 } elsif( $action =~ /^s/ ) {
564 I'm sorry, but I didn't understand that. Please type "send" or "save".
575 # Message has been accepted for transmission -- Send the message
579 $msg = new Mail::Send Subject => $subject, To => $address;
581 $msg->cc($cc) if $cc;
582 $msg->add("Reply-To",$from) if $from;
586 open(REP,"<$filename");
587 while(<REP>) { print $fh $_ }
594 if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
595 ($cc =~ /@/ and $cc !~ /^\w+%"/) ){
597 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
598 $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
600 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
601 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
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;" }
609 foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
611 $sendmail = $_, last if -e $_;
614 paraprint <<"EOF" and die "\n" if $sendmail eq "";
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.
620 So you may attempt to find some way of sending your message, it has
621 been left in the file `$filename'.
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 $_ }
640 print "\nMessage sent.\n";
642 1 while unlink($filename); # remove all versions under VMS
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
654 $0 [-v] [-a address] [-s subject] [-b body | -f file ]
655 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
657 Simplest usage: run "$0", and follow the prompts.
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.
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.
684 my @paragraphs = split /\n{2,}/, "@_";
686 for (@paragraphs) { # implicit local $_
696 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
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 ':';