Re: 5.6.1 darwin Configure fails to extract Makefile
[p5sagit/p5-mst-13.2.git] / utils / perlbug.PL
index 97f8d86..c4289f8 100644 (file)
@@ -37,15 +37,15 @@ my @patches;
 while (<PATCH_LEVEL>) {
     last if /^\s*}/;
     chomp;
-    s/^\s+,?"?//;
-    s/"?,?$//;
+    s/^\s+,?\s*"?//;
+    s/"?\s*,?$//;
     s/(['\\])/\\$1/g;
     push @patches, $_ unless $_ eq 'NULL';
 }
 my $patch_desc = "'" . join("',\n    '", @patches) . "'";
 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
 
-close PATCH_LEVEL;
+close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
 
 # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
 # used, compare $Config::config_sh with the stored version. If they differ then
@@ -57,7 +57,7 @@ print "Extracting $file (with variable substitutions)\n";
 # In this section, perl variables will be expanded during extraction.
 # You can use $Config{...} to use Configure variables.
 
-my $extract_version = sprintf("v%v", $^V);
+my $extract_version = sprintf("v%vd", $^V);
 
 print OUT <<"!GROK!THIS!";
 $Config{startperl}
@@ -91,7 +91,7 @@ BEGIN {
     $::HaveUtil = ($@ eq "");
 };
 
-my $Version = "1.27";
+my $Version = "1.33";
 
 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
 # Changed in 1.07 to see more sendmail execs, and added pipe output.
@@ -123,6 +123,12 @@ my $Version = "1.27";
 # Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
 # Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
 # Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
+# Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
+# Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
+# Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
+# Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
+# Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
+# Changed in 1.33 Don't require -t STDOUT for -ok.
 
 # TODO: - Allow the user to re-name the file on mail failure, and
 #       make sure failure (transmission-wise) of Mail::Send is
@@ -130,10 +136,10 @@ my $Version = "1.27";
 #       - Test -b option
 
 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
-    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS,
+    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
     $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
 
-my $perl_version = $^V ? sprintf("v%v", $^V) : $];
+my $perl_version = $^V ? sprintf("v%vd", $^V) : $];
 
 my $config_tag2 = "$perl_version - $Config{cf_time}";
 
@@ -148,7 +154,6 @@ include a file, you can use the -f switch.
 EOF
     die "\n";
 }
-if (!-t STDOUT && !$outfile) { Dump(*STDOUT); exit; }
 
 Query();
 Edit() unless $usefile || ($ok and not $::opt_n);
@@ -157,6 +162,48 @@ Send();
 
 exit;
 
+sub ask_for_alternatives { # (category|severity)
+    my $name = shift;
+    my %alts = (
+       'category' => {
+           'default' => 'core',
+           'ok'      => 'install',
+           'opts'    => [qw(core docs install library utilities)], # patch, notabug
+       },
+       'severity' => {
+           'default' => 'low',
+           'ok'      => 'none',
+           'opts'    => [qw(critical high medium low wishlist none)], # zero
+       },
+    );
+    die "Invalid alternative($name) requested\n" unless grep(/^$name$/, keys %alts);
+    my $alt = "";
+    if ($ok) {
+       $alt = $alts{$name}{'ok'};
+    } else {
+       my @alts = @{$alts{$name}{'opts'}};
+       paraprint <<EOF;
+Please pick a \u$name from the following:
+
+    @alts
+
+EOF
+       my $err = 0;
+       do {
+           if ($err++ > 5) {
+               die "Invalid $name: aborting.\n";
+           }
+           print "Please enter a \u$name [$alts{$name}{'default'}]: ";
+           $alt = <>;
+           chomp $alt;
+           if ($alt =~ /^\s*$/) {
+               $alt = $alts{$name}{'default'};
+           }
+       } while !((($alt) = grep(/^$alt/i, @alts)));
+    }
+    lc $alt;
+}
+
 sub Init {
     # -------- Setup --------
 
@@ -168,7 +215,7 @@ sub Init {
         MacPerl::Ask('Provide command-line args here (-h for help):')
         if $Is_MacOS && $MacPerl::Version =~ /App/;
 
-    if (!getopts("dhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
+    if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
 
     # This comment is needed to notify metaconfig that we are
     # using the $perladmin, $cf_by, and $cf_time definitions.
@@ -176,7 +223,7 @@ sub Init {
     # -------- Configuration ---------
 
     # perlbug address
-    $perlbug = 'perlbug@perl.com';
+    $perlbug = 'perlbug@perl.org';
 
     # Test address
     $testaddress = 'perlbug-test@perl.com';
@@ -437,6 +484,12 @@ EOF
        }
     }
 
+    # Prompt for category of bug
+    $category ||= ask_for_alternatives('category');
+
+    # Prompt for severity of bug
+    $severity ||= ask_for_alternatives('severity');
+
     # Generate scratch file to edit report in
     $filename = filename();
 
@@ -469,7 +522,7 @@ EOF
     }
 
     # Generate report
-    open(REP,">$filename");
+    open(REP,">$filename") or die "Unable to create report file `$filename': $!\n";
     my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
 
     print REP <<EOF;
@@ -486,7 +539,7 @@ EOF
        while (<F>) {
            print REP $_
        }
-       close(F);
+       close(F) or die "Error closing `$file': $!";
     } else {
        print REP <<EOF;
 
@@ -500,24 +553,37 @@ EOF
 EOF
     }
     Dump(*REP);
-    close(REP);
+    close(REP) or die "Error closing report file: $!";
 
     # read in the report template once so that
     # we can track whether the user does any editing.
     # yes, *all* whitespace is ignored.
-    open(REP, "<$filename");
+    open(REP, "<$filename") or die "Unable to open report file `$filename': $!\n";
     while (<REP>) {
        s/\s+//g;
        $REP{$_}++;
     }
-    close(REP);
+    close(REP) or die "Error closing report file `$filename': $!";
 } # sub Query
 
 sub Dump {
     local(*OUT) = @_;
 
-    print REP "\n---\n";
-    print REP "This perlbug was built using Perl $config_tag1\n",
+    print OUT <<EFF;
+---
+Flags:
+    category=$category
+    severity=$severity
+EFF
+    if ($::opt_A) {
+       print OUT <<EFF;
+    ack=no
+EFF
+    }
+    print OUT <<EFF;
+---
+EFF
+    print OUT "This perlbug was built using Perl $config_tag1\n",
            "It is being executed now by  Perl $config_tag2.\n\n"
        if $config_tag2 ne $config_tag1;
 
@@ -584,7 +650,8 @@ EOF
     }
 
 tryagain:
