[p5sagit/p5-mst-13.2.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);
use FileHandle ();
use File::Path ();
use vars qw($VERSION);
$VERSION = substr q$Revision: 1.21 $, 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($\) = "";
    local($|) = 1;

    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;
    while ($ans = prompt("CPAN build and cache directory?",$default)) {
	File::Path::mkpath($ans); # dies if it can't
	if (-d $ans && -w _) {
	    last;
	} else {
	    warn "Couldn't find directory $ans
  or directory is not writable. Please retry.\n";
	}
    }
    $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.
Don\'t panic if you do not have some of them, just press ENTER for
those.

};

    my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
    my $prog;
    for $prog (qw/gzip tar unzip make lynx ncftp ftp/){
	my $path = $CPAN::Config->{$prog} || "";
	if (MM->file_name_is_absolute($path)) {
	    warn "Warning: configured $path does not exist\n" unless -e $path;
	    $path = "";
	} else {
	    $path = '';
	}
	$path ||= find_exe($prog,[@path]);
	warn "Warning: $prog not found in PATH\n" unless -e $path;
	$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);
    $CPAN::Config->{'pager'} = $ans;
    $path = $CPAN::Config->{'shell'};
    if (MM->file_name_is_absolute($path)) {
	warn "Warning: configured $path does not exist\n" unless -e $path;
	$path = "";
    }
    $path ||= $ENV{SHELL};
    $path =~ s,\\,/,g if $^O eq 'os2';	# Cosmetic only
    $ans = prompt("What is your favorite shell?",$path);
    $CPAN::Config->{'shell'} = $ans;

    #
    # 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.

If you don\'t understand this question, just press ENTER.

};

    $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. This is
