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