From: Rafael Garcia-Suarez Date: Thu, 1 Jan 2004 13:30:33 +0000 (+0000) Subject: Upgrade to Getopt::Long 2.34_01 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d4ad7505816033c2e950d2aa89065971498a2b29;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Getopt::Long 2.34_01 p4raw-id: //depot/perl@22029 --- diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index 0f2fa5a..d47093d 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -2,12 +2,12 @@ package Getopt::Long; -# RCS Status : $Id: GetoptLong.pm,v 2.68 2003-09-23 15:24:53+02 jv Exp $ +# RCS Status : $Id: GetoptLong.pm,v 2.68 2003-09-23 15:24:53+02 jv Exp jv $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Tue Sep 23 15:21:23 2003 -# Update Count : 1364 +# Last Modified On: Wed Dec 31 20:48:15 2003 +# Update Count : 1440 # Status : Released ################ Copyright ################ @@ -35,10 +35,10 @@ use 5.004; use strict; use vars qw($VERSION); -$VERSION = 2.34; +$VERSION = 2.3401; # For testing versions only. -#use vars qw($VERSION_STRING); -#$VERSION_STRING = "2.33_03"; +use vars qw($VERSION_STRING); +$VERSION_STRING = "2.34_01"; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK); @@ -73,6 +73,7 @@ sub ConfigDefaults(); sub ParseOptionSpec($$); sub OptCtl($); sub FindOption($$$$); +sub ValidValue ($$$$$); ################ Local Variables ################ @@ -230,7 +231,7 @@ use constant CTL_TYPE => 0; use constant CTL_CNAME => 1; -use constant CTL_MAND => 2; +use constant CTL_DEFAULT => 2; use constant CTL_DEST => 3; use constant CTL_DEST_SCALAR => 0; @@ -238,7 +239,8 @@ use constant CTL_DEST => 3; use constant CTL_DEST_HASH => 2; use constant CTL_DEST_CODE => 3; -use constant CTL_DEFAULT => 4; +use constant CTL_AMIN => 4; +use constant CTL_AMAX => 5; # FFU. #use constant CTL_RANGE => ; @@ -474,7 +476,8 @@ sub GetOptions(@) { # FindOption undefines $opt in case of errors. next unless defined $opt; - if ( defined $arg ) { + my $argcnt = 0; + while ( defined $arg ) { # Get the canonical name. print STDERR ("=> cname for \"$opt\" is ") if $debug; @@ -606,6 +609,36 @@ sub GetOptions(@) { $userlinkage->{$opt} = $arg; } } + + $argcnt++; + last if $argcnt >= $ctl->[CTL_AMAX]; + undef($arg); + + # Need more args? + if ( $argcnt < $ctl->[CTL_AMIN] ) { + if ( @ARGV ) { + if ( ValidValue($ctl, $ARGV[0], 1, $argend, $prefix) ) { + $arg = shift(@ARGV); + ($key,$arg) = $arg =~ /^([^=]+)=(.*)/ + if $ctl->[CTL_DEST] == CTL_DEST_HASH; + next; + } + warn("Value \"$ARGV[0]\" invalid for option $opt\n"); + $error++; + } + else { + warn("Insufficient arguments for option $opt\n"); + $error++; + } + } + + # Any more args? + if ( @ARGV && ValidValue($ctl, $ARGV[0], 0, $argend, $prefix) ) { + $arg = shift(@ARGV); + ($key,$arg) = $arg =~ /^([^=]+)=(.*)/ + if $ctl->[CTL_DEST] == CTL_DEST_HASH; + next; + } } } @@ -670,9 +703,10 @@ sub OptCtl ($) { join(",", "\"$v[CTL_TYPE]\"", "\"$v[CTL_CNAME]\"", - $v[CTL_MAND] ? "O" : "M", - ("\$","\@","\%","\&")[$v[CTL_DEST] || 0], "\"$v[CTL_DEFAULT]\"", + ("\$","\@","\%","\&")[$v[CTL_DEST] || 0], + $v[CTL_AMIN] || '', + $v[CTL_AMAX] || '', # $v[CTL_RANGE] || '', # $v[CTL_REPEAT] || '', ). "]"; @@ -694,8 +728,8 @@ sub ParseOptionSpec ($$) { # Either modifiers ... [!+] | - # ... or a value/dest specification - [=:] [ionfs] [@%]? + # ... or a value/dest/repeat specification + [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )? | # ... or an optional-with-default spec : (?: -?\d+ | \+ ) [@%]? @@ -729,9 +763,9 @@ sub ParseOptionSpec ($$) { my $entry; if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) { # Fields are hard-wired here. - $entry = [$spec,$orig,0,CTL_DEST_SCALAR,undef]; + $entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0]; } - elsif ( $spec =~ /:(-?\d+|\+)([@%])?/ ) { + elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) { my $def = $1; my $dest = $2; my $type = $def eq '+' ? 'I' : 'i'; @@ -739,16 +773,35 @@ sub ParseOptionSpec ($$) { $dest = $dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR; # Fields are hard-wired here. - $entry = [$type,$orig,0,$dest,$def eq '+' ? undef : $def]; + $entry = [$type,$orig,$def eq '+' ? undef : $def, + $dest,0,1]; } else { - my ($mand, $type, $dest) = $spec =~ /([=:])([ionfs])([@%])?/; + my ($mand, $type, $dest) = + $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/; + return (undef, "Cannot repeat while bundling: \"$opt\"\n") + if $bundling && defined($4); + my ($mi, $cm, $ma) = ($5, $6, $7); + return (undef, "{0} is useless in option spec: \"$opt\"\n") + if defined($mi) && !$mi && !defined($ma) && !defined($cm); + $type = 'i' if $type eq 'n'; $dest ||= '$'; $dest = $dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR; + # Default minargs to 1/0 depending on mand status. + $mi = $mand eq '=' ? 1 : 0 unless defined $mi; + # Adjust mand status according to minargs. + $mand = $mi ? '=' : ':'; + # Adjust maxargs. + $ma = $mi ? $mi : 1 unless defined $ma || defined $cm; + return (undef, "Max must be greater than zero in option spec: \"$opt\"\n") + if defined($ma) && !$ma; + return (undef, "Max less than min in option spec: \"$opt\"\n") + if defined($ma) && $ma < $mi; + # Fields are hard-wired here. - $entry = [$type,$orig,$mand eq '=',$dest,undef]; + $entry = [$type,$orig,undef,$dest,$mi,$ma||-1]; } # Process all names. First is canonical, the rest are aliases. @@ -942,7 +995,7 @@ sub FindOption ($$$$) { } # Get mandatory status and type info. - my $mand = $ctl->[CTL_MAND]; + my $mand = $ctl->[CTL_AMIN]; # Check if there is an option argument available. if ( $gnu_compat && defined $optarg && $optarg eq '' ) { @@ -1101,6 +1154,47 @@ sub FindOption ($$$$) { return (1, $opt, $ctl, $arg, $key); } +sub ValidValue ($$$$$) { + my ($ctl, $arg, $mand, $argend, $prefix) = @_; + + if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) { + return 0 unless $arg =~ /[^=]+=(.*)/; + $arg = $1; + } + + my $type = $ctl->[CTL_TYPE]; + + if ( $type eq 's' ) { # string + # A mandatory string takes anything. + return (1) if $mand; + + return (1) if $arg eq "-"; + + # Check for option or option list terminator. + return 0 if $arg eq $argend || $arg =~ /^$prefix.+/; + return 1; + } + + elsif ( $type eq 'i' # numeric/integer + || $type eq 'I' # numeric/integer w/ incr default + || $type eq 'o' ) { # dec/oct/hex/bin value + + my $o_valid = + $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*" + : "[-+]?[0-9]+"; + + return $arg =~ /^$o_valid$/si; + } + + elsif ( $type eq 'f' ) { # real number, int is also ok + # We require at least one digit before a point or 'e', + # and at least one digit following the point and 'e'. + # [-]NN[.NN][eNN] + return $arg =~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/; + } + die("ValidValue: Cannot happen\n"); +} + # Getopt::Long Configuration. sub Configure (@) { my (@options) = @_; @@ -1523,6 +1617,26 @@ and join() operators: Of course, it is important to choose the right separator string for each purpose. +Warning: What follows is an experimental feature. + +Options can take multiple values at once, for example + + --coordinates 52.2 16.4 --rgbcolor 255 255 149 + +This can be accomplished by adding a repeat specifier to the option +specification. Repeat specifiers are very similar to the C<{...}> +repeat specifiers that can be used with regular expression patterns. +For example, the above command line would be handled as follows: + + GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color); + +The destination for the option must be an array or array reference. + +It is also possible to specify the minimal and maximal number of +arguments an option takes. C indicates an option that +takes at least two and at most 4 arguments. C indicates one +or more values; C indicates zero or more option values. + =head2 Options with hash values If the option destination is a reference to a hash, the option will @@ -1641,7 +1755,7 @@ resulting in a value of 3 (provided it was 0 or undefined at first). The C<+> specifier is ignored if the option destination is not a scalar. -=item = I [ I ] +=item = I [ I ] [ I ] The option requires an argument of the given type. Supported types are: @@ -1678,6 +1792,17 @@ list or a hash valued. This is only needed when the destination for the option value is not otherwise specified. It should be omitted when not needed. +The I specifies the number of values this option takes per +occurrence on the command line. It has the format C<{> [ I ] [ C<,> [ I ] ] C<}>. + +I denotes the minimal number of arguments. It defaults to 1 for +options with C<=> and to 0 for options with C<:>, see below. Note that +I overrules the C<=> / C<:> semantics. + +I denotes the maximum number of arguments. It must be at least +I. If I is omitted, I, there is no +upper bound to the number of argument values taken. + =item : I [ I ] Like C<=>, but designates the argument as optional. diff --git a/lib/Getopt/Long/CHANGES b/lib/Getopt/Long/CHANGES index a06357d..2c77c5e 100644 --- a/lib/Getopt/Long/CHANGES +++ b/lib/Getopt/Long/CHANGES @@ -1,3 +1,19 @@ +Changes in version 2.35 +----------------------- + +* [Experimental] Options can take multiple values at once. E.g., + + --coordinates 52.2 16.4 --rgbcolor 255 255 149 + + To handle the above command line, the following call to GetOptions + can be used: + + GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color); + + You can specify the minimum and maximum number of values desired. + The syntax for this is similar to that of regular expression + patterns: { min , max }. + Changes in version 2.34 -----------------------