print OUT <<'!NO!SUBS!';
+use strict;
use Config;
use File::Spec; # keep perlbug Perl 5.005 compatible
use Getopt::Std;
-use strict;
+use File::Basename 'basename';
sub paraprint;
# accounted for.
# - Test -b option
-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( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
+ $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, $thanks, $Is_OpenBSD, $progname);
my $perl_version = $^V ? sprintf("%vd", $^V) : $];
if ($::opt_h) { Help(); exit; }
if ($::opt_d) { Dump(*STDOUT); exit; }
if (!-t STDIN && !($ok and not $::opt_n)) {
- paraprint <<EOF;
-Please use perlbug interactively. If you want to
+ paraprint <<"EOF";
+Please use $progname interactively. If you want to
include a file, you can use the -f switch.
EOF
die "\n";
'category' => {
'default' => 'core',
'ok' => 'install',
+ # Inevitably some of these will end up in RT whatever we do:
+ 'thanks' => 'thanks',
'opts' => [qw(core docs install library utilities)], # patch, notabug
},
'severity' => {
'default' => 'low',
'ok' => 'none',
+ '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'};
+ my $what = $ok || $thanks;
+ if ($what) {
+ $alt = $alts{$name}{$what};
} else {
my @alts = @{$alts{$name}{'opts'}};
paraprint <<EOF;
MacPerl::Ask('Provide command-line args here (-h for help):')
if $Is_MacOS && $MacPerl::Version =~ /App/;
- if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
+ if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T")) { Help(); exit; };
# This comment is needed to notify metaconfig that we are
# using the $perladmin, $cf_by, and $cf_time definitions.
# -------- Configuration ---------
# perlbug address
- $perlbug = 'perlbug@perl.org';
+ $bugaddress = 'perlbug@perl.org';
# Test address
$testaddress = 'perlbug-test@perl.org';
+ # Thanks address
+ $thanksaddress = 'perl-thanks@perl.org';
+
+ if (basename ($0) =~ /^perlthanks/i) {
+ # invoked as perlthanks
+ $::opt_T = 1;
+ $::opt_C = 1; # don't send a copy to the local admin
+ }
+
+ if ($::opt_T) {
+ $thanks = 'thanks';
+ }
+
+ $progname = $thanks ? 'perlthanks' : 'perlbug';
# Target address
- $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
+ $address = $::opt_a || ($::opt_t ? $testaddress
+ : $thanks ? $thanksaddress : $bugaddress);
# Users address, used in message and in Reply-To header
$from = $::opt_r || "";
}
# OK - send "OK" report for build on this system
- $ok = 0;
+ $ok = '';
if ($::opt_o) {
if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
my $age = time - $patchlevel_date;
$subject = ($::opt_n ? 'Not ' : '')
. "OK: perl $perl_version ${patch_tags}on"
." $::Config{'archname'} $::Config{'osvers'} $subject";
- $ok = 1;
+ $ok = 'ok';
} else {
Help();
exit();
sub Query {
# Explain what perlbug is
unless ($ok) {
- paraprint <<EOF;
+ if ($thanks) {
+ paraprint <<'EOF';
+This program provides an easy way to send a thank-you message back to the
+authors and maintainers of perl.
+
+If you wish to submit a bug report, please run it without the -T flag
+(or run the program perlbug rather than perlthanks)
+EOF
+ } else {
+ paraprint <<"EOF";
This program provides an easy way to create a message reporting a bug
in perl, and e-mail it to $address. It is *NOT* intended for
sending test messages or simply verifying that perl works, *NOR* is it
If you're just looking for help with perl, try posting to the Usenet
newsgroup comp.lang.perl.misc. If you're looking for help with using
perl with CGI, try posting to comp.infosystems.www.programming.cgi.
+
+When invoked as perlthanks (or with the -T option) it can be used to
+send a thank-you message to $thanksaddress.
EOF
+ }
}
# Prompt for subject of message, if needed
}
unless ($subject) {
- paraprint <<EOF;
+ if ($thanks) {
+ paraprint "First of all, please provide a subject for the message.\n";
+ } else {
+ paraprint <<EOF;
First of all, please provide a subject for the
message. It should be a concise description of
the bug or problem. "perl bug" or "perl problem"
is not a concise description.
EOF
+ }
my $err = 0;
do {
$subject = <>;
chomp $subject;
if ($err++ == 5) {
- die "Aborting.\n";
+ if ($thanks) {
+ $subject = 'Thanks for Perl';
+ } else {
+ die "Aborting.\n";
+ }
}
} while (TrivialSubject($subject));
}
# Prompt for editor, if no override is given
editor:
unless ($::opt_e || $::opt_f || $::opt_b) {
- paraprint <<EOF;
+ chomp (my $common_end = <<"EOF");
+
+You will probably want to use an editor to enter
+the report. If "$ed" is the editor you want
+to use, then just press Enter, otherwise type in
+the name of the editor you would like to use.
+
+If you would like to use a prepared file, type
+"file", and you will be asked for the filename.
+EOF
+
+ if ($thanks) {
+ paraprint <<"EOF";
+Now you need to supply your thank-you message.
+
+Some information about your local perl configuration
+will automatically be included at the end of the message,
+because we're curious about the different ways that people
+build perl, but you're welcome to delete it if you wish.
+
+$common_end
+EOF
+ } else {
+ paraprint <<"EOF";
Now you need to supply the bug report. Try to make
the report concise but descriptive. Include any
relevant detail. If you are reporting something
unusual version of perl, please try and confirm
exactly which versions are relevant.
-You will probably want to use an editor to enter
-the report. If "$ed" is the editor you want
-to use, then just press Enter, otherwise type in
-the name of the editor you would like to use.
-
-If you would like to use a prepared file, type
-"file", and you will be asked for the filename.
+$common_end
EOF
+ }
+
print "Editor [$ed]: ";
my $entry =scalar <>;
chomp $entry;
}
}
my $report_about_module = '';
- if ($::HaveCoreList && !$ok) {
+ if ($::HaveCoreList && !$ok && !$thanks) {
paraprint <<EOF;
Is your report about a Perl module? If yes, enter its name. If not, skip.
EOF
# Generate report
open(REP,">$filename") or die "Unable to create report file `$filename': $!\n";
- my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
+ my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
+ : $::opt_n ? "build failure" : "success";
print REP <<EOF;
This is a $reptype report for perl from $from,
}
close(F) or die "Error closing `$file': $!";
} else {
- print REP <<EOF;
+ if ($thanks) {
+ print REP <<'EOF';
+
+-----------------------------------------------------------------
+[Please enter your thank you message here]
+
+
+
+[You're welcome to delete anything below this line if you prefer]
+-----------------------------------------------------------------
+EOF
+ } else {
+ print REP <<'EOF';
-----------------------------------------------------------------
[Please enter your report here]
[Please do not change anything below this line]
-----------------------------------------------------------------
EOF
+ }
}
Dump(*REP);
close(REP) or die "Error closing report file: $!";
chomp $action;
if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
- my $file_save = $outfile || "perlbug.rep";
+ my $file_save = $outfile || "$progname.rep";
print "\n\nName of file to save message in [$file_save]: ";
my $file = scalar <>;
chomp $file;
this if you don't give it here.
-e Editor to use.
-t Test mode. The target address defaults to `$testaddress'.
+ -T Thank-you mode. The target address defaults to
-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.
projects / p5sagit/p5-mst-13.2.git / commitdiff