Upgrade to CPAN-1.8801.
Steve Peters [Sat, 23 Sep 2006 16:58:17 +0000 (16:58 +0000)]
p4raw-id: //depot/perl@28881

lib/CPAN.pm
lib/CPAN/FirstTime.pm
lib/CPAN/Tarzip.pm

index 44923db..baa8cc8 100644 (file)
@@ -1,7 +1,7 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 use strict;
 package CPAN;
-$CPAN::VERSION = '1.87_63';
+$CPAN::VERSION = '1.8801';
 $CPAN::VERSION = eval $CPAN::VERSION;
 
 use CPAN::HandleConfig;
@@ -260,17 +260,19 @@ ReadLine support %s
            goto &shell;
        }
       }
-      for ($CPAN::Config->{term_ornaments}) { # alias
-          if (defined $_) {
-              if (not defined $last_term_ornaments
-                  or $_ != $last_term_ornaments
-                 ) {
-                  local $Term::ReadLine::termcap_nowarn = 1;
-                  $term->ornaments($_);
-                  $last_term_ornaments = $_;
+      if ($term and $term->can("ornaments")) {
+          for ($CPAN::Config->{term_ornaments}) { # alias
+              if (defined $_) {
+                  if (not defined $last_term_ornaments
+                      or $_ != $last_term_ornaments
+                     ) {
+                      local $Term::ReadLine::termcap_nowarn = 1;
+                      $term->ornaments($_);
+                      $last_term_ornaments = $_;
+                  }
+              } else {
+                  undef $last_term_ornaments;
               }
-          } else {
-              undef $last_term_ornaments;
           }
       }
     }
@@ -638,7 +640,6 @@ sub all_objects {
     CPAN::Index->reload;
     values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
 }
-*all = \&all_objects;
 
 # Called by shell, not in batch mode. In batch mode I see no risk in
 # having many processes updating something as installations are
@@ -772,7 +773,7 @@ this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
       # no blocks!!!
       &cleanup if $Signal;
       $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
-      print "Caught SIGINT\n";
+      $CPAN::Frontend->myprint("Caught SIGINT\n");
       $Signal++;
     };
 
@@ -1071,6 +1072,8 @@ sub is_tested {
     $self->{is_tested}{$what} = 1;
 }
 
+# looks suspicious but maybe it is really intended to set is_tested
+# here. Please document next time around
 sub is_installed {
     my($self,$what) = @_;
     delete $self->{is_tested}{$what};
@@ -1608,9 +1611,12 @@ index    re-reads the index files\n});
     }
 }
 
