[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / 5.8.0 / CPAN / FirstTime.pm

# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
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 File::Spec;
use vars qw($VERSION);
$VERSION = substr q$Revision: 1.56 $, 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;
    unless ($CPAN::VERSION) {
	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;
	$CPAN::Config->{urllist} ||= [];
	# prototype should match that of &MakeMaker::prompt
	*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} || File::Spec->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)) {
      eval { File::Path::mkpath($ans); }; # dies if it can't
      if ($@) {
	warn "Couldn't create directory $ans.
Please retry.\n";
	next;
      }
      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} = File::Spec->catdir($CPAN::Config->{cpan_home},"sources");
    $CPAN::Config->{build_dir} = File::Spec->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;

    print qq{

By default, each time the CPAN module is started, cache scanning
is performed to keep the cache size in sync. To prevent from this,
disable the cache scanning with 'never'.

};

    $default = $CPAN::Config->{scan_cache} || 'atstart';
    do {
        $ans = prompt("Perform cache scanning (atstart or never)?", $default);
    } while ($ans ne 'atstart' && $ans ne 'never');
    $CPAN::Config->{scan_cache} = $ans;

    #
    # cache_metadata
    #
    print qq{

To considerably speed up the initial CPAN shell startup, it is
possible to use Storable to create a cache of metadata. If Storable
is not available, the normal index mechanism will be used.

};

    defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
    do {
        $ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no'));
    } while ($ans !~ /^\s*[yn]/i);
    $CPAN::Config->{cache_metadata} = ($ans =~ /^\s*y/i ? 1 : 0);

    #
    # term_is_latin
    #
    print qq{

The next option deals with the charset your terminal supports. In
general CPAN is English speaking territory, thus the charset does not
matter much, but some of the aliens out there who upload their
software to CPAN bear names that are outside the ASCII range. If your
terminal supports UTF-8, you say no to the next question, if it
supports ISO-8859-1 (also known as LATIN1) then you say yes, and if it
supports neither nor, your answer does not matter, you will not be
able to read the names of some authors anyway. If you answer no, names
will be output in UTF-8.

};

    defined($default = $CPAN::Config->{term_is_latin}) or $default = 1;
    do {
        $ans = prompt("Your terminal expects ISO-8859-1 (yes/no)?",
                      ($default ? 'yes' : 'no'));
    } while ($ans !~ /^\s*[yn]/i);
    $CPAN::Config->{term_is_latin} = ($ans =~ /^\s*y/i ? 1 : 0);

    #
    # prerequisites_policy
    # Do we follow PREREQ_PM?
    #
    print qq{

The CPAN module can detect when a module that which you are trying to
build depends on prerequisites. If this happens, it can build the
prerequisites for you automatically ('follow'), ask you for
confirmation ('ask'), or just ignore them ('ignore'). Please set your
policy to one of the three values.

};

    $default = $CPAN::Config->{prerequisites_policy} || 'ask';
    do {
      $ans =
	  prompt("Policy on building prerequisites (follow, ask or ignore)?",
		 $default);
    } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
    $CPAN::Config->{prerequisites_policy} = $ans;

    #
    # 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. To
