firsttime.pm

MSYS在windows下模拟了一个类unix的终端

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.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: $!";
  }
  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 = MM->catfile($dir,$exe);
	if (($abs = MM->maybe_command($abs))) {
	    return $abs;
	}
    }
}

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

    my ($item, $i);
    for $item (@$items) {
	printf "(%d) %s\n", ++$i, $item;
    }

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

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;