[patch utils/perlbug] subject header setting problem
[p5sagit/p5-mst-13.2.git] / utils / perlbug.PL
index d9389ce..27fde11 100644 (file)
@@ -91,7 +91,7 @@ BEGIN {
     $::HaveUtil = ($@ eq "");
 };
 
-my $Version = "1.31";
+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.
@@ -127,6 +127,8 @@ my $Version = "1.31";
 # 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
@@ -134,8 +136,8 @@ my $Version = "1.31";
 #       - Test -b option
 
 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
-    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity, 
-    $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
+    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
+    $fh, $me, $Is_MSWin32, $Is_Linux, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
 
 my $perl_version = $^V ? sprintf("v%vd", $^V) : $];
 
@@ -152,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);
@@ -173,9 +174,9 @@ sub ask_for_alternatives { # (category|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); 
+    die "Invalid alternative($name) requested\n" unless grep(/^$name$/, keys %alts);
     my $alt = "";
     if ($ok) {
        $alt = $alts{$name}{'ok'};
@@ -208,13 +209,14 @@ sub Init {
 
     $Is_MSWin32 = $^O eq 'MSWin32';
     $Is_VMS = $^O eq 'VMS';
+    $Is_Linux = lc($^O) eq 'linux';
     $Is_MacOS = $^O eq 'MacOS';
 
     @ARGV = split m/\s+/,
         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.
@@ -222,7 +224,7 @@ sub Init {
     # -------- Configuration ---------
 
     # perlbug address
-    $perlbug = 'perlbug@perl.com';
+    $perlbug = 'perlbug@perl.org';
 
     # Test address
     $testaddress = 'perlbug-test@perl.com';
@@ -341,6 +343,11 @@ EOF
     }
 
     # Prompt for subject of message, if needed
+    
+    if (TrivialSubject($subject)) {
+       $subject = '';
+    }
+
     unless ($subject) {
        paraprint <<EOF;
 First of all, please provide a subject for the
@@ -348,18 +355,16 @@ message. It should be a concise description of
 the bug or problem. "perl bug" or "perl problem"
 is not a concise description.
 EOF
-       print "Subject: ";
-       $subject = <>;
 
        my $err = 0;
-       while ($subject !~ /\S/) {
-           print "\nPlease enter a subject: ";
+       do {
+           print "Subject: ";
            $subject = <>;
-           if ($err++ > 5) {
+           chomp $subject;
+           if ($err++ == 5) {
                die "Aborting.\n";
            }
-       }
-       chop $subject;
+       } while (TrivialSubject($subject));
     }
 
     # Prompt for return address, if needed
@@ -415,7 +420,7 @@ EOF
            # verify it
            print "Your address [$guess]: ";
            $from = <>;
-           chop $from;
+           chomp $from;
            $from = $guess if $from eq '';
        }
     }
@@ -435,7 +440,7 @@ a copy.
 EOF
        print "Local perl administrator [$cc]: ";
        my $entry = scalar <>;
-       chop $entry;
+       chomp $entry;
 
        if ($entry ne "") {
            $cc = $entry;
@@ -473,7 +478,7 @@ If you would like to use a prepared file, type
 EOF
        print "Editor [$ed]: ";
        my $entry =scalar <>;
-       chop $entry;
+       chomp $entry;
 
        $usefile = 0;
        if ($entry eq "file") {
@@ -500,7 +505,7 @@ What is the name of the file that contains your report?
 EOF
        print "Filename: ";
        my $entry = scalar <>;
-       chop $entry;
+       chomp $entry;
 
        if ($entry eq "") {
            paraprint <<EOF;
@@ -573,6 +578,13 @@ sub Dump {
 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",
@@ -610,7 +622,7 @@ EOF
     my @env =
         qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
     push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
-    push @env, grep /^(?:PERL|LC_|LANG)/, keys %ENV;
+    push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
     my %env;
     @env{@env} = @env;
     for my $env (sort keys %env) {
@@ -637,7 +649,7 @@ Please make sure that the name of the editor you want to use is correct.
 EOF
        print "Editor [$ed]: ";
        my $entry =scalar <>;
-       chop $entry;
+       chomp $entry;
        $ed = $entry unless $entry eq '';
     }
 
@@ -660,7 +672,7 @@ correct it here, otherwise just press Enter.
 EOF
        print "Editor [$ed]: ";
        my $entry =scalar <>;
-       chop $entry;
+       chomp $entry;
 
        if ($entry ne "") {
            $ed = $entry;
@@ -714,19 +726,21 @@ sub NowWhat {
            paraprint <<EOF;
 Now that you have completed your report, would you like to send
 the message to $address$andcc, display the message on
-the screen, re-edit it, or cancel without sending anything?
+the screen, re-edit it, display/change the subject,
+or cancel without sending anything?
 You may also save the message as a file to mail at another time.
 EOF
       retry:
-           print "Action (Send/Display/Edit/Cancel/Save to File): ";
+           print "Action (Send/Display/Edit/Subject/Save to File): ";
            my $action = scalar <>;
-           chop $action;
+           chomp $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 "";
+               chomp $file;
+               $file = $file_save if $file eq "";
 
                unless (open(FILE, ">$file")) {
                    print "\nError opening $file: $!\n\n";
@@ -748,12 +762,25 @@ EOF
                open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
                while (<REP>) { print $_ }
                close(REP) or die "Error closing report file `$filename': $!";
+           } elsif ($action =~ /^su/i) { # <Su>bject
+               print "Subject: $subject\n";
+               print "If the above subject is fine, just press Enter.\n";
+               print "If not, type in the new subject.\n";
+               print "Subject: ";
+               my $reply = scalar <STDIN>;
+               chomp $reply;
+               if ($reply ne '') {
+                   unless (TrivialSubject($reply)) {
+                       $subject = $reply;
+                       print "Subject: $subject\n";
+                   }
+               }
            } elsif ($action =~ /^se/i) { # <S>end
                # Send the message
                print "Are you certain you want to send this message?\n"
                    . 'Please type "yes" if you are: ';
                my $reply = scalar <STDIN>;
-               chop $reply;
+               chomp $reply;
                if ($reply eq "yes") {
                    last;
                } else {
@@ -768,7 +795,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
@@ -777,13 +804,30 @@ EOF
     }
 } # sub NowWhat
 
+sub TrivialSubject {
+    my $subject = shift;
+    if ($subject =~
+       /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
+       length($subject) < 4 ||
+       $subject !~ /\s/) {
+       print "\nThat doesn't look like a good subject.  Please be more verbose.\n\n";
+        return 1;
+    } else {
+       return 0;
+    }
+}
+
 sub Send {
     # Message has been accepted for transmission -- Send the message
     if ($outfile) {
        open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
        goto sendout;
     }
-    if ($::HaveSend) {
+
+    # on linux certain mail implementations won't accept the subject
+    # as "~s subject" and thus the Subject header will be corrupted
+    # so don't use Mail::Send to be safe
+    if ($::HaveSend && !$Is_Linux) {
        $msg = new Mail::Send Subject => $subject, To => $address;
        $msg->cc($cc) if $cc;
        $msg->add("Reply-To",$from) if $from;
@@ -836,7 +880,7 @@ 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";
@@ -866,7 +910,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.
 
@@ -888,9 +932,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.
@@ -905,12 +949,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);
 }
@@ -942,10 +982,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
 
@@ -963,7 +1003,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
@@ -1041,7 +1081,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.
 
@@ -1061,7 +1101,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).
 
@@ -1088,7 +1128,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>