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.30 $, 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     require CPAN::Nox;
  41     eval {require CPAN::Config;};
  42     $CPAN::Config ||= {};
  43     local($/) = "\n";
  44     local($\) = "";
  45     local($|) = 1;
  46
  47     my($ans,$default,$local,$cont,$url,$expected_size);
  48
  49     #
  50     # Files, directories
  51     #
  52
  53     print qq[
  54
  55 CPAN is the world-wide archive of perl resources. It consists of about
  56 100 sites that all replicate the same contents all around the globe.
  57 Many countries have at least one CPAN site already. The resources
  58 found on CPAN are easily accessible with the CPAN.pm module. If you
  59 want to use CPAN.pm, you have to configure it properly.
  60
  61 If you do not want to enter a dialog now, you can answer 'no' to this
  62 question and I\'ll try to autoconfigure. (Note: you can revisit this
  63 dialog anytime later by typing 'o conf init' at the cpan prompt.)
  64
  65 ];
  66
  67     my $manual_conf =
  68         ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
  69                                     "yes");
  70     my $fastread;
  71     {
  72       local $^W;
  73       if ($manual_conf =~ /^\s*y/i) {
  74         $fastread = 0;
  75         *prompt = \&ExtUtils::MakeMaker::prompt;
  76       } else {
  77         $fastread = 1;
  78         *prompt = sub {
  79           my($q,$a) = @_;
  80           my($ret) = defined $a ? $a : "";
  81           printf qq{%s [%s]\n\n}, $q, $ret;
  82           $ret;
  83         };
  84       }
  85     }
  86     print qq{
  87
  88 The following questions are intended to help you with the
  89 configuration. The CPAN module needs a directory of its own to cache
  90 important index files and maybe keep a temporary mirror of CPAN files.
  91 This may be a site-wide directory or a personal directory.
  92
  93 };
  94
  95     my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
  96     if (-d $cpan_home) {
  97         print qq{
  98
  99 I see you already have a  directory
 100     $cpan_home
 101 Shall we use it as the general CPAN build and cache directory?
 102
 103 };
 104     } else {
 105         print qq{
 106
 107 First of all, I\'d like to create this directory. Where?
 108
 109 };
 110     }
 111
 112     $default = $cpan_home;
 113     while ($ans = prompt("CPAN build and cache directory?",$default)) {
 114         File::Path::mkpath($ans); # dies if it can't
 115         if (-d $ans && -w _) {
 116             last;
 117         } else {
 118             warn "Couldn't find directory $ans
 119   or directory is not writable. Please retry.\n";
 120         }
 121     }
 122     $CPAN::Config->{cpan_home} = $ans;
 123
 124     print qq{
 125
 126 If you want, I can keep the source files after a build in the cpan
 127 home directory. If you choose so then future builds will take the
 128 files from there. If you don\'t want to keep them, answer 0 to the
 129 next question.
 130
 131 };
 132
 133     $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
 134     $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
 135
 136     #
 137     # Cache size, Index expire
 138     #
 139
 140     print qq{
 141
 142 How big should the disk cache be for keeping the build directories
 143 with all the intermediate files?
 144
 145 };
 146
 147     $default = $CPAN::Config->{build_cache} || 10;
 148     $ans = prompt("Cache size for build directory (in MB)?", $default);
 149     $CPAN::Config->{build_cache} = $ans;
 150
 151     # XXX This the time when we refetch the index files (in days)
 152     $CPAN::Config->{'index_expire'} = 1;
 153
 154     #
 155     # External programs
 156     #
 157
 158     print qq{
 159
 160 The CPAN module will need a few external programs to work
 161 properly. Please correct me, if I guess the wrong path for a program.
 162 Don\'t panic if you do not have some of them, just press ENTER for
 163 those.
 164
 165 };
 166
 167     my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
 168     my $progname;
 169     for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){
 170       my $progcall = $progname;
 171       # we don't need ncftp if we have ncftpget
 172       next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
 173       my $path = $CPAN::Config->{$progname}
 174           || $Config::Config{$progname}
 175               || "";
 176       if (MM->file_name_is_absolute($path)) {
 177         # testing existence is not good enough, some have these exe
 178         # extensions
 179
 180         # warn "Warning: configured $path does not exist\n" unless -e $path;
 181         # $path = "";
 182       } else {
 183         $path = '';
 184       }
 185       unless ($path) {
 186         # e.g. make -> nmake
 187         $progcall = $Config::Config{$progname} if $Config::Config{$progname};
 188       }
 189
 190       $path ||= find_exe($progcall,[@path]);
 191       warn "Warning: $progcall not found in PATH\n" unless
 192           $path; # not -e $path, because find_exe already checked that
 193       $ans = prompt("Where is your $progname program?",$path) || $path;
 194       $CPAN::Config->{$progname} = $ans;
 195     }
 196     my $path = $CPAN::Config->{'pager'} ||
 197         $ENV{PAGER} || find_exe("less",[@path]) ||
 198             find_exe("more",[@path]) || "more";
 199     $ans = prompt("What is your favorite pager program?",$path);
 200     $CPAN::Config->{'pager'} = $ans;
 201     $path = $CPAN::Config->{'shell'};
 202     if (MM->file_name_is_absolute($path)) {
 203         warn "Warning: configured $path does not exist\n" unless -e $path;
 204         $path = "";
 205     }
 206     $path ||= $ENV{SHELL};
 207     $path =~ s,\\,/,g if $^O eq 'os2';  # Cosmetic only
 208     $ans = prompt("What is your favorite shell?",$path);
 209     $CPAN::Config->{'shell'} = $ans;
 210
 211     #
 212     # Arguments to make etc.
 213     #
 214
 215     print qq{
 216
 217 Every Makefile.PL is run by perl in a separate process. Likewise we
 218 run \'make\' and \'make install\' in processes. If you have any parameters
 219 \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
 220 the calls, please specify them here.
 221
 222 If you don\'t understand this question, just press ENTER.
 223
 224 };
 225
 226     $default = $CPAN::Config->{makepl_arg} || "";
 227     $CPAN::Config->{makepl_arg} =
 228         prompt("Parameters for the 'perl Makefile.PL' command?",$default);
 229     $default = $CPAN::Config->{make_arg} || "";
 230     $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
 231
 232     $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
 233     $CPAN::Config->{make_install_arg} =
 234         prompt("Parameters for the 'make install' command?",$default);
 235
 236     #
 237     # Alarm period
 238     #
 239
 240     print qq{
 241
 242 Sometimes you may wish to leave the processes run by CPAN alone
 243 without caring about them. As sometimes the Makefile.PL contains
 244 question you\'re expected to answer, you can set a timer that will
 245 kill a 'perl Makefile.PL' process after the specified time in seconds.
 246
 247 If you set this value to 0, these processes will wait forever. This is
 248 the default and recommended setting.
 249
 250 };
 251
 252     $default = $CPAN::Config->{inactivity_timeout} || 0;
 253     $CPAN::Config->{inactivity_timeout} =
 254         prompt("Timeout for inactivity during Makefile.PL?",$default);
 255
 256     # Proxies
 257
 258     print qq{
 259
 260 If you\'re accessing the net via proxies, you can specify them in the
 261 CPAN configuration or via environment variables. The variable in
 262 the \$CPAN::Config takes precedence.
 263
 264 };
 265
 266     for (qw/ftp_proxy http_proxy no_proxy/) {
 267         $default = $CPAN::Config->{$_} || $ENV{$_};
 268         $CPAN::Config->{$_} = prompt("Your $_?",$default);
 269     }
 270
 271     #
 272     # MIRRORED.BY
 273     #
 274
 275     conf_sites() unless $fastread;
 276
 277     unless (@{$CPAN::Config->{'wait_list'}||[]}) {
 278         print qq{
 279
 280 WAIT support is available as a Plugin. You need the CPAN::WAIT module
 281 to actually use it.  But we need to know your favorite WAIT server. If
 282 you don\'t know a WAIT server near you, just press ENTER.
 283
 284 };
 285         $default = "wait://ls6.informatik.uni-dortmund.de:1404";
 286         $ans = prompt("Your favorite WAIT server?\n  ",$default);
 287         push @{$CPAN::Config->{'wait_list'}}, $ans;
 288     }
 289
 290     # We don't ask that now, it will be noticed in time, won't it?
 291     $CPAN::Config->{'inhibit_startup_message'} = 0;
 292     $CPAN::Config->{'getcwd'} = 'cwd';
 293
 294     print "\n\n";
 295     CPAN::Config->commit($configpm);
 296 }
 297
 298 sub conf_sites {
 299   my $m = 'MIRRORED.BY';
 300   my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m);
 301   File::Path::mkpath(File::Basename::dirname($mby));
 302   if (-f $mby && -f $m && -M $m < -M $mby) {
 303     require File::Copy;
 304     File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
 305   }
 306   if ( ! -f $mby ){
 307     print qq{You have no $mby
 308   I\'m trying to fetch one
 309 };
 310     $mby = CPAN::FTP->localize($m,$mby,3);
 311   } elsif (-M $mby > 30 ) {
 312     print qq{Your $mby is older than 30 days,
 313   I\'m trying to fetch one
 314 };
 315     $mby = CPAN::FTP->localize($m,$mby,3);
 316   }
 317   read_mirrored_by($mby);
 318 }
 319
 320 sub find_exe {
 321     my($exe,$path) = @_;
 322     my($dir);
 323     #warn "in find_exe exe[$exe] path[@$path]";
 324     for $dir (@$path) {
 325         my $abs = MM->catfile($dir,$exe);
 326         if (($abs = MM->maybe_command($abs))) {
 327             return $abs;
 328         }
 329     }
 330 }
 331
 332 sub read_mirrored_by {
 333     my($local) = @_;
 334     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
 335     my $fh = FileHandle->new;
 336     $fh->open($local) or die "Couldn't open $local: $!";
 337     while (<$fh>) {
 338         ($host) = /^([\w\.\-]+)/ unless defined $host;
 339         next unless defined $host;
 340         next unless /\s+dst_(dst|location)/;
 341         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
 342             ($continent, $country) = @location[-1,-2];
 343         $continent =~ s/\s\(.*//;
 344         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
 345         next unless $host && $dst && $continent && $country;
 346         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
 347         undef $host;
 348         $dst=$continent=$country="";
 349     }
 350     $fh->close;
 351     $CPAN::Config->{urllist} ||= [];
 352     if ($expected_size = @{$CPAN::Config->{urllist}}) {
 353         for $url (@{$CPAN::Config->{urllist}}) {
 354             # sanity check, scheme+colon, not "q" there:
 355             next unless $url =~ /^\w+:\/./;
 356             $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
 357         }
 358         $CPAN::Config->{urllist} = [];
 359     } else {
 360         $expected_size = 6;
 361     }
 362
 363     print qq{
 364
 365 Now we need to know, where your favorite CPAN sites are located. Push
 366 a few sites onto the array (just in case the first on the array won\'t
 367 work). If you are mirroring CPAN to your local workstation, specify a
 368 file: URL.
 369
 370 You can enter the number in front of the URL on the next screen, a
 371 file:, ftp: or http: URL, or "q" to finish selecting.
 372
 373 };
 374
 375     $ans = prompt("Press RETURN to continue");
 376     my $other;
 377     $ans = $other = "";
 378     my(%seen);
 379
 380     my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
 381     while () {
 382         my(@valid,$previous_best);
 383         my $fh = FileHandle->new;
 384         $fh->open($pipe);
 385         {
 386             my($cont,$country,$url,$item);
 387             my(@cont) = sort keys %all;
 388             for $cont (@cont) {
 389                 $fh->print("  $cont\n");
 390                 for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
 391                     for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
 392                         my $t = sprintf(
 393                                         "    %-16s (%2d) %s\n",
 394                                         $country,
 395                                         ++$item,
 396                                         $url
 397                                        );
 398                         if ($cont =~ /^\[/) {
 399                             $previous_best ||= $item;
 400                         }
 401                         push @valid, $all{$cont}{$country}{$url};
 402                         $fh->print($t);
 403                     }
 404                 }
 405             }
 406         }
 407         $fh->close;
 408         $previous_best ||= "";
 409         $default =
 410             @{$CPAN::Config->{urllist}} >=
 411                 $expected_size ? "q" : $previous_best;
 412         $ans = prompt(
 413                       "\nSelect an$other ftp or file URL or a number (q to finish)",
 414                       $default
 415                      );
 416         my $sel;
 417         if ($ans =~ /^\d/) {
 418             my $this = $valid[$ans-1];
 419             my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
 420             push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
 421             delete $all{$con}{$cou}{$url};
 422             #       print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
 423         } elsif ($ans =~ /^q/i) {
 424             last;
 425         } else {
 426             $ans =~ s|/?$|/|; # has to end with one slash
 427             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
 428             if ($ans =~ /^\w+:\/./) {
 429                 push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
 430             } else {
 431                 print qq{"$ans" doesn\'t look like an URL at first sight.
 432 I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
 433 later and report a bug in my Makefile.PL to me (andreas koenig).
 434 Thanks.\n};
 435             }
 436         }
 437         $other ||= "other";
 438     }
 439 }
 440
 441 1;