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
# 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}
$::HaveUtil = ($@ eq "");
};
-my $Version = "1.27";
+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.
# 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
# TODO: - Allow the user to re-name the file on mail failure, and
# make sure failure (transmission-wise) of Mail::Send is
# - 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}";
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 --------
}
}
+ # 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();
}
# 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;
while (<F>) {
print REP $_
}
- close(F);
+ close(F) or die "Error closing `$file': $!";
} else {
print REP <<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
+ 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;
}
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);
# 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
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"
$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";
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";
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
projects / p5sagit/p5-mst-13.2.git / blobdiff