diff options
Diffstat (limited to 'lib/CPAN')
| -rw-r--r-- | lib/CPAN/API/HOWTO.pm | 44 | ||||
| -rw-r--r-- | lib/CPAN/Debug.pm | 4 | ||||
| -rw-r--r-- | lib/CPAN/DeferedCode.pm | 16 | ||||
| -rw-r--r-- | lib/CPAN/FirstTime.pm | 1316 | ||||
| -rw-r--r-- | lib/CPAN/HandleConfig.pm | 266 | ||||
| -rw-r--r-- | lib/CPAN/Kwalify/distroprefs.dd | 20 | ||||
| -rw-r--r-- | lib/CPAN/Kwalify/distroprefs.yml | 13 | ||||
| -rw-r--r-- | lib/CPAN/Queue.pm | 135 | ||||
| -rw-r--r-- | lib/CPAN/Tarzip.pm | 525 | ||||
| -rw-r--r-- | lib/CPAN/Version.pm | 151 | ||||
| -rw-r--r-- | lib/CPAN/t/03pkgs.t | 2 | ||||
| -rw-r--r-- | lib/CPAN/t/10version.t | 13 |
12 files changed, 1352 insertions, 1153 deletions
diff --git a/lib/CPAN/API/HOWTO.pm b/lib/CPAN/API/HOWTO.pm new file mode 100644 index 0000000000..e65a4bc931 --- /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<http://www.perl.com/perl/misc/Artistic.html> + +=head1 AUTHOR + +David Cantrell + +=cut diff --git a/lib/CPAN/Debug.pm b/lib/CPAN/Debug.pm index 239fb6b0ea..086b623852 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 0000000000..c57669b177 --- /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 02a7f85b9e..d5d3e21763 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,6 +34,475 @@ 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). +In the following all questions and explanations regarding config +variables are collected. + +=cut + +# down until the next =back the manpage must be parsed by the program +# because the text is used in the init dialogues. + +=over 2 + +=item auto_commit + +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. + +Always commit changes to config variables to disk? + +=item build_cache + +CPAN.pm can limit the size of the disk area for keeping the build +directories with all the intermediate files. + +Cache size for build directory (in MB)? + +=item build_dir + +Directory where the build process takes place? + +=item build_dir_reuse + +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. + +Store and re-use state information about distributions between +CPAN.pm sessions? + +=item build_requires_install_policy + +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). + +Policy on installing 'build_requires' modules (yes, no, ask/yes, +ask/no)? + +=item cache_metadata + +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 (yes/no)? + +=item check_sigs + +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. + +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. + +Note that if you do not have Module::Signature installed, no signature +checks will be performed at all. + +Always try to check and verify signatures if a SIGNATURE file is in +the package and Module::Signature is installed (yes/no)? + +=item colorize_output + +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? + +=item colorize_print + +Color for normal output? + +=item colorize_warn + +Color for warnings? + +=item colorize_debug + +Color for debugging messages? + +=item commandnumber_in_prompt + +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)? + +=item ftp_passive + +Shall we always set the FTP_PASSIVE environment variable when dealing +with ftp download (yes/no)? + +=item getcwd + +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 + +Preferred method for determining the current working directory? + +=item histfile + +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. + +File to save your history? + +=item histsize + +Number of lines to save? + +=item inactivity_timeout + +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. + +If you set this value to 0, these processes will wait forever. This is +the default and recommended setting. + +Timeout for inactivity during {Makefile,Build}.PL? + +=item index_expire + +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. + +Let the index expire after how many days? + +=item inhibit_startup_message + +When the CPAN shell is started it normally displays a greeting message +that contains the running version and the status of readline support. + +Do you want to turn this message off? + +=item keep_source_where + +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. + +Download target directory? + +=item load_module_verbosity + +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. + +Verbosity level for loading modules (none or v)? + +=item makepl_arg + +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 you don't understand this question, just press ENTER. + +Typical frequently used settings: + + PREFIX=~/perl # non-root users (please see manual for more hints) + +Parameters for the 'perl Makefile.PL' command? + +=item make_arg + +Parameters for the 'make' command? Typical frequently used setting: + + -j3 # dual processor system (on GNU make) + +Your choice: + +=item make_install_arg + +Parameters for the 'make install' command? +Typical frequently used setting: + + UNINST=1 # to always uninstall potentially conflicting files + +Your choice: + +=item make_install_make_command + +Do you want to use a different make command for 'make install'? +Cautious people will probably prefer: + + su root -c make + or + sudo make + or + /path1/to/sudo -u admin_account /path2/to/make + +or some such. Your choice: + +=item mbuildpl_arg + +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. + +Typical frequently used settings: + + --install_base /home/xxx # different installation directory + +Parameters for the 'perl Build.PL' command? + +=item mbuild_arg + +Parameters for the './Build' command? Setting might be: + + --extra_linker_flags -L/usr/foo/lib # non-standard library location + +Your choice: + +=item mbuild_install_arg + +Parameters for the './Build install' command? Typical frequently used +setting: + + --uninst 1 # uninstall conflicting files + +Your choice: + +=item mbuild_install_build_command + +Do you want to use a different command for './Build install'? Sudo +users will probably prefer: + + su root -c ./Build + or + sudo ./Build + or + /path1/to/sudo -u admin_account ./Build + +or some such. Your choice: + +=item pager + +What is your favorite pager program? + +=item prefer_installer + +When you have Module::Build installed and a module comes with both a +Makefile.PL and a Build.PL, which shall have precedence? + +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. + +Or, as a third option you can choose RAND which will make a random +decision (something regular CPAN testers will enjoy). + +In case you can choose between running a Makefile.PL or a Build.PL, +which installer would you prefer (EUMM or MB or RAND)? + +=item prefs_dir + +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. + +Directory where to store default options/environment/dialogs for +building modules that need some customization? + +=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. + +Policy on building prerequisites (follow, ask or ignore)? + +=item randomize_urllist + +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 parameter + +=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'. + +Perform cache scanning (atstart or never)? + +=item shell + +What is your favorite shell? + +=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. + +Show all individual modules that have no $VERSION? + +=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 +internet. If you set the 'show_upload_date' variable to true, 'm' and +'d' will additionally show you the upload date of the module or +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)? + +=item show_zero_versions + +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. + +Show all individual modules that have a $VERSION of zero? + +=item tar_verbosity + +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. + +Tar command verbosity level (none or v or vv)? + +=item term_is_latin + +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. + +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. + +Do you want to turn ornaments on? + +=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 +possible. This provides valuable feedback to module authors and +potential users to identify bugs or platform compatibility issues and +improves the overall quality and value of CPAN. + +One way you can contribute is to send test results for each module +that you install. If you install the CPAN::Reporter module, you have +the option to automatically generate and email test reports to CPAN +Testers whenever you run tests on a CPAN package. + +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)? + +=item use_sqlite + +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. + +Use CPAN::SQLite if available? (yes/no)? + +=item yaml_load_code + +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. + +Do you want to enable code deserialisation (yes/no)? + +=item yaml_module + +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. + +Which YAML implementation would you prefer? + +=back + =head1 LICENSE This program is free software; you can redistribute it and/or @@ -78,7 +547,7 @@ sub init { CPAN->debug("matcher[$matcher]") if $CPAN::DEBUG; unless ($CPAN::VERSION) { - require CPAN::Nox; + require CPAN::Nox; } require CPAN::HandleConfig; CPAN::HandleConfig::require_myconfig_or_config(); @@ -112,43 +581,43 @@ sub init { 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 ($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{ @@ -157,7 +626,7 @@ sub init { cpan_home keep_source_where prefs_dir - } =~ /$matcher/){ + } =~ /$matcher/) { $CPAN::Frontend->myprint($prompts{config_intro}); if (!$matcher or 'cpan_home' =~ /$matcher/) { @@ -180,7 +649,9 @@ Shall we use it as the general CPAN build and cache directory? $default = $cpan_home; my $loop = 0; my $last_ans; + $CPAN::Frontend->myprint(" <cpan_home>\n"); PROMPT: while ($ans = prompt("CPAN build and cache directory?",$default)) { + print "\n"; if (File::Spec->file_name_is_absolute($ans)) { my @cpan_home = split /[\/\\]/, $ans; DIR: for my $dir (@cpan_home) { @@ -201,16 +672,16 @@ Shall we use it as the general CPAN build and cache directory? "absolute path. Please specify ". "an absolute path\n"); $default = $absans; - next; + 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; + next PROMPT; } if (-d $ans && -w _) { - last; + last PROMPT; } else { $CPAN::Frontend->mywarn("Couldn't find directory $ans\n". "or directory is not writable. Please retry.\n"); @@ -237,7 +708,7 @@ Shall we use it as the general CPAN build and cache directory? } if (!$matcher or 'build_dir_reuse' =~ /$matcher/) { - my_yn_prompt(build_dir_reuse => "y", $matcher); + my_yn_prompt(build_dir_reuse => 1, $matcher); } if (!$matcher or 'prefs_dir' =~ /$matcher/) { @@ -258,7 +729,7 @@ Shall we use it as the general CPAN build and cache directory? #= Cache size, Index expire # - if (!$matcher or 'build_cache' =~ /$matcher/){ + if (!$matcher or 'build_cache' =~ /$matcher/) { # large enough to build large dists like Tk my_dflt_prompt(build_cache => 100, $matcher); } @@ -267,8 +738,7 @@ Shall we use it as the general CPAN build and cache directory? my_dflt_prompt(index_expire => 1, $matcher); } - if (!$matcher or 'scan_cache' =~ /$matcher/){ - $CPAN::Frontend->myprint($prompts{scan_cache_intro}); + if (!$matcher or 'scan_cache' =~ /$matcher/) { my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|never'); } @@ -283,16 +753,12 @@ Shall we use it as the general CPAN build and cache directory? #= Do we follow PREREQ_PM? # - if (!$matcher or 'prerequisites_policy' =~ /$matcher/){ - $CPAN::Frontend->myprint($prompts{prerequisites_policy_intro}); - + if (!$matcher or 'prerequisites_policy' =~ /$matcher/) { my_prompt_loop(prerequisites_policy => 'ask', $matcher, 'follow|ask|ignore'); } - if (!$matcher or 'build_requires_install_policy' =~ /$matcher/){ - $CPAN::Frontend->myprint($prompts{build_requires_install_policy_intro}); - + if (!$matcher or 'build_requires_install_policy' =~ /$matcher/) { my_prompt_loop(build_requires_install_policy => 'ask/yes', $matcher, 'yes|no|ask/yes|ask/no'); } @@ -310,7 +776,7 @@ Shall we use it as the general CPAN build and cache directory? if (!$matcher or 'test_report' =~ /$matcher/) { my_yn_prompt(test_report => 0, $matcher); if ( - $CPAN::Config->{test_report} && + $CPAN::Config->{test_report} && $CPAN::META->has_inst("CPAN::Reporter") && CPAN::Reporter->can('configure') ) { @@ -333,6 +799,13 @@ Shall we use it as the general CPAN build and cache directory? } # + #= YAML code deserialisation + # + if (!$matcher or "yaml_load_code" =~ /$matcher/) { + my_yn_prompt(yaml_load_code => 0, $matcher); + } + + # #= External programs # @@ -387,7 +860,7 @@ Shall we use it as the general CPAN build and cache directory? } $path ||= find_exe($progcall,\@path); - unless ($path){ # not -e $path, because find_exe already checked that + 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") { @@ -412,18 +885,17 @@ substitute. You can then revisit this dialog with } } } - $ans = prompt("Where is your $progname program?",$path) || $path; - $CPAN::Config->{$progname} = $ans; + $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) || + 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; + my_dflt_prompt(pager => $path, $matcher); } if (!$matcher or 'shell' =~ /$matcher/) { @@ -438,23 +910,36 @@ substitute. You can then revisit this dialog with 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; + $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only + my_dflt_prompt(shell => $path, $matcher); } } # - #= Installer, arguments to make etc. + # verbosity # - if (!$matcher or 'prefer_installer' =~ /$matcher/){ - $CPAN::Frontend->myprint($prompts{prefer_installer_intro}); + 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. + # - my_prompt_loop(prefer_installer => 'EUMM', $matcher, 'MB|EUMM'); + if (!$matcher or 'prefer_installer' =~ /$matcher/) { + my_prompt_loop(prefer_installer => 'MB', $matcher, 'MB|EUMM|RAND'); } - if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/){ + if (!$matcher or 'makepl_arg make_arg' =~ /$matcher/) { my_dflt_prompt(makepl_arg => "", $matcher); my_dflt_prompt(make_arg => "", $matcher); } @@ -467,13 +952,11 @@ substitute. You can then revisit this dialog with $matcher); } - my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "", - $matcher); + my_dflt_prompt(make_install_arg => $CPAN::Config->{make_arg} || "", + $matcher); - if (!$matcher or 'mbuildpl_arg mbuild_arg' =~ /$matcher/){ - my_dflt_prompt(mbuildpl_arg => "", $matcher); - my_dflt_prompt(mbuild_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 @@ -487,12 +970,7 @@ substitute. You can then revisit this dialog with #= Alarm period # - 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); - } + my_dflt_prompt(inactivity_timeout => 0, $matcher); # #= Proxies @@ -500,14 +978,12 @@ substitute. You can then revisit this dialog with 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/){ + if (!$matcher or "@proxy_vars @proxy_user_vars" =~ /$matcher/) { $CPAN::Frontend->myprint($prompts{proxy_intro}); for (@proxy_vars) { - if (!$matcher or /$matcher/){ - $default = $CPAN::Config->{$_} || $ENV{$_} || ""; - $CPAN::Config->{$_} = prompt("Your $_?",$default); - } + $prompts{$_} = "Your $_?"; + my_dflt_prompt($_ => $ENV{$_}||"", $matcher); } if ($CPAN::Config->{ftp_proxy} || @@ -544,9 +1020,7 @@ substitute. You can then revisit this dialog with #= how cwd works # - if (!$matcher or 'getcwd' =~ /$matcher/){ - $CPAN::Frontend->myprint($prompts{getcwd_intro}); - + if (!$matcher or 'getcwd' =~ /$matcher/) { my_prompt_loop(getcwd => 'cwd', $matcher, 'cwd|getcwd|fastcwd|backtickcwd'); } @@ -563,7 +1037,7 @@ substitute. You can then revisit this dialog with if ($CPAN::META->has_inst("Term::ANSIColor")) { my $T="gYw"; print " on_ on_y ". - " on_ma on_\n"; + " on_ma on_\n"; print " on_black on_red green ellow ". "on_blue genta on_cyan white\n"; @@ -571,10 +1045,10 @@ substitute. You can then revisit this dialog with map {$_,"bold $_"} "black","red","green", "yellow","blue", "magenta", - "cyan","white"){ + "cyan","white") { printf "%12s ", $FG; for my $BG ("",map {"on_$_"} qw(black red green yellow - blue magenta cyan white)){ + blue magenta cyan white)) { print $FG||$BG ? Term::ANSIColor::colored(" $T ","$FG $BG") : " $T "; } @@ -603,8 +1077,7 @@ substitute. You can then revisit this dialog with #== term_is_latin # - if (!$matcher or 'term_is_latin' =~ /$matcher/){ - $CPAN::Frontend->myprint($prompts{term_is_latin}); + if (!$matcher or 'term_is_latin' =~ /$matcher/) { my_yn_prompt(term_is_latin => 1, $matcher); } @@ -616,34 +1089,36 @@ substitute. You can then revisit this dialog with $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; + my_dflt_prompt(histfile => $default, $matcher); if ($CPAN::Config->{histfile}) { defined($default = $CPAN::Config->{histsize}) or $default = 100; - $ans = prompt("Number of lines to save?", $default); - $CPAN::Config->{histsize} = $ans; + my_dflt_prompt(histsize => $default, $matcher); } } # #== 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); + 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 ($matcher) { if ("urllist" =~ $matcher) { # conf_sites would go into endless loop with the smash prompt local *_real_prompt; @@ -661,10 +1136,6 @@ substitute. You can then revisit this dialog with conf_sites(); } - # 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; - $CPAN::Frontend->myprint("\n\n"); if ($matcher && !$CPAN::Config->{auto_commit}) { $CPAN::Frontend->myprint("Please remember to call 'o conf commit' to ". @@ -683,9 +1154,11 @@ sub my_dflt_prompt { if (my $intro = $prompts{$item . "_intro"}) { $CPAN::Frontend->myprint($intro); } - $CPAN::Config->{$item} = prompt($prompts{$item}, $default); + $CPAN::Frontend->myprint(" <$item>\n"); + $CPAN::Config->{$item} = prompt($prompts{$item}, $default); + print "\n"; } else { - $CPAN::Config->{$item} = $default; + $CPAN::Config->{$item} = $default; } } @@ -694,15 +1167,17 @@ sub my_yn_prompt { my $default; defined($default = $CPAN::Config->{$item}) or $default = $dflt; - $DB::single = 1; + # $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::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; + $CPAN::Config->{$item} = $default; } } @@ -713,62 +1188,65 @@ sub my_prompt_loop { $DB::single = 1; if (!$m || $item =~ /$m/) { - do { $ans = prompt($prompts{$item}, $default); - } until $ans =~ /$ok/; - $CPAN::Config->{$item} = $ans; + $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; + $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 + 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; + my $ans = prompt($prompt,"y"); + $overwrite_local = 1 unless $ans =~ /^y/i; } - } - local $urllist = []; - read_mirrored_by($mby); - bring_your_own(); - $CPAN::Config->{urllist} = $urllist; + 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 { @@ -776,10 +1254,10 @@ sub find_exe { 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; - } + my $abs = File::Spec->catfile($dir,$exe); + if (($abs = MM->maybe_command($abs))) { + return $abs; + } } } @@ -811,7 +1289,7 @@ sub picklist { } my $i = scalar @$items; unrangify(\@nums); - if (grep (/\D/ || $_ < 1 || $_ > $i, @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"); @@ -872,18 +1350,18 @@ sub read_mirrored_by { $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=""; + ($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} ||= []; @@ -956,12 +1434,12 @@ sub bring_your_own { 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. + my $prompt = "Enter another URL or RETURN to quit:"; + unless (%seen) { + $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from. Please enter your CPAN site:}; - } + } $ans = prompt ($prompt, ""); if ($ans) { @@ -1038,7 +1516,6 @@ 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{ @@ -1046,348 +1523,28 @@ 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. - -}, +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{ - -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'. +First of all, I'd like to create this directory. Where? }, -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{ - -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. - -}, - -term_is_latin => qq{Your terminal expects ISO-8859-1 (yes/no)?}, - -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. - -}, - -histfile => qq{File to save your history?}, - -show_upload_date_intro => qq{ - -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 -internet. If you set the 'show_upload_date' variable to true, 'm' and -'d' will additionally show you the upload date of the module or -distribution. Per default this feature is off because it may require a -net connection to get at the upload date. - -}, - -show_upload_date => -"Always try to show upload date with 'd' and 'm' command (yes/no)?", - -prerequisites_policy_intro => qq{ - -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. - -}, - -prerequisites_policy => -"Policy on building prerequisites (follow, ask or ignore)?", - -check_sigs_intro => qq{ - -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. - -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. - -Note that if you do not have Module::Signature installed, no signature -checks will be performed at all. - -}, - -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)?}, - -test_report_intro => -qq{ - -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 -possible. This provides valuable feedback to module authors and -potential users to identify bugs or platform compatibility issues and -improves the overall quality and value of CPAN. - -One way you can contribute is to send test results for each module -that you install. If you install the CPAN::Reporter module, you have -the option to automatically generate and email test reports to CPAN -Testers whenever you run tests on a CPAN package. - -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. - -}, - -test_report => -qq{Email test reports if CPAN::Reporter is installed (yes/no)?}, - external_progs => qq{ The CPAN module will need a few external programs to work properly. -Please correct me, if I guess the wrong path for a program. Don\'t +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. }, -prefer_installer_intro => qq{ - -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. - -}, - -prefer_installer => -qq{In case you could choose, which installer would you prefer (EUMM or MB)?}, - -makepl_arg_intro => qq{ - -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 you don\'t understand this question, just press ENTER. -}, - -makepl_arg => qq{ -Parameters for the 'perl Makefile.PL' command? -Typical frequently used settings: - - PREFIX=~/perl # non-root users (please see manual for more hints) - -Your choice: }, - -make_arg => qq{Parameters for the 'make' command? -Typical frequently used setting: - - -j3 # dual processor system (on GNU make) - -Your choice: }, - - -make_install_make_command => qq{Do you want to use a different make command for 'make install'? -Cautious people will probably prefer: - - su root -c make -or - sudo make -or - /path1/to/sudo -u admin_account /path2/to/make - -or some such. Your choice: }, - - -make_install_arg => qq{Parameters for the 'make install' command? -Typical frequently used setting: - - UNINST=1 # to always uninstall potentially conflicting files - -Your choice: }, - - -mbuildpl_arg_intro => qq{ - -The next questions deal with Module::Build support. - -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. - -}, - -mbuildpl_arg => qq{Parameters for the 'perl Build.PL' command? -Typical frequently used settings: - - --install_base /home/xxx # different installation directory - -Your choice: }, - -mbuild_arg => qq{Parameters for the './Build' command? -Setting might be: - - --extra_linker_flags -L/usr/foo/lib # non-standard library location - -Your choice: }, - - -mbuild_install_build_command => qq{Do you want to use a different command for './Build install'? -Sudo users will probably prefer: - - su root -c ./Build -or - sudo ./Build -or - /path1/to/sudo -u admin_account ./Build - -or some such. Your choice: }, - - -mbuild_install_arg => qq{Parameters for the './Build install' command? -Typical frequently used setting: - - --uninst 1 # uninstall conflicting files - -Your choice: }, - - - -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. - -If you set this value to 0, these processes will wait forever. This is -the default and recommended setting. - -}, - -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 (<FH>) { + next if 1 .. /^=over/; + chomp; + push @podpara, $_; + last if /^=back/; +} +pop @podpara; +while (@podpara) { + warn "Alert: cannot parse my own manpage for init dialog" unless $podpara[0] =~ s/^=item\s+//; + my $name = shift @podpara; + my @para; + while (@podpara && $podpara[0] !~ /^=item/) { + push @para, shift @podpara; + } + $prompts{$name} = pop @para; + if (@para) { + $prompts{$name . "_intro"} = join "", map { "$_\n\n" } @para; } } diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm index 49a8a50d8e..ec0aefdab9 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(<<END); + $CPAN::Frontend->mywarn(<<END); Old configuration file $configpmtest moved to $configpm_bak END - } - } - my $fh = FileHandle->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(<<END); Sorry, we have to rerun the configuration dialog for CPAN.pm due to -the following indispensable but missing parameters: +some missing parameters... -@miss END $args{args} = \@miss; } - if (0) { - # where do we need this? - $CPAN::Frontend->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 392c821ab0..52118e5a98 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 60a43726d9..68ff72b5be 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 dac56f543a..f01ab5133d 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 88e8ef505f..a9cad24727 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 d2791349be..c306634148 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 5848c7354b..5abb96c071 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 3c6978f27b..c1199e99a7 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: |