From 2ccf00a715881982d4e58c6f46a35526476a3141 Mon Sep 17 00:00:00 2001 From: Steve Peters Date: Sat, 23 Sep 2006 16:58:17 +0000 Subject: [PATCH] Upgrade to CPAN-1.8801. p4raw-id: //depot/perl@28881 --- lib/CPAN.pm | 264 +++++++++++++++++++++++++++++++------------------- lib/CPAN/FirstTime.pm | 17 ++-- lib/CPAN/Tarzip.pm | 12 +-- 3 files changed, 179 insertions(+), 114 deletions(-) diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 44923db..baa8cc8 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -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 (Cinstall(...)>) 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 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<< >> +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L + =head1 TRANSLATIONS Kawai,Takanori provides a Japanese translation of this manpage at diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index 4ec7afc..9173349 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -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")) { diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm index 860faf0..abd9ace 100644 --- a/lib/CPAN/Tarzip.pm +++ b/lib/CPAN/Tarzip.pm @@ -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; -- 2.7.4