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.13";
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
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, $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; }
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 || "";
137 # File to send as report
138 $file = $::opt_f || "";
141 $body = $::opt_b || "";
144 $ed = ($::opt_f ? "file" : (
145 $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
146 ($Is_VMS ? "edit/tpu" : "vi")
157 # Explain what perlbug is
160 This program allows you to create a bug report,
161 which will be sent as an e-mail message to $address
162 once you have filled in the report.
167 # Prompt for subject of message, if needed
170 First of all, please provide a subject for the
171 message. It should be as a concise description of
172 the bug as is possible.
181 while( $subject =~ /^\s*$/ ) {
182 print "\nPlease enter a subject: ";
192 # Prompt for return address, if needed
195 # Try and guess return address
199 $domain = Mail::Util::maildomain();
201 require Sys::Hostname;
202 $domain = Sys::Hostname::hostname();
204 $domain = `hostname`.".".`domainname`;
205 $domain =~ s/[\r\n]+//g;
212 } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) {
213 $guess = "$domain\:\:$me";
215 $guess = "$me\@$domain" if $domain;
216 $guess = "$me\@unknown.addresss" unless $domain;
219 $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
220 $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
226 Your e-mail address will be useful if you need to be contacted. If the
227 default shown is not your full internet e-mail address, please correct it.
233 So that you may be contacted if necessary, please enter
234 your full internet e-mail address here.
238 print "Your address [$guess]: ";
243 if($from eq "") { $from = $guess }
247 #if( $from =~ /^(.*)\@(.*)$/ ) {
252 if( $from eq $cc or $me eq $cc ) {
253 # Try not to copy ourselves
258 # Prompt for administrator address, unless an override was given
259 if( !$::opt_C and !$::opt_c ) {
263 A copy of this report can be sent to your local
264 perl administrator. If the address is wrong, please
265 correct it, or enter 'none' or 'yourself' to not send
270 print "Local perl administrator [$cc]: ";
272 my($entry) = scalar(<>);
277 if($me eq $cc) { $cc = "" }
282 if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
284 $andcc = " and $cc" if $cc;
287 # Prompt for editor, if no override is given
288 if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
292 Now you need to supply the bug report. Try to make
293 the report concise but descriptive. Include any
294 relevant detail. Some information about your local
295 perl configuration will automatically be included
296 at the end of the report.
298 You will probably want to use an editor to enter
299 the report. If "$ed" is the editor you want
300 to use, then just press Enter, otherwise type in
301 the name of the editor you would like to use.
303 If you would like to use a prepared file, type
304 "file", and you will be asked for the filename.
308 print "Editor [$ed]: ";
310 my($entry) =scalar(<>);
319 # Generate scratch file to edit report in
322 my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
323 $filename = "bugrep0$$";
324 $filename++ while -e "$dir$filename";
325 $filename = "$dir$filename";
329 # Prompt for file to read report from, if needed
331 if( $ed eq "file" and ! $file) {
335 What is the name of the file that contains your report?
341 my($entry) = scalar(<>);
344 if(!-f $entry or !-r $entry) {
345 print "\n\nUnable to read from `$entry'.\nExiting.\n";
355 open(REP,">$filename");
358 This is a bug report for perl from $from,
359 generated with the help of perlbug $Version running under perl $].
366 open(F,"<$file") or die "Unable to read report file: $!\n";
372 print REP "[Please enter your report here]\n";
387 Site configuration information for perl $]:
391 if( $::Config{cf_by} and $::Config{cf_time}) {
392 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
395 print OUT Config::myconfig;
398 print OUT "\nComplete configuration data for perl $]:\n\n";
400 foreach (sort keys %::Config) {
401 $value = $::Config{$_};
403 print OUT "$_='$value'\n";
412 if(!$file and !$body) {
413 my($sts) = system("$ed $filename");
414 if( $Is_VMS ? !($sts & 1) : $sts ) {
415 #print "\nUnable to run editor!\n";
418 The editor you chose (`$ed') could apparently not be run!
419 Did you mistype the name of your editor? If so, please
420 correct it here, otherwise just press Enter.
423 print "Editor [$ed]: ";
425 my($entry) =scalar(<>);
435 You may want to save your report to a file, so you can edit and mail it
445 # Report is done, prompt for further action
452 Now that you have completed your report, would you like to send
453 the message to $address$andcc, display the message on
454 the screen, re-edit it, or cancel without sending anything?
455 You may also save the message as a file to mail at another time.
459 print "Action (Send/Display/Edit/Cancel/Save to File): ";
460 my($action) = scalar(<>);
463 if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
464 print "\n\nName of file to save message in [perlbug.rep]: ";
465 my($file) = scalar(<>);
467 if($file eq "") { $file = "perlbug.rep" }
470 open(REP,"<$filename");
471 print FILE "To: $address\nSubject: $subject\n";
472 print FILE "Cc: $cc\n" if $cc;
473 print FILE "Reply-To: $from\n" if $from;
475 while(<REP>) { print FILE }
479 print "\nMessage saved in `$file'.\n";
482 } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
483 # Display the message
484 open(REP,"<$filename");
485 while(<REP>) { print $_ }
487 } elsif( $action =~ /^se/i ) { # <S>end
490 Are you certain you want to send this message?
491 Please type \"yes\" if you are: ";
492 my($reply) = scalar(<STDIN>);
494 if( $reply eq "yes" ) {
497 } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
500 #system("$ed $filename");
501 } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
502 1 while unlink($filename); # remove all versions under VMS
503 print "\nCancelling.\n";
505 } elsif( $action =~ /^s/ ) {
508 I'm sorry, but I didn't understand that. Please type "send" or "save".
519 # Message has been accepted for transmission -- Send the message
523 $msg = new Mail::Send Subject => $subject, To => $address;
525 $msg->cc($cc) if $cc;
526 $msg->add("Reply-To",$from) if $from;
530 open(REP,"<$filename");
531 while(<REP>) { print $fh $_ }
538 if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
539 ($cc =~ /@/ and $cc !~ /^\w+%"/) ){
541 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
542 $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
544 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
545 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
547 $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
548 my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
549 if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
553 foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
555 $sendmail = $_, last if -e $_;
558 paraprint <<"EOF" and die "\n" if $sendmail eq "";
560 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
561 the perl package Mail::Send has not been installed, so I can't send your bug
562 report. We apologize for the inconveniencence.
564 So you may attempt to find some way of sending your message, it has
565 been left in the file `$filename'.
569 open(SENDMAIL,"|$sendmail -t");
570 print SENDMAIL "To: $address\n";
571 print SENDMAIL "Subject: $subject\n";
572 print SENDMAIL "Cc: $cc\n" if $cc;
573 print SENDMAIL "Reply-To: $from\n" if $from;
574 print SENDMAIL "\n\n";
575 open(REP,"<$filename");
576 while(<REP>) { print SENDMAIL $_ }
584 print "\nMessage sent.\n";
586 1 while unlink($filename); # remove all versions under VMS
593 A program to help generate bug reports about perl5, and mail them.
594 It is designed to be used interactively. Normally no arguments will
598 $0 [-v] [-a address] [-s subject] [-b body | -f file ]
599 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
601 Simplest usage: run "$0", and follow the prompts.
605 -v Include Verbose configuration data in the report
606 -f File containing the body of the report. Use this to
607 quickly send a prepared message.
608 -S Send without asking for confirmation.
609 -a Address to send the report to. Defaults to `$address'.
610 -c Address to send copy of report to. Defaults to `$cc'.
611 -C Don't send copy to administrator.
612 -s Subject to include with the message. You will be prompted
613 if you don't supply one on the command line.
614 -b Body of the report. If not included on the command line, or
615 in a file with -f, you will get a chance to edit the message.
616 -r Your return address. The program will ask you to confirm
617 this if you don't give it here.
619 -t Test mode. The target address defaults to `$testaddress'.
620 -d Data mode (the default if you redirect or pipe output.)
621 This prints out your configuration data, without mailing
622 anything. You can use this with -v to get more complete data.
628 my @paragraphs = split /\n{2,}/, "@_";
630 for (@paragraphs) { # implicit local $_
640 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
645 close OUT or die "Can't close $file: $!";
646 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
647 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';