package Getopt::Long;
-# RCS Status : $Id: GetoptLong.pm,v 2.68 2003-09-23 15:24:53+02 jv Exp jv $
+# RCS Status : $Id: GetoptLong.pm,v 2.72 2005-04-28 21:18:33+02 jv Exp $
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
-# Last Modified On: Wed Dec 31 20:48:15 2003
-# Update Count : 1440
+# Last Modified On: Wed Dec 14 21:17:21 2005
+# Update Count : 1458
# Status : Released
################ Copyright ################
-# This program is Copyright 1990,2002 by Johan Vromans.
+# This program is Copyright 1990,2005 by Johan Vromans.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the Perl Artistic License or the
# GNU General Public License as published by the Free Software
use strict;
use vars qw($VERSION);
-$VERSION = 2.3401;
+$VERSION = 2.35;
# For testing versions only.
-use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.34_01";
+#use vars qw($VERSION_STRING);
+#$VERSION_STRING = "2.35";
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK);
use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
$passthrough);
# Official invisible variables.
-use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version);
+use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
# Public subroutines.
sub config(@); # deprecated name
$ignorecase = 1; # ignore case when matching options
$passthrough = 0; # leave unrecognized options alone
$gnu_compat = 0; # require --opt=val if value is optional
+ $longprefix = "(--)"; # what does a long prefix look like
}
# Override import.
local ($^W) = 0;
print STDERR
("Getopt::Long $Getopt::Long::VERSION (",
- '$Revision: 2.68 $', ") ",
+ '$Revision: 2.72 $', ") ",
"called from package \"$pkg\".",
"\n ",
"ARGV: (@ARGV)",
"ignorecase=$ignorecase,",
"requested_version=$requested_version,",
"passthrough=$passthrough,",
- "genprefix=\"$genprefix\".",
+ "genprefix=\"$genprefix\",",
+ "longprefix=\"$longprefix\".",
"\n");
}
# as it is really a hash underneath.
$userlinkage = undef;
if ( @optionlist && ref($optionlist[0]) and
- "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
+ UNIVERSAL::isa($optionlist[0],'HASH') ) {
$userlinkage = shift (@optionlist);
print STDERR ("=> user linkage: $userlinkage\n") if $debug;
}
while ( @optionlist ) {
my $opt = shift (@optionlist);
+ unless ( defined($opt) ) {
+ $error .= "Undefined argument in option spec\n";
+ next;
+ }
+
# Strip leading prefix so people can specify "--foo=i" if they like.
$opt = $+ if $opt =~ /^$prefix+(.*)$/s;
}
$argcnt++;
- last if $argcnt >= $ctl->[CTL_AMAX];
+ last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
undef($arg);
# Need more args?
# If it is a long option, it may include the value.
# With getopt_compat, only if not bundling.
- if ( ($starter eq "--"
+ if ( ($starter=~/^$longprefix$/
|| ($getopt_compat && ($bundling == 0 || $bundling == 2)))
&& $opt =~ /^([^=]+)=(.*)$/s ) {
$opt = $1;
# See if all matches are for the same option.
my %hit;
foreach ( @hits ) {
- $_ = $opctl->{$_}->[CTL_CNAME]
- if defined $opctl->{$_}->[CTL_CNAME];
- $hit{$_} = 1;
+ my $hit = $_;
+ $hit = $opctl->{$hit}->[CTL_CNAME]
+ if defined $opctl->{$hit}->[CTL_CNAME];
+ $hit{$hit} = 1;
}
# Remove auto-supplied options (version, help).
if ( keys(%hit) == 2 ) {
unless ( defined $ctl ) {
return (0) if $passthrough;
# Pretend one char when bundling.
- if ( $bundling == 1) {
+ if ( $bundling == 1 && length($starter) == 1 ) {
$opt = substr($opt,0,1);
unshift (@ARGV, $starter.$rest) if defined $rest;
}
my $prevconfig =
[ $error, $debug, $major_version, $minor_version,
$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
- $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ];
+ $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
+ $longprefix ];
if ( ref($options[0]) eq 'ARRAY' ) {
( $error, $debug, $major_version, $minor_version,
$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
- $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ) =
- @{shift(@options)};
+ $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
+ $longprefix ) = @{shift(@options)};
}
my $opt;
# Parenthesize if needed.
$genprefix = "(" . $genprefix . ")"
unless $genprefix =~ /^\(.*\)$/;
- eval { '' =~ /$genprefix/; };
+ eval { '' =~ m"$genprefix"; };
die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
}
+ elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
+ $longprefix = $1;
+ # Parenthesize if needed.
+ $longprefix = "(" . $longprefix . ")"
+ unless $longprefix =~ /^\(.*\)$/;
+ eval { '' =~ m"$longprefix"; };
+ die("Getopt::Long: invalid long prefix pattern \"$longprefix\"") if $@;
+ }
elsif ( $try eq 'debug' ) {
$debug = $action;
}
=head1 Getting Started with Getopt::Long
-Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
-the first Perl module that provided support for handling the new style
-of command line options, hence the name Getopt::Long. This module
-also supports single-character options and bundling. In this case, the
-options are restricted to alphabetic characters only, and the
-characters C<?> and C<->.
+Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
+first Perl module that provided support for handling the new style of
+command line options, hence the name Getopt::Long. This module also
+supports single-character options and bundling. Single character
+options may be any alphabetic character, a question mark, and a dash.
+Long options may consist of a series of letters, digits, and dashes.
+Although this is currently not enforced by Getopt::Long, multiple
+consecutive dashes are not allowed, and the option name must not end
+with a dash.
To use Getopt::Long from a Perl program, you must include the
following line in your Perl program:
GetOptions ('length|height=f' => \$length);
The first name is called the I<primary> name, the other names are
-called I<aliases>.
+called I<aliases>. When using a hash to store options, the key will
+always be the primary name.
Multiple alternate names are possible.
=item !
-The option does not take an argument and may be negated, i.e. prefixed
-by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
-assigned) and C<--nofoo> and C<--no-foo> (a value of 0 will be assigned). If the
-option has aliases, this applies to the aliases as well.
+The option does not take an argument and may be negated by prefixing
+it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
+1 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
+0 will be assigned). If the option has aliases, this applies to the
+aliases as well.
Using negation on a single letter option when bundling is in effect is
pointless and will result in a warning.
See L<Pod::Usage> for details.
-=head2 Storing options in a hash
+=head2 Storing option values in a hash
Sometimes, for example when there are a lot of options, having a
separate variable for each of them can be cumbersome. GetOptions()
=item prefix_pattern
A Perl pattern that identifies the strings that introduce options.
-Default is C<(--|-|\+)> unless environment variable
-POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
+Default is C<--|-|\+> unless environment variable
+POSIXLY_CORRECT has been set, in which case it is C<--|->.
+
+=item long_prefix_pattern
+
+A Perl pattern that allows the disambiguation of long and short
+prefixes. Default is C<-->.
+
+Typically you only need to set this if you are using nonstandard
+prefixes and want some or all of them to have the same semantics as
+'--' does under normal circumstances.
+
+For example, setting prefix_pattern to C<--|-|\+|\/> and
+long_prefix_pattern to C<--|\/> would add Win32 style argument
+handling.
=item debug (default: disabled)
=head1 COPYRIGHT AND DISCLAIMER
-This program is Copyright 2003,1990 by Johan Vromans.
+This program is Copyright 1990,2005 by Johan Vromans.
This program is free software; you can redistribute it and/or
modify it under the terms of the Perl Artistic License or the
GNU General Public License as published by the Free Software