disable the use of a download program, you can type a space followed
by ENTER.

};

    my $old_warn = $^W;
    local $^W if $^O eq 'MacOS';
    my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
    local $^W = $old_warn;
    my $progname;
    for $progname (qw/gzip tar unzip make lynx wget ncftpget ncftp ftp/){
      if ($^O eq 'MacOS') {
          $CPAN::Config->{$progname} = 'not_here';
          next;
      }
      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 (File::Spec->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]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
	    || "more";
    $ans = prompt("What is your favorite pager program?",$path);
    $CPAN::Config->{'pager'} = $ans;
    $path = $CPAN::Config->{'shell'};
    if (File::Spec->file_name_is_absolute($path)) {
	warn "Warning: configured $path does not exist\n" unless -e $path;
	$path = "";
    }
    $path ||= $ENV{SHELL};
    if ($^O eq 'MacOS') {
        $CPAN::Config->{'shell'} = 'not_here';
    } else {
        $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, LIB, 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?
Typical frequently used settings:

    POLLUTE=1        increasing backwards compatibility
    LIB=~/perl       non-root users (please see manual for more hints)

Your choice: ",$default);
    $default = $CPAN::Config->{make_arg} || "";
    $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?
Typical frequently used setting:

    -j3              dual processor system

Your choice: ",$default);

    $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || "";
    $CPAN::Config->{make_install_arg} =
	prompt("Parameters for the 'make install' command?
Typical frequently used setting:

    UNINST=1         to always uninstall potentially conflicting files

Your choice: ",$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);
    }

    if ($CPAN::Config->{ftp_proxy} ||
        $CPAN::Config->{http_proxy}) {
        $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER;
        print qq{

If your proxy is an authenticating proxy, you can store your username
permanently. If you do not want that, just press RETURN. You will then
be asked for your username in every future session.

};
        if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
            print qq{

Your password for the authenticating proxy can also be stored
permanently on disk. If this violates your security policy, just press
RETURN. You will then be asked for the password in every future
session.

};

            if ($CPAN::META->has_inst("Term::ReadKey")) {
                Term::ReadKey::ReadMode("noecho");
            } else {
                print qq{

Warning: Term::ReadKey seems not to be available, your password will
be echoed to the terminal!

};
            }
            $CPAN::Config->{proxy_pass} = prompt("Your proxy password?");
            if ($CPAN::META->has_inst("Term::ReadKey")) {
                Term::ReadKey::ReadMode("restore");
            }
            $CPAN::Frontend->myprint("\n\n");
        }
    }

    #
    # 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-www.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 = File::Spec->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: $!";
  }
  my $loopcount = 0;
  local $^T = time;
  my $overwrite_local = 0;
  if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
      my $mtime = localtime((stat _)[9]);
      my $prompt = qq{Found $mby as of $mtime

I\'d use that as a database of CPAN sites. If that is OK for you,
please answer 'y', but if you want me to get a new database now,
please answer 'n' to the following question.

Shall I use the local database in $mby?};
      my $ans = prompt($prompt,"y");
      $overwrite_local = 1 unless $ans =~ /^y/i;
  }
  while ($mby) {
    if ($overwrite_local) {
      print qq{Trying to overwrite $mby
};
      $mby = CPAN::FTP->localize($m,$mby,3);
      $overwrite_local = 0;
    } elsif ( ! -f $mby ){
      print qq{You have no $mby
  I\'m trying to fetch one
};
      $mby = CPAN::FTP->localize($m,$mby,3);
    } elsif (-M $mby > 60 && $loopcount == 0) {
      print qq{Your $mby is older than 60 days,
  I\'m trying to fetch one
};
      $mby = CPAN::FTP->localize($m,$mby,3);
      $loopcount++;
    } elsif (-s $mby == 0) {
      print qq{You have an empty $mby,
  I\'m trying to fetch one
};
      $mby = CPAN::FTP->localize($m,$mby,3);
    } else {
      last;
    }
  }
  read_mirrored_by($mby);
  bring_your_own();
}

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

sub picklist {
    my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
    $default ||= '';

	my $pos = 0;

    my @nums;
    while (1) {

		# display, at most, 15 items at a time
		my $limit = $#{ $items } - $pos;
		$limit = 15 if $limit > 15;

		# show the next $limit items, get the new position
		$pos = display_some($items, $limit, $pos);
		$pos = 0 if $pos >= @$items;

		my $num = prompt($prompt,$default);
		
		@nums = split (' ', $num);
		my $i = scalar @$items;
		(warn "invalid items entered, try again\n"), next
		    if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
		if ($require_nonempty) {
		    (warn "$empty_warning\n");
		}
    	print "\n";

		# a blank line continues...
		next unless @nums;
		last;
    }
    for (@nums) { $_-- }
    @{$items}[@nums];
}

sub display_some {
	my ($items, $limit, $pos) = @_;
	$pos ||= 0;

	my @displayable = @$items[$pos .. ($pos + $limit)];
    for my $item (@displayable) {
		printf "(%d) %s\n", ++$pos, $item;
    }
	printf "%d more items, hit ENTER\n", (@$items - $pos) if $pos < @$items;
	return $pos;
}

