From: Steve Peters Date: Tue, 2 Oct 2007 13:39:06 +0000 (+0000) Subject: Upgrade to CPAN-1.9203 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=547d3dfd0918e1335aa86e352904fbb22cccfb6d;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CPAN-1.9203 p4raw-id: //depot/perl@32008 --- diff --git a/MANIFEST b/MANIFEST index 420d2e8..3fafe76 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1559,8 +1559,10 @@ lib/Config.t See if Config works lib/constant.pm For "use constant" lib/constant.t See if compile-time constants work lib/CORE.pod document the CORE namespace +lib/CPAN/API/HOWTO.pm recipe book for programming with CPAN.pm lib/CPAN/bin/cpan easily interact with CPAN from the command line lib/CPAN/Debug.pm helper package for CPAN.pm +lib/CPAN/DeferedCode.pm helper package for CPAN.pm lib/CPAN/FirstTime.pm Utility for creating CPAN config files lib/CPAN/HandleConfig.pm helper package for CPAN.pm lib/CPAN/Kwalify/distroprefs.dd helper file for validating config files @@ -3940,8 +3942,8 @@ utils/h2xs.PL Program to make .xs files from C header files utils/instmodsh.PL Give information about installed extensions utils/libnetcfg.PL libnet utils.lst Lists utilities bundled with Perl -utils/Makefile.SH Extract the utility scripts utils/Makefile Pregenerated from utils/Makefile.SH +utils/Makefile.SH Extract the utility scripts utils/perlbug.PL A simple tool to submit a bug report utils/perldoc.PL A simple tool to find & display perl's documentation utils/perlivp.PL installation verification procedure diff --git a/lib/CPAN/API/HOWTO.pm b/lib/CPAN/API/HOWTO.pm new file mode 100644 index 0000000..e65a4bc --- /dev/null +++ b/lib/CPAN/API/HOWTO.pm @@ -0,0 +1,44 @@ +=head1 NAME + +CPAN::API::HOWTO - a recipe book for programming with CPAN.pm + +=head1 RECIPES + +All of these recipes assume that you have put "use CPAN" at the top of +your program. + +=head2 What distribution contains a particular module? + + my $distribution = CPAN::Shell->expand( + "Module", "Data::UUID" + )->distribution()->pretty_id(); + +This returns a string of the form "AUTHORID/TARBALL". If you want the +full path and filename to this distribution on a CPAN mirror, then it is +C<.../authors/id/A/AU/AUTHORID/TARBALL>. + +=head2 What modules does a particular distribution contain? + + CPAN::Index->reload(); + my @modules = CPAN::Shell->expand( + "Distribution", "JHI/Graph-0.83.tar.gz" + )->containsmods(); + +You may also refer to a distribution in the form A/AU/AUTHORID/TARBALL. + +=head1 SEE ALSO + +the main CPAN.pm documentation + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L + +=head1 AUTHOR + +David Cantrell + +=cut diff --git a/lib/CPAN/Debug.pm b/lib/CPAN/Debug.pm index 239fb6b..086b623 100644 --- a/lib/CPAN/Debug.pm +++ b/lib/CPAN/Debug.pm @@ -3,7 +3,7 @@ package CPAN::Debug; use strict; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 955 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4; # module is internal to CPAN.pm %CPAN::DEBUG = qw[ @@ -48,7 +48,7 @@ sub debug { last if ++$i>=3; } pop @caller; - if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG){ + if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG) { if ($arg and ref $arg) { eval { require Data::Dumper }; if ($@) { diff --git a/lib/CPAN/DeferedCode.pm b/lib/CPAN/DeferedCode.pm new file mode 100644 index 0000000..c57669b --- /dev/null +++ b/lib/CPAN/DeferedCode.pm @@ -0,0 +1,16 @@ +package CPAN::DeferedCode; + +use strict; +use vars qw/$VERSION/; + +use overload fallback => 1, map { ($_ => 'run') } qw/ + bool "" 0+ +/; + +$VERSION = "5.50"; + +sub run { + $_[0]->(); +} + +1; diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index 02a7f85..d5d3e21 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -19,7 +19,7 @@ use File::Basename (); 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 @@ -34,1151 +34,381 @@ CPAN::FirstTime::init() 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 @@ -1187,51 +417,46 @@ internet. If you set the 'show_upload_date' variable to true, 'm' and 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 @@ -1248,146 +473,1078 @@ See the CPAN::Reporter documentation for additional details and 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(" \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. @@ -1434,136 +1591,43 @@ be echoed to the terminal! }, -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 () { + 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; } } diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm index 49a8a50..ec0aefd 100644 --- a/lib/CPAN/HandleConfig.pm +++ b/lib/CPAN/HandleConfig.pm @@ -1,8 +1,8 @@ package CPAN::HandleConfig; use strict; -use vars qw(%can %keys $VERSION); +use vars qw(%can %keys $loading $VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4; %can = ( commit => "Commit changes to disk", @@ -48,6 +48,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4; "index_expire", "inhibit_startup_message", "keep_source_where", + "load_module_verbosity", "lynx", "make", "make_arg", @@ -65,15 +66,18 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4; "password", "patch", "prefer_installer", - "prerequisites_policy", "prefs_dir", + "prerequisites_policy", "proxy_pass", "proxy_user", "randomize_urllist", "scan_cache", "shell", + "show_unparsable_versions", "show_upload_date", + "show_zero_versions", "tar", + "tar_verbosity", "term_is_latin", "term_ornaments", "test_report", @@ -83,6 +87,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 1744 $,4)/1000000 + 5.4; "username", "wait_list", "wget", + "yaml_load_code", "yaml_module", ); @@ -120,8 +125,8 @@ sub edit { $o = shift @args; $DB::single = 1; if($can{$o}) { - $self->$o(args => \@args); # o conf init => sub init => sub load - return 1; + $self->$o(args => \@args); # o conf init => sub init => sub load + return 1; } else { CPAN->debug("o[$o]") if $CPAN::DEBUG; unless (exists $keys{$o}) { @@ -132,40 +137,40 @@ sub edit { # one day I used randomize_urllist for a boolean, so we must # list them explicitly --ak - if (0) { + if (0) { } elsif ($o =~ /^(wait_list|urllist|dontload_list)$/) { # # ARRAYS # - $func = shift @args; - $func ||= ""; + $func = shift @args; + $func ||= ""; CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG; - # Let's avoid eval, it's easier to comprehend without. - if ($func eq "push") { - push @{$CPAN::Config->{$o}}, @args; + # Let's avoid eval, it's easier to comprehend without. + if ($func eq "push") { + push @{$CPAN::Config->{$o}}, @args; $changed = 1; - } elsif ($func eq "pop") { - pop @{$CPAN::Config->{$o}}; + } elsif ($func eq "pop") { + pop @{$CPAN::Config->{$o}}; $changed = 1; - } elsif ($func eq "shift") { - shift @{$CPAN::Config->{$o}}; + } elsif ($func eq "shift") { + shift @{$CPAN::Config->{$o}}; $changed = 1; - } elsif ($func eq "unshift") { - unshift @{$CPAN::Config->{$o}}, @args; + } elsif ($func eq "unshift") { + unshift @{$CPAN::Config->{$o}}, @args; $changed = 1; - } elsif ($func eq "splice") { + } elsif ($func eq "splice") { my $offset = shift @args || 0; my $length = shift @args || 0; - splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn + splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn $changed = 1; - } elsif ($func) { - $CPAN::Config->{$o} = [$func, @args]; + } elsif ($func) { + $CPAN::Config->{$o} = [$func, @args]; $changed = 1; - } else { + } else { $self->prettyprint($o); - } + } if ($changed) { if ($o eq "urllist") { # reset the cached values @@ -183,7 +188,7 @@ sub edit { # HASHES # - if (@args==1 && $args[0] eq ""){ + if (@args==1 && $args[0] eq "") { @args = (); } elsif (@args % 2) { push @args, ""; @@ -196,14 +201,14 @@ sub edit { # SCALARS # - if (defined $args[0]){ + if (defined $args[0]) { $CPAN::CONFIG_DIRTY = 1; $CPAN::Config->{$o} = $args[0]; $changed = 1; } - $self->prettyprint($o) + $self->prettyprint($o) if exists $keys{$o} or defined $CPAN::Config->{$o}; - } + } if ($changed) { if ($CPAN::Config->{auto_commit}) { $self->commit; @@ -217,33 +222,35 @@ sub edit { } sub prettyprint { - my($self,$k) = @_; - my $v = $CPAN::Config->{$k}; - if (ref $v) { - my(@report); - if (ref $v eq "ARRAY") { - @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v; + my($self,$k) = @_; + my $v = $CPAN::Config->{$k}; + if (ref $v) { + my(@report); + if (ref $v eq "ARRAY") { + @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v; + } else { + @report = map + { + sprintf "\t%-18s => %s\n", + "[$_]", + defined $v->{$_} ? "[$v->{$_}]" : "undef" + } keys %$v; + } + $CPAN::Frontend->myprint( + join( + "", + sprintf( + " %-18s\n", + $k + ), + @report + ) + ); + } elsif (defined $v) { + $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v); } else { - @report = map { sprintf("\t%-18s => %s\n", - map { "[$_]" } $_, - defined $v->{$_} ? $v->{$_} : "UNDEFINED" - )} keys %$v; + $CPAN::Frontend->myprint(sprintf " %-18s undef\n", $k); } - $CPAN::Frontend->myprint( - join( - "", - sprintf( - " %-18s\n", - $k - ), - @report - ) - ); - } elsif (defined $v) { - $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v); - } else { - $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, "UNDEFINED"); - } } sub commit { @@ -264,10 +271,10 @@ sub commit { $configpm = $args[0]; } } - unless (defined $configpm){ - $configpm ||= $INC{"CPAN/MyConfig.pm"}; - $configpm ||= $INC{"CPAN/Config.pm"}; - $configpm || Carp::confess(q{ + unless (defined $configpm) { + $configpm ||= $INC{"CPAN/MyConfig.pm"}; + $configpm ||= $INC{"CPAN/Config.pm"}; + $configpm || Carp::confess(q{ CPAN::Config::commit called without an argument. Please specify a filename where to save the configuration or try "o conf init" to have an interactive course through configing. @@ -275,10 +282,10 @@ Please specify a filename where to save the configuration or try } my($mode); if (-f $configpm) { - $mode = (stat $configpm)[2]; - if ($mode && ! -w _) { - Carp::confess("$configpm is not writable"); - } + $mode = (stat $configpm)[2]; + if ($mode && ! -w _) { + Carp::confess("$configpm is not writable"); + } } my $msg; @@ -302,11 +309,11 @@ EOF $CPAN::Frontend->mywarn("Unknown config variable '$_'\n"); next; } - $fh->print( - " '$_' => ", - $self->neatvalue($CPAN::Config->{$_}), - ",\n" - ); + $fh->print( + " '$_' => ", + $self->neatvalue($CPAN::Config->{$_}), + ",\n" + ); } $fh->print("};\n1;\n__END__\n"); @@ -327,7 +334,7 @@ sub neatvalue { my($self, $v) = @_; return "undef" unless defined $v; my($t) = ref $v; - unless ($t){ + unless ($t) { $v =~ s/\\/\\\\/g; return "q[$v]"; } @@ -343,7 +350,7 @@ sub neatvalue { } return "$v" unless $t eq 'HASH'; my(@m, $key, $val); - while (($key,$val) = each %$v){ + while (($key,$val) = each %$v) { last unless defined $key; # cautious programming in case (undef,undef) is true push(@m,"q[$key]=>".$self->neatvalue($val)) ; } @@ -408,7 +415,7 @@ else: quote it with the correct quote type for the box we're on my ($quotes,$use_quote) = $^O eq 'MSWin32' ? ('"', '"') - : (q<"'>, "'") + : (q{"'}, "'") ; sub safe_quote { @@ -428,12 +435,8 @@ else: quote it with the correct quote type for the box we're on sub init { my($self,@args) = @_; - undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to - # have the least - # important - # variable - # undefined - $self->load(@args); + CPAN->debug("self[$self]args[".join(",",@args)."]"); + $self->load(doit => 1, @args); 1; } @@ -441,7 +444,7 @@ sub init { # maintainability. RMB # sub _configpmtest { - my($configpmdir, $configpmtest) = @_; + my($configpmdir, $configpmtest) = @_; if (-w $configpmtest) { return $configpmtest; } elsif (-w $configpmdir) { @@ -450,20 +453,20 @@ sub _configpmtest { unlink $configpm_bak if -f $configpm_bak; if( -f $configpmtest ) { if( rename $configpmtest, $configpm_bak ) { - $CPAN::Frontend->mywarn(<mywarn(<new; - if ($fh->open(">$configpmtest")) { - $fh->print("1;\n"); - return $configpmtest; - } else { - # Should never happen - Carp::confess("Cannot open >$configpmtest"); - } + } + } + my $fh = FileHandle->new; + if ($fh->open(">$configpmtest")) { + $fh->print("1;\n"); + return $configpmtest; + } else { + # Should never happen + Carp::confess("Cannot open >$configpmtest"); + } } else { return } } @@ -490,7 +493,11 @@ sub home () { my $home; if ($CPAN::META->has_usable("File::HomeDir")) { $home = File::HomeDir->my_data; - } else { + unless (defined $home) { + $home = File::HomeDir->my_home + } + } + unless (defined $home) { $home = $ENV{HOME}; } $home; @@ -498,39 +505,42 @@ sub home () { sub load { my($self, %args) = @_; - $CPAN::Be_Silent++ if $args{be_silent}; + $CPAN::Be_Silent++ if $args{be_silent}; + my $doit; + $doit = delete $args{doit}; - my(@miss); use Carp; require_myconfig_or_config; - return unless @miss = $self->missing_config_data; + my @miss = $self->missing_config_data; + return unless $doit || @miss; + return if $loading; + $loading++; require CPAN::FirstTime; - my($configpm,$fh,$redo,$theycalled); + my($configpm,$fh,$redo); $redo ||= ""; - $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message'; if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) { - $configpm = $INC{"CPAN/Config.pm"}; - $redo++; + $configpm = $INC{"CPAN/Config.pm"}; + $redo++; } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) { - $configpm = $INC{"CPAN/MyConfig.pm"}; - $redo++; + $configpm = $INC{"CPAN/MyConfig.pm"}; + $redo++; } else { - my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"}); - my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN"); - my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm"); + my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"}); + my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN"); + my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm"); my $inc_key; - if (-d $configpmdir or File::Path::mkpath($configpmdir)) { - $configpm = _configpmtest($configpmdir,$configpmtest); + if (-d $configpmdir or File::Path::mkpath($configpmdir)) { + $configpm = _configpmtest($configpmdir,$configpmtest); $inc_key = "CPAN/Config.pm"; - } - unless ($configpm) { - $configpmdir = File::Spec->catdir(home,".cpan","CPAN"); - File::Path::mkpath($configpmdir); - $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm"); - $configpm = _configpmtest($configpmdir,$configpmtest); + } + unless ($configpm) { + $configpmdir = File::Spec->catdir(home,".cpan","CPAN"); + File::Path::mkpath($configpmdir); + $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm"); + $configpm = _configpmtest($configpmdir,$configpmtest); $inc_key = "CPAN/MyConfig.pm"; - } + } if ($configpm) { $INC{$inc_key} = $configpm; } else { @@ -541,22 +551,17 @@ sub load { } local($") = ", "; - if ($redo && ! $theycalled){ + if ($redo && !$doit) { $CPAN::Frontend->myprint(<myprint(qq{ -$configpm initialized. -}); - } CPAN::FirstTime::init($configpm, %args); + $loading--; + return; } @@ -573,7 +578,7 @@ sub missing_config_data { #"gzip", "http_proxy", "index_expire", - "inhibit_startup_message", + #"inhibit_startup_message", "keep_source_where", #"make", "make_arg", @@ -592,7 +597,7 @@ sub missing_config_data { "urllist", ) { next unless exists $keys{$_}; - push @miss, $_ unless defined $CPAN::Config->{$_}; + push @miss, $_ unless defined $CPAN::Config->{$_}; } return @miss; } @@ -622,17 +627,17 @@ sub cpl { CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; my(@words) = split " ", substr($line,0,$pos+1); if ( - defined($words[2]) - and + defined($words[2]) + and $words[2] =~ /list$/ and - ( - @words == 3 - || - @words == 4 && length($word) - ) + ( + @words == 3 + || + @words == 4 && length($word) + ) ) { - return grep /^\Q$word\E/, qw(splice shift unshift pop push); + return grep /^\Q$word\E/, qw(splice shift unshift pop push); } elsif (defined($words[2]) and $words[2] eq "init" @@ -642,9 +647,9 @@ sub cpl { || @words >= 4 && length($word) )) { - return sort grep /^\Q$word\E/, keys %keys; + return sort grep /^\Q$word\E/, keys %keys; } elsif (@words >= 4) { - return (); + return (); } my %seen; my(@o_conf) = sort grep { !$seen{$_}++ } @@ -685,10 +690,11 @@ sub prefs_lookup { use strict; use vars qw($AUTOLOAD $VERSION); - $VERSION = sprintf "%.2f", substr(q$Rev: 1744 $,4)/100; + $VERSION = sprintf "%.2f", substr(q$Rev: 2212 $,4)/100; # formerly CPAN::HandleConfig was known as CPAN::Config sub AUTOLOAD { + my $class = shift; # e.g. in dh-make-perl: CPAN::Config my($l) = $AUTOLOAD; $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n"); $l =~ s/.*:://; diff --git a/lib/CPAN/Kwalify/distroprefs.dd b/lib/CPAN/Kwalify/distroprefs.dd index 392c821..52118e5 100644 --- a/lib/CPAN/Kwalify/distroprefs.dd +++ b/lib/CPAN/Kwalify/distroprefs.dd @@ -11,6 +11,21 @@ $VAR1 = { }, "type" => "map" }, + "depends" => { + "mapping" => { + "build_requires" => { + "mapping" => { + "=" => { + "type" => "text" + } + }, + "type" => "map" + }, + "configure_requires" => {}, + "requires" => {} + }, + "type" => "map" + }, "disabled" => { "enum" => [ 0, @@ -43,6 +58,9 @@ $VAR1 = { ], "type" => "text" }, + "reuse" => { + "type" => "int" + }, "talk" => { "sequence" => [ { @@ -112,6 +130,8 @@ $VAR1 = { }, "type" => "map" }; +$VAR1->{"mapping"}{"depends"}{"mapping"}{"configure_requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"}; +$VAR1->{"mapping"}{"depends"}{"mapping"}{"requires"} = $VAR1->{"mapping"}{"depends"}{"mapping"}{"build_requires"}; $VAR1->{"mapping"}{"make"} = $VAR1->{"mapping"}{"install"}; $VAR1->{"mapping"}{"pl"} = $VAR1->{"mapping"}{"install"}; $VAR1->{"mapping"}{"test"} = $VAR1->{"mapping"}{"install"}; diff --git a/lib/CPAN/Kwalify/distroprefs.yml b/lib/CPAN/Kwalify/distroprefs.yml index 60a4372..68ff72b 100644 --- a/lib/CPAN/Kwalify/distroprefs.yml +++ b/lib/CPAN/Kwalify/distroprefs.yml @@ -3,6 +3,17 @@ type: map mapping: comment: type: text + depends: + type: map + mapping: + configure_requires: + &requires_common + type: map + mapping: + =: + type: text + build_requires: *requires_common + requires: *requires_common match: type: map mapping: @@ -46,6 +57,8 @@ mapping: - anyorder timeout: type: number + reuse: + type: int talk: type: seq sequence: diff --git a/lib/CPAN/Queue.pm b/lib/CPAN/Queue.pm index dac56f5..f01ab51 100644 --- a/lib/CPAN/Queue.pm +++ b/lib/CPAN/Queue.pm @@ -1,6 +1,26 @@ # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- -package CPAN::Queue; use strict; +package CPAN::Queue::Item; + +# CPAN::Queue::Item::new ; +sub new { + my($class,@attr) = @_; + my $self = bless { @attr }, $class; + return $self; +} + +sub as_string { + my($self) = @_; + $self->{qmod}; +} + +# r => requires, b => build_requires, c => commandline +sub reqtype { + my($self) = @_; + $self->{reqtype}; +} + +package CPAN::Queue; # One use of the queue is to determine if we should or shouldn't # announce the availability of a new CPAN module @@ -45,49 +65,43 @@ use strict; # tell the distribution object that it should ask the user before # processing. Where would the question be triggered then? Most probably # in CPAN::Distribution::rematein. -# Hope that makes sense, my head is a bit off:-) -- AK use vars qw{ @All $VERSION }; -$VERSION = sprintf "%.6f", substr(q$Rev: 1704 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4; + +# CPAN::Queue::queue_item ; +sub queue_item { + my($class,@attr) = @_; + my $item = "$class\::Item"->new(@attr); + $class->qpush($item); + return 1; +} -# CPAN::Queue::new ; -sub new { - my($class,@attr) = @_; - my $self = bless { @attr }, $class; - push @All, $self; - CPAN->debug(sprintf("in new All[%s]", - join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All), - )) if $CPAN::DEBUG; - return $self; +# CPAN::Queue::qpush ; +sub qpush { + my($class,$obj) = @_; + push @All, $obj; + CPAN->debug(sprintf("in new All[%s]", + join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All), + )) if $CPAN::DEBUG; } # CPAN::Queue::first ; sub first { - my $obj = $All[0]; - $obj; -} - -sub as_string { - my($self) = @_; - $self->{qmod}; -} - -# r => requires, b => build_requires, c => commandline -sub reqtype { - my($self) = @_; - $self->{reqtype}; + my $obj = $All[0]; + $obj; } # CPAN::Queue::delete_first ; sub delete_first { - my($class,$what) = @_; - my $i; - for my $i (0..$#All) { - if ( $All[$i]->{qmod} eq $what ) { - splice @All, $i, 1; - return; + my($class,$what) = @_; + my $i; + for my $i (0..$#All) { + if ( $All[$i]->{qmod} eq $what ) { + splice @All, $i, 1; + return; + } } - } } # CPAN::Queue::jumpqueue ; @@ -95,17 +109,17 @@ sub jumpqueue { my $class = shift; my @what = @_; CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]", - join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All), - join("",map {sprintf " %s\[%s]",$_->[0],$_->[1]} @what) - )) if $CPAN::DEBUG; - unless (defined $what[0][1]) { + join("", + map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All, @what + ))) if $CPAN::DEBUG; + unless (defined $what[0]{reqtype}) { # apparently it was not the Shell that sent us this enquiry, # treat it as commandline - $what[0][1] = "c"; - } - my $inherit_reqtype = $what[0][1] =~ /^(c|r)$/ ? "r" : "b"; + $what[0]{reqtype} = "c"; + } + my $inherit_reqtype = $what[0]{reqtype} =~ /^(c|r)$/ ? "r" : "b"; WHAT: for my $what_tuple (@what) { - my($what,$reqtype) = @$what_tuple; + my($what,$reqtype) = @$what_tuple{qw(qmod reqtype)}; if ($reqtype eq "r" && $inherit_reqtype eq "b" @@ -115,24 +129,27 @@ sub jumpqueue { my $jumped = 0; for (my $i=0; $i<$#All;$i++) { #prevent deep recursion # CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG; - if ($All[$i]{qmod} eq $what){ + if ($All[$i]{qmod} eq $what) { $jumped++; - if ($jumped > 25) { # one's OK if e.g. just processing + if ($jumped >= 50) { + die "PANIC: object[$what] 50 instances on the queue, looks like ". + "some recursiveness has hit"; + } elsif ($jumped > 25) { # one's OK if e.g. just processing # now; more are OK if user typed # it several times my $sleep = sprintf "%.1f", $jumped/10; $CPAN::Frontend->mywarn( qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n} - ); + ); $CPAN::Frontend->mysleep($sleep); # next WHAT; } } } - my $obj = bless { - qmod => $what, - reqtype => $reqtype - }, $class; + my $obj = "$class\::Item"->new( + qmod => $what, + reqtype => $reqtype + ); unshift @All, $obj; } CPAN->debug(sprintf("after jumpqueue All[%s]", @@ -142,26 +159,26 @@ qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n} # CPAN::Queue::exists ; sub exists { - my($self,$what) = @_; - my @all = map { $_->{qmod} } @All; - my $exists = grep { $_->{qmod} eq $what } @All; - # warn "in exists what[$what] all[@all] exists[$exists]"; - $exists; + my($self,$what) = @_; + my @all = map { $_->{qmod} } @All; + my $exists = grep { $_->{qmod} eq $what } @All; + # warn "in exists what[$what] all[@all] exists[$exists]"; + $exists; } # CPAN::Queue::delete ; sub delete { - my($self,$mod) = @_; - @All = grep { $_->{qmod} ne $mod } @All; - CPAN->debug(sprintf("after delete mod[%s] All[%s]", - $mod, - join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All) - )) if $CPAN::DEBUG; + my($self,$mod) = @_; + @All = grep { $_->{qmod} ne $mod } @All; + CPAN->debug(sprintf("after delete mod[%s] All[%s]", + $mod, + join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All) + )) if $CPAN::DEBUG; } # CPAN::Queue::nullify_queue ; sub nullify_queue { - @All = (); + @All = (); } 1; diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm index 88e8ef5..a9cad24 100644 --- a/lib/CPAN/Tarzip.pm +++ b/lib/CPAN/Tarzip.pm @@ -1,10 +1,10 @@ -# -*- 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); @@ -12,173 +12,173 @@ $BUGHUNTING ||= 0; # released code must have turned off # 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); + } } @@ -197,140 +197,147 @@ sub DESTROY { 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; diff --git a/lib/CPAN/Version.pm b/lib/CPAN/Version.pm index d279134..c306634 100644 --- a/lib/CPAN/Version.pm +++ b/lib/CPAN/Version.pm @@ -2,68 +2,68 @@ package CPAN::Version; use strict; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 1387 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 2210 $,4)/1000000 + 5.4; # CPAN::Version::vcmp courtesy Jost Krieger sub vcmp { - my($self,$l,$r) = @_; - local($^W) = 0; - CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; - - return 0 if $l eq $r; # short circuit for quicker success - - for ($l,$r) { - s/_//g; - } - CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; - for ($l,$r) { - next unless tr/.// > 1; - s/^v?/v/; - 1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group - } - CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; - if ($l=~/^v/ <=> $r=~/^v/) { - for ($l,$r) { - next if /^v/; - $_ = $self->float2vv($_); - } - } - CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; - my $lvstring = "v0"; - my $rvstring = "v0"; - if ($] >= 5.006 - && $l =~ /^v/ - && $r =~ /^v/) { - $lvstring = $self->vstring($l); - $rvstring = $self->vstring($r); - CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG; - } - - return ( - ($l ne "undef") <=> ($r ne "undef") - || - $lvstring cmp $rvstring - || - $l <=> $r - || - $l cmp $r - ); + my($self,$l,$r) = @_; + local($^W) = 0; + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + + return 0 if $l eq $r; # short circuit for quicker success + + for ($l,$r) { + s/_//g; + } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + for ($l,$r) { + next unless tr/.// > 1 || /^v/; + s/^v?/v/; + 1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group + } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + if ($l=~/^v/ <=> $r=~/^v/) { + for ($l,$r) { + next if /^v/; + $_ = $self->float2vv($_); + } + } + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + my $lvstring = "v0"; + my $rvstring = "v0"; + if ($] >= 5.006 + && $l =~ /^v/ + && $r =~ /^v/) { + $lvstring = $self->vstring($l); + $rvstring = $self->vstring($r); + CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG; + } + + return ( + ($l ne "undef") <=> ($r ne "undef") + || + $lvstring cmp $rvstring + || + $l <=> $r + || + $l cmp $r + ); } sub vgt { - my($self,$l,$r) = @_; - $self->vcmp($l,$r) > 0; + my($self,$l,$r) = @_; + $self->vcmp($l,$r) > 0; } sub vlt { - my($self,$l,$r) = @_; - 0 + ($self->vcmp($l,$r) < 0); + my($self,$l,$r) = @_; + 0 + ($self->vcmp($l,$r) < 0); } sub vstring { - my($self,$n) = @_; - $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]"; - pack "U*", split /\./, $n; + my($self,$n) = @_; + $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]"; + pack "U*", split /\./, $n; } # vv => visible vstring @@ -82,35 +82,36 @@ sub float2vv { $ret .= ".".int($1); } # warn "n[$n]ret[$ret]"; + $ret =~ s/(\.0)+/.0/; # v1.0.0 => v1.0 $ret; } sub readable { - my($self,$n) = @_; - $n =~ /^([\w\-\+\.]+)/; - - return $1 if defined $1 && length($1)>0; - # if the first user reaches version v43, he will be treated as "+". - # We'll have to decide about a new rule here then, depending on what - # will be the prevailing versioning behavior then. - - if ($] < 5.006) { # or whenever v-strings were introduced - # we get them wrong anyway, whatever we do, because 5.005 will - # have already interpreted 0.2.4 to be "0.24". So even if he - # indexer sends us something like "v0.2.4" we compare wrongly. - - # And if they say v1.2, then the old perl takes it as "v12" - - if (defined $CPAN::Frontend) { - $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n"); - } else { - warn("Suspicious version string seen [$n]\n"); + my($self,$n) = @_; + $n =~ /^([\w\-\+\.]+)/; + + return $1 if defined $1 && length($1)>0; + # if the first user reaches version v43, he will be treated as "+". + # We'll have to decide about a new rule here then, depending on what + # will be the prevailing versioning behavior then. + + if ($] < 5.006) { # or whenever v-strings were introduced + # we get them wrong anyway, whatever we do, because 5.005 will + # have already interpreted 0.2.4 to be "0.24". So even if he + # indexer sends us something like "v0.2.4" we compare wrongly. + + # And if they say v1.2, then the old perl takes it as "v12" + + if (defined $CPAN::Frontend) { + $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n"); + } else { + warn("Suspicious version string seen [$n]\n"); + } + return $n; } - return $n; - } - my $better = sprintf "v%vd", $n; - CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG; - return $better; + my $better = sprintf "v%vd", $n; + CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG; + return $better; } 1; @@ -158,5 +159,5 @@ modify it under the same terms as Perl itself. # Local Variables: # mode: cperl -# cperl-indent-level: 2 +# cperl-indent-level: 4 # End: diff --git a/lib/CPAN/t/03pkgs.t b/lib/CPAN/t/03pkgs.t index 5848c73..5abb96c 100644 --- a/lib/CPAN/t/03pkgs.t +++ b/lib/CPAN/t/03pkgs.t @@ -6,7 +6,7 @@ use lib "lib"; my @m; if ($ENV{PERL_CORE}){ - @m = ("CPAN", map { "CPAN::$_" } qw(Debug FirstTime Nox Queue Tarzip Version)); + @m = ("CPAN", map { "CPAN::$_" } qw(Debug DeferedCode FirstTime Nox Queue Tarzip Version)); } else { opendir DH, "lib/CPAN" or die; @m = ("CPAN", map { "CPAN::$_" } grep { s/\.pm$// } readdir DH); diff --git a/lib/CPAN/t/10version.t b/lib/CPAN/t/10version.t index 3c6978f..c1199e9 100644 --- a/lib/CPAN/t/10version.t +++ b/lib/CPAN/t/10version.t @@ -20,7 +20,7 @@ $N = scalar @$D; print "1..$N\n"; my $has_sort_versions = eval { require Sort::Versions; 1 }; -my $has_versionpm = eval { require version; 1 }; +my $has_versionpm = eval q{ use version 0.7203; 1 }; my $has_perl_versionpm = eval { require Perl::Version; 1 }; while (@$D) { my($l,$r,$exp) = @{shift @$D}; @@ -109,7 +109,18 @@ v1.0.22 122 -1 0.005.018 0.005018 0 4.008.000 4.008000 0 4.008.000 4.008 1 +v4.8 4.008 0 +v4.8.0 4.008000 0 v1.99.1_1 1.98 -1 +v2.3999 v2.4000 -1 +v2.3999 2.004000 1 +v2.3999 2.999999 1 +v2.1000 2.999999 1 +0123 123 -1 +v2.005 2.005 0 +v1.0 1.0 0 +v1.0 1.000 0 +v1.0 1.000000 0 __END__ # Local Variables: