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

package CPAN::Mirrored::By;

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

package CPAN::FirstTime;

use strict;
use ExtUtils::MakeMaker qw(prompt);
require File::Path;
use vars qw($VERSION);
$VERSION = substr q$Revision: 1.13 $, 10;

=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 ||= {};
    local($/) = "\n";
    local($\) = "";

    my($ans,$default,$local,$cont,$url,$expected_size);
    
    #
    # Files, directories
    #

    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");

    #
    # Cache size, Index expire
    #

    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;

    #
    # External programs
    #

    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;
    $path = $CPAN::Config->{'shell'} || $ENV{SHELL} || "";
    $ans = prompt("What is your favorite shell?",$path) || $path;

    #
    # Arguments to make etc.
    #

    print qq{

Every Makefile.PL is run by perl in a separate 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);

    #
    # Alarm period
    #

    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);


    #
    # MIRRORED.BY
    #

    $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 $_;
	}
    }

    print qq{

If you\'re accessing the net via proxies, you can specify them in the
CPAN configuration or via environment variables. The variable in
the \$CPAN::Config takes precedence.

};

    for (qw/ftp_proxy http_proxy no_proxy/) {
	$default = $CPAN::Config->{$_} || $ENV{$_};
	$CPAN::Config->{$_} = prompt("Your $_?",$default);
    }

    # 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->continent,$this->country,$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	}
da199366 A	7	sub continent { shift->[0] }
da199366 A	8	sub country { shift->[1] }
5f05dabc	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);
da199366	17	$VERSION = substr q$Revision: 1.13 $, 10;
5f05dabc	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 \|\|= {};
da199366 A	41	local($/) = "\n";
	42	local($\) = "";
	43
5f05dabc	44	my($ans,$default,$local,$cont,$url,$expected_size);
5f05dabc	45
da199366 A	46	#
	47	# Files, directories
	48	#
	49
