Term::Readline patch for AmigaOS
[p5sagit/p5-mst-13.2.git] / 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.16 $, 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 ftp/){
132         my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog;
133         $ans = prompt("Where is your $prog program?",$path) || $path;
134         $CPAN::Config->{$prog} = $ans;
135     }
136     my $path = $CPAN::Config->{'pager'} || 
137         $ENV{PAGER} || find_exe("less",[@path]) || 
138             find_exe("more",[@path]) || "more";
139     $ans = prompt("What is your favorite pager program?",$path) || $path;
140     $CPAN::Config->{'pager'} = $ans;
141     $path = $CPAN::Config->{'shell'} || $ENV{SHELL} || "";
142     $ans = prompt("What is your favorite shell?",$path) || $path;
143     $CPAN::Config->{'shell'} = $ans;
144
145     #
146     # Arguments to make etc.
147     #
148
149     print qq{
150
151 Every Makefile.PL is run by perl in a separate process. Likewise we
152 run \'make\' and \'make install\' in processes. If you have any parameters
153 \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
154 the calls, please specify them here.
155
156 If you don\'t understand this question, just press ENTER.
157
158 };
159
160     $default = $CPAN::Config->{makepl_arg} || "";
161     $CPAN::Config->{makepl_arg} =
162         prompt("Parameters for the 'perl Makefile.PL' command?",$default);
163     $default = $CPAN::Config->{make_arg} || "";
164     $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
165
166     $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
167     $CPAN::Config->{make_install_arg} =
168         prompt("Parameters for the 'make install' command?",$default);
169
170     #
171     # Alarm period
172     #
173
174     print qq{
175
176 Sometimes you may wish to leave the processes run by CPAN alone
177 without caring about them. As sometimes the Makefile.PL contains
178 question you\'re expected to answer, you can set a timer that will
179 kill a 'perl Makefile.PL' process after the specified time in seconds.
180
181 If you set this value to 0, these processes will wait forever.
182
183 };
184
185     $default = $CPAN::Config->{inactivity_timeout} || 0;
186     $CPAN::Config->{inactivity_timeout} =
187         prompt("Timout for inacivity during Makefile.PL?",$default);
188
189
190     #
191     # MIRRORED.BY
192     #
193
194     $local = 'MIRRORED.BY';
195     $local = MM->catfile($CPAN::Config->{keep_source_where},"MIRRORED.BY") unless -f $local;
196     if (@{$CPAN::Config->{urllist}||[]}) {
197         print qq{
198 I found a list of URLs in CPAN::Config and will use this.
199 You can change it later with the 'o conf' command.
200
201 }
202     } elsif (
203              -s $local
204              &&
205              -M $local < 30
206             ) {
207         read_mirrored_by($local);
208     } else {
209         $CPAN::Config->{urllist} ||= [];
210         while (! @{$CPAN::Config->{urllist}}) {
211             my($input) = prompt(qq{
212 We need to know the URL of your favorite CPAN site.
213 Please enter it here:});
214             $input =~ s/\s//g;
215             next unless $input;
216             my($wanted) = "MIRRORED.BY";
217             print qq{
218 Testing "$input" ...
219 };
220             push @{$CPAN::Config->{urllist}}, $input;
221             CPAN::FTP->localize($wanted,$local,"force");
222             if (-s $local) {
223                 print qq{
224 "$input" seems to work
225 };
226             } else {
227                 my $ans = prompt(qq{$input doesn\'t seem to work. Keep it in the list?},"n");
228                 last unless $ans =~ /^n/i;
229                 pop @{$CPAN::Config->{urllist}};
230             }
231         }
232     }
233
234     unless (@{$CPAN::Config->{'wait_list'}||[]}) {
235         print qq{
236
237 WAIT support is available as a Plugin. You need the CPAN::WAIT module
238 to actually use it.  But we need to know your favorite WAIT server. If
239 you don\'t know a WAIT server near you, just press ENTER.
240
241 };
242         $default = "wait://ls6.informatik.uni-dortmund.de:1404";
243         $ans = prompt("Your favorite WAIT server?\n  ",$default);
244         push @{$CPAN::Config->{'wait_list'}}, $ans;
245     }
246
247     print qq{
248
249 If you\'re accessing the net via proxies, you can specify them in the
250 CPAN configuration or via environment variables. The variable in
251 the \$CPAN::Config takes precedence.
252
253 };
254
255     for (qw/ftp_proxy http_proxy no_proxy/) {
256         $default = $CPAN::Config->{$_} || $ENV{$_};
257         $CPAN::Config->{$_} = prompt("Your $_?",$default);
258     }
259
260     # We don't ask that now, it will be noticed in time....
261     $CPAN::Config->{'inhibit_startup_message'} = 0;
262
263     print "\n\n";
264     CPAN::Config->commit($configpm);
265 }
266
267 sub find_exe {
268     my($exe,$path) = @_;
269     my($dir,$MY);
270     $MY = {};
271     bless $MY, 'MY';
272     for $dir (@$path) {
273         my $abs = $MY->catfile($dir,$exe);
274         if ($MY->maybe_command($abs)) {
275             return $abs;
276         }
277     }
278 }
279
280 sub read_mirrored_by {
281     my($local) = @_;
282     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
283     my $fh = FileHandle->new;
284     $fh->open($local) or die "Couldn't open $local: $!";
285     while (<$fh>) {
286         ($host) = /^([\w\.\-]+)/ unless defined $host;
287         next unless defined $host;
288         next unless /\s+dst_(dst|location)/;
289         /location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
290             ($continent, $country) = @location[-1,-2];
291         $continent =~ s/\s\(.*//;
292         /dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
293         next unless $host && $dst && $continent && $country;
294         $all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
295         undef $host;
296         $dst=$continent=$country="";
297     }
298     $fh->close;
299     $CPAN::Config->{urllist} ||= [];
300     if ($expected_size = @{$CPAN::Config->{urllist}}) {
301         for $url (@{$CPAN::Config->{urllist}}) {
302             # sanity check, scheme+colon, not "q" there:
303             next unless $url =~ /^\w+:\/./;
304             $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
305         }
306         $CPAN::Config->{urllist} = [];
307     } else {
308         $expected_size = 6;
309     }
310     
311     print qq{
312
313 Now we need to know, where your favorite CPAN sites are located. Push
314 a few sites onto the array (just in case the first on the array won\'t
315 work). If you are mirroring CPAN to your local workstation, specify a
316 file: URL.
317
318 You can enter the number in front of the URL on the next screen, a
319 file:, ftp: or http: URL, or "q" to finish selecting.
320
321 };
322
323     $ans = prompt("Press RETURN to continue");
324     my $other;
325     $ans = $other = "";
326     my(%seen);
327     
328     my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
329     while () {
330         my(@valid,$previous_best);
331         my $fh = FileHandle->new;
332         $fh->open($pipe);
333         {
334             my($cont,$country,$url,$item);
335             my(@cont) = sort keys %all;
336             for $cont (@cont) {
337                 $fh->print("    $cont\n");
338                 for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
339                     for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
340                         my $t = sprintf(
341                                         "      %-18s (%2d) %s\n",
342                                         $country,
343                                         ++$item,
344                                         $url
345                                        );
346                         if ($cont =~ /^\[/) {
347                             $previous_best ||= $item;
348                         }
349                         push @valid, $all{$cont}{$country}{$url};
350                         $fh->print($t);
351                     }
352                 }
353             }
354         }
355         $fh->close;
356         $previous_best ||= 1;
357         $default =
358             @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
359         $ans = prompt(
360                       "\nSelect an$other ftp or file URL or a number (q to finish)",
361                       $default
362                      );
363         my $sel;
364         if ($ans =~ /^\d/) {
365             my $this = $valid[$ans-1];
366             my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
367             push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
368             delete $all{$con}{$cou}{$url};
369             #       print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
370         } elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
371             last;
372         } else {
373             $ans =~ s|/?$|/|; # has to end with one slash
374             $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
375             if ($ans =~ /^\w+:\/./) {
376                 push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
377             } else {
378                 print qq{"$ans" doesn\'t look like an URL at first sight.
379 I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
380 later and report a bug in my Makefile.PL to me (andreas koenig).
381 Thanks.\n};
382             }
383         }
384         $other ||= "other";
385     }
386 }
387
388 1;