[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.29 $, 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 ncftp ftp/){
      my $progcall = $progname;
	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);
09d9d230	19	$VERSION = substr q$Revision: 1.29 $, 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
5f05dabc	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
	65	};
	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;
	169	for $progname (qw/gzip tar unzip make lynx ncftp ftp/){
	170	my $progcall = $progname;
	171	my $path = $CPAN::Config->{$progname}
	172	\|\| $Config::Config{$progname}
	173	\|\| "";
55e314ee	174	if (MM->file_name_is_absolute($path)) {
09d9d230	175	# testing existence is not good enough, some have these exe
	176	# extensions
	177
	178	# warn "Warning: configured $path does not exist\n" unless -e $path;
	179	# $path = "";
55e314ee	180	} else {
	181	$path = '';
	182	}
09d9d230	183	unless ($path) {
	184	# e.g. make -> nmake
	185	$progcall = $Config::Config{$progname} if $Config::Config{$progname};
	186	}
	187
	188	$path \|\|= find_exe($progcall,[@path]);
	189	warn "Warning: $progcall not found in PATH\n" unless
	190	$path; # not -e $path, because find_exe already checked that
	191	$ans = prompt("Where is your $progname program?",$path) \|\| $path;
	192	$CPAN::Config->{$progname} = $ans;
5f05dabc	193	}
	194	my $path = $CPAN::Config->{'pager'} \|\|
	195	$ENV{PAGER} \|\| find_exe("less",[@path]) \|\|
	196	find_exe("more",[@path]) \|\| "more";
55e314ee	197	$ans = prompt("What is your favorite pager program?",$path);
5f05dabc	198	$CPAN::Config->{'pager'} = $ans;
55e314ee	199	$path = $CPAN::Config->{'shell'};
	200	if (MM->file_name_is_absolute($path)) {
	201	warn "Warning: configured $path does not exist\n" unless -e $path;
	202	$path = "";
	203	}
	204	$path \|\|= $ENV{SHELL};
13bc20ff	205	$path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
55e314ee	206	$ans = prompt("What is your favorite shell?",$path);
05454584	207	$CPAN::Config->{'shell'} = $ans;
da199366	208
	209	#
	210	# Arguments to make etc.
	211	#
	212
5f05dabc	213	print qq{
5f05dabc	214
da199366	215	Every Makefile.PL is run by perl in a separate process. Likewise we
5f05dabc	216	run \'make\' and \'make install\' in processes. If you have any parameters
	217	\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
	218	the calls, please specify them here.
	219
05454584	220	If you don\'t understand this question, just press ENTER.
05454584	221
5f05dabc	222	};
	223
	224	$default = $CPAN::Config->{makepl_arg} \|\| "";
	225	$CPAN::Config->{makepl_arg} =
	226	prompt("Parameters for the 'perl Makefile.PL' command?",$default);
	227	$default = $CPAN::Config->{make_arg} \|\| "";
	228	$CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default);
	229
	230	$default = $CPAN::Config->{make_install_arg} \|\| $CPAN::Config->{make_arg} \|\| "";
	231	$CPAN::Config->{make_install_arg} =
	232	prompt("Parameters for the 'make install' command?",$default);
	233
da199366	234	#
	235	# Alarm period
	236	#
	237
10b2abe6	238	print qq{
	239
	240	Sometimes you may wish to leave the processes run by CPAN alone
	241	without caring about them. As sometimes the Makefile.PL contains
	242	question you\'re expected to answer, you can set a timer that will
	243	kill a 'perl Makefile.PL' process after the specified time in seconds.
	244
e50380aa	245	If you set this value to 0, these processes will wait forever. This is
e50380aa	246	the default and recommended setting.
10b2abe6	247
	248	};
	249
	250	$default = $CPAN::Config->{inactivity_timeout} \|\| 0;
	251	$CPAN::Config->{inactivity_timeout} =
09d9d230	252	prompt("Timeout for inactivity during Makefile.PL?",$default);
10b2abe6	253
09d9d230	254	# Proxies
da199366	255
09d9d230	256	print qq{
10b2abe6	257
09d9d230	258	If you\'re accessing the net via proxies, you can specify them in the
	259	CPAN configuration or via environment variables. The variable in
	260	the \$CPAN::Config takes precedence.
5f05dabc	261
05454584	262	};
09d9d230	263
	264	for (qw/ftp_proxy http_proxy no_proxy/) {
	265	$default = $CPAN::Config->{$_} \|\| $ENV{$_};
	266	$CPAN::Config->{$_} = prompt("Your $_?",$default);
5f05dabc	267	}
5f05dabc	268
09d9d230	269	#
	270	# MIRRORED.BY
	271	#
	272
	273	conf_sites() unless $fastread;
	274
d4fd5c69	275	unless (@{$CPAN::Config->{'wait_list'}\|\|[]}) {
d4fd5c69	276	print qq{
da199366	277
05454584	278	WAIT support is available as a Plugin. You need the CPAN::WAIT module
	279	to actually use it. But we need to know your favorite WAIT server. If
	280	you don\'t know a WAIT server near you, just press ENTER.
	281
	282	};
d4fd5c69	283	$default = "wait://ls6.informatik.uni-dortmund.de:1404";
	284	$ans = prompt("Your favorite WAIT server?\n ",$default);
	285	push @{$CPAN::Config->{'wait_list'}}, $ans;
	286	}
05454584	287
e50380aa	288	# We don't ask that now, it will be noticed in time, won't it?
5f05dabc	289	$CPAN::Config->{'inhibit_startup_message'} = 0;
e50380aa	290	$CPAN::Config->{'getcwd'} = 'cwd';
5f05dabc	291
	292	print "\n\n";
	293	CPAN::Config->commit($configpm);
	294	}
	295