5f05dabc	50	print qq{
	51
	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;
10b2abe6 CS	75	until (-d ($ans = prompt("CPAN build and cache directory?",$default)) && -w _) {
	76	print "Couldn't find directory $ans
	77	or directory is not writable. Please retry.\n";
	78	}
5f05dabc	79	File::Path::mkpath($ans); # dies if it can't
	80	$CPAN::Config->{cpan_home} = $ans;
	81
	82	print qq{
	83
	84	If you want, I can keep the source files after a build in the cpan
	85	home directory. If you choose so then future builds will take the
	86	files from there. If you don\'t want to keep them, answer 0 to the
	87	next question.
	88
	89	};
	90
	91	$CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
	92	$CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
	93
da199366 A	94	#
	95	# Cache size, Index expire
	96	#
	97
5f05dabc	98	print qq{
	99
	100	How big should the disk cache be for keeping the build directories
	101	with all the intermediate files?
	102
	103	};
	104
	105	$default = $CPAN::Config->{build_cache} \|\| 10;
	106	$ans = prompt("Cache size for build directory (in MB)?", $default);
	107	$CPAN::Config->{build_cache} = $ans;
	108
	109	# XXX This the time when we refetch the index files (in days)
	110	$CPAN::Config->{'index_expire'} = 1;
	111
da199366 A	112	#
	113	# External programs
	114	#
	115
5f05dabc	116	print qq{
	117
	118	The CPAN module will need a few external programs to work
	119	properly. Please correct me, if I guess the wrong path for a program.
	120
	121	};
	122
	123	my(@path) = split($Config{path_sep},$ENV{PATH});
	124	my $prog;
10b2abe6	125	for $prog (qw/gzip tar unzip make lynx ftp/){
5f05dabc	126	my $path = $CPAN::Config->{$prog} \|\| find_exe($prog,[@path]) \|\| $prog;
	127	$ans = prompt("Where is your $prog program?",$path) \|\| $path;
	128	$CPAN::Config->{$prog} = $ans;
	129	}
	130	my $path = $CPAN::Config->{'pager'} \|\|
	131	$ENV{PAGER} \|\| find_exe("less",[@path]) \|\|
	132	find_exe("more",[@path]) \|\| "more";
	133	$ans = prompt("What is your favorite pager program?",$path) \|\| $path;
	134	$CPAN::Config->{'pager'} = $ans;
da199366 A	135	$path = $CPAN::Config->{'shell'} \|\| $ENV{SHELL} \|\| "";
	136	$ans = prompt("What is your favorite shell?",$path) \|\| $path;
	137
	138	#
	139	# Arguments to make etc.
	140	#
	141
5f05dabc	142	print qq{
5f05dabc	143
da199366	144	Every Makefile.PL is run by perl in a separate process. Likewise we
5f05dabc	145	run \'make\' and \'make install\' in processes. If you have any parameters
	146	\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
	147	the calls, please specify them here.
	148
	149	};
	150
	151	$default = $CPAN::Config->{makepl_arg} \|\| "";
	152	$CPAN::Config->{makepl_arg} =
	153	prompt("Parameters for the 'perl Makefile.PL' command?",$default);
	154	$default = $CPAN::Config->{make_arg} \|\| "";
	155	$CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
	156
	157	$default = $CPAN::Config->{make_install_arg} \|\| $CPAN::Config->{make_arg} \|\| "";
	158	$CPAN::Config->{make_install_arg} =
	159	prompt("Parameters for the 'make install' command?",$default);
	160
da199366 A	161	#
	162	# Alarm period
	163	#
	164
10b2abe6 CS	165	print qq{
	166
	167	Sometimes you may wish to leave the processes run by CPAN alone
	168	without caring about them. As sometimes the Makefile.PL contains
	169	question you\'re expected to answer, you can set a timer that will
	170	kill a 'perl Makefile.PL' process after the specified time in seconds.
	171
	172	If you set this value to 0, these processes will wait forever.
	173
	174	};
	175
	176	$default = $CPAN::Config->{inactivity_timeout} \|\| 0;
	177	$CPAN::Config->{inactivity_timeout} =
	178	prompt("Timout for inacivity during Makefile.PL?",$default);
	179
da199366 A	180
	181	#
	182	# MIRRORED.BY
	183	#
10b2abe6	184
5f05dabc	185	$local = 'MIRRORED.BY';
	186	if (@{$CPAN::Config->{urllist}\|\|[]}) {
	187	print qq{
	188	I found a list of URLs in CPAN::Config and will use this.
	189	You can change it later with the 'o conf' command.
	190
	191	}
10b2abe6 CS	192	} elsif (-f $local) { # if they really have a wrong MIRRORED.BY in
10b2abe6 CS	193	# the current directory, we can't help
5f05dabc	194	read_mirrored_by($local);
	195	} else {
	196	$CPAN::Config->{urllist} \|\|= [];
	197	while (! @{$CPAN::Config->{urllist}}) {
	198	print qq{
	199	We need to know the URL of your favorite CPAN site.
	200	Please enter it here: };
	201	chop($_ = <>);
	202	s/\s//g;
	203	push @{$CPAN::Config->{urllist}}, $_ if $_;
	204	}
	205	}
	206
da199366 A	207	print qq{
	208
	209	If you\'re accessing the net via proxies, you can specify them in the
	210	CPAN configuration or via environment variables. The variable in
	211	the \$CPAN::Config takes precedence.
	212
	213	};
	214
	215	for (qw/ftp_proxy http_proxy no_proxy/) {
	216	$default = $CPAN::Config->{$_} \|\| $ENV{$_};
	217	$CPAN::Config->{$_} = prompt("Your $_?",$default);
	218	}
	219
5f05dabc	220	# We don't ask that now, it will be noticed in time....
	221	$CPAN::Config->{'inhibit_startup_message'} = 0;
	222
	223	print "\n\n";
	224	CPAN::Config->commit($configpm);
	225	}
	226
	227	sub find_exe {
	228	my($exe,$path) = @_;
	229	my($dir,$MY);
	230	$MY = {};
	231	bless $MY, 'MY';
	232	for $dir (@$path) {
	233	my $abs = $MY->catfile($dir,$exe);
	234	if ($MY->maybe_command($abs)) {
	235	return $abs;
	236	}
	237	}
	238	}
	239
	240	sub read_mirrored_by {
	241	my($local) = @_;
	242	my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
	243	open FH, $local or die "Couldn't open $local: $!";
	244	while (<FH>) {
	245	($host) = /^([\w\.\-]+)/ unless defined $host;
	246	next unless defined $host;
	247	next unless /\s+dst_(dst\|location)/;
	248	/location\s+=\s+\"([^\"]+)/ and @location = (split /\s,\s/, $1) and
	249	($continent, $country) = @location[-1,-2];
	250	$continent =~ s/\s\(.*//;
	251	/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
	252	next unless $host && $dst && $continent && $country;
	253	$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
	254	undef $host;
	255	$dst=$continent=$country="";
	256	}
	257	$CPAN::Config->{urllist} \|\|= [];
	258	if ($expected_size = @{$CPAN::Config->{urllist}}) {
	259	for $url (@{$CPAN::Config->{urllist}}) {
	260	# sanity check, scheme+colon, not "q" there:
	261	next unless $url =~ /^\w+:\/./;
	262	$all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
	263	}
	264	$CPAN::Config->{urllist} = [];
	265	} else {
	266	$expected_size = 6;
	267	}
	268
	269	print qq{
	270
	271	Now we need to know, where your favorite CPAN sites are located. Push
	272	a few sites onto the array (just in case the first on the array won\'t
	273	work). If you are mirroring CPAN to your local workstation, specify a
	274	file: URL.
	275
	276	You can enter the number in front of the URL on the next screen, a
	277	file:, ftp: or http: URL, or "q" to finish selecting.
	278
	279	};
	280
	281	$ans = prompt("Press RETURN to continue");
	282	my $other;
	283	$ans = $other = "";
284	my(%seen);
285
286	while () {
287	my $pipe = -t *STDIN ? "\| $CPAN::Config->{'pager'}" : ">/dev/null";
288	my(@valid,$previous_best);
289	open FH, $pipe;
290	{
291	my($cont,$country,$url,$item);
292	my(@cont) = sort keys %all;
293	for $cont (@cont) {
294	print FH " $cont\n";
295	for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
296	for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
297	my $t = sprintf(
298	" %-18s (%2d) %s\n",
299	$country,
300	++$item,
301	$url
302	);
303	if ($cont =~ /^\[/) {
304	$previous_best \|\|= $item;
305	}
306	push @valid, $all{$cont}{$country}{$url};
307	print FH $t;
308	}
309	}
310	}
311	}
312	close FH;
313	$previous_best \|\|= 1;
314	$default =
315	@{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
316	$ans = prompt(
317	"\nSelect an$other ftp or file URL or a number (q to finish)",
318	$default
319	);
320	my $sel;
321	if ($ans =~ /^\d/) {
322	my $this = $valid[$ans-1];
da199366	323	my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
5f05dabc	324	push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
	325	delete $all{$con}{$cou}{$url};
	326	# print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
	327	} elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
	328	last;
	329	} else {
	330	$ans =~ s\|/?$\|/\|; # has to end with one slash
	331	$ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
	332	if ($ans =~ /^\w+:\/./) {
	333	push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
	334	} else {
	335	print qq{"$ans" doesn\'t look like an URL at first sight.
	336	I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
	337	later and report a bug in my Makefile.PL to me (andreas koenig).
	338	Thanks.\n};
	339	}
	340	}
	341	$other \|\|= "other";
	342	}
	343	}
	344
	345	1;