# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
sub new {
}
use strict;
use FileHandle ();
use vars qw($VERSION);
=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;
}
local($/) = "\n";
local($\) = "";
local($|) = 1;
#
# Files, directories
#
print qq[
question and I\'ll try to autoconfigure. (Note: you can revisit this
];
my $manual_conf =
"yes");
my $fastread;
{
local $^W;
if ($manual_conf =~ /^\s*y/i) {
$fastread = 0;
} else {
$fastread = 1;
# 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{
};
if (-d $cpan_home) {
print qq{
};
} else {
print qq{
};
}
require Cwd;
warn "The path '$ans' is not an absolute path. Please specify an absolute path\n";
next;
}
if ($@) {
warn "Couldn't create directory $ans.
next;
}
if (-d $ans && -w _) {
last;
} else {
warn "Couldn't find directory $ans
}
}
print qq{
next question.
};
#
# Cache size, Index expire
#
print qq{
};
# XXX This the time when we refetch the index files (in days)
print qq{
};
do {
#
# cache_metadata
#
print qq{
};
do {
#
# term_is_latin
#
print qq{
};
do {
#
# save history in file histfile
#
print qq{
};
$ans =~ s/^\s+//;
$ans =~ s/\s+\z//;
}
#
# prerequisites_policy
# Do we follow PREREQ_PM?
#
print qq{
};
do {
$ans =
prompt("Policy on building prerequisites (follow, ask or ignore)?",
$default);
#
# External programs
#
print qq{
};
my $old_warn = $^W;
local $^W if $^O eq 'MacOS';
local $^W = $old_warn;
my $progname;
if ($^O eq 'MacOS') {
next;
}
# we don't need ncftp if we have ncftpget
|| "";
# 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
}
warn "Warning: $progcall not found in PATH\n" unless
$path; # not -e $path, because find_exe already checked that
}
|| "more";
warn "Warning: configured $path does not exist\n" unless -e $path;
$path = "";
}
if ($^O eq 'MacOS') {
} else {
}
#
# Arguments to make etc.
#
print qq{
run \'make\' and \'make install\' in processes. If you have any
};
prompt("Parameters for the 'perl Makefile.PL' command?
prompt("Parameters for the 'make install' command?
#
# Alarm period
#
print qq{
};
# Proxies
print qq{
};
}
print qq{
};
print qq{
};
} else {
print qq{
};
}
}
}
}
#
# MIRRORED.BY
#
conf_sites() unless $fastread;
# We don't ask that now, it will be noticed in time, won't it?
print "\n\n";
}
sub conf_sites {
my $m = 'MIRRORED.BY';
}
my $loopcount = 0;
local $^T = time;
my $overwrite_local = 0;
my $mtime = localtime((stat _)[9]);
I\'d use that as a database of CPAN sites. If that is OK for you,
}
while ($mby) {
if ($overwrite_local) {
};
$overwrite_local = 0;
} elsif ( ! -f $mby ){
I\'m trying to fetch one
};
I\'m trying to fetch one
};
$loopcount++;
} elsif (-s $mby == 0) {
I\'m trying to fetch one
};
} else {
last;
}
}
}
sub find_exe {
my($dir);
#warn "in find_exe exe[$exe] path[@$path]";
return $abs;
}
}
}
sub picklist {
$default ||= '';
my $pos = 0;
my @nums;
while (1) {
# display, at most, 15 items at a time
my $limit = $#{ $items } - $pos;
# show the next $limit items, get the new position
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) { $_-- }
}
sub display_some {
$pos ||= 0;
for my $item (@displayable) {
}
printf("%d more items, hit SPACE RETURN to show them\n",
)
return $pos;
}
sub read_mirrored_by {
my $local = shift or return;
my $fh = FileHandle->new;
local $/ = "\012";
while (<$fh>) {
next unless defined $host;
/location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
$continent =~ s/\s\(.*//;
/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
undef $host;
}
$fh->close;
my(@previous_urls);
}
print qq{
};
my $no_previous_warn =
"Sorry! since you don't have any existing picks, you must make a\n" .
"geographic selection.";
"Select your continent (or several nearby continents)",
'',
! @previous_urls,
push (@countries, @c);
}
if (@countries) {
"Select your country (or several nearby countries)",
'',
! @previous_urls,
# hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
(my $bare_country = $country) =~ s/ \(.*\)//;
@u = grep (! $seen{$_}, @u);
@u = map ("$_ ($bare_country)", @u)
if @countries > 1;
push (@urls, @u);
}
}
my $prompt = "Select as many URLs as you like (by number),
if (@previous_urls) {
(scalar @urls));
$prompt .= "\n(or just hit RETURN to keep your previous picks)";
}
foreach (@urls) { s/ \(.*\)//; }
}
sub bring_your_own {
do {
my $prompt = "Enter another URL or RETURN to quit:";
unless (%seen) {
}
if ($ans) {
$ans =~ s/^\s+//; # no leading spaces
$ans =~ s/\s+\z//; # no trailing spaces
$ans =~ s|/?\z|/|; # has to end with one slash
if ($ans =~ /^\w+:\/./) {
} else {
I\'ll ignore it for now.
$ans,
);
}
}
# xxx delete or comment these out when you're happy that it works
print "New set of picks:\n";
}
1;