X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fperlbug.PL;h=b9906f8acfe53be96e8c25abff0fa7f6657c7e04;hb=abec23e71b5d54dc73752d78864a1da13b1510e0;hp=97f8d867da17a48df18bafefa8922ffb419c011e;hpb=1761cee512762c09b2a848d3c6cbd5a3b4232ffa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 97f8d86..b9906f8 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -37,15 +37,15 @@ my @patches; while () { 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.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. @@ -123,17 +123,25 @@ 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. +# 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, - $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, - $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok); +my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, $messageid, $domain, + $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity, + $fh, $me, $Is_MSWin32, $Is_Linux, $Is_VMS, $msg, $body, $andcc, %REP, $ok, + $Is_OpenBSD); -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 +156,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,18 +164,62 @@ 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 < 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 -------- $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+/, 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,10 +227,10 @@ sub Init { # -------- Configuration --------- # perlbug address - $perlbug = 'perlbug@perl.com'; + $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); @@ -204,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") @@ -266,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'} @@ -295,6 +358,11 @@ EOF } # Prompt for subject of message, if needed + + if (TrivialSubject($subject)) { + $subject = ''; + } + unless ($subject) { paraprint <; 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 @@ -330,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 { @@ -369,7 +427,7 @@ EOF # verify it print "Your address [$guess]: "; $from = <>; - chop $from; + chomp $from; $from = $guess if $from eq ''; } } @@ -389,7 +447,7 @@ a copy. EOF print "Local perl administrator [$cc]: "; my $entry = scalar <>; - chop $entry; + chomp $entry; if ($entry ne "") { $cc = $entry; @@ -427,7 +485,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") { @@ -437,6 +495,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(); @@ -448,7 +512,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 <$filename"); + open(REP,">$filename") or die "Unable to create report file `$filename': $!\n"; my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success"; print REP <) { print REP $_ } - close(F); + close(F) or die "Error closing `$file': $!"; } else { print 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 <; - chop $entry; + chomp $entry; $ed = $entry unless $entry eq ''; } 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); @@ -601,7 +679,7 @@ correct it here, otherwise just press Enter. EOF print "Editor [$ed]: "; my $entry =scalar <>; - chop $entry; + chomp $entry; if ($entry ne "") { $ed = $entry; @@ -618,7 +696,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 @@ -655,46 +733,62 @@ sub NowWhat { paraprint <; - chop $action; + chomp $action; if ($action =~ /^(f|sa)/i) { # ile/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"; 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 "Message-Id: $messageid\n" if $messageid; print FILE "\n"; while () { 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 ) { # isplay, ist, ow # Display the message - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n"; while () { print $_ } - close(REP); + close(REP) or die "Error closing report file `$filename': $!"; + } elsif ($action =~ /^su/i) { # 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 ; + chomp $reply; + if ($reply ne '') { + unless (TrivialSubject($reply)) { + $subject = $reply; + print "Subject: $subject\n"; + } + } } elsif ($action =~ /^se/i) { # end # Send the message print "Are you certain you want to send this message?\n" . 'Please type "yes" if you are: '; my $reply = scalar ; - chop $reply; + chomp $reply; if ($reply eq "yes") { last; } else { @@ -709,7 +803,7 @@ EOF Edit(); } elsif ($action =~ /^[qc]/i) { # ancel, uit Cancel(); - } elsif ($action =~ /^s/) { + } elsif ($action =~ /^s/i) { paraprint <$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; $fh = $msg->open; - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open `$filename': $!\n"; while () { print $fh $_ } - close(REP); + close(REP) or die "Error closing $filename: $!"; $fh->close; print "\nMessage sent.\n"; @@ -777,16 +888,17 @@ 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 "Message-Id: $messageid\n" if $messageid; print SENDMAIL "\n\n"; - open(REP, "<$filename"); + open(REP, "<$filename") or die "Couldn't open `$filename': $!\n"; while () { print SENDMAIL $_ } - close(REP); + close(REP) or die "Error closing $filename: $!"; if (close(SENDMAIL)) { printf "\nMessage %s.\n", $outfile ? "saved" : "sent"; @@ -807,7 +919,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 +941,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 +958,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 +991,10 @@ B S<[ B<-v> ]> S<[ B<-a> I
]> S<[ B<-s> I ]> S<[ B<-b> I | B<-f> I ]> S<[ B<-F> I ]> S<[ B<-r> I ]> S<[ B<-e> I ]> S<[ B<-c> I | 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 S<[ B<-v> ]> S<[ B<-r> I ]> -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 +1012,7 @@ will be needed. Simply run it, and follow the prompts. If you are unable to run B (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. You might +compose your own report, and email it to B. 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 +1090,7 @@ definitely be fixed. Use the C program to generate your patches (C is being maintained by the GNU folks as part of the B 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 +1110,7 @@ B will, amongst other things, ensure your report includes crucial information about your version of perl. If C 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 and email -it to B. If, for some reason, you cannot run +it to B. If, for some reason, you cannot run C at all on your system, be sure to include the entire output produced by running C (note the uppercase V). @@ -1029,7 +1137,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 B. + +=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> @@ -1114,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. =item B<-v> @@ -1129,9 +1244,10 @@ by Gurusamy Sarathy (Egsar@activestate.comE), Tom Christiansen (Etchrist@perl.comE), Nathan Torkington (Egnat@frii.comE), Charles F. Randall (Ecfr@pobox.comE), Mike Guy (Emjtg@cam.a.ukE), Dominic Dunlop (Edomo@computer.orgE), -Hugo van der Sanden (Ehv@crypt0.demon.co.ukE), -Jarkko Hietaniemi (Ejhi@iki.fiE), hris Nandor -(Epudge@pobox.comE), and Jon Orwant (Eorwant@media.mit.eduE). +Hugo van der Sanden (Ehv@crypt.org), +Jarkko Hietaniemi (Ejhi@iki.fiE), Chris Nandor +(Epudge@pobox.comE), Jon Orwant (Eorwant@media.mit.eduE, +and Richard Foley (Erichard@rfi.netE). =head1 SEE ALSO