X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fperlbug.PL;h=d9389ce7d14ee6d66e9ddf43ceba65dd86c5943f;hb=aaa68c4a88ea4a62f62819baf4cacc0ca679c5fa;hp=208da3667c4a0b231236ff26aba5307694511794;hpb=158f8ee5d0a06552c1de9eceef93cfd383751c07;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 208da36..d9389ce 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -45,7 +45,7 @@ while () { 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 @@ -91,7 +91,7 @@ BEGIN { $::HaveUtil = ($@ eq ""); }; -my $Version = "1.28"; +my $Version = "1.31"; # 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. @@ -124,6 +124,9 @@ my $Version = "1.28"; # 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 # TODO: - Allow the user to re-name the file on mail failure, and # make sure failure (transmission-wise) of Mail::Send is @@ -158,30 +161,45 @@ Send(); exit; -sub ask_for_alternatives { +sub ask_for_alternatives { # (category|severity) my $name = shift; - my $default = shift; - my @alts = @_; + 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 = ""; - paraprint < 5) { - die "Invalid $name: aborting.\n"; - } - print "Please enter a \u$name [$default]: "; - $alt = <>; - chomp $alt; - if ($alt =~ /^\s*$/) { - $alt = $default; - } - } while ($alt !~ /^($joined_alts)$/i); + 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; } @@ -276,8 +294,6 @@ EOF $subject = ($::opt_n ? 'Not ' : '') . "OK: perl $perl_version ${patch_tags}on" ." $::Config{'archname'} $::Config{'osvers'} $subject"; - $category = "install"; - $severity = "none"; $ok = 1; } else { Help(); @@ -468,14 +484,10 @@ EOF } # Prompt for category of bug - $category ||= ask_for_alternatives("category", "core", - qw(core docs install - library utilities)); + $category ||= ask_for_alternatives('category'); # Prompt for severity of bug - $severity ||= ask_for_alternatives("severity", "low", - qw(critical high medium - low wishlist none)); + $severity ||= ask_for_alternatives('severity'); # Generate scratch file to edit report in $filename = filename(); @@ -509,7 +521,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 <) { 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 { @@ -630,7 +642,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); @@ -664,7 +677,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 @@ -719,22 +732,22 @@ EOF 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 () { 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 =~ /^se/i) { # end # Send the message print "Are you certain you want to send this message?\n" @@ -776,9 +789,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 () { print $fh $_ } - close(REP); + close(REP) or die "Error closing $filename: $!"; $fh->close; print "\nMessage sent.\n"; @@ -830,9 +843,9 @@ sendout: 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 () { print SENDMAIL $_ } - close(REP); + close(REP) or die "Error closing $filename: $!"; if (close(SENDMAIL)) { printf "\nMessage %s.\n", $outfile ? "saved" : "sent";