-    my $sts = system("$ed $filename") unless $Is_MacOS;
+    my $sts;
+    $sts = system("$ed $filename") unless $Is_MacOS;
     if ($Is_MacOS) {
         require ExtUtils::MakeMaker;
         ExtUtils::MM_MacOS::launch_file($filename);
@@ -618,7 +685,7 @@ EOF
     # Check that we have a report that has some, eh, report in it.
     my $unseen = 0;
 
-    open(REP, "<$filename");
+    open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
     # a strange way to check whether any significant editing
     # have been done: check whether any new non-empty lines
     # have been added. Yes, the below code ignores *any* space
@@ -664,31 +731,32 @@ EOF
            chop $action;
 
            if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
-               print "\n\nName of file to save message in [perlbug.rep]: ";
+               my $file_save = $outfile || "perlbug.rep";
+               print "\n\nName of file to save message in [$file_save]: ";
                my $file = scalar <>;
                chop $file;
-               $file = "perlbug.rep" if $file eq "";
+               $file = $file_save if $file eq "";
 
                unless (open(FILE, ">$file")) {
                    print "\nError opening $file: $!\n\n";
                    goto retry;
                }
-               open(REP, "<$filename");
+               open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
                print FILE "To: $address\nSubject: $subject\n";
                print FILE "Cc: $cc\n" if $cc;
                print FILE "Reply-To: $from\n" if $from;
                print FILE "\n";
                while (<REP>) { print FILE }
-               close(REP);
-               close(FILE);
+               close(REP) or die "Error closing report file `$filename': $!";
+               close(FILE) or die "Error closing $file: $!";
 
                print "\nMessage saved in `$file'.\n";
                exit;
            } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
                # Display the message
-               open(REP, "<$filename");
+               open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
                while (<REP>) { print $_ }
-               close(REP);
+               close(REP) or die "Error closing report file `$filename': $!";
            } elsif ($action =~ /^se/i) { # <S>end
                # Send the message
                print "Are you certain you want to send this message?\n"
@@ -709,7 +777,7 @@ EOF
                Edit();
            } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
                Cancel();
