threads::async + some cleanup

[p5sagit/p5-mst-13.2.git] / utils / perlbug.PL

diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index de848ae..b9906f8 100644 (file)
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -91,7 +91,7 @@ BEGIN {
     $::HaveUtil = ($@ eq "");
 };
 
-my $Version = "1.33";
+my $Version = "1.34";
 
 # 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.
@@ -129,15 +129,17 @@ my $Version = "1.33";
 # 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.
+# Changed in 1.34 Added Message-Id RFOLEY 18-06-2002 
 
 # TODO: - Allow the user to re-name the file on mail failure, and
 #       make sure failure (transmission-wise) of Mail::Send is
 #       accounted for.
 #       - Test -b option
 
-my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
+my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, $messageid, $domain,
     $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
-    $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
+    $fh, $me, $Is_MSWin32, $Is_Linux, $Is_VMS, $msg, $body, $andcc, %REP, $ok,
+    $Is_OpenBSD);
 
 my $perl_version = $^V ? sprintf("v%vd", $^V) : $];
 
@@ -209,6 +211,8 @@ sub Init {
 
     $Is_MSWin32 = $^O eq 'MSWin32';
     $Is_VMS = $^O eq 'VMS';
+    $Is_Linux = lc($^O) eq 'linux';
+    $Is_OpenBSD = lc($^O) eq 'openbsd';
     $Is_MacOS = $^O eq 'MacOS';
 
     @ARGV = split m/\s+/,
@@ -226,7 +230,7 @@ sub Init {
     $perlbug = 'perlbug@perl.org';
 
     # Test address
-    $testaddress = 'perlbug-test@perl.com';
+    $testaddress = 'perlbug-test@perl.org';
 
     # Target address
     $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
@@ -251,7 +255,7 @@ sub Init {
 
     # Body of report
     $body = $::opt_b || "";
-
+       
     # Editor
     $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
        || ($Is_VMS && "edit/tpu")
@@ -313,6 +317,18 @@ EOF
        || $::Config{'cf_email'} || $::Config{'cf_by'}
     );
 
+    if ($::HaveUtil) {
+               $domain = Mail::Util::maildomain();
+    } elsif ($Is_MSWin32) {
+               $domain = $ENV{'USERDOMAIN'};
+    } else {
+               require Sys::Hostname;
+               $domain = Sys::Hostname::hostname();
+    }
+
+    # Message-Id - rjsf
+    $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>"; 
+
     # My username
     $me = $Is_MSWin32 ? $ENV{'USERNAME'}
            : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
@@ -380,16 +396,8 @@ EOF
         }
 
        unless ($guess) {
-           my $domain;
-           if ($::HaveUtil) {
-               $domain = Mail::Util::maildomain();
-           } elsif ($Is_MSWin32) {
-               $domain = $ENV{'USERDOMAIN'};
-           } else {
-               require Sys::Hostname;
-               $domain = Sys::Hostname::hostname();
-           }
-           if ($domain) {
+               # move $domain to where we can use it elsewhere 
+        if ($domain) {
                if ($Is_VMS && !$::Config{'d_socket'}) {
                    $guess = "$domain\:\:$me";
                } else {
@@ -749,6 +757,7 @@ EOF
                print FILE "To: $address\nSubject: $subject\n";
                print FILE "Cc: $cc\n" if $cc;
                print FILE "Reply-To: $from\n" if $from;
+               print FILE "Message-Id: $messageid\n" if $messageid;
                print FILE "\n";
                while (<REP>) { print FILE }
                close(REP) or die "Error closing report file `$filename': $!";
@@ -822,7 +831,11 @@ sub Send {
        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 && !$Is_OpenBSD) {
        $msg = new Mail::Send Subject => $subject, To => $address;
        $msg->cc($cc) if $cc;
        $msg->add("Reply-To",$from) if $from;
@@ -881,6 +894,7 @@ sendout:
        print SENDMAIL "Subject: $subject\n";
        print SENDMAIL "Cc: $cc\n" if $cc;
        print SENDMAIL "Reply-To: $from\n" if $from;
+       print SENDMAIL "Message-Id: $messageid\n" if $messageid;
        print SENDMAIL "\n\n";
        open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
        while (<REP>) { print SENDMAIL $_ }
@@ -1123,7 +1137,7 @@ version of perl comes out and your bug is still present.
 
 =item B<-a>
 
-Address to send the report to.  Defaults to `perlbug@perl.org'.
+Address to send the report to.  Defaults to B<perlbug@perl.org>.
 
 =item B<-A>
 
@@ -1215,7 +1229,7 @@ supply one on the command line.
 
 =item B<-t>
 
-Test mode.  The target address defaults to `perlbug-test@perl.com'.
+Test mode.  The target address defaults to B<perlbug-test@perl.org>.
 
 =item B<-v>
 
@@ -1230,7 +1244,7 @@ by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>), Tom Christiansen
 (E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
 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>),
+Hugo van der Sanden (E<lt>hv@crypt.org<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>).