Mention the chdir("")/chdir(undef) deprecation.

[p5sagit/p5-mst-13.2.git] / lib / Getopt / Long.pm

diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index f1ac4f5..7e1663d 100644 (file)
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -2,12 +2,12 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: GetoptLong.pm,v 2.54 2002-02-20 15:00:10+01 jv Exp $
+# RCS Status      : $Id: GetoptLong.pm,v 2.58 2002-06-20 09:32:09+02 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Wed Feb 20 15:00:04 2002
-# Update Count    : 1045
+# Last Modified On: Thu Jun 20 07:48:05 2002
+# Update Count    : 1083
 # Status          : Released
 
 ################ Copyright ################
@@ -35,10 +35,10 @@ use 5.004;
 use strict;
 
 use vars qw($VERSION);
-$VERSION        =  2.28;
+$VERSION        =  2.32;
 # For testing versions only.
 use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.28";
+$VERSION_STRING = "2.32";
 
 use Exporter;
 
@@ -70,7 +70,6 @@ sub ConfigDefaults ();
 sub ParseOptionSpec ($$);
 sub OptCtl ($);
 sub FindOption ($$$$);
-sub Croak (@);                 # demand loading the real Croak
 
 ################ Local Variables ################
 
@@ -133,15 +132,9 @@ ConfigDefaults();
 
 package Getopt::Long::Parser;
 
-# NOTE: The object oriented routines use $error for thread locking.
-my $_lock = sub {
-    lock ($Getopt::Long::error) 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;
     Getopt::Long::Configure ()
 };
 
