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.29 $, 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 ncftp ftp/){
 170       my $progcall = $progname;
 171         my $path = $CPAN::Config->{$progname}
 172                 || $Config::Config{$progname}
 173                 || "";
 174         if (MM->file_name_is_absolute($path)) {
 175           # testing existence is not good enough, some have these exe
 176           # extensions
 177
 178           # warn "Warning: configured $path does not exist\n" unless -e $path;
 179           # $path = "";
 180         } else {
 181             $path = '';
 182         }
 183         unless ($path) {
 184           # e.g. make -> nmake
 185           $progcall = $Config::Config{$progname} if $Config::Config{$progname};
 186         }
 187
 188         $path ||= find_exe($progcall,[@path]);
 189         warn "Warning: $progcall not found in PATH\n" unless
 190             $path; # not -e $path, because find_exe already checked that
 191         $ans = prompt("Where is your $progname program?",$path) || $path;
 192         $CPAN::Config->{$progname} = $ans;
 193     }
 194     my $path = $CPAN::Config->{'pager'} ||
 195         $ENV{PAGER} || find_exe("less",[@path]) ||
 196             find_exe("more",[@path]) || "more";
 197     $ans = prompt("What is your favorite pager program?",$path);
 198     $CPAN::Config->{'pager'} = $ans;
 199     $path = $CPAN::Config->{'shell'};
 200     if (MM->file_name_is_absolute($path)) {
 201         warn "Warning: configured $path does not exist\n" unless -e $path;
 202         $path = "";
 203     }
 204     $path ||= $ENV{SHELL};
 205     $path =~ s,\\,/,g if $^O eq 'os2';  # Cosmetic only
 206     $ans = prompt("What is your favorite shell?",$path);
 207     $CPAN::Config->{'shell'} = $ans;
 208
 209     #
 210     # Arguments to make etc.
 211     #
 212
 213     print qq{
 214
 215 Every Makefile.PL is run by perl in a separate process. Likewise we
 216 run \'make\' and \'make install\' in processes. If you have any parameters
 217 \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
 218 the calls, please specify them here.
 219
 220 If you don\'t understand this question, just press ENTER.
 221
 222 };
 223
 224     $default = $CPAN::Config->{makepl_arg} || "";
 225     $CPAN::Config->{makepl_arg} =
 226         prompt("Parameters for the 'perl Makefile.PL' command?",$default);
 227     $default = $CPAN::Config->{make_arg} || "";
 228     $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
 229
 230     $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
 231     $CPAN::Config->{make_install_arg} =
 232         prompt("Parameters for the 'make install' command?",$default);
 233
 234     #
 235     # Alarm period
 236     #
 237
 238     print qq{
 239
 240 Sometimes you may wish to leave the processes run by CPAN alone
 241 without caring about them. As sometimes the Makefile.PL contains
 242 question you\'re expected to answer, you can set a timer that will
 243 kill a 'perl Makefile.PL' process after the specified time in seconds.
 244
 245 If you set this value to 0, these processes will wait forever. This is
 246 the default and recommended setting.
 247
 248 };
 249
 250     $default = $CPAN::Config->{inactivity_timeout} || 0;
 251     $CPAN::Config->{inactivity_timeout} =
 252         prompt("Timeout for inactivity during Makefile.PL?",$default);
 253
 254     # Proxies
 255
 256     print qq{
 257
 258 If you\'re accessing the net via proxies, you can specify them in the
 259 CPAN configuration or via environment variables. The variable in
 260 the \$CPAN::Config takes precedence.
 261
 262 };
 263
 264     for (qw/ftp_proxy http_proxy no_proxy/) {
 265         $default = $CPAN::Config->{$_} || $ENV{$_};
 266         $CPAN::Config->{$_} = prompt("Your $_?",$default);
 267     }
 268
 269     #
 270     # MIRRORED.BY
 271     #
 272
 273     conf_sites() unless $fastread;
 274
 275     unless (@{$CPAN::Config->{'wait_list'}||[]}) {
 276         print qq{
 277
 278 WAIT support is available as a Plugin. You need the CPAN::WAIT module
 279 to actually use it.  But we need to know your favorite WAIT server. If
 280 you don\'t know a WAIT server near you, just press ENTER.
 281
 282 };
 283         $default = "wait://ls6.informatik.uni-dortmund.de:1404";
 284         $ans = prompt("Your favorite WAIT server?\n  ",$default);
 285         push @{$CPAN::Config->{'wait_list'}}, $ans;
 286     }
 287
 288     # We don't ask that now, it will be noticed in time, won't it?
 289     $CPAN::Config->{'inhibit_startup_message'} = 0;
 290     $CPAN::Config->{'getcwd'} = 'cwd';
 291
 292     print "\n\n";
 293     CPAN::Config->commit($configpm);
 294 }
 295
 296 sub conf_sites {
 297   my $m = 'MIRRORED.BY';
 298   my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m);
 299   File::Path::mkpath(File::Basename::dirname($mby));
 300   if (-f $mby && -f $m && -M $m < -M $mby) {
 301     require File::Copy;
 302     File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
 303   }
 304   if ( ! -f $mby ){
 305     print qq{You have no $mby
 306   I\'m trying to fetch one
 307 };
 308     $mby = CPAN::FTP->localize($m,$mby,3);
 309   } elsif (-M $mby > 30 ) {
 310     print qq{Your $mby is older than 30 days,
 311   I\'m trying to fetch one
 312 };
 313     $mby = CPAN::FTP->localize($m,$mby,3);
 314   }
 315   read_mirrored_by($mby);
 316 }
 317
 318 sub find_exe {
 319     my($exe,$path) = @_;
 320     my($dir);
 321     #warn "in find_exe exe[$exe] path[@$path]";
 322     for $dir (@$path) {
 323         my $abs = MM->catfile($dir,$exe);
 324         if (($abs = MM->maybe_command($abs))) {
 325             return $abs;
 326         }
 327     }
 328 }
 329
 330 sub read_mirrored_by {
 331     my($local) = @_;
 332     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
 333     my $fh = FileHandle->new;
 334     $fh->open($local) or die "Couldn't open $local: $!";
 335     while (<$fh>) {
 336         ($host) = /^([\w\.\-]+)/ unless defined $host;
 337         next unless defined $host;
 338         next unless /\s+dst_(dst|location)/;
 339         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
 340             ($continent, $country) = @location[-1,-2];
 341         $continent =~ s/\s\(.*//;
 342         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
 343         next unless $host && $dst && $continent && $country;
 344         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
 345         undef $host;
 346         $dst=$continent=$country="";
 347     }
 348     $fh->close;
 349     $CPAN::Config->{urllist} ||= [];
 350     if ($expected_size = @{$CPAN::Config->{urllist}}) {
 351         for $url (@{$CPAN::Config->{urllist}}) {
 352             # sanity check, scheme+colon, not "q" there:
 353             next unless $url =~ /^\w+:\/./;
 354             $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
 355         }
 356         $CPAN::Config->{urllist} = [];
 357     } else {
 358         $expected_size = 6;
 359     }
 360
 361     print qq{
 362
 363 Now we need to know, where your favorite CPAN sites are located. Push
 364 a few sites onto the array (just in case the first on the array won\'t
 365 work). If you are mirroring CPAN to your local workstation, specify a
 366 file: URL.
 367
 368 You can enter the number in front of the URL on the next screen, a
 369 file:, ftp: or http: URL, or "q" to finish selecting.
 370
 371 };
 372
 373     $ans = prompt("Press RETURN to continue");
 374     my $other;
 375     $ans = $other = "";
 376     my(%seen);
 377
 378     my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
 379     while () {
 380         my(@valid,$previous_best);
 381         my $fh = FileHandle->new;
 382         $fh->open($pipe);
 383         {
 384             my($cont,$country,$url,$item);
 385             my(@cont) = sort keys %all;
 386             for $cont (@cont) {
 387                 $fh->print("  $cont\n");
 388                 for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
 389                     for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
 390                         my $t = sprintf(
 391                                         "    %-16s (%2d) %s\n",
 392                                         $country,
 393                                         ++$item,
 394                                         $url
 395                                        );
 396                         if ($cont =~ /^\[/) {
 397                             $previous_best ||= $item;
 398                         }
 399                         push @valid, $all{$cont}{$country}{$url};
 400                         $fh->print($t);
 401                     }
 402                 }
 403             }
 404         }
 405         $fh->close;
 406         $previous_best ||= "";
 407         $default =
 408             @{$CPAN::Config->{urllist}} >=
 409                 $expected_size ? "q" : $previous_best;
 410         $ans = prompt(
 411                       "\nSelect an$other ftp or file URL or a number (q to finish)",
 412                       $default
 413                      );
 414         my $sel;
 415         if ($ans =~ /^\d/) {
 416             my $this = $valid[$ans-1];
 417             my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
 418             push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
 419             delete $all{$con}{$cou}{$url};
 420             #       print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
 421         } elsif ($ans =~ /^q/i) {
 422             last;
 423         } else {
 424             $ans =~ s|/?$|/|; # has to end with one slash
 425             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
 426             if ($ans =~ /^\w+:\/./) {
 427                 push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
 428             } else {
 429                 print qq{"$ans" doesn\'t look like an URL at first sight.
 430 I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
 431 later and report a bug in my Makefile.PL to me (andreas koenig).
 432 Thanks.\n};
 433             }
 434         }
 435         $other ||= "other";
 436     }
 437 }
 438
 439 1;