[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::Basename ();
use File::Path ();
use vars qw($VERSION);
$VERSION = substr q$Revision: 1.30 $, 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[

CPAN is the world-wide archive of perl resources. It consists of about
100 sites that all replicate the same contents all around the globe.
Many countries have at least one CPAN site already. The resources
found on CPAN are easily accessible with the CPAN.pm module. If you
want to use CPAN.pm, you have to configure it properly.

If you do not want to enter a dialog now, you can answer 'no' to this
question and I\'ll try to autoconfigure. (Note: you can revisit this
dialog anytime later by typing 'o conf init' at the cpan prompt.)

];

    my $manual_conf =
	ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
				    "yes");
    my $fastread;
    {
      local $^W;
      if ($manual_conf =~ /^\s*y/i) {
	$fastread = 0;
	*prompt = \&ExtUtils::MakeMaker::prompt;
      } else {
	$fastread = 1;
	*prompt = sub {
	  my($q,$a) = @_;
	  my($ret) = defined $a ? $a : "";
	  printf qq{%s [%s]\n\n}, $q, $ret;
	  $ret;
	};
      }
    }
    print qq{

The following questions are intended to help you with the
configuration. 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 $progname;
    for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){
      my $progcall = $progname;
      # we don't need ncftp if we have ncftpget
      next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
      my $path = $CPAN::Config->{$progname} 
	  || $Config::Config{$progname}
	      || "";
      if (MM->file_name_is_absolute($path)) {
	# testing existence is not good enough, some have these exe
	# extensions

	# warn "Warning: configured $path does not exist\n" unless -e $path;
	# $path = "";
      } else {
	$path = '';
      }
      unless ($path) {
	# e.g. make -> nmake
	$progcall = $Config::Config{$progname} if $Config::Config{$progname};
      }

      $path ||= find_exe($progcall,[@path]);
      warn "Warning: $progcall not found in PATH\n" unless
	  $path; # not -e $path, because find_exe already checked that
      $ans = prompt("Where is your $progname program?",$path) || $path;
      $CPAN::Config->{$progname} = $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 inactivity during Makefile.PL?",$default);

    # Proxies

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

    #
    # MIRRORED.BY
    #

    conf_sites() unless $fastread;

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

    # 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 conf_sites {
  my $m = 'MIRRORED.BY';
  my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m);
  File::Path::mkpath(File::Basename::dirname($mby));
  if (-f $mby && -f $m && -M $m < -M $mby) {
    require File::Copy;
    File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
  }
  if ( ! -f $mby ){
    print qq{You have no $mby
  I\'m trying to fetch one
};
    $mby = CPAN::FTP->localize($m,$mby,3);
  } elsif (-M $mby > 30 ) {
    print qq{Your $mby is older than 30 days,
  I\'m trying to fetch one
};
    $mby = CPAN::FTP->localize($m,$mby,3);
  }
  read_mirrored_by($mby);
}

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