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 ($Config{'osname'} eq 'VMS' or
19 $Config{'osname'} eq 'OS2'); # "case-forgiving"
21 open OUT,">$file" or die "Can't create $file: $!";
23 print "Extracting $file (with variable substitutions)\n";
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
28 print OUT <<"!GROK!THIS!";
30 eval 'exec perl -S \$0 "\$@"'
34 # In the following, perl variables are not expanded during extraction.
36 print OUT <<'!NO!SUBS!';
42 eval "use Mail::Send;";
43 $::HaveSend = ($@ eq "");
44 eval "use Mail::Util;";
45 $::HaveUtil = ($@ eq "");
54 my($Version) = "1.12";
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 # Changed in 1.12 to check for editor errors, make save/send distinction
65 # clearer and add $ENV{REPLYTO}.
67 # TODO: Allow the user to re-name the file on mail failure, and
68 # make sure failure (transmission-wise) of Mail::Send is
71 my( $file, $cc, $address, $perlbug, $testaddress, $filename,
72 $subject, $from, $verbose, $ed,
73 $fh, $me, $Is_VMS, $msg, $body, $andcc );
77 if($::opt_h) { Help(); exit; }
79 if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
90 # -------- Setup --------
92 $Is_VMS = $::Config{'osname'} eq 'VMS';
94 getopts("dhva:s:b:f:r:e:SCc:t");
97 # This comment is needed to notify metaconfig that we are
98 # using the $perladmin, $cf_by, and $cf_time definitions.
101 # -------- Configuration ---------
104 $perlbug = 'perlbug@perl.com';
107 $testaddress = 'perlbug-test@perl.com';
110 $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
112 # Possible administrator addresses, in order of confidence
113 # (Note that cf_email is not mentioned to metaconfig, since
114 # we don't really want it. We'll just take it if we have to.)
115 $cc = ($::opt_C ? "" : (
116 $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
119 # Users address, used in message and in Reply-To header
120 $from = $::opt_r || "";
122 # Include verbose configuration information
123 $verbose = $::opt_v || 0;
125 # Subject of bug-report message
126 $subject = $::opt_s || "";
128 # File to send as report
129 $file = $::opt_f || "";
132 $body = $::opt_b || "";
135 $ed = ($::opt_f ? "file" : (
136 $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
137 ($Is_VMS ? "edit/tpu" : "vi")
148 # Explain what perlbug is
151 This program allows you to create a bug report,
152 which will be sent as an e-mail message to $address
153 once you have filled in the report.
158 # Prompt for subject of message, if needed
161 First of all, please provide a subject for the
162 message. It should be as a concise description of
163 the bug as is possible.
172 while( $subject =~ /^\s*$/ ) {
173 print "\nPlease enter a subject: ";
183 # Prompt for return address, if needed
186 # Try and guess return address
190 $domain = Mail::Util::maildomain();
192 require Sys::Hostname;
193 $domain = Sys::Hostname::hostname();
195 $domain = `hostname`.".".`domainname`;
196 $domain =~ s/[\r\n]+//g;
203 } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) {
204 $guess = "$domain\:\:$me";
206 $guess = "$me\@$domain" if $domain;
207 $guess = "$me\@unknown.addresss" unless $domain;
210 $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
211 $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
217 Your e-mail address will be useful if you need to be contacted. If the
218 default shown is not your full internet e-mail address, please correct it.
224 So that you may be contacted if necessary, please enter
225 your full internet e-mail address here.
229 print "Your address [$guess]: ";
234 if($from eq "") { $from = $guess }
238 #if( $from =~ /^(.*)\@(.*)$/ ) {
243 if( $from eq $cc or $me eq $cc ) {
244 # Try not to copy ourselves
249 # Prompt for administrator address, unless an override was given
250 if( !$::opt_C and !$::opt_c ) {
254 A copy of this report can be sent to your local
255 perl administrator. If the address is wrong, please
256 correct it, or enter 'none' or 'yourself' to not send
261 print "Local perl administrator [$cc]: ";
263 my($entry) = scalar(<>);
268 if($me eq $cc) { $cc = "" }
273 if($cc =~ /^(none|yourself|myself|ourselves)$/i) { $cc = "" }
275 $andcc = " and $cc" if $cc;
278 # Prompt for editor, if no override is given
279 if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
283 Now you need to supply the bug report. Try to make
284 the report concise but descriptive. Include any
285 relevant detail. Some information about your local
286 perl configuration will automatically be included
287 at the end of the report.
289 You will probably want to use an editor to enter
290 the report. If "$ed" is the editor you want
291 to use, then just press Enter, otherwise type in
292 the name of the editor you would like to use.
294 If you would like to use a prepared file, type
295 "file", and you will be asked for the filename.
299 print "Editor [$ed]: ";
301 my($entry) =scalar(<>);
310 # Generate scratch file to edit report in
313 my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
314 $filename = "bugrep0$$";
315 $filename++ while -e "$dir$filename";
316 $filename = "$dir$filename";
320 # Prompt for file to read report from, if needed
322 if( $ed eq "file" and ! $file) {
326 What is the name of the file that contains your report?
332 my($entry) = scalar(<>);
335 if(!-f $entry or !-r $entry) {
336 print "\n\nUnable to read from `$entry'.\nExiting.\n";
346 open(REP,">$filename");
349 This is a bug report for perl from $from,
350 generated with the help of perlbug $Version running under perl $].
357 open(F,"<$file") or die "Unable to read report file: $!\n";
363 print REP "[Please enter your report here]\n";
378 Site configuration information for perl $]:
382 if( $::Config{cf_by} and $::Config{cf_time}) {
383 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
386 print OUT Config::myconfig;
389 print OUT "\nComplete configuration data for perl $]:\n\n";
391 foreach (sort keys %::Config) {
392 $value = $::Config{$_};
394 print OUT "$_='$value'\n";
403 if(!$file and !$body) {
404 my($sts) = system("$ed $filename");
405 if( $Is_VMS ? !($sts & 1) : $sts ) {
406 #print "\nUnable to run editor!\n";
409 The editor you chose (`$ed') could apparently not be run!
410 Did you mistype the name of your editor? If so, please
411 correct it here, otherwise just press Enter.
414 print "Editor [$ed]: ";
416 my($entry) =scalar(<>);
426 You may want to save your report to a file, so you can edit and mail it
436 # Report is done, prompt for further action
443 Now that you have completed your report, would you like to send
444 the message to $address$andcc, display the message on
445 the screen, re-edit it, or cancel without sending anything?
446 You may also save the message as a file to mail at another time.
450 print "Action (Send/Display/Edit/Cancel/Save to File): ";
451 my($action) = scalar(<>);
454 if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
455 print "\n\nName of file to save message in [perlbug.rep]: ";
456 my($file) = scalar(<>);
458 if($file eq "") { $file = "perlbug.rep" }
461 open(REP,"<$filename");
462 print FILE "To: $address\nSubject: $subject\n";
463 print FILE "Cc: $cc\n" if $cc;
464 print FILE "Reply-To: $from\n" if $from;
466 while(<REP>) { print FILE }
470 print "\nMessage saved in `$file'.\n";
473 } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
474 # Display the message
475 open(REP,"<$filename");
476 while(<REP>) { print $_ }
478 } elsif( $action =~ /^s/i ) { # <S>end
481 } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
484 #system("$ed $filename");
485 } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
486 1 while unlink($filename); # remove all versions under VMS
487 print "\nCancelling.\n";
498 # Message has been accepted for transmission -- Send the message
502 $msg = new Mail::Send Subject => $subject, To => $address;
504 $msg->cc($cc) if $cc;
505 $msg->add("Reply-To",$from) if $from;
509 open(REP,"<$filename");
510 while(<REP>) { print $fh $_ }
517 if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
518 ($cc =~ /@/ and $cc !~ /^\w+%"/) ){
520 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
521 $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
523 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
524 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
526 $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
527 my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
528 if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
532 foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
534 $sendmail = $_, last if -e $_;
537 paraprint <<"EOF" and die "\n" if $sendmail eq "";
539 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
540 the perl package Mail::Send has not been installed, so I can't send your bug
541 report. We apologize for the inconveniencence.
543 So you may attempt to find some way of sending your message, it has
544 been left in the file `$filename'.
548 open(SENDMAIL,"|$sendmail -t");
549 print SENDMAIL "To: $address\n";
550 print SENDMAIL "Subject: $subject\n";
551 print SENDMAIL "Cc: $cc\n" if $cc;
552 print SENDMAIL "Reply-To: $from\n" if $from;
553 print SENDMAIL "\n\n";
554 open(REP,"<$filename");
555 while(<REP>) { print SENDMAIL $_ }
563 print "\nMessage sent.\n";
565 1 while unlink($filename); # remove all versions under VMS
572 A program to help generate bug reports about perl5, and mail them.
573 It is designed to be used interactively. Normally no arguments will
577 $0 [-v] [-a address] [-s subject] [-b body | -f file ]
578 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
580 Simplest usage: run "$0", and follow the prompts.
584 -v Include Verbose configuration data in the report
585 -f File containing the body of the report. Use this to
586 quickly send a prepared message.
587 -S Send without asking for confirmation.
588 -a Address to send the report to. Defaults to `$address'.
589 -c Address to send copy of report to. Defaults to `$cc'.
590 -C Don't send copy to administrator.
591 -s Subject to include with the message. You will be prompted
592 if you don't supply one on the command line.
593 -b Body of the report. If not included on the command line, or
594 in a file with -f, you will get a chance to edit the message.
595 -r Your return address. The program will ask you to confirm
596 this if you don't give it here.
598 -t Test mode. The target address defaults to `$testaddress'.
599 -d Data mode (the default if you redirect or pipe output.)
600 This prints out your configuration data, without mailing
601 anything. You can use this with -v to get more complete data.
607 my @paragraphs = split /\n{2,}/, "@_";
609 for (@paragraphs) { # implicit local $_
619 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
624 close OUT or die "Can't close $file: $!";
625 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
626 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';