Front page | perl.perl5.porters |
Postings from April 2003
[PATCH 5.8.1 @19053] Getopt::Std
Thread Next
From:
Ilya Zakharevich
Date:
April 1, 2003 15:58
Subject:
[PATCH 5.8.1 @19053] Getopt::Std
Message ID:
20030401235830.GA4912@math.berkeley.edu
This patch updates getopts() to the world of today.
Please think about how to make the messages more readable.
Enjoy,
Ilya
--- ./lib/Getopt/Std.pm-pre Fri Jul 19 16:49:48 2002
+++ ./lib/Getopt/Std.pm Tue Apr 1 15:54:48 2003
@@ -46,11 +46,26 @@ To allow programs to process arguments t
both functions will stop processing switches when they see the argument
C<-->. The C<--> will be removed from @ARGV.
+=head1 C<--help> and C<--version>
+
+If C<-> is not a recognized option letter, getopts() supports arguments
+C<--help> and C<--version>. If C<HELP_MESSAGE()> or C<VERSION_MESSAGE()> are
+defined in the package C<main>, they are called (with the switches string
+and C<GetOpt::Std> version as arguments); if not, an attempt is made to
+generate intelligent messages; for best results, define $main::VERSION.
+
+In presence of these arguments getopts() calls
+C<exit($GetOpt::Std::EXIT_ON_HELP_VERSION)> if
+$GetOpt::Std::EXIT_ON_HELP_VERSION is defined.
+
+One can print the messages of C<--help> and C<--version> by calling functions
+help_mess() and version_mess() with the switches string as an argument.
+
=cut
@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
-$VERSION = '1.03';
+$VERSION = '1.04';
# Process single-character switches with switch clustering. Pass one argument
# which is a string containing all switches that take an argument. For each
@@ -112,19 +127,57 @@ sub getopt (;$$) {
}
}
+sub version_mess ($;$) {
+ my $args = shift;
+ if (@ARGV and defined &main::VERSION_MESSAGE) {
+ main::VERSION_MESSAGE($args, $VERSION);
+ } else {
+ my $v = $main::VERSION;
+ $v = '[unknown]' unless defined $v;
+ print <<EOH;
+$0 version $v calling Getopt::Std::getopts (version $VERSION),
+running under Perl version $].
+EOH
+ }
+}
+
+sub help_mess ($;$) {
+ my $args = shift;
+ if (@ARGV and defined &main::HELP_MESSAGE) {
+ main::HELP_MESSAGE($args, $VERSION);
+ } else {
+ my (@witharg) = ($args =~ /(\S)\s*:/g);
+ my (@rest) = ($args =~ /([^\s:])(?!\s*:)/g);
+ my ($help, $arg) = ('', '');
+ if (@witharg) {
+ $help .= "\n\tWith arguments: -" . join " -", @witharg;
+ $arg = "\nSpace is not required between options and their arguments.";
+ }
+ if (@rest) {
+ $help .= "\n\tBoolean (without arguments): -" . join " -", @rest;
+ }
+ my ($scr) = ($0 =~ m,([^/\\]+)$,);
+ print <<EOH;
+Usage: $scr [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
+The following single-character options are accepted:$help
+Options may be merged together. -- stops processing of options.$arg
+EOH
+ }
+}
+
# Usage:
# getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
# # side effect.
sub getopts ($;$) {
my ($argumentative, $hash) = @_;
- my (@args,$first,$rest);
+ my (@args,$first,$rest,$exit);
my $errs = 0;
local $_;
local @EXPORT;
@args = split( / */, $argumentative );
- while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+ while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/s) {
($first,$rest) = ($1,$2);
if (/^--$/) { # early exit if --
shift @ARGV;
@@ -163,6 +216,18 @@ sub getopts ($;$) {
}
}
else {
+ if ($first eq '-' and $rest eq 'help') {
+ version_mess($argumentative, 'main');
+ help_mess($argumentative, 'main');
+ shift(@ARGV);
+ $exit = 1;
+ next;
+ } elsif ($first eq '-' and $rest eq 'version') {
+ version_mess($argumentative, 'main');
+ shift(@ARGV);
+ $exit = 1;
+ next;
+ }
warn "Unknown option: $first\n";
++$errs;
if ($rest ne '') {
@@ -177,6 +242,7 @@ sub getopts ($;$) {
local $Exporter::ExportLevel = 1;
import Getopt::Std;
}
+ exit $EXIT_ON_HELP_VERSION if $exit and defined $EXIT_ON_HELP_VERSION;
$errs == 0;
}
Thread Next
-
[PATCH 5.8.1 @19053] Getopt::Std
by Ilya Zakharevich