sub read_mirrored_by {
    my $local = shift or return;
    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: $!";
    local $/ = "\012";
    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\(.*//;
	$continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
	/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} ||= [];
    my(@previous_urls);
    if (@previous_urls = @{$CPAN::Config->{urllist}}) {
	$CPAN::Config->{urllist} = [];
    }

    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.

First, pick a nearby continent and country (you can pick several of
each, separated by spaces, or none if you just want to keep your
existing selections). Then, you will be presented with a list of URLs
of CPAN mirrors in the countries you selected, along with previously
selected URLs. Select some of those URLs, or just keep the old list.
Finally, you will be prompted for any extra URLs -- file:, ftp:, or
http: -- that host a CPAN mirror.

};

    my (@cont, $cont, %cont, @countries, @urls, %seen);
    my $no_previous_warn = 
       "Sorry! since you don't have any existing picks, you must make a\n" .
       "geographic selection.";
    @cont = picklist([sort keys %all],
                     "Select your continent (or several nearby continents)",
                     '',
                     ! @previous_urls,
                     $no_previous_warn);


    foreach $cont (@cont) {
        my @c = sort keys %{$all{$cont}};
        @cont{@c} = map ($cont, 0..$#c);
        @c = map ("$_ ($cont)", @c) if @cont > 1;
        push (@countries, @c);
    }

    if (@countries) {
        @countries = picklist (\@countries,
                               "Select your country (or several nearby countries)",
                               '',
                               ! @previous_urls,
                               $no_previous_warn);
        %seen = map (($_ => 1), @previous_urls);
        # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
        foreach $country (@countries) {
            (my $bare_country = $country) =~ s/ \(.*\)//;
            my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
            @u = grep (! $seen{$_}, @u);
            @u = map ("$_ ($bare_country)", @u)
               if @countries > 1;
            push (@urls, @u);
        }
    }
    push (@urls, map ("$_ (previous pick)", @previous_urls));
    my $prompt = "Select as many URLs as you like,
put them on one line, separated by blanks";
    if (@previous_urls) {
       $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
                             (scalar @urls));
       $prompt .= "\n(or just hit RETURN to keep your previous picks)";
    }

    @urls = picklist (\@urls, $prompt, $default);
    foreach (@urls) { s/ \(.*\)//; }
    push @{$CPAN::Config->{urllist}}, @urls;
}

sub bring_your_own {
    my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
    my($ans,@urls);
    do {
	my $prompt = "Enter another URL or RETURN to quit:";
	unless (%seen) {
	    $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.

Please enter your CPAN site:};
	}
        $ans = prompt ($prompt, "");

        if ($ans) {
            $ans =~ s|/?\z|/|; # has to end with one slash
            $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
            if ($ans =~ /^\w+:\/./) {
                push @urls, $ans unless $seen{$ans}++;
            } else {
                printf(qq{"%s" doesn\'t look like an URL at first sight.
I\'ll ignore it for now.
You can add it to your %s
later if you\'re sure it\'s right.\n},
                       $ans,
                       $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file",
                      );
            }
        }
    } while $ans || !%seen;

    push @{$CPAN::Config->{urllist}}, @urls;
    # xxx delete or comment these out when you're happy that it works
    print "New set of picks:\n";
    map { print "  $_\n" } @{$CPAN::Config->{urllist}};
}

