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