09d9d230	296	sub conf_sites {
	297	my $m = 'MIRRORED.BY';
	298	my $mby = MM->catfile($CPAN::Config->{keep_source_where},$m);
	299	File::Path::mkpath(File::Basename::dirname($mby));
	300	if (-f $mby && -f $m && -M $m < -M $mby) {
	301	require File::Copy;
	302	File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
	303	}
	304	if ( ! -f $mby ){
	305	print qq{You have no $mby
	306	I\'m trying to fetch one
	307	};
	308	$mby = CPAN::FTP->localize($m,$mby,3);
	309	} elsif (-M $mby > 30 ) {
	310	print qq{Your $mby is older than 30 days,
	311	I\'m trying to fetch one
	312	};
	313	$mby = CPAN::FTP->localize($m,$mby,3);
	314	}
	315	read_mirrored_by($mby);
	316	}
	317
5f05dabc	318	sub find_exe {
5f05dabc	319	my($exe,$path) = @_;
55e314ee	320	my($dir);
55e314ee	321	#warn "in find_exe exe[$exe] path[@$path]";
5f05dabc	322	for $dir (@$path) {
55e314ee	323	my $abs = MM->catfile($dir,$exe);
13bc20ff	324	if (($abs = MM->maybe_command($abs))) {
5f05dabc	325	return $abs;
	326	}
	327	}
	328	}
	329
	330	sub read_mirrored_by {
	331	my($local) = @_;
	332	my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
05454584	333	my $fh = FileHandle->new;
	334	$fh->open($local) or die "Couldn't open $local: $!";
	335	while (<$fh>) {
5f05dabc	336	($host) = /^([\w\.\-]+)/ unless defined $host;
	337	next unless defined $host;
	338	next unless /\s+dst_(dst\|location)/;
	339	/location\s+=\s+\"([^\"]+)/ and @location = (split /\s,\s/, $1) and
	340	($continent, $country) = @location[-1,-2];
	341	$continent =~ s/\s\(.*//;
	342	/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
	343	next unless $host && $dst && $continent && $country;
	344	$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
	345	undef $host;
	346	$dst=$continent=$country="";
	347	}
05454584	348	$fh->close;
5f05dabc	349	$CPAN::Config->{urllist} \|\|= [];
	350	if ($expected_size = @{$CPAN::Config->{urllist}}) {
	351	for $url (@{$CPAN::Config->{urllist}}) {
	352	# sanity check, scheme+colon, not "q" there:
	353	next unless $url =~ /^\w+:\/./;
	354	$all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
	355	}
	356	$CPAN::Config->{urllist} = [];
	357	} else {
	358	$expected_size = 6;
	359	}
	360
	361	print qq{
	362
	363	Now we need to know, where your favorite CPAN sites are located. Push
	364	a few sites onto the array (just in case the first on the array won\'t
	365	work). If you are mirroring CPAN to your local workstation, specify a
	366	file: URL.
	367
	368	You can enter the number in front of the URL on the next screen, a
	369	file:, ftp: or http: URL, or "q" to finish selecting.
	370
	371	};
	372
	373	$ans = prompt("Press RETURN to continue");
	374	my $other;
	375	$ans = $other = "";
	376	my(%seen);
	377
d4fd5c69	378	my $pipe = -t *STDIN ? "\| $CPAN::Config->{'pager'}" : ">/dev/null";
5f05dabc	379	while () {
5f05dabc	380	my(@valid,$previous_best);
05454584	381	my $fh = FileHandle->new;
05454584	382	$fh->open($pipe);
5f05dabc	383	{
	384	my($cont,$country,$url,$item);
	385	my(@cont) = sort keys %all;
	386	for $cont (@cont) {
09d9d230	387	$fh->print(" $cont\n");
5f05dabc	388	for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
	389	for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
	390	my $t = sprintf(
09d9d230	391	" %-16s (%2d) %s\n",
5f05dabc	392	$country,
	393	++$item,
	394	$url
	395	);
	396	if ($cont =~ /^\[/) {
	397	$previous_best \|\|= $item;
	398	}
	399	push @valid, $all{$cont}{$country}{$url};
05454584	400	$fh->print($t);
5f05dabc	401	}
	402	}
	403	}
	404	}
d4fd5c69	405	$fh->close;
09d9d230	406	$previous_best \|\|= "";
5f05dabc	407	$default =
09d9d230	408	@{$CPAN::Config->{urllist}} >=
09d9d230	409	$expected_size ? "q" : $previous_best;
5f05dabc	410	$ans = prompt(
	411	"\nSelect an$other ftp or file URL or a number (q to finish)",
	412	$default
	413	);
	414	my $sel;
	415	if ($ans =~ /^\d/) {
	416	my $this = $valid[$ans-1];
da199366	417	my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
5f05dabc	418	push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
	419	delete $all{$con}{$cou}{$url};
	420	# print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
09d9d230	421	} elsif ($ans =~ /^q/i) {
5f05dabc	422	last;
	423	} else {
	424	$ans =~ s\|/?$\|/\|; # has to end with one slash
	425	$ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
	426	if ($ans =~ /^\w+:\/./) {
	427	push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
	428	} else {
	429	print qq{"$ans" doesn\'t look like an URL at first sight.
	430	I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
	431	later and report a bug in my Makefile.PL to me (andreas koenig).
	432	Thanks.\n};
	433	}
	434	}
	435	$other \|\|= "other";
	436	}
	437	}
	438
	439	1;