Upgrade to Getopt::Long 2.38

diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index f44e615..c827d3c 100644 (file)
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -2,32 +2,14 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: Long.pm,v 2.74 2007/09/29 13:40:13 jv Exp $
+# RCS Status      : $Id: Long.pm,v 2.76 2009/03/30 20:54:30 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Sat Sep 29 15:38:55 2007
-# Update Count    : 1571
+# Last Modified On: Mon Mar 30 22:51:17 2009
+# Update Count    : 1601
 # Status          : Released
 
-################ Copyright ################
-
-# This program is Copyright 1990,2007 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
-# Foundation; either version 2 of the License, or (at your option) any
-# later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# If you do not have a copy of the GNU General Public License write to
-# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
-# MA 02139, USA.
-
 ################ Module Preamble ################
 
 use 5.004;
@@ -35,10 +17,10 @@ use 5.004;
 use strict;
 
 use vars qw($VERSION);
-$VERSION        =  2.37;
+$VERSION        =  2.38;
 # For testing versions only.
-use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.37";
+#use vars qw($VERSION_STRING);
+#$VERSION_STRING = "2.38";
 
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK);
@@ -46,8 +28,8 @@ use vars qw(@ISA @EXPORT @EXPORT_OK);
 
 # Exported subroutines.
 sub GetOptions(@);             # always
-sub GetOptionsFromArray($@);   # on demand
-sub GetOptionsFromString($@);  # on demand
+sub GetOptionsFromArray(@);    # on demand
+sub GetOptionsFromString(@);   # on demand
 sub Configure(@);              # on demand
 sub HelpMessage(@);            # on demand
 sub VersionMessage(@);         # in demand
@@ -205,7 +187,7 @@ sub getoptions {
        # Locally set exception handler to default, otherwise it will
        # be called implicitly here, and again explicitly when we try
        # to deliver the messages.
-       local ($SIG{__DIE__}) = '__DEFAULT__';
+       local ($SIG{__DIE__}) = 'DEFAULT';
        $ret = Getopt::Long::GetOptions (@_);
     };
 
@@ -271,7 +253,7 @@ sub GetOptions(@) {
     goto &GetOptionsFromArray;
 }
 
