[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;
    until (-d ($ans = prompt("CPAN build and cache directory?",$default)) && -w _) {
	print "Couldn't find directory $ans
  or directory is not writable. Please retry.\n";
    }
    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 lynx ftp/){
	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);

    print qq{

Sometimes you may wish to leave the processes run by CPAN alone
without caring about them. As sometimes the Makefile.PL contains
question you\'re expected to answer, you can set a timer that will
kill a 'perl Makefile.PL' process after the specified time in seconds.

If you set this value to 0, these processes will wait forever.

};

    $default = $CPAN::Config->{inactivity_timeout} || 0;
    $CPAN::Config->{inactivity_timeout} =
	prompt("Timout for inacivity during Makefile.PL?",$default);

    $default = $CPAN::Config->{makepl_arg} || "";

    $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 wrong 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;
10b2abe6 CS	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	}
5f05dabc	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;
10b2abe6	111	for $prog (qw/gzip tar unzip make lynx ftp/){
5f05dabc	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
10b2abe6 CS	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
5f05dabc	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	}
10b2abe6 CS	164	} elsif (-f $local) { # if they really have a wrong MIRRORED.BY in
10b2abe6 CS	165	# the current directory, we can't help
5f05dabc	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;