diff options
Diffstat (limited to 'lib/Getopt')
| -rw-r--r-- | lib/Getopt/Long.pm | 156 | ||||
| -rw-r--r-- | lib/Getopt/Long/CHANGES | 28 |
2 files changed, 127 insertions, 57 deletions
diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index c95a470b77..d9ad599971 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.65 2003-05-19 17:44:13+02 jv Exp $ +# RCS Status : $Id: GetoptLong.pm,v 2.67 2003-06-24 23:18:55+02 jv Exp jv $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Mon May 19 17:43:33 2003 -# Update Count : 1330 +# Last Modified On: Sun Sep 21 13:16:30 2003 +# Update Count : 1363 # Status : Released ################ Copyright ################ @@ -35,10 +35,10 @@ use 5.004; use strict; use vars qw($VERSION); -$VERSION = 2.33; +$VERSION = 2.3303; # For testing versions only. -#use vars qw($VERSION_STRING); -#$VERSION_STRING = "2.32_06"; +use vars qw($VERSION_STRING); +$VERSION_STRING = "2.33_03"; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK); @@ -259,25 +259,28 @@ sub GetOptions(@) { $error = ''; - print STDERR ("Getopt::Long $Getopt::Long::VERSION (", - '$Revision: 2.65 $', ") ", - "called from package \"$pkg\".", - "\n ", - "ARGV: (@ARGV)", - "\n ", - "autoabbrev=$autoabbrev,". - "bundling=$bundling,", - "getopt_compat=$getopt_compat,", - "gnu_compat=$gnu_compat,", - "order=$order,", - "\n ", - "ignorecase=$ignorecase,", - "autohelp=$auto_help,", - "autoversion=$auto_version,", - "passthrough=$passthrough,", - "genprefix=\"$genprefix\".", - "\n") - if $debug; + if ( $debug ) { + # Avoid some warnings if debugging. + local ($^W) = 0; + print STDERR + ("Getopt::Long $Getopt::Long::VERSION (", + '$Revision: 2.67 $', ") ", + "called from package \"$pkg\".", + "\n ", + "ARGV: (@ARGV)", + "\n ", + "autoabbrev=$autoabbrev,". + "bundling=$bundling,", + "getopt_compat=$getopt_compat,", + "gnu_compat=$gnu_compat,", + "order=$order,", + "\n ", + "ignorecase=$ignorecase,", + "requested_version=$requested_version,", + "passthrough=$passthrough,", + "genprefix=\"$genprefix\".", + "\n"); + } # Check for ref HASH as first argument. # First argument may be an object. It's OK to use this as long @@ -371,7 +374,18 @@ sub GetOptions(@) { elsif ( $rl eq "HASH" ) { $opctl{$name}[CTL_DEST] = CTL_DEST_HASH; } - elsif ( $rl eq "SCALAR" || $rl eq "CODE" ) { + elsif ( $rl eq "SCALAR" ) { +# if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) { +# my $t = $linkage{$orig}; +# $$t = $linkage{$orig} = []; +# } +# elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) { +# } +# else { + # Ok. +# } + } + elsif ( $rl eq "CODE" ) { # Ok. } else { @@ -411,12 +425,14 @@ sub GetOptions(@) { $opctl{version} = ['','version',0,CTL_DEST_CODE,undef]; $linkage{version} = \&VersionMessage; } + $auto_version = 1; } if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) { if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) { $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef]; $linkage{help} = \&HelpMessage; } + $auto_help = 1; } # Show the options tables if debugging. @@ -480,6 +496,26 @@ sub GetOptions(@) { ${$linkage{$opt}} = $arg; } } + elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) { + print STDERR ("=> ref(\$L{$opt}) auto-vivified", + " to ARRAY\n") + if $debug; + my $t = $linkage{$opt}; + $$t = $linkage{$opt} = []; + print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n") + if $debug; + push (@{$linkage{$opt}}, $arg); + } + elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) { + print STDERR ("=> ref(\$L{$opt}) auto-vivified", + " to HASH\n") + if $debug; + my $t = $linkage{$opt}; + $$t = $linkage{$opt} = {}; + print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n") + if $debug; + $linkage{$opt}->{$key} = $arg; + } else { print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug; @@ -828,6 +864,15 @@ sub FindOption ($$$$) { if defined $opctl->{$_}->[CTL_CNAME]; $hit{$_} = 1; } + # Remove auto-supplied options (version, help). + if ( keys(%hit) == 2 ) { + if ( $auto_version && exists($hit{version}) ) { + delete $hit{version}; + } + elsif ( $auto_help && exists($hit{help}) ) { + delete $hit{help}; + } + } # Now see if it really is ambiguous. unless ( keys(%hit) == 1 ) { return (0) if $passthrough; @@ -857,6 +902,11 @@ sub FindOption ($$$$) { my $ctl = $opctl->{$tryopt}; unless ( defined $ctl ) { return (0) if $passthrough; + # Pretend one char when bundling. + if ( $bundling == 1) { + $opt = substr($opt,0,1); + unshift (@ARGV, $starter.$rest) if defined $rest; + } warn ("Unknown option: ", $opt, "\n"); $error++; return (1, undef); @@ -1450,19 +1500,23 @@ use multiple directories to search for library files: To accomplish this behaviour, simply specify an array reference as the destination for the option: - my @libfiles = (); GetOptions ("library=s" => \@libfiles); -Used with the example above, C<@libfiles> would contain two strings -upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order. -It is also possible to specify that only integer or floating point -numbers are acceptible values. +Alternatively, you can specify that the option can have multiple +values by adding a "@", and pass a scalar reference as the +destination: + + GetOptions ("library=s@" => \$libfiles); + +Used with the example above, C<@libfiles> (or C<@$libfiles>) would +contain two strings upon completion: C<"lib/srdlib"> and +C<"lib/extlib">, in that order. It is also possible to specify that +only integer or floating point numbers are acceptible values. Often it is useful to allow comma-separated lists of values as well as multiple occurrences of the options. This is easy using Perl's split() and join() operators: - my @libfiles = (); GetOptions ("library=s" => \@libfiles); @libfiles = split(/,/,join(',',@libfiles)); @@ -1475,17 +1529,20 @@ If the option destination is a reference to a hash, the option will take, as value, strings of the form I<key>C<=>I<value>. The value will be stored with the specified key in the hash. - my %defines = (); GetOptions ("define=s" => \%defines); +Alternatively you can use: + + GetOptions ("define=s%" => \$defines); + When used with command line options: --define os=linux --define vendor=redhat -the hash C<%defines> will contain two keys, C<"os"> with value -C<"linux> and C<"vendor"> with value C<"redhat">. -It is also possible to specify that only integer or floating point -numbers are acceptible values. The keys are always taken to be strings. +the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os"> +with value C<"linux> and C<"vendor"> with value C<"redhat">. It is +also possible to specify that only integer or floating point numbers +are acceptible values. The keys are always taken to be strings. =head2 User-defined subroutines to handle options @@ -2014,6 +2071,10 @@ program name, its version (if $main::VERSION is defined), and the versions of Getopt::Long and Perl. The message will be written to standard output and processing will terminate. +C<auto_version> will be enabled if the calling program explicitly +specified a version number higher than 2.32 in the C<use> or +C<require> statement. + =item auto_help (default:disabled) Automatically provide support for the B<--help> and B<-?> options if @@ -2023,6 +2084,10 @@ Getopt::Long will provide a help message using module L<Pod::Usage>. The message, derived from the SYNOPSIS POD section, will be written to standard output and processing will terminate. +C<auto_help> will be enabled if the calling program explicitly +specified a version number higher than 2.32 in the C<use> or +C<require> statement. + =item pass_through (default: disabled) Options that are unknown, ambiguous or supplied with an invalid option @@ -2210,23 +2275,6 @@ in version 2.17. Besides, it is much easier. =head1 Trouble Shooting -=head2 Warning: Ignoring '!' modifier for short option - -This warning is issued when the '!' modifier is applied to a short -(one-character) option and bundling is in effect. E.g., - - Getopt::Long::Configure("bundling"); - GetOptions("foo|f!" => \$foo); - -Note that older Getopt::Long versions did not issue a warning, because -the '!' modifier was applied to the first name only. This bug was -fixed in 2.22. - -Solution: separate the long and short names and apply the '!' to the -long names only, e.g., - - GetOptions("foo!" => \$foo, "f" => \$foo); - =head2 GetOptions does not return a false result when an option is not supplied That's why they're called 'options'. diff --git a/lib/Getopt/Long/CHANGES b/lib/Getopt/Long/CHANGES index 5c7ef4a9ed..a06357d222 100644 --- a/lib/Getopt/Long/CHANGES +++ b/lib/Getopt/Long/CHANGES @@ -1,3 +1,25 @@ +Changes in version 2.34 +----------------------- + +* Auto-vivification of array and hash refs + + If an option is specified to require an array or hash ref, and a + scalar reference is passed, this is auto-vivified to array or hash + ref. + + Example: + + @ARGV = qw(--foo=xx); + GetOptions("foo=s@", \$var); + # Now $var->[0] eq "xx" + +* Auto-supplied verbose and help options are no longer taken into + account when determining option ambiguity. This eliminates the + common problem that you suddenly get an ambiguous option warning + when you have an option "verbose" and run your program with "-v". + +* Cosmetic changes in some error messages. + Changes in version 2.33 ----------------------- @@ -78,9 +100,9 @@ Changes in version 2.31 ----------------------- * Fix a bug where calling the configure method on a -Getopt::Long::Parser object would bail out with -Undefined subroutine &Getopt::Long::Parser::Configure called at -Getopt/Long.pm line 186. + Getopt::Long::Parser object would bail out with + Undefined subroutine &Getopt::Long::Parser::Configure called at + Getopt/Long.pm line 186. Changes in version 2.30 ----------------------- |