+# reload means only load again what we have loaded before
+#-> sub CPAN::Shell::reload_this ;
 sub reload_this {
     my($self,$f) = @_;
-    return 1 unless $INC{$f};
+    return 1 unless $INC{$f}; # we never loaded this, so we do not
+                              # reload but say OK
     my $pwd = CPAN::anycwd();
     CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
         if $CPAN::DEBUG;
@@ -2251,59 +2257,38 @@ sub print_ornamented {
         $swhat
             =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
     }
-    my $line;
-    my $longest = 0; # Does list::util work on 5.004?
-    for $line (split /\n/, $swhat) {
-        $longest = length($line) if length($line) > $longest;
-    }
-    $longest = 78 if $longest > 78; # yes, arbitrary, who wants it set-able?
     if ($self->colorize_output) {
         my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
         if ($@) {
             print "Term::ANSIColor rejects color[$ornament]: $@\n
 Please choose a different color (Hint: try 'o conf init color.*')\n";
         }
-        my $demobug = 0; # (=0) works, (=1) has some obscure bugs and
-                         # breaks 30shell.t, (=2) has some obvious
-                         # bugs but passes 30shell.t
-        if ($demobug == 1) {
-            my $nl = chomp $swhat ? "\n" : "";
-            while (length $swhat) {
-                $line = "";
-                if (0) {
-                    $swhat =~ s/(.*\n?)//m;
-                    $line = $1;
-                    last unless $line;
-                } else {
-                    while (length $swhat) {
-                        my $c = substr($swhat,0,1);
-                        $swhat = substr($swhat,1);
-                        $line .= $c;
-                        if ($c eq "\n") {
-                            last;
-                        }
-                    }
-                }
-
-                # my($nl) = chomp $line ? "\n" : "";
-                # ->debug verboten within print_ornamented ==> recursion!
-                # warn("line[$line]ornament[$ornament]sprintf[$sprintf]\n") if $CPAN::DEBUG;
-                print $color_on,
-                    sprintf("%-*s",$longest,$line),
-                        Term::ANSIColor::color("reset"),
-                              $line =~ /\n/ ? "" : $nl;
+        my $colorstyle = 0; # (=0) works, (=1) tries to make
+                            # background colors more attractive by
+                            # appending whitespace to short lines, it
+                            # seems also to work but is less tested;
+                            # for testing use the make target
+                            # testshell-with-protocol-twice; overall
+                            # seems not worth any effort
+        if ($colorstyle == 1) {
+            my $line;
+            my $longest = 0; # Does list::util work on 5.004?
+            for $line (split /\n/, $swhat) {
+                $longest = length($line) if length($line) > $longest;
             }
-        } elsif ($demobug == 2) {
-            my $block = join "\n",
+            $longest = 78 if $longest > 78; # yes, arbitrary, who wants it set-able?
+            my $nl = chomp $swhat ? "\n" : "";
+            my $block = join "",
                 map {
-                    sprintf("%s%-*s%s",
+                    sprintf("%s%-*s%s%s",
                             $color_on,
                             $longest,
                             $_,
                             Term::ANSIColor::color("reset"),
+                            $nl,
                            )
                 }
-                    split /[\r ]*\n/, $swhat;
+                    split /[\r\t ]*\n/, $swhat, -1;
             print $block;
         } else {
             print $color_on,
@@ -2322,7 +2307,7 @@ Please choose a different color (Hint: try 'o conf init color.*')\n";
 sub myprint {
     my($self,$what) = @_;
 
-    $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue');
+    $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
 }
 
 sub myexit {
@@ -2333,13 +2318,13 @@ sub myexit {
 
 sub mywarn {
     my($self,$what) = @_;
-    $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red');
+    $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
 }
 
 # only to be used for shell commands
 sub mydie {
     my($self,$what) = @_;
-    $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red');
+    $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
 
     # If it is the shell, we want that the following die to be silent,
     # but if it is not the shell, we would need a 'die $what'. We need
@@ -2353,7 +2338,7 @@ sub mydie {
 sub colorable_makemaker_prompt {
     my($foo,$bar) = @_;
     if (CPAN::Shell->colorize_output) {
-        my $ornament = $CPAN::Config->{colorize_print}||'bold blue';
+        my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
         my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
         print $color_on;
     }
@@ -5541,35 +5526,55 @@ or
        local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
        my($ret,$pid);
        $@ = "";
+        my $go_via_alarm;
        if ($CPAN::Config->{inactivity_timeout}) {
-           eval {
-               alarm $CPAN::Config->{inactivity_timeout};
-               local $SIG{CHLD}; # = sub { wait };
-               if (defined($pid = fork)) {
-                   if ($pid) { #parent
-                       # wait;
-                       waitpid $pid, 0;
-                   } else {    #child
+            require Config;
+            if ($Config::Config{d_alarm}
+                &&
+                $Config::Config{d_alarm} eq "define"
+               ) {
+                $go_via_alarm++
+            } else {
+                $CPAN::Frontend->mywarn("Warning: you have configured the config ".
+                                        "variable 'inactivity_timeout' to ".
+                                        "'$CPAN::Config->{inactivity_timeout}'. But ".
+                                        "on this machine the system call 'alarm' ".
+                                        "isn't available. This means that we cannot ".
+                                        "provide the feature of intercepting long ".
+                                        "waiting code and will turn this feature off.\n"
+                                       );
+                $CPAN::Config->{inactivity_timeout} = 0;
+            }
+        }
+        if ($go_via_alarm) {
+            eval {
+                alarm $CPAN::Config->{inactivity_timeout};
+                local $SIG{CHLD}; # = sub { wait };
+                if (defined($pid = fork)) {
+                    if ($pid) { #parent
+                        # wait;
+                        waitpid $pid, 0;
+                    } else {    #child
                         # note, this exec isn't necessary if
                         # inactivity_timeout is 0. On the Mac I'd
                         # suggest, we set it always to 0.
                         exec $system;
-                   }
-               } else {
-                   $CPAN::Frontend->myprint("Cannot fork: $!");
-                   return;
-               }
-           };
-           alarm 0;
-           if ($@){
-               kill 9, $pid;
-               waitpid $pid, 0;
+                    }
+                } else {
+                    $CPAN::Frontend->myprint("Cannot fork: $!");
+                    return;
+                }
+            };
+            alarm 0;
+            if ($@){
+                kill 9, $pid;
+                waitpid $pid, 0;
                 my $err = "$@";
-               $CPAN::Frontend->myprint($err);
-               $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
-               $@ = "";
-               return;
-           }
+                $CPAN::Frontend->myprint($err);
+                $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
+                $@ = "";
+                return;
+            }
        } else {
          $ret = system($system);
          if ($ret != 0) {
@@ -7244,14 +7249,8 @@ Batch mode:
 
 =head1 STATUS
 
-This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
-of a modern rewrite from ground up with greater extensibility and more
-features but no full compatibility. If you're new to CPAN.pm, you
-probably should investigate if CPANPLUS is the better choice for you.
-
-If you're already used to CPAN.pm you're welcome to continue using it.
-I intend to support it until somebody convinces me that there is a
-both superior and sufficiently compatible drop-in replacement.
+This module and its competitor, the CPANPLUS module, are both much
+cooler than the other.
 
 =head1 COMPATIBILITY
 
@@ -7291,7 +7290,7 @@ mechanism.
 All methods provided are accessible in a programmer style and in an
 interactive shell style.
 
-=head2 Interactive Mode
+=head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
 
 The interactive mode is entered by running
 
@@ -7535,7 +7534,7 @@ so you would have to say
 The first example will be driven by an object of the class
 CPAN::Module, the second by an object of class CPAN::Distribution.
 
-=head2 Programmer's interface
+=head1 PROGRAMMER'S INTERFACE
 
 If you do not enter the shell, the available shell commands are both
 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
@@ -8063,7 +8062,7 @@ your @INC path. The autobundle() command which is available in the
 shell interface does that for you by including all currently installed
 modules in a snapshot bundle file.
 
-=head2 Prerequisites
+=head1 PREREQUISITES
 
 If you have a local mirror of CPAN and can access all files with
 "file:" URLs, then you only need a perl better than perl5.003 to run
@@ -8075,6 +8074,8 @@ If you have neither Net::FTP nor LWP, there is a fallback mechanism
 implemented for an external ftp command or for an external lynx
 command.
 
+=head1 UTILITIES
+
 =head2 Finding packages and VERSION
 
 This module presumes that all packages on CPAN
@@ -8129,6 +8130,28 @@ $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
 with this floppy. See also below the paragraph about CD-ROM support.
 
+=head2 Basic Utilities for Programmers
+
+=over 2
+
+=item has_inst($module)
+
+Returns true if the module is installed. See the source for details.
+
+=item has_usable($module)
+
+Returns true if the module is installed and several and is in a usable
+state. Only useful for a handful of modules that are used internally.
+See the source for details.
+
+=item instance($module)
+
+The constructor for all the singletons used to represent modules,
+distributions, authors and bundles. If the object already exists, this
+method returns the object, otherwise it calls the constructor.
+
+=back
+
 =head1 CONFIGURATION
 
 When the CPAN module is used for the first time, a configuration
@@ -8152,19 +8175,32 @@ defined:
 
   build_cache        size of cache for directories to build modules
   build_dir          locally accessible directory to build modules
+  bzip2              path to external prg
   cache_metadata     use serializer to cache metadata
   commands_quote     prefered character to use for quoting external
                      commands when running them. Defaults to double
                      quote on Windows, single tick everywhere else;
                      can be set to space to disable quoting
   check_sigs         if signatures should be verified
+  colorize_output    boolean if Term::ANSIColor should colorize output
+  colorize_print     Term::ANSIColor attributes for normal output
+  colorize_warn      Term::ANSIColor attributes for warnings
+  commandnumber_in_prompt
+                     boolean if you want to see current command number
   cpan_home          local directory reserved for this package
+  curl               path to external prg
+  dontload_hash      DEPRECATED
   dontload_list      arrayref: modules in the list will not be
                      loaded by the CPAN::has_inst() routine
+  ftp                path to external prg
+  ftp_passive        if set, the envariable FTP_PASSIVE is set for downloads
+  ftp_proxy          proxy host for ftp requests
   getcwd             see below
+  gpg                path to external prg
   gzip              location of external program gzip
   histfile           file to maintain history between sessions
   histsize           maximum number of lines to keep in histfile
+  http_proxy         proxy host for http requests
   inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
                      after this many seconds inactivity. Set to 0 to
                      never break.
@@ -8172,6 +8208,7 @@ defined:
   inhibit_startup_message
                      if true, does not print the startup message
   keep_source_where  directory in which to keep the source (if we do)
+  lynx               path to external prg
   make               location of external make program
   make_arg          arguments that should always be passed to 'make'
   make_install_make_command
@@ -8185,7 +8222,11 @@ defined:
                      command to use instead of './Build' when we are
                      in the install stage, for example 'sudo ./Build'
   mbuildpl_arg       arguments passed to 'perl Build.PL'
+  ncftp              path to external prg
+  ncftpget           path to external prg
+  no_proxy           don't proxy to these hosts/domains (comma separated list)
   pager              location of external program more (or any pager)
+  password           your password if you CPAN server wants one
   prefer_installer   legal values are MB and EUMM: if a module comes
                      with both a Makefile.PL and a Build.PL, use the
                      former (EUMM) or the latter (MB); if the module
@@ -8197,17 +8238,18 @@ defined:
   proxy_user         username for accessing an authenticating proxy
   proxy_pass         password for accessing an authenticating proxy
   scan_cache        controls scanning of cache ('atstart' or 'never')
+  shell              your favorite shell
+  show_upload_date   boolean if commands should try to determine upload date
   tar                location of external program tar
   term_is_latin      if true internal UTF-8 is translated to ISO-8859-1
                      (and nonsense for characters outside latin range)
+  term_ornaments     boolean to turn ReadLine ornamenting on/off
   test_report        email test reports (if CPAN::Reporter is installed)
   unzip              location of external program unzip
   urllist           arrayref to nearby CPAN sites (or equivalent locations)
+  username           your username if you CPAN server wants one
   wait_list          arrayref to a wait server to try (See CPAN::WAIT)
-  ftp_passive        if set, the envariable FTP_PASSIVE is set for downloads
-  ftp_proxy,      }  the three usual variables for configuring
-    http_proxy,   }  proxy requests. Both as CPAN::Config variables
-    no_proxy      }  and as environment variables configurable.
+  wget               path to external prg
 
 You can set and query each of these options interactively in the cpan
 shell with the command set defined within the C<o conf> command:
@@ -8237,17 +8279,32 @@ works like the corresponding perl commands.
 
 =back
 
-=head2 Note on config variable getcwd
+=head2 CPAN::anycwd($path): Note on config variable getcwd
 
 CPAN.pm changes the current working directory often and needs to
 determine its own current working directory. Per default it uses
 Cwd::cwd but if this doesn't work on your system for some reason,
 alternatives can be configured according to the following table:
 
-    cwd         Cwd::cwd
-    getcwd      Cwd::getcwd
-    fastcwd     Cwd::fastcwd
-    backtickcwd external command cwd
+=over 2
+
+=item cwd
+
+Calls Cwd::cwd
+
+=item getcwd
+
+Calls Cwd::getcwd
+
+=item fastcwd
+
+Calls Cwd::fastcwd
+
+=item backtickcwd
+
+Calls the external command cwd.
+
+=back
 
 =head2 Note on urllist parameter's format
 
@@ -8701,6 +8758,13 @@ unusable. Please consider backing up your data before every upgrade.
 
 Andreas Koenig C<< <andk@cpan.org> >>
 
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
 =head1 TRANSLATIONS
 
 Kawai,Takanori provides a Japanese translation of this manpage at
index 4ec7afc..9173349 100644 (file)
@@ -2,7 +2,7 @@
 package CPAN::Mirrored::By;
 use strict;
 use vars qw($VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 848 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 879 $,4)/1000000 + 5.4;
 
 sub new { 
     my($self,@arg) = @_;
@@ -21,7 +21,7 @@ use File::Basename ();
 use File::Path ();
 use File::Spec;
 use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 848 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 879 $,4)/1000000 + 5.4;
 
 =head1 NAME
 
@@ -288,15 +288,18 @@ Shall we use it as the general CPAN build and cache directory?
         local $^W = $old_warn;
         my $progname;
         for $progname (@external_progs) {
+            next if $matcher && $progname !~ /$matcher/;
             if ($^O eq 'MacOS') {
                 $CPAN::Config->{$progname} = 'not_here';
                 next;
             }
-            next if $matcher && $progname !~ /$matcher/;
 
             my $progcall = $progname;
-            # we don't need ncftp if we have ncftpget
-            next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
+            unless ($matcher) {
+                # we really don't need ncftp if we have ncftpget, but
+                # if they chose this dialog via matcher, they shall have it
+                next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
+            }
             my $path = $CPAN::Config->{$progname}
                 || $Config::Config{$progname}
                     || "";
@@ -473,8 +476,8 @@ Shall we use it as the general CPAN build and cache directory?
         my_yn_prompt(colorize_output => 0, $matcher);
         if ($CPAN::Config->{colorize_output}) {
             for my $tuple (
-                           ["colorize_print", "bold blue"],
-                           ["colorize_warn", "bold red"],
+                           ["colorize_print", "bold blue on_white"],
+                           ["colorize_warn", "bold red on_white"],
                           ) {
                 my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
                 if ($CPAN::META->has_inst("Term::ANSIColor")) {
index 860faf0..abd9ace 100644 (file)
@@ -4,11 +4,11 @@ use strict;
 use vars qw($VERSION @ISA $BUGHUNTING);
 use CPAN::Debug;
 use File::Basename ();
-$VERSION = sprintf "%.6f", substr(q$Rev: 844 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 858 $,4)/1000000 + 5.4;
 # module is internal to CPAN.pm
 
 @ISA = qw(CPAN::Debug);
-$BUGHUNTING = 0; # released code must have turned off
+$BUGHUNTING ||= 0; # released code must have turned off
 
 # it's ok if file doesn't exist, it just matters if it is .gz or .bz2
 sub new {
@@ -208,11 +208,6 @@ sub untar {
            $CPAN::META->has_inst("Archive::Tar")
            &&
            $CPAN::META->has_inst("Compress::Zlib") ) {
-    if ($file =~ /\.bz2$/) {
-      $CPAN::Frontend->mydie(qq{
-Archive::Tar lacks support for bz2. Can't continue.
-});
-    }
     $prefer = 2;
   } else {
     $CPAN::Frontend->mydie(qq{
@@ -257,6 +252,9 @@ installed. Can't continue.
       return 1;
     }
   } elsif ($prefer==2) { # 2 => modules
+    unless ($CPAN::META->has_inst("Archive::Tar")) {
+      $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
+    }
     my $tar = Archive::Tar->new($file,1);
     my $af; # archive file
     my @af;