X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCPAN%2FFirstTime.pm;h=35043d7b3029d32971866e8804f38a5a1f2f7b19;hb=ac49b0251b62a2ed1e5f0e17d1c256ce3f88d6dd;hp=731d3ff2e4b773468fae552f74d7439c287e11bc;hpb=36263cb347dc0d66c6ed49be3e8c8a14c5d21ffb;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index 731d3ff..35043d7 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -1,3 +1,4 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- package CPAN::Mirrored::By; sub new { @@ -11,12 +12,13 @@ sub url { shift->[2] } package CPAN::FirstTime; use strict; -use ExtUtils::MakeMaker qw(prompt); +use ExtUtils::MakeMaker (); use FileHandle (); use File::Basename (); use File::Path (); +use File::Spec; use vars qw($VERSION); -$VERSION = substr q$Revision: 1.37 $, 10; +$VERSION = substr q$Revision: 1.60_01 $, 10; =head1 NAME @@ -46,7 +48,7 @@ sub init { local($\) = ""; local($|) = 1; - my($ans,$default,$local,$cont,$url,$expected_size); + my($ans,$default); # # Files, directories @@ -66,22 +68,22 @@ dialog anytime later by typing 'o conf init' at the cpan prompt.) ]; - my $manual_conf = - ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?", - "yes"); + my $manual_conf = prompt("Are you ready for manual configuration?", "yes"); my $fastread; { - local $^W; - if ($manual_conf =~ /^\s*y/i) { + if ($manual_conf =~ /^y/i) { $fastread = 0; - *prompt = \&ExtUtils::MakeMaker::prompt; } else { $fastread = 1; $CPAN::Config->{urllist} ||= []; - *prompt = sub { + + local $^W = 0; + # prototype should match that of &MakeMaker::prompt + *_real_prompt = sub ($;$) { my($q,$a) = @_; my($ret) = defined $a ? $a : ""; printf qq{%s [%s]\n\n}, $q, $ret; + $ret; }; } @@ -95,7 +97,7 @@ This may be a site-wide directory or a personal directory. }; - my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan"); + my $cpan_home = $CPAN::Config->{cpan_home} || File::Spec->catdir($ENV{HOME}, ".cpan"); if (-d $cpan_home) { print qq{ @@ -114,6 +116,14 @@ First of all, I\'d like to create this directory. Where? $default = $cpan_home; while ($ans = prompt("CPAN build and cache directory?",$default)) { + unless (File::Spec->file_name_is_absolute($ans)) { + require Cwd; + my $cwd = Cwd::cwd(); + my $absans = File::Spec->catdir($cwd,$ans); + warn "The path '$ans' is not an absolute path. Please specify an absolute path\n"; + $default = $absans; + next; + } eval { File::Path::mkpath($ans); }; # dies if it can't if ($@) { warn "Couldn't create directory $ans. @@ -138,8 +148,8 @@ next question. }; - $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources"); - $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build"); + $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"); # # Cache size, Index expire @@ -148,7 +158,7 @@ next question. print qq{ How big should the disk cache be for keeping the build directories -with all the intermediate files? +with all the intermediate files\? }; @@ -174,6 +184,71 @@ disable the cache scanning with 'never'. $CPAN::Config->{scan_cache} = $ans; # + # cache_metadata + # + print 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. + +}; + + defined($default = $CPAN::Config->{cache_metadata}) or $default = 1; + do { + $ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no')); + } while ($ans !~ /^[yn]/i); + $CPAN::Config->{cache_metadata} = ($ans =~ /^y/i ? 1 : 0); + + # + # term_is_latin + # + print qq{ + +The next option deals with the charset your terminal supports. In +general CPAN is English speaking territory, thus 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 say no to the next question, if it +supports ISO-8859-1 (also known as LATIN1) then you say yes, and if it +supports neither nor, your answer does not matter, you will not be +able to read the names of some authors anyway. If you answer no, names +will be output in UTF-8. + +}; + + defined($default = $CPAN::Config->{term_is_latin}) or $default = 1; + do { + $ans = prompt("Your terminal expects ISO-8859-1 (yes/no)?", + ($default ? 'yes' : 'no')); + } while ($ans !~ /^[yn]/i); + $CPAN::Config->{term_is_latin} = ($ans =~ /^y/i ? 1 : 0); + + # + # save history in file histfile + # + print 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. + +}; + + defined($default = $CPAN::Config->{histfile}) or + $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile"); + $ans = prompt("File to save your history?", $default); + $CPAN::Config->{histfile} = $ans; + + if ($CPAN::Config->{histfile}) { + defined($default = $CPAN::Config->{histsize}) or $default = 100; + $ans = prompt("Number of lines to save?", $default); + $CPAN::Config->{histsize} = $ans; + } + + # # prerequisites_policy # Do we follow PREREQ_PM? # @@ -187,7 +262,7 @@ policy to one of the three values. }; - $default = $CPAN::Config->{prerequisites_policy} || 'follow'; + $default = $CPAN::Config->{prerequisites_policy} || 'ask'; do { $ans = prompt("Policy on building prerequisites (follow, ask or ignore)?", @@ -201,10 +276,11 @@ policy to one of the three values. print 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. +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. }; @@ -213,7 +289,10 @@ those. my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'}; local $^W = $old_warn; my $progname; - for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){ + for $progname (qw/gzip tar unzip make + curl lynx wget ncftpget ncftp ftp + gpg/) + { if ($^O eq 'MacOS') { $CPAN::Config->{$progname} = 'not_here'; next; @@ -224,7 +303,7 @@ those. my $path = $CPAN::Config->{$progname} || $Config::Config{$progname} || ""; - if (MM->file_name_is_absolute($path)) { + if (File::Spec->file_name_is_absolute($path)) { # testing existence is not good enough, some have these exe # extensions @@ -251,7 +330,7 @@ those. $ans = prompt("What is your favorite pager program?",$path); $CPAN::Config->{'pager'} = $ans; $path = $CPAN::Config->{'shell'}; - if (MM->file_name_is_absolute($path)) { + if (File::Spec->file_name_is_absolute($path)) { warn "Warning: configured $path does not exist\n" unless -e $path; $path = ""; } @@ -271,9 +350,9 @@ those. print qq{ Every Makefile.PL is run by perl in a separate process. Likewise we -run \'make\' and \'make install\' in processes. If you have any parameters -\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to -the calls, please specify them here. +run \'make\' and \'make install\' in 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. @@ -281,13 +360,28 @@ 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?",$default); + 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?",$default); + $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_arg} || $CPAN::Config->{make_arg} || ""; $CPAN::Config->{make_install_arg} = - prompt("Parameters for the 'make install' command?",$default); + prompt("Parameters for the 'make install' command? +Typical frequently used setting: + + UNINST=1 to always uninstall potentially conflicting files + +Your choice: ",$default); # # Alarm period @@ -324,25 +418,50 @@ the \$CPAN::Config takes precedence. $CPAN::Config->{$_} = prompt("Your $_?",$default); } - # - # MIRRORED.BY - # + if ($CPAN::Config->{ftp_proxy} || + $CPAN::Config->{http_proxy}) { + $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER; + print qq{ - conf_sites() unless $fastread; +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. - unless (@{$CPAN::Config->{'wait_list'}||[]}) { - print qq{ +}; + if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) { + print 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. + +}; + + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("noecho"); + } else { + print qq{ -WAIT support is available as a Plugin. You need the CPAN::WAIT module -to actually use it. But we need to know your favorite WAIT server. If -you don\'t know a WAIT server near you, just press ENTER. +Warning: Term::ReadKey seems not to be available, your password will +be echoed to the terminal! }; - $default = "wait://ls6.informatik.uni-dortmund.de:1404"; - $ans = prompt("Your favorite WAIT server?\n ",$default); - push @{$CPAN::Config->{'wait_list'}}, $ans; + } + $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?"); + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("restore"); + } + $CPAN::Frontend->myprint("\n\n"); + } } + # + # MIRRORED.BY + # + + conf_sites() unless $fastread; + # We don't ask that now, it will be noticed in time, won't it? $CPAN::Config->{'inhibit_startup_message'} = 0; $CPAN::Config->{'getcwd'} = 'cwd'; @@ -353,23 +472,44 @@ you don\'t know a WAIT server near you, just press ENTER. sub conf_sites { my $m = 'MIRRORED.BY'; - my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m); + my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m); File::Path::mkpath(File::Basename::dirname($mby)); if (-f $mby && -f $m && -M $m < -M $mby) { require File::Copy; File::Copy::copy($m,$mby) or die "Could not update $mby: $!"; } - while () { - if ( ! -f $mby ){ + my $loopcount = 0; + local $^T = time; + my $overwrite_local = 0; + if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) { + my $mtime = localtime((stat _)[9]); + my $prompt = qq{Found $mby as of $mtime + +I\'d use that as a database of CPAN sites. If that is OK for you, +please answer 'y', but if you want me to get a new database now, +please answer 'n' to the following question. + +Shall I use the local database in $mby?}; + my $ans = prompt($prompt,"y"); + $overwrite_local = 1 unless $ans =~ /^y/i; + } + while ($mby) { + if ($overwrite_local) { + print qq{Trying to overwrite $mby +}; + $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 }; $mby = CPAN::FTP->localize($m,$mby,3); - } elsif (-M $mby > 30 ) { - print qq{Your $mby is older than 30 days, + } elsif (-M $mby > 60 && $loopcount == 0) { + print qq{Your $mby is older than 60 days, I\'m trying to fetch one }; $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 @@ -380,6 +520,7 @@ sub conf_sites { } } read_mirrored_by($mby); + bring_your_own(); } sub find_exe { @@ -387,7 +528,7 @@ sub find_exe { my($dir); #warn "in find_exe exe[$exe] path[@$path]"; for $dir (@$path) { - my $abs = MM->catfile($dir,$exe); + my $abs = File::Spec->catfile($dir,$exe); if (($abs = MM->maybe_command($abs))) { return $abs; } @@ -398,30 +539,55 @@ sub picklist { my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_; $default ||= ''; - my ($item, $i); - for $item (@$items) { - printf "(%d) %s\n", ++$i, $item; - } + my $pos = 0; my @nums; while (1) { - my $num = prompt($prompt,$default); - @nums = split (' ', $num); - (warn "invalid items entered, try again\n"), next - if grep (/\D/ || $_ < 1 || $_ > $i, @nums); - if ($require_nonempty) { - (warn "$empty_warning\n"), next - unless @nums; - } - last; + + # display, at most, 15 items at a time + my $limit = $#{ $items } - $pos; + $limit = 15 if $limit > 15; + + # show the next $limit items, get the new position + $pos = display_some($items, $limit, $pos); + $pos = 0 if $pos >= @$items; + + my $num = prompt($prompt,$default); + + @nums = split (' ', $num); + my $i = scalar @$items; + (warn "invalid items entered, try again\n"), next + if grep (/\D/ || $_ < 1 || $_ > $i, @nums); + if ($require_nonempty) { + (warn "$empty_warning\n"); + } + print "\n"; + + # a blank line continues... + next unless @nums; + last; } - print "\n"; for (@nums) { $_-- } @{$items}[@nums]; } +sub display_some { + my ($items, $limit, $pos) = @_; + $pos ||= 0; + + my @displayable = @$items[$pos .. ($pos + $limit)]; + for my $item (@displayable) { + printf "(%d) %s\n", ++$pos, $item; + } + printf("%d more items, hit SPACE RETURN to show them\n", + (@$items - $pos) + ) + if $pos < @$items; + return $pos; +} + sub read_mirrored_by { - my($local) = @_; + my $local = shift or return; 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: $!"; @@ -500,7 +666,8 @@ http: -- that host a CPAN mirror. } } push (@urls, map ("$_ (previous pick)", @previous_urls)); - my $prompt = "Select as many URLs as you like"; + my $prompt = "Select as many URLs as you like (by number), +put them on one line, separated by blanks, e.g. '1 4 5'"; if (@previous_urls) { $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) .. (scalar @urls)); @@ -509,25 +676,37 @@ http: -- that host a CPAN mirror. @urls = picklist (\@urls, $prompt, $default); foreach (@urls) { s/ \(.*\)//; } - %seen = map (($_ => 1), @urls); + push @{$CPAN::Config->{urllist}}, @urls; +} +sub bring_your_own { + my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}}); + my($ans,@urls); do { - $ans = prompt ("Enter another URL or RETURN to quit:", ""); + my $prompt = "Enter another URL or RETURN to quit:"; + unless (%seen) { + $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from. + +Please enter your CPAN site:}; + } + $ans = prompt ($prompt, ""); if ($ans) { - $ans =~ s|/?$|/|; # has to end with one slash + $ans =~ s|/?\z|/|; # has to end with one slash $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file: if ($ans =~ /^\w+:\/./) { - push @urls, $ans - unless $seen{$ans}; - } - else { - print qq{"$ans" doesn\'t look like an URL at first sight. -I\'ll ignore it for now. You can add it to $INC{'CPAN/MyConfig.pm'} -later if you\'re sure it\'s right.\n}; + push @urls, $ans unless $seen{$ans}++; + } else { + printf(qq{"%s" doesn\'t look like an URL at first sight. +I\'ll ignore it for now. +You can add it to your %s +later if you\'re sure it\'s right.\n}, + $ans, + $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file", + ); } } - } while $ans; + } while $ans || !%seen; push @{$CPAN::Config->{urllist}}, @urls; # xxx delete or comment these out when you're happy that it works @@ -535,4 +714,28 @@ later if you\'re sure it\'s right.\n}; map { print " $_\n" } @{$CPAN::Config->{urllist}}; } + +sub _strip_spaces { + $_[0] =~ s/^\s+//; # no leading spaces + $_[0] =~ s/\s+\z//; # no trailing spaces +} + + +sub prompt ($;$) { + my $ans = _real_prompt(@_); + + _strip_spaces($ans); + + return $ans; +} + + +sub prompt_no_strip ($;$) { + return _real_prompt(@_); +} + + +*_real_prompt = \*ExtUtils::MakeMaker::prompt; + + 1;