-sub GetOptionsFromString($@) {
+sub GetOptionsFromString(@) {
     my ($string) = shift;
     require Text::ParseWords;
     my $args = [ Text::ParseWords::shellwords($string) ];
@@ -285,7 +267,7 @@ sub GetOptionsFromString($@) {
     $ret;
 }
 
-sub GetOptionsFromArray($@) {
+sub GetOptionsFromArray(@) {
 
     my ($argv, @optionlist) = @_;      # local copy of the option descriptions
     my $argend = '--';         # option list terminator
@@ -305,7 +287,7 @@ sub GetOptionsFromArray($@) {
        local ($^W) = 0;
        print STDERR
          ("Getopt::Long $Getopt::Long::VERSION (",
-          '$Revision: 2.74 $', ") ",
+          '$Revision: 2.76 $', ") ",
           "called from package \"$pkg\".",
           "\n  ",
           "argv: (@$argv)",
@@ -460,6 +442,14 @@ sub GetOptionsFromArray($@) {
                eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
            }
        }
+
+       if ( $opctl{$name}[CTL_TYPE] eq 'I'
+            && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
+                 || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
+          ) {
+           $error .= "Invalid option linkage for \"$opt\"\n";
+       }
+
     }
 
     # Bail out if errors found.
@@ -588,7 +578,7 @@ sub GetOptionsFromArray($@) {
                            if $debug;
                        my $eval_error = do {
                            local $@;
-                           local $SIG{__DIE__}  = '__DEFAULT__';
+                           local $SIG{__DIE__}  = 'DEFAULT';
                            eval {
                                &{$linkage{$opt}}
                                  (Getopt::Long::CallBack->new
@@ -706,8 +696,17 @@ sub GetOptionsFromArray($@) {
                  if $debug;
                my $eval_error = do {
                    local $@;
-                   local $SIG{__DIE__}  = '__DEFAULT__';
-                   eval { &$cb ($tryopt) };
+                   local $SIG{__DIE__}  = 'DEFAULT';
+                   eval {
+                       &$cb
+                         (Getopt::Long::CallBack->new
+                          (name    => $tryopt,
+                           ctl     => $ctl,
+                           opctl   => \%opctl,
+                           linkage => \%linkage,
+                           prefix  => $prefix,
+                          ));
+                   };
                    $@;
                };
                print STDERR ("=> die($eval_error)\n")
@@ -777,7 +776,7 @@ sub ParseOptionSpec ($$) {
                     # Option name
                     (?: \w+[-\w]* )
                     # Alias names, or "?"
-                    (?: \| (?: \? | \w[-\w]* )? )*
+                    (?: \| (?: \? | \w[-\w]* ) )*
                   )?
                   (
                     # Either modifiers ...
@@ -950,7 +949,7 @@ sub FindOption ($$$$$) {
     }
 
     # Try auto-abbreviation.
-    elsif ( $autoabbrev ) {
+    elsif ( $autoabbrev && $opt ne "" ) {
        # Sort the possible long option names.
        my @names = sort(keys (%$opctl));
        # Downcase if allowed.
@@ -1016,7 +1015,12 @@ sub FindOption ($$$$$) {
            $opt = substr($opt,0,1);
             unshift (@$argv, $starter.$rest) if defined $rest;
        }
-       warn ("Unknown option: ", $opt, "\n");
+       if ( $opt eq "" ) {
+           warn ("Missing option after ", $starter, "\n");
+       }
+       else {
+           warn ("Unknown option: ", $opt, "\n");
+       }
        $error++;
        return (1, undef);
     }
@@ -1481,9 +1485,8 @@ sub name {
 }
 
 use overload
-  # Treat this object as an oridinary string for legacy API.
+  # Treat this object as an ordinary string for legacy API.
   '""'    => \&name,
-  '0+'    => sub { 0 },
   fallback => 1;
 
 1;
@@ -1749,7 +1752,7 @@ When used with command line options:
     --define os=linux --define vendor=redhat
 
 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
+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 acceptable values. The keys are always taken to be strings.
 
@@ -1760,7 +1763,8 @@ an option is encountered on the command line can be achieved by
 designating a reference to a subroutine (or an anonymous subroutine)
 as the option destination. When GetOptions() encounters the option, it
 will call the subroutine with two or three arguments. The first
-argument is the name of the option. For a scalar or array destination,
+argument is the name of the option. (Actually, it is an object that
+stringifies to the name of the option.) For a scalar or array destination,
 the second argument is the value to be stored. For a hash destination,
 the second arguments is the key to the hash, and the third argument
 the value to be stored. It is up to the subroutine to store the value,
@@ -1786,6 +1790,12 @@ 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<-->.
 
+In version 2.37 the first argument to the callback function was
+changed from string to object. This was done to make room for
+extensions and more detailed control. The object stringifies to the
+option name so this change should not introduce compatibility
+problems.
+
 =head2 Options with multiple names
 
 Often it is user friendly to supply alternate mnemonic names for
@@ -2155,7 +2165,8 @@ it will set variable C<$stdio>.
 A special option 'name' C<< <> >> can be used to designate a subroutine
 to handle non-option arguments. When GetOptions() encounters an
 argument that does not look like an option, it will immediately call this
-subroutine and passes it one parameter: the argument name.
+subroutine and passes it one parameter: the argument name. Well, actually
+it is an object that stringifies to the argument name.
 
 For example:
 
@@ -2567,7 +2578,7 @@ This can be accomplished with a destination routine:
   GetOptions('list=s%' =>
                sub { push(@{$list{$_[1]}}, $_[2]) });
 
-=head1 Trouble Shooting
+=head1 Troubleshooting
 
 =head2 GetOptions does not return a false result when an option is not supplied
 
@@ -2618,7 +2629,7 @@ Johan Vromans <jvromans@squirrel.nl>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-This program is Copyright 1990,2007 by Johan Vromans.
+This program is Copyright 1990,2009 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

diff --git a/lib/Getopt/Long/CHANGES b/lib/Getopt/Long/CHANGES
index 071deb3..679da2a 100644 (file)
--- a/lib/Getopt/Long/CHANGES
+++ b/lib/Getopt/Long/CHANGES
@@ -1,6 +1,22 @@
+Changes in version 2.38
+-----------------------
+
+* Bugfix for Ticket 35759: First arg to callback function evaluates
+  to false when used in bool context.
+
+* Fix problem with prototypes of GetOptionsFrom* functions.
+
+* Fix restoring default die handler.
+
+* Bugfix for Ticket 24941: Autoabbrev with + incorrect.
+
 Changes in version 2.37
 -----------------------
 
+* The first argument to callback function is now an object and will
+  get methods for finer control in the future. The object stringifies
+  to the option name, so current code should not notice a difference.
+
 * Bugfix: With gnu_compat, --foo= will no longer trigger "Option
   requires an argument" but return the empty string.
 

diff --git a/lib/Getopt/Long/README b/lib/Getopt/Long/README
index fb653f3..b1b8e2a 100644 (file)
--- a/lib/Getopt/Long/README
+++ b/lib/Getopt/Long/README
@@ -200,7 +200,7 @@ Or use the CPAN search engine:
 COPYRIGHT AND DISCLAIMER
 ========================
 
-Module Getopt::Long is Copyright 2006,1990 by Johan Vromans.
+Module Getopt::Long is Copyright 2009,1990 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

diff --git a/lib/newgetopt.pl b/lib/newgetopt.pl
index 95eef22..1de6a6e 100644 (file)
--- a/lib/newgetopt.pl
+++ b/lib/newgetopt.pl
@@ -1,4 +1,4 @@
-# $Id: newgetopt.pl,v 1.18 2001-09-21 15:34:59+02 jv Exp $
+# $Id: newgetopt.pl,v 1.18 2001/09/21 13:34:59 jv Exp $
 
 # This library is no longer being maintained, and is included for backward
 # compatibility with Perl 4 programs which may require it.