the default and recommended setting.

};

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


    #
    # MIRRORED.BY
    #

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

}
    } elsif (
	     -s $local
	     &&
	     -M $local < 30
	    ) {
	read_mirrored_by($local);
    } else {
	$CPAN::Config->{urllist} ||= [];
	my $val = 'http://this.field.should.be.inserted/';
	my $cnt = 0;
	while (! @{$CPAN::Config->{urllist}}) {
	    my($input) = prompt(qq{
We need to know the URL of your favorite CPAN site.  Any one will go,
you can change it later from CPAN shell with the 'o conf urllist' command.
A short list is available in 'perlmodlib', as in
	perldoc perlmodlib
Please enter it here:}, $val);
	    $input =~ s/\s//g;
	    die "Did not obtain required field" if $cnt > 10;
	    $cnt++, next if $input eq $val;
	    next unless $input;
	    my($wanted) = "MIRRORED.BY";
	    print qq{
Testing "$input" ...
};
	    push @{$CPAN::Config->{urllist}}, $input;
	    CPAN::FTP->localize($wanted,$local,"force");
	    if (-s $local) {
		print qq{
"$input" seems to work
};
	    } else {
		my $ans = prompt(qq{$input doesn\'t seem to work. Keep it in the list?},"n");
		last unless $ans =~ /^n/i;
		pop @{$CPAN::Config->{urllist}};
	    }
	}
    }

    unless (@{$CPAN::Config->{'wait_list'}||[]}) {
	print qq{

WAIT support is available as a Plugin. You need the CPAN::WAIT module
to actually use it.  But we need to know your favorite WAIT server. If
you don\'t know a WAIT server near you, just press ENTER.

};
	$default = "wait://ls6.informatik.uni-dortmund.de:1404";
	$ans = prompt("Your favorite WAIT server?\n  ",$default);
	push @{$CPAN::Config->{'wait_list'}}, $ans;
    }

    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, won't it?
    $CPAN::Config->{'inhibit_startup_message'} = 0;
    $CPAN::Config->{'getcwd'} = 'cwd';

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

sub find_exe {
    my($exe,$path) = @_;
    my($dir);
    #warn "in find_exe exe[$exe] path[@$path]";
    for $dir (@$path) {
	my $abs = MM->catfile($dir,$exe);
	if (($abs = MM->maybe_command($abs))) {
	    return $abs;
	}
    }
}

sub read_mirrored_by {
    my($local) = @_;
    my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
    my $fh = FileHandle->new;
    $fh->open($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="";
    }
    $fh->close;
    $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);
    
    my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
    while () {
	my(@valid,$previous_best);
	my $fh = FileHandle->new;
	$fh->open($pipe);
	{
	    my($cont,$country,$url,$item);
	    my(@cont) = sort keys %all;
	    for $cont (@cont) {
		$fh->print("    $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};
			$fh->print($t);
		    }
		}
	    }
	}
	$fh->close;
	$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	7	sub continent { shift->[0] }
da199366	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);
05454584	15	use FileHandle ();
05454584	16	use File::Path ();
5f05dabc	17	use vars qw($VERSION);
c356248b	18	$VERSION = substr q$Revision: 1.21 $, 10;
5f05dabc	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 \|\|= {};
da199366	42	local($/) = "\n";
da199366	43	local($\) = "";
13bc20ff	44	local($\|) = 1;
da199366	45
5f05dabc	46	my($ans,$default,$local,$cont,$url,$expected_size);
5f05dabc	47
da199366	48	#
	49	# Files, directories
	50	#
	51
5f05dabc	52	print qq{
5f05dabc	53	The CPAN module needs a directory of its own to cache important
	54	index files and maybe keep a temporary mirror of CPAN files. This may
	55	be a site-wide directory or a personal directory.
	56	};
	57
	58	my $cpan_home = $CPAN::Config->{cpan_home} \|\| MM->catdir($ENV{HOME}, ".cpan");
	59	if (-d $cpan_home) {
	60	print qq{
	61
	62	I see you already have a directory
	63	$cpan_home
	64	Shall we use it as the general CPAN build and cache directory?
	65
	66	};
	67	} else {
	68	print qq{
	69
	70	First of all, I\'d like to create this directory. Where?
	71
	72	};
	73	}
	74
	75	$default = $cpan_home;
05454584	76	while ($ans = prompt("CPAN build and cache directory?",$default)) {
	77	File::Path::mkpath($ans); # dies if it can't
	78	if (-d $ans && -w _) {
	79	last;
	80	} else {
	81	warn "Couldn't find directory $ans
10b2abe6	82	or directory is not writable. Please retry.\n";
05454584	83	}
10b2abe6	84	}
5f05dabc	85	$CPAN::Config->{cpan_home} = $ans;
	86
	87	print qq{
	88
	89	If you want, I can keep the source files after a build in the cpan
	90	home directory. If you choose so then future builds will take the
	91	files from there. If you don\'t want to keep them, answer 0 to the
	92	next question.
	93
	94	};
	95
	96	$CPAN::Config->{keep_source_where} = MM->catdir($CPAN::Config->{cpan_home},"sources");
	97	$CPAN::Config->{build_dir} = MM->catdir($CPAN::Config->{cpan_home},"build");
	98
da199366	99	#
	100	# Cache size, Index expire
	101	#
	102
5f05dabc	103	print qq{
	104
	105	How big should the disk cache be for keeping the build directories
	106	with all the intermediate files?
	107
	108	};
	109
	110	$default = $CPAN::Config->{build_cache} \|\| 10;
	111	$ans = prompt("Cache size for build directory (in MB)?", $default);
	112	$CPAN::Config->{build_cache} = $ans;
	113
	114	# XXX This the time when we refetch the index files (in days)
	115	$CPAN::Config->{'index_expire'} = 1;
	116
da199366	117	#
	118	# External programs
	119	#
	120
5f05dabc	121	print qq{
	122
	123	The CPAN module will need a few external programs to work
	124	properly. Please correct me, if I guess the wrong path for a program.
05454584	125	Don\'t panic if you do not have some of them, just press ENTER for
05454584	126	those.
5f05dabc	127
	128	};
	129
55e314ee	130	my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
5f05dabc	131	my $prog;
e50380aa	132	for $prog (qw/gzip tar unzip make lynx ncftp ftp/){
55e314ee	133	my $path = $CPAN::Config->{$prog} \|\| "";
	134	if (MM->file_name_is_absolute($path)) {
	135	warn "Warning: configured $path does not exist\n" unless -e $path;
	136	$path = "";
	137	} else {
	138	$path = '';
	139	}
	140	$path \|\|= find_exe($prog,[@path]);
	141	warn "Warning: $prog not found in PATH\n" unless -e $path;
5f05dabc	142	$ans = prompt("Where is your $prog program?",$path) \|\| $path;
	143	$CPAN::Config->{$prog} = $ans;
	144	}
	145	my $path = $CPAN::Config->{'pager'} \|\|
	146	$ENV{PAGER} \|\| find_exe("less",[@path]) \|\|
	147	find_exe("more",[@path]) \|\| "more";
55e314ee	148	$ans = prompt("What is your favorite pager program?",$path);
5f05dabc	149	$CPAN::Config->{'pager'} = $ans;
55e314ee	150	$path = $CPAN::Config->{'shell'};
	151	if (MM->file_name_is_absolute($path)) {
	152	warn "Warning: configured $path does not exist\n" unless -e $path;
	153	$path = "";
	154	}
	155	$path \|\|= $ENV{SHELL};
13bc20ff	156	$path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
55e314ee	157	$ans = prompt("What is your favorite shell?",$path);
05454584	158	$CPAN::Config->{'shell'} = $ans;
da199366	159
	160	#
	161	# Arguments to make etc.
	162	#
	163
5f05dabc	164	print qq{
5f05dabc	165
da199366	166	Every Makefile.PL is run by perl in a separate process. Likewise we
5f05dabc	167	run \'make\' and \'make install\' in processes. If you have any parameters
	168	\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
	169	the calls, please specify them here.
	170
05454584	171	If you don\'t understand this question, just press ENTER.
05454584	172
5f05dabc	173	};
	174
	175	$default = $CPAN::Config->{makepl_arg} \|\| "";
	176	$CPAN::Config->{makepl_arg} =
	177	prompt("Parameters for the 'perl Makefile.PL' command?",$default);
	178	$default = $CPAN::Config->{make_arg} \|\| "";
	179	$CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
	180
	181	$default = $CPAN::Config->{make_install_arg} \|\| $CPAN::Config->{make_arg} \|\| "";
	182	$CPAN::Config->{make_install_arg} =
	183	prompt("Parameters for the 'make install' command?",$default);
	184
da199366	185	#
	186	# Alarm period
	187	#
	188
10b2abe6	189	print qq{
	190
	191	Sometimes you may wish to leave the processes run by CPAN alone
	192	without caring about them. As sometimes the Makefile.PL contains
	193	question you\'re expected to answer, you can set a timer that will
	194	kill a 'perl Makefile.PL' process after the specified time in seconds.
	195
e50380aa	196	If you set this value to 0, these processes will wait forever. This is
e50380aa	197	the default and recommended setting.
10b2abe6	198
	199	};
	200
	201	$default = $CPAN::Config->{inactivity_timeout} \|\| 0;
	202	$CPAN::Config->{inactivity_timeout} =
55e314ee	203	prompt("Timeout for inacivity during Makefile.PL?",$default);
10b2abe6	204
da199366	205
	206	#
	207	# MIRRORED.BY
	208	#
10b2abe6	209
5f05dabc	210	$local = 'MIRRORED.BY';
05454584	211	$local = MM->catfile($CPAN::Config->{keep_source_where},"MIRRORED.BY") unless -f $local;
5f05dabc	212	if (@{$CPAN::Config->{urllist}\|\|[]}) {
	213	print qq{
	214	I found a list of URLs in CPAN::Config and will use this.
13bc20ff	215	You can change it later from CPAN shell with the 'o conf urllist' command.
5f05dabc	216
5f05dabc	217	}
05454584	218	} elsif (
	219	-s $local
	220	&&
	221	-M $local < 30
	222	) {
5f05dabc	223	read_mirrored_by($local);
	224	} else {
	225	$CPAN::Config->{urllist} \|\|= [];
13bc20ff	226	my $val = 'http://this.field.should.be.inserted/';
13bc20ff	227	my $cnt = 0;
5f05dabc	228	while (! @{$CPAN::Config->{urllist}}) {
05454584	229	my($input) = prompt(qq{
13bc20ff	230	We need to know the URL of your favorite CPAN site. Any one will go,
	231	you can change it later from CPAN shell with the 'o conf urllist' command.
	232	A short list is available in 'perlmodlib', as in
	233	perldoc perlmodlib
	234	Please enter it here:}, $val);
05454584	235	$input =~ s/\s//g;
13bc20ff	236	die "Did not obtain required field" if $cnt > 10;
13bc20ff	237	$cnt++, next if $input eq $val;
05454584	238	next unless $input;
	239	my($wanted) = "MIRRORED.BY";
	240	print qq{
	241	Testing "$input" ...
	242	};
	243	push @{$CPAN::Config->{urllist}}, $input;
	244	CPAN::FTP->localize($wanted,$local,"force");
	245	if (-s $local) {
	246	print qq{
	247	"$input" seems to work
	248	};
	249	} else {
	250	my $ans = prompt(qq{$input doesn\'t seem to work. Keep it in the list?},"n");
	251	last unless $ans =~ /^n/i;
	252	pop @{$CPAN::Config->{urllist}};
	253	}
5f05dabc	254	}
	255	}
	256
d4fd5c69	257	unless (@{$CPAN::Config->{'wait_list'}\|\|[]}) {
d4fd5c69	258	print qq{
da199366	259
05454584	260	WAIT support is available as a Plugin. You need the CPAN::WAIT module
	261	to actually use it. But we need to know your favorite WAIT server. If
	262	you don\'t know a WAIT server near you, just press ENTER.
	263
	264	};
d4fd5c69	265	$default = "wait://ls6.informatik.uni-dortmund.de:1404";
	266	$ans = prompt("Your favorite WAIT server?\n ",$default);
	267	push @{$CPAN::Config->{'wait_list'}}, $ans;
	268	}
05454584	269
	270	print qq{
	271
da199366	272	If you\'re accessing the net via proxies, you can specify them in the
	273	CPAN configuration or via environment variables. The variable in
	274	the \$CPAN::Config takes precedence.
	275
	276	};
	277
	278	for (qw/ftp_proxy http_proxy no_proxy/) {
	279	$default = $CPAN::Config->{$_} \|\| $ENV{$_};
	280	$CPAN::Config->{$_} = prompt("Your $_?",$default);
	281	}
	282
e50380aa	283	# We don't ask that now, it will be noticed in time, won't it?
5f05dabc	284	$CPAN::Config->{'inhibit_startup_message'} = 0;
e50380aa	285	$CPAN::Config->{'getcwd'} = 'cwd';
5f05dabc	286
	287	print "\n\n";
	288	CPAN::Config->commit($configpm);
	289	}
	290
	291	sub find_exe {
	292	my($exe,$path) = @_;
55e314ee	293	my($dir);
55e314ee	294	#warn "in find_exe exe[$exe] path[@$path]";
5f05dabc	295	for $dir (@$path) {
55e314ee	296	my $abs = MM->catfile($dir,$exe);
13bc20ff	297	if (($abs = MM->maybe_command($abs))) {
5f05dabc	298	return $abs;
	299	}
	300	}
	301	}
	302
	303	sub read_mirrored_by {
	304	my($local) = @_;
	305	my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
05454584	306	my $fh = FileHandle->new;
	307	$fh->open($local) or die "Couldn't open $local: $!";
	308	while (<$fh>) {
5f05dabc	309	($host) = /^([\w\.\-]+)/ unless defined $host;
	310	next unless defined $host;
	311	next unless /\s+dst_(dst\|location)/;
	312	/location\s+=\s+\"([^\"]+)/ and @location = (split /\s,\s/, $1) and
	313	($continent, $country) = @location[-1,-2];
	314	$continent =~ s/\s\(.*//;
	315	/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
	316	next unless $host && $dst && $continent && $country;
	317	$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
	318	undef $host;
	319	$dst=$continent=$country="";
	320	}
05454584	321	$fh->close;
5f05dabc	322	$CPAN::Config->{urllist} \|\|= [];
	323	if ($expected_size = @{$CPAN::Config->{urllist}}) {
	324	for $url (@{$CPAN::Config->{urllist}}) {
	325	# sanity check, scheme+colon, not "q" there:
	326	next unless $url =~ /^\w+:\/./;
	327	$all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
	328	}
	329	$CPAN::Config->{urllist} = [];
	330	} else {
	331	$expected_size = 6;
	332	}
	333
	334	print qq{
	335
	336	Now we need to know, where your favorite CPAN sites are located. Push
	337	a few sites onto the array (just in case the first on the array won\'t
	338	work). If you are mirroring CPAN to your local workstation, specify a
	339	file: URL.
	340
	341	You can enter the number in front of the URL on the next screen, a
	342	file:, ftp: or http: URL, or "q" to finish selecting.
	343
	344	};
	345
	346	$ans = prompt("Press RETURN to continue");
	347	my $other;
	348	$ans = $other = "";
	349	my(%seen);
	350
d4fd5c69	351	my $pipe = -t *STDIN ? "\| $CPAN::Config->{'pager'}" : ">/dev/null";
5f05dabc	352	while () {
5f05dabc	353	my(@valid,$previous_best);
05454584	354	my $fh = FileHandle->new;
05454584	355	$fh->open($pipe);
5f05dabc	356	{
	357	my($cont,$country,$url,$item);
	358	my(@cont) = sort keys %all;
	359	for $cont (@cont) {
05454584	360	$fh->print(" $cont\n");
5f05dabc	361	for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
	362	for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
	363	my $t = sprintf(
	364	" %-18s (%2d) %s\n",
	365	$country,
	366	++$item,
	367	$url
	368	);
	369	if ($cont =~ /^\[/) {
	370	$previous_best \|\|= $item;
	371	}
	372	push @valid, $all{$cont}{$country}{$url};
05454584	373	$fh->print($t);
5f05dabc	374	}
	375	}
	376	}
	377	}
d4fd5c69	378	$fh->close;
5f05dabc	379	$previous_best \|\|= 1;
	380	$default =
	381	@{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;
	382	$ans = prompt(
	383	"\nSelect an$other ftp or file URL or a number (q to finish)",
	384	$default
	385	);
	386	my $sel;
	387	if ($ans =~ /^\d/) {
	388	my $this = $valid[$ans-1];
da199366	389	my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
5f05dabc	390	push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
	391	delete $all{$con}{$cou}{$url};
	392	# print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
	393	} elsif (@{$CPAN::Config->{urllist}} && $ans =~ /^q/i) {
	394	last;
	395	} else {
	396	$ans =~ s\|/?$\|/\|; # has to end with one slash
	397	$ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
	398	if ($ans =~ /^\w+:\/./) {
	399	push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
	400	} else {
	401	print qq{"$ans" doesn\'t look like an URL at first sight.
	402	I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
	403	later and report a bug in my Makefile.PL to me (andreas koenig).
	404	Thanks.\n};
	405	}
	406	}
	407	$other \|\|= "other";
	408	}
	409	}
	410
	411	1;