lib/CPAN/FirstTime.pm

   1 package CPAN::Mirrored::By;
   2
   3 sub new {
   4     my($self,@arg) = @_;
   5     bless [@arg], $self;
   6 }
   7 sub con { shift->[0] }
   8 sub cou { shift->[1] }
   9 sub url { shift->[2] }
  10
  11 package CPAN::FirstTime;
  12
  13 use strict;
  14 use ExtUtils::MakeMaker qw(prompt);
  15 require File::Path;
  16 use vars qw($VERSION);
  17 $VERSION = "1.00";
  18
  19 =head1 NAME
  20
  21 CPAN::FirstTime - Utility for CPAN::Config file Initialization
  22
  23 =head1 SYNOPSIS
  24
  25 CPAN::FirstTime::init()
  26
  27 =head1 DESCRIPTION
  28
  29 The init routine asks a few questions and writes a CPAN::Config
  30 file. Nothing special.
  31
  32 =cut
  33
  34
  35 sub init {
  36     my($configpm) = @_;
  37     use Config;
  38     require CPAN::Nox;
  39     eval {require CPAN::Config;};
  40     $CPAN::Config ||= {};
  41
  42     my($ans,$default,$local,$cont,$url,$expected_size);
  43
  44     print qq{
  45
  46 The CPAN module needs a directory of its own to cache important
  47 index files and maybe keep a temporary mirror of CPAN files. This may
  48 be a site-wide directory or a personal directory.
  49 };
  50
  51     my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
  52     if (-d $cpan_home) {
  53         print qq{
  54
  55 I see you already have a  directory
  56     $cpan_home
  57 Shall we use it as the general CPAN build and cache directory?
  58
  59 };
  60     } else {
  61         print qq{
  62
  63 First of all, I\'d like to create this directory. Where?
  64
  65 };
  66     }
  67
  68     $default = $cpan_home;
  69     until (-d ($ans = prompt("CPAN build and cache directory?",$default)) && -w _) {
  70         print "Couldn't find directory $ans
  71   or directory is not writable. Please retry.\n";
  72     }
  73     File::Path::mkpath($ans); # dies if it can't
  74     $CPAN::Config->{cpan_home} = $ans;
  75
  76     print qq{
  77
  78 If you want, I can keep the source files after a build in the cpan
  79 home directory. If you choose so then future builds will take the
  80 files from there. If you don\'t want to keep them, answer 0 to the
  81 next question.
  82
  83 };
  84
  85     $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
  86     $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
  87
  88     print qq{
  89
  90 How big should the disk cache be for keeping the build directories
  91 with all the intermediate files?
  92
  93 };
  94
  95     $default = $CPAN::Config->{build_cache} || 10;
  96     $ans = prompt("Cache size for build directory (in MB)?", $default);
  97     $CPAN::Config->{build_cache} = $ans;
  98
  99     # XXX This the time when we refetch the index files (in days)
 100     $CPAN::Config->{'index_expire'} = 1;
 101
 102     print qq{
 103
 104 The CPAN module will need a few external programs to work
 105 properly. Please correct me, if I guess the wrong path for a program.
 106
 107 };
 108
 109     my(@path) = split($Config{path_sep},$ENV{PATH});
 110     my $prog;
 111     for $prog (qw/gzip tar unzip make lynx ftp/){
 112         my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog;
 113         $ans = prompt("Where is your $prog program?",$path) || $path;
 114         $CPAN::Config->{$prog} = $ans;
 115     }
 116     my $path = $CPAN::Config->{'pager'} ||
 117         $ENV{PAGER} || find_exe("less",[@path]) ||
 118             find_exe("more",[@path]) || "more";
 119     $ans = prompt("What is your favorite pager program?",$path) || $path;
 120     $CPAN::Config->{'pager'} = $ans;
 121     print qq{
 122
 123 Every Makefile.PL is run by perl in a seperate process. Likewise we
 124 run \'make\' and \'make install\' in processes. If you have any parameters
 125 \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
 126 the calls, please specify them here.
 127
 128 };
 129
 130     $default = $CPAN::Config->{makepl_arg} || "";
 131     $CPAN::Config->{makepl_arg} =
 132         prompt("Parameters for the 'perl Makefile.PL' command?",$default);
 133     $default = $CPAN::Config->{make_arg} || "";
 134     $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
 135
 136     $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
 137     $CPAN::Config->{make_install_arg} =
 138         prompt("Parameters for the 'make install' command?",$default);
 139
 140     print qq{
 141
 142 Sometimes you may wish to leave the processes run by CPAN alone
 143 without caring about them. As sometimes the Makefile.PL contains
 144 question you\'re expected to answer, you can set a timer that will
 145 kill a 'perl Makefile.PL' process after the specified time in seconds.
 146
 147 If you set this value to 0, these processes will wait forever.
 148
 149 };
 150
 151     $default = $CPAN::Config->{inactivity_timeout} || 0;
 152     $CPAN::Config->{inactivity_timeout} =
 153         prompt("Timout for inacivity during Makefile.PL?",$default);
 154
 155     $default = $CPAN::Config->{makepl_arg} || "";
 156
 157     $local = 'MIRRORED.BY';
 158     if (@{$CPAN::Config->{urllist}||[]}) {
 159         print qq{
 160 I found a list of URLs in CPAN::Config and will use this.
 161 You can change it later with the 'o conf' command.
 162
 163 }
 164     } elsif (-f $local) { # if they really have a wrong MIRRORED.BY in
 165                           # the current directory, we can't help
 166         read_mirrored_by($local);
 167     } else {
 168         $CPAN::Config->{urllist} ||= [];
 169         while (! @{$CPAN::Config->{urllist}}) {
 170             print qq{
 171 We need to know the URL of your favorite CPAN site.
 172 Please enter it here: };
 173             chop($_ = <>);
 174             s/\s//g;
 175             push @{$CPAN::Config->{urllist}}, $_ if $_;
 176         }
 177     }
 178
 179     # We don't ask that now, it will be noticed in time....
 180     $CPAN::Config->{'inhibit_startup_message'} = 0;
 181
 182     print "\n\n";
 183     CPAN::Config->commit($configpm);
 184 }
 185
 186 sub find_exe {
 187     my($exe,$path) = @_;
 188     my($dir,$MY);
 189     $MY = {};
 190     bless $MY, 'MY';
 191     for $dir (@$path) {
 192         my $abs = $MY->catfile($dir,$exe);
 193         if ($MY->maybe_command($abs)) {
 194             return $abs;
 195         }
 196     }
 197 }
 198
 199 sub read_mirrored_by {
 200     my($local) = @_;
 201     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
 202     open FH, $local or die "Couldn't open $local: $!";
 203     while (<FH>) {
 204         ($host) = /^([\w\.\-]+)/ unless defined $host;
 205         next unless defined $host;
 206         next unless /\s+dst_(dst|location)/;
 207         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
 208             ($continent, $country) = @location[-1,-2];
 209         $continent =~ s/\s\(.*//;
 210         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
 211         next unless $host && $dst && $continent && $country;
 212         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
 213         undef $host;
 214         $dst=$continent=$country="";
 215     }
 216     $CPAN::Config->{urllist} ||= [];
 217     if ($expected_size = @{$CPAN::Config->{urllist}}) {
 218         for $url (@{$CPAN::Config->{urllist}}) {
 219             # sanity check, scheme+colon, not "q" there:
 220             next unless $url =~ /^\w+:\/./;
 221             $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
 222         }
 223         $CPAN::Config->{urllist} = [];
 224     } else {
 225         $expected_size = 6;
 226     }
 227
 228     print qq{
 229
 230 Now we need to know, where your favorite CPAN sites are located. Push
 231 a few sites onto the array (just in case the first on the array won\'t
 232 work). If you are mirroring CPAN to your local workstation, specify a
 233 file: URL.
 234
 235 You can enter the number in front of the URL on the next screen, a
 236 file:, ftp: or http: URL, or "q" to finish selecting.
 237
 238 };
 239
 240     $ans = prompt("Press RETURN to continue");
 241     my $other;
 242     $ans = $other = "";
 243     my(%seen);
 244
 245     while () {
 246         my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
 247         my(@valid,$previous_best);
 248         open FH, $pipe;
 249         {
 250             my($cont,$country,$url,$item);
 251             my(@cont) = sort keys %all;
 252             for $cont (@cont) {
 253                 print FH "    $cont\n";
 254                 for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
 255                     for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
 256                         my $t = sprintf(
 257                                         "      %-18s (%2d) %s\n",
 258                                         $country,
 259                                         ++$item,
 260                                         $url
 261                                        );
 262                         if ($cont =~ /^\[/) {
 263                             $previous_best ||= $item;
 264                         }
 265                         push @valid, $all{$cont}{$country}{$url};
 266                         print FH $t;
 267                     }
 268                 }
 269             }
 270         }
 271         close FH;
 272         $previous_best ||= 1;
 273         $default =
 274             @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
 275         $ans = prompt(
 276                       "\nSelect an$other ftp or file URL or a number (q to finish)",
 277                       $default
 278                      );
 279         my $sel;
 280         if ($ans =~ /^\d/) {
 281             my $this = $valid[$ans-1];
 282             my($con,$cou,$url) = ($this->con,$this->cou,$this->url);
 283             push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
 284             delete $all{$con}{$cou}{$url};
 285             #       print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
 286         } elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
 287             last;
 288         } else {
 289             $ans =~ s|/?$|/|; # has to end with one slash
 290             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
 291             if ($ans =~ /^\w+:\/./) {
 292                 push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
 293             } else {
 294                 print qq{"$ans" doesn\'t look like an URL at first sight.
 295 I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
 296 later and report a bug in my Makefile.PL to me (andreas koenig).
 297 Thanks.\n};
 298             }
 299         }
 300         $other ||= "other";
 301     }
 302 }
 303
 304 1;