@@ -157,7 +150,6 @@ sub new {
 
     # Process config attributes.
     if ( defined $atts{config} ) {
-       &$_lock;
        my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
        $self->{settings} = Getopt::Long::Configure ($save);
        delete ($atts{config});
@@ -168,8 +160,8 @@ sub new {
     }
 
     if ( %atts ) {             # Oops
-       Getopt::Long::Croak(__PACKAGE__.": unhandled attributes: ".
-                           join(" ", sort(keys(%atts))));
+       die(__PACKAGE__.": unhandled attributes: ".
+           join(" ", sort(keys(%atts)))."\n");
     }
 
     $self;
@@ -178,20 +170,16 @@ sub new {
 sub configure {
     my ($self) = shift;
 
-    &$_lock;
-
     # Restore settings, merge new settings in.
     my $save = Getopt::Long::Configure ($self->{settings}, @_);
 
     # Restore orig config and save the new config.
-    $self->{settings} = Configure ($save);
+    $self->{settings} = Getopt::Long::Configure ($save);
 }
 
 sub getoptions {
     my ($self) = shift;
 
-    &$_lock;
-
     # Restore config settings.
     my $save = Getopt::Long::Configure ($self->{settings});
 
@@ -261,7 +249,7 @@ sub GetOptions {
     $error = '';
 
     print STDERR ("GetOpt::Long $Getopt::Long::VERSION (",
-                 '$Revision: 2.54 $', ") ",
+                 '$Revision: 2.58 $', ") ",
                  "called from package \"$pkg\".",
                  "\n  ",
                  "ARGV: (@ARGV)",
@@ -483,28 +471,32 @@ sub GetOptions {
                                      $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
                                      ", \"$arg\")\n")
                            if $debug;
-                       local ($@);
-                       eval {
+                       my $eval_error = do {
+                           local $@;
                            local $SIG{__DIE__}  = '__DEFAULT__';
-                           &{$linkage{$opt}}($opt,
-                                             $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
-                                             $arg);
+                           eval {
+                               &{$linkage{$opt}}($opt,
+                                                 $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
+                                                 $arg);
+                           };
+                           $@;
                        };
-                       print STDERR ("=> die($@)\n") if $debug && $@ ne '';
-                       if ( $@ =~ /^!/ ) {
-                           if ( $@ =~ /^!FINISH\b/ ) {
+                       print STDERR ("=> die($eval_error)\n")
+                         if $debug && $eval_error ne '';
+                       if ( $eval_error =~ /^!/ ) {
+                           if ( $eval_error =~ /^!FINISH\b/ ) {
                                $goon = 0;
                            }
                        }
-                       elsif ( $@ ne '' ) {
-                           warn ($@);
+                       elsif ( $eval_error ne '' ) {
+                           warn ($eval_error);
                            $error++;
                        }
                    }
                    else {
                        print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
                                      "\" in linkage\n");
-                       Croak ("Getopt::Long -- internal error!\n");
+                       die("Getopt::Long -- internal error!\n");
                    }
                }
                # No entry in linkage means entry in userlinkage.
@@ -556,21 +548,23 @@ sub GetOptions {
            # Try non-options call-back.
            my $cb;
            if ( (defined ($cb = $linkage{'<>'})) ) {
-               local ($@);
                print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
                  if $debug;
-               eval {
+               my $eval_error = do {
+                   local $@;
                    local $SIG{__DIE__}  = '__DEFAULT__';
-                   &$cb ($tryopt);
+                   eval { &$cb ($tryopt) };
+                   $@;
                };
-               print STDERR ("=> die($@)\n") if $debug && $@ ne '';
-               if ( $@ =~ /^!/ ) {
-                   if ( $@ =~ /^!FINISH\b/ ) {
+               print STDERR ("=> die($eval_error)\n")
+                 if $debug && $eval_error ne '';
+               if ( $eval_error =~ /^!/ ) {
+                   if ( $eval_error =~ /^!FINISH\b/ ) {
                        $goon = 0;
                    }
                }
-               elsif ( $@ ne '' ) {
-                   warn ($@);
+               elsif ( $eval_error ne '' ) {
+                   warn ($eval_error);
                    $error++;
                }
            }
@@ -713,10 +707,8 @@ sub ParseOptionSpec ($$) {
     }
 
     if ( $dups && $^W ) {
-       require 'Carp.pm';
-       $Carp::CarpLevel = 2;
        foreach ( split(/\n+/, $dups) ) {
-           Carp::cluck($_);
+           warn($_."\n");
        }
     }
     ($names[0], $orig);
@@ -757,7 +749,7 @@ sub FindOption ($$$$) {
 
     #### Look it up ###
 
-    my $tryopt;                        # option to try
+    my $tryopt = $opt;         # option to try
 
     if ( $bundling && $starter eq '-' ) {
 
@@ -906,7 +898,8 @@ sub FindOption ($$$$) {
     # Get key if this is a "name=value" pair for a hash option.
     my $key;
     if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
-       ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
+       ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
+         : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 1);
     }
 
     #### Check if the argument is valid for this option ####
@@ -1011,7 +1004,7 @@ sub FindOption ($$$$) {
        }
     }
     else {
-       Croak ("GetOpt::Long internal error (Can't happen)\n");
+       die("GetOpt::Long internal error (Can't happen)\n");
     }
     return (1, $opt, $ctl, $arg, $key);
 }
@@ -1090,7 +1083,7 @@ sub Configure (@) {
            # Turn into regexp. Needs to be parenthesized!
            $genprefix = "(" . quotemeta($genprefix) . ")";
            eval { '' =~ /$genprefix/; };
-           Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+           die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
        }
        elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
            $genprefix = $1;
@@ -1098,13 +1091,13 @@ sub Configure (@) {
            $genprefix = "(" . $genprefix . ")"
              unless $genprefix =~ /^\(.*\)$/;
            eval { '' =~ /$genprefix/; };
-           Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+           die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
        }
        elsif ( $try eq 'debug' ) {
            $debug = $action;
        }
        else {
-           Croak ("Getopt::Long: unknown config parameter \"$opt\"")
+           die("Getopt::Long: unknown config parameter \"$opt\"")
        }
     }
     $prevconfig;
@@ -1115,13 +1108,6 @@ sub config (@) {
     Configure (@_);
 }
 
-# To prevent Carp from being loaded unnecessarily.
-sub Croak (@) {
-    require 'Carp.pm';
-    $Carp::CarpLevel = 1;
-    Carp::croak(@_);
-};
-
 ################ Documentation ################
 
 =head1 NAME
@@ -1527,9 +1513,11 @@ Configuration options can be passed to the constructor:
     $p = new Getopt::Long::Parser
              config => [...configuration options...];
 
-For thread safety, each method call will acquire an exclusive lock to
-the Getopt::Long module. So don't call these methods from a callback
-routine!
+=head2 Thread Safety
+
+Getopt::Long is thread safe when using ithreads as of Perl 5.8.  It is
+I<not> thread safe when using the older (experimental and now
+obsolete) threads implementation that was added to Perl 5.005.
 
 =head2 Documentation and help texts