Add support for --help and --version in perlbug

RT 130032: Thanks to Houston Perl Mongers for contributing to this work at
our monthly meeting!

NPD

diff --git a/lib/perlbug.t b/lib/perlbug.t
index ed32c04..d4f1116 100644 (file)
--- a/lib/perlbug.t
+++ b/lib/perlbug.t
@@ -42,7 +42,7 @@ sub _dump {
         return 1;
 }
 
-plan(22);
+plan(25);
 
 
 # check -d
@@ -153,3 +153,13 @@ for (split(/\n/, $contents)) {
 }
 ok($maxlen1 < 1000, "[perl #128020] long body lines are wrapped: maxlen $maxlen1");
 ok($maxlen2 > 1000, "long attachment lines are not wrapped: maxlen $maxlen2");
+
+$result = runperl( progfile => $extracted_program, stderr => 1, args => ['-o'] ); # Invalid option
+like($result, qr/^\s*This program is designed/, "No leading error messages with help from invalid arg.");
+
+$result = runperl( progfile => $extracted_program, stderr => 1, args => ['--help'] ); # Invalid option
+like($result, qr/^\s*perlbug version \d+\.\d+\n\nThis program is designed/, "No leading error messages with help from --help and version is displayed.");
+
+$result = runperl( progfile => $extracted_program, stderr => 1, args => ['--version'] ); # Invalid option
+like($result, qr/^perlbug version \d+\.\d+\n$/, "No leading error messages with --version");
+#print $result;

diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index 2a440cd..3273902 100644 (file)
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -65,6 +65,8 @@ use File::Spec;               # keep perlbug Perl 5.005 compatible
 use Getopt::Std;
 use File::Basename 'basename';
 
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+
 sub paraprint;
 
 BEGIN {
@@ -81,7 +83,7 @@ BEGIN {
     $::HaveWrap = ($@ eq "");
 };
 
-my $Version = "1.40";
+our $VERSION = "1.41";
 
 #TODO:
 #       make sure failure (transmission-wise) of Mail::Send is accounted for.
@@ -185,6 +187,9 @@ EOF
     lc $alt;
 }
 
+sub HELP_MESSAGE { Help(); exit; }
+sub VERSION_MESSAGE { print "perlbug version $VERSION\n"; }
+
 sub Init {
     # -------- Setup --------
 
@@ -193,13 +198,6 @@ sub Init {
     $Is_Linux = lc($^O) eq 'linux';
     $Is_OpenBSD = lc($^O) eq 'openbsd';
 
-    if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt)) { Help(); exit; };
-
-    # This comment is needed to notify metaconfig that we are
-    # using the $perladmin, $cf_by, and $cf_time definitions.
-
-    # -------- Configuration ---------
-
     # perlbug address
     $bugaddress = 'perlbug@perl.org';
 
@@ -209,6 +207,16 @@ sub Init {
     # Thanks address
     $thanksaddress = 'perl-thanks@perl.org';
 
+    # Defaults if getopts fails.
+    $address = (basename ($0) =~ /^perlthanks/i) ? $thanksaddress : $bugaddress;
+    $cc = $::Config{'perladmin'} || $::Config{'cf_email'} || $::Config{'cf_by'} || '';
+
+    HELP_MESSAGE() unless getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt);
+
+    # This comment is needed to notify metaconfig that we are
+    # using the $perladmin, $cf_by, and $cf_time definitions.
+    # -------- Configuration ---------
+
     if (basename ($0) =~ /^perlthanks/i) {
        # invoked as perlthanks
        $opt{T} = 1;
@@ -241,7 +249,7 @@ sub Init {
 
     # We have one or more attachments
     $have_attachment = ($opt{p} || 0);
-    $mime_boundary = ('-' x 12) . "$Version.perlbug" if $have_attachment;
+    $mime_boundary = ('-' x 12) . "$VERSION.perlbug" if $have_attachment;
 
     # Comma-separated list of attachments
     $attachments = $opt{p} || "";
@@ -612,7 +620,7 @@ EOF
 
     print REP <<EOF;
 This is a $reptype report for perl from $from,
-generated with the help of perlbug $Version running under perl $perl_version.
+generated with the help of perlbug $VERSION running under perl $perl_version.
 
 EOF