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     $ans = prompt("CPAN build and cache directory?",$default);
  70     File::Path::mkpath($ans); # dies if it can't
  71     $CPAN::Config->{cpan_home} = $ans;
  72
  73     print qq{
  74
  75 If you want, I can keep the source files after a build in the cpan
  76 home directory. If you choose so then future builds will take the
  77 files from there. If you don\'t want to keep them, answer 0 to the
  78 next question.
  79
  80 };
  81
  82     $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
  83     $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
  84
  85     print qq{
  86
  87 How big should the disk cache be for keeping the build directories
  88 with all the intermediate files?
  89
  90 };
  91
  92     $default = $CPAN::Config->{build_cache} || 10;
  93     $ans = prompt("Cache size for build directory (in MB)?", $default);
  94     $CPAN::Config->{build_cache} = $ans;
  95
  96     # XXX This the time when we refetch the index files (in days)
  97     $CPAN::Config->{'index_expire'} = 1;
  98
  99     print qq{
 100
 101 The CPAN module will need a few external programs to work
 102 properly. Please correct me, if I guess the wrong path for a program.
 103
 104 };
 105
 106     my(@path) = split($Config{path_sep},$ENV{PATH});
 107     my $prog;
 108     for $prog (qw/gzip tar unzip make/){
 109         my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog;
 110         $ans = prompt("Where is your $prog program?",$path) || $path;
 111         $CPAN::Config->{$prog} = $ans;
 112     }
 113     my $path = $CPAN::Config->{'pager'} ||
 114         $ENV{PAGER} || find_exe("less",[@path]) ||
 115             find_exe("more",[@path]) || "more";
 116     $ans = prompt("What is your favorite pager program?",$path) || $path;
 117     $CPAN::Config->{'pager'} = $ans;
 118     print qq{
 119
 120 Every Makefile.PL is run by perl in a seperate process. Likewise we
 121 run \'make\' and \'make install\' in processes. If you have any parameters
 122 \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
 123 the calls, please specify them here.
 124
 125 };
 126
 127     $default = $CPAN::Config->{makepl_arg} || "";
 128     $CPAN::Config->{makepl_arg} =
 129         prompt("Parameters for the 'perl Makefile.PL' command?",$default);
 130     $default = $CPAN::Config->{make_arg} || "";
 131     $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
 132
 133     $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
 134     $CPAN::Config->{make_install_arg} =
 135         prompt("Parameters for the 'make install' command?",$default);
 136
 137     $local = 'MIRRORED.BY';
 138     if (@{$CPAN::Config->{urllist}||[]}) {
 139         print qq{
 140 I found a list of URLs in CPAN::Config and will use this.
 141 You can change it later with the 'o conf' command.
 142
 143 }
 144     } elsif (-f $local) { # if they really have a MIRRORED.BY in the
 145                      # current directory, we can't help
 146         read_mirrored_by($local);
 147     } else {
 148         $CPAN::Config->{urllist} ||= [];
 149         while (! @{$CPAN::Config->{urllist}}) {
 150             print qq{
 151 We need to know the URL of your favorite CPAN site.
 152 Please enter it here: };
 153             chop($_ = <>);
 154             s/\s//g;
 155             push @{$CPAN::Config->{urllist}}, $_ if $_;
 156         }
 157     }
 158
 159     # We don't ask that now, it will be noticed in time....
 160     $CPAN::Config->{'inhibit_startup_message'} = 0;
 161
 162     print "\n\n";
 163     CPAN::Config->commit($configpm);
 164 }
 165
 166 sub find_exe {
 167     my($exe,$path) = @_;
 168     my($dir,$MY);
 169     $MY = {};
 170     bless $MY, 'MY';
 171     for $dir (@$path) {
 172         my $abs = $MY->catfile($dir,$exe);
 173         if ($MY->maybe_command($abs)) {
 174             return $abs;
 175         }
 176     }
 177 }
 178
 179 sub read_mirrored_by {
 180     my($local) = @_;
 181     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
 182     open FH, $local or die "Couldn't open $local: $!";
 183     while (<FH>) {
 184         ($host) = /^([\w\.\-]+)/ unless defined $host;
 185         next unless defined $host;
 186         next unless /\s+dst_(dst|location)/;
 187         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
 188             ($continent, $country) = @location[-1,-2];
 189         $continent =~ s/\s\(.*//;
 190         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
 191         next unless $host && $dst && $continent && $country;
 192         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
 193         undef $host;
 194         $dst=$continent=$country="";
 195     }
 196     $CPAN::Config->{urllist} ||= [];
 197     if ($expected_size = @{$CPAN::Config->{urllist}}) {
 198         for $url (@{$CPAN::Config->{urllist}}) {
 199             # sanity check, scheme+colon, not "q" there:
 200             next unless $url =~ /^\w+:\/./;
 201             $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
 202         }
 203         $CPAN::Config->{urllist} = [];
 204     } else {
 205         $expected_size = 6;
 206     }
 207
 208     print qq{
 209
 210 Now we need to know, where your favorite CPAN sites are located. Push
 211 a few sites onto the array (just in case the first on the array won\'t
 212 work). If you are mirroring CPAN to your local workstation, specify a
 213 file: URL.
 214
 215 You can enter the number in front of the URL on the next screen, a
 216 file:, ftp: or http: URL, or "q" to finish selecting.
 217
 218 };
 219
 220     $ans = prompt("Press RETURN to continue");
 221     my $other;
 222     $ans = $other = "";
 223     my(%seen);
 224
 225     while () {
 226         my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
 227         my(@valid,$previous_best);
 228         open FH, $pipe;
 229         {
 230             my($cont,$country,$url,$item);
 231             my(@cont) = sort keys %all;
 232             for $cont (@cont) {
 233                 print FH "    $cont\n";
 234                 for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
 235                     for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
 236                         my $t = sprintf(
 237                                         "      %-18s (%2d) %s\n",
 238                                         $country,
 239                                         ++$item,
 240                                         $url
 241                                        );
 242                         if ($cont =~ /^\[/) {
 243                             $previous_best ||= $item;
 244                         }
 245                         push @valid, $all{$cont}{$country}{$url};
 246                         print FH $t;
 247                     }
 248                 }
 249             }
 250         }
 251         close FH;
 252         $previous_best ||= 1;
 253         $default =
 254             @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
 255         $ans = prompt(
 256                       "\nSelect an$other ftp or file URL or a number (q to finish)",
 257                       $default
 258                      );
 259         my $sel;
 260         if ($ans =~ /^\d/) {
 261             my $this = $valid[$ans-1];
 262             my($con,$cou,$url) = ($this->con,$this->cou,$this->url);
 263             push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
 264             delete $all{$con}{$cou}{$url};
 265             #       print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
 266         } elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
 267             last;
 268         } else {
 269             $ans =~ s|/?$|/|; # has to end with one slash
 270             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
 271             if ($ans =~ /^\w+:\/./) {
 272                 push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
 273             } else {
 274                 print qq{"$ans" doesn\'t look like an URL at first sight.
 275 I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
 276 later and report a bug in my Makefile.PL to me (andreas koenig).
 277 Thanks.\n};
 278             }
 279         }
 280         $other ||= "other";
 281     }
 282 }
 283
 284 1;