use File::Path ();
use File::Spec ();
use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 1669 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2229 $,4)/1000000 + 5.4;
=head1 NAME
The init routine asks a few questions and writes a CPAN/Config.pm or
CPAN/MyConfig.pm file (depending on what it is currently using).
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+In the following all questions and explanations regarding config
+variables are collected.
=cut
-use vars qw( %prompts );
+# down until the next =back the manpage must be parsed by the program
+# because the text is used in the init dialogues.
-sub init {
- my($configpm, %args) = @_;
- use Config;
- # extra args after 'o conf init'
- my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
- if ($matcher =~ /^\/(.*)\/$/) {
- # case /regex/ => take the first, ignore the rest
- $matcher = $1;
- shift @{$args{args}};
- if (@{$args{args}}) {
- local $" = " ";
- $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
- $CPAN::Frontend->mysleep(2);
- }
- } elsif (0 == length $matcher) {
- } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
- my @unconfigured = grep { not exists $CPAN::Config->{$_}
- or not defined $CPAN::Config->{$_}
- or not length $CPAN::Config->{$_}
- } keys %$CPAN::Config;
- $matcher = "\\b(".join("|", @unconfigured).")\\b";
- $CPAN::Frontend->mywarn("matcher[$matcher]");
- } else {
- # case WORD... => all arguments must be valid
- for my $arg (@{$args{args}}) {
- unless (exists $CPAN::HandleConfig::keys{$arg}) {
- $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
- return;
- }
- }
- $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
- }
- CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
+=over 2
- unless ($CPAN::VERSION) {
- require CPAN::Nox;
- }
- require CPAN::HandleConfig;
- CPAN::HandleConfig::require_myconfig_or_config();
- $CPAN::Config ||= {};
- local($/) = "\n";
- local($\) = "";
- local($|) = 1;
+=item auto_commit
- my($ans,$default);
+Normally CPAN.pm keeps config variables in memory and changes need to
+be saved in a separate 'o conf commit' command to make them permanent
+between sessions. If you set the 'auto_commit' option to true, changes
+to a config variable are always automatically committed to disk.
- #
- #= Files, directories
- #
+Always commit changes to config variables to disk?
- unless ($matcher) {
- $CPAN::Frontend->myprint($prompts{manual_config});
- }
+=item build_cache
- my $manual_conf;
+CPAN.pm can limit the size of the disk area for keeping the build
+directories with all the intermediate files.
- local *_real_prompt;
- if ( $args{autoconfig} ) {
- $manual_conf = "no";
- } elsif ($matcher) {
- $manual_conf = "yes";
- } else {
- my $_conf = prompt("Would you like me to configure as much as possible ".
- "automatically?", "yes");
- $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
- }
- CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
- my $fastread;
- {
- if ($manual_conf =~ /^y/i) {
- $fastread = 0;
- } else {
- $fastread = 1;
- $CPAN::Config->{urllist} ||= [];
-
- local $^W = 0;
- # prototype should match that of &MakeMaker::prompt
- my $current_second = time;
- my $current_second_count = 0;
- my $i_am_mad = 0;
- *_real_prompt = sub {
- my($q,$a) = @_;
- my($ret) = defined $a ? $a : "";
- $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
- eval { require Time::HiRes };
- unless ($@) {
- if (time == $current_second) {
- $current_second_count++;
- if ($current_second_count > 20) {
- # I don't like more than 20 prompts per second
- $i_am_mad++;
- }
- } else {
- $current_second = time;
- $current_second_count = 0;
- $i_am_mad-- if $i_am_mad>0;
- }
- if ($i_am_mad>0){
- #require Carp;
- #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
- Time::HiRes::sleep(0.1);
- }
- }
- $ret;
- };
- }
- }
+Cache size for build directory (in MB)?
- if (!$matcher or q{
- build_dir
- build_dir_reuse
- cpan_home
- keep_source_where
- prefs_dir
- } =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{config_intro});
+=item build_dir
- if (!$matcher or 'cpan_home' =~ /$matcher/) {
- my $cpan_home = $CPAN::Config->{cpan_home}
- || File::Spec->catdir($ENV{HOME}, ".cpan");
+Directory where the build process takes place?
- if (-d $cpan_home) {
- $CPAN::Frontend->myprint(qq{
+=item build_dir_reuse
-I see you already have a directory
- $cpan_home
-Shall we use it as the general CPAN build and cache directory?
+Until version 1.88 CPAN.pm never trusted the contents of the build_dir
+directory between sessions. Since 1.88_58 CPAN.pm has a YAML-based
+mechanism that makes it possible to share the contents of the
+build_dir/ directory between different sessions with the same version
+of perl. People who prefer to test things several days before
+installing will like this feature because it safes a lot of time.
-});
- } else {
- # no cpan-home, must prompt and get one
- $CPAN::Frontend->myprint($prompts{cpan_home_where});
- }
+If you say yes to the following question, CPAN will try to store
+enough information about the build process so that it can pick up in
+future sessions at the same state of affairs as it left a previous
+session.
- $default = $cpan_home;
- my $loop = 0;
- my $last_ans;
- PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
- if (File::Spec->file_name_is_absolute($ans)) {
- my @cpan_home = split /[\/\\]/, $ans;
- DIR: for my $dir (@cpan_home) {
- if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
- $CPAN::Frontend
- ->mywarn("Warning: a tilde in the path will be ".
- "taken as a literal tilde. Please ".
- "confirm again if you want to keep it\n");
- $last_ans = $default = $ans;
- next PROMPT;
- }
- }
- } else {
- require Cwd;
- my $cwd = Cwd::cwd();
- my $absans = File::Spec->catdir($cwd,$ans);
- $CPAN::Frontend->mywarn("The path '$ans' is not an ".
- "absolute path. Please specify ".
- "an absolute path\n");
- $default = $absans;
- next;
- }
- eval { File::Path::mkpath($ans); }; # dies if it can't
- if ($@) {
- $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
- "Please retry.\n");
- next;
- }
- if (-d $ans && -w _) {
- last;
- } else {
- $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
- "or directory is not writable. Please retry.\n");
- if (++$loop > 5) {
- $CPAN::Frontend->mydie("Giving up");
- }
- }
- }
- $CPAN::Config->{cpan_home} = $ans;
- }
+Store and re-use state information about distributions between
+CPAN.pm sessions?
- if (!$matcher or 'keep_source_where' =~ /$matcher/) {
- my_dflt_prompt("keep_source_where",
- File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
- $matcher,
- );
- }
+=item build_requires_install_policy
- if (!$matcher or 'build_dir' =~ /$matcher/) {
- my_dflt_prompt("build_dir",
- File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
- $matcher
- );
- }
+When a module declares another one as a 'build_requires' prerequisite
+this means that the other module is only needed for building or
+testing the module but need not be installed permanently. In this case
+you may wish to install that other module nonetheless or just keep it
+in the 'build_dir' directory to have it available only temporarily.
+Installing saves time on future installations but makes the perl
+installation bigger.
- if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
- my_yn_prompt(build_dir_reuse => "y", $matcher);
- }
+You can choose if you want to always install (yes), never install (no)
+or be always asked. In the latter case you can set the default answer
+for the question to yes (ask/yes) or no (ask/no).
- if (!$matcher or 'prefs_dir' =~ /$matcher/) {
- my_dflt_prompt("prefs_dir",
- File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
- $matcher
- );
- }
- }
+Policy on installing 'build_requires' modules (yes, no, ask/yes,
+ask/no)?
- #
- #= Config: auto_commit
- #
+=item cache_metadata
- my_yn_prompt(auto_commit => 0, $matcher);
+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.
- #
- #= Cache size, Index expire
- #
+Note: this mechanism is not used when use_sqlite is on and SQLLite is
+running.
- if (!$matcher or 'build_cache' =~ /$matcher/){
- # large enough to build large dists like Tk
- my_dflt_prompt(build_cache => 100, $matcher);
- }
+Cache metadata (yes/no)?
- if (!$matcher or 'index_expire' =~ /$matcher/) {
- my_dflt_prompt(index_expire => 1, $matcher);
- }
+=item check_sigs
- if (!$matcher or 'scan_cache' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{scan_cache_intro});
- my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
- }
+CPAN packages can be digitally signed by authors and thus verified
+with the security provided by strong cryptography. The exact mechanism
+is defined in the Module::Signature module. While this is generally
+considered a good thing, it is not always convenient to the end user
+to install modules that are signed incorrectly or where the key of the
+author is not available or where some prerequisite for
+Module::Signature has a bug and so on.
- #
- #= cache_metadata
- #
+With the check_sigs parameter you can turn signature checking on and
+off. The default is off for now because the whole tool chain for the
+functionality is not yet considered mature by some. The author of
+CPAN.pm would recommend setting it to true most of the time and
+turning it off only if it turns out to be annoying.
- my_yn_prompt(cache_metadata => 1, $matcher);
- my_yn_prompt(use_sqlite => 0, $matcher);
+Note that if you do not have Module::Signature installed, no signature
+checks will be performed at all.
- #
- #= Do we follow PREREQ_PM?
- #
+Always try to check and verify signatures if a SIGNATURE file is in
+the package and Module::Signature is installed (yes/no)?
- if (!$matcher or 'prerequisites_policy' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{prerequisites_policy_intro});
+=item colorize_output
- my_prompt_loop(prerequisites_policy => 'ask', $matcher,
- 'follow|ask|ignore');
- }
+When you have Term::ANSIColor installed, you can turn on colorized
+output to have some visual differences between normal CPAN.pm output,
+warnings, debugging output, and the output of the modules being
+installed. Set your favorite colors after some experimenting with the
+Term::ANSIColor module.
- if (!$matcher or 'build_requires_install_policy' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{build_requires_install_policy_intro});
+Do you want to turn on colored output?
- my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
- 'yes|no|ask/yes|ask/no');
- }
+=item colorize_print
- #
- #= Module::Signature
- #
- if (!$matcher or 'check_sigs' =~ /$matcher/) {
- my_yn_prompt(check_sigs => 0, $matcher);
- }
+Color for normal output?
- #
- #= CPAN::Reporter
- #
- if (!$matcher or 'test_report' =~ /$matcher/) {
- my_yn_prompt(test_report => 0, $matcher);
- if (
- $CPAN::Config->{test_report} &&
- $CPAN::META->has_inst("CPAN::Reporter") &&
- CPAN::Reporter->can('configure')
- ) {
- $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
- CPAN::Reporter::configure();
- $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
- }
- }
+=item colorize_warn
- #
- #= YAML vs. YAML::Syck
- #
- if (!$matcher or "yaml_module" =~ /$matcher/) {
- my_dflt_prompt(yaml_module => "YAML", $matcher);
- unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
- $CPAN::Frontend->mywarn
- ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
- $CPAN::Frontend->mysleep(3);
- }
- }
+Color for warnings?
- #
- #= External programs
- #
+=item colorize_debug
- my @external_progs = qw/bzip2 gzip tar unzip
+Color for debugging messages?
- make
+=item commandnumber_in_prompt
- curl lynx wget ncftpget ncftp ftp
+The prompt of the cpan shell can contain the current command number
+for easier tracking of the session or be a plain string.
- gpg
+Do you want the command number in the prompt (yes/no)?
- patch applypatch
- /;
- my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
- if (!$matcher or "@external_progs" =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{external_progs});
+=item ftp_passive
- my $old_warn = $^W;
- local $^W if $^O eq 'MacOS';
- local $^W = $old_warn;
- my $progname;
- for $progname (@external_progs) {
- next if $matcher && $progname !~ /$matcher/;
- if ($^O eq 'MacOS') {
- $CPAN::Config->{$progname} = 'not_here';
- next;
- }
+Shall we always set the FTP_PASSIVE environment variable when dealing
+with ftp download (yes/no)?
- my $progcall = $progname;
- unless ($matcher) {
- # we really don't need ncftp if we have ncftpget, but
- # if they chose this dialog via matcher, they shall have it
- 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
+=item getcwd
- # warn "Warning: configured $path does not exist\n" unless -e $path;
- # $path = "";
- } elsif ($path =~ /^\s+$/) {
- # preserve disabled programs
- } else {
- $path = '';
- }
- unless ($path) {
- # e.g. make -> nmake
- $progcall = $Config::Config{$progname} if $Config::Config{$progname};
- }
+CPAN.pm changes the current working directory often and needs to
+determine its own current working directory. Per default it uses
+Cwd::cwd but if this doesn't work on your system for some reason,
+alternatives can be configured according to the following table:
- $path ||= find_exe($progcall,\@path);
- unless ($path){ # not -e $path, because find_exe already checked that
- local $"=";";
- $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n");
- if ($progname eq "make") {
- $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
- "building perl Modules. Please make sure you ".
- "have 'make' (or some equivalent) ".
- "working.\n"
- );
- if ($^O eq "MSWin32") {
- $CPAN::Frontend->mywarn("
-Windows users may want to follow this procedure when back in the CPAN shell:
+ cwd Cwd::cwd
+ getcwd Cwd::getcwd
+ fastcwd Cwd::fastcwd
+ backtickcwd external command cwd
- look YVES/scripts/alien_nmake.pl
- perl alien_nmake.pl
+Preferred method for determining the current working directory?
-This will install nmake on your system which can be used as a 'make'
-substitute. You can then revisit this dialog with
+=item histfile
- o conf init make
+If you have one of the readline packages (Term::ReadLine::Perl,
+Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
+shell will have history support. The next two questions deal with the
+filename of the history file and with its size. If you do not want to
+set this variable, please hit SPACE RETURN to the following question.
-");
- }
- }
- }
- $ans = prompt("Where is your $progname program?",$path) || $path;
- $CPAN::Config->{$progname} = $ans;
- }
- }
+File to save your history?
- if (!$matcher or 'pager' =~ /$matcher/) {
- 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;
- }
+=item histsize
- if (!$matcher or 'shell' =~ /$matcher/) {
- my $path = $CPAN::Config->{'shell'};
- if ($path && File::Spec->file_name_is_absolute($path)) {
- $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
- unless -e $path;
- $path = "";
- }
- $path ||= $ENV{SHELL};
- $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
- 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;
- }
- }
+Number of lines to save?
- #
- #= Installer, arguments to make etc.
- #
+=item inactivity_timeout
- if (!$matcher or 'prefer_installer' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{prefer_installer_intro});
+Sometimes you may wish to leave the processes run by CPAN alone
+without caring about them. Because the Makefile.PL or the Build.PL
+sometimes 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.
- my_prompt_loop(prefer_installer => 'EUMM', $matcher, 'MB|EUMM');
- }
+If you set this value to 0, these processes will wait forever. This is
+the default and recommended setting.
- if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/){
- my_dflt_prompt(makepl_arg => "", $matcher);
- my_dflt_prompt(make_arg => "", $matcher);
- }
+Timeout for inactivity during {Makefile,Build}.PL?
- require CPAN::HandleConfig;
- if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
- # as long as Windows needs $self->_build_command, we cannot
- # support sudo on windows :-)
- my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
- $matcher);
- }
+=item index_expire
- my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
- $matcher);
+The CPAN indexes are usually rebuilt once or twice per hour, but the
+typical CPAN mirror mirrors only once or twice per day. Depending on
+the quality of your mirror and your desire to be on the bleeding edge,
+you may want to set the following value to more or less than one day
+(which is the default). It determines after how many days CPAN.pm
+downloads new indexes.
- if (!$matcher or 'mbuildpl_arg mbuild_arg' =~ /$matcher/){
- my_dflt_prompt(mbuildpl_arg => "", $matcher);
- my_dflt_prompt(mbuild_arg => "", $matcher);
- }
+Let the index expire after how many days?
- if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
- # as long as Windows needs $self->_build_command, we cannot
- # support sudo on windows :-)
- my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
- }
+=item inhibit_startup_message
- my_dflt_prompt(mbuild_install_arg => "", $matcher);
+When the CPAN shell is started it normally displays a greeting message
+that contains the running version and the status of readline support.
- #
- #= Alarm period
- #
+Do you want to turn this message off?
- if (!$matcher or 'inactivity_timeout' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{inactivity_timeout_intro});
- $default = $CPAN::Config->{inactivity_timeout} || 0;
- $CPAN::Config->{inactivity_timeout} =
- prompt("Timeout for inactivity during {Makefile,Build}.PL?",$default);
- }
+=item keep_source_where
- #
- #= Proxies
- #
+Unless you are accessing the CPAN on your filesystem via a file: URL,
+CPAN.pm needs to keep the source files it downloads somewhere. Please
+supply a directory where the downloaded files are to be kept.
- my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
- my @proxy_user_vars = qw/proxy_user proxy_pass/;
- if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{proxy_intro});
+Download target directory?
- for (@proxy_vars) {
- if (!$matcher or /$matcher/){
- $default = $CPAN::Config->{$_} || $ENV{$_} || "";
- $CPAN::Config->{$_} = prompt("Your $_?",$default);
- }
- }
+=item load_module_verbosity
- if ($CPAN::Config->{ftp_proxy} ||
- $CPAN::Config->{http_proxy}) {
+When CPAN.pm loads a module it needs for some optional feature, it
+usually reports about module name and version. Choose 'v' to get this
+message, 'none' to suppress it.
- $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
+Verbosity level for loading modules (none or v)?
- $CPAN::Frontend->myprint($prompts{proxy_user});
+=item makepl_arg
- if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
- $CPAN::Frontend->myprint($prompts{proxy_pass});
+Every Makefile.PL is run by perl in a separate process. Likewise we
+run 'make' and 'make install' in separate 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 ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("noecho");
- } else {
- $CPAN::Frontend->myprint($prompts{password_warn});
- }
- $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
- if ($CPAN::META->has_inst("Term::ReadKey")) {
- Term::ReadKey::ReadMode("restore");
- }
- $CPAN::Frontend->myprint("\n\n");
- }
- }
- }
+If you don't understand this question, just press ENTER.
- #
- #= how FTP works
- #
+Typical frequently used settings:
- my_yn_prompt(ftp_passive => 1, $matcher);
+ PREFIX=~/perl # non-root users (please see manual for more hints)
- #
- #= how cwd works
- #
+Parameters for the 'perl Makefile.PL' command?
- if (!$matcher or 'getcwd' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{getcwd_intro});
+=item make_arg
- my_prompt_loop(getcwd => 'cwd', $matcher,
- 'cwd|getcwd|fastcwd|backtickcwd');
- }
+Parameters for the 'make' command? Typical frequently used setting:
- #
- #= the CPAN shell itself (prompt, color)
- #
+ -j3 # dual processor system (on GNU make)
- my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
- my_yn_prompt(term_ornaments => 1, $matcher);
- if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
- my_yn_prompt(colorize_output => 0, $matcher);
- if ($CPAN::Config->{colorize_output}) {
- if ($CPAN::META->has_inst("Term::ANSIColor")) {
- my $T="gYw";
- print " on_ on_y ".
- " on_ma on_\n";
- print " on_black on_red green ellow ".
- "on_blue genta on_cyan white\n";
+Your choice:
- for my $FG ("", "bold",
- map {$_,"bold $_"} "black","red","green",
- "yellow","blue",
- "magenta",
- "cyan","white"){
- printf "%12s ", $FG;
- for my $BG ("",map {"on_$_"} qw(black red green yellow
- blue magenta cyan white)){
- print $FG||$BG ?
- Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ";
- }
- print "\n";
- }
- print "\n";
- }
- for my $tuple (
- ["colorize_print", "bold blue on_white"],
- ["colorize_warn", "bold red on_white"],
- ["colorize_debug", "black on_cyan"],
- ) {
- my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
- if ($CPAN::META->has_inst("Term::ANSIColor")) {
- eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
- if ($@) {
- $CPAN::Config->{$tuple->[0]} = $tuple->[1];
- $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
- }
- }
- }
- }
- }
+=item make_install_arg
- #
- #== term_is_latin
- #
+Parameters for the 'make install' command?
+Typical frequently used setting:
- if (!$matcher or 'term_is_latin' =~ /$matcher/){
- $CPAN::Frontend->myprint($prompts{term_is_latin});
- my_yn_prompt(term_is_latin => 1, $matcher);
- }
+ UNINST=1 # to always uninstall potentially conflicting files
- #
- #== save history in file 'histfile'
- #
+Your choice:
- if (!$matcher or 'histfile histsize' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{histfile_intro});
- defined($default = $CPAN::Config->{histfile}) or
- $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
- $ans = prompt("File to save your history?", $default);
- $CPAN::Config->{histfile} = $ans;
+=item make_install_make_command
- if ($CPAN::Config->{histfile}) {
- defined($default = $CPAN::Config->{histsize}) or $default = 100;
- $ans = prompt("Number of lines to save?", $default);
- $CPAN::Config->{histsize} = $ans;
- }
- }
+Do you want to use a different make command for 'make install'?
+Cautious people will probably prefer:
- #
- #== do an ls on the m or the d command
- #
- if (!$matcher or 'show_upload_date' =~ /$matcher/) {
- $CPAN::Frontend->myprint($prompts{show_upload_date_intro});
-
- defined($default = $CPAN::Config->{show_upload_date}) or
- $default = 'n';
- $ans = prompt("Always try to show upload date with 'd' and 'm' command (yes/no)?",
- ($default ? 'yes' : 'no'));
- $CPAN::Config->{show_upload_date} = ($ans =~ /^[y1]/i ? 1 : 0);
- }
+ su root -c make
+ or
+ sudo make
+ or
+ /path1/to/sudo -u admin_account /path2/to/make
- #
- #= MIRRORED.BY and conf_sites()
- #
+or some such. Your choice:
- if ($matcher){
- if ("urllist" =~ $matcher) {
- # conf_sites would go into endless loop with the smash prompt
- local *_real_prompt;
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- conf_sites();
- }
- if ("randomize_urllist" =~ $matcher) {
- my_dflt_prompt(randomize_urllist => 0, $matcher);
- }
- } elsif ($fastread) {
- $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
- "Please call 'o conf init urllist' to configure ".
- "your CPAN server(s) now!");
- } else {
- conf_sites();
- }
+=item mbuildpl_arg
- # We don't ask this one now, it's plain silly and maybe is not
- # even used correctly everywhere.
- $CPAN::Config->{inhibit_startup_message} = 0;
+A Build.PL is run by perl in a separate process. Likewise we run
+'./Build' and './Build install' in separate processes. If you have any
+parameters you want to pass to the calls, please specify them here.
- $CPAN::Frontend->myprint("\n\n");
- if ($matcher && !$CPAN::Config->{auto_commit}) {
- $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
- "make the config permanent!\n\n");
- } else {
- CPAN::HandleConfig->commit($configpm);
- }
-}
+Typical frequently used settings:
-sub my_dflt_prompt {
- my ($item, $dflt, $m) = @_;
- my $default = $CPAN::Config->{$item} || $dflt;
+ --install_base /home/xxx # different installation directory
- $DB::single = 1;
- if (!$m || $item =~ /$m/) {
- if (my $intro = $prompts{$item . "_intro"}) {
- $CPAN::Frontend->myprint($intro);
- }
- $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
- } else {
- $CPAN::Config->{$item} = $default;
- }
-}
+Parameters for the 'perl Build.PL' command?
-sub my_yn_prompt {
- my ($item, $dflt, $m) = @_;
- my $default;
- defined($default = $CPAN::Config->{$item}) or $default = $dflt;
+=item mbuild_arg
- $DB::single = 1;
- if (!$m || $item =~ /$m/) {
- if (my $intro = $prompts{$item . "_intro"}) {
- $CPAN::Frontend->myprint($intro);
- }
- my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
- $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
- } else {
- $CPAN::Config->{$item} = $default;
- }
-}
+Parameters for the './Build' command? Setting might be:
-sub my_prompt_loop {
- my ($item, $dflt, $m, $ok) = @_;
- my $default = $CPAN::Config->{$item} || $dflt;
- my $ans;
+ --extra_linker_flags -L/usr/foo/lib # non-standard library location
- $DB::single = 1;
- if (!$m || $item =~ /$m/) {
- do { $ans = prompt($prompts{$item}, $default);
- } until $ans =~ /$ok/;
- $CPAN::Config->{$item} = $ans;
- } else {
- $CPAN::Config->{$item} = $default;
- }
-}
+Your choice:
+=item mbuild_install_arg
-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
+Parameters for the './Build install' command? Typical frequently used
+setting:
-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.
+ --uninst 1 # uninstall conflicting files
-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) {
- $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $overwrite_local = 0;
- } elsif ( ! -f $mby ){
- $CPAN::Frontend->myprint(qq{You have no $mby\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- } elsif (-M $mby > 60 && $loopcount == 0) {
- $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I\'m trying }.
- qq{to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- $loopcount++;
- } elsif (-s $mby == 0) {
- $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I\'m trying to fetch one\n});
- $mby = CPAN::FTP->localize($m,$mby,3);
- } else {
- last;
- }
- }
- local $urllist = [];
- read_mirrored_by($mby);
- bring_your_own();
- $CPAN::Config->{urllist} = $urllist;
-}
+Your choice:
-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;
- }
- }
-}
+=item mbuild_install_build_command
-sub picklist {
- my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
- CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
- "'$empty_warning')") if $CPAN::DEBUG;
- $default ||= '';
+Do you want to use a different command for './Build install'? Sudo
+users will probably prefer:
- my $pos = 0;
+ su root -c ./Build
+ or
+ sudo ./Build
+ or
+ /path1/to/sudo -u admin_account ./Build
- my @nums;
- SELECTION: while (1) {
+or some such. Your choice:
- # display, at most, 15 items at a time
- my $limit = $#{ $items } - $pos;
- $limit = 15 if $limit > 15;
+=item pager
- # show the next $limit items, get the new position
- $pos = display_some($items, $limit, $pos, $default);
- $pos = 0 if $pos >= @$items;
+What is your favorite pager program?
- my $num = prompt($prompt,$default);
+=item prefer_installer
- @nums = split (' ', $num);
- {
- my %seen;
- @nums = grep { !$seen{$_}++ } @nums;
- }
- my $i = scalar @$items;
- unrangify(\@nums);
- if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)){
- $CPAN::Frontend->mywarn("invalid items entered, try again\n");
- if ("@nums" =~ /\D/) {
- $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
- }
- next SELECTION;
- }
- if ($require_nonempty && !@nums) {
- $CPAN::Frontend->mywarn("$empty_warning\n");
- }
- $CPAN::Frontend->myprint("\n");
+When you have Module::Build installed and a module comes with both a
+Makefile.PL and a Build.PL, which shall have precedence?
- # a blank line continues...
- next SELECTION unless @nums;
- last;
- }
- for (@nums) { $_-- }
- @{$items}[@nums];
-}
+The main two standard installer modules are the old and well
+established ExtUtils::MakeMaker (for short: EUMM) which uses the
+Makefile.PL. And the next generation installer Module::Build (MB)
+which works with the Build.PL (and often comes with a Makefile.PL
+too). If a module comes only with one of the two we will use that one
+but if both are supplied then a decision must be made between EUMM and
+MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a
+discussion about the right default.
-sub unrangify ($) {
- my($nums) = $_[0];
- my @nums2 = ();
- while (@{$nums||[]}) {
- my $n = shift @$nums;
- if ($n =~ /^(\d+)-(\d+)$/) {
- my @range = $1 .. $2;
- # warn "range[@range]";
- push @nums2, @range;
- } else {
- push @nums2, $n;
- }
- }
- push @$nums, @nums2;
-}
+Or, as a third option you can choose RAND which will make a random
+decision (something regular CPAN testers will enjoy).
-sub display_some {
- my ($items, $limit, $pos, $default) = @_;
- $pos ||= 0;
+In case you can choose between running a Makefile.PL or a Build.PL,
+which installer would you prefer (EUMM or MB or RAND)?
- my @displayable = @$items[$pos .. ($pos + $limit)];
- for my $item (@displayable) {
- $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
- }
- my $hit_what = $default ? "SPACE RETURN" : "RETURN";
- $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
- (@$items - $pos),
- $hit_what,
- ))
- if $pos < @$items;
- return $pos;
-}
+=item prefs_dir
-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 = @{$CPAN::Config->{urllist}};
+CPAN.pm can store customized build environments based on regular
+expressions for distribution names. These are YAML files where the
+default options for CPAN.pm and the environment can be overridden and
+dialog sequences can be stored that can later be executed by an
+Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
+files that cover sample distributions that can be used as blueprints
+to store one own prefs. Please check out the distroprefs/ directory of
+the CPAN.pm distribution to get a quick start into the prefs system.
- $CPAN::Frontend->myprint($prompts{urls_intro});
+Directory where to store default options/environment/dialogs for
+building modules that need some customization?
- 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.";
- my $offer_cont = [sort keys %all];
- if (@previous_urls) {
- push @$offer_cont, "(edit previous picks)";
- $default = @$offer_cont;
- }
- @cont = picklist($offer_cont,
- "Select your continent (or several nearby continents)",
- $default,
- ! @previous_urls,
- $no_previous_warn);
+=item prerequisites_policy
+The CPAN module can detect when a module 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.
- 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 (@previous_urls && @countries) {
- push @countries, "(edit previous picks)";
- $default = @countries;
- }
+Policy on building prerequisites (follow, ask or ignore)?
- if (@countries) {
- @countries = picklist (\@countries,
- "Select your country (or several nearby countries)",
- $default,
- ! @previous_urls,
- $no_previous_warn);
- %seen = map (($_ => 1), @previous_urls);
- # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
- foreach $country (@countries) {
- next if $country =~ /edit previous picks/;
- (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 (by number),
-put them on one line, separated by blanks, hyphenated ranges allowed
- e.g. '1 4 5' or '7 1-4 8'";
- if (@previous_urls) {
- $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
- (scalar @urls));
- $prompt .= "\n(or just hit RETURN to keep your previous picks)";
- }
+=item randomize_urllist
- @urls = picklist (\@urls, $prompt, $default);
- foreach (@urls) { s/ \(.*\)//; }
- push @$urllist, @urls;
-}
+CPAN.pm can introduce some randomness when using hosts for download
+that are configured in the urllist parameter. Enter a numeric value
+between 0 and 1 to indicate how often you want to let CPAN.pm try a
+random host from the urllist. A value of one specifies to always use a
+random host as the first try. A value of zero means no randomness at
+all. Anything in between specifies how often, on average, a random
+host should be tried first.
-sub bring_your_own {
- my %seen = map (($_ => 1), @$urllist);
- my($ans,@urls);
- my $eacnt = 0; # empty answers
- 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.
+Randomize parameter
-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 {
- $CPAN::Frontend->
- myprint(sprintf(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",
- ));
- }
- } else {
- if (++$eacnt >= 5) {
- $CPAN::Frontend->
- mywarn("Giving up.\n");
- $CPAN::Frontend->mysleep(5);
- return;
- }
- }
- } while $ans || !%seen;
-
- push @$urllist, @urls;
- # xxx delete or comment these out when you're happy that it works
- $CPAN::Frontend->myprint("New set of picks:\n");
- map { $CPAN::Frontend->myprint(" $_\n") } @$urllist;
-}
-
-
-sub _strip_spaces {
- $_[0] =~ s/^\s+//; # no leading spaces
- $_[0] =~ s/\s+\z//; # no trailing spaces
-}
-
-sub prompt ($;$) {
- unless (defined &_real_prompt) {
- *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
- }
- my $ans = _real_prompt(@_);
-
- _strip_spaces($ans);
-
- return $ans;
-}
-
-
-sub prompt_no_strip ($;$) {
- return _real_prompt(@_);
-}
-
-
-BEGIN {
-
-my @prompts = (
-
-manual_config => qq[
-
-CPAN is the world-wide archive of perl resources. It consists of about
-300 sites that all replicate the same contents 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, lots of things have to be configured. Fortunately, most of
-them can be determined automatically. If you prefer the automatic
-configuration, answer 'yes' below.
-
-If you prefer to enter a dialog instead, you can answer 'no' to this
-question and I'll let you configure in small steps one thing after the
-other. (Note: you can revisit this dialog anytime later by typing 'o
-conf init' at the cpan prompt.)
-
-],
-
-config_intro => 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 or a personal directory.
-
-},
-
-# cpan_home => qq{ },
-
-cpan_home_where => qq{
-
-First of all, I\'d like to create this directory. Where?
-
-},
-
-keep_source_where => qq{
-
-Unless you are accessing the CPAN via the filesystem directly CPAN.pm
-needs to keep the source files it downloads somewhere. Please supply a
-directory where the downloaded files are to be kept.},
-
-build_cache_intro => qq{
-
-How big should the disk cache be for keeping the build directories
-with all the intermediate files\?
-
-},
-
-build_cache =>
-"Cache size for build directory (in MB)?",
-
-build_dir =>
-
-"Directory where the build process takes place?",
-
-build_dir_reuse_intro =>
-
-qq{Until version 1.88 CPAN.pm never trusted the contents of the
-build_dir directory between sessions. Since 1.88_58 CPAN.pm has a
-YAML-based mechanism that makes it possible to share the contents of
-the build_dir/ directory between different sessions with the same
-version of perl. People who prefer to test things several days before
-installing will like this feature because it safes a lot of time.
-
-If you say yes to the following question, CPAN will try to store
-enough information about the build process so that it can pick up in
-future sessions at the same state of affairs as it left a previous
-session.
-
-},
-
-build_dir_reuse =>
-
-qq{Store and re-use state information about distributions between
-CPAN.pm sessions?},
-
-prefs_dir_intro => qq{
-
-CPAN.pm can store customized build environments based on regular
-expressions for distribution names. These are YAML files where the
-default options for CPAN.pm and the environment can be overridden and
-dialog sequences can be stored that can later be executed by an
-Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
-files that cover sample distributions that can be used as blueprints
-to store one own prefs. Please check out the distroprefs/ directory of
-the CPAN.pm distribution to get a quick start into the prefs system.
-
-},
-
-prefs_dir =>
-
-"Directory where to store default options/environment/dialogs for
-building modules that need some customization?",
-
-scan_cache_intro => qq{
+=item scan_cache
By default, each time the CPAN module is started, cache scanning is
performed to keep the cache size in sync. To prevent this, answer
'never'.
-},
-
-scan_cache => "Perform cache scanning (atstart or never)?",
-
-cache_metadata_intro => 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.
-
-Note: this mechanism is not used when use_sqlite is on and SQLLite is
-running.
-
-},
-
-cache_metadata => qq{Cache metadata (yes/no)?},
-
-use_sqlite_intro => qq{
-
-CPAN::SQLite is a layer between the index files that are downloaded
-from the CPAN and CPAN.pm that speeds up metadata queries and reduces
-memory consumption of CPAN.pm considereably.
-
-},
-
-use_sqlite => qq{Use CPAN::SQLite if available? (yes/no)?},
-
-term_is_latin_intro => qq{
+Perform cache scanning (atstart or never)?
-The next option deals with the charset (aka character set) your
-terminal supports. In general, CPAN is English speaking territory, so
-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 should say no to the next
-question. If it supports ISO-8859-1 (also known as LATIN1) then you
-should say yes. If it supports neither, your answer does not matter
-because you will not be able to read the names of some authors
-anyway. If you answer no, names will be output in UTF-8.
-
-},
+=item shell
-term_is_latin => qq{Your terminal expects ISO-8859-1 (yes/no)?},
+What is your favorite shell?
-histfile_intro => qq{
-
-If you have one of the readline packages (Term::ReadLine::Perl,
-Term::ReadLine::Gnu, possibly others) installed, the interactive CPAN
-shell will have history support. The next two questions deal with the
-filename of the history file and with its size. If you do not want to
-set this variable, please hit SPACE RETURN to the following question.
+=item show_unparsable_versions
-},
+During the 'r' command CPAN.pm finds modules without version number.
+When the command finishes, it prints a report about this. If you
+want this report to be very verbose, say yes to the following
+variable.
-histfile => qq{File to save your history?},
+Show all individual modules that have no $VERSION?
-show_upload_date_intro => qq{
+=item show_upload_date
The 'd' and the 'm' command normally only show you information they
have in their in-memory database and thus will never connect to the
distribution. Per default this feature is off because it may require a
net connection to get at the upload date.
-},
+Always try to show upload date with 'd' and 'm' command (yes/no)?
-show_upload_date =>
-"Always try to show upload date with 'd' and 'm' command (yes/no)?",
+=item show_zero_versions
-prerequisites_policy_intro => qq{
+During the 'r' command CPAN.pm finds modules with a version number of
+zero. When the command finishes, it prints a report about this. If you
+want this report to be very verbose, say yes to the following
+variable.
-The CPAN module can detect when a module 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.
+Show all individual modules that have a $VERSION of zero?
-},
+=item tar_verbosity
-prerequisites_policy =>
-"Policy on building prerequisites (follow, ask or ignore)?",
+When CPAN.pm uses the tar command, which switch for the verbosity
+shall be used? Choose 'none' for quiet operation, 'v' for file
+name listing, 'vv' for full listing.
-check_sigs_intro => qq{
+Tar command verbosity level (none or v or vv)?
-CPAN packages can be digitally signed by authors and thus verified
-with the security provided by strong cryptography. The exact mechanism
-is defined in the Module::Signature module. While this is generally
-considered a good thing, it is not always convenient to the end user
-to install modules that are signed incorrectly or where the key of the
-author is not available or where some prerequisite for
-Module::Signature has a bug and so on.
+=item term_is_latin
-With the check_sigs parameter you can turn signature checking on and
-off. The default is off for now because the whole tool chain for the
-functionality is not yet considered mature by some. The author of
-CPAN.pm would recommend setting it to true most of the time and
-turning it off only if it turns out to be annoying.
+The next option deals with the charset (aka character set) your
+terminal supports. In general, CPAN is English speaking territory, so
+the charset does not matter much but some CPAN have names that are
+outside the ASCII range. If your terminal supports UTF-8, you should
+say no to the next question. If it expects ISO-8859-1 (also known as
+LATIN1) then you should say yes. If it supports neither, your answer
+does not matter because you will not be able to read the names of some
+authors anyway. If you answer no, names will be output in UTF-8.
-Note that if you do not have Module::Signature installed, no signature
-checks will be performed at all.
+Your terminal expects ISO-8859-1 (yes/no)?
-},
+=item term_ornaments
+
+When using Term::ReadLine, you can turn ornaments on so that your
+input stands out against the output from CPAN.pm.
-check_sigs =>
-qq{Always try to check and verify signatures if a SIGNATURE file is in the package
-and Module::Signature is installed (yes/no)?},
+Do you want to turn ornaments on?
-test_report_intro =>
-qq{
+=item test_report
The goal of the CPAN Testers project (http://testers.cpan.org/) is to
test as many CPAN packages as possible on as many platforms as
configuration settings. If your firewall blocks outgoing email,
you will need to configure CPAN::Reporter before sending reports.
-},
+Email test reports if CPAN::Reporter is installed (yes/no)?
-test_report =>
-qq{Email test reports if CPAN::Reporter is installed (yes/no)?},
+=item use_sqlite
-external_progs => qq{
+CPAN::SQLite is a layer between the index files that are downloaded
+from the CPAN and CPAN.pm that speeds up metadata queries and reduces
+memory consumption of CPAN.pm considerably.
-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 program, you can type a space followed by ENTER.
+Use CPAN::SQLite if available? (yes/no)?
-},
+=item yaml_load_code
-prefer_installer_intro => qq{
+Both YAML.pm and YAML::Syck are capable of deserialising code. As this requires
+a string eval, which might be a security risk, you can use this option to
+enable or disable the deserialisation of code.
-When you have Module::Build installed and a module comes with both a
-Makefile.PL and a Build.PL, which shall have precedence? The two
-installer modules we have are the old and well established
-ExtUtils::MakeMaker (for short: EUMM) which uses the Makefile.PL and
-the next generation installer Module::Build (MB) works with the
-Build.PL.
+Do you want to enable code deserialisation (yes/no)?
-},
+=item yaml_module
-prefer_installer =>
-qq{In case you could choose, which installer would you prefer (EUMM or MB)?},
+At the time of this writing there are two competing YAML modules,
+YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
+installed on your system. There may be more alternative YAML
+conforming modules but at the time of writing a potential third
+player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
-makepl_arg_intro => qq{
+Which YAML implementation would you prefer?
-Every Makefile.PL is run by perl in a separate process. Likewise we
-run \'make\' and \'make install\' in separate 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.
+=back
-If you don\'t understand this question, just press ENTER.
-},
+=head1 LICENSE
-makepl_arg => qq{
-Parameters for the 'perl Makefile.PL' command?
-Typical frequently used settings:
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
- PREFIX=~/perl # non-root users (please see manual for more hints)
+=cut
-Your choice: },
+use vars qw( %prompts );
-make_arg => qq{Parameters for the 'make' command?
-Typical frequently used setting:
+sub init {
+ my($configpm, %args) = @_;
+ use Config;
+ # extra args after 'o conf init'
+ my $matcher = $args{args} && @{$args{args}} ? $args{args}[0] : '';
+ if ($matcher =~ /^\/(.*)\/$/) {
+ # case /regex/ => take the first, ignore the rest
+ $matcher = $1;
+ shift @{$args{args}};
+ if (@{$args{args}}) {
+ local $" = " ";
+ $CPAN::Frontend->mywarn("Ignoring excessive arguments '@{$args{args}}'");
+ $CPAN::Frontend->mysleep(2);
+ }
+ } elsif (0 == length $matcher) {
+ } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea
+ my @unconfigured = grep { not exists $CPAN::Config->{$_}
+ or not defined $CPAN::Config->{$_}
+ or not length $CPAN::Config->{$_}
+ } keys %$CPAN::Config;
+ $matcher = "\\b(".join("|", @unconfigured).")\\b";
+ $CPAN::Frontend->mywarn("matcher[$matcher]");
+ } else {
+ # case WORD... => all arguments must be valid
+ for my $arg (@{$args{args}}) {
+ unless (exists $CPAN::HandleConfig::keys{$arg}) {
+ $CPAN::Frontend->mywarn("'$arg' is not a valid configuration variable\n");
+ return;
+ }
+ }
+ $matcher = "\\b(".join("|",@{$args{args}}).")\\b";
+ }
+ CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG;
- -j3 # dual processor system (on GNU make)
+ unless ($CPAN::VERSION) {
+ require CPAN::Nox;
+ }
+ require CPAN::HandleConfig;
+ CPAN::HandleConfig::require_myconfig_or_config();
+ $CPAN::Config ||= {};
+ local($/) = "\n";
+ local($\) = "";
+ local($|) = 1;
+
+ my($ans,$default);
+
+ #
+ #= Files, directories
+ #
-Your choice: },
+ unless ($matcher) {
+ $CPAN::Frontend->myprint($prompts{manual_config});
+ }
+
+ my $manual_conf;
+ local *_real_prompt;
+ if ( $args{autoconfig} ) {
+ $manual_conf = "no";
+ } elsif ($matcher) {
+ $manual_conf = "yes";
+ } else {
+ my $_conf = prompt("Would you like me to configure as much as possible ".
+ "automatically?", "yes");
+ $manual_conf = ($_conf and $_conf =~ /^y/i) ? "no" : "yes";
+ }
+ CPAN->debug("manual_conf[$manual_conf]") if $CPAN::DEBUG;
+ my $fastread;
+ {
+ if ($manual_conf =~ /^y/i) {
+ $fastread = 0;
+ } else {
+ $fastread = 1;
+ $CPAN::Config->{urllist} ||= [];
+
+ local $^W = 0;
+ # prototype should match that of &MakeMaker::prompt
+ my $current_second = time;
+ my $current_second_count = 0;
+ my $i_am_mad = 0;
+ *_real_prompt = sub {
+ my($q,$a) = @_;
+ my($ret) = defined $a ? $a : "";
+ $CPAN::Frontend->myprint(sprintf qq{%s [%s]\n\n}, $q, $ret);
+ eval { require Time::HiRes };
+ unless ($@) {
+ if (time == $current_second) {
+ $current_second_count++;
+ if ($current_second_count > 20) {
+ # I don't like more than 20 prompts per second
+ $i_am_mad++;
+ }
+ } else {
+ $current_second = time;
+ $current_second_count = 0;
+ $i_am_mad-- if $i_am_mad>0;
+ }
+ if ($i_am_mad>0) {
+ #require Carp;
+ #Carp::cluck("SLEEEEEEEEPIIIIIIIIIIINGGGGGGGGGGG");
+ Time::HiRes::sleep(0.1);
+ }
+ }
+ $ret;
+ };
+ }
+ }
+
+ if (!$matcher or q{
+ build_dir
+ build_dir_reuse
+ cpan_home
+ keep_source_where
+ prefs_dir
+ } =~ /$matcher/) {
+ $CPAN::Frontend->myprint($prompts{config_intro});
+
+ if (!$matcher or 'cpan_home' =~ /$matcher/) {
+ my $cpan_home = $CPAN::Config->{cpan_home}
+ || File::Spec->catdir($ENV{HOME}, ".cpan");
+
+ if (-d $cpan_home) {
+ $CPAN::Frontend->myprint(qq{
+
+I see you already have a directory
+ $cpan_home
+Shall we use it as the general CPAN build and cache directory?
+
+});
+ } else {
+ # no cpan-home, must prompt and get one
+ $CPAN::Frontend->myprint($prompts{cpan_home_where});
+ }
+
+ $default = $cpan_home;
+ my $loop = 0;
+ my $last_ans;
+ $CPAN::Frontend->myprint(" <cpan_home>\n");
+ PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) {
+ print "\n";
+ if (File::Spec->file_name_is_absolute($ans)) {
+ my @cpan_home = split /[\/\\]/, $ans;
+ DIR: for my $dir (@cpan_home) {
+ if ($dir =~ /^~/ and (!$last_ans or $ans ne $last_ans)) {
+ $CPAN::Frontend
+ ->mywarn("Warning: a tilde in the path will be ".
+ "taken as a literal tilde. Please ".
+ "confirm again if you want to keep it\n");
+ $last_ans = $default = $ans;
+ next PROMPT;
+ }
+ }
+ } else {
+ require Cwd;
+ my $cwd = Cwd::cwd();
+ my $absans = File::Spec->catdir($cwd,$ans);
+ $CPAN::Frontend->mywarn("The path '$ans' is not an ".
+ "absolute path. Please specify ".
+ "an absolute path\n");
+ $default = $absans;
+ next PROMPT;
+ }
+ eval { File::Path::mkpath($ans); }; # dies if it can't
+ if ($@) {
+ $CPAN::Frontend->mywarn("Couldn't create directory $ans.\n".
+ "Please retry.\n");
+ next PROMPT;
+ }
+ if (-d $ans && -w _) {
+ last PROMPT;
+ } else {
+ $CPAN::Frontend->mywarn("Couldn't find directory $ans\n".
+ "or directory is not writable. Please retry.\n");
+ if (++$loop > 5) {
+ $CPAN::Frontend->mydie("Giving up");
+ }
+ }
+ }
+ $CPAN::Config->{cpan_home} = $ans;
+ }
+
+ if (!$matcher or 'keep_source_where' =~ /$matcher/) {
+ my_dflt_prompt("keep_source_where",
+ File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
+ $matcher,
+ );
+ }
+
+ if (!$matcher or 'build_dir' =~ /$matcher/) {
+ my_dflt_prompt("build_dir",
+ File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
+ $matcher
+ );
+ }
+
+ if (!$matcher or 'build_dir_reuse' =~ /$matcher/) {
+ my_yn_prompt(build_dir_reuse => 1, $matcher);
+ }
+
+ if (!$matcher or 'prefs_dir' =~ /$matcher/) {
+ my_dflt_prompt("prefs_dir",
+ File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
+ $matcher
+ );
+ }
+ }
+
+ #
+ #= Config: auto_commit
+ #
+
+ my_yn_prompt(auto_commit => 0, $matcher);
+
+ #
+ #= Cache size, Index expire
+ #
+
+ if (!$matcher or 'build_cache' =~ /$matcher/) {
+ # large enough to build large dists like Tk
+ my_dflt_prompt(build_cache => 100, $matcher);
+ }
+
+ if (!$matcher or 'index_expire' =~ /$matcher/) {
+ my_dflt_prompt(index_expire => 1, $matcher);
+ }
+
+ if (!$matcher or 'scan_cache' =~ /$matcher/) {
+ my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never');
+ }
+
+ #
+ #= cache_metadata
+ #
+
+ my_yn_prompt(cache_metadata => 1, $matcher);
+ my_yn_prompt(use_sqlite => 0, $matcher);
+
+ #
+ #= Do we follow PREREQ_PM?
+ #
+
+ if (!$matcher or 'prerequisites_policy' =~ /$matcher/) {
+ my_prompt_loop(prerequisites_policy => 'ask', $matcher,
+ 'follow|ask|ignore');
+ }
+
+ if (!$matcher or 'build_requires_install_policy' =~ /$matcher/) {
+ my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher,
+ 'yes|no|ask/yes|ask/no');
+ }
+
+ #
+ #= Module::Signature
+ #
+ if (!$matcher or 'check_sigs' =~ /$matcher/) {
+ my_yn_prompt(check_sigs => 0, $matcher);
+ }
+
+ #
+ #= CPAN::Reporter
+ #
+ if (!$matcher or 'test_report' =~ /$matcher/) {
+ my_yn_prompt(test_report => 0, $matcher);
+ if (
+ $CPAN::Config->{test_report} &&
+ $CPAN::META->has_inst("CPAN::Reporter") &&
+ CPAN::Reporter->can('configure')
+ ) {
+ $CPAN::Frontend->myprint("\nProceeding to configure CPAN::Reporter.\n");
+ CPAN::Reporter::configure();
+ $CPAN::Frontend->myprint("\nReturning to CPAN configuration.\n");
+ }
+ }
+
+ #
+ #= YAML vs. YAML::Syck
+ #
+ if (!$matcher or "yaml_module" =~ /$matcher/) {
+ my_dflt_prompt(yaml_module => "YAML", $matcher);
+ unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module})) {
+ $CPAN::Frontend->mywarn
+ ("Warning (maybe harmless): '$CPAN::Config->{yaml_module}' not installed.\n");
+ $CPAN::Frontend->mysleep(3);
+ }
+ }
+
+ #
+ #= YAML code deserialisation
+ #
+ if (!$matcher or "yaml_load_code" =~ /$matcher/) {
+ my_yn_prompt(yaml_load_code => 0, $matcher);
+ }
+
+ #
+ #= External programs
+ #
+
+ my @external_progs = qw/bzip2 gzip tar unzip
+
+ make
+
+ curl lynx wget ncftpget ncftp ftp
+
+ gpg
+
+ patch applypatch
+ /;
+ my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
+ if (!$matcher or "@external_progs" =~ /$matcher/) {
+ $CPAN::Frontend->myprint($prompts{external_progs});
+
+ my $old_warn = $^W;
+ local $^W if $^O eq 'MacOS';
+ local $^W = $old_warn;
+ my $progname;
+ for $progname (@external_progs) {
+ next if $matcher && $progname !~ /$matcher/;
+ if ($^O eq 'MacOS') {
+ $CPAN::Config->{$progname} = 'not_here';
+ next;
+ }
+
+ my $progcall = $progname;
+ unless ($matcher) {
+ # we really don't need ncftp if we have ncftpget, but
+ # if they chose this dialog via matcher, they shall have it
+ 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 = "";
+ } elsif ($path =~ /^\s+$/) {
+ # preserve disabled programs
+ } else {
+ $path = '';
+ }
+ unless ($path) {
+ # e.g. make -> nmake
+ $progcall = $Config::Config{$progname} if $Config::Config{$progname};
+ }
+
+ $path ||= find_exe($progcall,\@path);
+ unless ($path) { # not -e $path, because find_exe already checked that
+ local $"=";";
+ $CPAN::Frontend->mywarn("Warning: $progcall not found in PATH[@path]\n");
+ if ($progname eq "make") {
+ $CPAN::Frontend->mywarn("ALERT: 'make' is an essential tool for ".
+ "building perl Modules. Please make sure you ".
+ "have 'make' (or some equivalent) ".
+ "working.\n"
+ );
+ if ($^O eq "MSWin32") {
+ $CPAN::Frontend->mywarn("
+Windows users may want to follow this procedure when back in the CPAN shell:
+
+ look YVES/scripts/alien_nmake.pl
+ perl alien_nmake.pl
+
+This will install nmake on your system which can be used as a 'make'
+substitute. You can then revisit this dialog with
+
+ o conf init make
+
+");
+ }
+ }
+ }
+ $prompts{$progname} = "Where is your $progname program?";
+ my_dflt_prompt($progname,$path,$matcher);
+ }
+ }
+
+ if (!$matcher or 'pager' =~ /$matcher/) {
+ my $path = $CPAN::Config->{'pager'} ||
+ $ENV{PAGER} || find_exe("less",\@path) ||
+ find_exe("more",\@path) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
+ || "more";
+ my_dflt_prompt(pager => $path, $matcher);
+ }
+
+ if (!$matcher or 'shell' =~ /$matcher/) {
+ my $path = $CPAN::Config->{'shell'};
+ if ($path && File::Spec->file_name_is_absolute($path)) {
+ $CPAN::Frontend->mywarn("Warning: configured $path does not exist\n")
+ unless -e $path;
+ $path = "";
+ }
+ $path ||= $ENV{SHELL};
+ $path ||= $ENV{COMSPEC} if $^O eq "MSWin32";
+ if ($^O eq 'MacOS') {
+ $CPAN::Config->{'shell'} = 'not_here';
+ } else {
+ $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
+ my_dflt_prompt(shell => $path, $matcher);
+ }
+ }
+
+ #
+ # verbosity
+ #
+
+ if (!$matcher or 'tar_verbosity' =~ /$matcher/) {
+ my_prompt_loop(tar_verbosity => 'v', $matcher,
+ 'none|v|vv');
+ }
+
+ if (!$matcher or 'load_module_verbosity' =~ /$matcher/) {
+ my_prompt_loop(load_module_verbosity => 'v', $matcher,
+ 'none|v');
+ }
+
+ my_yn_prompt(inhibit_startup_message => 0, $matcher);
+
+ #
+ #= Installer, arguments to make etc.
+ #
+
+ if (!$matcher or 'prefer_installer' =~ /$matcher/) {
+ my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND');
+ }
+
+ if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) {
+ my_dflt_prompt(makepl_arg => "", $matcher);
+ my_dflt_prompt(make_arg => "", $matcher);
+ }
+
+ require CPAN::HandleConfig;
+ if (exists $CPAN::HandleConfig::keys{make_install_make_command}) {
+ # as long as Windows needs $self->_build_command, we cannot
+ # support sudo on windows :-)
+ my_dflt_prompt(make_install_make_command => $CPAN::Config->{make} || "",
+ $matcher);
+ }
+
+ my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "",
+ $matcher);
+
+ my_dflt_prompt(mbuildpl_arg => "", $matcher);
+ my_dflt_prompt(mbuild_arg => "", $matcher);
+
+ if (exists $CPAN::HandleConfig::keys{mbuild_install_build_command}) {
+ # as long as Windows needs $self->_build_command, we cannot
+ # support sudo on windows :-)
+ my_dflt_prompt(mbuild_install_build_command => "./Build", $matcher);
+ }
+
+ my_dflt_prompt(mbuild_install_arg => "", $matcher);
+
+ #
+ #= Alarm period
+ #
+
+ my_dflt_prompt(inactivity_timeout => 0, $matcher);
+
+ #
+ #= Proxies
+ #
+
+ my @proxy_vars = qw/ftp_proxy http_proxy no_proxy/;
+ my @proxy_user_vars = qw/proxy_user proxy_pass/;
+ if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) {
+ $CPAN::Frontend->myprint($prompts{proxy_intro});
+
+ for (@proxy_vars) {
+ $prompts{$_} = "Your $_?";
+ my_dflt_prompt($_ => $ENV{$_}||"", $matcher);
+ }
+
+ if ($CPAN::Config->{ftp_proxy} ||
+ $CPAN::Config->{http_proxy}) {
+
+ $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER || "";
+
+ $CPAN::Frontend->myprint($prompts{proxy_user});
+
+ if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
+ $CPAN::Frontend->myprint($prompts{proxy_pass});
+
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("noecho");
+ } else {
+ $CPAN::Frontend->myprint($prompts{password_warn});
+ }
+ $CPAN::Config->{proxy_pass} = prompt_no_strip("Your proxy password?");
+ if ($CPAN::META->has_inst("Term::ReadKey")) {
+ Term::ReadKey::ReadMode("restore");
+ }
+ $CPAN::Frontend->myprint("\n\n");
+ }
+ }
+ }
+
+ #
+ #= how FTP works
+ #
+
+ my_yn_prompt(ftp_passive => 1, $matcher);
+
+ #
+ #= how cwd works
+ #
+
+ if (!$matcher or 'getcwd' =~ /$matcher/) {
+ my_prompt_loop(getcwd => 'cwd', $matcher,
+ 'cwd|getcwd|fastcwd|backtickcwd');
+ }
+
+ #
+ #= the CPAN shell itself (prompt, color)
+ #
+
+ my_yn_prompt(commandnumber_in_prompt => 1, $matcher);
+ my_yn_prompt(term_ornaments => 1, $matcher);
+ if ("colorize_output colorize_print colorize_warn colorize_debug" =~ $matcher) {
+ my_yn_prompt(colorize_output => 0, $matcher);
+ if ($CPAN::Config->{colorize_output}) {
+ if ($CPAN::META->has_inst("Term::ANSIColor")) {
+ my $T="gYw";
+ print " on_ on_y ".
+ " on_ma on_\n";
+ print " on_black on_red green ellow ".
+ "on_blue genta on_cyan white\n";
+
+ for my $FG ("", "bold",
+ map {$_,"bold $_"} "black","red","green",
+ "yellow","blue",
+ "magenta",
+ "cyan","white") {
+ printf "%12s ", $FG;
+ for my $BG ("",map {"on_$_"} qw(black red green yellow
+ blue magenta cyan white)) {
+ print $FG||$BG ?
+ Term::ANSIColor::colored(" $T ","$FG $BG") : " $T ";
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+ for my $tuple (
+ ["colorize_print", "bold blue on_white"],
+ ["colorize_warn", "bold red on_white"],
+ ["colorize_debug", "black on_cyan"],
+ ) {
+ my_dflt_prompt($tuple->[0] => $tuple->[1], $matcher);
+ if ($CPAN::META->has_inst("Term::ANSIColor")) {
+ eval { Term::ANSIColor::color($CPAN::Config->{$tuple->[0]})};
+ if ($@) {
+ $CPAN::Config->{$tuple->[0]} = $tuple->[1];
+ $CPAN::Frontend->mywarn($@."setting to default '$tuple->[1]'\n");
+ }
+ }
+ }
+ }
+ }
+
+ #
+ #== term_is_latin
+ #
+
+ if (!$matcher or 'term_is_latin' =~ /$matcher/) {
+ my_yn_prompt(term_is_latin => 1, $matcher);
+ }
+
+ #
+ #== save history in file 'histfile'
+ #
+
+ if (!$matcher or 'histfile histsize' =~ /$matcher/) {
+ $CPAN::Frontend->myprint($prompts{histfile_intro});
+ defined($default = $CPAN::Config->{histfile}) or
+ $default = File::Spec->catfile($CPAN::Config->{cpan_home},"histfile");
+ my_dflt_prompt(histfile => $default, $matcher);
+
+ if ($CPAN::Config->{histfile}) {
+ defined($default = $CPAN::Config->{histsize}) or $default = 100;
+ my_dflt_prompt(histsize => $default, $matcher);
+ }
+ }
+
+ #
+ #== do an ls on the m or the d command
+ #
+ my_yn_prompt(show_upload_date => 0, $matcher);
+
+ #
+ #== verbosity at the end of the r command
+ #
+ if (!$matcher
+ or 'show_unparsable_versions' =~ /$matcher/
+ or 'show_zero_versions' =~ /$matcher/
+ ) {
+ $CPAN::Frontend->myprint($prompts{show_unparsable_or_zero_versions_intro});
+ my_yn_prompt(show_unparsable_versions => 0, $matcher);
+ my_yn_prompt(show_zero_versions => 0, $matcher);
+ }
+
+ #
+ #= MIRRORED.BY and conf_sites()
+ #
+
+ if ($matcher) {
+ if ("urllist" =~ $matcher) {
+ # conf_sites would go into endless loop with the smash prompt
+ local *_real_prompt;
+ *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+ conf_sites();
+ }
+ if ("randomize_urllist" =~ $matcher) {
+ my_dflt_prompt(randomize_urllist => 0, $matcher);
+ }
+ } elsif ($fastread) {
+ $CPAN::Frontend->myprint("Autoconfigured everything but 'urllist'.\n".
+ "Please call 'o conf init urllist' to configure ".
+ "your CPAN server(s) now!");
+ } else {
+ conf_sites();
+ }
+
+ $CPAN::Frontend->myprint("\n\n");
+ if ($matcher && !$CPAN::Config->{auto_commit}) {
+ $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ".
+ "make the config permanent!\n\n");
+ } else {
+ CPAN::HandleConfig->commit($configpm);
+ }
+}
+
+sub my_dflt_prompt {
+ my ($item, $dflt, $m) = @_;
+ my $default = $CPAN::Config->{$item} || $dflt;
+
+ $DB::single = 1;
+ if (!$m || $item =~ /$m/) {
+ if (my $intro = $prompts{$item . "_intro"}) {
+ $CPAN::Frontend->myprint($intro);
+ }
+ $CPAN::Frontend->myprint(" <$item>\n");
+ $CPAN::Config->{$item} = prompt($prompts{$item}, $default);
+ print "\n";
+ } else {
+ $CPAN::Config->{$item} = $default;
+ }
+}
+
+sub my_yn_prompt {
+ my ($item, $dflt, $m) = @_;
+ my $default;
+ defined($default = $CPAN::Config->{$item}) or $default = $dflt;
+
+ # $DB::single = 1;
+ if (!$m || $item =~ /$m/) {
+ if (my $intro = $prompts{$item . "_intro"}) {
+ $CPAN::Frontend->myprint($intro);
+ }
+ $CPAN::Frontend->myprint(" <$item>\n");
+ my $ans = prompt($prompts{$item}, $default ? 'yes' : 'no');
+ $CPAN::Config->{$item} = ($ans =~ /^[y1]/i ? 1 : 0);
+ print "\n";
+ } else {
+ $CPAN::Config->{$item} = $default;
+ }
+}
+
+sub my_prompt_loop {
+ my ($item, $dflt, $m, $ok) = @_;
+ my $default = $CPAN::Config->{$item} || $dflt;
+ my $ans;
+
+ $DB::single = 1;
+ if (!$m || $item =~ /$m/) {
+ $CPAN::Frontend->myprint($prompts{$item . "_intro"});
+ $CPAN::Frontend->myprint(" <$item>\n");
+ do { $ans = prompt($prompts{$item}, $default);
+ } until $ans =~ /$ok/;
+ $CPAN::Config->{$item} = $ans;
+ print "\n";
+ } else {
+ $CPAN::Config->{$item} = $default;
+ }
+}
+
+
+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) {
+ $CPAN::Frontend->myprint(qq{Trying to overwrite $mby\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ $overwrite_local = 0;
+ } elsif ( ! -f $mby ) {
+ $CPAN::Frontend->myprint(qq{You have no $mby\n I\'m trying to fetch one\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ } elsif (-M $mby > 60 && $loopcount == 0) {
+ $CPAN::Frontend->myprint(qq{Your $mby is older than 60 days,\n I\'m trying }.
+ qq{to fetch one\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ $loopcount++;
+ } elsif (-s $mby == 0) {
+ $CPAN::Frontend->myprint(qq{You have an empty $mby,\n I\'m trying to fetch one\n});
+ $mby = CPAN::FTP->localize($m,$mby,3);
+ } else {
+ last;
+ }
+ }
+ local $urllist = [];
+ read_mirrored_by($mby);
+ bring_your_own();
+ $CPAN::Config->{urllist} = $urllist;
+}
+
+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)=@_;
+ CPAN->debug("picklist('$items','$prompt','$default','$require_nonempty',".
+ "'$empty_warning')") if $CPAN::DEBUG;
+ $default ||= '';
+
+ my $pos = 0;
+
+ my @nums;
+ SELECTION: 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, $default);
+ $pos = 0 if $pos >= @$items;
+
+ my $num = prompt($prompt,$default);
+
+ @nums = split (' ', $num);
+ {
+ my %seen;
+ @nums = grep { !$seen{$_}++ } @nums;
+ }
+ my $i = scalar @$items;
+ unrangify(\@nums);
+ if (grep (/\D/ || $_ < 1 || $_ > $i, @nums)) {
+ $CPAN::Frontend->mywarn("invalid items entered, try again\n");
+ if ("@nums" =~ /\D/) {
+ $CPAN::Frontend->mywarn("(we are expecting only numbers between 1 and $i)\n");
+ }
+ next SELECTION;
+ }
+ if ($require_nonempty && !@nums) {
+ $CPAN::Frontend->mywarn("$empty_warning\n");
+ }
+ $CPAN::Frontend->myprint("\n");
+
+ # a blank line continues...
+ next SELECTION unless @nums;
+ last;
+ }
+ for (@nums) { $_-- }
+ @{$items}[@nums];
+}
+
+sub unrangify ($) {
+ my($nums) = $_[0];
+ my @nums2 = ();
+ while (@{$nums||[]}) {
+ my $n = shift @$nums;
+ if ($n =~ /^(\d+)-(\d+)$/) {
+ my @range = $1 .. $2;
+ # warn "range[@range]";
+ push @nums2, @range;
+ } else {
+ push @nums2, $n;
+ }
+ }
+ push @$nums, @nums2;
+}
+
+sub display_some {
+ my ($items, $limit, $pos, $default) = @_;
+ $pos ||= 0;
+
+ my @displayable = @$items[$pos .. ($pos + $limit)];
+ for my $item (@displayable) {
+ $CPAN::Frontend->myprint(sprintf "(%d) %s\n", ++$pos, $item);
+ }
+ my $hit_what = $default ? "SPACE RETURN" : "RETURN";
+ $CPAN::Frontend->myprint(sprintf("%d more items, hit %s to show them\n",
+ (@$items - $pos),
+ $hit_what,
+ ))
+ 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 = @{$CPAN::Config->{urllist}};
-make_install_make_command => qq{Do you want to use a different make command for 'make install'?
-Cautious people will probably prefer:
+ $CPAN::Frontend->myprint($prompts{urls_intro});
- su root -c make
-or
- sudo make
-or
- /path1/to/sudo -u admin_account /path2/to/make
+ 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.";
+ my $offer_cont = [sort keys %all];
+ if (@previous_urls) {
+ push @$offer_cont, "(edit previous picks)";
+ $default = @$offer_cont;
+ }
+ @cont = picklist($offer_cont,
+ "Select your continent (or several nearby continents)",
+ $default,
+ ! @previous_urls,
+ $no_previous_warn);
-or some such. Your choice: },
+ 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 (@previous_urls && @countries) {
+ push @countries, "(edit previous picks)";
+ $default = @countries;
+ }
-make_install_arg => qq{Parameters for the 'make install' command?
-Typical frequently used setting:
+ if (@countries) {
+ @countries = picklist (\@countries,
+ "Select your country (or several nearby countries)",
+ $default,
+ ! @previous_urls,
+ $no_previous_warn);
+ %seen = map (($_ => 1), @previous_urls);
+ # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
+ foreach $country (@countries) {
+ next if $country =~ /edit previous picks/;
+ (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 (by number),
+put them on one line, separated by blanks, hyphenated ranges allowed
+ e.g. '1 4 5' or '7 1-4 8'";
+ if (@previous_urls) {
+ $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
+ (scalar @urls));
+ $prompt .= "\n(or just hit RETURN to keep your previous picks)";
+ }
- UNINST=1 # to always uninstall potentially conflicting files
+ @urls = picklist (\@urls, $prompt, $default);
+ foreach (@urls) { s/ \(.*\)//; }
+ push @$urllist, @urls;
+}
-Your choice: },
+sub bring_your_own {
+ my %seen = map (($_ => 1), @$urllist);
+ my($ans,@urls);
+ my $eacnt = 0; # empty answers
+ 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, "");
-mbuildpl_arg_intro => qq{
+ 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 {
+ $CPAN::Frontend->
+ myprint(sprintf(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",
+ ));
+ }
+ } else {
+ if (++$eacnt >= 5) {
+ $CPAN::Frontend->
+ mywarn("Giving up.\n");
+ $CPAN::Frontend->mysleep(5);
+ return;
+ }
+ }
+ } while $ans || !%seen;
-The next questions deal with Module::Build support.
+ push @$urllist, @urls;
+ # xxx delete or comment these out when you're happy that it works
+ $CPAN::Frontend->myprint("New set of picks:\n");
+ map { $CPAN::Frontend->myprint(" $_\n") } @$urllist;
+}
-A Build.PL is run by perl in a separate process. Likewise we run
-'./Build' and './Build install' in separate processes. If you have any
-parameters you want to pass to the calls, please specify them here.
-},
+sub _strip_spaces {
+ $_[0] =~ s/^\s+//; # no leading spaces
+ $_[0] =~ s/\s+\z//; # no trailing spaces
+}
-mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command?
-Typical frequently used settings:
+sub prompt ($;$) {
+ unless (defined &_real_prompt) {
+ *_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
+ }
+ my $ans = _real_prompt(@_);
- --install_base /home/xxx # different installation directory
+ _strip_spaces($ans);
-Your choice: },
+ return $ans;
+}
-mbuild_arg => qq{Parameters for the './Build' command?
-Setting might be:
- --extra_linker_flags -L/usr/foo/lib # non-standard library location
+sub prompt_no_strip ($;$) {
+ return _real_prompt(@_);
+}
-Your choice: },
+BEGIN {
-mbuild_install_build_command => qq{Do you want to use a different command for './Build install'?
-Sudo users will probably prefer:
+my @prompts = (
- su root -c ./Build
-or
- sudo ./Build
-or
- /path1/to/sudo -u admin_account ./Build
+manual_config => qq[
-or some such. Your choice: },
+CPAN is the world-wide archive of perl resources. It consists of about
+300 sites that all replicate the same contents 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, lots of things have to be configured. Fortunately, most of
+them can be determined automatically. If you prefer the automatic
+configuration, answer 'yes' below.
+If you prefer to enter a dialog instead, you can answer 'no' to this
+question and I'll let you configure in small steps one thing after the
+other. (Note: you can revisit this dialog anytime later by typing 'o
+conf init' at the cpan prompt.)
+],
-mbuild_install_arg => qq{Parameters for the './Build install' command?
-Typical frequently used setting:
+config_intro => qq{
- --uninst 1 # uninstall conflicting files
+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 or a personal directory.},
-Your choice: },
+# cpan_home => qq{ },
+cpan_home_where => qq{
+First of all, I'd like to create this directory. Where?
-inactivity_timeout_intro => qq{
+},
-Sometimes you may wish to leave the processes run by CPAN alone
-without caring about them. Because the Makefile.PL or the Build.PL
-sometimes 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.
+external_progs => qq{
-If you set this value to 0, these processes will wait forever. This is
-the default and recommended setting.
+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 program, you can type a space followed by ENTER.
},
-inactivity_timeout =>
-qq{Timeout for inactivity during {Makefile,Build}.PL? },
-
-
proxy_intro => qq{
-If you\'re accessing the net via proxies, you can specify them in the
+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.
},
-commandnumber_in_prompt => qq{
-
-The prompt of the cpan shell can contain the current command number
-for easier tracking of the session or be a plain string. Do you want
-the command number in the prompt (yes/no)?},
-
-ftp_passive => qq{
-
-Shall we always set FTP_PASSIVE envariable when dealing with ftp
-download (yes/no)?},
-
-# taken from the manpage:
-getcwd_intro => qq{
-
-CPAN.pm changes the current working directory often and needs to
-determine its own current working directory. Per default it uses
-Cwd::cwd but if this doesn't work on your system for some reason,
-alternatives can be configured according to the following table:
-
- cwd Cwd::cwd
- getcwd Cwd::getcwd
- fastcwd Cwd::fastcwd
- backtickcwd external command cwd
-
-},
-
-getcwd => qq{Preferred method for determining the current working directory?},
-
-index_expire_intro => qq{
-
-The CPAN indexes are usually rebuilt once or twice per hour, but the
-typical CPAN mirror mirrors only once or twice per day. Depending on
-the quality of your mirror and your desire to be on the bleeding edge,
-you may want to set the following value to more or less than one day
-(which is the default). It determines after how many days CPAN.pm
-downloads new indexes.
-
-},
-
-index_expire => qq{Let the index expire after how many days?},
-
-term_ornaments => qq{
-
-When using Term::ReadLine, you can turn ornaments on so that your
-input stands out against the output from CPAN.pm. Do you want to turn
-ornaments on?},
-
-colorize_output => qq{
-
-When you have Term::ANSIColor installed, you can turn on colorized
-output to have some visual differences between normal CPAN.pm output,
-warnings, debugging output, and the output of the modules being
-installed. Set your favorite colors after some experimenting with the
-Term::ANSIColor module. Do you want to turn on colored output?},
-
-colorize_print => qq{Color for normal output?},
-
-colorize_warn => qq{Color for warnings?},
-
-colorize_debug => qq{Color for debugging messages?},
-
-build_requires_install_policy_intro => qq{
-
-When a module declares another one as a 'build_requires' prerequisite
-this means that the other module is only needed for building or
-testing the module but need not be installed permanently. In this case
-you may wish to install that other module nonetheless or just keep it
-in the 'build_dir' directory to have it available only temporarily.
-Installing saves time on future installations but makes the perl
-installation bigger.
-
-You can choose if you want to always install (yes), never install (no)
-or be always asked. In the latter case you can set the default answer
-for the question to yes (ask/yes) or no (ask/no).
-
-},
-
-build_requires_install_policy =>
-qq{Policy on installing 'build_requires' modules (yes, no, ask/yes,
-ask/no)?},
-
-yaml_module_intro => qq{
-
-At the time of this writing there are two competing YAML modules,
-YAML.pm and YAML::Syck. The latter is faster but needs a C compiler
-installed on your system. There may be more alternative YAML
-conforming modules but at the time of writing a potential third
-player, YAML::Tiny, seemed not powerful enough to work with CPAN.pm.
-
-},
-
-yaml_module => qq{Which YAML implementation would you prefer?},
-
-randomize_urllist_intro => qq{
-
-CPAN.pm can introduce some randomness when using hosts for download
-that are configured in the urllist parameter. Enter a numeric value
-between 0 and 1 to indicate how often you want to let CPAN.pm try a
-random host from the urllist. A value of one specifies to always use a
-random host as the first try. A value of zero means no randomness at
-all. Anything in between specifies how often, on average, a random
-host should be tried first.
-
-},
-
-randomize_urllist => "Randomize parameter",
-
-auto_commit_intro => qq{
-
-Normally CPAN.pm keeps config variables in memory and changes need to
-be saved in a separate 'o conf commit' command to make them permanent
-between sessions. If you set the 'auto_commit' option to true, changes
-to a config variable are always automatically committed to disk.
-
-},
-
-auto_commit => qq{Always commit changes to config variables to disk?},
-
);
die "Coding error in \@prompts declaration. Odd number of elements, above"
- if (@prompts % 2);
+ if (@prompts % 2);
%prompts = @prompts;
if (scalar(keys %prompts) != scalar(@prompts)/2) {
my %already;
for my $item (0..$#prompts) {
- next if $item % 2;
- die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
+ next if $item % 2;
+ die "$prompts[$item] is duplicated\n" if $already{$prompts[$item]}++;
+ }
+}
+
+local *FH;
+my $pmfile = __FILE__;
+open FH, $pmfile or die "Could not open '$pmfile': $!";
+local $/ = "";
+my @podpara;
+while (<FH>) {
+ next if 1 .. /^=over/;
+ chomp;
+ push @podpara, $_;
+ last if /^=back/;
+}
+pop @podpara;
+while (@podpara) {
+ warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//;
+ my $name = shift @podpara;
+ my @para;
+ while (@podpara && $podpara[0] !~ /^=item/) {
+ push @para, shift @podpara;
+ }
+ $prompts{$name} = pop @para;
+ if (@para) {
+ $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para;
}
}
-# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN::Tarzip;
use strict;
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
use File::Basename ();
-$VERSION = sprintf "%.6f", substr(q$Rev: 1717 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 2213 $,4)/1000000 + 5.4;
# module is internal to CPAN.pm
@ISA = qw(CPAN::Debug);
# it's ok if file doesn't exist, it just matters if it is .gz or .bz2
sub new {
- my($class,$file) = @_;
- $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
- if (0) {
- # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
- $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/")
- unless $file =~ /\.(bz2|gz|zip|tgz)$/i;
- }
- my $me = { FILE => $file };
- if (0) {
- } elsif ($file =~ /\.bz2$/i) {
- unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) {
- my $bzip2;
- if ($CPAN::META->has_inst("File::Which")) {
- $bzip2 = File::Which::which("bzip2");
- }
- if ($bzip2) {
- $me->{UNGZIPPRG} = $bzip2 || "bzip2";
- } else {
- $CPAN::Frontend->mydie(qq{
+ my($class,$file) = @_;
+ $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
+ if (0) {
+ # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
+ $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/")
+ unless $file =~ /\.(bz2|gz|zip|tgz)$/i;
+ }
+ my $me = { FILE => $file };
+ if (0) {
+ } elsif ($file =~ /\.bz2$/i) {
+ unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) {
+ my $bzip2;
+ if ($CPAN::META->has_inst("File::Which")) {
+ $bzip2 = File::Which::which("bzip2");
+ }
+ if ($bzip2) {
+ $me->{UNGZIPPRG} = $bzip2 || "bzip2";
+ } else {
+ $CPAN::Frontend->mydie(qq{
CPAN.pm needs the external program bzip2 in order to handle '$file'.
Please install it now and run 'o conf init' to register it as external
program.
});
- }
+ }
+ }
+ } else {
+ # yes, we let gzip figure it out in *any* other case
+ $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
}
- } else {
- # yes, we let gzip figure it out in *any* other case
- $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
- }
- bless $me, $class;
+ bless $me, $class;
}
sub gzip {
- my($self,$read) = @_;
- my $write = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
- my($buffer,$fhw);
- $fhw = FileHandle->new($read)
- or $CPAN::Frontend->mydie("Could not open $read: $!");
- my $cwd = `pwd`;
- my $gz = Compress::Zlib::gzopen($write, "wb")
- or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
- $gz->gzwrite($buffer)
- while read($fhw,$buffer,4096) > 0 ;
- $gz->gzclose() ;
- $fhw->close;
- return 1;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- system(qq{$command -c "$read" > "$write"})==0;
- }
+ my($self,$read) = @_;
+ my $write = $self->{FILE};
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my($buffer,$fhw);
+ $fhw = FileHandle->new($read)
+ or $CPAN::Frontend->mydie("Could not open $read: $!");
+ my $cwd = `pwd`;
+ my $gz = Compress::Zlib::gzopen($write, "wb")
+ or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
+ $gz->gzwrite($buffer)
+ while read($fhw,$buffer,4096) > 0 ;
+ $gz->gzclose() ;
+ $fhw->close;
+ return 1;
+ } else {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ system(qq{$command -c "$read" > "$write"})==0;
+ }
}
sub gunzip {
- my($self,$write) = @_;
- my $read = $self->{FILE};
- if ($CPAN::META->has_inst("Compress::Zlib")) {
- my($buffer,$fhw);
- $fhw = FileHandle->new(">$write")
- or $CPAN::Frontend->mydie("Could not open >$write: $!");
- my $gz = Compress::Zlib::gzopen($read, "rb")
- or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
- $fhw->print($buffer)
- while $gz->gzread($buffer) > 0 ;
- $CPAN::Frontend->mydie("Error reading from $read: $!\n")
- if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
- $gz->gzclose() ;
- $fhw->close;
- return 1;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- system(qq{$command -dc "$read" > "$write"})==0;
- }
+ my($self,$write) = @_;
+ my $read = $self->{FILE};
+ if ($CPAN::META->has_inst("Compress::Zlib")) {
+ my($buffer,$fhw);
+ $fhw = FileHandle->new(">$write")
+ or $CPAN::Frontend->mydie("Could not open >$write: $!");
+ my $gz = Compress::Zlib::gzopen($read, "rb")
+ or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
+ $fhw->print($buffer)
+ while $gz->gzread($buffer) > 0 ;
+ $CPAN::Frontend->mydie("Error reading from $read: $!\n")
+ if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
+ $gz->gzclose() ;
+ $fhw->close;
+ return 1;
+ } else {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ system(qq{$command -dc "$read" > "$write"})==0;
+ }
}
sub gtest {
- my($self) = @_;
- return $self->{GTEST} if exists $self->{GTEST};
- defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
- my $read = $self->{FILE};
- my $success;
- # After I had reread the documentation in zlib.h, I discovered that
- # uncompressed files do not lead to an gzerror (anymore?).
- if ( $CPAN::META->has_inst("Compress::Zlib") ) {
- my($buffer,$len);
- $len = 0;
- my $gz = Compress::Zlib::gzopen($read, "rb")
- or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
- $read,
- $Compress::Zlib::gzerrno));
- while ($gz->gzread($buffer) > 0 ){
- $len += length($buffer);
- $buffer = "";
- }
- my $err = $gz->gzerror;
- $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
- if ($len == -s $read){
- $success = 0;
- CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
+ my($self) = @_;
+ return $self->{GTEST} if exists $self->{GTEST};
+ defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
+ my $read = $self->{FILE};
+ my $success;
+ # After I had reread the documentation in zlib.h, I discovered that
+ # uncompressed files do not lead to an gzerror (anymore?).
+ if ( $CPAN::META->has_inst("Compress::Zlib") ) {
+ my($buffer,$len);
+ $len = 0;
+ my $gz = Compress::Zlib::gzopen($read, "rb")
+ or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
+ $read,
+ $Compress::Zlib::gzerrno));
+ while ($gz->gzread($buffer) > 0 ) {
+ $len += length($buffer);
+ $buffer = "";
+ }
+ my $err = $gz->gzerror;
+ $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
+ if ($len == -s $read) {
+ $success = 0;
+ CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
+ }
+ $gz->gzclose();
+ CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
+ } else {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ $success = 0==system(qq{$command -qdt "$read"});
}
- $gz->gzclose();
- CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
- } else {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- $success = 0==system(qq{$command -qdt "$read"});
- }
- return $self->{GTEST} = $success;
+ return $self->{GTEST} = $success;
}
sub TIEHANDLE {
- my($class,$file) = @_;
- my $ret;
- $class->debug("file[$file]");
- my $self = $class->new($file);
- if (0) {
- } elsif (!$self->gtest) {
- my $fh = FileHandle->new($file)
- or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
- binmode $fh;
- $self->{FH} = $fh;
- $class->debug("via uncompressed FH");
- } elsif ($CPAN::META->has_inst("Compress::Zlib")) {
- my $gz = Compress::Zlib::gzopen($file,"rb") or
- $CPAN::Frontend->mydie("Could not gzopen $file");
- $self->{GZ} = $gz;
- $class->debug("via Compress::Zlib");
- } else {
- my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- my $pipe = "$gzip -dc $file |";
- my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
- binmode $fh;
- $self->{FH} = $fh;
- $class->debug("via external gzip");
- }
- $self;
+ my($class,$file) = @_;
+ my $ret;
+ $class->debug("file[$file]");
+ my $self = $class->new($file);
+ if (0) {
+ } elsif (!$self->gtest) {
+ my $fh = FileHandle->new($file)
+ or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
+ binmode $fh;
+ $self->{FH} = $fh;
+ $class->debug("via uncompressed FH");
+ } elsif ($CPAN::META->has_inst("Compress::Zlib")) {
+ my $gz = Compress::Zlib::gzopen($file,"rb") or
+ $CPAN::Frontend->mydie("Could not gzopen $file");
+ $self->{GZ} = $gz;
+ $class->debug("via Compress::Zlib");
+ } else {
+ my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ my $pipe = "$gzip -dc $file |";
+ my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
+ binmode $fh;
+ $self->{FH} = $fh;
+ $class->debug("via external gzip");
+ }
+ $self;
}
sub READLINE {
- my($self) = @_;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- my($line,$bytesread);
- $bytesread = $gz->gzreadline($line);
- return undef if $bytesread <= 0;
- return $line;
- } else {
- my $fh = $self->{FH};
- return scalar <$fh>;
- }
+ my($self) = @_;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ my($line,$bytesread);
+ $bytesread = $gz->gzreadline($line);
+ return undef if $bytesread <= 0;
+ return $line;
+ } else {
+ my $fh = $self->{FH};
+ return scalar <$fh>;
+ }
}
sub READ {
- my($self,$ref,$length,$offset) = @_;
- $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
- if (exists $self->{GZ}) {
- my $gz = $self->{GZ};
- my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
- return $byteread;
- } else {
- my $fh = $self->{FH};
- return read($fh,$$ref,$length);
- }
+ my($self,$ref,$length,$offset) = @_;
+ $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
+ if (exists $self->{GZ}) {
+ my $gz = $self->{GZ};
+ my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
+ return $byteread;
+ } else {
+ my $fh = $self->{FH};
+ return read($fh,$$ref,$length);
+ }
}
sub untar {
- my($self) = @_;
- my $file = $self->{FILE};
- my($prefer) = 0;
+ my($self) = @_;
+ my $file = $self->{FILE};
+ my($prefer) = 0;
- if (0) { # makes changing order easier
- } elsif ($BUGHUNTING){
- $prefer=2;
- } elsif (MM->maybe_command($self->{UNGZIPPRG})
- &&
- MM->maybe_command($CPAN::Config->{tar})) {
- # should be default until Archive::Tar handles bzip2
- $prefer = 1;
- } elsif (
- $CPAN::META->has_usable("Archive::Tar")
- &&
- $CPAN::META->has_inst("Compress::Zlib") ) {
- $prefer = 2;
- } else {
- $CPAN::Frontend->mydie(qq{
+ if (0) { # makes changing order easier
+ } elsif ($BUGHUNTING) {
+ $prefer=2;
+ } elsif (MM->maybe_command($self->{UNGZIPPRG})
+ &&
+ MM->maybe_command($CPAN::Config->{tar})) {
+ # should be default until Archive::Tar handles bzip2
+ $prefer = 1;
+ } elsif (
+ $CPAN::META->has_usable("Archive::Tar")
+ &&
+ $CPAN::META->has_inst("Compress::Zlib") ) {
+ $prefer = 2;
+ } else {
+ $CPAN::Frontend->mydie(qq{
CPAN.pm needs either the external programs tar, gzip and bzip2
installed. Can't continue.
});
- }
- if ($prefer==1) { # 1 => external gzip+tar
- my($system);
- my $is_compressed = $self->gtest();
- my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar";
- if ($is_compressed) {
- my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
- $system = qq{$command -dc }.
- qq{< "$file" | $tarcommand xvf -};
- } else {
- $system = qq{$tarcommand xvf "$file"};
}
- if (system($system) != 0) {
- # people find the most curious tar binaries that cannot handle
- # pipes
- if ($is_compressed) {
- (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
- $ungzf = File::Basename::basename($ungzf);
- my $ct = CPAN::Tarzip->new($file);
- if ($ct->gunzip($ungzf)) {
- $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+ my $tar_verb = "v";
+ if (defined $CPAN::Config->{tar_verbosity}) {
+ $tar_verb = $CPAN::Config->{tar_verbosity} eq "none" ? "" :
+ $CPAN::Config->{tar_verbosity};
+ }
+ if ($prefer==1) { # 1 => external gzip+tar
+ my($system);
+ my $is_compressed = $self->gtest();
+ my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar";
+ if ($is_compressed) {
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ $system = qq{$command -dc }.
+ qq{< "$file" | $tarcommand x${tar_verb}f -};
} else {
- $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
+ $system = qq{$tarcommand x${tar_verb}f "$file"};
}
- $file = $ungzf;
- }
- $system = qq{$tarcommand xvf "$file"};
- $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
- if (system($system)==0) {
- $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
- } else {
- $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
- }
- return 1;
- } else {
- return 1;
- }
- } elsif ($prefer==2) { # 2 => modules
- unless ($CPAN::META->has_usable("Archive::Tar")) {
- $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
- }
- my $tar = Archive::Tar->new($file,1);
- my $af; # archive file
- my @af;
- if ($BUGHUNTING) {
- # RCS 1.337 had this code, it turned out unacceptable slow but
- # it revealed a bug in Archive::Tar. Code is only here to hunt
- # the bug again. It should never be enabled in published code.
- # GDGraph3d-0.53 was an interesting case according to Larry
- # Virden.
- warn(">>>Bughunting code enabled<<< " x 20);
- for $af ($tar->list_files) {
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
+ if (system($system) != 0) {
+ # people find the most curious tar binaries that cannot handle
+ # pipes
+ if ($is_compressed) {
+ (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
+ $ungzf = File::Basename::basename($ungzf);
+ my $ct = CPAN::Tarzip->new($file);
+ if ($ct->gunzip($ungzf)) {
+ $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
+ }
+ $file = $ungzf;
+ }
+ $system = qq{$tarcommand x${tar_verb}f "$file"};
+ $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
+ if (system($system)==0) {
+ $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
+ }
+ return 1;
+ } else {
+ return 1;
}
- $CPAN::Frontend->myprint("$af\n");
- $tar->extract($af); # slow but effective for finding the bug
- return if $CPAN::Signal;
- }
- } else {
- for $af ($tar->list_files) {
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
+ } elsif ($prefer==2) { # 2 => modules
+ unless ($CPAN::META->has_usable("Archive::Tar")) {
+ $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
+ }
+ my $tar = Archive::Tar->new($file,1);
+ my $af; # archive file
+ my @af;
+ if ($BUGHUNTING) {
+ # RCS 1.337 had this code, it turned out unacceptable slow but
+ # it revealed a bug in Archive::Tar. Code is only here to hunt
+ # the bug again. It should never be enabled in published code.
+ # GDGraph3d-0.53 was an interesting case according to Larry
+ # Virden.
+ warn(">>>Bughunting code enabled<<< " x 20);
+ for $af ($tar->list_files) {
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains ".
+ "illegal member [$af]");
+ }
+ $CPAN::Frontend->myprint("$af\n");
+ $tar->extract($af); # slow but effective for finding the bug
+ return if $CPAN::Signal;
+ }
+ } else {
+ for $af ($tar->list_files) {
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains ".
+ "illegal member [$af]");
+ }
+ if ($tar_verb eq "v" || $tar_verb eq "vv") {
+ $CPAN::Frontend->myprint("$af\n");
+ }
+ push @af, $af;
+ return if $CPAN::Signal;
+ }
+ $tar->extract(@af) or
+ $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
}
- $CPAN::Frontend->myprint("$af\n");
- push @af, $af;
- return if $CPAN::Signal;
- }
- $tar->extract(@af) or
- $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
- }
- Mac::BuildTools::convert_files([$tar->list_files], 1)
- if ($^O eq 'MacOS');
+ Mac::BuildTools::convert_files([$tar->list_files], 1)
+ if ($^O eq 'MacOS');
- return 1;
- }
+ return 1;
+ }
}
sub unzip {
- my($self) = @_;
- my $file = $self->{FILE};
- if ($CPAN::META->has_inst("Archive::Zip")) {
- # blueprint of the code from Archive::Zip::Tree::extractTree();
- my $zip = Archive::Zip->new();
- my $status;
- $status = $zip->read($file);
- $CPAN::Frontend->mydie("Read of file[$file] failed\n")
- if $status != Archive::Zip::AZ_OK();
- $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
- my @members = $zip->members();
- for my $member ( @members ) {
- my $af = $member->fileName();
- if ($af =~ m!^(/|\.\./)!) {
- $CPAN::Frontend->mydie("ALERT: Archive contains ".
- "illegal member [$af]");
- }
- $status = $member->extractToFileNamed( $af );
- $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
- $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
- $status != Archive::Zip::AZ_OK();
- return if $CPAN::Signal;
+ my($self) = @_;
+ my $file = $self->{FILE};
+ if ($CPAN::META->has_inst("Archive::Zip")) {
+ # blueprint of the code from Archive::Zip::Tree::extractTree();
+ my $zip = Archive::Zip->new();
+ my $status;
+ $status = $zip->read($file);
+ $CPAN::Frontend->mydie("Read of file[$file] failed\n")
+ if $status != Archive::Zip::AZ_OK();
+ $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
+ my @members = $zip->members();
+ for my $member ( @members ) {
+ my $af = $member->fileName();
+ if ($af =~ m!^(/|\.\./)!) {
+ $CPAN::Frontend->mydie("ALERT: Archive contains ".
+ "illegal member [$af]");
+ }
+ $status = $member->extractToFileNamed( $af );
+ $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
+ $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
+ $status != Archive::Zip::AZ_OK();
+ return if $CPAN::Signal;
+ }
+ return 1;
+ } else {
+ my $unzip = $CPAN::Config->{unzip} or
+ $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
+ my @system = ($unzip, $file);
+ return system(@system) == 0;
}
- return 1;
- } else {
- my $unzip = $CPAN::Config->{unzip} or
- $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
- my @system = ($unzip, $file);
- return system(@system) == 0;
- }
}
1;
projects / platform / upstream / perl.git / commitdiff