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