[perl5.git] / lib / CPAN / FirstTime.pm

package CPAN::Mirrored::By;

sub new { 
    my($self,@arg) = @_;
    bless [@arg], $self;
}
sub con { shift->[0] }
sub cou { shift->[1] }
sub url { shift->[2] }

package CPAN::FirstTime;

use strict;
use ExtUtils::MakeMaker qw(prompt);
require File::Path;
use vars qw($VERSION);
$VERSION = "1.00";

=head1 NAME

CPAN::FirstTime - Utility for CPAN::Config file Initialization

=head1 SYNOPSIS

CPAN::FirstTime::init()

=head1 DESCRIPTION

The init routine asks a few questions and writes a CPAN::Config
file. Nothing special.

=cut


sub init {
    my($configpm) = @_;
    use Config;
    require CPAN::Nox;
    eval {require CPAN::Config;};
    $CPAN::Config ||= {};
    
    my($ans,$default,$local,$cont,$url,$expected_size);
    
    print qq{

The CPAN module needs a directory of its own to cache important
index files and maybe keep a temporary mirror of CPAN files. This may
be a site-wide directory or a personal directory.
};

    my $cpan_home = $CPAN::Config->{cpan_home} || MM->catdir($ENV{HOME}, ".cpan");
    if (-d $cpan_home) {
	print qq{

I see you already have a  directory
    $cpan_home
Shall we use it as the general CPAN build and cache directory?

};
    } else {
	print qq{

First of all, I\'d like to create this directory. Where?

};
    }

    $default = $cpan_home;
    $ans = prompt("CPAN build and cache directory?",$default);
    File::Path::mkpath($ans); # dies if it can't
    $CPAN::Config->{cpan_home} = $ans;
    
    print qq{

If you want, I can keep the source files after a build in the cpan
home directory. If you choose so then future builds will take the
files from there. If you don\'t want to keep them, answer 0 to the
next question.

};

    $CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
    $CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");

    print qq{

How big should the disk cache be for keeping the build directories
with all the intermediate files?

};

    $default = $CPAN::Config->{build_cache} || 10;
    $ans = prompt("Cache size for build directory (in MB)?", $default);
    $CPAN::Config->{build_cache} = $ans;

    # XXX This the time when we refetch the index files (in days)
    $CPAN::Config->{'index_expire'} = 1;

    print qq{

The CPAN module will need a few external programs to work
properly. Please correct me, if I guess the wrong path for a program.

};

    my(@path) = split($Config{path_sep},$ENV{PATH});
    my $prog;
    for $prog (qw/gzip tar unzip make/){
	my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog;
	$ans = prompt("Where is your $prog program?",$path) || $path;
	$CPAN::Config->{$prog} = $ans;
    }
    my $path = $CPAN::Config->{'pager'} || 
	$ENV{PAGER} || find_exe("less",[@path]) || 
	    find_exe("more",[@path]) || "more";
    $ans = prompt("What is your favorite pager program?",$path) || $path;
    $CPAN::Config->{'pager'} = $ans;
    print qq{

Every Makefile.PL is run by perl in a seperate process. Likewise we
run \'make\' and \'make install\' in processes. If you have any parameters
\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
the calls, please specify them here.

};

    $default = $CPAN::Config->{makepl_arg} || "";
    $CPAN::Config->{makepl_arg} =
	prompt("Parameters for the 'perl Makefile.PL' command?",$default);
    $default = $CPAN::Config->{make_arg} || "";
    $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);

    $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
    $CPAN::Config->{make_install_arg} =
	prompt("Parameters for the 'make install' command?",$default);

    $local = 'MIRRORED.BY';
    if (@{$CPAN::Config->{urllist}||[]}) {
	print qq{
I found a list of URLs in CPAN::Config and will use this.
You can change it later with the 'o conf' command.

}
    } elsif (-f $local) { # if they really have a MIRRORED.BY in the
                     # current directory, we can't help
	read_mirrored_by($local);
    } else {
	$CPAN::Config->{urllist} ||= [];
	while (! @{$CPAN::Config->{urllist}}) {
	    print qq{
We need to know the URL of your favorite CPAN site.
Please enter it here: };
	    chop($_ = <>);
	    s/\s//g;
	    push @{$CPAN::Config->{urllist}}, $_ if $_;
	}
    }

    # We don't ask that now, it will be noticed in time....
    $CPAN::Config->{'inhibit_startup_message'} = 0;

    print "\n\n";
    CPAN::Config->commit($configpm);
}

