From: Andreas König Date: Sat, 14 Jan 2006 12:57:48 +0000 (+0100) Subject: [PAUSE] CPAN Upload: A/AN/ANDK/CPAN-1.83_55.tar.gz X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ddc4ed0d78d3f27114dba4c8b582621702194a5;p=p5sagit%2Fp5-mst-13.2.git [PAUSE] CPAN Upload: A/AN/ANDK/CPAN-1.83_55.tar.gz Message-ID: <87u0c7yqbn.fsf@k75.linux.bogus> p4raw-id: //depot/perl@26858 --- diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 70597a9..487b637 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -1,6 +1,6 @@ # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- package CPAN; -$VERSION = '1.83'; +$VERSION = '1.83_55'; $VERSION = eval $VERSION; use strict; @@ -81,9 +81,10 @@ sub shell { $Suppress_readline = ! -t STDIN unless defined $Suppress_readline; CPAN::HandleConfig->load unless $CPAN::Config_loaded++; - my $oprompt = shift || "cpan> "; + my $oprompt = shift || CPAN::Prompt->new; my $prompt = $oprompt; my $commandline = shift || ""; + $CPAN::CurrentCommandId ||= 1; local($^W) = 1; unless ($Suppress_readline) { @@ -190,9 +191,13 @@ ReadLine support %s my $command = shift @line; eval { CPAN::Shell->$command(@line) }; warn $@ if $@; + if ($command =~ /^(make|test|install|force|notest)$/) { + CPAN::Shell->failed($CPAN::CurrentCommandId,1); + } soft_chdir_with_alternatives(\@cwd); $CPAN::Frontend->myprint("\n"); $continuation = ""; + $CPAN::CurrentCommandId++; $prompt = $oprompt; } } continue { @@ -321,6 +326,56 @@ sub as_string { ".\nCannot continue.\n"; } +package CPAN::Prompt; use overload '""' => "as_string"; +our $prompt = "cpan> "; +$CPAN::CurrentCommandId ||= 0; +sub as_randomly_capitalized_string { + # pure fun variant + substr($prompt,$_,1)=rand()<0.5 ? + uc(substr($prompt,$_,1)) : + lc(substr($prompt,$_,1)) for 0..3; + $prompt; +} +sub new { + bless {}, shift; +} +sub as_string { + if ($CPAN::Config->{commandnumber_in_prompt}) { + sprintf "cpan[%d]> ", $CPAN::CurrentCommandId; + } else { + "cpan> "; + } +} + +package CPAN::Distrostatus; +use overload '""' => "as_string", + fallback => 1; +sub new { + my($class,$arg) = @_; + bless { + TEXT => $arg, + FAILED => substr($arg,0,2) eq "NO", + COMMANDID => $CPAN::CurrentCommandId, + }, $class; +} +sub commandid { shift->{COMMANDID} } +sub failed { shift->{FAILED} } +sub text { + my($self,$set) = @_; + if (defined $set) { + $self->{TEXT} = $set; + } + $self->{TEXT}; +} +sub as_string { + my($self) = @_; + if (0) { # called from rematein during install? + require Carp; + Carp::cluck("HERE"); + } + $self->{TEXT}; +} + package CPAN::Shell; use strict; use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING); @@ -512,7 +567,7 @@ sub checklock { my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock"); if (-f $lockfile && -M _ > 0) { my $fh = FileHandle->new($lockfile) or - $CPAN::Frontend->mydie("Could not open $lockfile: $!"); + $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!"); my $otherpid = <$fh>; my $otherhost = <$fh>; $fh->close; @@ -526,7 +581,7 @@ sub checklock { if (defined $otherhost && defined $thishost && $otherhost ne '' && $thishost ne '' && $otherhost ne $thishost) { - $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile\n". + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n". "reports other host $otherhost and other process $otherpid.\n". "Cannot proceed.\n")); } @@ -546,20 +601,20 @@ You may want to kill it and delete the lockfile, maybe. On UNIX try: my($ans) = ExtUtils::MakeMaker::prompt (qq{Other job not responding. Shall I overwrite }. - qq{the lockfile? (Y/N)},"y"); + qq{the lockfile '$lockfile'? (Y/n)},"y"); $CPAN::Frontend->myexit("Ok, bye\n") unless $ans =~ /^y/i; } else { Carp::croak( - qq{Lockfile $lockfile not writeable by you. }. + qq{Lockfile '$lockfile' not writeable by you. }. qq{Cannot proceed.\n}. qq{ On UNIX try:\n}. - qq{ rm $lockfile\n}. + qq{ rm '$lockfile'\n}. qq{ and then rerun us.\n} ); } } else { - $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile\n". + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n". "reports other process with ID ". "$otherpid. Cannot proceed.\n")); } @@ -1099,8 +1154,9 @@ sub h { if (defined $about) { $CPAN::Frontend->myprint("Detailed help not yet implemented\n"); } else { - $CPAN::Frontend->myprint(q{ -Display Information + my $filler = " " x (80 - 28 - length($CPAN::VERSION)); + $CPAN::Frontend->myprint(qq{ +Display Information $filler (ver $CPAN::VERSION) command argument description a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules i WORD or /REGEXP/ about any of the above @@ -1140,7 +1196,7 @@ sub a { } sub handle_ls { - my($self,$pragma,$s) = @_; + my($self,$pragmas,$s) = @_; # ls is really very different, but we had it once as an ordinary # command in the Shell (upto rev. 321) and we could not handle # force well then @@ -1199,7 +1255,18 @@ sub handle_ls { } $CPAN::Frontend->myprint($ad); } + for my $pragma (@$pragmas) { + if ($author->can($pragma)) { + $author->$pragma(); + } + } $author->ls($pathglob,$silent); # silent if more than one author + for my $pragma (@$pragmas) { + my $meth = "un$pragma"; + if ($author->can($meth)) { + $author->$meth(); + } + } } } @@ -1274,6 +1341,7 @@ sub i { # should have been called set and 'o debug' maybe 'set debug' sub o { my($self,$o_type,@o_what) = @_; + $DB::single = 1; $o_type ||= ""; CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n"); if ($o_type eq 'conf') { @@ -1605,25 +1673,32 @@ sub u { # XXX intentionally undocumented because not considered enough #-> sub CPAN::Shell::failed ; sub failed { - my($self) = @_; + my($self,$only_id,$silent) = @_; my $print = ""; DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) { my $failed = ""; - for my $nosayer (qw(make make_test make_install)) { + for my $nosayer (qw(signature_verify make make_test install)) { next unless exists $d->{$nosayer}; - next unless substr($d->{$nosayer},0,2) eq "NO"; + next unless $d->{$nosayer}->failed; $failed = $nosayer; last; } next DIST unless $failed; + next DIST if $only_id && $only_id != $d->{$failed}->commandid; my $id = $d->id; $id =~ s|^./../||; - $print .= sprintf " %-45s: %s %s\n", $id, $failed, $d->{$failed}; + $print .= sprintf( + " %-45s: %s %s\n", + $id, + $failed, + $d->{$failed}->text, + ); } + my $scope = $only_id ? "command" : "session"; if ($print) { - $CPAN::Frontend->myprint("Failed installations in this session:\n$print"); - } else { - $CPAN::Frontend->myprint("No installations failed in this session\n"); + $CPAN::Frontend->myprint("Failed installations in this $scope:\n$print"); + } elsif (!$only_id || !$silent) { + $CPAN::Frontend->myprint("No installations failed in this $scope\n"); } } @@ -1945,6 +2020,11 @@ sub mydie { die "\n"; } +sub mysleep { + my($self, $sleep) = @_; + sleep $sleep; +} + sub setup_output { return if -t STDOUT; my $odef = select STDERR; @@ -2197,31 +2277,38 @@ use strict; #-> sub CPAN::FTP::ftp_get ; sub ftp_get { - my($class,$host,$dir,$file,$target) = @_; - $class->debug( - qq[Going to fetch file [$file] from dir [$dir] + my($class,$host,$dir,$file,$target) = @_; + $class->debug( + qq[Going to fetch file [$file] from dir [$dir] on host [$host] as local [$target]\n] - ) if $CPAN::DEBUG; - my $ftp = Net::FTP->new($host); - return 0 unless defined $ftp; - $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG; - $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]); - unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){ - warn "Couldn't login on $host"; - return; - } - unless ( $ftp->cwd($dir) ){ - warn "Couldn't cwd $dir"; - return; - } - $ftp->binary; - $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG; - unless ( $ftp->get($file,$target) ){ - warn "Couldn't fetch $file from $host\n"; - return; - } - $ftp->quit; # it's ok if this fails - return 1; + ) if $CPAN::DEBUG; + my $ftp = Net::FTP->new($host); + unless ($ftp) { + $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n"); + return; + } + return 0 unless defined $ftp; + $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG; + $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]); + unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){ + my $msg = $ftp->message; + $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg"); + return; + } + unless ( $ftp->cwd($dir) ){ + my $msg = $ftp->message; + $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg"); + return; + } + $ftp->binary; + $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG; + unless ( $ftp->get($file,$target) ){ + my $msg = $ftp->message; + $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg"); + return; + } + $ftp->quit; # it's ok if this fails + return 1; } # If more accuracy is wanted/needed, Chris Leach sent me this patch... @@ -3228,21 +3315,40 @@ happen.\a $last_updated); $DATE_OF_02 = $last_updated; + my $age = time; if ($CPAN::META->has_inst('HTTP::Date')) { require HTTP::Date; - my($age) = (time - HTTP::Date::str2time($last_updated))/3600/24; - if ($age > 30) { + $age -= HTTP::Date::str2time($last_updated); + } else { + $CPAN::Frontend->myprint(" HTTP::Date not available\n"); + require Time::Local; + my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /; + $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4; + $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0; + } + $age /= 3600*24; + if ($age > 30) { - $CPAN::Frontend - ->mywarn(sprintf - qq{Warning: This index file is %d days old. + $CPAN::Frontend + ->mywarn(sprintf + qq{Warning: This index file is %d days old. Please check the host you chose as your CPAN mirror for staleness. I'll continue but problems seem likely to happen.\a\n}, - $age); + $age); + + } elsif ($age < -1) { + + $CPAN::Frontend + ->mywarn(sprintf + qq{Warning: Your system date is %d days behind this index file! + System time: %s + Timestamp index file: %s + Please fix your system time, problems with the make command expected.\n}, + -$age, + scalar gmtime, + $DATE_OF_02, + ); - } - } else { - $CPAN::Frontend->myprint(" HTTP::Date not available\n"); } } @@ -3597,6 +3703,18 @@ sub dump { package CPAN::Author; use strict; +#-> sub CPAN::Author::force +sub force { + my $self = shift; + $self->{force}++; +} + +#-> sub CPAN::Author::force +sub unforce { + my $self = shift; + delete $self->{force}; +} + #-> sub CPAN::Author::id sub id { my $self = shift; @@ -3685,9 +3803,9 @@ sub dir_listing { local($") = "/"; # connect "force" argument with "index_expire". - my $force = 0; + my $force = $self->{force}; if (my @stat = stat $lc_want) { - $force = $stat[9] + $CPAN::Config->{index_expire}*86400 <= time; + $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time; } my $lc_file; if ($may_ftp) { @@ -4073,17 +4191,22 @@ sub get { ); my $wrap = - sprintf(qq{I\'d recommend removing %s. Its signature + sprintf(qq{I'd recommend removing %s. Its signature is invalid. Maybe you have configured your 'urllist' with a bad URL. Please check this array with 'o conf urllist', and retry. For more information, try opening a subshell with look %s and there run - cpansign -v}, + cpansign -v +}, $self->{localfile}, $self->pretty_id, ); - $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap)); + $self->{signature_verify} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap)); + $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep"); + } else { + $self->{signature_verify} = CPAN::Distrostatus->new("YES"); } } else { $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n}); @@ -4253,9 +4376,13 @@ Could not determine which directory to use for looking at $dist. my $pwd = CPAN::anycwd(); $self->safe_chdir($dir); $CPAN::Frontend->myprint(qq{Working directory is $dir\n}); - unless (system($CPAN::Config->{'shell'}) == 0) { - my $code = $? >> 8; - $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n"); + { + local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0; + $ENV{CPAN_SHELL_LEVEL} += 1; + unless (system($CPAN::Config->{'shell'}) == 0) { + my $code = $? >> 8; + $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n"); + } } $self->safe_chdir($pwd); } @@ -4535,7 +4662,7 @@ sub force { )) { delete $self->{$att}; } - if ($method && $method eq "install") { + if ($method && $method =~ /make|test|install/) { $self->{"force_update"}++; # name should probably have been force_install } } @@ -4627,7 +4754,12 @@ or "Is neither a tar nor a zip archive."; !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e, - "had problems unarchiving. Please build manually"; + "Had problems unarchiving. Please build manually"; + + unless ($self->{force_update}) { + exists $self->{signature_verify} and $self->{signature_verify}->failed + and push @e, "Did not pass the signature test."; + } exists $self->{writemakefile} && $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e, @@ -4728,18 +4860,22 @@ or if ($self->{modulebuild}) { $system = "./Build $CPAN::Config->{mbuild_arg}"; } else { - $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg}; + $system = join " ", _make_command(), $CPAN::Config->{make_arg}; } if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); - $self->{'make'} = "YES"; + $self->{'make'} = CPAN::Distrostatus->new("YES"); } else { $self->{writemakefile} ||= "YES"; - $self->{'make'} = "NO"; + $self->{'make'} = CPAN::Distrostatus->new("NO"); $CPAN::Frontend->myprint(" $system -- NOT OK\n"); } } +sub _make_command { + return $CPAN::Config->{'make'} || $Config::Config{make} || 'make'; +} + sub follow_prereqs { my($self) = shift; my(@prereq) = grep {$_ ne "perl"} @_; @@ -4939,6 +5075,10 @@ sub prereq_pm { } last; } + } elsif (-f "Build") { + if ($CPAN::META->has_inst("Module::Build")) { + $req = Module::Build->current->requires(); + } } } $self->{prereq_pm_detected}++; @@ -4970,7 +5110,7 @@ sub test { "Make had some problems, maybe interrupted? Won't test"; exists $self->{'make'} and - $self->{'make'} eq 'NO' and + $self->{'make'}->failed and push @e, "Can't test without successful make"; exists $self->{build_dir} or push @e, "Has no own directory"; @@ -5002,14 +5142,14 @@ sub test { if ($self->{modulebuild}) { $system = "./Build test"; } else { - $system = join " ", $CPAN::Config->{'make'}, "test"; + $system = join " ", _make_command(), "test"; } if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); $CPAN::META->is_tested($self->{'build_dir'}); - $self->{make_test} = "YES"; + $self->{make_test} = CPAN::Distrostatus->new("YES"); } else { - $self->{make_test} = "NO"; + $self->{make_test} = CPAN::Distrostatus->new("NO"); $self->{badtestcnt}++; $CPAN::Frontend->myprint(" $system -- NOT OK\n"); } @@ -5043,7 +5183,7 @@ sub clean { if ($self->{modulebuild}) { $system = "./Build clean"; } else { - $system = join " ", $CPAN::Config->{'make'}, "clean"; + $system = join " ", _make_command(), "clean"; } if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); @@ -5096,17 +5236,21 @@ sub install { "Make had some problems, maybe interrupted? Won't install"; exists $self->{'make'} and - $self->{'make'} eq 'NO' and + $self->{'make'}->failed and push @e, "make had returned bad status, install seems impossible"; - push @e, "make test had returned bad status, ". - "won't install without force" - if exists $self->{'make_test'} and - $self->{'make_test'} eq 'NO' and - ! $self->{'force_update'}; - + if (exists $self->{make_test} and + $self->{make_test}->failed){ + if ($self->{force_update}) { + $self->{make_test}->text("FAILED but failure ignored because ". + "'force' in effect"); + } else { + push @e, "make test had returned bad status, ". + "won't install without force" + } + } exists $self->{'install'} and push @e, - $self->{'install'} eq "YES" ? + $self->{'install'}->text eq "YES" ? "Already done" : "Already tried without success"; exists $self->{later} and length($self->{later}) and @@ -5135,7 +5279,7 @@ sub install { ); } else { my($make_install_make_command) = $CPAN::Config->{'make_install_make_command'} || - $CPAN::Config->{'make'}; + _make_command(); $system = join(" ", $make_install_make_command, "install", @@ -5154,9 +5298,9 @@ sub install { if ($?==0) { $CPAN::Frontend->myprint(" $system -- OK\n"); $CPAN::META->is_installed($self->{'build_dir'}); - return $self->{'install'} = "YES"; + return $self->{'install'} = CPAN::Distrostatus->new("YES"); } else { - $self->{'install'} = "NO"; + $self->{'install'} = CPAN::Distrostatus->new("NO"); $CPAN::Frontend->myprint(" $system -- NOT OK\n"); if ( $makeout =~ /permission/s @@ -5695,7 +5839,11 @@ sub userid { return $ro->{userid} || $ro->{CPAN_USERID}; } # sub CPAN::Module::description -sub description { shift->ro->{description} } +sub description { + my $self = shift; + my $ro = $self->ro or return ""; + $ro->{description} +} sub undelay { my $self = shift; @@ -5825,7 +5973,7 @@ sub as_string { $stats{$ro->{stats}}, $statl{$ro->{statl}}, $stati{$ro->{stati}} - ) if $ro->{statd}; + ) if $ro && $ro->{statd}; my $local_file = $self->inst_file; unless ($self->{MANPAGE}) { if ($local_file) { @@ -6337,6 +6485,12 @@ globbing as in the following examples: The last example is very slow and outputs extra progress indicators that break the alignment of the result. +=item failed + +The C command reports all distributions that failed on one of +C, C or C for some reason in the currently +running shell session. + =item Signals CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are @@ -7101,6 +7255,12 @@ Most functions in package CPAN are exported per default. The reason for this is that the primary use is intended for the cpan shell or for one-liners. +=head1 ENVIRONMENT + +When the CPAN shell enters a subshell via the look command, it sets +the environment CPAN_SHELL_LEVEL to 1 or increments it if it is +already set. + =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES Populating a freshly installed perl with my favorite modules is pretty diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index edfff68..e4ab30a 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 "%.2f", substr(q$Rev: 338 $,4)/100; +$VERSION = sprintf "%.2f", substr(q$Rev: 399 $,4)/100; sub new { my($self,@arg) = @_; @@ -21,7 +21,7 @@ use File::Basename (); use File::Path (); use File::Spec; use vars qw($VERSION); -$VERSION = sprintf "%.2f", substr(q$Rev: 338 $,4)/100; +$VERSION = sprintf "%.2f", substr(q$Rev: 399 $,4)/100; =head1 NAME @@ -38,10 +38,13 @@ file. Nothing special. =cut +use vars qw( %prompts ); + sub init { my($configpm, %args) = @_; - use Config; + # extra arg in 'o conf init make' selects only $item =~ /make/ + my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : ''; unless ($CPAN::VERSION) { require CPAN::Nox; @@ -58,19 +61,10 @@ sub init { # Files, directories # - print qq[ + # not just yet + # if (!@sections or grep /^(files|dirs)$/, @sections) { -CPAN is the world-wide archive of perl resources. It consists of about -100 sites that all replicate the same contents all around the globe. -Many countries have at least one CPAN site already. The resources -found on CPAN are easily accessible with the CPAN.pm module. If you -want to use CPAN.pm, you have to configure it properly. - -If you do not want to enter a dialog now, you can answer 'no' to this -question and I\'ll try to autoconfigure. (Note: you can revisit this -dialog anytime later by typing 'o conf init' at the cpan prompt.) - -]; + print $prompts{manual_config}; my $manual_conf; @@ -102,16 +96,16 @@ dialog anytime later by typing 'o conf init' at the cpan prompt.) }; } } - $CPAN::Frontend->myprint(qq{ + # if ('config_intro' ~= $matcher) { -The following questions are intended to help you with the -configuration. The CPAN module needs a directory of its own to cache -important index files and maybe keep a temporary mirror of CPAN files. -This may be a site-wide directory or a personal directory. + $CPAN::Frontend->myprint($prompts{config_intro}); -}); + #} + + + my $cpan_home = $CPAN::Config->{cpan_home} + || File::Spec->catdir($ENV{HOME}, ".cpan"); - my $cpan_home = $CPAN::Config->{cpan_home} || File::Spec->catdir($ENV{HOME}, ".cpan"); if (-d $cpan_home) { $CPAN::Frontend->myprint(qq{ @@ -120,12 +114,9 @@ I see you already have a directory Shall we use it as the general CPAN build and cache directory? }); - } else { - $CPAN::Frontend->myprint(qq{ - -First of all, I\'d like to create this directory. Where? -}); + } else { + $CPAN::Frontend->myprint($prompts{cpan_home_where}); } $default = $cpan_home; @@ -140,76 +131,46 @@ First of all, I\'d like to create this directory. Where? } eval { File::Path::mkpath($ans); }; # dies if it can't if ($@) { - warn "Couldn't create directory $ans. -Please retry.\n"; + warn "Couldn't create directory $ans.\nPlease retry.\n"; next; } if (-d $ans && -w _) { last; } else { - warn "Couldn't find directory $ans - or directory is not writable. Please retry.\n"; + warn "Couldn't find directory $ans\n" + . "or directory is not writable. Please retry.\n"; } } $CPAN::Config->{cpan_home} = $ans; - $CPAN::Frontend->myprint( qq{ - -If you like, I can cache the source files after I build them. Doing -so means that, if you ever rebuild that module in the future, the -files will be taken from the cache. The tradeoff is that it takes up -space. How much space would you like to allocate to this cache? (If -you don\'t want me to keep a cache, answer 0.) + $CPAN::Frontend->myprint($prompts{keep_source_where}); -}); + $CPAN::Config->{keep_source_where} + = File::Spec->catdir($CPAN::Config->{cpan_home},"sources"); - $CPAN::Config->{keep_source_where} = File::Spec->catdir($CPAN::Config->{cpan_home},"sources"); - $CPAN::Config->{build_dir} = File::Spec->catdir($CPAN::Config->{cpan_home},"build"); + $CPAN::Config->{build_dir} + = File::Spec->catdir($CPAN::Config->{cpan_home},"build"); # # Cache size, Index expire # - $CPAN::Frontend->myprint( qq{ - -How big should the disk cache be for keeping the build directories -with all the intermediate files\? - -}); + $CPAN::Frontend->myprint($prompts{build_cache_intro}); - $default = $CPAN::Config->{build_cache} || 100; # large enough to - # build large - # dists like Tk - $ans = prompt("Cache size for build directory (in MB)?", $default); - $CPAN::Config->{build_cache} = $ans; + # large enough to build large dists like Tk + my_dflt_prompt(build_cache => 100, $matcher); # XXX This the time when we refetch the index files (in days) $CPAN::Config->{'index_expire'} = 1; - $CPAN::Frontend->myprint( qq{ - -By default, each time the CPAN module is started, cache scanning is -performed to keep the cache size in sync. To prevent this, answer -'never'. - -}); - - $default = $CPAN::Config->{scan_cache} || 'atstart'; - do { - $ans = prompt("Perform cache scanning (atstart or never)?", $default); - } while ($ans ne 'atstart' && $ans ne 'never'); - $CPAN::Config->{scan_cache} = $ans; + $CPAN::Frontend->myprint($prompts{scan_cache_intro}); + my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never'); # # cache_metadata # - $CPAN::Frontend->myprint( qq{ -To considerably speed up the initial CPAN shell startup, it is -possible to use Storable to create a cache of metadata. If Storable -is not available, the normal index mechanism will be used. - -}); + $CPAN::Frontend->myprint($prompts{cache_metadata}); defined($default = $CPAN::Config->{cache_metadata}) or $default = 1; do { @@ -220,19 +181,8 @@ is not available, the normal index mechanism will be used. # # term_is_latin # - $CPAN::Frontend->myprint( qq{ -The next option deals with the charset (aka character set) your -terminal supports. In general, CPAN is English speaking territory, so -the charset does not matter much, but some of the aliens out there who -upload their software to CPAN bear names that are outside the ASCII -range. If your terminal supports UTF-8, you should say no to the next -question. If it supports ISO-8859-1 (also known as LATIN1) then you -should say yes. If it supports neither, your answer does not matter -because you will not be able to read the names of some authors -anyway. If you answer no, names will be output in UTF-8. - -}); + $CPAN::Frontend->myprint($prompts{term_is_latin}); defined($default = $CPAN::Config->{term_is_latin}) or $default = 1; do { @@ -244,15 +194,8 @@ anyway. If you answer no, names will be output in UTF-8. # # save history in file histfile # - $CPAN::Frontend->myprint( qq{ -If you have one of the readline packages (Term::ReadLine::Perl, -Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN -shell will have history support. The next two questions deal with the -filename of the history file and with its size. If you do not want to -set this variable, please hit SPACE RETURN to the following question. - -}); + $CPAN::Frontend->myprint($prompts{histfile}); defined($default = $CPAN::Config->{histfile}) or $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile"); @@ -268,57 +211,33 @@ set this variable, please hit SPACE RETURN to the following question. # # do an ls on the m or the d command # - $CPAN::Frontend->myprint( qq{ - -The 'd' and the 'm' command normally only show you information they -have in their in-memory database and thus will never connect to the -internet. If you set the 'show_upload_date' variable to true, 'm' and -'d' will additionally show you the upload date of the module or -distribution. Per default this feature is off because it may require a -net connection to get at the upload date. - -}); + $CPAN::Frontend->myprint($prompts{show_upload_date_intro}); defined($default = $CPAN::Config->{show_upload_date}) or - $default = 0; - $ans = prompt("Always try to show upload date with 'd' and 'm' command?", $default); - $CPAN::Config->{show_upload_date} = $ans; + $default = 'n'; + $ans = prompt("Always try to show upload date with 'd' and 'm' command (yes/no)?", + ($default ? 'yes' : 'no')); + $CPAN::Config->{show_upload_date} = ($ans =~ /^[y1]/i ? 1 : 0); + + #my_prompt_loop(show_upload_date => 'n', $matcher, + #'follow|ask|ignore'); # # prerequisites_policy # Do we follow PREREQ_PM? # - $CPAN::Frontend->myprint( qq{ -The CPAN module can detect when a module which you are trying to build -depends on prerequisites. If this happens, it can build the -prerequisites for you automatically ('follow'), ask you for -confirmation ('ask'), or just ignore them ('ignore'). Please set your -policy to one of the three values. + $CPAN::Frontend->myprint($prompts{prerequisites_policy_intro}); -}); + my_prompt_loop(prerequisites_policy => 'ask', $matcher, + 'follow|ask|ignore'); - $default = $CPAN::Config->{prerequisites_policy} || 'ask'; - do { - $ans = - prompt("Policy on building prerequisites (follow, ask or ignore)?", - $default); - } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore'); - $CPAN::Config->{prerequisites_policy} = $ans; # # External programs # - $CPAN::Frontend->myprint(qq{ - -The CPAN module will need a few external programs to work properly. -Please correct me, if I guess the wrong path for a program. Don\'t -panic if you do not have some of them, just press ENTER for those. To -disable the use of a download program, you can type a space followed -by ENTER. - -}); + $CPAN::Frontend->myprint($prompts{external_progs}); my $old_warn = $^W; local $^W if $^O eq 'MacOS'; @@ -333,6 +252,8 @@ by ENTER. $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 " "; @@ -371,6 +292,9 @@ by ENTER. $path = ""; } $path ||= $ENV{SHELL}; + if (!$path && $^O eq 'MSWin32') { + $path = Win32::IsWinNT() ? "cmd.exe" : "command.com"; + } if ($^O eq 'MacOS') { $CPAN::Config->{'shell'} = 'not_here'; } else { @@ -383,151 +307,48 @@ by ENTER. # Arguments to make etc. # - $CPAN::Frontend->myprint( qq{ - -When you have Module::Build installed and a module comes with both a -Makefile.PL and a Build.PL, which shall have precedence? The two -installer modules we have are the old and well established -ExtUtils::MakeMaker (for short: EUMM) understands the Makefile.PL and -the next generation installer Module::Build (MB) works with the -Build.PL. - -}); - - $default = $CPAN::Config->{prefer_installer} || "EUMM"; - do { - $ans = - prompt("In case you could choose, which installer would you prefer (EUMM or MB)?", - $default); - } while (uc $ans ne 'MB' && uc $ans ne 'EUMM'); - $CPAN::Config->{prefer_installer} = $ans; - - $CPAN::Frontend->myprint( qq{ - -Every Makefile.PL is run by perl in a separate process. Likewise we -run \'make\' and \'make install\' in separate processes. If you have -any parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to -pass to the calls, please specify them here. - -If you don\'t understand this question, just press ENTER. - -}); - - $default = $CPAN::Config->{makepl_arg} || ""; - $CPAN::Config->{makepl_arg} = - prompt("Parameters for the 'perl Makefile.PL' command? -Typical frequently used settings: - - PREFIX=~/perl # non-root users (please see manual for more hints) - -Your choice: ",$default); - $default = $CPAN::Config->{make_arg} || ""; - $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command? -Typical frequently used setting: - - -j3 # dual processor system - -Your choice: ",$default); - - $default = $CPAN::Config->{make_install_make_command} || $CPAN::Config->{make} || ""; - $CPAN::Config->{make_install_make_command} = - prompt("Do you want to use a different make command for 'make install'? -Cautious people will probably prefer: - - su root -c make -or - sudo make -or - /path1/to/sudo -u admin_account /path2/to/make - -or some such. Your choice: ",$default); - - $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || ""; - $CPAN::Config->{make_install_arg} = - prompt("Parameters for the 'make install' command? -Typical frequently used setting: - - UNINST=1 # to always uninstall potentially conflicting files - -Your choice: ",$default); - - $CPAN::Frontend->myprint( qq{ - -The next questions deal with Module::Build support. - -A Build.PL is run by perl in a separate process. Likewise we run -'./Build' and './Build install' in separate processes. If you have any -parameters you want to pass to the calls, please specify them here. + $CPAN::Frontend->myprint($prompts{prefer_installer_intro}); -}); + my_prompt_loop(prefer_installer => 'EUMM', $matcher, 'MB|EUMM'); - $default = $CPAN::Config->{mbuildpl_arg} || ""; - $CPAN::Config->{mbuildpl_arg} = - prompt("Parameters for the 'perl Build.PL' command? -Typical frequently used settings: - --install_base /home/xxx # different installation directory + $CPAN::Frontend->myprint($prompts{makepl_arg_intro}); -Your choice: ",$default); - $default = $CPAN::Config->{mbuild_arg} || ""; - $CPAN::Config->{mbuild_arg} = prompt("Parameters for the './Build' command? -Setting might be: + my_dflt_prompt(makepl_arg => "", $matcher); - --extra_linker_flags -L/usr/foo/lib # non-standard library location + my_dflt_prompt(make_arg => "", $matcher); -Your choice: ",$default); + my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "", + $matcher); - $default = $CPAN::Config->{mbuild_install_build_command} || "./Build"; - $CPAN::Config->{mbuild_install_build_command} = - prompt("Do you want to use a different command for './Build install'? -Sudo users will probably prefer: + my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "", + $matcher); - su root -c ./Build -or - sudo ./Build -or - /path1/to/sudo -u admin_account ./Build + $CPAN::Frontend->myprint($prompts{mbuildpl_arg_intro}); -or some such. Your choice: ",$default); + my_dflt_prompt(mbuildpl_arg => "", $matcher); - $default = $CPAN::Config->{mbuild_install_arg} || ""; - $CPAN::Config->{mbuild_install_arg} = - prompt("Parameters for the './Build install' command? -Typical frequently used setting: + my_dflt_prompt(mbuild_arg => "", $matcher); - --uninst 1 # uninstall conflicting files + my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher); -Your choice: ",$default); + my_dflt_prompt(mbuild_install_arg => "", $matcher); # # Alarm period # - $CPAN::Frontend->myprint( qq{ + $CPAN::Frontend->myprint($prompts{inactivity_timeout_intro}); -Sometimes you may wish to leave the processes run by CPAN alone -without caring about them. Because the Makefile.PL sometimes contains -question you\'re expected to answer, you can set a timer that will -kill a 'perl Makefile.PL' process after the specified time in seconds. - -If you set this value to 0, these processes will wait forever. This is -the default and recommended setting. - -}); + # my_dflt_prompt(inactivity_timeout => 0); $default = $CPAN::Config->{inactivity_timeout} || 0; $CPAN::Config->{inactivity_timeout} = - prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default); + prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default); # Proxies - $CPAN::Frontend->myprint( qq{ - -If you\'re accessing the net via proxies, you can specify them in the -CPAN configuration or via environment variables. The variable in -the \$CPAN::Config takes precedence. - -}); + $CPAN::Frontend->myprint($prompts{proxies}); for (qw/ftp_proxy http_proxy no_proxy/) { $default = $CPAN::Config->{$_} || $ENV{$_}; @@ -536,33 +357,18 @@ the \$CPAN::Config takes precedence. if ($CPAN::Config->{ftp_proxy} || $CPAN::Config->{http_proxy}) { + $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER; - $CPAN::Frontend->myprint( qq{ -If your proxy is an authenticating proxy, you can store your username -permanently. If you do not want that, just press RETURN. You will then -be asked for your username in every future session. + $CPAN::Frontend->myprint($prompts{proxy_user}); -}); if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) { - $CPAN::Frontend->myprint( qq{ - -Your password for the authenticating proxy can also be stored -permanently on disk. If this violates your security policy, just press -RETURN. You will then be asked for the password in every future -session. - -}); + $CPAN::Frontend->myprint($prompts{proxy_pass}); if ($CPAN::META->has_inst("Term::ReadKey")) { Term::ReadKey::ReadMode("noecho"); } else { - $CPAN::Frontend->myprint( qq{ - -Warning: Term::ReadKey seems not to be available, your password will -be echoed to the terminal! - -}); + $CPAN::Frontend->myprint($prompts{password_warn}); } $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?"); if ($CPAN::META->has_inst("Term::ReadKey")) { @@ -586,6 +392,34 @@ be echoed to the terminal! CPAN::HandleConfig->commit($configpm); } +sub my_dflt_prompt { + my ($item, $dflt, $m) = @_; + my $default = $CPAN::Config->{$item} || $dflt; + + $DB::single = 1; + if (!$m || $item =~ /$m/) { + $CPAN::Config->{$item} = prompt($prompts{$item}, $default); + } else { + $CPAN::Config->{$item} = $default; + } +} + +sub my_prompt_loop { + my ($item, $dflt, $m, $ok) = @_; + my $default = $CPAN::Config->{$item} || $dflt; + my $ans; + + $DB::single = 1; + if (!$m || $item =~ /$m/) { + do { $ans = prompt($prompts{$item}, $default); + } until $ans =~ /$ok/; + $CPAN::Config->{$item} = $ans; + } else { + $CPAN::Config->{$item} = $default; + } +} + + sub conf_sites { my $m = 'MIRRORED.BY'; my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m); @@ -611,25 +445,18 @@ Shall I use the local database in $mby?}; } while ($mby) { if ($overwrite_local) { - print qq{Trying to overwrite $mby -}; + print qq{Trying to overwrite $mby\n}; $mby = CPAN::FTP->localize($m,$mby,3); $overwrite_local = 0; } elsif ( ! -f $mby ){ - print qq{You have no $mby - I\'m trying to fetch one -}; + print qq{You have no $mby\n I\'m trying to fetch one\n}; $mby = CPAN::FTP->localize($m,$mby,3); } elsif (-M $mby > 60 && $loopcount == 0) { - print qq{Your $mby is older than 60 days, - I\'m trying to fetch one -}; + print qq{Your $mby is older than 60 days,\n I\'m trying to fetch one\n}; $mby = CPAN::FTP->localize($m,$mby,3); $loopcount++; } elsif (-s $mby == 0) { - print qq{You have an empty $mby, - I\'m trying to fetch one -}; + print qq{You have an empty $mby,\n I\'m trying to fetch one\n}; $mby = CPAN::FTP->localize($m,$mby,3); } else { last; @@ -704,7 +531,8 @@ sub display_some { sub read_mirrored_by { my $local = shift or return; - my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location); + my(%all,$url,$expected_size,$default,$ans,$host, + $dst,$country,$continent,@location); my $fh = FileHandle->new; $fh->open($local) or die "Couldn't open $local: $!"; local $/ = "\012"; @@ -729,22 +557,7 @@ sub read_mirrored_by { $CPAN::Config->{urllist} = []; } - print qq{ - -Now we need to know where your favorite CPAN sites are located. Push -a few sites onto the array (just in case the first on the array won\'t -work). If you are mirroring CPAN to your local workstation, specify a -file: URL. - -First, pick a nearby continent and country (you can pick several of -each, separated by spaces, or none if you just want to keep your -existing selections). Then, you will be presented with a list of URLs -of CPAN mirrors in the countries you selected, along with previously -selected URLs. Select some of those URLs, or just keep the old list. -Finally, you will be prompted for any extra URLs -- file:, ftp:, or -http: -- that host a CPAN mirror. - -}; + print $prompts{urls_intro}; my (@cont, $cont, %cont, @countries, @urls, %seen); my $no_previous_warn = @@ -851,4 +664,331 @@ sub prompt_no_strip ($;$) { } +BEGIN { + +my @prompts = ( + +manual_config => qq[ + +CPAN is the world-wide archive of perl resources. It consists of about +100 sites that all replicate the same contents all around the globe. +Many countries have at least one CPAN site already. The resources +found on CPAN are easily accessible with the CPAN.pm module. If you +want to use CPAN.pm, you have to configure it properly. + +If you do not want to enter a dialog now, you can answer 'no' to this +question and I\'ll try to autoconfigure. (Note: you can revisit this +dialog anytime later by typing 'o conf init' at the cpan prompt.) + +], + +config_intro => qq{ + +The following questions are intended to help you with the +configuration. The CPAN module needs a directory of its own to cache +important index files and maybe keep a temporary mirror of CPAN files. +This may be a site-wide directory or a personal directory. + +}, + +# cpan_home => qq{ }, + +cpan_home_where => qq{ + +First of all, I\'d like to create this directory. Where? + +}, + +keep_source_where => qq{ + +If you like, I can cache the source files after I build them. Doing +so means that, if you ever rebuild that module in the future, the +files will be taken from the cache. The tradeoff is that it takes up +space. How much space would you like to allocate to this cache? (If +you don\'t want me to keep a cache, answer 0.) + +}, + +build_cache_intro => qq{ + +How big should the disk cache be for keeping the build directories +with all the intermediate files\? + +}, + +build_cache => +"Cache size for build directory (in MB)?", + + +scan_cache_intro => qq{ + +By default, each time the CPAN module is started, cache scanning is +performed to keep the cache size in sync. To prevent this, answer +'never'. + +}, + +scan_cache => "Perform cache scanning (atstart or never)?", + +cache_metadata => qq{ + +To considerably speed up the initial CPAN shell startup, it is +possible to use Storable to create a cache of metadata. If Storable +is not available, the normal index mechanism will be used. + +}, + +term_is_latin => qq{ + +The next option deals with the charset (aka character set) your +terminal supports. In general, CPAN is English speaking territory, so +the charset does not matter much, but some of the aliens out there who +upload their software to CPAN bear names that are outside the ASCII +range. If your terminal supports UTF-8, you should say no to the next +question. If it supports ISO-8859-1 (also known as LATIN1) then you +should say yes. If it supports neither, your answer does not matter +because you will not be able to read the names of some authors +anyway. If you answer no, names will be output in UTF-8. + +}, + +histfile => qq{ + +If you have one of the readline packages (Term::ReadLine::Perl, +Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN +shell will have history support. The next two questions deal with the +filename of the history file and with its size. If you do not want to +set this variable, please hit SPACE RETURN to the following question. + +}, + +show_upload_date_intro => qq{ + +The 'd' and the 'm' command normally only show you information they +have in their in-memory database and thus will never connect to the +internet. If you set the 'show_upload_date' variable to true, 'm' and +'d' will additionally show you the upload date of the module or +distribution. Per default this feature is off because it may require a +net connection to get at the upload date. + +}, + +show_upload_date => +"Always try to show upload date with 'd' and 'm' command (yes/no)?", + +prerequisites_policy_intro => qq{ + +The CPAN module can detect when a module which you are trying to build +depends on prerequisites. If this happens, it can build the +prerequisites for you automatically ('follow'), ask you for +confirmation ('ask'), or just ignore them ('ignore'). Please set your +policy to one of the three values. + +}, + +prerequisites_policy => + qq{Policy on building prerequisites (follow, ask or ignore)?}, + +external_progs => qq{ + +The CPAN module will need a few external programs to work properly. +Please correct me, if I guess the wrong path for a program. Don\'t +panic if you do not have some of them, just press ENTER for those. To +disable the use of a download program, you can type a space followed +by ENTER. + +}, + +prefer_installer_intro => qq{ + +When you have Module::Build installed and a module comes with both a +Makefile.PL and a Build.PL, which shall have precedence? The two +installer modules we have are the old and well established +ExtUtils::MakeMaker (for short: EUMM) understands the Makefile.PL and +the next generation installer Module::Build (MB) works with the +Build.PL. + +}, + +prefer_installer => +qq{In case you could choose, which installer would you prefer (EUMM or MB)?}, + +makepl_arg_intro => qq{ + +Every Makefile.PL is run by perl in a separate process. Likewise we +run \'make\' and \'make install\' in separate processes. If you have +any parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to +pass to the calls, please specify them here. + +If you don\'t understand this question, just press ENTER. +}, + +makepl_arg => qq{ +Parameters for the 'perl Makefile.PL' command? +Typical frequently used settings: + + PREFIX=~/perl # non-root users (please see manual for more hints) + +Your choice: }, + +make_arg => qq{Parameters for the 'make' command? +Typical frequently used setting: + + -j3 # dual processor system + +Your choice: }, + + +make_install_make_command => qq{Do you want to use a different make command for 'make install'? +Cautious people will probably prefer: + + su root -c make +or + sudo make +or + /path1/to/sudo -u admin_account /path2/to/make + +or some such. Your choice: }, + + +make_install_arg => qq{Parameters for the 'make install' command? +Typical frequently used setting: + + UNINST=1 # to always uninstall potentially conflicting files + +Your choice: }, + + +mbuildpl_arg_intro => qq{ + +The next questions deal with Module::Build support. + +A Build.PL is run by perl in a separate process. Likewise we run +'./Build' and './Build install' in separate processes. If you have any +parameters you want to pass to the calls, please specify them here. + +}, + +mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command? +Typical frequently used settings: + + --install_base /home/xxx # different installation directory + +Your choice: }, + +mbuild_arg => qq{Parameters for the './Build' command? +Setting might be: + + --extra_linker_flags -L/usr/foo/lib # non-standard library location + +Your choice: }, + + +mbuild_install_build_command => qq{Do you want to use a different command for './Build install'? +Sudo users will probably prefer: + + su root -c ./Build +or + sudo ./Build +or + /path1/to/sudo -u admin_account ./Build + +or some such. Your choice: }, + + +mbuild_install_arg => qq{Parameters for the './Build install' command? +Typical frequently used setting: + + --uninst 1 # uninstall conflicting files + +Your choice: }, + + + +inactivity_timeout_intro => qq{ + +Sometimes you may wish to leave the processes run by CPAN alone +without caring about them. Because the Makefile.PL sometimes contains +question you\'re expected to answer, you can set a timer that will +kill a 'perl Makefile.PL' process after the specified time in seconds. + +If you set this value to 0, these processes will wait forever. This is +the default and recommended setting. + +}, + +inactivity_timeout => +qq{Timeout for inactivity during {Makefile,Build}.PL? }, + + +proxies => qq{ + +If you\'re accessing the net via proxies, you can specify them in the +CPAN configuration or via environment variables. The variable in +the \$CPAN::Config takes precedence. + +}, + +proxy_user => qq{ + +If your proxy is an authenticating proxy, you can store your username +permanently. If you do not want that, just press RETURN. You will then +be asked for your username in every future session. + +}, + +proxy_pass => qq{ + +Your password for the authenticating proxy can also be stored +permanently on disk. If this violates your security policy, just press +RETURN. You will then be asked for the password in every future +session. + +}, + +urls_intro => qq{ + +Now we need to know where your favorite CPAN sites are located. Push +a few sites onto the array (just in case the first on the array won\'t +work). If you are mirroring CPAN to your local workstation, specify a +file: URL. + +First, pick a nearby continent and country (you can pick several of +each, separated by spaces, or none if you just want to keep your +existing selections). Then, you will be presented with a list of URLs +of CPAN mirrors in the countries you selected, along with previously +selected URLs. Select some of those URLs, or just keep the old list. +Finally, you will be prompted for any extra URLs -- file:, ftp:, or +http: -- that host a CPAN mirror. + +}, + +password_warn => qq{ + +Warning: Term::ReadKey seems not to be available, your password will +be echoed to the terminal! + +}, + +); + +die "Coding error in \@prompts declaration. Odd number of elements, above" + if (@prompts % 2); + +%prompts = @prompts; + +if (scalar(keys %prompts) != scalar(@prompts)/2) { + + my %already; + + for my $item (0..$#prompts) { + next if $item % 2; + die "$prompts[$item] is duplicated\n" + if $already{$prompts[$item]}++; + } + +} + +} + 1; diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm index 493a806..8c50d41 100644 --- a/lib/CPAN/HandleConfig.pm +++ b/lib/CPAN/HandleConfig.pm @@ -1,28 +1,8 @@ -package CPAN::Config; -use strict; -use vars qw($AUTOLOAD); - -# formerly CPAN::HandleConfig was known as CPAN::Config -sub AUTOLOAD { - my($l) = $AUTOLOAD; - $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig"); - $l =~ s/.*:://; - CPAN::HandleConfig->$l(@_); -} - -# note: J. Nick Koston wrote me that they are using -# CPAN::Config->commit although undocumented. I suggested -# CPAN::Shell->o("conf","commit") even when ugly it is at least -# documented - -# that's why I added the CPAN::Config class with autoload and -# deprecated warning - package CPAN::HandleConfig; use strict; use vars qw(%can %keys $dot_cpan $VERSION); -$VERSION = sprintf "%.2f", substr(q$Rev: 337 $,4)/100; +$VERSION = sprintf "%.2f", substr(q$Rev: 423 $,4)/100; %can = ( 'commit' => "Commit changes to disk", @@ -32,7 +12,7 @@ $VERSION = sprintf "%.2f", substr(q$Rev: 337 $,4)/100; %keys = map { $_ => undef } qw( build_cache build_dir bzip2 - cache_metadata cpan_home curl + cache_metadata commandnumber_in_prompt cpan_home curl dontload_hash ftp ftp_proxy getcwd gpg gzip @@ -57,8 +37,9 @@ sub edit { CPAN->debug("self[$self]args[".join(" | ",@args)."]"); my($o,$str,$func,$args,$key_exists); $o = shift @args; + $DB::single = 1; if($can{$o}) { - $self->$o(@args); + $self->$o(args => \@args); return 1; } else { CPAN->debug("o[$o]") if $CPAN::DEBUG; @@ -109,12 +90,15 @@ sub prettyprint { my($self,$k) = @_; my $v = $CPAN::Config->{$k}; if (ref $v) { - my(@report) = ref $v eq "ARRAY" ? - @$v : - map { sprintf(" %-18s => [%s]\n", - map { "[$_]" } $_, - defined $v->{$_} ? $v->{$_} : "UNDEFINED" - )} keys %$v; + my(@report); + if (ref $v eq "ARRAY") { + @report = map {"\t[$_]\n"} @$v; + } else { + @report = map { sprintf("\t%-18s => %s\n", + map { "[$_]" } $_, + defined $v->{$_} ? $v->{$_} : "UNDEFINED" + )} keys %$v; + } $CPAN::Frontend->myprint( join( "", @@ -122,7 +106,7 @@ sub prettyprint { " %-18s\n", $k ), - map {"\t[$_]\n"} @report + @report ) ); } elsif (defined $v) { @@ -133,7 +117,15 @@ sub prettyprint { } sub commit { - my($self,$configpm) = @_; + my($self,@args) = @_; + my $configpm; + if (@args) { + if ($args[0] eq "args") { + # we have not signed that contract + } else { + $configpm = $args[0]; + } + } unless (defined $configpm){ $configpm ||= $INC{"CPAN/MyConfig.pm"}; $configpm ||= $INC{"CPAN/Config.pm"}; @@ -180,7 +172,7 @@ EOF #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); #chmod $mode, $configpm; ###why was that so? $self->defaults; - $CPAN::Frontend->myprint("commit: wrote $configpm\n"); + $CPAN::Frontend->myprint("commit: wrote '$configpm'\n"); 1; } @@ -193,13 +185,13 @@ sub defaults { } sub init { - my($self) = @_; + my($self,@args) = @_; undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to # have the least # important # variable # undefined - $self->load; + $self->load(@args); 1; } @@ -239,12 +231,12 @@ sub load { my(@miss); use Carp; - eval {require CPAN::Config;}; # We eval because of some - # MakeMaker problems + unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already + eval {require CPAN::Config;}; # not everybody has one + } unless ($dot_cpan++){ unshift @INC, File::Spec->catdir($ENV{HOME},".cpan"); - eval {require CPAN::MyConfig;}; # where you can override - # system wide settings + eval {require CPAN::MyConfig;}; # override system wide settings shift @INC; } return unless @miss = $self->missing_config_data; @@ -380,6 +372,29 @@ sub cpl { return grep /^\Q$word\E/, @o_conf; } + +package ####::###### #hide from indexer + CPAN::Config; +# note: J. Nick Koston wrote me that they are using +# CPAN::Config->commit although undocumented. I suggested +# CPAN::Shell->o("conf","commit") even when ugly it is at least +# documented + +# that's why I added the CPAN::Config class with autoload and +# deprecated warning + +use strict; +use vars qw($AUTOLOAD $VERSION); +$VERSION = sprintf "%.2f", substr(q$Rev: 423 $,4)/100; + +# formerly CPAN::HandleConfig was known as CPAN::Config +sub AUTOLOAD { + my($l) = $AUTOLOAD; + $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig"); + $l =~ s/.*:://; + CPAN::HandleConfig->$l(@_); +} + 1; __END__ diff --git a/lib/CPAN/SIGNATURE b/lib/CPAN/SIGNATURE index e60928d..045e793 100644 --- a/lib/CPAN/SIGNATURE +++ b/lib/CPAN/SIGNATURE @@ -14,41 +14,43 @@ not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 a6c7343a7937488434d7b0254f94787b129df8bd ChangeLog +SHA1 1dd6639dee1773639e5e22cf785d9f6b0efeff2f ChangeLog SHA1 9b97524a7a91c815e46b19302a33829d3c26bbbf ChangeLog.old +SHA1 14cb7a05a3d6ee722c47566e3eefdfc652732e83 Changes SHA1 a029ffa2f2252bb8914eb658666244710994d256 Changes.old -SHA1 0fbd0f7751c77f99d1020a10ca82be0b63fe06c1 MANIFEST -SHA1 c4090d00f577a0c5b562899afb75abc626805eb6 MANIFEST.SKIP -SHA1 42cbf3182f3f290d920d9fcbc4081b4d8776b186 META.yml -SHA1 7e95a16dc2e04fb32ab9a058d8b25b720377e6c1 Makefile.PL +SHA1 b3fc1dfd25885b80d144cf817b9f0b1c88fe41d6 MANIFEST +SHA1 6abf20ed9cb6c55d6c8062841522a5b6b784f074 MANIFEST.SKIP +SHA1 29d220942dfa9ec0e41a63037c6ba3995c85e30b META.yml +SHA1 23b8305cc0883f6163b52a673838dbab9961399c Makefile.PL SHA1 37e858c51409a297ef5d3fb35dc57cd3b57f9a4d PAUSE2003.pub SHA1 af016003ad503ed078c5f8254521d13a3e0c494f PAUSE2005.pub -SHA1 fc1836c23a1fae2e86169bbc57058f06fd3ad457 README -SHA1 b0baafdce51037288ca925516501bfe21ff2b0c7 Releasenotes -SHA1 6c9eb4b95e9acb5928464b09e7d94a4368d63bbd Todo +SHA1 86d4b26821f12425dfafa2a149ed7a89a0b358d5 README +SHA1 9b2b49def457c50b3dd05be10c944ea6d569122e Todo SHA1 efbe8e6882a2caa0d741b113959a706830ab5882 inc/Test/Builder.pm SHA1 ae1d68262bedc2475e2c6fd478d99b259b4fb109 inc/Test/More.pm SHA1 06a0406535e8ae4057e374d4ea8cd5b105483803 lib/Bundle/CPAN.pm -SHA1 7494410d1d146437bffd50467b54463e264f7515 lib/CPAN.pm +SHA1 58939f1928bcbad69be302c13416717d9faf7b82 lib/CPAN.pm SHA1 104fd2b39fdba692143655b53bcf01d36c8ebf68 lib/CPAN/Admin.pm SHA1 0dc9b34d14c199a57f26d4d4d9ff7653ca3c5834 lib/CPAN/Debug.pm -SHA1 a1622c2ff6534ee904d7a70a852f6bedadd2344e lib/CPAN/FirstTime.pm -SHA1 515c0c0d9e5b453827b72210e6f7f380df0880fa lib/CPAN/HandleConfig.pm +SHA1 add49d4be143c5fe705a96e9195d931c7c30ad52 lib/CPAN/FirstTime.pm +SHA1 34cd91d32c05805428140a812dc3e14358a7595b lib/CPAN/HandleConfig.pm SHA1 4fa9695417b54fc8d4e29684ad61689bc108274b lib/CPAN/Nox.pm SHA1 e85202a30802f3cd86e67af649ba219d97b0925c lib/CPAN/Tarzip.pm SHA1 174b3501753423eb90914fb5be043b79e405af28 lib/CPAN/Version.pm -SHA1 77d2d606c0ce30eac1b8e22933d91d6e219203be scripts/cpan +SHA1 fb08e07d8740ef36e8ab719c6a9b7e89c4fe674a scripts/cpan +SHA1 fd5431e748094972572d216dfb55c69b14433205 t/CPAN/TestConfig.pm SHA1 67e80e1cfc3530932de7743dd0c833b2c387609d t/Nox.t SHA1 215dace24b507de20011d36cbe2d16ddea78bcf3 t/loadme.t SHA1 325d8a2f72d59c4cd2400c72403c05cd614c3abc t/mirroredby.t SHA1 6a79f15a10337bd3450604abf39d4462df2a550b t/pod.t +SHA1 50088f8e2dc36b679d73a4b55c4627f3837308c8 t/shell.t SHA1 952e77e7944637eed1b5d202afa98baef8a4c64c t/signature.t SHA1 d773586d80dbd79605a4b08c3ef310379c4d09c5 t/vcmp.t SHA1 b505a0db80ed4c835ad5676e9d1cbf09c86e6c34 t/version.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.2 (GNU/Linux) -iD8DBQFDvNKJ7IA58KMXwV0RAvsnAJ9cWtGhEMl4wa5n0Xfeu1WLYBba/wCfQxnO -RhsZ8JzeCu60s+x3kCqZ4es= -=RU5L +iD8DBQFDyOEB7IA58KMXwV0RAgB7AKD5n5S0ba3fjs4HCU0NqyC4kSUhXgCeOoaK +IJBJ/2MnhVq24hvEfglqMGo= +=4fdL -----END PGP SIGNATURE----- diff --git a/lib/CPAN/bin/cpan b/lib/CPAN/bin/cpan index 0060d79..83044ae 100644 --- a/lib/CPAN/bin/cpan +++ b/lib/CPAN/bin/cpan @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: cpan,v 1.5 2005/12/24 00:59:08 comdog Exp $ +# $Id: cpan,v 1.7 2006/01/11 06:22:32 comdog Exp $ use strict; =head1 NAME @@ -158,7 +158,7 @@ brian d foy, C<< >> =head1 COPYRIGHT -Copyright (c) 2001-2005, brian d foy, All Rights Reserved. +Copyright (c) 2001-2006, brian d foy, All Rights Reserved. You may redistribute this under the same terms as Perl itself. @@ -168,7 +168,7 @@ use CPAN (); use Getopt::Std; my $VERSION = - sprintf "%d.%02d", q$Revision: 296 $ =~ m/ (\d+) \. (\d+) /xg; + sprintf "%d.%d", q$Revision: 403 $ =~ m/ (\d+) \. (\d+) /xg; if( 0 == @ARGV ) { CPAN::shell(); exit 0 } @@ -231,6 +231,9 @@ Getopt::Std::getopts( my $option_count = grep { $options{$_} } @option_order; $option_count -= $options{'f'}; # don't count force +# if there are no options, set -i (this line fixes RT ticket 16915) +$options{i}++ unless $option_count; + # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # try each of the possible switches until we find one to handle # print an error message if there are too many switches