package Getopt::Long;
-# RCS Status : $Id: GetoptLong.pl,v 2.22 2000-03-05 21:08:03+01 jv Exp $
+# RCS Status : $Id: GetoptLong.pl,v 2.24 2000-03-14 21:28:52+01 jv Exp $
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
-# Last Modified On: Sun Mar 5 21:08:55 2000
-# Update Count : 720
+# Last Modified On: Tue Mar 14 21:28:40 2000
+# Update Count : 721
# Status : Released
################ Copyright ################
require 5.004;
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
- $VERSION = "2.21";
+ $VERSION = "2.23";
@ISA = qw(Exporter);
@EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
ConfigDefaults();
-################ Object Oriented routines ################
-
-=for experimental
-
-# NOTE: The object oriented routines use $error for thread locking.
-eval "sub lock{}" if $] < 5.005;
-
-# Store a copy of the default configuration. Since ConfigDefaults has
-# just been called, what we get from Configure is the default.
-my $default_config = do { lock ($error); Configure () };
-
-sub new {
- my $that = shift;
- my $class = ref($that) || $that;
-
- # Register the callers package.
- my $self = { caller => (caller)[0] };
-
- bless ($self, $class);
-
- # Process construct time configuration.
- if ( @_ > 0 ) {
- lock ($error);
- my $save = Configure ($default_config, @_);
- $self->{settings} = Configure ($save);
- }
- # Else use default config.
- else {
- $self->{settings} = $default_config;
- }
-
- $self;
-}
-
-sub configure {
- my ($self) = shift;
-
- lock ($error);
-
- # Restore settings, merge new settings in.
- my $save = Configure ($self->{settings}, @_);
-
- # Restore orig config and save the new config.
- $self->{settings} = Configure ($save);
-}
-
-sub getoptions {
- my ($self) = shift;
-
- lock ($error);
-
- # Restore config settings.
- my $save = Configure ($self->{settings});
-
- # Call main routine.
- my $ret = 0;
- $caller = $self->{caller};
- eval { $ret = GetOptions (@_); };
-
- # Restore saved settings.
- Configure ($save);
-
- # Handle errors and return value.
- die ($@) if $@;
- return $ret;
-}
-
-=cut
-
################ Package return ################
1;
################ AutoLoading subroutines ################
-# RCS Status : $Id: GetoptLongAl.pl,v 2.25 2000-03-05 21:08:03+01 jv Exp $
+# RCS Status : $Id: GetoptLongAl.pl,v 2.27 2000-03-17 09:07:26+01 jv Exp $
# Author : Johan Vromans
# Created On : Fri Mar 27 11:50:30 1998
# Last Modified By: Johan Vromans
-# Last Modified On: Sat Mar 4 16:33:02 2000
-# Update Count : 49
+# Last Modified On: Fri Mar 17 09:00:09 2000
+# Update Count : 55
# Status : Released
sub GetOptions {
print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
"called from package \"$pkg\".",
"\n ",
- 'GetOptionsAl $Revision: 2.25 $ ',
+ 'GetOptionsAl $Revision: 2.27 $ ',
"\n ",
"ARGV: (@ARGV)",
"\n ",
if ( $c eq '!' ) {
$opctl{"no$_"} = $c;
warn ("Ignoring '!' modifier for short option $_\n");
- $c = '';
+ $opctl{$_} = $bopctl{$_} = '';
+ }
+ else {
+ $opctl{$_} = $bopctl{$_} = $c;
}
- $opctl{$_} = $bopctl{$_} = $c;
}
else {
$_ = lc ($_) if $ignorecase;
if ( $c eq '!' ) {
$opctl{"no$_"} = $c;
- $c = '';
+ $opctl{$_} = ''
+ }
+ else {
+ $opctl{$_} = $c;
}
- $opctl{$_} = $c;
}
if ( defined $a ) {
# Note alias.
&{$linkage{$opt}}($opt, $arg);
};
print STDERR ("=> die($@)\n") if $debug && $@ ne '';
- if ( $@ =~ /^FINISH\b/ ) {
- $goon = 0;
+ if ( $@ =~ /^!/ ) {
+ if ( $@ =~ /^!FINISH\b/ ) {
+ $goon = 0;
+ }
}
elsif ( $@ ne '' ) {
warn ($@);
&$cb ($tryopt);
};
print STDERR ("=> die($@)\n") if $debug && $@ ne '';
- if ( $@ =~ /^FINISH\b/ ) {
- $goon = 0;
+ if ( $@ =~ /^!/ ) {
+ if ( $@ =~ /^!FINISH\b/ ) {
+ $goon = 0;
+ }
}
elsif ( $@ ne '' ) {
warn ($@);
die(), issue the error message, and record that an error result must
be returned upon completion.
-It is also possible for a user-defined subroutine to preliminary
-terminate options processing by calling die() with argument
-C<"FINISH">. GetOptions will react as if it encountered a double dash
-C<-->.
+If the text of the error message starts with an exclamantion mark C<!>
+it is interpreted specially by GetOptions(). There is currently one
+special command implemented: C<die("!FINISH")> will cause GetOptions()
+to stop processing options, as if it encountered a double dash C<-->.
=head2 Options with multiple names
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> (a value of 0 will be assigned).
+assigned) and C<--nofoo> (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.
=item +
projects / p5sagit/p5-mst-13.2.git / blobdiff