Integrate:

[ 21302]
CPAN.pm 1.76_01 from Andreas.

[ 21303]
Upgrade to Getopt::Long 2.33_03.
p4raw-link: @21303 on //depot/perl: 9e01bed8b6dd351933b88ffcf539432d47e152bc
p4raw-link: @21302 on //depot/perl: 1426a145710dcf31e1623041f231376973b4606b

p4raw-id: //depot/maint-5.8/perl@21304
p4raw-integrated: from //depot/perl@21301 'copy in' lib/Getopt/Long.pm
	lib/Getopt/Long/CHANGES (@19574..) lib/CPAN.pm (@20383..)

diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index d4776dd..887d5cd 100644 (file)
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -1,6 +1,7 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN;
-$VERSION = '1.76';
+$VERSION = '1.76_01';
+$VERSION = eval $VERSION;
 # $Id: CPAN.pm,v 1.412 2003/07/31 14:53:04 k Exp $
 
 # only used during development:
@@ -2187,7 +2188,7 @@ sub get_basic_credentials {
     return unless $proxy;
     if ($USER && $PASSWD) {
     } elsif (defined $CPAN::Config->{proxy_user} &&
-        defined $CPAN::Config->{proxy_pass}) {
+             defined $CPAN::Config->{proxy_pass}) {
         $USER = $CPAN::Config->{proxy_user};
         $PASSWD = $CPAN::Config->{proxy_pass};
     } else {
@@ -2212,6 +2213,21 @@ sub get_basic_credentials {
     return($USER,$PASSWD);
 }
 
+# mirror(): Its purpose is to deal with proxy authentication. When we
+# call SUPER::mirror, we relly call the mirror method in
+# LWP::UserAgent. LWP::UserAgent will then call
+# $self->get_basic_credentials or some equivalent and this will be
+# $self->dispatched to our own get_basic_credentials method.
+
+# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
+
+# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
+# although we have gone through our get_basic_credentials, the proxy
+# server refuses to connect. This could be a case where the username or
+# password has changed in the meantime, so I'm trying once again without
+# $USER and $PASSWD to give the get_basic_credentials routine another
+# chance to set $USER and $PASSWD.
+
 sub mirror {
     my($self,$url,$aslocal) = @_;
     my $result = $self->SUPER::mirror($url,$aslocal);
@@ -5427,7 +5443,7 @@ sub cpan_file {
                 }
                 return "Contact Author $fullname <$email>";
             } else {
-                return "UserID $userid";
+                return "Contact Author $userid (Email address not available)";
             }
         } else {
             return "N/A";

diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index c95a470..d9ad599 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.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 5c7ef4a..a06357d 100644 (file)
--- 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
 -----------------------