lib/CPAN/FirstTime.pm

   1 package CPAN::Mirrored::By;
   2
   3 sub new {
   4     my($self,@arg) = @_;
   5     bless [@arg], $self;
   6 }
   7 sub continent { shift->[0] }
   8 sub country { shift->[1] }
   9 sub url { shift->[2] }
  10
  11 package CPAN::FirstTime;
  12
  13 use strict;
  14 use ExtUtils::MakeMaker qw(prompt);
  15 use FileHandle ();
  16 use File::Basename ();
  17 use File::Path ();
  18 use vars qw($VERSION);
  19 $VERSION = substr q$Revision: 1.33 $, 10;
  20
  21 =head1 NAME
  22
  23 CPAN::FirstTime - Utility for CPAN::Config file Initialization
  24
  25 =head1 SYNOPSIS
  26
  27 CPAN::FirstTime::init()
  28
  29 =head1 DESCRIPTION
  30
  31 The init routine asks a few questions and writes a CPAN::Config
  32 file. Nothing special.
  33
  34 =cut
  35
  36
  37 sub init {
  38     my($configpm) = @_;
  39     use Config;
  40     unless ($CPAN::VERSION) {
  41         require CPAN::Nox;
  42     }
  43     eval {require CPAN::Config;};
  44     $CPAN::Config ||= {};
  45     local($/) = "\n";
  46     local($\) = "";
  47     local($|) = 1;
  48
  49     my($ans,$default,$local,$cont,$url,$expected_size);
  50
  51     #
  52     # Files, directories
  53     #
  54
  55     print qq[
  56
  57 CPAN is the world-wide archive of perl resources. It consists of about
  58 100 sites that all replicate the same contents all around the globe.
  59 Many countries have at least one CPAN site already. The resources
  60 found on CPAN are easily accessible with the CPAN.pm module. If you
  61 want to use CPAN.pm, you have to configure it properly.
  62
  63 If you do not want to enter a dialog now, you can answer 'no' to this
  64 question and I\'ll try to autoconfigure. (Note: you can revisit this
  65 dialog anytime later by typing 'o conf init' at the cpan prompt.)
  66
  67 ];
  68
  69     my $manual_conf =
  70         ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
  71                                     "yes");
  72     my $fastread;
  73     {
  74       local $^W;
  75       if ($manual_conf =~ /^\s*y/i) {
  76         $fastread = 0;
  77         *prompt = \&ExtUtils::MakeMaker::prompt;
  78       } else {
  79         $fastread = 1;
  80         *prompt = sub {
  81           my($q,$a) = @_;
  82           my($ret) = defined $a ? $a : "";
  83           printf qq{%s [%s]\n\n}, $q, $ret;
  84           $ret;
  85         };
  86       }
  87     }
  88     print qq{
  89
  90 The following questions are intended to help you with the
  91 configuration. The CPAN module needs a directory of its own to cache
  92 important index files and maybe keep a temporary mirror of CPAN files.
  93 This may be a site-wide directory or a personal directory.
  94
  95 };
  96
  97     my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
  98     if (-d $cpan_home) {
  99         print qq{
 100
 101 I see you already have a  directory
 102     $cpan_home
 103 Shall we use it as the general CPAN build and cache directory?
 104
 105 };
 106     } else {
 107         print qq{
 108
 109 First of all, I\'d like to create this directory. Where?
 110
 111 };
 112     }
 113
 114     $default = $cpan_home;
 115     while ($ans = prompt("CPAN build and cache directory?",$default)) {
 116         File::Path::mkpath($ans); # dies if it can't
 117         if (-d $ans && -w _) {
 118             last;
 119         } else {
 120             warn "Couldn't find directory $ans
 121   or directory is not writable. Please retry.\n";
 122         }
 123     }
 124     $CPAN::Config->{cpan_home} = $ans;
 125
 126     print qq{
 127
 128 If you want, I can keep the source files after a build in the cpan
 129 home directory. If you choose so then future builds will take the
 130 files from there. If you don\'t want to keep them, answer 0 to the
 131 next question.
 132
 133 };
 134
 135     $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
 136     $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
 137
 138     #
 139     # Cache size, Index expire
 140     #
 141
 142     print qq{
 143
 144 How big should the disk cache be for keeping the build directories
 145 with all the intermediate files?
 146
 147 };
 148
 149     $default = $CPAN::Config->{build_cache} || 10;
 150     $ans = prompt("Cache size for build directory (in MB)?", $default);
 151     $CPAN::Config->{build_cache} = $ans;
 152
 153     # XXX This the time when we refetch the index files (in days)
 154     $CPAN::Config->{'index_expire'} = 1;
 155
 156     print qq{
 157
 158 By default, each time the CPAN module is started, cache scanning
 159 is performed to keep the cache size in sync. To prevent from this,
 160 disable the cache scanning with 'never'.
 161
 162 };
 163
 164     $default = $CPAN::Config->{scan_cache} || 'atstart';
 165     do {
 166         $ans = prompt("Perform cache scanning (atstart or never)?", $default);
 167     } while ($ans ne 'atstart' && $ans ne 'never');
 168     $CPAN::Config->{scan_cache} = $ans;
 169
 170     #
 171     # prerequisites_policy
 172     # Do we follow PREREQ_PM?
 173     #
 174     print qq{
 175
 176 The CPAN module can detect when a module that which you are trying to
 177 build depends on prerequisites. If this happens, it can build the
 178 prerequisites for you automatically ('follow'), ask you for
 179 confirmation ('ask'), or just ignore them ('ignore'). Please set your
 180 policy to one of the three values.
 181
 182 };
 183
 184     $default = $CPAN::Config->{prerequisites_policy} || 'follow';
 185     do {
 186         $ans = prompt("Perform cache scanning (follow, ask or ignore)?", $default);
 187     } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
 188     $CPAN::Config->{prerequisites_policy} = $ans;
 189
 190     #
 191     # External programs
 192     #
 193
 194     print qq{
 195
 196 The CPAN module will need a few external programs to work
 197 properly. Please correct me, if I guess the wrong path for a program.
 198 Don\'t panic if you do not have some of them, just press ENTER for
 199 those.
 200
 201 };
 202
 203     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
 204     my $progname;
 205     for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){
 206       my $progcall = $progname;
 207       # we don't need ncftp if we have ncftpget
 208       next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
 209       my $path = $CPAN::Config->{$progname}
 210           || $Config::Config{$progname}
 211               || "";
 212       if (MM->file_name_is_absolute($path)) {
 213         # testing existence is not good enough, some have these exe
 214         # extensions
 215
 216         # warn "Warning: configured $path does not exist\n" unless -e $path;
 217         # $path = "";
 218       } else {
 219         $path = '';
 220       }
 221       unless ($path) {
 222         # e.g. make -> nmake
 223         $progcall = $Config::Config{$progname} if $Config::Config{$progname};
 224       }
 225
 226       $path ||= find_exe($progcall,[@path]);
 227       warn "Warning: $progcall not found in PATH\n" unless
 228           $path; # not -e $path, because find_exe already checked that
 229       $ans = prompt("Where is your $progname program?",$path) || $path;
 230       $CPAN::Config->{$progname} = $ans;
 231     }
 232     my $path = $CPAN::Config->{'pager'} ||
 233         $ENV{PAGER} || find_exe("less",[@path]) ||
 234             find_exe("more",[@path]) || "more";
 235     $ans = prompt("What is your favorite pager program?",$path);
 236     $CPAN::Config->{'pager'} = $ans;
 237     $path = $CPAN::Config->{'shell'};
 238     if (MM->file_name_is_absolute($path)) {
 239         warn "Warning: configured $path does not exist\n" unless -e $path;
 240         $path = "";
 241     }
 242     $path ||= $ENV{SHELL};
 243     $path =~ s,\\,/,g if $^O eq 'os2';  # Cosmetic only
 244     $ans = prompt("What is your favorite shell?",$path);
 245     $CPAN::Config->{'shell'} = $ans;
 246
 247     #
 248     # Arguments to make etc.
 249     #
 250
 251     print qq{
 252
 253 Every Makefile.PL is run by perl in a separate process. Likewise we
 254 run \'make\' and \'make install\' in processes. If you have any parameters
 255 \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
 256 the calls, please specify them here.
 257
 258 If you don\'t understand this question, just press ENTER.
 259
 260 };
 261
 262     $default = $CPAN::Config->{makepl_arg} || "";
 263     $CPAN::Config->{makepl_arg} =
 264         prompt("Parameters for the 'perl Makefile.PL' command?",$default);
 265     $default = $CPAN::Config->{make_arg} || "";
 266     $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
 267
 268     $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
 269     $CPAN::Config->{make_install_arg} =
 270         prompt("Parameters for the 'make install' command?",$default);
 271
 272     #
 273     # Alarm period
 274     #
 275
 276     print qq{
 277
 278 Sometimes you may wish to leave the processes run by CPAN alone
 279 without caring about them. As sometimes the Makefile.PL contains
 280 question you\'re expected to answer, you can set a timer that will
 281 kill a 'perl Makefile.PL' process after the specified time in seconds.
 282
 283 If you set this value to 0, these processes will wait forever. This is
 284 the default and recommended setting.
 285
 286 };
 287
 288     $default = $CPAN::Config->{inactivity_timeout} || 0;
 289     $CPAN::Config->{inactivity_timeout} =
 290         prompt("Timeout for inactivity during Makefile.PL?",$default);
 291
 292     # Proxies
 293
 294     print qq{
 295
 296 If you\'re accessing the net via proxies, you can specify them in the
 297 CPAN configuration or via environment variables. The variable in
 298 the \$CPAN::Config takes precedence.
 299
 300 };
 301
 302     for (qw/ftp_proxy http_proxy no_proxy/) {
 303         $default = $CPAN::Config->{$_} || $ENV{$_};
 304         $CPAN::Config->{$_} = prompt("Your $_?",$default);
 305     }
 306
 307     #
 308     # MIRRORED.BY
 309     #
 310
 311     conf_sites() unless $fastread;
 312
 313     unless (@{$CPAN::Config->{'wait_list'}||[]}) {
 314         print qq{
 315
 316 WAIT support is available as a Plugin. You need the CPAN::WAIT module
 317 to actually use it.  But we need to know your favorite WAIT server. If
 318 you don\'t know a WAIT server near you, just press ENTER.
 319
 320 };
 321         $default = "wait://ls6.informatik.uni-dortmund.de:1404";
 322         $ans = prompt("Your favorite WAIT server?\n  ",$default);
 323         push @{$CPAN::Config->{'wait_list'}}, $ans;
 324     }
 325
 326     # We don't ask that now, it will be noticed in time, won't it?
 327     $CPAN::Config->{'inhibit_startup_message'} = 0;
 328     $CPAN::Config->{'getcwd'} = 'cwd';
 329
 330     print "\n\n";
 331     CPAN::Config->commit($configpm);
 332 }
 333
 334 sub conf_sites {
 335   my $m = 'MIRRORED.BY';
 336   my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m);
 337   File::Path::mkpath(File::Basename::dirname($mby));
 338   if (-f $mby && -f $m && -M $m < -M $mby) {
 339     require File::Copy;
 340     File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
 341   }
 342   if ( ! -f $mby ){
 343     print qq{You have no $mby
 344   I\'m trying to fetch one
 345 };
 346     $mby = CPAN::FTP->localize($m,$mby,3);
 347   } elsif (-M $mby > 30 ) {
 348     print qq{Your $mby is older than 30 days,
 349   I\'m trying to fetch one
 350 };
 351     $mby = CPAN::FTP->localize($m,$mby,3);
 352   }
 353   read_mirrored_by($mby);
 354 }
 355
 356 sub find_exe {
 357     my($exe,$path) = @_;
 358     my($dir);
 359     #warn "in find_exe exe[$exe] path[@$path]";
 360     for $dir (@$path) {
 361         my $abs = MM->catfile($dir,$exe);
 362         if (($abs = MM->maybe_command($abs))) {
 363             return $abs;
 364         }
 365     }
 366 }
 367
 368 sub picklist {
 369     my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
 370     $default ||= '';
 371
 372     my ($item, $i);
 373     for $item (@$items) {
 374         printf "(%d) %s\n", ++$i, $item;
 375     }
 376
 377     my @nums;
 378     while (1) {
 379         my $num = prompt($prompt,$default);
 380         @nums = split (' ', $num);
 381         (warn "invalid items entered, try again\n"), next
 382             if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
 383         if ($require_nonempty) {
 384             (warn "$empty_warning\n"), next
 385                 unless @nums;
 386         }
 387         last;
 388     }
 389     print "\n";
 390     for (@nums) { $_-- }
 391     @{$items}[@nums];
 392 }
 393
 394 sub read_mirrored_by {
 395     my($local) = @_;
 396     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
 397     my $fh = FileHandle->new;
 398     $fh->open($local) or die "Couldn't open $local: $!";
 399     while (<$fh>) {
 400         ($host) = /^([\w\.\-]+)/ unless defined $host;
 401         next unless defined $host;
 402         next unless /\s+dst_(dst|location)/;
 403         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
 404             ($continent, $country) = @location[-1,-2];
 405         $continent =~ s/\s\(.*//;
 406         $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
 407         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
 408         next unless $host && $dst && $continent && $country;
 409         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
 410         undef $host;
 411         $dst=$continent=$country="";
 412     }
 413     $fh->close;
 414     $CPAN::Config->{urllist} ||= [];
 415     my(@previous_urls);
 416     if (@previous_urls = @{$CPAN::Config->{urllist}}) {
 417         $CPAN::Config->{urllist} = [];
 418     }
 419
 420     print qq{
 421
 422 Now we need to know where your favorite CPAN sites are located. Push
 423 a few sites onto the array (just in case the first on the array won\'t
 424 work). If you are mirroring CPAN to your local workstation, specify a
 425 file: URL.
 426
 427 First, pick a nearby continent and country (you can pick several of
 428 each, separated by spaces, or none if you just want to keep your
 429 existing selections). Then, you will be presented with a list of URLs
 430 of CPAN mirrors in the countries you selected, along with previously
 431 selected URLs. Select some of those URLs, or just keep the old list.
 432 Finally, you will be prompted for any extra URLs -- file:, ftp:, or
 433 http: -- that host a CPAN mirror.
 434
 435 };
 436
 437     my (@cont, $cont, %cont, @countries, @urls, %seen);
 438     my $no_previous_warn =
 439        "Sorry! since you don't have any existing picks, you must make a\n" .
 440        "geographic selection.";
 441     @cont = picklist([sort keys %all],
 442                      "Select your continent (or several nearby continents)",
 443                      '',
 444                      ! @previous_urls,
 445                      $no_previous_warn);
 446
 447
 448     foreach $cont (@cont) {
 449         my @c = sort keys %{$all{$cont}};
 450         @cont{@c} = map ($cont, 0..$#c);
 451         @c = map ("$_ ($cont)", @c) if @cont > 1;
 452         push (@countries, @c);
 453     }
 454
 455     if (@countries) {
 456         @countries = picklist (\@countries,
 457                                "Select your country (or several nearby countries)",
 458                                '',
 459                                ! @previous_urls,
 460                                $no_previous_warn);
 461         %seen = map (($_ => 1), @previous_urls);
 462         # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
 463         foreach $country (@countries) {
 464             (my $bare_country = $country) =~ s/ \(.*\)//;
 465             my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
 466             @u = grep (! $seen{$_}, @u);
 467             @u = map ("$_ ($bare_country)", @u)
 468                if @countries > 1;
 469             push (@urls, @u);
 470         }
 471     }
 472     push (@urls, map ("$_ (previous pick)", @previous_urls));
 473     my $prompt = "Select as many URLs as you like";
 474     if (@previous_urls) {
 475        $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
 476                              (scalar @urls));
 477        $prompt .= "\n(or just hit RETURN to keep your previous picks)";
 478     }
 479
 480     @urls = picklist (\@urls, $prompt, $default);
 481     foreach (@urls) { s/ \(.*\)//; }
 482     %seen = map (($_ => 1), @urls);
 483
 484     do {
 485         $ans = prompt ("Enter another URL or RETURN to quit:", "");
 486
 487         if ($ans) {
 488             $ans =~ s|/?$|/|; # has to end with one slash
 489             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
 490             if ($ans =~ /^\w+:\/./) {
 491                push @urls, $ans
 492                   unless $seen{$ans};
 493             }
 494             else {
 495                 print qq{"$ans" doesn\'t look like an URL at first sight.
 496 I\'ll ignore it for now.  You can add it to $INC{'CPAN/MyConfig.pm'}
 497 later if you\'re sure it\'s right.\n};
 498             }
 499         }
 500     } while $ans;
 501
 502     push @{$CPAN::Config->{urllist}}, @urls;
 503     # xxx delete or comment these out when you're happy that it works
 504     print "New set of picks:\n";
 505     map { print "  $_\n" } @{$CPAN::Config->{urllist}};
 506 }
 507
 508 1;