sub find_exe {
    my($exe,$path) = @_;
    my($dir,$MY);
    $MY = {};
    bless $MY, 'MY';
    for $dir (@$path) {
	my $abs = $MY->catfile($dir,$exe);
	if ($MY->maybe_command($abs)) {
	    return $abs;
	}
    }
}

sub read_mirrored_by {
    my($local) = @_;
    my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
    open FH, $local or die "Couldn't open $local: $!";
    while (<FH>) {
	($host) = /^([\w\.\-]+)/ unless defined $host;
	next unless defined $host;
	next unless /\s+dst_(dst|location)/;
	/location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
	    ($continent, $country) = @location[-1,-2];
	$continent =~ s/\s\(.*//;
	/dst_dst\s+=\s+\"([^\"]+)/  and $dst = $1;
	next unless $host && $dst && $continent && $country;
	$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
	undef $host;
	$dst=$continent=$country="";
    }
    $CPAN::Config->{urllist} ||= [];
    if ($expected_size = @{$CPAN::Config->{urllist}}) {
	for $url (@{$CPAN::Config->{urllist}}) {
	    # sanity check, scheme+colon, not "q" there:
	    next unless $url =~ /^\w+:\/./;
	    $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
	}
	$CPAN::Config->{urllist} = [];
    } else {
	$expected_size = 6;
    }
    
    print qq{

Now we need to know, where your favorite CPAN sites are located. Push
a few sites onto the array (just in case the first on the array won\'t
work). If you are mirroring CPAN to your local workstation, specify a
file: URL.

You can enter the number in front of the URL on the next screen, a
file:, ftp: or http: URL, or "q" to finish selecting.

};

    $ans = prompt("Press RETURN to continue");
    my $other;
    $ans = $other = "";
    my(%seen);
    
    while () {
	my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
	my(@valid,$previous_best);
	open FH, $pipe;
	{
	    my($cont,$country,$url,$item);
	    my(@cont) = sort keys %all;
	    for $cont (@cont) {
		print FH "    $cont\n";
		for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
		    for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
			my $t = sprintf(
					"      %-18s (%2d) %s\n",
					$country,
					++$item,
					$url
				       );
			if ($cont =~ /^\[/) {
			    $previous_best ||= $item;
			}
			push @valid, $all{$cont}{$country}{$url};
			print FH $t;
		    }
		}
	    }
	}
	close FH;
	$previous_best ||= 1;
	$default =
	    @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
	$ans = prompt(
		      "\nSelect an$other ftp or file URL or a number (q to finish)",
		      $default
		     );
	my $sel;
	if ($ans =~ /^\d/) {
	    my $this = $valid[$ans-1];
	    my($con,$cou,$url) = ($this->con,$this->cou,$this->url);
	    push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
	    delete $all{$con}{$cou}{$url};
	    #	    print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
	} elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
	    last;
	} else {
	    $ans =~ s|/?$|/|; # has to end with one slash
	    $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
	    if ($ans =~ /^\w+:\/./) {
		push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
	    } else {
		print qq{"$ans" doesn\'t look like an URL at first sight.
I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
later and report a bug in my Makefile.PL to me (andreas koenig).
Thanks.\n};
	    }
	}
	$other ||= "other";
    }
}

1;
Commit	Line	Data
5f05dabc	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;