-           } elsif ($action =~ /^s/) {
+           } elsif ($action =~ /^s/i) {
                paraprint <<EOF;
 I'm sorry, but I didn't understand that. Please type "send" or "save".
 EOF
@@ -730,9 +798,9 @@ sub Send {
        $msg->add("Reply-To",$from) if $from;
 
        $fh = $msg->open;
-       open(REP, "<$filename");
+       open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
        while (<REP>) { print $fh $_ }
-       close(REP);
+       close(REP) or die "Error closing $filename: $!";
        $fh->close;
 
        print "\nMessage sent.\n";
@@ -777,16 +845,16 @@ report. We apologize for the inconvenience.
 So you may attempt to find some way of sending your message, it has
 been left in the file `$filename'.
 EOF
-       open(SENDMAIL, "|$sendmail -t") || die "'|$sendmail -t' failed: $!";
+       open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
 sendout:
        print SENDMAIL "To: $address\n";
        print SENDMAIL "Subject: $subject\n";
        print SENDMAIL "Cc: $cc\n" if $cc;
        print SENDMAIL "Reply-To: $from\n" if $from;
        print SENDMAIL "\n\n";
-       open(REP, "<$filename");
+       open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
        while (<REP>) { print SENDMAIL $_ }
-       close(REP);
+       close(REP) or die "Error closing $filename: $!";
 
        if (close(SENDMAIL)) {
            printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
@@ -807,7 +875,7 @@ be needed.
 Usage:
 $0  [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
-$0  [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
+$0  [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
 
 Simplest usage:  run "$0", and follow the prompts.
 
@@ -829,9 +897,9 @@ Options:
         this if you don't give it here.
   -e    Editor to use.
   -t    Test mode. The target address defaults to `$testaddress'.
-  -d    Data mode (the default if you redirect or pipe output.)
-        This prints out your configuration data, without mailing
+  -d    Data mode.  This prints out your configuration data, without mailing
         anything. You can use this with -v to get more complete data.
+  -A    Don't send a bug received acknowledgement to the return address.
   -ok   Report successful build on this system to perl porters
         (use alone or with -v). Only use -ok if *everything* was ok:
         if there were *any* problems at all, use -nok.
@@ -846,12 +914,8 @@ EOF
 }
 
 sub filename {
-    my $dir = $Is_VMS ? 'sys$scratch:'
-       : ($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'}
-        : $Is_MacOS ? $ENV{'TMPDIR'}
-       : '/tmp';
+    my $dir = File::Spec->tmpdir();
     $filename = "bugrep0$$";
-#    $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
     $filename++ while -e File::Spec->catfile($dir, $filename);
     $filename = File::Spec->catfile($dir, $filename);
 }
@@ -883,10 +947,10 @@ B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
 S<[ B<-r> I<returnaddress> ]>
 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
-S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-h> ]>
+S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-A> ]>  S<[ B<-h> ]>
 
 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
-S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
+ S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
 
 =head1 DESCRIPTION
 
@@ -904,7 +968,7 @@ will be needed.  Simply run it, and follow the prompts.
 
 If you are unable to run B<perlbug> (most likely because you don't have
 a working setup to send mail that perlbug recognizes), you may have to
-compose your own report, and email it to B<perlbug@perl.com>.  You might
+compose your own report, and email it to B<perlbug@perl.org>.  You might
 find the B<-d> option useful to get summary information in that case.
 
 In any case, when reporting a bug, please make sure you have run through
@@ -982,7 +1046,7 @@ definitely be fixed.  Use the C<diff> program to generate your patches
 (C<diff> is being maintained by the GNU folks as part of the B<diffutils>
 package, so you should be able to get it from any of the GNU software
 repositories).  If you do submit a patch, the cool-dude counter at
-perlbug@perl.com will register you as a savior of the world.  Your
+perlbug@perl.org will register you as a savior of the world.  Your
 patch may be returned with requests for changes, or requests for more
 detailed explanations about your fix.
 
@@ -1002,7 +1066,7 @@ B<perlbug> will, amongst other things, ensure your report includes
 crucial information about your version of perl.  If C<perlbug> is unable
 to mail your report after you have typed it in, you may have to compose
 the message yourself, add the output produced by C<perlbug -d> and email
-it to B<perlbug@perl.com>.  If, for some reason, you cannot run
+it to B<perlbug@perl.org>.  If, for some reason, you cannot run
 C<perlbug> at all on your system, be sure to include the entire output
 produced by running C<perl -V> (note the uppercase V).
 
@@ -1029,7 +1093,14 @@ version of perl comes out and your bug is still present.
 
 =item B<-a>
 
-Address to send the report to.  Defaults to `perlbug@perl.com'.
+Address to send the report to.  Defaults to `perlbug@perl.org'.
+
+=item B<-A>
+
+Don't send a bug received acknowledgement to the reply address.
+Generally it is only a sensible to use this option if you are a
+perl maintainer actively watching perl porters for your message to
+arrive.
 
 =item B<-b>
 
@@ -1130,8 +1201,9 @@ by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>), Tom Christiansen
 Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
 (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
 Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>),
-Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), hris Nandor
-(E<lt>pudge@pobox.comE<gt>), and Jon Orwant (E<lt>orwant@media.mit.eduE<gt>).
+Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
+(E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
+and Richard Foley (E<lt>richard@rfi.netE<gt>).
 
 =head1 SEE ALSO