1;
Commit	Line	Data
86530b38 AT	1	# -- Mode: cperl; coding: utf-8; cperl-indent-level: 4 --
	2	package CPAN::Mirrored::By;
	3
	4	sub new {
	5	my($self,@arg) = @_;
	6	bless [@arg], $self;
	7	}
	8	sub continent { shift->[0] }
	9	sub country { shift->[1] }
	10	sub url { shift->[2] }
	11
	12	package CPAN::FirstTime;
	13
	14	use strict;
	15	use ExtUtils::MakeMaker qw(prompt);
	16	use FileHandle ();
	17	use File::Basename ();
	18	use File::Path ();
	19	use File::Spec;
	20	use vars qw($VERSION);
	21	$VERSION = substr q$Revision: 1.56 $, 10;
	22
	23	=head1 NAME
	24
	25	CPAN::FirstTime - Utility for CPAN::Config file Initialization
	26
	27	=head1 SYNOPSIS
	28
	29	CPAN::FirstTime::init()
	30
	31	=head1 DESCRIPTION
	32
	33	The init routine asks a few questions and writes a CPAN::Config
	34	file. Nothing special.
	35
	36	=cut
	37
	38
	39	sub init {
	40	my($configpm) = @_;
	41	use Config;
	42	unless ($CPAN::VERSION) {
	43	require CPAN::Nox;
	44	}
	45	eval {require CPAN::Config;};
	46	$CPAN::Config \|\|= {};
	47	local($/) = "\n";
	48	local($\) = "";
	49	local($\|) = 1;
	50
	51	my($ans,$default,$local,$cont,$url,$expected_size);
	52
	53	#
	54	# Files, directories
	55	#
	56
	57	print qq[
	58
	59	CPAN is the world-wide archive of perl resources. It consists of about
	60	100 sites that all replicate the same contents all around the globe.
	61	Many countries have at least one CPAN site already. The resources
	62	found on CPAN are easily accessible with the CPAN.pm module. If you
	63	want to use CPAN.pm, you have to configure it properly.
	64
65	If you do not want to enter a dialog now, you can answer 'no' to this
66	question and I\'ll try to autoconfigure. (Note: you can revisit this
67	dialog anytime later by typing 'o conf init' at the cpan prompt.)
68
69	];
70
71	my $manual_conf =
72	ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
73	"yes");
74	my $fastread;
75	{
76	local $^W;
77	if ($manual_conf =~ /^\s*y/i) {
78	$fastread = 0;
79	*prompt = \&ExtUtils::MakeMaker::prompt;
80	} else {
81	$fastread = 1;
82	$CPAN::Config->{urllist} \|\|= [];
83	# prototype should match that of &MakeMaker::prompt
84	*prompt = sub ($;$) {
85	my($q,$a) = @_;
86	my($ret) = defined $a ? $a : "";
87	printf qq{%s [%s]\n\n}, $q, $ret;
88	$ret;
89	};
90	}
91	}
92	print qq{
93
94	The following questions are intended to help you with the
95	configuration. The CPAN module needs a directory of its own to cache
96	important index files and maybe keep a temporary mirror of CPAN files.
97	This may be a site-wide directory or a personal directory.
98
99	};
100
101	my $cpan_home = $CPAN::Config->{cpan_home} \|\| File::Spec->catdir($ENV{HOME}, ".cpan");
102	if (-d $cpan_home) {
103	print qq{
104
105	I see you already have a directory
106	$cpan_home
107	Shall we use it as the general CPAN build and cache directory?
108
109	};
110	} else {
111	print qq{
112
113	First of all, I\'d like to create this directory. Where?
114
115	};
116	}
117
118	$default = $cpan_home;
119	while ($ans = prompt("CPAN build and cache directory?",$default)) {
120	eval { File::Path::mkpath($ans); }; # dies if it can't
121	if ($@) {
122	warn "Couldn't create directory $ans.
123	Please retry.\n";
124	next;
125	}
126	if (-d $ans && -w _) {
127	last;
128	} else {
129	warn "Couldn't find directory $ans
130	or directory is not writable. Please retry.\n";
131	}
132	}
133	$CPAN::Config->{cpan_home} = $ans;
134
135	print qq{
136
137	If you want, I can keep the source files after a build in the cpan
138	home directory. If you choose so then future builds will take the
139	files from there. If you don\'t want to keep them, answer 0 to the
140	next question.
141
142	};
143
144	$CPAN::Config->{keep_source_where} = File::Spec->catdir($CPAN::Config->{cpan_home},"sources");
145	$CPAN::Config->{build_dir} = File::Spec->catdir($CPAN::Config->{cpan_home},"build");
146
147	#
148	# Cache size, Index expire
149	#
150
151	print qq{
152
153	How big should the disk cache be for keeping the build directories
154	with all the intermediate files\?
155
156	};
157
158	$default = $CPAN::Config->{build_cache} \|\| 10;
159	$ans = prompt("Cache size for build directory (in MB)?", $default);
160	$CPAN::Config->{build_cache} = $ans;
161
162	# XXX This the time when we refetch the index files (in days)
163	$CPAN::Config->{'index_expire'} = 1;
164
165	print qq{
166
167	By default, each time the CPAN module is started, cache scanning
168	is performed to keep the cache size in sync. To prevent from this,
169	disable the cache scanning with 'never'.
170
171	};
172
173	$default = $CPAN::Config->{scan_cache} \|\| 'atstart';
174	do {
175	$ans = prompt("Perform cache scanning (atstart or never)?", $default);
176	} while ($ans ne 'atstart' && $ans ne 'never');
177	$CPAN::Config->{scan_cache} = $ans;
178
179	#
180	# cache_metadata
181	#
182	print qq{
183
184	To considerably speed up the initial CPAN shell startup, it is
185	possible to use Storable to create a cache of metadata. If Storable
186	is not available, the normal index mechanism will be used.
187
188	};
189
190	defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
191	do {
192	$ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no'));
193	} while ($ans !~ /^\s*[yn]/i);
194	$CPAN::Config->{cache_metadata} = ($ans =~ /^\s*y/i ? 1 : 0);
195
196	#
197	# term_is_latin
198	#
199	print qq{
200
201	The next option deals with the charset your terminal supports. In
202	general CPAN is English speaking territory, thus the charset does not
203	matter much, but some of the aliens out there who upload their
204	software to CPAN bear names that are outside the ASCII range. If your
205	terminal supports UTF-8, you say no to the next question, if it
206	supports ISO-8859-1 (also known as LATIN1) then you say yes, and if it
207	supports neither nor, your answer does not matter, you will not be
208	able to read the names of some authors anyway. If you answer no, names
209	will be output in UTF-8.
210
211	};
212
213	defined($default = $CPAN::Config->{term_is_latin}) or $default = 1;
214	do {
215	$ans = prompt("Your terminal expects ISO-8859-1 (yes/no)?",
216	($default ? 'yes' : 'no'));
217	} while ($ans !~ /^\s*[yn]/i);
218	$CPAN::Config->{term_is_latin} = ($ans =~ /^\s*y/i ? 1 : 0);
219
220	#
221	# prerequisites_policy
222	# Do we follow PREREQ_PM?
223	#
224	print qq{
225
226	The CPAN module can detect when a module that which you are trying to
227	build depends on prerequisites. If this happens, it can build the
228	prerequisites for you automatically ('follow'), ask you for
229	confirmation ('ask'), or just ignore them ('ignore'). Please set your
230	policy to one of the three values.
231
232	};
233
234	$default = $CPAN::Config->{prerequisites_policy} \|\| 'ask';
235	do {
236	$ans =
237	prompt("Policy on building prerequisites (follow, ask or ignore)?",
238	$default);
239	} while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
240	$CPAN::Config->{prerequisites_policy} = $ans;
241
242	#
243	# External programs
244	#
245
246	print qq{
247
248	The CPAN module will need a few external programs to work properly.
249	Please correct me, if I guess the wrong path for a program. Don\'t
250	panic if you do not have some of them, just press ENTER for those. To
251	disable the use of a download program, you can type a space followed
252	by ENTER.
253
254	};
255
256	my $old_warn = $^W;
257	local $^W if $^O eq 'MacOS';
258	my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
259	local $^W = $old_warn;
260	my $progname;
261	for $progname (qw/gzip tar unzip make lynx wget ncftpget ncftp ftp/){
262	if ($^O eq 'MacOS') {
263	$CPAN::Config->{$progname} = 'not_here';
264	next;
265	}
266	my $progcall = $progname;
267	# we don't need ncftp if we have ncftpget
268	next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
269	my $path = $CPAN::Config->{$progname}
270	\|\| $Config::Config{$progname}
271	\|\| "";
272	if (File::Spec->file_name_is_absolute($path)) {
273	# testing existence is not good enough, some have these exe
274	# extensions
275
276	# warn "Warning: configured $path does not exist\n" unless -e $path;
277	# $path = "";
278	} else {
279	$path = '';
280	}
281	unless ($path) {
282	# e.g. make -> nmake
283	$progcall = $Config::Config{$progname} if $Config::Config{$progname};
284	}
285
286	$path \|\|= find_exe($progcall,[@path]);
287	warn "Warning: $progcall not found in PATH\n" unless
288	$path; # not -e $path, because find_exe already checked that
289	$ans = prompt("Where is your $progname program?",$path) \|\| $path;
290	$CPAN::Config->{$progname} = $ans;
291	}
292	my $path = $CPAN::Config->{'pager'} \|\|
293	$ENV{PAGER} \|\| find_exe("less",[@path]) \|\|
294	find_exe("more",[@path]) \|\| ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
295	\|\| "more";
296	$ans = prompt("What is your favorite pager program?",$path);
297	$CPAN::Config->{'pager'} = $ans;
298	$path = $CPAN::Config->{'shell'};
299	if (File::Spec->file_name_is_absolute($path)) {
300	warn "Warning: configured $path does not exist\n" unless -e $path;
301	$path = "";
302	}
303	$path \|\|= $ENV{SHELL};
304	if ($^O eq 'MacOS') {
305	$CPAN::Config->{'shell'} = 'not_here';
306	} else {
307	$path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
308	$ans = prompt("What is your favorite shell?",$path);
309	$CPAN::Config->{'shell'} = $ans;
310	}
311
312	#
313	# Arguments to make etc.
314	#
315
316	print qq{
317
318	Every Makefile.PL is run by perl in a separate process. Likewise we
319	run \'make\' and \'make install\' in processes. If you have any
320	parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to pass
321	to the calls, please specify them here.
322
323	If you don\'t understand this question, just press ENTER.
324
325	};
326
327	$default = $CPAN::Config->{makepl_arg} \|\| "";
328	$CPAN::Config->{makepl_arg} =
329	prompt("Parameters for the 'perl Makefile.PL' command?
330	Typical frequently used settings:
331
332	POLLUTE=1 increasing backwards compatibility
333	LIB=~/perl non-root users (please see manual for more hints)
334
335	Your choice: ",$default);
336	$default = $CPAN::Config->{make_arg} \|\| "";
337	$CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?
338	Typical frequently used setting:
339
340	-j3 dual processor system
341
342	Your choice: ",$default);
343
344	$default = $CPAN::Config->{make_install_arg} \|\| $CPAN::Config->{make_arg} \|\| "";
345	$CPAN::Config->{make_install_arg} =
346	prompt("Parameters for the 'make install' command?
347	Typical frequently used setting:
348
349	UNINST=1 to always uninstall potentially conflicting files
350
351	Your choice: ",$default);
352
353	#
354	# Alarm period
355	#
356
357	print qq{
358
359	Sometimes you may wish to leave the processes run by CPAN alone
360	without caring about them. As sometimes the Makefile.PL contains
361	question you\'re expected to answer, you can set a timer that will
362	kill a 'perl Makefile.PL' process after the specified time in seconds.
363
364	If you set this value to 0, these processes will wait forever. This is
365	the default and recommended setting.
366
367	};
368
369	$default = $CPAN::Config->{inactivity_timeout} \|\| 0;
370	$CPAN::Config->{inactivity_timeout} =
371	prompt("Timeout for inactivity during Makefile.PL?",$default);
372
373	# Proxies
374
375	print qq{
376
377	If you\'re accessing the net via proxies, you can specify them in the
378	CPAN configuration or via environment variables. The variable in
379	the \$CPAN::Config takes precedence.
380
381	};
382
383	for (qw/ftp_proxy http_proxy no_proxy/) {
384	$default = $CPAN::Config->{$_} \|\| $ENV{$_};
385	$CPAN::Config->{$_} = prompt("Your $_?",$default);
386	}
387
388	if ($CPAN::Config->{ftp_proxy} \|\|
389	$CPAN::Config->{http_proxy}) {
390	$default = $CPAN::Config->{proxy_user} \|\| $CPAN::LWP::UserAgent::USER;
391	print qq{
392
393	If your proxy is an authenticating proxy, you can store your username
394	permanently. If you do not want that, just press RETURN. You will then
395	be asked for your username in every future session.
396
397	};
398	if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
399	print qq{
400
401	Your password for the authenticating proxy can also be stored
402	permanently on disk. If this violates your security policy, just press
403	RETURN. You will then be asked for the password in every future
404	session.
405
406	};
407
408	if ($CPAN::META->has_inst("Term::ReadKey")) {
409	Term::ReadKey::ReadMode("noecho");
410	} else {
411	print qq{
412
413	Warning: Term::ReadKey seems not to be available, your password will
414	be echoed to the terminal!
415
416	};
417	}
418	$CPAN::Config->{proxy_pass} = prompt("Your proxy password?");
419	if ($CPAN::META->has_inst("Term::ReadKey")) {
420	Term::ReadKey::ReadMode("restore");
421	}
422	$CPAN::Frontend->myprint("\n\n");
423	}
424	}
425
426	#
427	# MIRRORED.BY
428	#
429
430	conf_sites() unless $fastread;
431
432	unless (@{$CPAN::Config->{'wait_list'}\|\|[]}) {
433	print qq{
434
435	WAIT support is available as a Plugin. You need the CPAN::WAIT module
436	to actually use it. But we need to know your favorite WAIT server. If
437	you don\'t know a WAIT server near you, just press ENTER.
438
439	};
440	$default = "wait://ls6-www.informatik.uni-dortmund.de:1404";
441	$ans = prompt("Your favorite WAIT server?\n ",$default);
442	push @{$CPAN::Config->{'wait_list'}}, $ans;
443	}
444
445	# We don't ask that now, it will be noticed in time, won't it?
446	$CPAN::Config->{'inhibit_startup_message'} = 0;
447	$CPAN::Config->{'getcwd'} = 'cwd';
448
449	print "\n\n";
450	CPAN::Config->commit($configpm);
451	}
452
453	sub conf_sites {
454	my $m = 'MIRRORED.BY';
455	my $mby = File::Spec->catfile($CPAN::Config->{keep_source_where},$m);
456	File::Path::mkpath(File::Basename::dirname($mby));
457	if (-f $mby && -f $m && -M $m < -M $mby) {
458	require File::Copy;
459	File::Copy::copy($m,$mby) or die "Could not update $mby: $!";
460	}
461	my $loopcount = 0;
462	local $^T = time;
463	my $overwrite_local = 0;
464	if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) {
465	my $mtime = localtime((stat _)[9]);
466	my $prompt = qq{Found $mby as of $mtime
467
468	I\'d use that as a database of CPAN sites. If that is OK for you,
469	please answer 'y', but if you want me to get a new database now,
470	please answer 'n' to the following question.
471
472	Shall I use the local database in $mby?};
473	my $ans = prompt($prompt,"y");
474	$overwrite_local = 1 unless $ans =~ /^y/i;
475	}
476	while ($mby) {
477	if ($overwrite_local) {
478	print qq{Trying to overwrite $mby
479	};
480	$mby = CPAN::FTP->localize($m,$mby,3);
481	$overwrite_local = 0;
482	} elsif ( ! -f $mby ){
483	print qq{You have no $mby
484	I\'m trying to fetch one
485	};
486	$mby = CPAN::FTP->localize($m,$mby,3);
487	} elsif (-M $mby > 60 && $loopcount == 0) {
488	print qq{Your $mby is older than 60 days,
489	I\'m trying to fetch one
490	};
491	$mby = CPAN::FTP->localize($m,$mby,3);
492	$loopcount++;
493	} elsif (-s $mby == 0) {
494	print qq{You have an empty $mby,
495	I\'m trying to fetch one
496	};
497	$mby = CPAN::FTP->localize($m,$mby,3);
498	} else {
499	last;
500	}
501	}
502	read_mirrored_by($mby);
503	bring_your_own();
504	}
505
506	sub find_exe {
507	my($exe,$path) = @_;
508	my($dir);
509	#warn "in find_exe exe[$exe] path[@$path]";
510	for $dir (@$path) {
511	my $abs = File::Spec->catfile($dir,$exe);
512	if (($abs = MM->maybe_command($abs))) {
513	return $abs;
514	}
515	}
516	}
517
518	sub picklist {
519	my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
520	$default \|\|= '';
521
522	my $pos = 0;
523
524	my @nums;
525	while (1) {
526
527	# display, at most, 15 items at a time
528	my $limit = $#{ $items } - $pos;
529	$limit = 15 if $limit > 15;
530
531	# show the next $limit items, get the new position
532	$pos = display_some($items, $limit, $pos);
533	$pos = 0 if $pos >= @$items;
534
535	my $num = prompt($prompt,$default);
536
537	@nums = split (' ', $num);
538	my $i = scalar @$items;
539	(warn "invalid items entered, try again\n"), next
540	if grep (/\D/ \|\| $_ < 1 \|\| $_ > $i, @nums);
541	if ($require_nonempty) {
542	(warn "$empty_warning\n");
543	}
544	print "\n";
545
546	# a blank line continues...
547	next unless @nums;
548	last;
549	}
550	for (@nums) { $_-- }
551	@{$items}[@nums];
552	}
553
554	sub display_some {
555	my ($items, $limit, $pos) = @_;
556	$pos \|\|= 0;
557
558	my @displayable = @$items[$pos .. ($pos + $limit)];
559	for my $item (@displayable) {
560	printf "(%d) %s\n", ++$pos, $item;
561	}
562	printf "%d more items, hit ENTER\n", (@$items - $pos) if $pos < @$items;
563	return $pos;
564	}
565
566	sub read_mirrored_by {
567	my $local = shift or return;
568	my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
569	my $fh = FileHandle->new;
570	$fh->open($local) or die "Couldn't open $local: $!";
571	local $/ = "\012";
572	while (<$fh>) {
573	($host) = /^([\w\.\-]+)/ unless defined $host;
574	next unless defined $host;
575	next unless /\s+dst_(dst\|location)/;
576	/location\s+=\s+\"([^\"]+)/ and @location = (split /\s,\s/, $1) and
577	($continent, $country) = @location[-1,-2];
578	$continent =~ s/\s\(.*//;
579	$continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
580	/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
581	next unless $host && $dst && $continent && $country;
582	$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
583	undef $host;
584	$dst=$continent=$country="";
585	}
586	$fh->close;
587	$CPAN::Config->{urllist} \|\|= [];
588	my(@previous_urls);
589	if (@previous_urls = @{$CPAN::Config->{urllist}}) {
590	$CPAN::Config->{urllist} = [];
591	}
592
593	print qq{
594
595	Now we need to know where your favorite CPAN sites are located. Push
596	a few sites onto the array (just in case the first on the array won\'t
597	work). If you are mirroring CPAN to your local workstation, specify a
598	file: URL.
599
600	First, pick a nearby continent and country (you can pick several of
601	each, separated by spaces, or none if you just want to keep your
602	existing selections). Then, you will be presented with a list of URLs
603	of CPAN mirrors in the countries you selected, along with previously
604	selected URLs. Select some of those URLs, or just keep the old list.
605	Finally, you will be prompted for any extra URLs -- file:, ftp:, or
606	http: -- that host a CPAN mirror.
607
608	};
609
610	my (@cont, $cont, %cont, @countries, @urls, %seen);
611	my $no_previous_warn =
612	"Sorry! since you don't have any existing picks, you must make a\n" .
613	"geographic selection.";
614	@cont = picklist([sort keys %all],
615	"Select your continent (or several nearby continents)",
616	'',
617	! @previous_urls,
618	$no_previous_warn);
619
620
621	foreach $cont (@cont) {
622	my @c = sort keys %{$all{$cont}};
623	@cont{@c} = map ($cont, 0..$#c);
624	@c = map ("$_ ($cont)", @c) if @cont > 1;
625	push (@countries, @c);
626	}
627
628	if (@countries) {
629	@countries = picklist (\@countries,
630	"Select your country (or several nearby countries)",
631	'',
632	! @previous_urls,
633	$no_previous_warn);
634	%seen = map (($_ => 1), @previous_urls);
635	# hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
636	foreach $country (@countries) {
637	(my $bare_country = $country) =~ s/ \(.*\)//;
638	my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
639	@u = grep (! $seen{$_}, @u);
640	@u = map ("$_ ($bare_country)", @u)
641	if @countries > 1;
642	push (@urls, @u);
643	}
644	}
645	push (@urls, map ("$_ (previous pick)", @previous_urls));
646	my $prompt = "Select as many URLs as you like,
647	put them on one line, separated by blanks";
648	if (@previous_urls) {
649	$default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
650	(scalar @urls));
651	$prompt .= "\n(or just hit RETURN to keep your previous picks)";
652	}
653
654	@urls = picklist (\@urls, $prompt, $default);
655	foreach (@urls) { s/ \(.*\)//; }
656	push @{$CPAN::Config->{urllist}}, @urls;
657	}
658
659	sub bring_your_own {
660	my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}});
661	my($ans,@urls);
662	do {
663	my $prompt = "Enter another URL or RETURN to quit:";
664	unless (%seen) {
665	$prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from.
666
667	Please enter your CPAN site:};
668	}
669	$ans = prompt ($prompt, "");
670
671	if ($ans) {
672	$ans =~ s\|/?\z\|/\|; # has to end with one slash
673	$ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
674	if ($ans =~ /^\w+:\/./) {
675	push @urls, $ans unless $seen{$ans}++;
676	} else {
677	printf(qq{"%s" doesn\'t look like an URL at first sight.
678	I\'ll ignore it for now.
679	You can add it to your %s
680	later if you\'re sure it\'s right.\n},
681	$ans,
682	$INC{'CPAN/MyConfig.pm'} \|\| $INC{'CPAN/Config.pm'} \|\| "configuration file",
683	);
684	}
685	}
686	} while $ans \|\| !%seen;
687
688	push @{$CPAN::Config->{urllist}}, @urls;
689	# xxx delete or comment these out when you're happy that it works
690	print "New set of picks:\n";
691	map { print " $_\n" } @{$CPAN::Config->{urllist}};
692	}
693
694	1;