From 12527e6c89dc3642bce883fbd5e6b9b48f5aef95 Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Tue, 18 Sep 2001 19:32:13 +0200 Subject: [PATCH] Getopt::Std cleanup Message-Id: <20010918173213.C777@rafael> p4raw-id: //depot/perl@12070 --- lib/Getopt/Std.pm | 29 ++++++++++++-------- lib/Getopt/Std.t | 82 +++++++++++++++++++++++++++---------------------------- 2 files changed, 59 insertions(+), 52 deletions(-) diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm index e5b369c..1e6413b 100644 --- a/lib/Getopt/Std.pm +++ b/lib/Getopt/Std.pm @@ -12,26 +12,30 @@ getopts - Process single-character switches with switch clustering use Getopt::Std; - getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. + getopt('oDI'); # -o, -D & -I take arg. Sets $opt_* as a side effect. getopt('oDI', \%opts); # -o, -D & -I take arg. Values in %opts getopts('oif:'); # -o & -i are boolean flags, -f takes an argument - # Sets opt_* as a side effect. + # Sets $opt_* as a side effect. getopts('oif:', \%opts); # options as above. Values in %opts =head1 DESCRIPTION -The getopt() functions processes single-character switches with switch +The getopt() function processes single-character switches with switch clustering. Pass one argument which is a string containing all switches that take an argument. For each switch found, sets $opt_x (where x is the switch name) to the value of the argument, or 1 if no argument. Switches which take an argument don't care whether there is a space between the switch and the argument. +The getopts() function is similar, but you should pass to it the list of all +switches to be recognized. If unspecified switches are found on the +command-line, the user will be warned that an unknown option was given. + Note that, if your code is running under the recommended C pragma, you will need to declare these package variables with "our": - our($opt_foo, $opt_bar); + our($opt_x, $opt_y); For those of you who don't like additional global variables being created, getopt() and getopts() will also accept a hash reference as an optional second argument. @@ -46,7 +50,7 @@ C<-->. The C<--> will be removed from @ARGV. @ISA = qw(Exporter); @EXPORT = qw(getopt getopts); -$VERSION = '1.02'; +$VERSION = '1.03'; # Process single-character switches with switch clustering. Pass one argument # which is a string containing all switches that take an argument. For each @@ -57,9 +61,11 @@ $VERSION = '1.02'; # Usage: # getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. -sub getopt ($;$) { - local($argumentative, $hash) = @_; - local($_,$first,$rest); +sub getopt (;$$) { + my ($argumentative, $hash) = @_; + $argumentative = '' if !defined $argumentative; + my ($first,$rest); + local $_; local @EXPORT; while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { @@ -111,9 +117,10 @@ sub getopt ($;$) { # # side effect. sub getopts ($;$) { - local($argumentative, $hash) = @_; - local(@args,$_,$first,$rest); - local($errs) = 0; + my ($argumentative, $hash) = @_; + my (@args,$first,$rest); + my $errs = 0; + local $_; local @EXPORT; @args = split( / */, $argumentative ); diff --git a/lib/Getopt/Std.t b/lib/Getopt/Std.t index fb70f10..35922ab 100755 --- a/lib/Getopt/Std.t +++ b/lib/Getopt/Std.t @@ -1,52 +1,56 @@ -#!./perl +#!./perl -wT BEGIN { chdir 't' if -d 't'; @INC = '../lib'; } -print "1..11\n"; - +use strict; +use Test::More tests => 21; use Getopt::Std; +our ($warning, $opt_f, $opt_i, $opt_o, $opt_x, $opt_y, %opt); + # First we test the getopt function @ARGV = qw(-xo -f foo -y file); getopt('f'); -print "not " if "@ARGV" ne 'file'; -print "ok 1\n"; - -print "not " unless $opt_x && $opt_o && opt_y; -print "ok 2\n"; +is( "@ARGV", 'file', 'options removed from @ARGV (1)' ); +ok( $opt_x && $opt_o && $opt_y, 'options -x, -o and -y set' ); +is( $opt_f, 'foo', q/option -f is 'foo'/ ); -print "not " unless $opt_f eq 'foo'; -print "ok 3\n"; +@ARGV = qw(-hij k -- -l m -n); +getopt 'il', \%opt; +is( "@ARGV", 'k -- -l m -n', 'options removed from @ARGV (2)' ); +ok( $opt{h} && $opt{i} eq 'j', 'option -h and -i correctly set' ); +ok( !defined $opt{l}, 'option -l not set' ); +ok( !defined $opt_i, '$opt_i still undefined' ); # Then we try the getopts $opt_o = $opt_i = $opt_f = undef; @ARGV = qw(-foi -i file); -getopts('oif:') or print "not "; -print "ok 4\n"; -print "not " unless "@ARGV" eq 'file'; -print "ok 5\n"; +ok( getopts('oif:'), 'getopts succeeded (1)' ); +is( "@ARGV", 'file', 'options removed from @ARGV (3)' ); +ok( $opt_i && $opt_f eq 'oi', 'options -i and -f correctly set' ); +ok( !defined $opt_o, 'option -o not set' ); -print "not " unless $opt_i and $opt_f eq 'oi'; -print "ok 6\n"; +%opt = (); $opt_i = undef; +@ARGV = qw(-hij -k -- -l m); -print "not " if $opt_o; -print "ok 7\n"; +ok( getopts('hi:kl', \%opt), 'getopts succeeded (2)' ); +is( "@ARGV", '-l m', 'options removed from @ARGV (4)' ); +ok( $opt{h} && $opt{k}, 'options -h and -k set' ); +is( $opt{i}, 'j', q/option -i is 'j'/ ); +ok( !defined $opt_i, '$opt_i still undefined' ); # Try illegal options, but avoid printing of the error message - -open(STDERR, ">stderr") || die; - +$SIG{__WARN__} = sub { $warning = $_[0] }; @ARGV = qw(-h help); -!getopts("xf:y") or print "not "; -print "ok 8\n"; - +ok( !getopts("xf:y"), 'getopts fails for an illegal option' ); +ok( $warning eq "Unknown option: h\n", 'user warned' ); # Then try the Getopt::Long module @@ -54,20 +58,16 @@ use Getopt::Long; @ARGV = qw(--help --file foo --foo --nobar --num=5 -- file); -GetOptions( - 'help' => \$HELP, - 'file:s' => \$FILE, - 'foo!' => \$FOO, - 'bar!' => \$BAR, - 'num:i' => \$NO, -) || print "not "; -print "ok 9\n"; - -print "not " unless $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5; -print "ok 10\n"; - -print "not " unless "@ARGV" eq "file"; -print "ok 11\n"; - -close STDERR; -unlink "stderr"; +our ($HELP, $FILE, $FOO, $BAR, $NO); + +ok( GetOptions( + 'help' => \$HELP, + 'file:s' => \$FILE, + 'foo!' => \$FOO, + 'bar!' => \$BAR, + 'num:i' => \$NO, + ), + 'Getopt::Long::GetOptions succeeded' +); +is( "@ARGV", 'file', 'options removed from @ARGV (5)' ); +ok( $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5, 'options set' ); -- 2.7.4