This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use "proto" instead of "_" in sdbm.h
[perl5.git] / lib / CPAN / FirstTime.pm
CommitLineData
5f05dabc
PP
1package CPAN::Mirrored::By;
2
3sub new {
4 my($self,@arg) = @_;
5 bless [@arg], $self;
6}
7sub con { shift->[0] }
8sub cou { shift->[1] }
9sub url { shift->[2] }
10
11package CPAN::FirstTime;
12
13use strict;
14use ExtUtils::MakeMaker qw(prompt);
15require File::Path;
16use vars qw($VERSION);
17$VERSION = "1.00";
18
19=head1 NAME
20
21CPAN::FirstTime - Utility for CPAN::Config file Initialization
22
23=head1 SYNOPSIS
24
25CPAN::FirstTime::init()
26
27=head1 DESCRIPTION
28
29The init routine asks a few questions and writes a CPAN::Config
30file. Nothing special.
31
32=cut
33
34
35sub 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
46The CPAN module needs a directory of its own to cache important
47index files and maybe keep a temporary mirror of CPAN files. This may
48be 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
55I see you already have a directory
56 $cpan_home
57Shall we use it as the general CPAN build and cache directory?
58
59};
60 } else {
61 print qq{
62
63First 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
75If you want, I can keep the source files after a build in the cpan
76home directory. If you choose so then future builds will take the
77files from there. If you don\'t want to keep them, answer 0 to the
78next 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
87How big should the disk cache be for keeping the build directories
88with 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
101The CPAN module will need a few external programs to work
102properly. 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
120Every Makefile.PL is run by perl in a seperate process. Likewise we
121run \'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
123the 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{
140I found a list of URLs in CPAN::Config and will use this.
141You 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{
151We need to know the URL of your favorite CPAN site.
152Please 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
166sub 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
179sub 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
210Now we need to know, where your favorite CPAN sites are located. Push
211a few sites onto the array (just in case the first on the array won\'t
212work). If you are mirroring CPAN to your local workstation, specify a
213file: URL.
214
215You can enter the number in front of the URL on the next screen, a
216file:, 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.
275I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
276later and report a bug in my Makefile.PL to me (andreas koenig).
277Thanks.\n};
278 }
279 }
280 $other ||= "other";
281 }
282}
283
2841;