1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.9205';
5 $CPAN::VERSION = eval $CPAN::VERSION if $CPAN::VERSION =~ /_/;
7 use CPAN::HandleConfig;
12 use CPAN::DeferedCode;
18 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
19 # 5.005_04 does not work without
21 use File::Basename ();
29 use Sys::Hostname qw(hostname);
30 use Text::ParseWords ();
35 # we need to run chdir all over and we would get at wrong libraries
38 if (File::Spec->can("rel2abs")) {
40 $inc = File::Spec->rel2abs($inc) unless ref $inc;
46 require Mac::BuildTools if $^O eq 'MacOS';
47 $ENV{PERL5_CPAN_IS_RUNNING}=$$;
48 $ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735
50 END { $CPAN::End++; &cleanup; }
53 $CPAN::Frontend ||= "CPAN::Shell";
54 unless (@CPAN::Defaultsites) {
55 @CPAN::Defaultsites = map {
56 CPAN::URL->new(TEXT => $_, FROM => "DEF")
58 "http://www.perl.org/CPAN/",
59 "ftp://ftp.perl.org/pub/CPAN/";
61 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
62 $CPAN::Perl ||= CPAN::find_perl();
63 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
64 $CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf";
65 $CPAN::Defaultrecent ||= "http://cpan.uwinnipeg.ca/htdocs/cpan.xml";
67 # our globals are getting a mess
93 @CPAN::ISA = qw(CPAN::Debug Exporter);
95 # note that these functions live in CPAN::Shell and get executed via
96 # AUTOLOAD when called directly
123 sub soft_chdir_with_alternatives ($);
126 $autoload_recursion ||= 0;
128 #-> sub CPAN::AUTOLOAD ;
130 $autoload_recursion++;
134 warn "Refusing to autoload '$l' while signal pending";
135 $autoload_recursion--;
138 if ($autoload_recursion > 1) {
139 my $fullcommand = join " ", map { "'$_'" } $l, @_;
140 warn "Refusing to autoload $fullcommand in recursion\n";
141 $autoload_recursion--;
145 @export{@EXPORT} = '';
146 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
147 if (exists $export{$l}) {
150 die(qq{Unknown CPAN command "$AUTOLOAD". }.
151 qq{Type ? for help.\n});
153 $autoload_recursion--;
157 #-> sub CPAN::shell ;
160 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
161 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
163 my $oprompt = shift || CPAN::Prompt->new;
164 my $prompt = $oprompt;
165 my $commandline = shift || "";
166 $CPAN::CurrentCommandId ||= 1;
169 unless ($Suppress_readline) {
170 require Term::ReadLine;
173 $term->ReadLine eq "Term::ReadLine::Stub"
175 $term = Term::ReadLine->new('CPAN Monitor');
177 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
178 my $attribs = $term->Attribs;
179 $attribs->{attempted_completion_function} = sub {
180 &CPAN::Complete::gnu_cpl;
183 $readline::rl_completion_function =
184 $readline::rl_completion_function = 'CPAN::Complete::cpl';
186 if (my $histfile = $CPAN::Config->{'histfile'}) {{
187 unless ($term->can("AddHistory")) {
188 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
191 $META->readhist($term,$histfile);
193 for ($CPAN::Config->{term_ornaments}) { # alias
194 local $Term::ReadLine::termcap_nowarn = 1;
195 $term->ornaments($_) if defined;
197 # $term->OUT is autoflushed anyway
198 my $odef = select STDERR;
206 my @cwd = grep { defined $_ and length $_ }
208 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
209 File::Spec->rootdir();
210 my $try_detect_readline;
211 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
212 unless ($CPAN::Config->{inhibit_startup_message}) {
213 my $rl_avail = $Suppress_readline ? "suppressed" :
214 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
215 "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)";
216 $CPAN::Frontend->myprint(
218 cpan shell -- CPAN exploration and modules installation (v%s)
226 my($continuation) = "";
227 my $last_term_ornaments;
228 SHELLCOMMAND: while () {
229 if ($Suppress_readline) {
230 if ($Echo_readline) {
234 last SHELLCOMMAND unless defined ($_ = <> );
235 if ($Echo_readline) {
236 # backdoor: I could not find a way to record sessions
241 last SHELLCOMMAND unless
242 defined ($_ = $term->readline($prompt, $commandline));
244 $_ = "$continuation$_" if $continuation;
246 next SHELLCOMMAND if /^$/;
248 if (/^(?:q(?:uit)?|bye|exit)$/i) {
259 use vars qw($import_done);
260 CPAN->import(':DEFAULT') unless $import_done++;
261 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
268 eval { @line = Text::ParseWords::shellwords($_) };
269 warn($@), next SHELLCOMMAND if $@;
270 warn("Text::Parsewords could not parse the line [$_]"),
271 next SHELLCOMMAND unless @line;
272 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
273 my $command = shift @line;
274 eval { CPAN::Shell->$command(@line) };
280 my $dv = Dumpvalue->new();
281 Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
291 # pragmas for classic commands
300 # only commands that tell us something about failed distros
301 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
303 soft_chdir_with_alternatives(\@cwd);
304 $CPAN::Frontend->myprint("\n");
306 $CPAN::CurrentCommandId++;
310 $commandline = ""; # I do want to be able to pass a default to
311 # shell, but on the second command I see no
314 CPAN::Queue->nullify_queue;
315 if ($try_detect_readline) {
316 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
318 $CPAN::META->has_inst("Term::ReadLine::Perl")
320 delete $INC{"Term/ReadLine.pm"};
322 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
323 require Term::ReadLine;
324 $CPAN::Frontend->myprint("\n$redef subroutines in ".
325 "Term::ReadLine redefined\n");
329 if ($term and $term->can("ornaments")) {
330 for ($CPAN::Config->{term_ornaments}) { # alias
332 if (not defined $last_term_ornaments
333 or $_ != $last_term_ornaments
335 local $Term::ReadLine::termcap_nowarn = 1;
336 $term->ornaments($_);
337 $last_term_ornaments = $_;
340 undef $last_term_ornaments;
344 for my $class (qw(Module Distribution)) {
345 # again unsafe meta access?
346 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
347 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
348 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
349 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
353 $GOTOSHELL = 0; # not too often
354 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
359 soft_chdir_with_alternatives(\@cwd);
362 #-> CPAN::soft_chdir_with_alternatives ;
363 sub soft_chdir_with_alternatives ($) {
366 my $root = File::Spec->rootdir();
367 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
368 Trying '$root' as temporary haven.
373 if (chdir $cwd->[0]) {
377 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
378 Trying to chdir to "$cwd->[1]" instead.
382 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
390 if ($Config::Config{d_flock}) {
391 return flock $fh, $mode;
392 } elsif (!$Have_warned->{"d_flock"}++) {
393 $CPAN::Frontend->mywarn("Your OS does not support locking; continuing and ignoring all locking issues\n");
394 $CPAN::Frontend->mysleep(5);
401 sub _yaml_module () {
402 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
404 $yaml_module ne "YAML"
406 !$CPAN::META->has_inst($yaml_module)
408 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
409 $yaml_module = "YAML";
411 if ($yaml_module eq "YAML"
413 $CPAN::META->has_inst($yaml_module)
415 $YAML::VERSION < 0.60
417 !$Have_warned->{"YAML"}++
419 $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n".
420 "I'll continue but problems are *very* likely to happen.\n"
422 $CPAN::Frontend->mysleep(5);
427 # CPAN::_yaml_loadfile
429 my($self,$local_file) = @_;
430 return +[] unless -s $local_file;
431 my $yaml_module = _yaml_module;
432 if ($CPAN::META->has_inst($yaml_module)) {
433 # temporarly enable yaml code deserialisation
435 # 5.6.2 could not do the local() with the reference
436 local $YAML::LoadCode;
437 local $YAML::Syck::LoadCode;
438 ${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
441 if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
443 eval { @yaml = $code->($local_file); };
445 # this shall not be done by the frontend
446 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
449 } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
451 open FH, $local_file or die "Could not open '$local_file': $!";
455 eval { @yaml = $code->($ystream); };
457 # this shall not be done by the frontend
458 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
463 # this shall not be done by the frontend
464 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
469 # CPAN::_yaml_dumpfile
471 my($self,$local_file,@what) = @_;
472 my $yaml_module = _yaml_module;
473 if ($CPAN::META->has_inst($yaml_module)) {
475 if (UNIVERSAL::isa($local_file, "FileHandle")) {
476 $code = UNIVERSAL::can($yaml_module, "Dump");
477 eval { print $local_file $code->(@what) };
478 } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
479 eval { $code->($local_file,@what); };
480 } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
482 open FH, ">$local_file" or die "Could not open '$local_file': $!";
483 print FH $code->(@what);
486 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
489 if (UNIVERSAL::isa($local_file, "FileHandle")) {
490 # I think this case does not justify a warning at all
492 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
497 sub _init_sqlite () {
498 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
499 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
500 unless $Have_warned->{"CPAN::SQLite"}++;
503 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
504 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
508 my $negative_cache = {};
509 sub _sqlite_running {
510 if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
511 # need to cache the result, otherwise too slow
512 return $negative_cache->{fact};
514 $negative_cache = {}; # reset
516 my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
517 return $ret if $ret; # fast anyway
518 $negative_cache->{time} = time;
519 return $negative_cache->{fact} = $ret;
523 package CPAN::CacheMgr;
525 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
530 use Fcntl qw(:flock);
531 use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
532 @CPAN::FTP::ISA = qw(CPAN::Debug);
534 package CPAN::LWP::UserAgent;
536 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
537 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
539 package CPAN::Complete;
541 @CPAN::Complete::ISA = qw(CPAN::Debug);
542 # Q: where is the "How do I add a new command" HOWTO?
543 # A: svn diff -r 1048:1049 where andk added the report command
544 @CPAN::Complete::COMMANDS = sort qw(
545 ? ! a b d h i m o q r u
580 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
581 @CPAN::Index::ISA = qw(CPAN::Debug);
584 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
587 package CPAN::InfoObj;
589 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
591 package CPAN::Author;
593 @CPAN::Author::ISA = qw(CPAN::InfoObj);
595 package CPAN::Distribution;
597 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
599 package CPAN::Bundle;
601 @CPAN::Bundle::ISA = qw(CPAN::Module);
603 package CPAN::Module;
605 @CPAN::Module::ISA = qw(CPAN::InfoObj);
607 package CPAN::Exception::RecursiveDependency;
609 use overload '""' => "as_string";
611 # a module sees its distribution (no version)
612 # a distribution sees its prereqs (which are module names) (usually with versions)
613 # a bundle sees its module names and/or its distributions (no version)
618 my (@deps,%seen,$loop_starts_with);
619 DCHAIN: for my $dep (@$deps) {
620 push @deps, {name => $dep, display_as => $dep};
622 $loop_starts_with = $dep;
627 for my $i (0..$#deps) {
628 my $x = $deps[$i]{name};
629 $in_loop ||= $x eq $loop_starts_with;
630 my $xo = CPAN::Shell->expandany($x) or next;
631 if ($xo->isa("CPAN::Module")) {
632 my $have = $xo->inst_version || "N/A";
633 my($want,$d,$want_type);
634 if ($i>0 and $d = $deps[$i-1]{name}) {
635 my $do = CPAN::Shell->expandany($d);
636 $want = $do->{prereq_pm}{requires}{$x};
638 $want_type = "requires: ";
640 $want = $do->{prereq_pm}{build_requires}{$x};
642 $want_type = "build_requires: ";
644 $want_type = "unknown status";
649 $want = $xo->cpan_version;
650 $want_type = "want: ";
652 $deps[$i]{have} = $have;
653 $deps[$i]{want_type} = $want_type;
654 $deps[$i]{want} = $want;
655 $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
656 } elsif ($xo->isa("CPAN::Distribution")) {
657 $deps[$i]{display_as} = $xo->pretty_id;
659 $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
661 $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
663 $xo->store_persistent_state; # otherwise I will not reach
664 # all involved parties for
668 bless { deps => \@deps }, $class;
673 my $ret = "\nRecursive dependency detected:\n ";
674 $ret .= join("\n => ", map {$_->{display_as}} @{$self->{deps}});
675 $ret .= ".\nCannot resolve.\n";
679 package CPAN::Exception::yaml_not_installed;
681 use overload '""' => "as_string";
684 my($class,$module,$file,$during) = @_;
685 bless { module => $module, file => $file, during => $during }, $class;
690 "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
693 package CPAN::Exception::yaml_process_error;
695 use overload '""' => "as_string";
698 my($class,$module,$file,$during,$error) = @_;
699 bless { module => $module,
702 error => $error }, $class;
707 if ($self->{during}) {
709 if ($self->{module}) {
710 if ($self->{error}) {
711 return "Alert: While trying to '$self->{during}' YAML file\n".
712 " '$self->{file}'\n".
713 "with '$self->{module}' the following error was encountered:\n".
716 return "Alert: While trying to '$self->{during}' YAML file\n".
717 " '$self->{file}'\n".
718 "with '$self->{module}' some unknown error was encountered\n";
721 return "Alert: While trying to '$self->{during}' YAML file\n".
722 " '$self->{file}'\n".
723 "some unknown error was encountered\n";
726 return "Alert: While trying to '$self->{during}' some YAML file\n".
727 "some unknown error was encountered\n";
730 return "Alert: unknown error encountered\n";
734 package CPAN::Prompt; use overload '""' => "as_string";
735 use vars qw($prompt);
737 $CPAN::CurrentCommandId ||= 0;
743 unless ($CPAN::META->{LOCK}) {
744 $word = "nolock_cpan";
746 if ($CPAN::Config->{commandnumber_in_prompt}) {
747 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
753 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
754 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
755 # planned are things like age or quality
757 my($class,%args) = @_;
769 $self->{TEXT} = $set;
774 package CPAN::Distrostatus;
775 use overload '""' => "as_string",
778 my($class,$arg) = @_;
781 FAILED => substr($arg,0,2) eq "NO",
782 COMMANDID => $CPAN::CurrentCommandId,
786 sub commandid { shift->{COMMANDID} }
787 sub failed { shift->{FAILED} }
791 $self->{TEXT} = $set;
811 @CPAN::Shell::ISA = qw(CPAN::Debug);
812 $COLOR_REGISTERED ||= 0;
815 '!' => "eval the rest of the line as perl",
817 autobundle => "wtite inventory into a bundle file",
818 b => "info about bundle",
820 clean => "clean up a distribution's build directory",
822 d => "info about a distribution",
825 failed => "list all failed actions within current session",
826 fforce => "redo a command from scratch",
827 force => "redo a command",
829 help => "overview over commands; 'help ...' explains specific commands",
830 hosts => "statistics about recently used hosts",
831 i => "info about authors/bundles/distributions/modules",
832 install => "install a distribution",
833 install_tested => "install all distributions tested OK",
834 is_tested => "list all distributions tested OK",
835 look => "open a subshell in a distribution's directory",
836 ls => "list distributions according to a glob",
837 m => "info about a module",
838 make => "make/build a distribution",
839 mkmyconfig => "write current config into a CPAN/MyConfig.pm file",
840 notest => "run a (usually install) command but leave out the test phase",
841 o => "'o conf ...' for config stuff; 'o debug ...' for debugging",
842 perldoc => "try to get a manpage for a module",
844 quit => "leave the cpan shell",
845 r => "review over upgradeable modules",
846 readme => "display the README of a distro woth a pager",
847 recent => "show recent uploads to the CPAN",
849 reload => "'reload cpan' or 'reload index'",
850 report => "test a distribution and send a test report to cpantesters",
851 reports => "info about reported tests from cpantesters",
854 test => "test a distribution",
855 u => "display uninstalled modules",
856 upgrade => "combine 'r' command with immediate installation",
859 $autoload_recursion ||= 0;
861 #-> sub CPAN::Shell::AUTOLOAD ;
863 $autoload_recursion++;
865 my $class = shift(@_);
866 # warn "autoload[$l] class[$class]";
869 warn "Refusing to autoload '$l' while signal pending";
870 $autoload_recursion--;
873 if ($autoload_recursion > 1) {
874 my $fullcommand = join " ", map { "'$_'" } $l, @_;
875 warn "Refusing to autoload $fullcommand in recursion\n";
876 $autoload_recursion--;
880 # XXX needs to be reconsidered
881 if ($CPAN::META->has_inst('CPAN::WAIT')) {
884 $CPAN::Frontend->mywarn(qq{
885 Commands starting with "w" require CPAN::WAIT to be installed.
886 Please consider installing CPAN::WAIT to use the fulltext index.
887 For this you just need to type
892 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
896 $autoload_recursion--;
903 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
905 # from here on only subs.
906 ################################################################################
908 sub _perl_fingerprint {
909 my($self,$other_fingerprint) = @_;
910 my $dll = eval {OS2::DLLname()};
913 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
915 my $mtime_perl = (-f CPAN::find_perl ? (stat(_))[9] : '-1');
916 my $this_fingerprint = {
917 '$^X' => CPAN::find_perl,
918 sitearchexp => $Config::Config{sitearchexp},
919 'mtime_$^X' => $mtime_perl,
920 'mtime_dll' => $mtime_dll,
922 if ($other_fingerprint) {
923 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
924 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
926 # mandatory keys since 1.88_57
927 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
928 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
932 return $this_fingerprint;
936 sub suggest_myconfig () {
937 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
938 $CPAN::Frontend->myprint("You don't seem to have a user ".
939 "configuration (MyConfig.pm) yet.\n");
940 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
941 "user configuration now? (Y/n)",
944 CPAN::Shell->mkmyconfig();
947 $CPAN::Frontend->mydie("OK, giving up.");
952 #-> sub CPAN::all_objects ;
954 my($mgr,$class) = @_;
955 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
956 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
958 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
961 # Called by shell, not in batch mode. In batch mode I see no risk in
962 # having many processes updating something as installations are
963 # continually checked at runtime. In shell mode I suspect it is
964 # unintentional to open more than one shell at a time
966 #-> sub CPAN::checklock ;
969 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
970 if (-f $lockfile && -M _ > 0) {
971 my $fh = FileHandle->new($lockfile) or
972 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
973 my $otherpid = <$fh>;
974 my $otherhost = <$fh>;
976 if (defined $otherpid && $otherpid) {
979 if (defined $otherhost && $otherhost) {
982 my $thishost = hostname();
983 if (defined $otherhost && defined $thishost &&
984 $otherhost ne '' && $thishost ne '' &&
985 $otherhost ne $thishost) {
986 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
987 "reports other host $otherhost and other ".
988 "process $otherpid.\n".
989 "Cannot proceed.\n"));
990 } elsif ($RUN_DEGRADED) {
991 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
992 } elsif (defined $otherpid && $otherpid) {
993 return if $$ == $otherpid; # should never happen
994 $CPAN::Frontend->mywarn(
996 There seems to be running another CPAN process (pid $otherpid). Contacting...
998 if (kill 0, $otherpid) {
999 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
1001 CPAN::Shell::colorable_makemaker_prompt
1002 (qq{Shall I try to run in degraded }.
1003 qq{mode? (Y/n)},"y");
1004 if ($ans =~ /^y/i) {
1005 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
1006 Please report if something unexpected happens\n");
1008 for ($CPAN::Config) {
1010 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
1011 $_->{commandnumber_in_prompt} = 0; # visibility
1012 $_->{histfile} = ""; # who should win otherwise?
1013 $_->{cache_metadata} = 0; # better would be a lock?
1014 $_->{use_sqlite} = 0; # better would be a write lock!
1017 $CPAN::Frontend->mydie("
1018 You may want to kill the other job and delete the lockfile. On UNIX try:
1023 } elsif (-w $lockfile) {
1025 CPAN::Shell::colorable_makemaker_prompt
1026 (qq{Other job not responding. Shall I overwrite }.
1027 qq{the lockfile '$lockfile'? (Y/n)},"y");
1028 $CPAN::Frontend->myexit("Ok, bye\n")
1029 unless $ans =~ /^y/i;
1032 qq{Lockfile '$lockfile' not writeable by you. }.
1033 qq{Cannot proceed.\n}.
1034 qq{ On UNIX try:\n}.
1035 qq{ rm '$lockfile'\n}.
1036 qq{ and then rerun us.\n}
1040 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
1041 "'$lockfile', please remove. Cannot proceed.\n"));
1044 my $dotcpan = $CPAN::Config->{cpan_home};
1045 eval { File::Path::mkpath($dotcpan);};
1047 # A special case at least for Jarkko.
1048 my $firsterror = $@;
1052 $symlinkcpan = readlink $dotcpan;
1053 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
1054 eval { File::Path::mkpath($symlinkcpan); };
1058 $CPAN::Frontend->mywarn(qq{
1059 Working directory $symlinkcpan created.
1063 unless (-d $dotcpan) {
1065 Your configuration suggests "$dotcpan" as your
1066 CPAN.pm working directory. I could not create this directory due
1067 to this error: $firsterror\n};
1069 As "$dotcpan" is a symlink to "$symlinkcpan",
1070 I tried to create that, but I failed with this error: $seconderror
1073 Please make sure the directory exists and is writable.
1075 $CPAN::Frontend->mywarn($mess);
1076 return suggest_myconfig;
1078 } # $@ after eval mkpath $dotcpan
1079 if (0) { # to test what happens when a race condition occurs
1080 for (reverse 1..10) {
1086 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
1088 unless ($fh = FileHandle->new("+>>$lockfile")) {
1089 if ($! =~ /Permission/) {
1090 $CPAN::Frontend->mywarn(qq{
1092 Your configuration suggests that CPAN.pm should use a working
1094 $CPAN::Config->{cpan_home}
1095 Unfortunately we could not create the lock file
1097 due to permission problems.
1099 Please make sure that the configuration variable
1100 \$CPAN::Config->{cpan_home}
1101 points to a directory where you can write a .lock file. You can set
1102 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
1105 return suggest_myconfig;
1109 while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) {
1111 $CPAN::Frontend->mydie("Giving up\n");
1113 $CPAN::Frontend->mysleep($sleep++);
1114 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
1120 $fh->print($$, "\n");
1121 $fh->print(hostname(), "\n");
1122 $self->{LOCK} = $lockfile;
1123 $self->{LOCKFH} = $fh;
1128 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
1133 &cleanup if $Signal;
1134 die "Got yet another signal" if $Signal > 1;
1135 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
1136 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
1140 # From: Larry Wall <larry@wall.org>
1141 # Subject: Re: deprecating SIGDIE
1142 # To: perl5-porters@perl.org
1143 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
1145 # The original intent of __DIE__ was only to allow you to substitute one
1146 # kind of death for another on an application-wide basis without respect
1147 # to whether you were in an eval or not. As a global backstop, it should
1148 # not be used any more lightly (or any more heavily :-) than class
1149 # UNIVERSAL. Any attempt to build a general exception model on it should
1150 # be politely squashed. Any bug that causes every eval {} to have to be
1151 # modified should be not so politely squashed.
1153 # Those are my current opinions. It is also my optinion that polite
1154 # arguments degenerate to personal arguments far too frequently, and that
1155 # when they do, it's because both people wanted it to, or at least didn't
1156 # sufficiently want it not to.
1160 # global backstop to cleanup if we should really die
1161 $SIG{__DIE__} = \&cleanup;
1162 $self->debug("Signal handler set.") if $CPAN::DEBUG;
1165 #-> sub CPAN::DESTROY ;
1167 &cleanup; # need an eval?
1170 #-> sub CPAN::anycwd ;
1173 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
1178 sub cwd {Cwd::cwd();}
1180 #-> sub CPAN::getcwd ;
1181 sub getcwd {Cwd::getcwd();}
1183 #-> sub CPAN::fastcwd ;
1184 sub fastcwd {Cwd::fastcwd();}
1186 #-> sub CPAN::backtickcwd ;
1187 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
1189 #-> sub CPAN::find_perl ;
1191 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
1192 my $pwd = $CPAN::iCwd = CPAN::anycwd();
1193 my $candidate = File::Spec->catfile($pwd,$^X);
1194 $perl ||= $candidate if MM->maybe_command($candidate);
1197 my ($component,$perl_name);
1198 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
1199 PATH_COMPONENT: foreach $component (File::Spec->path(),
1200 $Config::Config{'binexp'}) {
1201 next unless defined($component) && $component;
1202 my($abs) = File::Spec->catfile($component,$perl_name);
1203 if (MM->maybe_command($abs)) {
1215 #-> sub CPAN::exists ;
1217 my($mgr,$class,$id) = @_;
1218 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1219 CPAN::Index->reload;
1220 ### Carp::croak "exists called without class argument" unless $class;
1222 $id =~ s/:+/::/g if $class eq "CPAN::Module";
1224 if (CPAN::_sqlite_running) {
1225 $exists = (exists $META->{readonly}{$class}{$id} or
1226 $CPAN::SQLite->set($class, $id));
1228 $exists = exists $META->{readonly}{$class}{$id};
1230 $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1233 #-> sub CPAN::delete ;
1235 my($mgr,$class,$id) = @_;
1236 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1237 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1240 #-> sub CPAN::has_usable
1241 # has_inst is sometimes too optimistic, we should replace it with this
1242 # has_usable whenever a case is given
1244 my($self,$mod,$message) = @_;
1245 return 1 if $HAS_USABLE->{$mod};
1246 my $has_inst = $self->has_inst($mod,$message);
1247 return unless $has_inst;
1250 LWP => [ # we frequently had "Can't locate object
1251 # method "new" via package "LWP::UserAgent" at
1252 # (eval 69) line 2006
1254 sub {require LWP::UserAgent},
1255 sub {require HTTP::Request},
1256 sub {require URI::URL},
1259 sub {require Net::FTP},
1260 sub {require Net::Config},
1262 'File::HomeDir' => [
1263 sub {require File::HomeDir;
1264 unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) {
1265 for ("Will not use File::HomeDir, need 0.52\n") {
1266 $CPAN::Frontend->mywarn($_);
1273 sub {require Archive::Tar;
1274 unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.00)) {
1275 for ("Will not use Archive::Tar, need 1.00\n") {
1276 $CPAN::Frontend->mywarn($_);
1283 # XXX we should probably delete from
1284 # %INC too so we can load after we
1285 # installed a new enough version --
1287 sub {require File::Temp;
1288 unless (CPAN::Version->vge(File::Temp::->VERSION,0.16)) {
1289 for ("Will not use File::Temp, need 0.16\n") {
1290 $CPAN::Frontend->mywarn($_);
1297 if ($usable->{$mod}) {
1298 for my $c (0..$#{$usable->{$mod}}) {
1299 my $code = $usable->{$mod}[$c];
1300 my $ret = eval { &$code() };
1301 $ret = "" unless defined $ret;
1303 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1308 return $HAS_USABLE->{$mod} = 1;
1311 #-> sub CPAN::has_inst
1313 my($self,$mod,$message) = @_;
1314 Carp::croak("CPAN->has_inst() called without an argument")
1315 unless defined $mod;
1316 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1317 keys %{$CPAN::Config->{dontload_hash}||{}},
1318 @{$CPAN::Config->{dontload_list}||[]};
1319 if (defined $message && $message eq "no" # afair only used by Nox
1323 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1331 # checking %INC is wrong, because $INC{LWP} may be true
1332 # although $INC{"URI/URL.pm"} may have failed. But as
1333 # I really want to say "bla loaded OK", I have to somehow
1335 ### warn "$file in %INC"; #debug
1337 } elsif (eval { require $file }) {
1338 # eval is good: if we haven't yet read the database it's
1339 # perfect and if we have installed the module in the meantime,
1340 # it tries again. The second require is only a NOOP returning
1341 # 1 if we had success, otherwise it's retrying
1343 my $mtime = (stat $INC{$file})[9];
1344 # privileged files loaded by has_inst; Note: we use $mtime
1345 # as a proxy for a checksum.
1346 $CPAN::Shell::reload->{$file} = $mtime;
1347 my $v = eval "\$$mod\::VERSION";
1348 $v = $v ? " (v$v)" : "";
1349 CPAN::Shell->optprint("load_module","CPAN: $mod loaded ok$v\n");
1350 if ($mod eq "CPAN::WAIT") {
1351 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1354 } elsif ($mod eq "Net::FTP") {
1355 $CPAN::Frontend->mywarn(qq{
1356 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1358 install Bundle::libnet
1360 }) unless $Have_warned->{"Net::FTP"}++;
1361 $CPAN::Frontend->mysleep(3);
1362 } elsif ($mod eq "Digest::SHA") {
1363 if ($Have_warned->{"Digest::SHA"}++) {
1364 $CPAN::Frontend->mywarn(qq{CPAN: checksum security checks disabled }.
1365 qq{because Digest::SHA not installed.\n});
1367 $CPAN::Frontend->mywarn(qq{
1368 CPAN: checksum security checks disabled because Digest::SHA not installed.
1369 Please consider installing the Digest::SHA module.
1372 $CPAN::Frontend->mysleep(2);
1374 } elsif ($mod eq "Module::Signature") {
1375 # NOT prefs_lookup, we are not a distro
1376 my $check_sigs = $CPAN::Config->{check_sigs};
1377 if (not $check_sigs) {
1378 # they do not want us:-(
1379 } elsif (not $Have_warned->{"Module::Signature"}++) {
1380 # No point in complaining unless the user can
1381 # reasonably install and use it.
1382 if (eval { require Crypt::OpenPGP; 1 } ||
1384 defined $CPAN::Config->{'gpg'}
1386 $CPAN::Config->{'gpg'} =~ /\S/
1389 $CPAN::Frontend->mywarn(qq{
1390 CPAN: Module::Signature security checks disabled because Module::Signature
1391 not installed. Please consider installing the Module::Signature module.
1392 You may also need to be able to connect over the Internet to the public
1393 keyservers like pgp.mit.edu (port 11371).
1396 $CPAN::Frontend->mysleep(2);
1400 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1405 #-> sub CPAN::instance ;
1407 my($mgr,$class,$id) = @_;
1408 CPAN::Index->reload;
1410 # unsafe meta access, ok?
1411 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1412 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1420 #-> sub CPAN::cleanup ;
1422 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1423 local $SIG{__DIE__} = '';
1428 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1429 $ineval = 1, last if
1430 $subroutine eq '(eval)';
1432 return if $ineval && !$CPAN::End;
1433 return unless defined $META->{LOCK};
1434 return unless -f $META->{LOCK};
1436 close $META->{LOCKFH};
1437 unlink $META->{LOCK};
1439 # Carp::cluck("DEBUGGING");
1440 if ( $CPAN::CONFIG_DIRTY ) {
1441 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1443 $CPAN::Frontend->myprint("Lockfile removed.\n");
1446 #-> sub CPAN::readhist
1448 my($self,$term,$histfile) = @_;
1449 my($fh) = FileHandle->new;
1450 open $fh, "<$histfile" or last;
1454 $term->AddHistory($_);
1459 #-> sub CPAN::savehist
1462 my($histfile,$histsize);
1463 unless ($histfile = $CPAN::Config->{'histfile'}) {
1464 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1467 $histsize = $CPAN::Config->{'histsize'} || 100;
1469 unless ($CPAN::term->can("GetHistory")) {
1470 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1476 my @h = $CPAN::term->GetHistory;
1477 splice @h, 0, @h-$histsize if @h>$histsize;
1478 my($fh) = FileHandle->new;
1479 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1480 local $\ = local $, = "\n";
1485 #-> sub CPAN::is_tested
1487 my($self,$what,$when) = @_;
1489 Carp::cluck("DEBUG: empty what");
1492 $self->{is_tested}{$what} = $when;
1495 #-> sub CPAN::is_installed
1496 # unsets the is_tested flag: as soon as the thing is installed, it is
1497 # not needed in set_perl5lib anymore
1499 my($self,$what) = @_;
1500 delete $self->{is_tested}{$what};
1503 sub _list_sorted_descending_is_tested {
1506 { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
1507 keys %{$self->{is_tested}}
1510 #-> sub CPAN::set_perl5lib
1512 my($self,$for) = @_;
1514 (undef,undef,undef,$for) = caller(1);
1517 $self->{is_tested} ||= {};
1518 return unless %{$self->{is_tested}};
1519 my $env = $ENV{PERL5LIB};
1520 $env = $ENV{PERLLIB} unless defined $env;
1522 push @env, $env if defined $env and length $env;
1523 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1524 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1526 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
1528 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
1529 } elsif (@dirs < 24) {
1530 my @d = map {my $cp = $_;
1531 $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
1534 $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
1535 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
1539 my $cnt = keys %{$self->{is_tested}};
1540 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
1541 "$cnt build dirs to PERL5LIB; ".
1546 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1549 package CPAN::CacheMgr;
1552 #-> sub CPAN::CacheMgr::as_string ;
1554 eval { require Data::Dumper };
1556 return shift->SUPER::as_string;
1558 return Data::Dumper::Dumper(shift);
1562 #-> sub CPAN::CacheMgr::cachesize ;
1567 #-> sub CPAN::CacheMgr::tidyup ;
1570 return unless $CPAN::META->{LOCK};
1571 return unless -d $self->{ID};
1572 my @toremove = grep { $self->{SIZE}{$_}==0 } @{$self->{FIFO}};
1573 for my $current (0..$#toremove) {
1574 my $toremove = $toremove[$current];
1575 $CPAN::Frontend->myprint(sprintf(
1576 "DEL(%d/%d): %s \n",
1582 return if $CPAN::Signal;
1583 $self->_clean_cache($toremove);
1584 return if $CPAN::Signal;
1588 #-> sub CPAN::CacheMgr::dir ;
1593 #-> sub CPAN::CacheMgr::entries ;
1595 my($self,$dir) = @_;
1596 return unless defined $dir;
1597 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1598 $dir ||= $self->{ID};
1599 my($cwd) = CPAN::anycwd();
1600 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1601 my $dh = DirHandle->new(File::Spec->curdir)
1602 or Carp::croak("Couldn't opendir $dir: $!");
1605 next if $_ eq "." || $_ eq "..";
1607 push @entries, File::Spec->catfile($dir,$_);
1609 push @entries, File::Spec->catdir($dir,$_);
1611 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1614 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1615 sort { -M $a <=> -M $b} @entries;
1618 #-> sub CPAN::CacheMgr::disk_usage ;
1620 my($self,$dir,$fast) = @_;
1621 return if exists $self->{SIZE}{$dir};
1622 return if $CPAN::Signal;
1627 unless (chmod 0755, $dir) {
1628 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1629 "permission to change the permission; cannot ".
1630 "estimate disk usage of '$dir'\n");
1631 $CPAN::Frontend->mysleep(5);
1636 # nothing to say, no matter what the permissions
1639 $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
1643 $Du = 0; # placeholder
1647 $File::Find::prune++ if $CPAN::Signal;
1649 if ($^O eq 'MacOS') {
1651 my $cat = Mac::Files::FSpGetCatInfo($_);
1652 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1656 unless (chmod 0755, $_) {
1657 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1658 "the permission to change the permission; ".
1659 "can only partially estimate disk usage ".
1661 $CPAN::Frontend->mysleep(5);
1673 return if $CPAN::Signal;
1674 $self->{SIZE}{$dir} = $Du/1024/1024;
1675 unshift @{$self->{FIFO}}, $dir;
1676 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1677 $self->{DU} += $Du/1024/1024;
1681 #-> sub CPAN::CacheMgr::_clean_cache ;
1683 my($self,$dir) = @_;
1684 return unless -e $dir;
1685 unless (File::Spec->canonpath(File::Basename::dirname($dir))
1686 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
1687 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
1688 "will not remove\n");
1689 $CPAN::Frontend->mysleep(5);
1692 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1694 File::Path::rmtree($dir);
1696 if ($dir !~ /\.yml$/ && -f "$dir.yml") {
1697 my $yaml_module = CPAN::_yaml_module;
1698 if ($CPAN::META->has_inst($yaml_module)) {
1699 my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); };
1701 $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)");
1702 unlink "$dir.yml" or
1703 $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)");
1705 } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) {
1706 $CPAN::META->delete("CPAN::Distribution", $id);
1708 # XXX we should restore the state NOW, otherise this
1709 # distro does not exist until we read an index. BUG ALERT(?)
1711 # $CPAN::Frontend->mywarn (" +++\n");
1715 unlink "$dir.yml"; # may fail
1716 unless ($id_deleted) {
1717 CPAN->debug("no distro found associated with '$dir'");
1720 $self->{DU} -= $self->{SIZE}{$dir};
1721 delete $self->{SIZE}{$dir};
1724 #-> sub CPAN::CacheMgr::new ;
1731 ID => $CPAN::Config->{build_dir},
1732 MAX => $CPAN::Config->{'build_cache'},
1733 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1736 File::Path::mkpath($self->{ID});
1737 my $dh = DirHandle->new($self->{ID});
1738 bless $self, $class;
1741 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1743 CPAN->debug($debug) if $CPAN::DEBUG;
1747 #-> sub CPAN::CacheMgr::scan_cache ;
1750 return if $self->{SCAN} eq 'never';
1751 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1752 unless $self->{SCAN} eq 'atstart';
1753 return unless $CPAN::META->{LOCK};
1754 $CPAN::Frontend->myprint(
1755 sprintf("Scanning cache %s for sizes\n",
1758 my @entries = $self->entries($self->{ID});
1763 if ($self->{DU} > $self->{MAX}) {
1765 $self->disk_usage($e,1);
1767 $self->disk_usage($e);
1770 while (($painted/76) < ($i/@entries)) {
1771 $CPAN::Frontend->myprint($symbol);
1774 return if $CPAN::Signal;
1776 $CPAN::Frontend->myprint("DONE\n");
1780 package CPAN::Shell;
1783 #-> sub CPAN::Shell::h ;
1785 my($class,$about) = @_;
1786 if (defined $about) {
1788 if (exists $Help->{$about}) {
1789 if (ref $Help->{$about}) { # aliases
1790 $about = ${$Help->{$about}};
1792 $help = $Help->{$about};
1794 $help = "No help available";
1796 $CPAN::Frontend->myprint("$about\: $help\n");
1798 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1799 $CPAN::Frontend->myprint(qq{
1800 Display Information $filler (ver $CPAN::VERSION)
1801 command argument description
1802 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1803 i WORD or /REGEXP/ about any of the above
1804 ls AUTHOR or GLOB about files in the author's directory
1805 (with WORD being a module, bundle or author name or a distribution
1806 name of the form AUTHOR/DISTRIBUTION)
1808 Download, Test, Make, Install...
1809 get download clean make clean
1810 make make (implies get) look open subshell in dist directory
1811 test make test (implies make) readme display these README files
1812 install make install (implies test) perldoc display POD documentation
1815 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1816 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1819 force CMD try hard to do command fforce CMD try harder
1820 notest CMD skip testing
1823 h,? display this menu ! perl-code eval a perl command
1824 o conf [opt] set and query options q quit the cpan shell
1825 reload cpan load CPAN.pm again reload index load newer indices
1826 autobundle Snapshot recent latest CPAN uploads});
1832 #-> sub CPAN::Shell::a ;
1834 my($self,@arg) = @_;
1835 # authors are always UPPERCASE
1837 $_ = uc $_ unless /=/;
1839 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1842 #-> sub CPAN::Shell::globls ;
1844 my($self,$s,$pragmas) = @_;
1845 # ls is really very different, but we had it once as an ordinary
1846 # command in the Shell (upto rev. 321) and we could not handle
1848 my(@accept,@preexpand);
1849 if ($s =~ /[\*\?\/]/) {
1850 if ($CPAN::META->has_inst("Text::Glob")) {
1851 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1852 my $rau = Text::Glob::glob_to_regex(uc $au);
1853 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1855 push @preexpand, map { $_->id . "/" . $pathglob }
1856 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1858 my $rau = Text::Glob::glob_to_regex(uc $s);
1859 push @preexpand, map { $_->id }
1860 CPAN::Shell->expand_by_method('CPAN::Author',
1865 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1868 push @preexpand, uc $s;
1871 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1872 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1877 my $silent = @accept>1;
1878 my $last_alpha = "";
1880 for my $a (@accept) {
1881 my($author,$pathglob);
1882 if ($a =~ m|(.*?)/(.*)|) {
1885 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1888 or $CPAN::Frontend->mydie("No author found for $a2\n");
1890 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1893 or $CPAN::Frontend->mydie("No author found for $a\n");
1896 my $alpha = substr $author->id, 0, 1;
1898 if ($alpha eq $last_alpha) {
1902 $last_alpha = $alpha;
1904 $CPAN::Frontend->myprint($ad);
1906 for my $pragma (@$pragmas) {
1907 if ($author->can($pragma)) {
1911 push @results, $author->ls($pathglob,$silent); # silent if
1914 for my $pragma (@$pragmas) {
1915 my $unpragma = "un$pragma";
1916 if ($author->can($unpragma)) {
1917 $author->$unpragma();
1924 #-> sub CPAN::Shell::local_bundles ;
1926 my($self,@which) = @_;
1927 my($incdir,$bdir,$dh);
1928 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1929 my @bbase = "Bundle";
1930 while (my $bbase = shift @bbase) {
1931 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1932 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1933 if ($dh = DirHandle->new($bdir)) { # may fail
1935 for $entry ($dh->read) {
1936 next if $entry =~ /^\./;
1937 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1938 if (-d File::Spec->catdir($bdir,$entry)) {
1939 push @bbase, "$bbase\::$entry";
1941 next unless $entry =~ s/\.pm(?!\n)\Z//;
1942 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1950 #-> sub CPAN::Shell::b ;
1952 my($self,@which) = @_;
1953 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1954 $self->local_bundles;
1955 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1958 #-> sub CPAN::Shell::d ;
1959 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1961 #-> sub CPAN::Shell::m ;
1962 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1964 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1967 #-> sub CPAN::Shell::i ;
1971 @args = '/./' unless @args;
1973 for my $type (qw/Bundle Distribution Module/) {
1974 push @result, $self->expand($type,@args);
1976 # Authors are always uppercase.
1977 push @result, $self->expand("Author", map { uc $_ } @args);
1979 my $result = @result == 1 ?
1980 $result[0]->as_string :
1982 "No objects found of any type for argument @args\n" :
1984 (map {$_->as_glimpse} @result),
1985 scalar @result, " items found\n",
1987 $CPAN::Frontend->myprint($result);
1990 #-> sub CPAN::Shell::o ;
1992 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1993 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1994 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1995 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1997 my($self,$o_type,@o_what) = @_;
1999 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
2000 if ($o_type eq 'conf') {
2002 ($cfilter) = $o_what[0] =~ m|^/(.*)/$| if @o_what;
2003 if (!@o_what or $cfilter) { # print all things, "o conf"
2005 my $qrfilter = eval 'qr/$cfilter/';
2007 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
2009 if (exists $INC{'CPAN/Config.pm'}) {
2010 push @from, $INC{'CPAN/Config.pm'};
2012 if (exists $INC{'CPAN/MyConfig.pm'}) {
2013 push @from, $INC{'CPAN/MyConfig.pm'};
2015 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
2016 $CPAN::Frontend->myprint(":\n");
2017 for $k (sort keys %CPAN::HandleConfig::can) {
2018 next unless $k =~ /$qrfilter/;
2019 $v = $CPAN::HandleConfig::can{$k};
2020 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
2022 $CPAN::Frontend->myprint("\n");
2023 for $k (sort keys %CPAN::HandleConfig::keys) {
2024 next unless $k =~ /$qrfilter/;
2025 CPAN::HandleConfig->prettyprint($k);
2027 $CPAN::Frontend->myprint("\n");
2029 if (CPAN::HandleConfig->edit(@o_what)) {
2031 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
2035 } elsif ($o_type eq 'debug') {
2037 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
2040 my($what) = shift @o_what;
2041 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
2042 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
2045 if ( exists $CPAN::DEBUG{$what} ) {
2046 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
2047 } elsif ($what =~ /^\d/) {
2048 $CPAN::DEBUG = $what;
2049 } elsif (lc $what eq 'all') {
2051 for (values %CPAN::DEBUG) {
2054 $CPAN::DEBUG = $max;
2057 for (keys %CPAN::DEBUG) {
2058 next unless lc($_) eq lc($what);
2059 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
2062 $CPAN::Frontend->myprint("unknown argument [$what]\n")
2067 my $raw = "Valid options for debug are ".
2068 join(", ",sort(keys %CPAN::DEBUG), 'all').
2069 qq{ or a number. Completion works on the options. }.
2070 qq{Case is ignored.};
2072 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
2073 $CPAN::Frontend->myprint("\n\n");
2076 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
2078 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
2079 $v = $CPAN::DEBUG{$k};
2080 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
2081 if $v & $CPAN::DEBUG;
2084 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
2087 $CPAN::Frontend->myprint(qq{
2089 conf set or get configuration variables
2090 debug set or get debugging options
2095 # CPAN::Shell::paintdots_onreload
2096 sub paintdots_onreload {
2099 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
2103 # $CPAN::Frontend->myprint(".($subr)");
2104 $CPAN::Frontend->myprint(".");
2105 if ($subr =~ /\bshell\b/i) {
2106 # warn "debug[$_[0]]";
2108 # It would be nice if we could detect that a
2109 # subroutine has actually changed, but for now we
2110 # practically always set the GOTOSHELL global
2120 #-> sub CPAN::Shell::hosts ;
2123 my $fullstats = CPAN::FTP->_ftp_statistics();
2124 my $history = $fullstats->{history} || [];
2126 while (my $last = pop @$history) {
2127 my $attempts = $last->{attempts} or next;
2130 $start = $attempts->[-1]{start};
2131 if ($#$attempts > 0) {
2132 for my $i (0..$#$attempts-1) {
2133 my $url = $attempts->[$i]{url} or next;
2138 $start = $last->{start};
2140 next unless $last->{thesiteurl}; # C-C? bad filenames?
2142 $S{end} ||= $last->{end};
2143 my $dltime = $last->{end} - $start;
2144 my $dlsize = $last->{filesize} || 0;
2145 my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
2146 my $s = $S{ok}{$url} ||= {};
2149 $s->{dlsize} += $dlsize/1024;
2151 $s->{dltime} += $dltime;
2154 for my $url (keys %{$S{ok}}) {
2155 next if $S{ok}{$url}{dltime} == 0; # div by zero
2156 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
2157 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
2161 for my $url (keys %{$S{no}}) {
2162 push @{$res->{no}}, [$S{no}{$url},
2166 my $R = ""; # report
2167 if ($S{start} && $S{end}) {
2168 $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
2169 $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown";
2171 if ($res->{ok} && @{$res->{ok}}) {
2172 $R .= sprintf "\nSuccessful downloads:
2173 N kB secs kB/s url\n";
2175 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
2176 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
2180 if ($res->{no} && @{$res->{no}}) {
2181 $R .= sprintf "\nUnsuccessful downloads:\n";
2183 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
2184 $R .= sprintf "%4d %s\n", @$_;
2188 $CPAN::Frontend->myprint($R);
2191 #-> sub CPAN::Shell::reload ;
2193 my($self,$command,@arg) = @_;
2195 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
2196 if ($command =~ /^cpan$/i) {
2198 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
2203 "CPAN/FirstTime.pm",
2204 "CPAN/HandleConfig.pm",
2207 "CPAN/Reporter/Config.pm",
2208 "CPAN/Reporter/History.pm",
2214 MFILE: for my $f (@relo) {
2215 next unless exists $INC{$f};
2219 $CPAN::Frontend->myprint("($p");
2220 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
2221 $self->_reload_this($f) or $failed++;
2222 my $v = eval "$p\::->VERSION";
2223 $CPAN::Frontend->myprint("v$v)");
2225 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
2227 my $errors = $failed == 1 ? "error" : "errors";
2228 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
2231 } elsif ($command =~ /^index$/i) {
2232 CPAN::Index->force_reload;
2234 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
2235 index re-reads the index files\n});
2239 # reload means only load again what we have loaded before
2240 #-> sub CPAN::Shell::_reload_this ;
2242 my($self,$f,$args) = @_;
2243 CPAN->debug("f[$f]") if $CPAN::DEBUG;
2244 return 1 unless $INC{$f}; # we never loaded this, so we do not
2246 my $pwd = CPAN::anycwd();
2247 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
2249 for my $inc (@INC) {
2250 $file = File::Spec->catfile($inc,split /\//, $f);
2254 CPAN->debug("file[$file]") if $CPAN::DEBUG;
2256 unless ($file && -f $file) {
2257 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
2259 unless (CPAN->has_inst("File::Basename")) {
2260 @inc = File::Basename::dirname($file);
2262 # do we ever need this?
2263 @inc = substr($file,0,-length($f)-1); # bring in back to me!
2266 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
2268 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
2271 my $mtime = (stat $file)[9];
2272 if ($reload->{$f}) {
2273 } elsif ($^T < $mtime) {
2274 # since we started the file has changed, force it to be reloaded
2277 $reload->{$f} = $mtime;
2279 my $must_reload = $mtime != $reload->{$f};
2281 $must_reload ||= $args->{reloforce}; # o conf defaults needs this
2283 my $fh = FileHandle->new($file) or
2284 $CPAN::Frontend->mydie("Could not open $file: $!");
2287 my $content = <$fh>;
2288 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
2292 eval "require '$f'";
2297 $reload->{$f} = $mtime;
2299 $CPAN::Frontend->myprint("__unchanged__");
2304 #-> sub CPAN::Shell::mkmyconfig ;
2306 my($self, $cpanpm, %args) = @_;
2307 require CPAN::FirstTime;
2308 my $home = CPAN::HandleConfig::home;
2309 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
2310 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
2311 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
2312 CPAN::HandleConfig::require_myconfig_or_config;
2313 $CPAN::Config ||= {};
2318 keep_source_where => undef,
2321 CPAN::FirstTime::init($cpanpm, %args);
2324 #-> sub CPAN::Shell::_binary_extensions ;
2325 sub _binary_extensions {
2326 my($self) = shift @_;
2327 my(@result,$module,%seen,%need,$headerdone);
2328 for $module ($self->expand('Module','/./')) {
2329 my $file = $module->cpan_file;
2330 next if $file eq "N/A";
2331 next if $file =~ /^Contact Author/;
2332 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
2333 next if $dist->isa_perl;
2334 next unless $module->xs_file;
2336 $CPAN::Frontend->myprint(".");
2337 push @result, $module;
2339 # print join " | ", @result;
2340 $CPAN::Frontend->myprint("\n");
2344 #-> sub CPAN::Shell::recompile ;
2346 my($self) = shift @_;
2347 my($module,@module,$cpan_file,%dist);
2348 @module = $self->_binary_extensions();
2349 for $module (@module) { # we force now and compile later, so we
2351 $cpan_file = $module->cpan_file;
2352 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2354 $dist{$cpan_file}++;
2356 for $cpan_file (sort keys %dist) {
2357 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
2358 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2360 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
2361 # stop a package from recompiling,
2362 # e.g. IO-1.12 when we have perl5.003_10
2366 #-> sub CPAN::Shell::scripts ;
2368 my($self, $arg) = @_;
2369 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
2371 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
2372 unless ($CPAN::META->has_inst($req)) {
2373 $CPAN::Frontend->mywarn(" $req not available\n");
2376 my $p = HTML::LinkExtor->new();
2377 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
2378 unless (-f $indexfile) {
2379 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
2381 $p->parse_file($indexfile);
2384 if ($arg =~ s|^/(.+)/$|$1|) {
2385 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
2387 for my $l ($p->links) {
2388 my $tag = shift @$l;
2389 next unless $tag eq "a";
2391 my $href = $att{href};
2392 next unless $href =~ s|^\.\./authors/id/./../||;
2395 if ($href =~ $qrarg) {
2399 if ($href =~ /\Q$arg\E/) {
2407 # now filter for the latest version if there is more than one of a name
2413 $stems{$stem} ||= [];
2414 push @{$stems{$stem}}, $href;
2416 for (sort keys %stems) {
2418 if (@{$stems{$_}} > 1) {
2419 $highest = List::Util::reduce {
2420 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
2423 $highest = $stems{$_}[0];
2425 $CPAN::Frontend->myprint("$highest\n");
2429 #-> sub CPAN::Shell::report ;
2431 my($self,@args) = @_;
2432 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2433 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2435 local $CPAN::Config->{test_report} = 1;
2436 $self->force("test",@args); # force is there so that the test be
2437 # re-run (as documented)
2440 # compare with is_tested
2441 #-> sub CPAN::Shell::install_tested
2442 sub install_tested {
2443 my($self,@some) = @_;
2444 $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
2446 CPAN::Index->reload;
2448 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2449 my $yaml = "$b.yml";
2451 $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
2454 my $yaml_content = CPAN->_yaml_loadfile($yaml);
2455 my $id = $yaml_content->[0]{distribution}{ID};
2457 $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
2460 my $do = CPAN::Shell->expandany($id);
2462 $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
2465 unless ($do->{build_dir}) {
2466 $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
2469 unless ($do->{build_dir} eq $b) {
2470 $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
2476 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2477 return unless @some;
2479 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2480 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2481 return unless @some;
2483 # @some = grep { not $_->uptodate } @some;
2484 # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2485 # return unless @some;
2487 CPAN->debug("some[@some]");
2489 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2490 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2491 $CPAN::Frontend->mysleep(1);
2496 #-> sub CPAN::Shell::upgrade ;
2498 my($self,@args) = @_;
2499 $self->install($self->r(@args));
2502 #-> sub CPAN::Shell::_u_r_common ;
2504 my($self) = shift @_;
2505 my($what) = shift @_;
2506 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2507 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2508 $what && $what =~ /^[aru]$/;
2510 @args = '/./' unless @args;
2511 my(@result,$module,%seen,%need,$headerdone,
2512 $version_undefs,$version_zeroes,
2513 @version_undefs,@version_zeroes);
2514 $version_undefs = $version_zeroes = 0;
2515 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2516 my @expand = $self->expand('Module',@args);
2517 my $expand = scalar @expand;
2518 if (0) { # Looks like noise to me, was very useful for debugging
2519 # for metadata cache
2520 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
2522 MODULE: for $module (@expand) {
2523 my $file = $module->cpan_file;
2524 next MODULE unless defined $file; # ??
2525 $file =~ s!^./../!!;
2526 my($latest) = $module->cpan_version;
2527 my($inst_file) = $module->inst_file;
2529 return if $CPAN::Signal;
2532 $have = $module->inst_version;
2533 } elsif ($what eq "r") {
2534 $have = $module->inst_version;
2536 if ($have eq "undef") {
2538 push @version_undefs, $module->as_glimpse;
2539 } elsif (CPAN::Version->vcmp($have,0)==0) {
2541 push @version_zeroes, $module->as_glimpse;
2543 next MODULE unless CPAN::Version->vgt($latest, $have);
2544 # to be pedantic we should probably say:
2545 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2546 # to catch the case where CPAN has a version 0 and we have a version undef
2547 } elsif ($what eq "u") {
2553 } elsif ($what eq "r") {
2555 } elsif ($what eq "u") {
2559 return if $CPAN::Signal; # this is sometimes lengthy
2562 push @result, sprintf "%s %s\n", $module->id, $have;
2563 } elsif ($what eq "r") {
2564 push @result, $module->id;
2565 next MODULE if $seen{$file}++;
2566 } elsif ($what eq "u") {
2567 push @result, $module->id;
2568 next MODULE if $seen{$file}++;
2569 next MODULE if $file =~ /^Contact/;
2571 unless ($headerdone++) {
2572 $CPAN::Frontend->myprint("\n");
2573 $CPAN::Frontend->myprint(sprintf(
2576 "Package namespace",
2588 $CPAN::META->has_inst("Term::ANSIColor")
2590 $module->description
2592 $color_on = Term::ANSIColor::color("green");
2593 $color_off = Term::ANSIColor::color("reset");
2595 $CPAN::Frontend->myprint(sprintf $sprintf,
2602 $need{$module->id}++;
2606 $CPAN::Frontend->myprint("No modules found for @args\n");
2607 } elsif ($what eq "r") {
2608 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2612 if ($version_zeroes) {
2613 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2614 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2615 qq{a version number of 0\n});
2616 if ($CPAN::Config->{show_zero_versions}) {
2618 $CPAN::Frontend->myprint(qq{ they are\n\t@version_zeroes\n});
2619 $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 0' }.
2620 qq{to hide them)\n});
2622 $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 1' }.
2623 qq{to show them)\n});
2626 if ($version_undefs) {
2627 my $s_has = $version_undefs > 1 ? "s have" : " has";
2628 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2629 qq{parseable version number\n});
2630 if ($CPAN::Config->{show_unparsable_versions}) {
2632 $CPAN::Frontend->myprint(qq{ they are\n\t@version_undefs\n});
2633 $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 0' }.
2634 qq{to hide them)\n});
2636 $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 1' }.
2637 qq{to show them)\n});
2644 #-> sub CPAN::Shell::r ;
2646 shift->_u_r_common("r",@_);
2649 #-> sub CPAN::Shell::u ;
2651 shift->_u_r_common("u",@_);
2654 #-> sub CPAN::Shell::failed ;
2656 my($self,$only_id,$silent) = @_;
2658 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2660 NAY: for my $nosayer ( # order matters!
2669 next unless exists $d->{$nosayer};
2670 next unless defined $d->{$nosayer};
2672 UNIVERSAL::can($d->{$nosayer},"failed") ?
2673 $d->{$nosayer}->failed :
2674 $d->{$nosayer} =~ /^NO/
2676 next NAY if $only_id && $only_id != (
2677 UNIVERSAL::can($d->{$nosayer},"commandid")
2679 $d->{$nosayer}->commandid
2681 $CPAN::CurrentCommandId
2686 next DIST unless $failed;
2690 # " %-45s: %s %s\n",
2693 UNIVERSAL::can($d->{$failed},"failed") ?
2695 $d->{$failed}->commandid,
2698 $d->{$failed}->text,
2699 $d->{$failed}{TIME}||0,
2712 $scope = "this command";
2713 } elsif ($CPAN::Index::HAVE_REANIMATED) {
2714 $scope = "this or a previous session";
2715 # it might be nice to have a section for previous session and
2718 $scope = "this session";
2725 map { sprintf "%5d %-45s: %s %s\n", @$_ }
2726 sort { $a->[0] <=> $b->[0] } @failed;
2729 map { sprintf " %-45s: %s %s\n", @$_[1..3] }
2736 $CPAN::Frontend->myprint("Failed during $scope:\n$print");
2737 } elsif (!$only_id || !$silent) {
2738 $CPAN::Frontend->myprint("Nothing failed in $scope\n");
2742 # XXX intentionally undocumented because completely bogus, unportable,
2745 #-> sub CPAN::Shell::status ;
2748 require Devel::Size;
2749 my $ps = FileHandle->new;
2750 open $ps, "/proc/$$/status";
2753 next unless /VmSize:\s+(\d+)/;
2757 $CPAN::Frontend->mywarn(sprintf(
2758 "%-27s %6d\n%-27s %6d\n",
2762 Devel::Size::total_size($CPAN::META)/1024,
2764 for my $k (sort keys %$CPAN::META) {
2765 next unless substr($k,0,4) eq "read";
2766 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2767 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2768 warn sprintf " %-25s %6d (keys: %6d)\n",
2770 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2771 scalar keys %{$CPAN::META->{$k}{$k2}};
2776 # compare with install_tested
2777 #-> sub CPAN::Shell::is_tested
2780 CPAN::Index->reload;
2781 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2783 if ($CPAN::META->{is_tested}{$b}) {
2784 $time = scalar(localtime $CPAN::META->{is_tested}{$b});
2786 $time = scalar localtime;
2789 $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
2793 #-> sub CPAN::Shell::autobundle ;
2796 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2797 my(@bundle) = $self->_u_r_common("a",@_);
2798 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2799 File::Path::mkpath($todir);
2800 unless (-d $todir) {
2801 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2804 my($y,$m,$d) = (localtime)[5,4,3];
2808 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2809 my($to) = File::Spec->catfile($todir,"$me.pm");
2811 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2812 $to = File::Spec->catfile($todir,"$me.pm");
2814 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2816 "package Bundle::$me;\n\n",
2817 "\$VERSION = '0.01';\n\n",
2821 "Bundle::$me - Snapshot of installation on ",
2822 $Config::Config{'myhostname'},
2825 "\n\n=head1 SYNOPSIS\n\n",
2826 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2827 "=head1 CONTENTS\n\n",
2828 join("\n", @bundle),
2829 "\n\n=head1 CONFIGURATION\n\n",
2831 "\n\n=head1 AUTHOR\n\n",
2832 "This Bundle has been generated automatically ",
2833 "by the autobundle routine in CPAN.pm.\n",
2836 $CPAN::Frontend->myprint("\nWrote bundle file
2840 #-> sub CPAN::Shell::expandany ;
2843 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2844 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2845 $s = CPAN::Distribution->normalize($s);
2846 return $CPAN::META->instance('CPAN::Distribution',$s);
2847 # Distributions spring into existence, not expand
2848 } elsif ($s =~ m|^Bundle::|) {
2849 $self->local_bundles; # scanning so late for bundles seems
2850 # both attractive and crumpy: always
2851 # current state but easy to forget
2853 return $self->expand('Bundle',$s);
2855 return $self->expand('Module',$s)
2856 if $CPAN::META->exists('CPAN::Module',$s);
2861 #-> sub CPAN::Shell::expand ;
2864 my($type,@args) = @_;
2865 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2866 my $class = "CPAN::$type";
2867 my $methods = ['id'];
2868 for my $meth (qw(name)) {
2869 next unless $class->can($meth);
2870 push @$methods, $meth;
2872 $self->expand_by_method($class,$methods,@args);
2875 #-> sub CPAN::Shell::expand_by_method ;
2876 sub expand_by_method {
2878 my($class,$methods,@args) = @_;
2881 my($regex,$command);
2882 if ($arg =~ m|^/(.*)/$|) {
2884 # FIXME: there seem to be some ='s in the author data, which trigger
2885 # a failure here. This needs to be contemplated.
2886 # } elsif ($arg =~ m/=/) {
2890 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2892 defined $regex ? $regex : "UNDEFINED",
2893 defined $command ? $command : "UNDEFINED",
2895 if (defined $regex) {
2896 if (CPAN::_sqlite_running) {
2897 $CPAN::SQLite->search($class, $regex);
2900 $CPAN::META->all_objects($class)
2902 unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id) {
2903 # BUG, we got an empty object somewhere
2904 require Data::Dumper;
2905 CPAN->debug(sprintf(
2906 "Bug in CPAN: Empty id on obj[%s][%s]",
2908 Data::Dumper::Dumper($obj)
2912 for my $method (@$methods) {
2913 my $match = eval {$obj->$method() =~ /$regex/i};
2915 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2916 $err ||= $@; # if we were too restrictive above
2917 $CPAN::Frontend->mydie("$err\n");
2924 } elsif ($command) {
2925 die "equal sign in command disabled (immature interface), ".
2927 ! \$CPAN::Shell::ADVANCED_QUERY=1
2928 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2929 that may go away anytime.\n"
2930 unless $ADVANCED_QUERY;
2931 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2932 my($matchcrit) = $criterion =~ m/^~(.+)/;
2936 $CPAN::META->all_objects($class)
2938 my $lhs = $self->$method() or next; # () for 5.00503
2940 push @m, $self if $lhs =~ m/$matchcrit/;
2942 push @m, $self if $lhs eq $criterion;
2947 if ( $class eq 'CPAN::Bundle' ) {
2948 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2949 } elsif ($class eq "CPAN::Distribution") {
2950 $xarg = CPAN::Distribution->normalize($arg);
2954 if ($CPAN::META->exists($class,$xarg)) {
2955 $obj = $CPAN::META->instance($class,$xarg);
2956 } elsif ($CPAN::META->exists($class,$arg)) {
2957 $obj = $CPAN::META->instance($class,$arg);
2964 @m = sort {$a->id cmp $b->id} @m;
2965 if ( $CPAN::DEBUG ) {
2966 my $wantarray = wantarray;
2967 my $join_m = join ",", map {$_->id} @m;
2968 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2970 return wantarray ? @m : $m[0];
2973 #-> sub CPAN::Shell::format_result ;
2976 my($type,@args) = @_;
2977 @args = '/./' unless @args;
2978 my(@result) = $self->expand($type,@args);
2979 my $result = @result == 1 ?
2980 $result[0]->as_string :
2982 "No objects of type $type found for argument @args\n" :
2984 (map {$_->as_glimpse} @result),
2985 scalar @result, " items found\n",
2990 #-> sub CPAN::Shell::report_fh ;
2992 my $installation_report_fh;
2993 my $previously_noticed = 0;
2996 return $installation_report_fh if $installation_report_fh;
2997 if ($CPAN::META->has_usable("File::Temp")) {
2998 $installation_report_fh
3000 dir => File::Spec->tmpdir,
3001 template => 'cpan_install_XXXX',
3006 unless ( $installation_report_fh ) {
3007 warn("Couldn't open installation report file; " .
3008 "no report file will be generated."
3009 ) unless $previously_noticed++;
3015 # The only reason for this method is currently to have a reliable
3016 # debugging utility that reveals which output is going through which
3017 # channel. No, I don't like the colors ;-)
3019 # to turn colordebugging on, write
3020 # cpan> o conf colorize_output 1
3022 #-> sub CPAN::Shell::print_ornamented ;
3024 my $print_ornamented_have_warned = 0;
3025 sub colorize_output {
3026 my $colorize_output = $CPAN::Config->{colorize_output};
3027 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
3028 unless ($print_ornamented_have_warned++) {
3029 # no myprint/mywarn within myprint/mywarn!
3030 warn "Colorize_output is set to true but Term::ANSIColor is not
3031 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
3033 $colorize_output = 0;
3035 return $colorize_output;
3040 #-> sub CPAN::Shell::print_ornamented ;
3041 sub print_ornamented {
3042 my($self,$what,$ornament) = @_;
3043 return unless defined $what;
3045 local $| = 1; # Flush immediately
3046 if ( $CPAN::Be_Silent ) {
3047 print {report_fh()} $what;
3050 my $swhat = "$what"; # stringify if it is an object
3051 if ($CPAN::Config->{term_is_latin}) {
3052 # note: deprecated, need to switch to $LANG and $LC_*
3055 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
3057 if ($self->colorize_output) {
3058 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
3059 # if you want to have this configurable, please file a bugreport
3060 $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
3062 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
3064 print "Term::ANSIColor rejects color[$ornament]: $@\n
3065 Please choose a different color (Hint: try 'o conf init /color/')\n";
3067 # GGOLDBACH/Test-GreaterVersion-0.008 broke wthout this
3068 # $trailer construct. We want the newline be the last thing if
3069 # there is a newline at the end ensuring that the next line is
3070 # empty for other players
3072 $trailer = $1 if $swhat =~ s/([\r\n]+)\z//;
3075 Term::ANSIColor::color("reset"),
3082 #-> sub CPAN::Shell::myprint ;
3084 # where is myprint/mywarn/Frontend/etc. documented? Where to use what?
3085 # I think, we send everything to STDOUT and use print for normal/good
3086 # news and warn for news that need more attention. Yes, this is our
3087 # working contract for now.
3089 my($self,$what) = @_;
3090 $self->print_ornamented($what,
3091 $CPAN::Config->{colorize_print}||'bold blue on_white',
3096 my($self,$category,$what) = @_;
3097 my $vname = $category . "_verbosity";
3098 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
3099 if (!$CPAN::Config->{$vname}
3100 || $CPAN::Config->{$vname} =~ /^v/
3102 $CPAN::Frontend->myprint($what);
3106 #-> sub CPAN::Shell::myexit ;
3108 my($self,$what) = @_;
3109 $self->myprint($what);
3113 #-> sub CPAN::Shell::mywarn ;
3115 my($self,$what) = @_;
3116 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
3119 # only to be used for shell commands
3120 #-> sub CPAN::Shell::mydie ;
3122 my($self,$what) = @_;
3123 $self->mywarn($what);
3125 # If it is the shell, we want the following die to be silent,
3126 # but if it is not the shell, we would need a 'die $what'. We need
3127 # to take care that only shell commands use mydie. Is this
3133 # sub CPAN::Shell::colorable_makemaker_prompt ;
3134 sub colorable_makemaker_prompt {
3136 if (CPAN::Shell->colorize_output) {
3137 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
3138 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
3141 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
3142 if (CPAN::Shell->colorize_output) {
3143 print Term::ANSIColor::color('reset');
3148 # use this only for unrecoverable errors!
3149 #-> sub CPAN::Shell::unrecoverable_error ;
3150 sub unrecoverable_error {
3151 my($self,$what) = @_;
3152 my @lines = split /\n/, $what;
3154 for my $l (@lines) {
3155 $longest = length $l if length $l > $longest;
3157 $longest = 62 if $longest > 62;
3158 for my $l (@lines) {
3159 if ($l =~ /^\s*$/) {
3164 if (length $l < 66) {
3165 $l = pack "A66 A*", $l, "<==";
3169 unshift @lines, "\n";
3170 $self->mydie(join "", @lines);
3173 #-> sub CPAN::Shell::mysleep ;
3175 my($self, $sleep) = @_;
3176 if (CPAN->has_inst("Time::HiRes")) {
3177 Time::HiRes::sleep($sleep);
3179 sleep($sleep < 1 ? 1 : int($sleep + 0.5));
3183 #-> sub CPAN::Shell::setup_output ;
3185 return if -t STDOUT;
3186 my $odef = select STDERR;
3193 #-> sub CPAN::Shell::rematein ;
3194 # RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
3197 my($meth,@some) = @_;
3199 while($meth =~ /^(ff?orce|notest)$/) {
3200 push @pragma, $meth;
3201 $meth = shift @some or
3202 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
3206 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
3208 # Here is the place to set "test_count" on all involved parties to
3209 # 0. We then can pass this counter on to the involved
3210 # distributions and those can refuse to test if test_count > X. In
3211 # the first stab at it we could use a 1 for "X".
3213 # But when do I reset the distributions to start with 0 again?
3214 # Jost suggested to have a random or cycling interaction ID that
3215 # we pass through. But the ID is something that is just left lying
3216 # around in addition to the counter, so I'd prefer to set the
3217 # counter to 0 now, and repeat at the end of the loop. But what
3218 # about dependencies? They appear later and are not reset, they
3219 # enter the queue but not its copy. How do they get a sensible
3222 # With configure_requires, "get" is vulnerable in recursion.
3224 my $needs_recursion_protection = "get|make|test|install";
3226 # construct the queue
3228 STHING: foreach $s (@some) {
3231 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
3233 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
3234 } elsif ($s =~ m|^/|) { # looks like a regexp
3235 if (substr($s,-1,1) eq ".") {
3236 $obj = CPAN::Shell->expandany($s);
3238 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
3239 "not supported.\nRejecting argument '$s'\n");
3240 $CPAN::Frontend->mysleep(2);
3243 } elsif ($meth eq "ls") {
3244 $self->globls($s,\@pragma);
3247 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
3248 $obj = CPAN::Shell->expandany($s);
3251 } elsif (ref $obj) {
3252 if ($meth =~ /^($needs_recursion_protection)$/) {
3253 # it would be silly to check for recursion for look or dump
3254 # (we are in CPAN::Shell::rematein)
3255 CPAN->debug("Going to test against recursion") if $CPAN::DEBUG;
3256 eval { $obj->color_cmd_tmps(0,1); };
3259 and $@->isa("CPAN::Exception::RecursiveDependency")) {
3260 $CPAN::Frontend->mywarn($@);
3264 Carp::confess(sprintf "DEBUG: \$\@[%s]ref[%s]", $@, ref $@);
3270 CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c");
3272 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
3273 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
3274 if ($meth =~ /^(dump|ls|reports)$/) {
3277 $CPAN::Frontend->mywarn(
3279 "Don't be silly, you can't $meth ",
3283 $CPAN::Frontend->mysleep(2);
3285 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
3286 CPAN::InfoObj->dump($s);
3289 ->mywarn(qq{Warning: Cannot $meth $s, }.
3290 qq{don't know what it is.
3295 to find objects with matching identifiers.
3297 $CPAN::Frontend->mysleep(2);
3301 # queuerunner (please be warned: when I started to change the
3302 # queue to hold objects instead of names, I made one or two
3303 # mistakes and never found which. I reverted back instead)
3304 while (my $q = CPAN::Queue->first) {
3306 my $s = $q->as_string;
3307 my $reqtype = $q->reqtype || "";
3308 $obj = CPAN::Shell->expandany($s);
3310 # don't know how this can happen, maybe we should panic,
3311 # but maybe we get a solution from the first user who hits
3312 # this unfortunate exception?
3313 $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
3314 "to an object. Skipping.\n");
3315 $CPAN::Frontend->mysleep(5);
3316 CPAN::Queue->delete_first($s);
3319 $obj->{reqtype} ||= "";
3321 # force debugging because CPAN::SQLite somehow delivers us
3324 # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
3326 CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
3327 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
3329 if ($obj->{reqtype}) {
3330 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
3331 $obj->{reqtype} = $reqtype;
3333 exists $obj->{install}
3336 UNIVERSAL::can($obj->{install},"failed") ?
3337 $obj->{install}->failed :
3338 $obj->{install} =~ /^NO/
3341 delete $obj->{install};
3342 $CPAN::Frontend->mywarn
3343 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
3347 $obj->{reqtype} = $reqtype;
3350 for my $pragma (@pragma) {
3353 $obj->can($pragma)) {
3354 $obj->$pragma($meth);
3357 if (UNIVERSAL::can($obj, 'called_for')) {
3358 $obj->called_for($s);
3360 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
3361 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
3364 if ($meth =~ /^(report)$/) { # they came here with a pragma?
3366 } elsif (! UNIVERSAL::can($obj,$meth)) {
3368 my $serialized = "";
3370 } elsif ($CPAN::META->has_inst("YAML::Syck")) {
3371 $serialized = YAML::Syck::Dump($obj);
3372 } elsif ($CPAN::META->has_inst("YAML")) {
3373 $serialized = YAML::Dump($obj);
3374 } elsif ($CPAN::META->has_inst("Data::Dumper")) {
3375 $serialized = Data::Dumper::Dumper($obj);
3378 $serialized = overload::StrVal($obj);
3380 CPAN->debug("Going to panic. meth[$meth]s[$s]") if $CPAN::DEBUG;
3381 $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
3382 } elsif ($obj->$meth()) {
3383 CPAN::Queue->delete($s);
3384 CPAN->debug("From queue deleted. meth[$meth]s[$s]") if $CPAN::DEBUG;
3386 CPAN->debug("Failed. pragma[@pragma]meth[$meth]") if $CPAN::DEBUG;
3390 for my $pragma (@pragma) {
3391 my $unpragma = "un$pragma";
3392 if ($obj->can($unpragma)) {
3396 CPAN::Queue->delete_first($s);
3398 if ($meth =~ /^($needs_recursion_protection)$/) {
3399 for my $obj (@qcopy) {
3400 $obj->color_cmd_tmps(0,0);
3405 #-> sub CPAN::Shell::recent ;
3408 if ($CPAN::META->has_inst("XML::LibXML")) {
3409 my $url = $CPAN::Defaultrecent;
3410 $CPAN::Frontend->myprint("Going to fetch '$url'\n");
3411 unless ($CPAN::META->has_usable("LWP")) {
3412 $CPAN::Frontend->mydie("LWP not installed; cannot continue");
3414 CPAN::LWP::UserAgent->config;
3416 eval { $Ua = CPAN::LWP::UserAgent->new; };
3418 $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
3420 my $resp = $Ua->get($url);
3421 unless ($resp->is_success) {
3422 $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
3424 $CPAN::Frontend->myprint("DONE\n\n");
3425 my $xml = XML::LibXML->new->parse_string($resp->content);
3427 my $s = $xml->serialize(2);
3428 $s =~ s/\n\s*\n/\n/g;
3429 $CPAN::Frontend->myprint($s);
3433 if ($url =~ /winnipeg/) {
3434 my $pubdate = $xml->findvalue("/rss/channel/pubDate");
3435 $CPAN::Frontend->myprint(" pubDate: $pubdate\n\n");
3436 for my $eitem ($xml->findnodes("/rss/channel/item")) {
3437 my $distro = $eitem->findvalue("enclosure/\@url");
3438 $distro =~ s|.*?/authors/id/./../||;
3439 my $size = $eitem->findvalue("enclosure/\@length");
3440 my $desc = $eitem->findvalue("description");
3441 \0 $desc =~ s/.+? - //;
3442 $CPAN::Frontend->myprint("$distro [$size b]\n $desc\n");
3443 push @distros, $distro;
3445 } elsif ($url =~ /search.*uploads.rdf/) {
3446 # xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
3447 # xmlns="http://purl.org/rss/1.0/"
3448 # xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/"
3449 # xmlns:dc="http://purl.org/dc/elements/1.1/"
3450 # xmlns:syn="http://purl.org/rss/1.0/modules/syndication/"
3451 # xmlns:admin="http://webns.net/mvcb/"
3454 my $dc_date = $xml->findvalue("//*[local-name(.) = 'RDF']/*[local-name(.) = 'channel']/*[local-name(.) = 'date']");
3455 $CPAN::Frontend->myprint(" dc:date: $dc_date\n\n");
3456 my $finish_eitem = 0;
3457 local $SIG{INT} = sub { $finish_eitem = 1 };
3458 EITEM: for my $eitem ($xml->findnodes("//*[local-name(.) = 'RDF']/*[local-name(.) = 'item']")) {
3459 my $distro = $eitem->findvalue("\@rdf:about");
3460 $distro =~ s|.*~||; # remove up to the tilde before the name
3461 $distro =~ s|/$||; # remove trailing slash
3462 $distro =~ s|([^/]+)|\U$1\E|; # upcase the name
3463 my $author = uc $1 or die "distro[$distro] without author, cannot continue";
3464 my $desc = $eitem->findvalue("*[local-name(.) = 'description']");
3466 SUBDIRTEST: while () {
3467 last SUBDIRTEST if ++$i >= 6; # half a dozen must do!
3468 if (my @ret = $self->globls("$distro*")) {
3469 @ret = grep {$_->[2] !~ /meta/} @ret;
3470 @ret = grep {length $_->[2]} @ret;
3472 $distro = "$author/$ret[0][2]";
3476 $distro =~ s|/|/*/|; # allow it to reside in a subdirectory
3479 next EITEM if $distro =~ m|\*|; # did not find the thing
3480 $CPAN::Frontend->myprint("____$desc\n");
3481 push @distros, $distro;
3482 last EITEM if $finish_eitem;
3487 # deprecated old version
3488 $CPAN::Frontend->mydie("no XML::LibXML installed, cannot continue\n");
3492 #-> sub CPAN::Shell::smoke ;
3495 my $distros = $self->recent;
3496 DISTRO: for my $distro (@$distros) {
3497 $CPAN::Frontend->myprint(sprintf "Going to download and test '$distro'\n");
3500 local $SIG{INT} = sub { $skip = 1 };
3502 $CPAN::Frontend->myprint(sprintf "\r%2d (Hit ^C to skip)", 10-$_);
3505 $CPAN::Frontend->myprint(" skipped\n");
3510 $CPAN::Frontend->myprint("\r \n"); # leave the dirty line with a newline
3511 $self->test($distro);
3516 # set up the dispatching methods
3518 for my $command (qw(
3535 *$command = sub { shift->rematein($command, @_); };
3539 package CPAN::LWP::UserAgent;
3543 return if $SETUPDONE;
3544 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3545 require LWP::UserAgent;
3546 @ISA = qw(Exporter LWP::UserAgent);
3549 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
3553 sub get_basic_credentials {
3554 my($self, $realm, $uri, $proxy) = @_;
3555 if ($USER && $PASSWD) {
3556 return ($USER, $PASSWD);
3559 ($USER,$PASSWD) = $self->get_proxy_credentials();
3561 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
3563 return($USER,$PASSWD);
3566 sub get_proxy_credentials {
3568 my ($user, $password);
3569 if ( defined $CPAN::Config->{proxy_user} &&
3570 defined $CPAN::Config->{proxy_pass}) {
3571 $user = $CPAN::Config->{proxy_user};
3572 $password = $CPAN::Config->{proxy_pass};
3573 return ($user, $password);
3575 my $username_prompt = "\nProxy authentication needed!
3576 (Note: to permanently configure username and password run
3577 o conf proxy_user your_username
3578 o conf proxy_pass your_password
3580 ($user, $password) =
3581 _get_username_and_password_from_user($username_prompt);
3582 return ($user,$password);
3585 sub get_non_proxy_credentials {
3587 my ($user,$password);
3588 if ( defined $CPAN::Config->{username} &&
3589 defined $CPAN::Config->{password}) {
3590 $user = $CPAN::Config->{username};
3591 $password = $CPAN::Config->{password};
3592 return ($user, $password);
3594 my $username_prompt = "\nAuthentication needed!
3595 (Note: to permanently configure username and password run
3596 o conf username your_username
3597 o conf password your_password
3600 ($user, $password) =
3601 _get_username_and_password_from_user($username_prompt);
3602 return ($user,$password);
3605 sub _get_username_and_password_from_user {
3606 my $username_message = shift;
3607 my ($username,$password);
3609 ExtUtils::MakeMaker->import(qw(prompt));
3610 $username = prompt($username_message);
3611 if ($CPAN::META->has_inst("Term::ReadKey")) {
3612 Term::ReadKey::ReadMode("noecho");
3615 $CPAN::Frontend->mywarn(
3616 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
3619 $password = prompt("Password:");
3621 if ($CPAN::META->has_inst("Term::ReadKey")) {
3622 Term::ReadKey::ReadMode("restore");
3624 $CPAN::Frontend->myprint("\n\n");
3625 return ($username,$password);
3628 # mirror(): Its purpose is to deal with proxy authentication. When we
3629 # call SUPER::mirror, we relly call the mirror method in
3630 # LWP::UserAgent. LWP::UserAgent will then call
3631 # $self->get_basic_credentials or some equivalent and this will be
3632 # $self->dispatched to our own get_basic_credentials method.
3634 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3636 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3637 # although we have gone through our get_basic_credentials, the proxy
3638 # server refuses to connect. This could be a case where the username or
3639 # password has changed in the meantime, so I'm trying once again without
3640 # $USER and $PASSWD to give the get_basic_credentials routine another
3641 # chance to set $USER and $PASSWD.
3643 # mirror(): Its purpose is to deal with proxy authentication. When we
3644 # call SUPER::mirror, we relly call the mirror method in
3645 # LWP::UserAgent. LWP::UserAgent will then call
3646 # $self->get_basic_credentials or some equivalent and this will be
3647 # $self->dispatched to our own get_basic_credentials method.
3649 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3651 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3652 # although we have gone through our get_basic_credentials, the proxy
3653 # server refuses to connect. This could be a case where the username or
3654 # password has changed in the meantime, so I'm trying once again without
3655 # $USER and $PASSWD to give the get_basic_credentials routine another
3656 # chance to set $USER and $PASSWD.
3659 my($self,$url,$aslocal) = @_;
3660 my $result = $self->SUPER::mirror($url,$aslocal);
3661 if ($result->code == 407) {
3664 $result = $self->SUPER::mirror($url,$aslocal);
3672 #-> sub CPAN::FTP::ftp_statistics
3673 # if they want to rewrite, they need to pass in a filehandle
3674 sub _ftp_statistics {
3676 my $locktype = $fh ? LOCK_EX : LOCK_SH;
3677 $fh ||= FileHandle->new;
3678 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3679 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
3682 while (!CPAN::_flock($fh, $locktype|LOCK_NB)) {
3683 $waitstart ||= localtime();
3685 $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
3687 $CPAN::Frontend->mysleep($sleep);
3690 } elsif ($sleep <=6) {
3694 my $stats = eval { CPAN->_yaml_loadfile($file); };
3697 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
3698 $CPAN::Frontend->myprint("Warning (usually harmless): $@");
3700 } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
3701 $CPAN::Frontend->mydie($@);
3704 $CPAN::Frontend->mydie($@);
3710 #-> sub CPAN::FTP::_mytime
3712 if (CPAN->has_inst("Time::HiRes")) {
3713 return Time::HiRes::time();
3719 #-> sub CPAN::FTP::_new_stats
3721 my($self,$file) = @_;
3730 #-> sub CPAN::FTP::_add_to_statistics
3731 sub _add_to_statistics {
3732 my($self,$stats) = @_;
3733 my $yaml_module = CPAN::_yaml_module;
3734 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
3735 if ($CPAN::META->has_inst($yaml_module)) {
3736 $stats->{thesiteurl} = $ThesiteURL;
3737 if (CPAN->has_inst("Time::HiRes")) {
3738 $stats->{end} = Time::HiRes::time();
3740 $stats->{end} = time;
3742 my $fh = FileHandle->new;
3746 @debug = $time if $sdebug;
3747 my $fullstats = $self->_ftp_statistics($fh);
3749 $fullstats->{history} ||= [];
3750 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3751 push @debug, time if $sdebug;
3752 push @{$fullstats->{history}}, $stats;
3753 # arbitrary hardcoded constants until somebody demands to have
3754 # them settable; YAML.pm 0.62 is unacceptably slow with 999;
3755 # YAML::Syck 0.82 has no noticable performance problem with 999;
3757 @{$fullstats->{history}} > 99
3758 || $time - $fullstats->{history}[0]{start} > 14*86400
3760 shift @{$fullstats->{history}}
3762 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3763 push @debug, time if $sdebug;
3764 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
3765 # need no eval because if this fails, it is serious
3766 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3767 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
3769 local $CPAN::DEBUG = 512; # FTP
3771 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
3772 "after[%d]at[%d]oldest[%s]dumped backat[%d]",
3776 # Win32 cannot rename a file to an existing filename
3777 unlink($sfile) if ($^O eq 'MSWin32');
3778 rename "$sfile.$$", $sfile
3779 or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
3783 # if file is CHECKSUMS, suggest the place where we got the file to be
3784 # checked from, maybe only for young files?
3785 #-> sub CPAN::FTP::_recommend_url_for
3786 sub _recommend_url_for {
3787 my($self, $file) = @_;
3788 my $urllist = $self->_get_urllist;
3789 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3790 my $fullstats = $self->_ftp_statistics();
3791 my $history = $fullstats->{history} || [];
3792 while (my $last = pop @$history) {
3793 last if $last->{end} - time > 3600; # only young results are interesting
3794 next unless $last->{file}; # dirname of nothing dies!
3795 next unless $file eq File::Basename::dirname($last->{file});
3796 return $last->{thesiteurl};
3799 if ($CPAN::Config->{randomize_urllist}
3801 rand(1) < $CPAN::Config->{randomize_urllist}
3803 $urllist->[int rand scalar @$urllist];
3809 #-> sub CPAN::FTP::_get_urllist
3812 $CPAN::Config->{urllist} ||= [];
3813 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3814 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3815 $CPAN::Config->{urllist} = [];
3817 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3818 for my $u (@urllist) {
3819 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3820 if (UNIVERSAL::can($u,"text")) {
3821 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3823 $u .= "/" unless substr($u,-1) eq "/";
3824 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3830 #-> sub CPAN::FTP::ftp_get ;
3832 my($class,$host,$dir,$file,$target) = @_;
3834 qq[Going to fetch file [$file] from dir [$dir]
3835 on host [$host] as local [$target]\n]
3837 my $ftp = Net::FTP->new($host);
3839 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3842 return 0 unless defined $ftp;
3843 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3844 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3845 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) {
3846 my $msg = $ftp->message;
3847 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3850 unless ( $ftp->cwd($dir) ) {
3851 my $msg = $ftp->message;
3852 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3856 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3857 unless ( $ftp->get($file,$target) ) {
3858 my $msg = $ftp->message;
3859 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3862 $ftp->quit; # it's ok if this fails
3866 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3868 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3869 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3871 # > *** 1562,1567 ****
3872 # > --- 1562,1580 ----
3873 # > return 1 if substr($url,0,4) eq "file";
3874 # > return 1 unless $url =~ m|://([^/]+)|;
3876 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3878 # > + $proxy =~ m|://([^/:]+)|;
3880 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3881 # > + if ($noproxy) {
3882 # > + if ($host !~ /$noproxy$/) {
3883 # > + $host = $proxy;
3886 # > + $host = $proxy;
3889 # > require Net::Ping;
3890 # > return 1 unless $Net::Ping::VERSION >= 2;
3894 #-> sub CPAN::FTP::localize ;
3896 my($self,$file,$aslocal,$force) = @_;
3898 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3899 unless defined $aslocal;
3900 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3903 if ($^O eq 'MacOS') {
3904 # Comment by AK on 2000-09-03: Uniq short filenames would be
3905 # available in CHECKSUMS file
3906 my($name, $path) = File::Basename::fileparse($aslocal, '');
3907 if (length($name) > 31) {
3918 my $size = 31 - length($suf);
3919 while (length($name) > $size) {
3923 $aslocal = File::Spec->catfile($path, $name);
3927 if (-f $aslocal && -r _ && !($force & 1)) {
3929 if ($size = -s $aslocal) {
3930 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3933 # empty file from a previous unsuccessful attempt to download it
3935 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3936 "could not remove.");
3939 my($maybe_restore) = 0;
3941 rename $aslocal, "$aslocal.bak$$";
3945 my($aslocal_dir) = File::Basename::dirname($aslocal);
3946 $self->mymkpath($aslocal_dir); # too early for file URLs / RT #28438
3947 # Inheritance is not easier to manage than a few if/else branches
3948 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3950 CPAN::LWP::UserAgent->config;
3951 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3953 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3957 $Ua->proxy('ftp', $var)
3958 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3959 $Ua->proxy('http', $var)
3960 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3962 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3966 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3967 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3970 # Try the list of urls for each single object. We keep a record
3971 # where we did get a file from
3972 my(@reordered,$last);
3973 my $ccurllist = $self->_get_urllist;
3974 $last = $#$ccurllist;
3975 if ($force & 2) { # local cpans probably out of date, don't reorder
3976 @reordered = (0..$last);
3980 (substr($ccurllist->[$b],0,4) eq "file")
3982 (substr($ccurllist->[$a],0,4) eq "file")
3984 defined($ThesiteURL)
3986 ($ccurllist->[$b] eq $ThesiteURL)
3988 ($ccurllist->[$a] eq $ThesiteURL)
3993 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3999 ["dleasy", "http","defaultsites"],
4000 ["dlhard", "http","defaultsites"],
4001 ["dleasy", "ftp", "defaultsites"],
4002 ["dlhard", "ftp", "defaultsites"],
4003 ["dlhardest","", "defaultsites"],
4006 @levels = grep {$_->[0] eq $Themethod} @all_levels;
4007 push @levels, grep {$_->[0] ne $Themethod} @all_levels;
4009 @levels = @all_levels;
4011 @levels = qw/dleasy/ if $^O eq 'MacOS';
4013 local $ENV{FTP_PASSIVE} =
4014 exists $CPAN::Config->{ftp_passive} ?
4015 $CPAN::Config->{ftp_passive} : 1;
4017 my $stats = $self->_new_stats($file);
4018 LEVEL: for $levelno (0..$#levels) {
4019 my $level_tuple = $levels[$levelno];
4020 my($level,$scheme,$sitetag) = @$level_tuple;
4021 my $defaultsites = $sitetag && $sitetag eq "defaultsites";
4023 if ($defaultsites) {
4024 unless (defined $connect_to_internet_ok) {
4025 $CPAN::Frontend->myprint(sprintf qq{
4026 I would like to connect to one of the following sites to get '%s':
4031 join("",map { " ".$_->text."\n" } @CPAN::Defaultsites),
4033 my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes");
4034 if ($answer =~ /^y/i) {
4035 $connect_to_internet_ok = 1;
4037 $connect_to_internet_ok = 0;
4040 if ($connect_to_internet_ok) {
4041 @urllist = @CPAN::Defaultsites;
4046 my @host_seq = $level =~ /dleasy/ ?
4047 @reordered : 0..$last; # reordered has file and $Thesiteurl first
4048 @urllist = map { $ccurllist->[$_] } @host_seq;
4050 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
4051 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
4052 if (my $recommend = $self->_recommend_url_for($file)) {
4053 @urllist = grep { $_ ne $recommend } @urllist;
4054 unshift @urllist, $recommend;
4056 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
4057 $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats);
4059 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
4060 if ($ret eq $aslocal_tempfile) {
4061 # if we got it exactly as we asked for, only then we
4063 rename $aslocal_tempfile, $aslocal
4064 or $CPAN::Frontend->mydie("Error while trying to rename ".
4065 "'$ret' to '$aslocal': $!");
4068 $Themethod = $level;
4070 # utime $now, $now, $aslocal; # too bad, if we do that, we
4071 # might alter a local mirror
4072 $self->debug("level[$level]") if $CPAN::DEBUG;
4075 unlink $aslocal_tempfile;
4076 last if $CPAN::Signal; # need to cleanup
4080 $stats->{filesize} = -s $ret;
4082 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
4083 $self->_add_to_statistics($stats);
4084 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
4086 unlink "$aslocal.bak$$";
4089 unless ($CPAN::Signal) {
4092 if (@{$CPAN::Config->{urllist}}) {
4094 qq{Please check, if the URLs I found in your configuration file \(}.
4095 join(", ", @{$CPAN::Config->{urllist}}).
4098 push @mess, qq{Your urllist is empty!};
4100 push @mess, qq{The urllist can be edited.},
4101 qq{E.g. with 'o conf urllist push ftp://myurl/'};
4102 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
4103 $CPAN::Frontend->mywarn("Could not fetch $file\n");
4104 $CPAN::Frontend->mysleep(2);
4106 if ($maybe_restore) {
4107 rename "$aslocal.bak$$", $aslocal;
4108 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
4109 $self->ls($aslocal));
4116 my($self, $aslocal_dir) = @_;
4117 File::Path::mkpath($aslocal_dir);
4118 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
4119 qq{directory "$aslocal_dir".
4120 I\'ll continue, but if you encounter problems, they may be due
4121 to insufficient permissions.\n}) unless -w $aslocal_dir;
4129 $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme;
4130 my $method = "host$level";
4131 $self->$method($h, @_);
4135 my($self,$stats,$method,$url) = @_;
4136 push @{$stats->{attempts}}, {
4143 # package CPAN::FTP;
4145 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4147 HOSTEASY: for $ro_url (@$host_seq) {
4148 $self->_set_attempt($stats,"dleasy",$ro_url);
4149 my $url .= "$ro_url$file";
4150 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
4151 if ($url =~ /^file:/) {
4153 if ($CPAN::META->has_inst('URI::URL')) {
4154 my $u = URI::URL->new($url);
4156 } else { # works only on Unix, is poorly constructed, but
4157 # hopefully better than nothing.
4158 # RFC 1738 says fileurl BNF is
4159 # fileurl = "file://" [ host | "localhost" ] "/" fpath
4160 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
4162 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
4163 $l =~ s|^file:||; # assume they
4167 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
4169 $self->debug("local file[$l]") if $CPAN::DEBUG;
4170 if ( -f $l && -r _) {
4171 $ThesiteURL = $ro_url;
4174 if ($l =~ /(.+)\.gz$/) {
4176 if ( -f $ungz && -r _) {
4177 $ThesiteURL = $ro_url;
4181 # Maybe mirror has compressed it?
4183 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
4184 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
4186 $ThesiteURL = $ro_url;
4190 $CPAN::Frontend->mywarn("Could not find '$l'\n");
4192 $self->debug("it was not a file URL") if $CPAN::DEBUG;
4193 if ($CPAN::META->has_usable('LWP')) {
4194 $CPAN::Frontend->myprint("Fetching with LWP:
4198 CPAN::LWP::UserAgent->config;
4199 eval { $Ua = CPAN::LWP::UserAgent->new; };
4201 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
4204 my $res = $Ua->mirror($url, $aslocal);
4205 if ($res->is_success) {
4206 $ThesiteURL = $ro_url;
4208 utime $now, $now, $aslocal; # download time is more
4209 # important than upload
4212 } elsif ($url !~ /\.gz(?!\n)\Z/) {
4213 my $gzurl = "$url.gz";
4214 $CPAN::Frontend->myprint("Fetching with LWP:
4217 $res = $Ua->mirror($gzurl, "$aslocal.gz");
4218 if ($res->is_success) {
4219 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
4220 $ThesiteURL = $ro_url;
4225 $CPAN::Frontend->myprint(sprintf(
4226 "LWP failed with code[%s] message[%s]\n",
4230 # Alan Burlison informed me that in firewall environments
4231 # Net::FTP can still succeed where LWP fails. So we do not
4232 # skip Net::FTP anymore when LWP is available.
4235 $CPAN::Frontend->mywarn(" LWP not available\n");
4237 return if $CPAN::Signal;
4238 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4239 # that's the nice and easy way thanks to Graham
4240 $self->debug("recognized ftp") if $CPAN::DEBUG;
4241 my($host,$dir,$getfile) = ($1,$2,$3);
4242 if ($CPAN::META->has_usable('Net::FTP')) {
4244 $CPAN::Frontend->myprint("Fetching with Net::FTP:
4247 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
4248 "aslocal[$aslocal]") if $CPAN::DEBUG;
4249 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
4250 $ThesiteURL = $ro_url;
4253 if ($aslocal !~ /\.gz(?!\n)\Z/) {
4254 my $gz = "$aslocal.gz";
4255 $CPAN::Frontend->myprint("Fetching with Net::FTP
4258 if (CPAN::FTP->ftp_get($host,
4262 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
4264 $ThesiteURL = $ro_url;
4270 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
4274 UNIVERSAL::can($ro_url,"text")
4276 $ro_url->{FROM} eq "USER"
4278 ##address #17973: default URLs should not try to override
4279 ##user-defined URLs just because LWP is not available
4280 my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats);
4281 return $ret if $ret;
4283 return if $CPAN::Signal;
4287 # package CPAN::FTP;
4289 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4291 # Came back if Net::FTP couldn't establish connection (or
4292 # failed otherwise) Maybe they are behind a firewall, but they
4293 # gave us a socksified (or other) ftp program...
4296 my($devnull) = $CPAN::Config->{devnull} || "";
4298 my($aslocal_dir) = File::Basename::dirname($aslocal);
4299 File::Path::mkpath($aslocal_dir);
4300 HOSTHARD: for $ro_url (@$host_seq) {
4301 $self->_set_attempt($stats,"dlhard",$ro_url);
4302 my $url = "$ro_url$file";
4303 my($proto,$host,$dir,$getfile);
4305 # Courtesy Mark Conty mark_conty@cargill.com change from
4306 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4308 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
4309 # proto not yet used
4310 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
4312 next HOSTHARD; # who said, we could ftp anything except ftp?
4314 next HOSTHARD if $proto eq "file"; # file URLs would have had
4315 # success above. Likely a bogus URL
4317 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
4319 # Try the most capable first and leave ncftp* for last as it only
4321 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
4322 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
4323 next unless defined $funkyftp;
4324 next if $funkyftp =~ /^\s*$/;
4326 my($asl_ungz, $asl_gz);
4327 ($asl_ungz = $aslocal) =~ s/\.gz//;
4328 $asl_gz = "$asl_ungz.gz";
4330 my($src_switch) = "";
4332 my($stdout_redir) = " > $asl_ungz";
4334 $src_switch = " -source";
4335 } elsif ($f eq "ncftp") {
4336 $src_switch = " -c";
4337 } elsif ($f eq "wget") {
4338 $src_switch = " -O $asl_ungz";
4340 } elsif ($f eq 'curl') {
4341 $src_switch = ' -L -f -s -S --netrc-optional';
4344 if ($f eq "ncftpget") {
4345 $chdir = "cd $aslocal_dir && ";
4348 $CPAN::Frontend->myprint(
4350 Trying with "$funkyftp$src_switch" to get
4354 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
4355 $self->debug("system[$system]") if $CPAN::DEBUG;
4356 my($wstatus) = system($system);
4358 # lynx returns 0 when it fails somewhere
4360 my $content = do { local *FH;
4361 open FH, $asl_ungz or die;
4364 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
4365 $CPAN::Frontend->mywarn(qq{
4366 No success, the file that lynx has downloaded looks like an error message:
4369 $CPAN::Frontend->mysleep(1);
4373 $CPAN::Frontend->myprint(qq{
4374 No success, the file that lynx has downloaded is an empty file.
4379 if ($wstatus == 0) {
4382 } elsif ($asl_ungz ne $aslocal) {
4383 # test gzip integrity
4384 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
4385 # e.g. foo.tar is gzipped --> foo.tar.gz
4386 rename $asl_ungz, $aslocal;
4388 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
4391 $ThesiteURL = $ro_url;
4393 } elsif ($url !~ /\.gz(?!\n)\Z/) {
4395 -f $asl_ungz && -s _ == 0;
4396 my $gz = "$aslocal.gz";
4397 my $gzurl = "$url.gz";
4398 $CPAN::Frontend->myprint(
4400 Trying with "$funkyftp$src_switch" to get
4403 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
4404 $self->debug("system[$system]") if $CPAN::DEBUG;
4406 if (($wstatus = system($system)) == 0
4410 # test gzip integrity
4411 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
4412 if ($ct && $ct->gtest) {
4413 $ct->gunzip($aslocal);
4415 # somebody uncompressed file for us?
4416 rename $asl_ungz, $aslocal;
4418 $ThesiteURL = $ro_url;
4421 unlink $asl_gz if -f $asl_gz;
4424 my $estatus = $wstatus >> 8;
4425 my $size = -f $aslocal ?
4426 ", left\n$aslocal with size ".-s _ :
4427 "\nWarning: expected file [$aslocal] doesn't exist";
4428 $CPAN::Frontend->myprint(qq{
4429 System call "$system"
4430 returned status $estatus (wstat $wstatus)$size
4433 return if $CPAN::Signal;
4434 } # transfer programs
4438 # package CPAN::FTP;
4440 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4442 return unless @$host_seq;
4444 my($aslocal_dir) = File::Basename::dirname($aslocal);
4445 File::Path::mkpath($aslocal_dir);
4446 my $ftpbin = $CPAN::Config->{ftp};
4447 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
4448 $CPAN::Frontend->myprint("No external ftp command available\n\n");
4451 $CPAN::Frontend->mywarn(qq{
4452 As a last ressort we now switch to the external ftp command '$ftpbin'
4455 Doing so often leads to problems that are hard to diagnose.
4457 If you're victim of such problems, please consider unsetting the ftp
4458 config variable with
4464 $CPAN::Frontend->mysleep(2);
4465 HOSTHARDEST: for $ro_url (@$host_seq) {
4466 $self->_set_attempt($stats,"dlhardest",$ro_url);
4467 my $url = "$ro_url$file";
4468 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
4469 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4472 my($host,$dir,$getfile) = ($1,$2,$3);
4474 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
4475 $ctime,$blksize,$blocks) = stat($aslocal);
4476 $timestamp = $mtime ||= 0;
4477 my($netrc) = CPAN::FTP::netrc->new;
4478 my($netrcfile) = $netrc->netrc;
4479 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
4480 my $targetfile = File::Basename::basename($aslocal);
4486 map("cd $_", split /\//, $dir), # RFC 1738
4488 "get $getfile $targetfile",
4492 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
4493 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
4494 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
4496 $netrc->contains($host))) if $CPAN::DEBUG;
4497 if ($netrc->protected) {
4498 my $dialog = join "", map { " $_\n" } @dialog;
4500 if ($netrc->contains($host)) {
4501 $netrc_explain = "Relying that your .netrc entry for '$host' ".
4502 "manages the login";
4504 $netrc_explain = "Relying that your default .netrc entry ".
4505 "manages the login";
4507 $CPAN::Frontend->myprint(qq{
4508 Trying with external ftp to get
4511 Going to send the dialog
4515 $self->talk_ftp("$ftpbin$verbose $host",
4517 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4518 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4520 if ($mtime > $timestamp) {
4521 $CPAN::Frontend->myprint("GOT $aslocal\n");
4522 $ThesiteURL = $ro_url;
4525 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
4527 return if $CPAN::Signal;
4529 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
4530 qq{correctly protected.\n});
4533 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
4534 nor does it have a default entry\n");
4537 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
4538 # then and login manually to host, using e-mail as
4540 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
4544 "user anonymous $Config::Config{'cf_email'}"
4546 my $dialog = join "", map { " $_\n" } @dialog;
4547 $CPAN::Frontend->myprint(qq{
4548 Trying with external ftp to get
4550 Going to send the dialog
4554 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
4555 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4556 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4558 if ($mtime > $timestamp) {
4559 $CPAN::Frontend->myprint("GOT $aslocal\n");
4560 $ThesiteURL = $ro_url;
4563 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
4565 return if $CPAN::Signal;
4566 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
4567 $CPAN::Frontend->mysleep(2);
4571 # package CPAN::FTP;
4573 my($self,$command,@dialog) = @_;
4574 my $fh = FileHandle->new;
4575 $fh->open("|$command") or die "Couldn't open ftp: $!";
4576 foreach (@dialog) { $fh->print("$_\n") }
4577 $fh->close; # Wait for process to complete
4579 my $estatus = $wstatus >> 8;
4580 $CPAN::Frontend->myprint(qq{
4581 Subprocess "|$command"
4582 returned status $estatus (wstat $wstatus)
4586 # find2perl needs modularization, too, all the following is stolen
4590 my($self,$name) = @_;
4591 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
4592 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
4594 my($perms,%user,%group);
4598 $blocks = int(($blocks + 1) / 2);
4601 $blocks = int(($sizemm + 1023) / 1024);
4604 if (-f _) { $perms = '-'; }
4605 elsif (-d _) { $perms = 'd'; }
4606 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
4607 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
4608 elsif (-p _) { $perms = 'p'; }
4609 elsif (-S _) { $perms = 's'; }
4610 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
4612 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
4613 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
4614 my $tmpmode = $mode;
4615 my $tmp = $rwx[$tmpmode & 7];
4617 $tmp = $rwx[$tmpmode & 7] . $tmp;
4619 $tmp = $rwx[$tmpmode & 7] . $tmp;
4620 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
4621 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
4622 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
4625 my $user = $user{$uid} || $uid; # too lazy to implement lookup
4626 my $group = $group{$gid} || $gid;
4628 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4630 my($moname) = $moname[$mon];
4631 if (-M _ > 365.25 / 2) {
4632 $timeyear = $year + 1900;
4635 $timeyear = sprintf("%02d:%02d", $hour, $min);
4638 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
4652 package CPAN::FTP::netrc;
4655 # package CPAN::FTP::netrc;
4658 my $home = CPAN::HandleConfig::home;
4659 my $file = File::Spec->catfile($home,".netrc");
4661 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4662 $atime,$mtime,$ctime,$blksize,$blocks)
4667 my($fh,@machines,$hasdefault);
4669 $fh = FileHandle->new or die "Could not create a filehandle";
4671 if($fh->open($file)) {
4672 $protected = ($mode & 077) == 0;
4674 NETRC: while (<$fh>) {
4675 my(@tokens) = split " ", $_;
4676 TOKEN: while (@tokens) {
4677 my($t) = shift @tokens;
4678 if ($t eq "default") {
4682 last TOKEN if $t eq "macdef";
4683 if ($t eq "machine") {
4684 push @machines, shift @tokens;
4689 $file = $hasdefault = $protected = "";
4693 'mach' => [@machines],
4695 'hasdefault' => $hasdefault,
4696 'protected' => $protected,
4700 # CPAN::FTP::netrc::hasdefault;
4701 sub hasdefault { shift->{'hasdefault'} }
4702 sub netrc { shift->{'netrc'} }
4703 sub protected { shift->{'protected'} }
4705 my($self,$mach) = @_;
4706 for ( @{$self->{'mach'}} ) {
4707 return 1 if $_ eq $mach;
4712 package CPAN::Complete;
4716 my($text, $line, $start, $end) = @_;
4717 my(@perlret) = cpl($text, $line, $start);
4718 # find longest common match. Can anybody show me how to peruse
4719 # T::R::Gnu to have this done automatically? Seems expensive.
4720 return () unless @perlret;
4721 my($newtext) = $text;
4722 for (my $i = length($text)+1;;$i++) {
4723 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4724 my $try = substr($perlret[0],0,$i);
4725 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4726 # warn "try[$try]tries[@tries]";
4727 if (@tries == @perlret) {
4733 ($newtext,@perlret);
4736 #-> sub CPAN::Complete::cpl ;
4738 my($word,$line,$pos) = @_;
4742 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4744 if ($line =~ s/^((?:notest|f?force)\s*)//) {
4748 if ($pos == 0 || $line =~ /^(?:h(?:elp)?|\?)\s/) {
4749 @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS;
4750 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4752 } elsif ($line =~ /^(a|ls)\s/) {
4753 @return = cplx('CPAN::Author',uc($word));
4754 } elsif ($line =~ /^b\s/) {
4755 CPAN::Shell->local_bundles;
4756 @return = cplx('CPAN::Bundle',$word);
4757 } elsif ($line =~ /^d\s/) {
4758 @return = cplx('CPAN::Distribution',$word);
4759 } elsif ($line =~ m/^(
4760 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4762 if ($word =~ /^Bundle::/) {
4763 CPAN::Shell->local_bundles;
4765 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4766 } elsif ($line =~ /^i\s/) {
4767 @return = cpl_any($word);
4768 } elsif ($line =~ /^reload\s/) {
4769 @return = cpl_reload($word,$line,$pos);
4770 } elsif ($line =~ /^o\s/) {
4771 @return = cpl_option($word,$line,$pos);
4772 } elsif ($line =~ m/^\S+\s/ ) {
4773 # fallback for future commands and what we have forgotten above
4774 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4781 #-> sub CPAN::Complete::cplx ;
4783 my($class, $word) = @_;
4784 if (CPAN::_sqlite_running) {
4785 $CPAN::SQLite->search($class, "^\Q$word\E");
4787 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
4790 #-> sub CPAN::Complete::cpl_any ;
4794 cplx('CPAN::Author',$word),
4795 cplx('CPAN::Bundle',$word),
4796 cplx('CPAN::Distribution',$word),
4797 cplx('CPAN::Module',$word),
4801 #-> sub CPAN::Complete::cpl_reload ;
4803 my($word,$line,$pos) = @_;
4805 my(@words) = split " ", $line;
4806 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4807 my(@ok) = qw(cpan index);
4808 return @ok if @words == 1;
4809 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4812 #-> sub CPAN::Complete::cpl_option ;
4814 my($word,$line,$pos) = @_;
4816 my(@words) = split " ", $line;
4817 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4818 my(@ok) = qw(conf debug);
4819 return @ok if @words == 1;
4820 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4822 } elsif ($words[1] eq 'index') {
4824 } elsif ($words[1] eq 'conf') {
4825 return CPAN::HandleConfig::cpl(@_);
4826 } elsif ($words[1] eq 'debug') {
4827 return sort grep /^\Q$word\E/i,
4828 sort keys %CPAN::DEBUG, 'all';
4832 package CPAN::Index;
4835 #-> sub CPAN::Index::force_reload ;
4838 $CPAN::Index::LAST_TIME = 0;
4842 #-> sub CPAN::Index::reload ;
4844 my($self,$force) = @_;
4847 # XXX check if a newer one is available. (We currently read it
4848 # from time to time)
4849 for ($CPAN::Config->{index_expire}) {
4850 $_ = 0.001 unless $_ && $_ > 0.001;
4852 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4853 # debug here when CPAN doesn't seem to read the Metadata
4855 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4857 unless ($CPAN::META->{PROTOCOL}) {
4858 $self->read_metadata_cache;
4859 $CPAN::META->{PROTOCOL} ||= "1.0";
4861 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4862 # warn "Setting last_time to 0";
4863 $LAST_TIME = 0; # No warning necessary
4865 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4868 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4870 # IFF we are developing, it helps to wipe out the memory
4871 # between reloads, otherwise it is not what a user expects.
4872 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4873 $CPAN::META = CPAN->new;
4876 local $LAST_TIME = $time;
4877 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4879 my $needshort = $^O eq "dos";
4881 $self->rd_authindex($self
4883 "authors/01mailrc.txt.gz",
4885 File::Spec->catfile('authors', '01mailrc.gz') :
4886 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4889 $debug = "timing reading 01[".($t2 - $time)."]";
4891 return if $CPAN::Signal; # this is sometimes lengthy
4892 $self->rd_modpacks($self
4894 "modules/02packages.details.txt.gz",
4896 File::Spec->catfile('modules', '02packag.gz') :
4897 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4900 $debug .= "02[".($t2 - $time)."]";
4902 return if $CPAN::Signal; # this is sometimes lengthy
4903 $self->rd_modlist($self
4905 "modules/03modlist.data.gz",
4907 File::Spec->catfile('modules', '03mlist.gz') :
4908 File::Spec->catfile('modules', '03modlist.data.gz'),
4910 $self->write_metadata_cache;
4912 $debug .= "03[".($t2 - $time)."]";
4914 CPAN->debug($debug) if $CPAN::DEBUG;
4916 if ($CPAN::Config->{build_dir_reuse}) {
4917 $self->reanimate_build_dir;
4919 if (CPAN::_sqlite_running) {
4920 $CPAN::SQLite->reload(time => $time, force => $force)
4924 $CPAN::META->{PROTOCOL} = PROTOCOL;
4927 #-> sub CPAN::Index::reanimate_build_dir ;
4928 sub reanimate_build_dir {
4930 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4933 return if $HAVE_REANIMATED++;
4934 my $d = $CPAN::Config->{build_dir};
4935 my $dh = DirHandle->new;
4936 opendir $dh, $d or return; # does not exist
4941 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4942 my @candidates = map { $_->[0] }
4943 sort { $b->[1] <=> $a->[1] }
4944 map { [ $_, -M File::Spec->catfile($d,$_) ] }
4945 grep {/\.yml$/} readdir $dh;
4946 DISTRO: for $i (0..$#candidates) {
4947 my $dirent = $candidates[$i];
4948 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
4950 warn "Error while parsing file '$dirent'; error: '$@'";
4954 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4955 my $key = $c->{distribution}{ID};
4956 for my $k (keys %{$c->{distribution}}) {
4957 if ($c->{distribution}{$k}
4958 && ref $c->{distribution}{$k}
4959 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4960 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
4964 #we tried to restore only if element already
4965 #exists; but then we do not work with metadata
4968 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
4969 = $c->{distribution};
4970 for my $skipper (qw(
4972 configure_requires_later
4973 configure_requires_later_for
4981 delete $do->{$skipper};
4984 if ($do->{make_test}
4986 && !(UNIVERSAL::can($do->{make_test},"failed") ?
4987 $do->{make_test}->failed :
4988 $do->{make_test} =~ /^YES/
4993 $do->{install}->failed
4996 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
5001 while (($painted/76) < ($i/@candidates)) {
5002 $CPAN::Frontend->myprint(".");
5006 $CPAN::Frontend->myprint(sprintf(
5007 "DONE\nFound %s old build%s, restored the state of %s\n",
5008 @candidates ? sprintf("%d",scalar @candidates) : "no",
5009 @candidates==1 ? "" : "s",
5010 $restored || "none",
5015 #-> sub CPAN::Index::reload_x ;
5017 my($cl,$wanted,$localname,$force) = @_;
5018 $force |= 2; # means we're dealing with an index here
5019 CPAN::HandleConfig->load; # we should guarantee loading wherever
5020 # we rely on Config XXX
5021 $localname ||= $wanted;
5022 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
5026 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
5029 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
5030 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
5031 qq{day$s. I\'ll use that.});
5034 $force |= 1; # means we're quite serious about it.
5036 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
5039 #-> sub CPAN::Index::rd_authindex ;
5041 my($cl, $index_target) = @_;
5042 return unless defined $index_target;
5043 return if CPAN::_sqlite_running;
5045 $CPAN::Frontend->myprint("Going to read $index_target\n");
5047 tie *FH, 'CPAN::Tarzip', $index_target;
5050 push @lines, split /\012/ while <FH>;
5054 my($userid,$fullname,$email) =
5055 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
5056 $fullname ||= $email;
5057 if ($userid && $fullname && $email) {
5058 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
5059 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
5061 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
5064 while (($painted/76) < ($i/@lines)) {
5065 $CPAN::Frontend->myprint(".");
5068 return if $CPAN::Signal;
5070 $CPAN::Frontend->myprint("DONE\n");
5074 my($self,$dist) = @_;
5075 $dist = $self->{'id'} unless defined $dist;
5076 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
5080 #-> sub CPAN::Index::rd_modpacks ;
5082 my($self, $index_target) = @_;
5083 return unless defined $index_target;
5084 return if CPAN::_sqlite_running;
5085 $CPAN::Frontend->myprint("Going to read $index_target\n");
5086 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
5088 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
5091 while (my $bytes = $fh->READ(\$chunk,8192)) {
5094 my @lines = split /\012/, $slurp;
5095 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
5098 my($line_count,$last_updated);
5100 my $shift = shift(@lines);
5101 last if $shift =~ /^\s*$/;
5102 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
5103 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
5105 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
5106 if (not defined $line_count) {
5108 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
5109 Please check the validity of the index file by comparing it to more
5110 than one CPAN mirror. I'll continue but problems seem likely to
5114 $CPAN::Frontend->mysleep(5);
5115 } elsif ($line_count != scalar @lines) {
5117 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
5118 contains a Line-Count header of %d but I see %d lines there. Please
5119 check the validity of the index file by comparing it to more than one
5120 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
5121 $index_target, $line_count, scalar(@lines));
5124 if (not defined $last_updated) {
5126 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
5127 Please check the validity of the index file by comparing it to more
5128 than one CPAN mirror. I'll continue but problems seem likely to
5132 $CPAN::Frontend->mysleep(5);
5136 ->myprint(sprintf qq{ Database was generated on %s\n},
5138 $DATE_OF_02 = $last_updated;
5141 if ($CPAN::META->has_inst('HTTP::Date')) {
5143 $age -= HTTP::Date::str2time($last_updated);
5145 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
5146 require Time::Local;
5147 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
5148 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
5149 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
5156 qq{Warning: This index file is %d days old.
5157 Please check the host you chose as your CPAN mirror for staleness.
5158 I'll continue but problems seem likely to happen.\a\n},
5161 } elsif ($age < -1) {
5165 qq{Warning: Your system date is %d days behind this index file!
5167 Timestamp index file: %s
5168 Please fix your system time, problems with the make command expected.\n},
5178 # A necessity since we have metadata_cache: delete what isn't
5180 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
5181 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
5186 # before 1.56 we split into 3 and discarded the rest. From
5187 # 1.57 we assign remaining text to $comment thus allowing to
5188 # influence isa_perl
5189 my($mod,$version,$dist,$comment) = split " ", $_, 4;
5190 my($bundle,$id,$userid);
5192 if ($mod eq 'CPAN' &&
5194 CPAN::Queue->exists('Bundle::CPAN') ||
5195 CPAN::Queue->exists('CPAN')
5199 if ($version > $CPAN::VERSION) {
5200 $CPAN::Frontend->mywarn(qq{
5201 New CPAN.pm version (v$version) available.
5202 [Currently running version is v$CPAN::VERSION]
5203 You might want to try
5206 to both upgrade CPAN.pm and run the new version without leaving
5207 the current session.
5210 $CPAN::Frontend->mysleep(2);
5211 $CPAN::Frontend->myprint(qq{\n});
5213 last if $CPAN::Signal;
5214 } elsif ($mod =~ /^Bundle::(.*)/) {
5219 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
5220 # Let's make it a module too, because bundles have so much
5221 # in common with modules.
5223 # Changed in 1.57_63: seems like memory bloat now without
5224 # any value, so commented out
5226 # $CPAN::META->instance('CPAN::Module',$mod);
5230 # instantiate a module object
5231 $id = $CPAN::META->instance('CPAN::Module',$mod);
5235 # Although CPAN prohibits same name with different version the
5236 # indexer may have changed the version for the same distro
5237 # since the last time ("Force Reindexing" feature)
5238 if ($id->cpan_file ne $dist
5240 $id->cpan_version ne $version
5242 $userid = $id->userid || $self->userid($dist);
5244 'CPAN_USERID' => $userid,
5245 'CPAN_VERSION' => $version,
5246 'CPAN_FILE' => $dist,
5250 # instantiate a distribution object
5251 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
5252 # we do not need CONTAINSMODS unless we do something with
5253 # this dist, so we better produce it on demand.
5255 ## my $obj = $CPAN::META->instance(
5256 ## 'CPAN::Distribution' => $dist
5258 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
5260 $CPAN::META->instance(
5261 'CPAN::Distribution' => $dist
5263 'CPAN_USERID' => $userid,
5264 'CPAN_COMMENT' => $comment,
5268 for my $name ($mod,$dist) {
5269 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
5270 $exists{$name} = undef;
5274 while (($painted/76) < ($i/@lines)) {
5275 $CPAN::Frontend->myprint(".");
5278 return if $CPAN::Signal;
5280 $CPAN::Frontend->myprint("DONE\n");
5282 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
5283 for my $o ($CPAN::META->all_objects($class)) {
5284 next if exists $exists{$o->{ID}};
5285 $CPAN::META->delete($class,$o->{ID});
5286 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
5293 #-> sub CPAN::Index::rd_modlist ;
5295 my($cl,$index_target) = @_;
5296 return unless defined $index_target;
5297 return if CPAN::_sqlite_running;
5298 $CPAN::Frontend->myprint("Going to read $index_target\n");
5299 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
5303 while (my $bytes = $fh->READ(\$chunk,8192)) {
5306 my @eval2 = split /\012/, $slurp;
5309 my $shift = shift(@eval2);
5310 if ($shift =~ /^Date:\s+(.*)/) {
5311 if ($DATE_OF_03 eq $1) {
5312 $CPAN::Frontend->myprint("Unchanged.\n");
5317 last if $shift =~ /^\s*$/;
5319 push @eval2, q{CPAN::Modulelist->data;};
5321 my($comp) = Safe->new("CPAN::Safe1");
5322 my($eval2) = join("\n", @eval2);
5323 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
5324 my $ret = $comp->reval($eval2);
5325 Carp::confess($@) if $@;
5326 return if $CPAN::Signal;
5328 my $until = keys(%$ret);
5330 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
5332 my $obj = $CPAN::META->instance("CPAN::Module",$_);
5333 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
5334 $obj->set(%{$ret->{$_}});
5336 while (($painted/76) < ($i/$until)) {
5337 $CPAN::Frontend->myprint(".");
5340 return if $CPAN::Signal;
5342 $CPAN::Frontend->myprint("DONE\n");
5345 #-> sub CPAN::Index::write_metadata_cache ;
5346 sub write_metadata_cache {
5348 return unless $CPAN::Config->{'cache_metadata'};
5349 return if CPAN::_sqlite_running;
5350 return unless $CPAN::META->has_usable("Storable");
5352 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
5353 CPAN::Distribution)) {
5354 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
5356 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5357 $cache->{last_time} = $LAST_TIME;
5358 $cache->{DATE_OF_02} = $DATE_OF_02;
5359 $cache->{PROTOCOL} = PROTOCOL;
5360 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
5361 eval { Storable::nstore($cache, $metadata_file) };
5362 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5365 #-> sub CPAN::Index::read_metadata_cache ;
5366 sub read_metadata_cache {
5368 return unless $CPAN::Config->{'cache_metadata'};
5369 return if CPAN::_sqlite_running;
5370 return unless $CPAN::META->has_usable("Storable");
5371 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5372 return unless -r $metadata_file and -f $metadata_file;
5373 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
5375 eval { $cache = Storable::retrieve($metadata_file) };
5376 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5377 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) {
5381 if (exists $cache->{PROTOCOL}) {
5382 if (PROTOCOL > $cache->{PROTOCOL}) {
5383 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
5384 "with protocol v%s, requiring v%s\n",
5391 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
5392 "with protocol v1.0\n");
5397 while(my($class,$v) = each %$cache) {
5398 next unless $class =~ /^CPAN::/;
5399 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
5400 while (my($id,$ro) = each %$v) {
5401 $CPAN::META->{readwrite}{$class}{$id} ||=
5402 $class->new(ID=>$id, RO=>$ro);
5407 unless ($clcnt) { # sanity check
5408 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
5411 if ($idcnt < 1000) {
5412 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
5413 "in $metadata_file\n");
5416 $CPAN::META->{PROTOCOL} ||=
5417 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
5418 # does initialize to some protocol
5419 $LAST_TIME = $cache->{last_time};
5420 $DATE_OF_02 = $cache->{DATE_OF_02};
5421 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
5422 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
5426 package CPAN::InfoObj;
5431 exists $self->{RO} and return $self->{RO};
5434 #-> sub CPAN::InfoObj::cpan_userid
5439 return $ro->{CPAN_USERID} || "N/A";
5441 $self->debug("ID[$self->{ID}]");
5442 # N/A for bundles found locally
5447 sub id { shift->{ID}; }
5449 #-> sub CPAN::InfoObj::new ;
5451 my $this = bless {}, shift;
5456 # The set method may only be used by code that reads index data or
5457 # otherwise "objective" data from the outside world. All session
5458 # related material may do anything else with instance variables but
5459 # must not touch the hash under the RO attribute. The reason is that
5460 # the RO hash gets written to Metadata file and is thus persistent.
5462 #-> sub CPAN::InfoObj::safe_chdir ;
5464 my($self,$todir) = @_;
5465 # we die if we cannot chdir and we are debuggable
5466 Carp::confess("safe_chdir called without todir argument")
5467 unless defined $todir and length $todir;
5469 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5473 unless (-x $todir) {
5474 unless (chmod 0755, $todir) {
5475 my $cwd = CPAN::anycwd();
5476 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
5477 "permission to change the permission; cannot ".
5478 "chdir to '$todir'\n");
5479 $CPAN::Frontend->mysleep(5);
5480 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5481 qq{to todir[$todir]: $!});
5485 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
5488 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5491 my $cwd = CPAN::anycwd();
5492 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5493 qq{to todir[$todir] (a chmod has been issued): $!});
5498 #-> sub CPAN::InfoObj::set ;
5500 my($self,%att) = @_;
5501 my $class = ref $self;
5503 # This must be ||=, not ||, because only if we write an empty
5504 # reference, only then the set method will write into the readonly
5505 # area. But for Distributions that spring into existence, maybe
5506 # because of a typo, we do not like it that they are written into
5507 # the readonly area and made permanent (at least for a while) and
5508 # that is why we do not "allow" other places to call ->set.
5509 unless ($self->id) {
5510 CPAN->debug("Bug? Empty ID, rejecting");
5513 my $ro = $self->{RO} =
5514 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
5516 while (my($k,$v) = each %att) {
5521 #-> sub CPAN::InfoObj::as_glimpse ;
5525 my $class = ref($self);
5526 $class =~ s/^CPAN:://;
5527 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
5528 push @m, sprintf "%-15s %s\n", $class, $id;
5532 #-> sub CPAN::InfoObj::as_string ;
5536 my $class = ref($self);
5537 $class =~ s/^CPAN:://;
5538 push @m, $class, " id = $self->{ID}\n";
5540 unless ($ro = $self->ro) {
5541 if (substr($self->{ID},-1,1) eq ".") { # directory
5544 $CPAN::Frontend->mywarn("Unknown object $self->{ID}\n");
5545 $CPAN::Frontend->mysleep(5);
5549 for (sort keys %$ro) {
5550 # next if m/^(ID|RO)$/;
5552 if ($_ eq "CPAN_USERID") {
5554 $extra .= $self->fullname;
5555 my $email; # old perls!
5556 if ($email = $CPAN::META->instance("CPAN::Author",
5559 $extra .= " <$email>";
5561 $extra .= " <no email>";
5564 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
5565 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
5568 next unless defined $ro->{$_};
5569 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
5571 KEY: for (sort keys %$self) {
5572 next if m/^(ID|RO)$/;
5573 unless (defined $self->{$_}) {
5577 if (ref($self->{$_}) eq "ARRAY") {
5578 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
5579 } elsif (ref($self->{$_}) eq "HASH") {
5581 if (/^CONTAINSMODS$/) {
5582 $value = join(" ",sort keys %{$self->{$_}});
5583 } elsif (/^prereq_pm$/) {
5585 my $v = $self->{$_};
5586 for my $x (sort keys %$v) {
5588 for my $y (sort keys %{$v->{$x}}) {
5589 push @svalue, "$y=>$v->{$x}{$y}";
5591 push @value, "$x\:" . join ",", @svalue if @svalue;
5593 $value = join ";", @value;
5595 $value = $self->{$_};
5603 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
5609 #-> sub CPAN::InfoObj::fullname ;
5612 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
5615 #-> sub CPAN::InfoObj::dump ;
5617 my($self, $what) = @_;
5618 unless ($CPAN::META->has_inst("Data::Dumper")) {
5619 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
5621 local $Data::Dumper::Sortkeys;
5622 $Data::Dumper::Sortkeys = 1;
5623 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
5624 if (length $out > 100000) {
5625 my $fh_pager = FileHandle->new;
5626 local($SIG{PIPE}) = "IGNORE";
5627 my $pager = $CPAN::Config->{'pager'} || "cat";
5628 $fh_pager->open("|$pager")
5629 or die "Could not open pager $pager\: $!";
5630 $fh_pager->print($out);
5633 $CPAN::Frontend->myprint($out);
5637 package CPAN::Author;
5640 #-> sub CPAN::Author::force
5646 #-> sub CPAN::Author::force
5649 delete $self->{force};
5652 #-> sub CPAN::Author::id
5655 my $id = $self->{ID};
5656 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
5660 #-> sub CPAN::Author::as_glimpse ;
5664 my $class = ref($self);
5665 $class =~ s/^CPAN:://;
5666 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
5674 #-> sub CPAN::Author::fullname ;
5676 shift->ro->{FULLNAME};
5680 #-> sub CPAN::Author::email ;
5681 sub email { shift->ro->{EMAIL}; }
5683 #-> sub CPAN::Author::ls ;
5686 my $glob = shift || "";
5687 my $silent = shift || 0;
5690 # adapted from CPAN::Distribution::verifyCHECKSUM ;
5691 my(@csf); # chksumfile
5692 @csf = $self->id =~ /(.)(.)(.*)/;
5693 $csf[1] = join "", @csf[0,1];
5694 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
5696 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
5697 unless (grep {$_->[2] eq $csf[1]} @dl) {
5698 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
5701 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
5702 unless (grep {$_->[2] eq $csf[2]} @dl) {
5703 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5706 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5708 if ($CPAN::META->has_inst("Text::Glob")) {
5709 my $rglob = Text::Glob::glob_to_regex($glob);
5710 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5712 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5715 unless ($silent >= 2) {
5716 $CPAN::Frontend->myprint(join "", map {
5717 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5718 } sort { $a->[2] cmp $b->[2] } @dl);
5723 # returns an array of arrays, the latter contain (size,mtime,filename)
5724 #-> sub CPAN::Author::dir_listing ;
5727 my $chksumfile = shift;
5728 my $recursive = shift;
5729 my $may_ftp = shift;
5732 File::Spec->catfile($CPAN::Config->{keep_source_where},
5733 "authors", "id", @$chksumfile);
5737 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5738 # hazard. (Without GPG installed they are not that much better,
5740 $fh = FileHandle->new;
5741 if (open($fh, $lc_want)) {
5742 my $line = <$fh>; close $fh;
5743 unlink($lc_want) unless $line =~ /PGP/;
5747 # connect "force" argument with "index_expire".
5748 my $force = $self->{force};
5749 if (my @stat = stat $lc_want) {
5750 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5754 $lc_file = CPAN::FTP->localize(
5755 "authors/id/@$chksumfile",
5760 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5761 $chksumfile->[-1] .= ".gz";
5762 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5765 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5766 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
5772 $lc_file = $lc_want;
5773 # we *could* second-guess and if the user has a file: URL,
5774 # then we could look there. But on the other hand, if they do
5775 # have a file: URL, wy did they choose to set
5776 # $CPAN::Config->{show_upload_date} to false?
5779 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
5780 $fh = FileHandle->new;
5782 if (open $fh, $lc_file) {
5785 $eval =~ s/\015?\012/\n/g;
5787 my($comp) = Safe->new();
5788 $cksum = $comp->reval($eval);
5790 rename $lc_file, "$lc_file.bad";
5791 Carp::confess($@) if $@;
5793 } elsif ($may_ftp) {
5794 Carp::carp "Could not open '$lc_file' for reading.";
5796 # Maybe should warn: "You may want to set show_upload_date to a true value"
5800 for $f (sort keys %$cksum) {
5801 if (exists $cksum->{$f}{isdir}) {
5803 my(@dir) = @$chksumfile;
5805 push @dir, $f, "CHECKSUMS";
5807 [$_->[0], $_->[1], "$f/$_->[2]"]
5808 } $self->dir_listing(\@dir,1,$may_ftp);
5810 push @result, [ 0, "-", $f ];
5814 ($cksum->{$f}{"size"}||0),
5815 $cksum->{$f}{"mtime"}||"---",
5823 #-> sub CPAN::Author::reports
5825 $CPAN::Frontend->mywarn("reports on authors not implemented.
5826 Please file a bugreport if you need this.\n");
5829 package CPAN::Distribution;
5835 my $ro = $self->ro or return;
5839 #-> CPAN::Distribution::undelay
5843 "configure_requires_later",
5844 "configure_requires_later_for",
5848 delete $self->{$delayer};
5852 #-> CPAN::Distribution::is_dot_dist
5855 return substr($self->id,-1,1) eq ".";
5858 # add the A/AN/ stuff
5859 #-> CPAN::Distribution::normalize
5862 $s = $self->id unless defined $s;
5863 if (substr($s,-1,1) eq ".") {
5864 # using a global because we are sometimes called as static method
5865 if (!$CPAN::META->{LOCK}
5866 && !$CPAN::Have_warned->{"$s is unlocked"}++
5868 $CPAN::Frontend->mywarn("You are visiting the local directory
5870 without lock, take care that concurrent processes do not do likewise.\n");
5871 $CPAN::Frontend->mysleep(1);
5874 $s = "$CPAN::iCwd/.";
5875 } elsif (File::Spec->file_name_is_absolute($s)) {
5876 } elsif (File::Spec->can("rel2abs")) {
5877 $s = File::Spec->rel2abs($s);
5879 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5881 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5882 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5883 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5884 $_->{build_dir} = $s;
5885 $_->{archived} = "local_directory";
5886 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5892 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5894 return $s if $s =~ m:^N/A|^Contact Author: ;
5895 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5896 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5897 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5902 #-> sub CPAN::Distribution::author ;
5906 if (substr($self->id,-1,1) eq ".") {
5907 $authorid = "LOCAL";
5909 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5911 CPAN::Shell->expand("Author",$authorid);
5914 # tries to get the yaml from CPAN instead of the distro itself:
5915 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5918 my $meta = $self->pretty_id;
5919 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5920 my(@ls) = CPAN::Shell->globls($meta);
5921 my $norm = $self->normalize($meta);
5925 File::Spec->catfile(
5926 $CPAN::Config->{keep_source_where},
5931 $self->debug("Doing localize") if $CPAN::DEBUG;
5932 unless ($local_file =
5933 CPAN::FTP->localize("authors/id/$norm",
5935 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5937 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5940 #-> sub CPAN::Distribution::cpan_userid
5943 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5946 return $self->SUPER::cpan_userid;
5949 #-> sub CPAN::Distribution::pretty_id
5953 return $id unless $id =~ m|^./../|;
5957 #-> sub CPAN::Distribution::base_id
5960 my $id = $self->pretty_id();
5961 my $base_id = File::Basename::basename($id);
5962 $base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i;
5966 # mark as dirty/clean for the sake of recursion detection. $color=1
5967 # means "in use", $color=0 means "not in use anymore". $color=2 means
5968 # we have determined prereqs now and thus insist on passing this
5969 # through (at least) once again.
5971 #-> sub CPAN::Distribution::color_cmd_tmps ;
5972 sub color_cmd_tmps {
5974 my($depth) = shift || 0;
5975 my($color) = shift || 0;
5976 my($ancestors) = shift || [];
5977 # a distribution needs to recurse into its prereq_pms
5979 return if exists $self->{incommandcolor}
5981 && $self->{incommandcolor}==$color;
5982 if ($depth>=$CPAN::MAX_RECURSION) {
5983 die(CPAN::Exception::RecursiveDependency->new($ancestors));
5985 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5986 my $prereq_pm = $self->prereq_pm;
5987 if (defined $prereq_pm) {
5988 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5989 keys %{$prereq_pm->{build_requires}||{}}) {
5990 next PREREQ if $pre eq "perl";
5992 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5993 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5994 $CPAN::Frontend->mysleep(2);
5997 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6001 delete $self->{sponsored_mods};
6003 # as we are at the end of a command, we'll give up this
6004 # reminder of a broken test. Other commands may test this guy
6005 # again. Maybe 'badtestcnt' should be renamed to
6006 # 'make_test_failed_within_command'?
6007 delete $self->{badtestcnt};
6009 $self->{incommandcolor} = $color;
6012 #-> sub CPAN::Distribution::as_string ;
6015 $self->containsmods;
6017 $self->SUPER::as_string(@_);
6020 #-> sub CPAN::Distribution::containsmods ;
6023 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
6024 my $dist_id = $self->{ID};
6025 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
6026 my $mod_file = $mod->cpan_file or next;
6027 my $mod_id = $mod->{ID} or next;
6028 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
6030 if ($CPAN::Signal) {
6031 delete $self->{CONTAINSMODS};
6034 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
6036 keys %{$self->{CONTAINSMODS}||={}};
6039 #-> sub CPAN::Distribution::upload_date ;
6042 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
6043 my(@local_wanted) = split(/\//,$self->id);
6044 my $filename = pop @local_wanted;
6045 push @local_wanted, "CHECKSUMS";
6046 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
6047 return unless $author;
6048 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
6050 my($dirent) = grep { $_->[2] eq $filename } @dl;
6051 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
6052 return unless $dirent->[1];
6053 return $self->{UPLOAD_DATE} = $dirent->[1];
6056 #-> sub CPAN::Distribution::uptodate ;
6060 foreach $c ($self->containsmods) {
6061 my $obj = CPAN::Shell->expandany($c);
6062 unless ($obj->uptodate) {
6063 my $id = $self->pretty_id;
6064 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
6071 #-> sub CPAN::Distribution::called_for ;
6074 $self->{CALLED_FOR} = $id if defined $id;
6075 return $self->{CALLED_FOR};
6078 #-> sub CPAN::Distribution::get ;
6081 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
6082 if (my $goto = $self->prefs->{goto}) {
6083 $CPAN::Frontend->mywarn
6085 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
6087 $self->{prefs_file},
6088 $self->{prefs_file_doc},
6090 return $self->goto($goto);
6092 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6094 : ($ENV{PERLLIB} || "");
6096 $CPAN::META->set_perl5lib;
6097 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6101 my $goodbye_message;
6102 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
6103 if ($self->prefs->{disabled}) {
6105 "Disabled via prefs file '%s' doc %d",
6106 $self->{prefs_file},
6107 $self->{prefs_file_doc},
6110 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
6111 $goodbye_message = "[disabled] -- NA $why";
6112 # note: not intended to be persistent but at least visible
6113 # during this session
6115 if (exists $self->{build_dir} && -d $self->{build_dir}
6116 && ($self->{modulebuild}||$self->{writemakefile})
6118 # this deserves print, not warn:
6119 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
6120 "$self->{build_dir}\n"
6125 # although we talk about 'force' we shall not test on
6126 # force directly. New model of force tries to refrain from
6127 # direct checking of force.
6128 exists $self->{unwrapped} and (
6129 UNIVERSAL::can($self->{unwrapped},"failed") ?
6130 $self->{unwrapped}->failed :
6131 $self->{unwrapped} =~ /^NO/
6133 and push @e, "Unwrapping had some problem, won't try again without force";
6136 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e);
6137 if ($goodbye_message) {
6138 $self->goodbye($goodbye_message);
6143 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
6146 unless ($self->{build_dir} && -d $self->{build_dir}) {
6147 $self->get_file_onto_local_disk;
6148 return if $CPAN::Signal;
6149 $self->check_integrity;
6150 return if $CPAN::Signal;
6151 (my $packagedir,$local_file) = $self->run_preps_on_packagedir;
6152 $packagedir ||= $self->{build_dir};
6153 $self->{build_dir} = $packagedir;
6156 if ($CPAN::Signal) {
6157 $self->safe_chdir($sub_wd);
6160 return $self->run_MM_or_MB($local_file);
6163 #-> CPAN::Distribution::get_file_onto_local_disk
6164 sub get_file_onto_local_disk {
6167 return if $self->is_dot_dist;
6170 File::Spec->catfile(
6171 $CPAN::Config->{keep_source_where},
6174 split(/\//,$self->id)
6177 $self->debug("Doing localize") if $CPAN::DEBUG;
6178 unless ($local_file =
6179 CPAN::FTP->localize("authors/id/$self->{ID}",
6182 if ($CPAN::Index::DATE_OF_02) {
6183 $note = "Note: Current database in memory was generated ".
6184 "on $CPAN::Index::DATE_OF_02\n";
6186 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
6189 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
6190 $self->{localfile} = $local_file;
6194 #-> CPAN::Distribution::check_integrity
6195 sub check_integrity {
6198 return if $self->is_dot_dist;
6199 if ($CPAN::META->has_inst("Digest::SHA")) {
6200 $self->debug("Digest::SHA is installed, verifying");
6201 $self->verifyCHECKSUM;
6203 $self->debug("Digest::SHA is NOT installed");
6207 #-> CPAN::Distribution::run_preps_on_packagedir
6208 sub run_preps_on_packagedir {
6210 return if $self->is_dot_dist;
6212 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
6213 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
6214 $self->safe_chdir($builddir);
6215 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
6216 File::Path::rmtree("tmp-$$");
6217 unless (mkdir "tmp-$$", 0755) {
6218 $CPAN::Frontend->unrecoverable_error(<<EOF);
6219 Couldn't mkdir '$builddir/tmp-$$': $!
6221 Cannot continue: Please find the reason why I cannot make the
6224 and fix the problem, then retry.
6228 if ($CPAN::Signal) {
6231 $self->safe_chdir("tmp-$$");
6236 my $local_file = $self->{localfile};
6237 my $ct = eval{CPAN::Tarzip->new($local_file)};
6239 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
6240 delete $self->{build_dir};
6243 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) {
6244 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
6245 $self->untar_me($ct);
6246 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
6247 $self->unzip_me($ct);
6249 $self->{was_uncompressed}++ unless $ct->gtest();
6250 $local_file = $self->handle_singlefile($local_file);
6253 # we are still in the tmp directory!
6254 # Let's check if the package has its own directory.
6255 my $dh = DirHandle->new(File::Spec->curdir)
6256 or Carp::croak("Couldn't opendir .: $!");
6257 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
6260 # XXX here we want in each branch File::Temp to protect all build_dir directories
6261 if (CPAN->has_usable("File::Temp")) {
6265 if (@readdir == 1 && -d $readdir[0]) {
6266 $tdir_base = $readdir[0];
6267 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
6268 my $dh2 = DirHandle->new($from_dir)
6269 or Carp::croak("Couldn't opendir $from_dir: $!");
6270 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
6272 my $userid = $self->cpan_userid;
6273 CPAN->debug("userid[$userid]");
6274 if (!$userid or $userid eq "N/A") {
6277 $tdir_base = $userid;
6278 $from_dir = File::Spec->curdir;
6279 @dirents = @readdir;
6281 $packagedir = File::Temp::tempdir(
6282 "$tdir_base-XXXXXX",
6287 for $f (@dirents) { # is already without "." and ".."
6288 my $from = File::Spec->catdir($from_dir,$f);
6289 my $to = File::Spec->catdir($packagedir,$f);
6290 unless (File::Copy::move($from,$to)) {
6292 $from = File::Spec->rel2abs($from);
6293 Carp::confess("Couldn't move $from to $to: $err");
6296 } else { # older code below, still better than nothing when there is no File::Temp
6298 if (@readdir == 1 && -d $readdir[0]) {
6299 $distdir = $readdir[0];
6300 $packagedir = File::Spec->catdir($builddir,$distdir);
6301 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
6303 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
6305 File::Path::rmtree($packagedir);
6306 unless (File::Copy::move($distdir,$packagedir)) {
6307 $CPAN::Frontend->unrecoverable_error(<<EOF);
6308 Couldn't move '$distdir' to '$packagedir': $!
6310 Cannot continue: Please find the reason why I cannot move
6311 $builddir/tmp-$$/$distdir
6314 and fix the problem, then retry
6318 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
6325 my $userid = $self->cpan_userid;
6326 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
6327 if (!$userid or $userid eq "N/A") {
6330 my $pragmatic_dir = $userid . '000';
6331 $pragmatic_dir =~ s/\W_//g;
6332 $pragmatic_dir++ while -d "../$pragmatic_dir";
6333 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
6334 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
6335 File::Path::mkpath($packagedir);
6337 for $f (@readdir) { # is already without "." and ".."
6338 my $to = File::Spec->catdir($packagedir,$f);
6339 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
6343 $self->{build_dir} = $packagedir;
6344 $self->safe_chdir($builddir);
6345 File::Path::rmtree("tmp-$$");
6347 $self->safe_chdir($packagedir);
6348 $self->_signature_business();
6349 $self->safe_chdir($builddir);
6351 return($packagedir,$local_file);
6354 #-> sub CPAN::Distribution::parse_meta_yml ;
6355 sub parse_meta_yml {
6357 my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir";
6358 my $yaml = File::Spec->catfile($build_dir,"META.yml");
6359 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
6360 return unless -f $yaml;
6363 require Parse::Metayaml; # hypothetical
6364 $early_yaml = Parse::Metayaml::LoadFile($yaml)->[0];
6366 unless ($early_yaml) {
6367 eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; };
6369 unless ($early_yaml) {
6375 #-> sub CPAN::Distribution::satisfy_configure_requires ;
6376 sub satisfy_configure_requires {
6378 my $enable_configure_requires = 1;
6379 if (!$enable_configure_requires) {
6381 # if we return 1 here, everything is as before we introduced
6382 # configure_requires that means, things with
6383 # configure_requires simply fail, all others succeed
6385 my @prereq = $self->unsat_prereq("configure_requires_later") or return 1;
6386 if ($self->{configure_requires_later}) {
6387 for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
6388 if ($self->{configure_requires_later_for}{$k}>1) {
6389 # we must not come here a second time
6390 $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate...");
6392 $CPAN::Frontend->mydie
6395 ({self=>$self, prereq=>\@prereq})
6400 if ($prereq[0][0] eq "perl") {
6401 my $need = "requires perl '$prereq[0][1]'";
6402 my $id = $self->pretty_id;
6403 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6404 $self->{make} = CPAN::Distrostatus->new("NO $need");
6405 $self->store_persistent_state;
6406 return $self->goodbye("[prereq] -- NOT OK");
6409 $self->follow_prereqs("configure_requires_later", @prereq);
6414 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
6415 $CPAN::Frontend->mywarn($@);
6416 return $self->goodbye("[depend] -- NOT OK");
6419 die "never reached";
6422 #-> sub CPAN::Distribution::run_MM_or_MB ;
6424 my($self,$local_file) = @_;
6425 $self->satisfy_configure_requires() or return;
6426 my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL");
6427 my($mpl_exists) = -f $mpl;
6428 unless ($mpl_exists) {
6429 # NFS has been reported to have racing problems after the
6430 # renaming of a directory in some environments.
6432 $CPAN::Frontend->mysleep(1);
6433 my $mpldh = DirHandle->new($self->{build_dir})
6434 or Carp::croak("Couldn't opendir $self->{build_dir}: $!");
6435 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
6438 my $prefer_installer = "eumm"; # eumm|mb
6439 if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) {
6440 if ($mpl_exists) { # they *can* choose
6441 if ($CPAN::META->has_inst("Module::Build")) {
6442 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
6443 q{prefer_installer});
6446 $prefer_installer = "mb";
6449 return unless $self->patch;
6450 if (lc($prefer_installer) eq "rand") {
6451 $prefer_installer = rand()<.5 ? "eumm" : "mb";
6453 if (lc($prefer_installer) eq "mb") {
6454 $self->{modulebuild} = 1;
6455 } elsif ($self->{archived} eq "patch") {
6456 # not an edge case, nothing to install for sure
6457 my $why = "A patch file cannot be installed";
6458 $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n");
6459 $self->{writemakefile} = CPAN::Distrostatus->new("NO $why");
6460 } elsif (! $mpl_exists) {
6461 $self->_edge_cases($mpl,$local_file);
6463 if ($self->{build_dir}
6465 $CPAN::Config->{build_dir_reuse}
6467 $self->store_persistent_state;
6472 #-> CPAN::Distribution::store_persistent_state
6473 sub store_persistent_state {
6475 my $dir = $self->{build_dir};
6476 unless (File::Spec->canonpath(File::Basename::dirname($dir))
6477 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
6478 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
6479 "will not store persistent state\n");
6482 my $file = sprintf "%s.yml", $dir;
6483 my $yaml_module = CPAN::_yaml_module;
6484 if ($CPAN::META->has_inst($yaml_module)) {
6485 CPAN->_yaml_dumpfile(
6489 perl => CPAN::_perl_fingerprint,
6490 distribution => $self,
6494 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
6495 "will not store persistent state\n");
6499 #-> CPAN::Distribution::try_download
6501 my($self,$patch) = @_;
6502 my $norm = $self->normalize($patch);
6504 File::Spec->catfile(
6505 $CPAN::Config->{keep_source_where},
6510 $self->debug("Doing localize") if $CPAN::DEBUG;
6511 return CPAN::FTP->localize("authors/id/$norm",
6516 my $stdpatchargs = "";
6517 #-> CPAN::Distribution::patch
6520 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
6521 my $patches = $self->prefs->{patches};
6523 $self->debug("patches[$patches]") if $CPAN::DEBUG;
6525 return unless @$patches;
6526 $self->safe_chdir($self->{build_dir});
6527 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
6528 my $patchbin = $CPAN::Config->{patch};
6529 unless ($patchbin && length $patchbin) {
6530 $CPAN::Frontend->mydie("No external patch command configured\n\n".
6531 "Please run 'o conf init /patch/'\n\n");
6533 unless (MM->maybe_command($patchbin)) {
6534 $CPAN::Frontend->mydie("No external patch command available\n\n".
6535 "Please run 'o conf init /patch/'\n\n");
6537 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
6538 local $ENV{PATCH_GET} = 0; # formerly known as -g0
6539 unless ($stdpatchargs) {
6540 my $system = "$patchbin --version |";
6542 open FH, $system or die "Could not fork '$system': $!";
6545 PARSEVERSION: while (<FH>) {
6546 if (/^patch\s+([\d\.]+)/) {
6552 $stdpatchargs = "-N --fuzz=3";
6554 $stdpatchargs = "-N";
6557 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
6558 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
6559 for my $patch (@$patches) {
6560 unless (-f $patch) {
6561 if (my $trydl = $self->try_download($patch)) {
6564 my $fail = "Could not find patch '$patch'";
6565 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6566 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6567 delete $self->{build_dir};
6571 $CPAN::Frontend->myprint(" $patch\n");
6572 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
6575 my $ppp = $self->_patch_p_parameter($readfh);
6576 if ($ppp eq "applypatch") {
6577 $pcommand = "$CPAN::Config->{applypatch} -verbose";
6579 my $thispatchargs = join " ", $stdpatchargs, $ppp;
6580 $pcommand = "$patchbin $thispatchargs";
6583 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
6584 my $writefh = FileHandle->new;
6585 $CPAN::Frontend->myprint(" $pcommand\n");
6586 unless (open $writefh, "|$pcommand") {
6587 my $fail = "Could not fork '$pcommand'";
6588 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6589 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6590 delete $self->{build_dir};
6593 while (my $x = $readfh->READLINE) {
6596 unless (close $writefh) {
6597 my $fail = "Could not apply patch '$patch'";
6598 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6599 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6600 delete $self->{build_dir};
6610 sub _patch_p_parameter {
6613 my $cnt_p0files = 0;
6615 while ($_ = $fh->READLINE) {
6617 $CPAN::Config->{applypatch}
6619 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
6623 next unless /^[\*\+]{3}\s(\S+)/;
6626 $cnt_p0files++ if -f $file;
6627 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
6630 return "-p1" unless $cnt_files;
6631 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
6634 #-> sub CPAN::Distribution::_edge_cases
6635 # with "configure" or "Makefile" or single file scripts
6637 my($self,$mpl,$local_file) = @_;
6638 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
6642 my $build_dir = $self->{build_dir};
6643 my($configure) = File::Spec->catfile($build_dir,"Configure");
6644 if (-f $configure) {
6645 # do we have anything to do?
6646 $self->{configure} = $configure;
6647 } elsif (-f File::Spec->catfile($build_dir,"Makefile")) {
6648 $CPAN::Frontend->mywarn(qq{
6649 Package comes with a Makefile and without a Makefile.PL.
6650 We\'ll try to build it with that Makefile then.
6652 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6653 $CPAN::Frontend->mysleep(2);
6655 my $cf = $self->called_for || "unknown";
6660 $cf =~ s|[/\\:]||g; # risk of filesystem damage
6661 $cf = "unknown" unless length($cf);
6662 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
6663 (The test -f "$mpl" returned false.)
6664 Writing one on our own (setting NAME to $cf)\a\n});
6665 $self->{had_no_makefile_pl}++;
6666 $CPAN::Frontend->mysleep(3);
6668 # Writing our own Makefile.PL
6671 if ($self->{archived} eq "maybe_pl") {
6672 my $fh = FileHandle->new;
6673 my $script_file = File::Spec->catfile($build_dir,$local_file);
6674 $fh->open($script_file)
6675 or Carp::croak("Could not open script '$script_file': $!");
6677 # name parsen und prereq
6678 my($state) = "poddir";
6679 my($name, $prereq) = ("", "");
6681 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
6684 } elsif ($1 eq 'PREREQUISITES') {
6687 } elsif ($state =~ m{^(name|prereq)$}) {
6692 } elsif ($state eq "name") {
6697 } elsif ($state eq "prereq") {
6700 } elsif (/^=cut\b/) {
6707 s{.*<}{}; # strip X<...>
6711 $prereq = join " ", split /\s+/, $prereq;
6712 my($PREREQ_PM) = join("\n", map {
6713 s{.*<}{}; # strip X<...>
6715 if (/[\s\'\"]/) { # prose?
6717 s/[^\w:]$//; # period?
6718 " "x28 . "'$_' => 0,";
6720 } split /\s*,\s*/, $prereq);
6723 EXE_FILES => ['$name'],
6729 my $to_file = File::Spec->catfile($build_dir, $name);
6730 rename $script_file, $to_file
6731 or die "Can't rename $script_file to $to_file: $!";
6735 my $fh = FileHandle->new;
6737 or Carp::croak("Could not open >$mpl: $!");
6739 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
6740 # because there was no Makefile.PL supplied.
6741 # Autogenerated on: }.scalar localtime().qq{
6743 use ExtUtils::MakeMaker;
6745 NAME => q[$cf],$script
6752 #-> CPAN::Distribution::_signature_business
6753 sub _signature_business {
6755 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6758 if ($CPAN::META->has_inst("Module::Signature")) {
6759 if (-f "SIGNATURE") {
6760 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6761 my $rv = Module::Signature::verify();
6762 if ($rv != Module::Signature::SIGNATURE_OK() and
6763 $rv != Module::Signature::SIGNATURE_MISSING()) {
6764 $CPAN::Frontend->mywarn(
6765 qq{\nSignature invalid for }.
6766 qq{distribution file. }.
6767 qq{Please investigate.\n\n}
6771 sprintf(qq{I'd recommend removing %s. Some error occured }.
6772 qq{while checking its signature, so it could }.
6773 qq{be invalid. Maybe you have configured }.
6774 qq{your 'urllist' with a bad URL. Please check this }.
6775 qq{array with 'o conf urllist' and retry. Or }.
6776 qq{examine the distribution in a subshell. Try
6784 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
6785 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
6786 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
6788 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
6789 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
6792 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
6795 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6800 #-> CPAN::Distribution::untar_me ;
6803 $self->{archived} = "tar";
6805 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6807 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
6811 # CPAN::Distribution::unzip_me ;
6814 $self->{archived} = "zip";
6816 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6818 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
6823 sub handle_singlefile {
6824 my($self,$local_file) = @_;
6826 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ) {
6827 $self->{archived} = "pm";
6828 } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) {
6829 $self->{archived} = "patch";
6831 $self->{archived} = "maybe_pl";
6834 my $to = File::Basename::basename($local_file);
6835 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
6836 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
6837 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6839 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
6842 if (File::Copy::cp($local_file,".")) {
6843 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6845 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
6851 #-> sub CPAN::Distribution::new ;
6853 my($class,%att) = @_;
6855 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
6857 my $this = { %att };
6858 return bless $this, $class;
6861 #-> sub CPAN::Distribution::look ;
6865 if ($^O eq 'MacOS') {
6866 $self->Mac::BuildTools::look;
6870 if ( $CPAN::Config->{'shell'} ) {
6871 $CPAN::Frontend->myprint(qq{
6872 Trying to open a subshell in the build directory...
6875 $CPAN::Frontend->myprint(qq{
6876 Your configuration does not define a value for subshells.
6877 Please define it with "o conf shell <your shell>"
6881 my $dist = $self->id;
6883 unless ($dir = $self->dir) {
6886 unless ($dir ||= $self->dir) {
6887 $CPAN::Frontend->mywarn(qq{
6888 Could not determine which directory to use for looking at $dist.
6892 my $pwd = CPAN::anycwd();
6893 $self->safe_chdir($dir);
6894 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6896 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
6897 $ENV{CPAN_SHELL_LEVEL} += 1;
6898 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
6899 unless (system($shell) == 0) {
6901 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
6904 $self->safe_chdir($pwd);
6907 # CPAN::Distribution::cvs_import ;
6911 my $dir = $self->dir;
6913 my $package = $self->called_for;
6914 my $module = $CPAN::META->instance('CPAN::Module', $package);
6915 my $version = $module->cpan_version;
6917 my $userid = $self->cpan_userid;
6919 my $cvs_dir = (split /\//, $dir)[-1];
6920 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
6922 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
6924 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
6925 if ($cvs_site_perl) {
6926 $cvs_dir = "$cvs_site_perl/$cvs_dir";
6928 my $cvs_log = qq{"imported $package $version sources"};
6929 $version =~ s/\./_/g;
6930 # XXX cvs: undocumented and unclear how it was meant to work
6931 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
6932 "$cvs_dir", $userid, "v$version");
6934 my $pwd = CPAN::anycwd();
6935 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
6937 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6939 $CPAN::Frontend->myprint(qq{@cmd\n});
6940 system(@cmd) == 0 or
6942 $CPAN::Frontend->mydie("cvs import failed");
6943 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
6946 #-> sub CPAN::Distribution::readme ;
6949 my($dist) = $self->id;
6950 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
6951 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
6954 File::Spec->catfile(
6955 $CPAN::Config->{keep_source_where},
6958 split(/\//,"$sans.readme"),
6960 $self->debug("Doing localize") if $CPAN::DEBUG;
6961 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
6963 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
6965 if ($^O eq 'MacOS') {
6966 Mac::BuildTools::launch_file($local_file);
6970 my $fh_pager = FileHandle->new;
6971 local($SIG{PIPE}) = "IGNORE";
6972 my $pager = $CPAN::Config->{'pager'} || "cat";
6973 $fh_pager->open("|$pager")
6974 or die "Could not open pager $pager\: $!";
6975 my $fh_readme = FileHandle->new;
6976 $fh_readme->open($local_file)
6977 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
6978 $CPAN::Frontend->myprint(qq{
6983 $fh_pager->print(<$fh_readme>);
6987 #-> sub CPAN::Distribution::verifyCHECKSUM ;
6988 sub verifyCHECKSUM {
6992 $self->{CHECKSUM_STATUS} ||= "";
6993 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
6994 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6996 my($lc_want,$lc_file,@local,$basename);
6997 @local = split(/\//,$self->id);
6999 push @local, "CHECKSUMS";
7001 File::Spec->catfile($CPAN::Config->{keep_source_where},
7002 "authors", "id", @local);
7004 if (my $size = -s $lc_want) {
7005 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
7006 if ($self->CHECKSUM_check_file($lc_want,1)) {
7007 return $self->{CHECKSUM_STATUS} = "OK";
7010 $lc_file = CPAN::FTP->localize("authors/id/@local",
7013 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
7014 $local[-1] .= ".gz";
7015 $lc_file = CPAN::FTP->localize("authors/id/@local",
7018 $lc_file =~ s/\.gz(?!\n)\Z//;
7019 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
7024 if ($self->CHECKSUM_check_file($lc_file)) {
7025 return $self->{CHECKSUM_STATUS} = "OK";
7029 #-> sub CPAN::Distribution::SIG_check_file ;
7030 sub SIG_check_file {
7031 my($self,$chk_file) = @_;
7032 my $rv = eval { Module::Signature::_verify($chk_file) };
7034 if ($rv == Module::Signature::SIGNATURE_OK()) {
7035 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
7036 return $self->{SIG_STATUS} = "OK";
7038 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
7039 qq{distribution file. }.
7040 qq{Please investigate.\n\n}.
7042 $CPAN::META->instance(
7047 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
7048 is invalid. Maybe you have configured your 'urllist' with
7049 a bad URL. Please check this array with 'o conf urllist', and
7052 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
7056 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
7058 # sloppy is 1 when we have an old checksums file that maybe is good
7061 sub CHECKSUM_check_file {
7062 my($self,$chk_file,$sloppy) = @_;
7063 my($cksum,$file,$basename);
7066 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
7067 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
7070 if ($CPAN::META->has_inst("Module::Signature")) {
7071 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
7072 $self->SIG_check_file($chk_file);
7074 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
7078 $file = $self->{localfile};
7079 $basename = File::Basename::basename($file);
7080 my $fh = FileHandle->new;
7081 if (open $fh, $chk_file) {
7084 $eval =~ s/\015?\012/\n/g;
7086 my($comp) = Safe->new();
7087 $cksum = $comp->reval($eval);
7089 rename $chk_file, "$chk_file.bad";
7090 Carp::confess($@) if $@;
7093 Carp::carp "Could not open $chk_file for reading";
7096 if (! ref $cksum or ref $cksum ne "HASH") {
7097 $CPAN::Frontend->mywarn(qq{
7098 Warning: checksum file '$chk_file' broken.
7100 When trying to read that file I expected to get a hash reference
7101 for further processing, but got garbage instead.
7103 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
7104 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
7105 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
7107 } elsif (exists $cksum->{$basename}{sha256}) {
7108 $self->debug("Found checksum for $basename:" .
7109 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
7113 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
7115 $fh = CPAN::Tarzip->TIEHANDLE($file);
7118 my $dg = Digest::SHA->new(256);
7121 while ($fh->READ($ref, 4096) > 0) {
7124 my $hexdigest = $dg->hexdigest;
7125 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
7129 $CPAN::Frontend->myprint("Checksum for $file ok\n");
7130 return $self->{CHECKSUM_STATUS} = "OK";
7132 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
7133 qq{distribution file. }.
7134 qq{Please investigate.\n\n}.
7136 $CPAN::META->instance(
7141 my $wrap = qq{I\'d recommend removing $file. Its
7142 checksum is incorrect. Maybe you have configured your 'urllist' with
7143 a bad URL. Please check this array with 'o conf urllist', and
7146 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
7148 # former versions just returned here but this seems a
7149 # serious threat that deserves a die
7151 # $CPAN::Frontend->myprint("\n\n");
7155 # close $fh if fileno($fh);
7158 unless ($self->{CHECKSUM_STATUS}) {
7159 $CPAN::Frontend->mywarn(qq{
7160 Warning: No checksum for $basename in $chk_file.
7162 The cause for this may be that the file is very new and the checksum
7163 has not yet been calculated, but it may also be that something is
7164 going awry right now.
7166 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
7167 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
7169 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
7174 #-> sub CPAN::Distribution::eq_CHECKSUM ;
7176 my($self,$fh,$expect) = @_;
7177 if ($CPAN::META->has_inst("Digest::SHA")) {
7178 my $dg = Digest::SHA->new(256);
7180 while (read($fh, $data, 4096)) {
7183 my $hexdigest = $dg->hexdigest;
7184 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
7185 return $hexdigest eq $expect;
7190 #-> sub CPAN::Distribution::force ;
7192 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
7193 # effect by autoinspection, not by inspecting a global variable. One
7194 # of the reason why this was chosen to work that way was the treatment
7195 # of dependencies. They should not automatically inherit the force
7196 # status. But this has the downside that ^C and die() will return to
7197 # the prompt but will not be able to reset the force_update
7198 # attributes. We try to correct for it currently in the read_metadata
7199 # routine, and immediately before we check for a Signal. I hope this
7200 # works out in one of v1.57_53ff
7202 # "Force get forgets previous error conditions"
7204 #-> sub CPAN::Distribution::fforce ;
7206 my($self, $method) = @_;
7207 $self->force($method,1);
7210 #-> sub CPAN::Distribution::force ;
7212 my($self, $method,$fforce) = @_;
7230 "prereq_pm_detected",
7244 my $methodmatch = 0;
7246 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
7247 $methodmatch = 1 if $fforce || $phase eq $method;
7248 next unless $methodmatch;
7249 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
7250 if ($phase eq "get") {
7251 if (substr($self->id,-1,1) eq "."
7252 && $att =~ /(unwrapped|build_dir|archived)/ ) {
7253 # cannot be undone for local distros
7256 if ($att eq "build_dir"
7257 && $self->{build_dir}
7258 && $CPAN::META->{is_tested}
7260 delete $CPAN::META->{is_tested}{$self->{build_dir}};
7262 } elsif ($phase eq "test") {
7263 if ($att eq "make_test"
7264 && $self->{make_test}
7265 && $self->{make_test}{COMMANDID}
7266 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
7268 # endless loop too likely
7272 delete $self->{$att};
7273 if ($ldebug || $CPAN::DEBUG) {
7274 # local $CPAN::DEBUG = 16; # Distribution
7275 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
7279 if ($method && $method =~ /make|test|install/) {
7280 $self->{force_update} = 1; # name should probably have been force_install
7284 #-> sub CPAN::Distribution::notest ;
7286 my($self, $method) = @_;
7287 # $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method");
7288 $self->{"notest"}++; # name should probably have been force_install
7291 #-> sub CPAN::Distribution::unnotest ;
7294 # warn "XDEBUG: deleting notest";
7295 delete $self->{notest};
7298 #-> sub CPAN::Distribution::unforce ;
7301 delete $self->{force_update};
7304 #-> sub CPAN::Distribution::isa_perl ;
7307 my $file = File::Basename::basename($self->id);
7308 if ($file =~ m{ ^ perl
7317 \.tar[._-](?:gz|bz2)
7321 } elsif ($self->cpan_comment
7323 $self->cpan_comment =~ /isa_perl\(.+?\)/) {
7329 #-> sub CPAN::Distribution::perl ;
7334 carp __PACKAGE__ . "::perl was called without parameters.";
7336 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
7340 #-> sub CPAN::Distribution::make ;
7343 if (my $goto = $self->prefs->{goto}) {
7344 return $self->goto($goto);
7346 my $make = $self->{modulebuild} ? "Build" : "make";
7347 # Emergency brake if they said install Pippi and get newest perl
7348 if ($self->isa_perl) {
7350 $self->called_for ne $self->id &&
7351 ! $self->{force_update}
7353 # if we die here, we break bundles
7356 qq{The most recent version "%s" of the module "%s"
7357 is part of the perl-%s distribution. To install that, you need to run
7358 force install %s --or--
7361 $CPAN::META->instance(
7370 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
7371 $CPAN::Frontend->mysleep(1);
7375 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
7377 if ($self->{configure_requires_later}) {
7380 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7382 : ($ENV{PERLLIB} || "");
7383 $CPAN::META->set_perl5lib;
7384 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7386 if ($CPAN::Signal) {
7387 delete $self->{force_update};
7394 if (!$self->{archived} || $self->{archived} eq "NO") {
7395 push @e, "Is neither a tar nor a zip archive.";
7398 if (!$self->{unwrapped}
7400 UNIVERSAL::can($self->{unwrapped},"failed") ?
7401 $self->{unwrapped}->failed :
7402 $self->{unwrapped} =~ /^NO/
7404 push @e, "Had problems unarchiving. Please build manually";
7407 unless ($self->{force_update}) {
7408 exists $self->{signature_verify} and
7410 UNIVERSAL::can($self->{signature_verify},"failed") ?
7411 $self->{signature_verify}->failed :
7412 $self->{signature_verify} =~ /^NO/
7414 and push @e, "Did not pass the signature test.";
7417 if (exists $self->{writemakefile} &&
7419 UNIVERSAL::can($self->{writemakefile},"failed") ?
7420 $self->{writemakefile}->failed :
7421 $self->{writemakefile} =~ /^NO/
7423 # XXX maybe a retry would be in order?
7424 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
7425 $self->{writemakefile}->text :
7426 $self->{writemakefile};
7428 $err ||= "Had some problem writing Makefile";
7429 $err .= ", won't make";
7433 if (defined $self->{make}) {
7434 if (UNIVERSAL::can($self->{make},"failed") ?
7435 $self->{make}->failed :
7436 $self->{make} =~ /^NO/) {
7437 if ($self->{force_update}) {
7438 # Trying an already failed 'make' (unless somebody else blocks)
7440 # introduced for turning recursion detection into a distrostatus
7441 my $error = length $self->{make}>3
7442 ? substr($self->{make},3) : "Unknown error";
7443 $CPAN::Frontend->mywarn("Could not make: $error\n");
7444 $self->store_persistent_state;
7448 push @e, "Has already been made";
7452 my $later = $self->{later} || $self->{configure_requires_later};
7453 if ($later) { # see also undelay
7459 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7460 $builddir = $self->dir or
7461 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
7462 unless (chdir $builddir) {
7463 push @e, "Couldn't chdir to '$builddir': $!";
7465 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
7467 if ($CPAN::Signal) {
7468 delete $self->{force_update};
7471 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
7472 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
7474 if ($^O eq 'MacOS') {
7475 Mac::BuildTools::make($self);
7480 while (my($k,$v) = each %ENV) {
7481 next unless defined $v;
7486 if (my $commandline = $self->prefs->{pl}{commandline}) {
7487 $system = $commandline;
7489 } elsif ($self->{'configure'}) {
7490 $system = $self->{'configure'};
7491 } elsif ($self->{modulebuild}) {
7492 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
7493 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
7495 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
7497 # This needs a handler that can be turned on or off:
7498 # $switch = "-MExtUtils::MakeMaker ".
7499 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
7501 my $makepl_arg = $self->make_x_arg("pl");
7502 $ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir},
7504 $system = sprintf("%s%s Makefile.PL%s",
7506 $switch ? " $switch" : "",
7507 $makepl_arg ? " $makepl_arg" : "",
7510 if (my $env = $self->prefs->{pl}{env}) {
7511 for my $e (keys %$env) {
7512 $ENV{$e} = $env->{$e};
7515 if (exists $self->{writemakefile}) {
7517 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
7518 my($ret,$pid,$output);
7521 if ($CPAN::Config->{inactivity_timeout}) {
7523 if ($Config::Config{d_alarm}
7525 $Config::Config{d_alarm} eq "define"
7529 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
7530 "variable 'inactivity_timeout' to ".
7531 "'$CPAN::Config->{inactivity_timeout}'. But ".
7532 "on this machine the system call 'alarm' ".
7533 "isn't available. This means that we cannot ".
7534 "provide the feature of intercepting long ".
7535 "waiting code and will turn this feature off.\n"
7537 $CPAN::Config->{inactivity_timeout} = 0;
7540 if ($go_via_alarm) {
7541 if ( $self->_should_report('pl') ) {
7542 ($output, $ret) = CPAN::Reporter::record_command(
7544 $CPAN::Config->{inactivity_timeout},
7546 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
7550 alarm $CPAN::Config->{inactivity_timeout};
7551 local $SIG{CHLD}; # = sub { wait };
7552 if (defined($pid = fork)) {
7557 # note, this exec isn't necessary if
7558 # inactivity_timeout is 0. On the Mac I'd
7559 # suggest, we set it always to 0.
7563 $CPAN::Frontend->myprint("Cannot fork: $!");
7572 $CPAN::Frontend->myprint($err);
7573 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
7575 $self->store_persistent_state;
7576 return $self->goodbye("$system -- TIMED OUT");
7580 if (my $expect_model = $self->_prefs_with_expect("pl")) {
7581 # XXX probably want to check _should_report here and warn
7582 # about not being able to use CPAN::Reporter with expect
7583 $ret = $self->_run_via_expect($system,$expect_model);
7585 && $self->{writemakefile}
7586 && $self->{writemakefile}->failed) {
7591 elsif ( $self->_should_report('pl') ) {
7592 ($output, $ret) = CPAN::Reporter::record_command($system);
7593 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
7596 $ret = system($system);
7599 $self->{writemakefile} = CPAN::Distrostatus
7600 ->new("NO '$system' returned status $ret");
7601 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
7602 $self->store_persistent_state;
7603 return $self->goodbye("$system -- NOT OK");
7606 if (-f "Makefile" || -f "Build") {
7607 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
7608 delete $self->{make_clean}; # if cleaned before, enable next
7610 my $makefile = $self->{modulebuild} ? "Build" : "Makefile";
7611 $self->{writemakefile} = CPAN::Distrostatus
7612 ->new(qq{NO -- No $makefile created});
7613 $self->store_persistent_state;
7614 return $self->goodbye("$system -- NO $makefile created");
7617 if ($CPAN::Signal) {
7618 delete $self->{force_update};
7621 if (my @prereq = $self->unsat_prereq("later")) {
7622 if ($prereq[0][0] eq "perl") {
7623 my $need = "requires perl '$prereq[0][1]'";
7624 my $id = $self->pretty_id;
7625 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
7626 $self->{make} = CPAN::Distrostatus->new("NO $need");
7627 $self->store_persistent_state;
7628 return $self->goodbye("[prereq] -- NOT OK");
7630 my $follow = eval { $self->follow_prereqs("later",@prereq); };
7633 # signal success to the queuerunner
7635 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
7636 $CPAN::Frontend->mywarn($@);
7637 return $self->goodbye("[depend] -- NOT OK");
7641 if ($CPAN::Signal) {
7642 delete $self->{force_update};
7645 if (my $commandline = $self->prefs->{make}{commandline}) {
7646 $system = $commandline;
7647 $ENV{PERL} = CPAN::find_perl;
7649 if ($self->{modulebuild}) {
7650 unless (-f "Build") {
7651 my $cwd = CPAN::anycwd();
7652 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
7653 " in cwd[$cwd]. Danger, Will Robinson!\n");
7654 $CPAN::Frontend->mysleep(5);
7656 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
7658 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
7660 $system =~ s/\s+$//;
7661 my $make_arg = $self->make_x_arg("make");
7662 $system = sprintf("%s%s",
7664 $make_arg ? " $make_arg" : "",
7667 if (my $env = $self->prefs->{make}{env}) { # overriding the local
7668 # ENV of PL, not the
7670 # unlikely to be a risk
7671 for my $e (keys %$env) {
7672 $ENV{$e} = $env->{$e};
7675 my $expect_model = $self->_prefs_with_expect("make");
7676 my $want_expect = 0;
7677 if ( $expect_model && @{$expect_model->{talk}} ) {
7678 my $can_expect = $CPAN::META->has_inst("Expect");
7682 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7688 # XXX probably want to check _should_report here and
7689 # warn about not being able to use CPAN::Reporter with expect
7690 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
7692 elsif ( $self->_should_report('make') ) {
7693 my ($output, $ret) = CPAN::Reporter::record_command($system);
7694 CPAN::Reporter::grade_make( $self, $system, $output, $ret );
7695 $system_ok = ! $ret;
7698 $system_ok = system($system) == 0;
7700 $self->introduce_myself;
7702 $CPAN::Frontend->myprint(" $system -- OK\n");
7703 $self->{make} = CPAN::Distrostatus->new("YES");
7705 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
7706 $self->{make} = CPAN::Distrostatus->new("NO");
7707 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7709 $self->store_persistent_state;
7712 # CPAN::Distribution::goodbye ;
7714 my($self,$goodbye) = @_;
7715 my $id = $self->pretty_id;
7716 $CPAN::Frontend->mywarn(" $id\n $goodbye\n");
7720 # CPAN::Distribution::_run_via_expect ;
7721 sub _run_via_expect {
7722 my($self,$system,$expect_model) = @_;
7723 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
7724 if ($CPAN::META->has_inst("Expect")) {
7725 my $expo = Expect->new; # expo Expect object;
7726 $expo->spawn($system);
7727 $expect_model->{mode} ||= "deterministic";
7728 if ($expect_model->{mode} eq "deterministic") {
7729 return $self->_run_via_expect_deterministic($expo,$expect_model);
7730 } elsif ($expect_model->{mode} eq "anyorder") {
7731 return $self->_run_via_expect_anyorder($expo,$expect_model);
7733 die "Panic: Illegal expect mode: $expect_model->{mode}";
7736 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
7737 return system($system);
7741 sub _run_via_expect_anyorder {
7742 my($self,$expo,$expect_model) = @_;
7743 my $timeout = $expect_model->{timeout} || 5;
7744 my $reuse = $expect_model->{reuse};
7745 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
7748 my($eof,$ran_into_timeout);
7749 my @match = $expo->expect($timeout,
7754 $ran_into_timeout++;
7761 $but .= $expo->clear_accum;
7764 return $expo->exitstatus();
7765 } elsif ($ran_into_timeout) {
7766 # warn "DEBUG: they are asking a question, but[$but]";
7767 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
7768 my($next,$send) = @expectacopy[$i,$i+1];
7769 my $regex = eval "qr{$next}";
7770 # warn "DEBUG: will compare with regex[$regex].";
7771 if ($but =~ /$regex/) {
7772 # warn "DEBUG: will send send[$send]";
7774 # never allow reusing an QA pair unless they told us
7775 splice @expectacopy, $i, 2 unless $reuse;
7779 my $why = "could not answer a question during the dialog";
7780 $CPAN::Frontend->mywarn("Failing: $why\n");
7781 $self->{writemakefile} =
7782 CPAN::Distrostatus->new("NO $why");
7788 sub _run_via_expect_deterministic {
7789 my($self,$expo,$expect_model) = @_;
7790 my $ran_into_timeout;
7791 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
7792 my $expecta = $expect_model->{talk};
7793 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
7794 my($re,$send) = @$expecta[$i,$i+1];
7795 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
7796 my $regex = eval "qr{$re}";
7797 $expo->expect($timeout,
7799 my $but = $expo->clear_accum;
7800 $CPAN::Frontend->mywarn("EOF (maybe harmless)
7801 expected[$regex]\nbut[$but]\n\n");
7805 my $but = $expo->clear_accum;
7806 $CPAN::Frontend->mywarn("TIMEOUT
7807 expected[$regex]\nbut[$but]\n\n");
7808 $ran_into_timeout++;
7811 if ($ran_into_timeout) {
7812 # note that the caller expects 0 for success
7813 $self->{writemakefile} =
7814 CPAN::Distrostatus->new("NO timeout during expect dialog");
7820 return $expo->exitstatus();
7823 #-> CPAN::Distribution::_validate_distropref
7824 sub _validate_distropref {
7825 my($self,@args) = @_;
7827 $CPAN::META->has_inst("CPAN::Kwalify")
7829 $CPAN::META->has_inst("Kwalify")
7831 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
7833 $CPAN::Frontend->mywarn($@);
7836 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
7840 #-> CPAN::Distribution::_find_prefs
7843 my $distroid = $self->pretty_id;
7844 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
7845 my $prefs_dir = $CPAN::Config->{prefs_dir};
7846 return if $prefs_dir =~ /^\s*$/;
7847 eval { File::Path::mkpath($prefs_dir); };
7849 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
7851 my $yaml_module = CPAN::_yaml_module;
7853 if ($CPAN::META->has_inst($yaml_module)) {
7854 push @extensions, "yml";
7857 if ($CPAN::META->has_inst("Data::Dumper")) {
7858 push @extensions, "dd";
7859 push @fallbacks, "Data::Dumper";
7861 if ($CPAN::META->has_inst("Storable")) {
7862 push @extensions, "st";
7863 push @fallbacks, "Storable";
7867 unless ($self->{have_complained_about_missing_yaml}++) {
7868 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
7869 "to @fallbacks to read prefs '$prefs_dir'\n");
7872 unless ($self->{have_complained_about_missing_yaml}++) {
7873 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
7874 "read prefs '$prefs_dir'\n");
7879 my $dh = DirHandle->new($prefs_dir)
7880 or die Carp::croak("Couldn't open '$prefs_dir': $!");
7881 DIRENT: for (sort $dh->read) {
7882 next if $_ eq "." || $_ eq "..";
7883 my $exte = join "|", @extensions;
7884 next unless /\.($exte)$/;
7886 my $abs = File::Spec->catfile($prefs_dir, $_);
7888 #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
7890 if ($thisexte eq "yml") {
7891 # need no eval because if we have no YAML we do not try to read *.yml
7892 #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7893 @distropref = @{CPAN->_yaml_loadfile($abs)};
7894 #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7895 } elsif ($thisexte eq "dd") {
7898 open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
7904 $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
7907 while (${"VAR".$i}) {
7908 push @distropref, ${"VAR".$i};
7911 } elsif ($thisexte eq "st") {
7912 # eval because Storable is never forward compatible
7913 eval { @distropref = @{scalar Storable::retrieve($abs)}; };
7915 $CPAN::Frontend->mywarn("Error reading distroprefs file ".
7916 "$_, skipping\: $@");
7917 $CPAN::Frontend->mysleep(4);
7922 #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7923 ELEMENT: for my $y (0..$#distropref) {
7924 my $distropref = $distropref[$y];
7925 $self->_validate_distropref($distropref,$abs,$y);
7926 my $match = $distropref->{match};
7928 #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
7932 # do not take the order of C<keys %$match> because
7933 # "module" is by far the slowest
7934 my $saw_valid_subkeys = 0;
7935 for my $sub_attribute (qw(distribution perl perlconfig module)) {
7936 next unless exists $match->{$sub_attribute};
7937 $saw_valid_subkeys++;
7938 my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
7939 if ($sub_attribute eq "module") {
7941 #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7942 my @modules = $self->containsmods;
7943 #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
7944 MODULE: for my $module (@modules) {
7945 $okm ||= $module =~ /$qr/;
7946 last MODULE if $okm;
7949 } elsif ($sub_attribute eq "distribution") {
7950 my $okd = $distroid =~ /$qr/;
7952 } elsif ($sub_attribute eq "perl") {
7953 my $okp = CPAN::find_perl =~ /$qr/;
7955 } elsif ($sub_attribute eq "perlconfig") {
7956 for my $perlconfigkey (keys %{$match->{perlconfig}}) {
7957 my $perlconfigval = $match->{perlconfig}->{$perlconfigkey};
7958 # XXX should probably warn if Config does not exist
7959 my $okpc = $Config::Config{$perlconfigkey} =~ /$perlconfigval/;
7964 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7965 "unknown sub_attribut '$sub_attribute'. ".
7967 "remove, cannot continue.");
7969 last if $ok == 0; # short circuit
7971 unless ($saw_valid_subkeys) {
7972 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7973 "missing match/* subattribute. ".
7975 "remove, cannot continue.");
7977 #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
7980 prefs => $distropref,
7982 prefs_file_doc => $y,
7994 # CPAN::Distribution::prefs
7997 if (exists $self->{negative_prefs_cache}
7999 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
8001 delete $self->{negative_prefs_cache};
8002 delete $self->{prefs};
8004 if (exists $self->{prefs}) {
8005 return $self->{prefs}; # XXX comment out during debugging
8007 if ($CPAN::Config->{prefs_dir}) {
8008 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
8009 my $prefs = $self->_find_prefs();
8010 $prefs ||= ""; # avoid warning next line
8011 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
8013 for my $x (qw(prefs prefs_file prefs_file_doc)) {
8014 $self->{$x} = $prefs->{$x};
8018 File::Basename::basename($self->{prefs_file}),
8019 $self->{prefs_file_doc},
8021 my $filler1 = "_" x 22;
8022 my $filler2 = int(66 - length($bs))/2;
8023 $filler2 = 0 if $filler2 < 0;
8024 $filler2 = " " x $filler2;
8025 $CPAN::Frontend->myprint("
8026 $filler1 D i s t r o P r e f s $filler1
8027 $filler2 $bs $filler2
8029 $CPAN::Frontend->mysleep(1);
8030 return $self->{prefs};
8033 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
8034 return $self->{prefs} = +{};
8037 # CPAN::Distribution::make_x_arg
8039 my($self, $whixh) = @_;
8041 my $prefs = $self->prefs;
8044 && exists $prefs->{$whixh}
8045 && exists $prefs->{$whixh}{args}
8046 && $prefs->{$whixh}{args}
8048 $make_x_arg = join(" ",
8049 map {CPAN::HandleConfig
8050 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
8053 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
8054 $make_x_arg ||= $CPAN::Config->{$what};
8058 # CPAN::Distribution::_make_command
8065 CPAN::HandleConfig->prefs_lookup($self,
8067 || $Config::Config{make}
8071 # Old style call, without object. Deprecated
8072 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
8075 CPAN::HandleConfig->prefs_lookup($self,q{make})
8076 || $CPAN::Config->{make}
8077 || $Config::Config{make}
8082 #-> sub CPAN::Distribution::follow_prereqs ;
8083 sub follow_prereqs {
8086 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
8087 return unless @prereq_tuples;
8088 my @prereq = map { $_->[0] } @prereq_tuples;
8089 my $pretty_id = $self->pretty_id;
8091 b => "build_requires",
8095 my($filler1,$filler2,$filler3,$filler4);
8097 my $unsat = "Unsatisfied dependencies detected during";
8098 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
8100 my $r = int(($w - length($unsat))/2);
8101 my $l = $w - length($unsat) - $r;
8102 $filler1 = "-"x4 . " "x$l;
8103 $filler2 = " "x$r . "-"x4 . "\n";
8106 my $r = int(($w - length($pretty_id))/2);
8107 my $l = $w - length($pretty_id) - $r;
8108 $filler3 = "-"x4 . " "x$l;
8109 $filler4 = " "x$r . "-"x4 . "\n";
8112 myprint("$filler1 $unsat $filler2".
8113 "$filler3 $pretty_id $filler4".
8114 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
8117 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
8119 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
8120 my $answer = CPAN::Shell::colorable_makemaker_prompt(
8121 "Shall I follow them and prepend them to the queue
8122 of modules we are processing right now?", "yes");
8123 $follow = $answer =~ /^\s*y/i;
8127 myprint(" Ignoring dependencies on modules @prereq\n");
8131 # color them as dirty
8132 for my $p (@prereq) {
8133 # warn "calling color_cmd_tmps(0,1)";
8134 my $any = CPAN::Shell->expandany($p);
8135 $self->{$slot . "_for"}{$any->id}++;
8137 $any->color_cmd_tmps(0,2);
8139 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
8140 $CPAN::Frontend->mysleep(2);
8143 # queue them and re-queue yourself
8144 CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}},
8145 map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @prereq_tuples);
8146 $self->{$slot} = "Delayed until after prerequisites";
8147 return 1; # signal success to the queuerunner
8152 #-> sub CPAN::Distribution::unsat_prereq ;
8153 # return ([Foo=>1],[Bar=>1.2]) for normal modules
8154 # return ([perl=>5.008]) if we need a newer perl than we are running under
8156 my($self,$slot) = @_;
8157 my(%merged,$prereq_pm);
8158 my $prefs_depends = $self->prefs->{depends}||{};
8159 if ($slot eq "configure_requires_later") {
8160 my $meta_yml = $self->parse_meta_yml();
8161 %merged = (%{$meta_yml->{configure_requires}||{}},
8162 %{$prefs_depends->{configure_requires}||{}});
8163 $prereq_pm = {}; # configure_requires defined as "b"
8164 } elsif ($slot eq "later") {
8165 my $prereq_pm_0 = $self->prereq_pm || {};
8166 for my $reqtype (qw(requires build_requires)) {
8167 $prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it
8168 for my $k (keys %{$prefs_depends->{$reqtype}||{}}) {
8169 $prereq_pm->{$reqtype}{$k} = $prefs_depends->{$reqtype}{$k};
8172 %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
8174 die "Panic: illegal slot '$slot'";
8177 my @merged = %merged;
8178 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
8179 NEED: while (my($need_module, $need_version) = each %merged) {
8180 my($available_version,$available_file,$nmo);
8181 if ($need_module eq "perl") {
8182 $available_version = $];
8183 $available_file = CPAN::find_perl;
8185 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
8186 next if $nmo->uptodate;
8187 $available_file = $nmo->available_file;
8189 # if they have not specified a version, we accept any installed one
8190 if (defined $available_file
8191 and ( # a few quick shortcurcuits
8192 not defined $need_version
8193 or $need_version eq '0' # "==" would trigger warning when not numeric
8194 or $need_version eq "undef"
8199 $available_version = $nmo->available_version;
8202 # We only want to install prereqs if either they're not installed
8203 # or if the installed version is too old. We cannot omit this
8204 # check, because if 'force' is in effect, nobody else will check.
8205 if (defined $available_file) {
8206 my(@all_requirements) = split /\s*,\s*/, $need_version;
8209 RQ: for my $rq (@all_requirements) {
8210 if ($rq =~ s|>=\s*||) {
8211 } elsif ($rq =~ s|>\s*||) {
8213 if (CPAN::Version->vgt($available_version,$rq)) {
8217 } elsif ($rq =~ s|!=\s*||) {
8219 if (CPAN::Version->vcmp($available_version,$rq)) {
8225 } elsif ($rq =~ m|<=?\s*|) {
8227 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
8231 if (! CPAN::Version->vgt($rq, $available_version)) {
8234 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
8235 "available_version[%s]rq[%s]ok[%d]",
8239 CPAN::Version->readable($rq),
8243 next NEED if $ok == @all_requirements;
8246 if ($need_module eq "perl") {
8247 return ["perl", $need_version];
8249 $self->{sponsored_mods}{$need_module} ||= 0;
8250 CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG;
8251 if ($self->{sponsored_mods}{$need_module}++) {
8252 # We have already sponsored it and for some reason it's still
8253 # not available. So we do ... what??
8255 # if we push it again, we have a potential infinite loop
8257 # The following "next" was a very problematic construct.
8258 # It helped a lot but broke some day and had to be
8261 # We must be able to deal with modules that come again and
8262 # again as a prereq and have themselves prereqs and the
8263 # queue becomes long but finally we would find the correct
8264 # order. The RecursiveDependency check should trigger a
8265 # die when it's becoming too weird. Unfortunately removing
8266 # this next breaks many other things.
8268 # The bug that brought this up is described in Todo under
8269 # "5.8.9 cannot install Compress::Zlib"
8271 # next; # this is the next that had to go away
8273 # The following "next NEED" are fine and the error message
8274 # explains well what is going on. For example when the DBI
8275 # fails and consequently DBD::SQLite fails and now we are
8276 # processing CPAN::SQLite. Then we must have a "next" for
8277 # DBD::SQLite. How can we get it and how can we identify
8278 # all other cases we must identify?
8280 my $do = $nmo->distribution;
8281 next NEED unless $do; # not on CPAN
8282 if (CPAN::Version->vcmp($need_version, $nmo->ro->{CPAN_VERSION}) > 0){
8283 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8284 "'$need_module => $need_version' ".
8285 "for '$self->{ID}' seems ".
8286 "not available according to the indexes\n"
8290 NOSAYER: for my $nosayer (
8299 if ($do->{$nosayer}) {
8300 if (UNIVERSAL::can($do->{$nosayer},"failed") ?
8301 $do->{$nosayer}->failed :
8302 $do->{$nosayer} =~ /^NO/) {
8303 if ($nosayer eq "make_test"
8305 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
8309 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8310 "'$need_module => $need_version' ".
8311 "for '$self->{ID}' failed when ".
8312 "processing '$do->{ID}' with ".
8313 "'$nosayer => $do->{$nosayer}'. Continuing, ".
8314 "but chances to succeed are limited.\n"
8317 } else { # the other guy succeeded
8318 if ($nosayer eq "install") {
8320 # DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz
8322 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8323 "'$need_module => $need_version' ".
8324 "for '$self->{ID}' already installed ".
8325 "but installation looks suspicious. ".
8326 "Skipping another installation attempt, ".
8327 "to prevent looping endlessly.\n"
8335 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
8336 push @need, [$need_module,$needed_as];
8338 my @unfolded = map { "[".join(",",@$_)."]" } @need;
8339 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
8343 #-> sub CPAN::Distribution::read_yaml ;
8346 return $self->{yaml_content} if exists $self->{yaml_content};
8347 my $build_dir = $self->{build_dir};
8348 my $yaml = File::Spec->catfile($build_dir,"META.yml");
8349 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
8350 return unless -f $yaml;
8351 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
8353 $CPAN::Frontend->mywarn("Could not read ".
8354 "'$yaml'. Falling back to other ".
8355 "methods to determine prerequisites\n");
8356 return $self->{yaml_content} = undef; # if we die, then we
8357 # cannot read YAML's own
8360 # not "authoritative"
8361 if (not exists $self->{yaml_content}{dynamic_config}
8362 or $self->{yaml_content}{dynamic_config}
8364 $self->{yaml_content} = undef;
8366 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
8368 return $self->{yaml_content};
8371 #-> sub CPAN::Distribution::prereq_pm ;
8374 $self->{prereq_pm_detected} ||= 0;
8375 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
8376 return $self->{prereq_pm} if $self->{prereq_pm_detected};
8377 return unless $self->{writemakefile} # no need to have succeeded
8378 # but we must have run it
8379 || $self->{modulebuild};
8380 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
8381 $self->{writemakefile}||"",
8382 $self->{modulebuild}||"",
8385 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
8386 $req = $yaml->{requires} || {};
8387 $breq = $yaml->{build_requires} || {};
8388 undef $req unless ref $req eq "HASH" && %$req;
8390 if ($yaml->{generated_by} &&
8391 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
8392 my $eummv = do { local $^W = 0; $1+0; };
8393 if ($eummv < 6.2501) {
8394 # thanks to Slaven for digging that out: MM before
8395 # that could be wrong because it could reflect a
8402 while (my($k,$v) = each %{$req||{}}) {
8405 } elsif ($k =~ /[A-Za-z]/ &&
8407 $CPAN::META->exists("Module",$v)
8409 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
8410 "requires hash: $k => $v; I'll take both ".
8411 "key and value as a module name\n");
8412 $CPAN::Frontend->mysleep(1);
8418 $req = $areq if $do_replace;
8421 unless ($req || $breq) {
8422 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
8423 my $makefile = File::Spec->catfile($build_dir,"Makefile");
8427 $fh = FileHandle->new("<$makefile\0")) {
8428 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
8431 last if /MakeMaker post_initialize section/;
8433 \s+PREREQ_PM\s+=>\s+(.+)
8436 # warn "Found prereq expr[$p]";
8438 # Regexp modified by A.Speer to remember actual version of file
8439 # PREREQ_PM hash key wants, then add to
8440 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ) {
8441 # In case a prereq is mentioned twice, complain.
8442 if ( defined $req->{$1} ) {
8443 warn "Warning: PREREQ_PM mentions $1 more than once, ".
8444 "last mention wins";
8446 my($m,$n) = ($1,$2);
8447 if ($n =~ /^q\[(.*?)\]$/) {
8456 unless ($req || $breq) {
8457 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
8458 my $buildfile = File::Spec->catfile($build_dir,"Build");
8459 if (-f $buildfile) {
8460 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
8461 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
8462 if (-f $build_prereqs) {
8463 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
8464 my $content = do { local *FH;
8465 open FH, $build_prereqs
8466 or $CPAN::Frontend->mydie("Could not open ".
8467 "'$build_prereqs': $!");
8471 my $bphash = eval $content;
8474 $req = $bphash->{requires} || +{};
8475 $breq = $bphash->{build_requires} || +{};
8481 && ! -f "Makefile.PL"
8482 && ! exists $req->{"Module::Build"}
8483 && ! $CPAN::META->has_inst("Module::Build")) {
8484 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
8485 "undeclared prerequisite.\n".
8486 " Adding it now as such.\n"
8488 $CPAN::Frontend->mysleep(5);
8489 $req->{"Module::Build"} = 0;
8490 delete $self->{writemakefile};
8492 if ($req || $breq) {
8493 $self->{prereq_pm_detected}++;
8494 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
8498 #-> sub CPAN::Distribution::test ;
8501 if (my $goto = $self->prefs->{goto}) {
8502 return $self->goto($goto);
8505 if ($CPAN::Signal) {
8506 delete $self->{force_update};
8509 # warn "XDEBUG: checking for notest: $self->{notest} $self";
8510 if ($self->{notest}) {
8511 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
8515 my $make = $self->{modulebuild} ? "Build" : "make";
8517 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
8519 : ($ENV{PERLLIB} || "");
8521 $CPAN::META->set_perl5lib;
8522 local $ENV{MAKEFLAGS}; # protect us from outer make calls
8524 $CPAN::Frontend->myprint("Running $make test\n");
8528 if ($self->{make} or $self->{later}) {
8532 "Make had some problems, won't test";
8535 exists $self->{make} and
8537 UNIVERSAL::can($self->{make},"failed") ?
8538 $self->{make}->failed :
8539 $self->{make} =~ /^NO/
8540 ) and push @e, "Can't test without successful make";
8541 $self->{badtestcnt} ||= 0;
8542 if ($self->{badtestcnt} > 0) {
8543 require Data::Dumper;
8544 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
8545 push @e, "Won't repeat unsuccessful test during this command";
8548 push @e, $self->{later} if $self->{later};
8549 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
8551 if (exists $self->{build_dir}) {
8552 if (exists $self->{make_test}) {
8554 UNIVERSAL::can($self->{make_test},"failed") ?
8555 $self->{make_test}->failed :
8556 $self->{make_test} =~ /^NO/
8559 UNIVERSAL::can($self->{make_test},"commandid")
8561 $self->{make_test}->commandid == $CPAN::CurrentCommandId
8563 push @e, "Has already been tested within this command";
8566 push @e, "Has already been tested successfully";
8570 push @e, "Has no own directory";
8572 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8573 unless (chdir $self->{build_dir}) {
8574 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8576 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8578 $self->debug("Changed directory to $self->{build_dir}")
8581 if ($^O eq 'MacOS') {
8582 Mac::BuildTools::make_test($self);
8586 if ($self->{modulebuild}) {
8587 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
8588 if (CPAN::Version->vlt($v,2.62)) {
8589 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
8590 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
8591 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
8597 my $prefs_test = $self->prefs->{test};
8599 = exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") {
8600 $system = $commandline;
8601 $ENV{PERL} = CPAN::find_perl;
8602 } elsif ($self->{modulebuild}) {
8603 $system = sprintf "%s test", $self->_build_command();
8605 $system = join " ", $self->_make_command(), "test";
8607 my $make_test_arg = $self->make_x_arg("test");
8608 $system = sprintf("%s%s",
8610 $make_test_arg ? " $make_test_arg" : "",
8614 while (my($k,$v) = each %ENV) {
8615 next unless defined $v;
8619 if (my $env = $self->prefs->{test}{env}) {
8620 for my $e (keys %$env) {
8621 $ENV{$e} = $env->{$e};
8624 my $expect_model = $self->_prefs_with_expect("test");
8625 my $want_expect = 0;
8626 if ( $expect_model && @{$expect_model->{talk}} ) {
8627 my $can_expect = $CPAN::META->has_inst("Expect");
8631 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
8632 "testing without\n");
8636 if ($self->_should_report('test')) {
8637 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
8638 "not supported when distroprefs specify ".
8639 "an interactive test\n");
8641 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
8642 } elsif ( $self->_should_report('test') ) {
8643 $tests_ok = CPAN::Reporter::test($self, $system);
8645 $tests_ok = system($system) == 0;
8647 $self->introduce_myself;
8652 # local $CPAN::DEBUG = 16; # Distribution
8653 for my $m (keys %{$self->{sponsored_mods}}) {
8654 next unless $self->{sponsored_mods}{$m} > 0;
8655 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
8656 # XXX we need available_version which reflects
8657 # $ENV{PERL5LIB} so that already tested but not yet
8658 # installed modules are counted.
8659 my $available_version = $m_obj->available_version;
8660 my $available_file = $m_obj->available_file;
8661 if ($available_version &&
8662 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
8664 CPAN->debug("m[$m] good enough available_version[$available_version]")
8666 } elsif ($available_file
8668 !$self->{prereq_pm}{$m}
8670 $self->{prereq_pm}{$m} == 0
8673 # lex Class::Accessor::Chained::Fast which has no $VERSION
8674 CPAN->debug("m[$m] have available_file[$available_file]")
8682 my $which = join ",", @prereq;
8683 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
8684 "$cnt dependencies missing ($which)";
8685 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
8686 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
8687 $self->store_persistent_state;
8688 return $self->goodbye("[dependencies] -- NA");
8692 $CPAN::Frontend->myprint(" $system -- OK\n");
8693 $self->{make_test} = CPAN::Distrostatus->new("YES");
8694 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
8695 # probably impossible to need the next line because badtestcnt
8696 # has a lifespan of one command
8697 delete $self->{badtestcnt};
8699 $self->{make_test} = CPAN::Distrostatus->new("NO");
8700 $self->{badtestcnt}++;
8701 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8702 CPAN::Shell->optprint
8705 ("//hint// to see the cpan-testers results for installing this module, try:
8709 $self->store_persistent_state;
8712 sub _prefs_with_expect {
8713 my($self,$where) = @_;
8714 return unless my $prefs = $self->prefs;
8715 return unless my $where_prefs = $prefs->{$where};
8716 if ($where_prefs->{expect}) {
8718 mode => "deterministic",
8720 talk => $where_prefs->{expect},
8722 } elsif ($where_prefs->{"eexpect"}) {
8723 return $where_prefs->{"eexpect"};
8728 #-> sub CPAN::Distribution::clean ;
8731 my $make = $self->{modulebuild} ? "Build" : "make";
8732 $CPAN::Frontend->myprint("Running $make clean\n");
8733 unless (exists $self->{archived}) {
8734 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
8735 "/untarred, nothing done\n");
8738 unless (exists $self->{build_dir}) {
8739 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
8742 if (exists $self->{writemakefile}
8743 and $self->{writemakefile}->failed
8745 $CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n");
8750 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
8751 push @e, "make clean already called once";
8752 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8754 chdir $self->{build_dir} or
8755 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
8756 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
8758 if ($^O eq 'MacOS') {
8759 Mac::BuildTools::make_clean($self);
8764 if ($self->{modulebuild}) {
8765 unless (-f "Build") {
8766 my $cwd = CPAN::anycwd();
8767 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
8768 " in cwd[$cwd]. Danger, Will Robinson!");
8769 $CPAN::Frontend->mysleep(5);
8771 $system = sprintf "%s clean", $self->_build_command();
8773 $system = join " ", $self->_make_command(), "clean";
8775 my $system_ok = system($system) == 0;
8776 $self->introduce_myself;
8778 $CPAN::Frontend->myprint(" $system -- OK\n");
8782 # Jost Krieger pointed out that this "force" was wrong because
8783 # it has the effect that the next "install" on this distribution
8784 # will untar everything again. Instead we should bring the
8785 # object's state back to where it is after untarring.
8796 $self->{make_clean} = CPAN::Distrostatus->new("YES");
8799 # Hmmm, what to do if make clean failed?
8801 $self->{make_clean} = CPAN::Distrostatus->new("NO");
8802 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
8804 # 2006-02-27: seems silly to me to force a make now
8805 # $self->force("make"); # so that this directory won't be used again
8808 $self->store_persistent_state;
8811 #-> sub CPAN::Distribution::goto ;
8813 my($self,$goto) = @_;
8814 $goto = $self->normalize($goto);
8816 "Goto '$goto' via prefs file '%s' doc %d",
8817 $self->{prefs_file},
8818 $self->{prefs_file_doc},
8820 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
8821 # 2007-07-16 akoenig : Better than NA would be if we could inherit
8822 # the status of the $goto distro but given the exceptional nature
8823 # of 'goto' I feel reluctant to implement it
8824 my $goodbye_message = "[goto] -- NA $why";
8825 $self->goodbye($goodbye_message);
8827 # inject into the queue
8829 CPAN::Queue->delete($self->id);
8830 CPAN::Queue->jumpqueue({qmod => $goto, reqtype => $self->{reqtype}});
8832 # and run where we left off
8834 my($method) = (caller(1))[3];
8835 CPAN->instance("CPAN::Distribution",$goto)->$method();
8836 CPAN::Queue->delete_first($goto);
8839 #-> sub CPAN::Distribution::install ;
8842 if (my $goto = $self->prefs->{goto}) {
8843 return $self->goto($goto);
8846 unless ($self->{badtestcnt}) {
8849 if ($CPAN::Signal) {
8850 delete $self->{force_update};
8853 my $make = $self->{modulebuild} ? "Build" : "make";
8854 $CPAN::Frontend->myprint("Running $make install\n");
8857 if ($self->{make} or $self->{later}) {
8861 "Make had some problems, won't install";
8864 exists $self->{make} and
8866 UNIVERSAL::can($self->{make},"failed") ?
8867 $self->{make}->failed :
8868 $self->{make} =~ /^NO/
8870 push @e, "Make had returned bad status, install seems impossible";
8872 if (exists $self->{build_dir}) {
8874 push @e, "Has no own directory";
8877 if (exists $self->{make_test} and
8879 UNIVERSAL::can($self->{make_test},"failed") ?
8880 $self->{make_test}->failed :
8881 $self->{make_test} =~ /^NO/
8883 if ($self->{force_update}) {
8884 $self->{make_test}->text("FAILED but failure ignored because ".
8885 "'force' in effect");
8887 push @e, "make test had returned bad status, ".
8888 "won't install without force"
8891 if (exists $self->{install}) {
8892 if (UNIVERSAL::can($self->{install},"text") ?
8893 $self->{install}->text eq "YES" :
8894 $self->{install} =~ /^YES/
8896 $CPAN::Frontend->myprint(" Already done\n");
8897 $CPAN::META->is_installed($self->{build_dir});
8900 # comment in Todo on 2006-02-11; maybe retry?
8901 push @e, "Already tried without success";
8905 push @e, $self->{later} if $self->{later};
8906 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
8908 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8909 unless (chdir $self->{build_dir}) {
8910 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8912 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8914 $self->debug("Changed directory to $self->{build_dir}")
8917 if ($^O eq 'MacOS') {
8918 Mac::BuildTools::make_install($self);
8923 if (my $commandline = $self->prefs->{install}{commandline}) {
8924 $system = $commandline;
8925 $ENV{PERL} = CPAN::find_perl;
8926 } elsif ($self->{modulebuild}) {
8927 my($mbuild_install_build_command) =
8928 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
8929 $CPAN::Config->{mbuild_install_build_command} ?
8930 $CPAN::Config->{mbuild_install_build_command} :
8931 $self->_build_command();
8932 $system = sprintf("%s install %s",
8933 $mbuild_install_build_command,
8934 $CPAN::Config->{mbuild_install_arg},
8937 my($make_install_make_command) =
8938 CPAN::HandleConfig->prefs_lookup($self,
8939 q{make_install_make_command})
8940 || $self->_make_command();
8941 $system = sprintf("%s install %s",
8942 $make_install_make_command,
8943 $CPAN::Config->{make_install_arg},
8947 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
8948 my $brip = CPAN::HandleConfig->prefs_lookup($self,
8949 q{build_requires_install_policy});
8952 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
8953 my $want_install = "yes";
8954 if ($reqtype eq "b") {
8955 if ($brip eq "no") {
8956 $want_install = "no";
8957 } elsif ($brip =~ m|^ask/(.+)|) {
8959 $default = "yes" unless $default =~ /^(y|n)/i;
8961 CPAN::Shell::colorable_makemaker_prompt
8962 ("$id is just needed temporarily during building or testing. ".
8963 "Do you want to install it permanently? (Y/n)",
8967 unless ($want_install =~ /^y/i) {
8968 my $is_only = "is only 'build_requires'";
8969 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
8970 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
8971 delete $self->{force_update};
8974 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
8976 : ($ENV{PERLLIB} || "");
8978 $CPAN::META->set_perl5lib;
8979 my($pipe) = FileHandle->new("$system $stderr |");
8982 print $_; # intentionally NOT use Frontend->myprint because it
8983 # looks irritating when we markup in color what we
8984 # just pass through from an external program
8988 my $close_ok = $? == 0;
8989 $self->introduce_myself;
8991 $CPAN::Frontend->myprint(" $system -- OK\n");
8992 $CPAN::META->is_installed($self->{build_dir});
8993 $self->{install} = CPAN::Distrostatus->new("YES");
8995 $self->{install} = CPAN::Distrostatus->new("NO");
8996 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8998 CPAN::HandleConfig->prefs_lookup($self,
8999 q{make_install_make_command});
9001 $makeout =~ /permission/s
9005 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
9009 $CPAN::Frontend->myprint(
9011 qq{ You may have to su }.
9012 qq{to root to install the package\n}.
9013 qq{ (Or you may want to run something like\n}.
9014 qq{ o conf make_install_make_command 'sudo make'\n}.
9015 qq{ to raise your permissions.}
9019 delete $self->{force_update};
9021 $self->store_persistent_state;
9024 sub introduce_myself {
9026 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
9029 #-> sub CPAN::Distribution::dir ;
9034 #-> sub CPAN::Distribution::perldoc ;
9038 my($dist) = $self->id;
9039 my $package = $self->called_for;
9041 $self->_display_url( $CPAN::Defaultdocs . $package );
9044 #-> sub CPAN::Distribution::_check_binary ;
9046 my ($dist,$shell,$binary) = @_;
9049 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
9052 if ($CPAN::META->has_inst("File::Which")) {
9053 return File::Which::which($binary);
9056 $pid = open README, "which $binary|"
9057 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
9063 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
9067 $CPAN::Frontend->myprint(qq{ + $out \n})
9068 if $CPAN::DEBUG && $out;
9073 #-> sub CPAN::Distribution::_display_url ;
9075 my($self,$url) = @_;
9076 my($res,$saved_file,$pid,$out);
9078 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
9081 # should we define it in the config instead?
9082 my $html_converter = "html2text.pl";
9084 my $web_browser = $CPAN::Config->{'lynx'} || undef;
9085 my $web_browser_out = $web_browser
9086 ? CPAN::Distribution->_check_binary($self,$web_browser)
9089 if ($web_browser_out) {
9090 # web browser found, run the action
9091 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
9092 $CPAN::Frontend->myprint(qq{system[$browser $url]})
9094 $CPAN::Frontend->myprint(qq{
9097 with browser $browser
9099 $CPAN::Frontend->mysleep(1);
9100 system("$browser $url");
9101 if ($saved_file) { 1 while unlink($saved_file) }
9103 # web browser not found, let's try text only
9104 my $html_converter_out =
9105 CPAN::Distribution->_check_binary($self,$html_converter);
9106 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
9108 if ($html_converter_out ) {
9109 # html2text found, run it
9110 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
9111 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
9112 unless defined($saved_file);
9115 $pid = open README, "$html_converter $saved_file |"
9116 or $CPAN::Frontend->mydie(qq{
9117 Could not fork '$html_converter $saved_file': $!});
9119 if ($CPAN::META->has_usable("File::Temp")) {
9120 $fh = File::Temp->new(
9121 dir => File::Spec->tmpdir,
9122 template => 'cpan_htmlconvert_XXXX',
9126 $filename = $fh->filename;
9128 $filename = "cpan_htmlconvert_$$.txt";
9129 $fh = FileHandle->new();
9130 open $fh, ">$filename" or die;
9136 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
9137 my $tmpin = $fh->filename;
9138 $CPAN::Frontend->myprint(sprintf(qq{
9140 saved output to %s\n},
9148 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
9149 my $fh_pager = FileHandle->new;
9150 local($SIG{PIPE}) = "IGNORE";
9151 my $pager = $CPAN::Config->{'pager'} || "cat";
9152 $fh_pager->open("|$pager")
9153 or $CPAN::Frontend->mydie(qq{
9154 Could not open pager '$pager': $!});
9155 $CPAN::Frontend->myprint(qq{
9160 $CPAN::Frontend->mysleep(1);
9161 $fh_pager->print(<FH>);
9164 # coldn't find the web browser or html converter
9165 $CPAN::Frontend->myprint(qq{
9166 You need to install lynx or $html_converter to use this feature.});
9171 #-> sub CPAN::Distribution::_getsave_url ;
9173 my($dist, $shell, $url) = @_;
9175 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
9179 if ($CPAN::META->has_usable("File::Temp")) {
9180 $fh = File::Temp->new(
9181 dir => File::Spec->tmpdir,
9182 template => "cpan_getsave_url_XXXX",
9186 $filename = $fh->filename;
9188 $fh = FileHandle->new;
9189 $filename = "cpan_getsave_url_$$.html";
9191 my $tmpin = $filename;
9192 if ($CPAN::META->has_usable('LWP')) {
9193 $CPAN::Frontend->myprint("Fetching with LWP:
9197 CPAN::LWP::UserAgent->config;
9198 eval { $Ua = CPAN::LWP::UserAgent->new; };
9200 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
9204 $Ua->proxy('http', $var)
9205 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
9207 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
9210 my $req = HTTP::Request->new(GET => $url);
9211 $req->header('Accept' => 'text/html');
9212 my $res = $Ua->request($req);
9213 if ($res->is_success) {
9214 $CPAN::Frontend->myprint(" + request successful.\n")
9216 print $fh $res->content;
9218 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
9222 $CPAN::Frontend->myprint(sprintf(
9223 "LWP failed with code[%s], message[%s]\n",
9230 $CPAN::Frontend->mywarn(" LWP not available\n");
9235 #-> sub CPAN::Distribution::_build_command
9236 sub _build_command {
9238 if ($^O eq "MSWin32") { # special code needed at least up to
9239 # Module::Build 0.2611 and 0.2706; a fix
9240 # in M:B has been promised 2006-01-30
9241 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
9242 return "$perl ./Build";
9247 #-> sub CPAN::Distribution::_should_report
9248 sub _should_report {
9249 my($self, $phase) = @_;
9250 die "_should_report() requires a 'phase' argument"
9251 if ! defined $phase;
9254 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
9256 return unless $test_report;
9258 # don't repeat if we cached a result
9259 return $self->{should_report}
9260 if exists $self->{should_report};
9263 if ( ! $CPAN::META->has_inst("CPAN::Reporter")) {
9264 $CPAN::Frontend->mywarn(
9265 "CPAN::Reporter not installed. No reports will be sent.\n"
9267 return $self->{should_report} = 0;
9271 my $crv = CPAN::Reporter->VERSION;
9272 if ( CPAN::Version->vlt( $crv, 0.99 ) ) {
9273 # don't cache $self->{should_report} -- need to check each phase
9274 if ( $phase eq 'test' ) {
9278 $CPAN::Frontend->mywarn(
9279 "Reporting on the '$phase' phase requires CPAN::Reporter 0.99, but \n" .
9280 "you only have version $crv\. Only 'test' phase reports will be sent.\n"
9287 if ($self->is_dot_dist) {
9288 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
9289 "for local directories\n");
9290 return $self->{should_report} = 0;
9292 if ($self->prefs->{patches}
9294 @{$self->prefs->{patches}}
9298 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
9299 "when the source has been patched\n");
9300 return $self->{should_report} = 0;
9303 # proceed and cache success
9304 return $self->{should_report} = 1;
9307 #-> sub CPAN::Distribution::reports
9310 my $pathname = $self->id;
9311 $CPAN::Frontend->myprint("Distribution: $pathname\n");
9313 unless ($CPAN::META->has_inst("CPAN::DistnameInfo")) {
9314 $CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot continue");
9316 unless ($CPAN::META->has_usable("LWP")) {
9317 $CPAN::Frontend->mydie("LWP not installed; cannot continue");
9319 unless ($CPAN::META->has_usable("File::Temp")) {
9320 $CPAN::Frontend->mydie("File::Temp not installed; cannot continue");
9323 my $d = CPAN::DistnameInfo->new($pathname);
9325 my $dist = $d->dist; # "CPAN-DistnameInfo"
9326 my $version = $d->version; # "0.02"
9327 my $maturity = $d->maturity; # "released"
9328 my $filename = $d->filename; # "CPAN-DistnameInfo-0.02.tar.gz"
9329 my $cpanid = $d->cpanid; # "GBARR"
9330 my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
9332 my $url = sprintf "http://cpantesters.perl.org/show/%s.yaml", $dist;
9334 CPAN::LWP::UserAgent->config;
9336 eval { $Ua = CPAN::LWP::UserAgent->new; };
9338 $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
9340 $CPAN::Frontend->myprint("Fetching '$url'...");
9341 my $resp = $Ua->get($url);
9342 unless ($resp->is_success) {
9343 $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
9345 $CPAN::Frontend->myprint("DONE\n\n");
9346 my $yaml = $resp->content;
9347 # was fuer ein Umweg!
9348 my $fh = File::Temp->new(
9349 dir => File::Spec->tmpdir,
9350 template => 'cpan_reports_XXXX',
9354 my $tfilename = $fh->filename;
9356 close $fh or $CPAN::Frontend->mydie("Could not close '$tfilename': $!");
9357 my $unserialized = CPAN->_yaml_loadfile($tfilename)->[0];
9358 unlink $tfilename or $CPAN::Frontend->mydie("Could not unlink '$tfilename': $!");
9360 my $this_version_seen;
9361 for my $rep (@$unserialized) {
9362 my $rversion = $rep->{version};
9363 if ($rversion eq $version) {
9364 unless ($this_version_seen++) {
9365 $CPAN::Frontend->myprint ("$rep->{version}:\n");
9367 $CPAN::Frontend->myprint
9368 (sprintf("%1s%1s%-4s %s on %s %s (%s)\n",
9369 $rep->{archname} eq $Config::Config{archname}?"*":"",
9370 $rep->{action}eq"PASS"?"+":$rep->{action}eq"FAIL"?"-":"",
9373 ucfirst $rep->{osname},
9378 $other_versions{$rep->{version}}++;
9381 unless ($this_version_seen) {
9382 $CPAN::Frontend->myprint("No reports found for version '$version'
9383 Reports for other versions:\n");
9384 for my $v (sort keys %other_versions) {
9385 $CPAN::Frontend->myprint(" $v\: $other_versions{$v}\n");
9388 $url =~ s/\.yaml/.html/;
9389 $CPAN::Frontend->myprint("See $url for details\n");
9392 package CPAN::Bundle;
9397 $CPAN::Frontend->myprint($self->as_string);
9400 #-> CPAN::Bundle::undelay
9403 delete $self->{later};
9404 for my $c ( $self->contains ) {
9405 my $obj = CPAN::Shell->expandany($c) or next;
9410 # mark as dirty/clean
9411 #-> sub CPAN::Bundle::color_cmd_tmps ;
9412 sub color_cmd_tmps {
9414 my($depth) = shift || 0;
9415 my($color) = shift || 0;
9416 my($ancestors) = shift || [];
9417 # a module needs to recurse to its cpan_file, a distribution needs
9418 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
9420 return if exists $self->{incommandcolor}
9422 && $self->{incommandcolor}==$color;
9423 if ($depth>=$CPAN::MAX_RECURSION) {
9424 die(CPAN::Exception::RecursiveDependency->new($ancestors));
9426 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
9428 for my $c ( $self->contains ) {
9429 my $obj = CPAN::Shell->expandany($c) or next;
9430 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
9431 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
9433 # never reached code?
9435 #delete $self->{badtestcnt};
9437 $self->{incommandcolor} = $color;
9440 #-> sub CPAN::Bundle::as_string ;
9444 # following line must be "=", not "||=" because we have a moving target
9445 $self->{INST_VERSION} = $self->inst_version;
9446 return $self->SUPER::as_string;
9449 #-> sub CPAN::Bundle::contains ;
9452 my($inst_file) = $self->inst_file || "";
9453 my($id) = $self->id;
9454 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
9455 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
9458 unless ($inst_file) {
9459 # Try to get at it in the cpan directory
9460 $self->debug("no inst_file") if $CPAN::DEBUG;
9462 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
9463 $cpan_file = $self->cpan_file;
9464 if ($cpan_file eq "N/A") {
9465 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
9466 Maybe stale symlink? Maybe removed during session? Giving up.\n");
9468 my $dist = $CPAN::META->instance('CPAN::Distribution',
9470 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
9472 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
9473 my($todir) = $CPAN::Config->{'cpan_home'};
9474 my(@me,$from,$to,$me);
9475 @me = split /::/, $self->id;
9477 $me = File::Spec->catfile(@me);
9478 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
9479 $to = File::Spec->catfile($todir,$me);
9480 File::Path::mkpath(File::Basename::dirname($to));
9481 File::Copy::copy($from, $to)
9482 or Carp::confess("Couldn't copy $from to $to: $!");
9486 my $fh = FileHandle->new;
9488 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
9490 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
9492 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
9493 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
9494 next unless $in_cont;
9499 push @result, (split " ", $_, 2)[0];
9502 delete $self->{STATUS};
9503 $self->{CONTAINS} = \@result;
9504 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
9506 $CPAN::Frontend->mywarn(qq{
9507 The bundle file "$inst_file" may be a broken
9508 bundlefile. It seems not to contain any bundle definition.
9509 Please check the file and if it is bogus, please delete it.
9510 Sorry for the inconvenience.
9516 #-> sub CPAN::Bundle::find_bundle_file
9517 # $where is in local format, $what is in unix format
9518 sub find_bundle_file {
9519 my($self,$where,$what) = @_;
9520 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
9521 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
9522 ### my $bu = File::Spec->catfile($where,$what);
9523 ### return $bu if -f $bu;
9524 my $manifest = File::Spec->catfile($where,"MANIFEST");
9525 unless (-f $manifest) {
9526 require ExtUtils::Manifest;
9527 my $cwd = CPAN::anycwd();
9528 $self->safe_chdir($where);
9529 ExtUtils::Manifest::mkmanifest();
9530 $self->safe_chdir($cwd);
9532 my $fh = FileHandle->new($manifest)
9533 or Carp::croak("Couldn't open $manifest: $!");
9535 my $bundle_filename = $what;
9536 $bundle_filename =~ s|Bundle.*/||;
9537 my $bundle_unixpath;
9540 my($file) = /(\S+)/;
9541 if ($file =~ m|\Q$what\E$|) {
9542 $bundle_unixpath = $file;
9543 # return File::Spec->catfile($where,$bundle_unixpath); # bad
9546 # retry if she managed to have no Bundle directory
9547 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
9549 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
9550 if $bundle_unixpath;
9551 Carp::croak("Couldn't find a Bundle file in $where");
9554 # needs to work quite differently from Module::inst_file because of
9555 # cpan_home/Bundle/ directory and the possibility that we have
9556 # shadowing effect. As it makes no sense to take the first in @INC for
9557 # Bundles, we parse them all for $VERSION and take the newest.
9559 #-> sub CPAN::Bundle::inst_file ;
9564 @me = split /::/, $self->id;
9567 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
9568 my $bfile = File::Spec->catfile($incdir, @me);
9569 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
9570 next unless -f $bfile;
9571 my $foundv = MM->parse_version($bfile);
9572 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
9573 $self->{INST_FILE} = $bfile;
9574 $self->{INST_VERSION} = $bestv = $foundv;
9580 #-> sub CPAN::Bundle::inst_version ;
9583 $self->inst_file; # finds INST_VERSION as side effect
9584 $self->{INST_VERSION};
9587 #-> sub CPAN::Bundle::rematein ;
9589 my($self,$meth) = @_;
9590 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
9591 my($id) = $self->id;
9592 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
9593 unless $self->inst_file || $self->cpan_file;
9595 for $s ($self->contains) {
9596 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
9597 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
9598 if ($type eq 'CPAN::Distribution') {
9599 $CPAN::Frontend->mywarn(qq{
9600 The Bundle }.$self->id.qq{ contains
9601 explicitly a file '$s'.
9602 Going to $meth that.
9604 $CPAN::Frontend->mysleep(5);
9606 # possibly noisy action:
9607 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
9608 my $obj = $CPAN::META->instance($type,$s);
9609 $obj->{reqtype} = $self->{reqtype};
9614 # If a bundle contains another that contains an xs_file we have here,
9615 # we just don't bother I suppose
9616 #-> sub CPAN::Bundle::xs_file
9621 #-> sub CPAN::Bundle::force ;
9622 sub fforce { shift->rematein('fforce',@_); }
9623 #-> sub CPAN::Bundle::force ;
9624 sub force { shift->rematein('force',@_); }
9625 #-> sub CPAN::Bundle::notest ;
9626 sub notest { shift->rematein('notest',@_); }
9627 #-> sub CPAN::Bundle::get ;
9628 sub get { shift->rematein('get',@_); }
9629 #-> sub CPAN::Bundle::make ;
9630 sub make { shift->rematein('make',@_); }
9631 #-> sub CPAN::Bundle::test ;
9634 # $self->{badtestcnt} ||= 0;
9635 $self->rematein('test',@_);
9637 #-> sub CPAN::Bundle::install ;
9640 $self->rematein('install',@_);
9642 #-> sub CPAN::Bundle::clean ;
9643 sub clean { shift->rematein('clean',@_); }
9645 #-> sub CPAN::Bundle::uptodate ;
9648 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
9650 foreach $c ($self->contains) {
9651 my $obj = CPAN::Shell->expandany($c);
9652 return 0 unless $obj->uptodate;
9657 #-> sub CPAN::Bundle::readme ;
9660 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
9661 No File found for bundle } . $self->id . qq{\n}), return;
9662 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
9663 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
9666 package CPAN::Module;
9670 #-> sub CPAN::Module::userid
9675 return $ro->{userid} || $ro->{CPAN_USERID};
9677 #-> sub CPAN::Module::description
9680 my $ro = $self->ro or return "";
9684 #-> sub CPAN::Module::distribution
9687 CPAN::Shell->expand("Distribution",$self->cpan_file);
9690 #-> sub CPAN::Module::undelay
9693 delete $self->{later};
9694 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
9699 # mark as dirty/clean
9700 #-> sub CPAN::Module::color_cmd_tmps ;
9701 sub color_cmd_tmps {
9703 my($depth) = shift || 0;
9704 my($color) = shift || 0;
9705 my($ancestors) = shift || [];
9706 # a module needs to recurse to its cpan_file
9708 return if exists $self->{incommandcolor}
9710 && $self->{incommandcolor}==$color;
9711 return if $color==0 && !$self->{incommandcolor};
9713 if ( $self->uptodate ) {
9714 $self->{incommandcolor} = $color;
9716 } elsif (my $have_version = $self->available_version) {
9717 # maybe what we have is good enough
9719 my $who_asked_for_me = $ancestors->[-1];
9720 my $obj = CPAN::Shell->expandany($who_asked_for_me);
9722 } elsif ($obj->isa("CPAN::Bundle")) {
9723 # bundles cannot specify a minimum version
9725 } elsif ($obj->isa("CPAN::Distribution")) {
9726 if (my $prereq_pm = $obj->prereq_pm) {
9727 for my $k (keys %$prereq_pm) {
9728 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
9729 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
9730 $self->{incommandcolor} = $color;
9740 $self->{incommandcolor} = $color; # set me before recursion,
9741 # so we can break it
9743 if ($depth>=$CPAN::MAX_RECURSION) {
9744 die(CPAN::Exception::RecursiveDependency->new($ancestors));
9746 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
9748 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
9749 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
9753 # delete $self->{badtestcnt};
9755 $self->{incommandcolor} = $color;
9758 #-> sub CPAN::Module::as_glimpse ;
9762 my $class = ref($self);
9763 $class =~ s/^CPAN:://;
9767 $CPAN::Shell::COLOR_REGISTERED
9769 $CPAN::META->has_inst("Term::ANSIColor")
9773 $color_on = Term::ANSIColor::color("green");
9774 $color_off = Term::ANSIColor::color("reset");
9776 my $uptodateness = " ";
9777 unless ($class eq "Bundle") {
9778 my $u = $self->uptodate;
9779 $uptodateness = $u ? "=" : "<" if defined $u;
9782 my $d = $self->distribution;
9783 $d ? $d -> pretty_id : $self->cpan_userid;
9785 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
9796 #-> sub CPAN::Module::dslip_status
9800 # development status
9801 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
9802 pre-alpha alpha beta released
9805 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
9806 developer comp.lang.perl.*
9809 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
9811 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
9813 object-oriented pragma
9816 @{$stat->{P}}{qw,p g l b a 2 o d r n,} = qw,Standard-Perl
9818 BSD Artistic Artistic_2
9820 distribution_allowed
9821 restricted_distribution
9823 for my $x (qw(d s l i p)) {
9824 $stat->{$x}{' '} = 'unknown';
9825 $stat->{$x}{'?'} = 'unknown';
9828 return +{} unless $ro && $ro->{statd};
9835 DV => $stat->{D}{$ro->{statd}},
9836 SV => $stat->{S}{$ro->{stats}},
9837 LV => $stat->{L}{$ro->{statl}},
9838 IV => $stat->{I}{$ro->{stati}},
9839 PV => $stat->{P}{$ro->{statp}},
9843 #-> sub CPAN::Module::as_string ;
9847 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
9848 my $class = ref($self);
9849 $class =~ s/^CPAN:://;
9851 push @m, $class, " id = $self->{ID}\n";
9852 my $sprintf = " %-12s %s\n";
9853 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
9854 if $self->description;
9855 my $sprintf2 = " %-12s %s (%s)\n";
9857 $userid = $self->userid;
9860 if ($author = CPAN::Shell->expand('Author',$userid)) {
9863 if ($m = $author->email) {
9870 $author->fullname . $email
9874 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
9875 if $self->cpan_version;
9876 if (my $cpan_file = $self->cpan_file) {
9877 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
9878 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
9879 my $upload_date = $dist->upload_date;
9881 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
9885 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
9886 my $dslip = $self->dslip_status;
9890 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
9892 my $local_file = $self->inst_file;
9893 unless ($self->{MANPAGE}) {
9896 $manpage = $self->manpage_headline($local_file);
9898 # If we have already untarred it, we should look there
9899 my $dist = $CPAN::META->instance('CPAN::Distribution',
9901 # warn "dist[$dist]";
9902 # mff=manifest file; mfh=manifest handle
9907 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
9909 $mfh = FileHandle->new($mff)
9911 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
9912 my $lfre = $self->id; # local file RE
9915 my($lfl); # local file file
9917 my(@mflines) = <$mfh>;
9922 while (length($lfre)>5 and !$lfl) {
9923 ($lfl) = grep /$lfre/, @mflines;
9924 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
9927 $lfl =~ s/\s.*//; # remove comments
9928 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
9929 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
9930 # warn "lfl_abs[$lfl_abs]";
9932 $manpage = $self->manpage_headline($lfl_abs);
9936 $self->{MANPAGE} = $manpage if $manpage;
9939 for $item (qw/MANPAGE/) {
9940 push @m, sprintf($sprintf, $item, $self->{$item})
9941 if exists $self->{$item};
9943 for $item (qw/CONTAINS/) {
9944 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
9945 if exists $self->{$item} && @{$self->{$item}};
9947 push @m, sprintf($sprintf, 'INST_FILE',
9948 $local_file || "(not installed)");
9949 push @m, sprintf($sprintf, 'INST_VERSION',
9950 $self->inst_version) if $local_file;
9954 #-> sub CPAN::Module::manpage_headline
9955 sub manpage_headline {
9956 my($self,$local_file) = @_;
9957 my(@local_file) = $local_file;
9958 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
9959 push @local_file, $local_file;
9961 for $locf (@local_file) {
9962 next unless -f $locf;
9963 my $fh = FileHandle->new($locf)
9964 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
9968 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
9969 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
9986 #-> sub CPAN::Module::cpan_file ;
9987 # Note: also inherited by CPAN::Bundle
9990 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
9991 unless ($self->ro) {
9992 CPAN::Index->reload;
9995 if ($ro && defined $ro->{CPAN_FILE}) {
9996 return $ro->{CPAN_FILE};
9998 my $userid = $self->userid;
10000 if ($CPAN::META->exists("CPAN::Author",$userid)) {
10001 my $author = $CPAN::META->instance("CPAN::Author",
10003 my $fullname = $author->fullname;
10004 my $email = $author->email;
10005 unless (defined $fullname && defined $email) {
10006 return sprintf("Contact Author %s",
10010 return "Contact Author $fullname <$email>";
10012 return "Contact Author $userid (Email address not available)";
10020 #-> sub CPAN::Module::cpan_version ;
10024 my $ro = $self->ro;
10026 # Can happen with modules that are not on CPAN
10029 $ro->{CPAN_VERSION} = 'undef'
10030 unless defined $ro->{CPAN_VERSION};
10031 $ro->{CPAN_VERSION};
10034 #-> sub CPAN::Module::force ;
10037 $self->{force_update} = 1;
10040 #-> sub CPAN::Module::fforce ;
10043 $self->{force_update} = 2;
10046 #-> sub CPAN::Module::notest ;
10049 # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module");
10053 #-> sub CPAN::Module::rematein ;
10055 my($self,$meth) = @_;
10056 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
10059 my $cpan_file = $self->cpan_file;
10060 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/) {
10061 $CPAN::Frontend->mywarn(sprintf qq{
10062 The module %s isn\'t available on CPAN.
10064 Either the module has not yet been uploaded to CPAN, or it is
10065 temporary unavailable. Please contact the author to find out
10066 more about the status. Try 'i %s'.
10073 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
10074 $pack->called_for($self->id);
10075 if (exists $self->{force_update}) {
10076 if ($self->{force_update} == 2) {
10077 $pack->fforce($meth);
10079 $pack->force($meth);
10082 $pack->notest($meth) if exists $self->{notest} && $self->{notest};
10084 $pack->{reqtype} ||= "";
10085 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
10086 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
10087 if ($pack->{reqtype}) {
10088 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
10089 $pack->{reqtype} = $self->{reqtype};
10091 exists $pack->{install}
10094 UNIVERSAL::can($pack->{install},"failed") ?
10095 $pack->{install}->failed :
10096 $pack->{install} =~ /^NO/
10099 delete $pack->{install};
10100 $CPAN::Frontend->mywarn
10101 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
10105 $pack->{reqtype} = $self->{reqtype};
10108 my $success = eval {
10112 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
10113 $pack->unnotest if $pack->can("unnotest") && exists $self->{notest};
10114 delete $self->{force_update};
10115 delete $self->{notest};
10122 #-> sub CPAN::Module::perldoc ;
10123 sub perldoc { shift->rematein('perldoc') }
10124 #-> sub CPAN::Module::readme ;
10125 sub readme { shift->rematein('readme') }
10126 #-> sub CPAN::Module::look ;
10127 sub look { shift->rematein('look') }
10128 #-> sub CPAN::Module::cvs_import ;
10129 sub cvs_import { shift->rematein('cvs_import') }
10130 #-> sub CPAN::Module::get ;
10131 sub get { shift->rematein('get',@_) }
10132 #-> sub CPAN::Module::make ;
10133 sub make { shift->rematein('make') }
10134 #-> sub CPAN::Module::test ;
10137 # $self->{badtestcnt} ||= 0;
10138 $self->rematein('test',@_);
10141 #-> sub CPAN::Module::uptodate ;
10145 my $inst = $self->inst_version or return undef;
10146 my $cpan = $self->cpan_version;
10148 CPAN::Version->vgt($cpan,$inst) and return 0;
10149 CPAN->debug(join("",
10150 "returning uptodate. inst_file[",
10152 "cpan[$cpan] inst[$inst]")) if $CPAN::DEBUG;
10156 #-> sub CPAN::Module::install ;
10160 if ($self->uptodate
10162 not exists $self->{force_update}
10164 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
10166 $self->inst_version,
10171 my $ro = $self->ro;
10172 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
10173 $CPAN::Frontend->mywarn(qq{
10174 \n\n\n ***WARNING***
10175 The module $self->{ID} has no active maintainer.\n\n\n
10177 $CPAN::Frontend->mysleep(5);
10179 $self->rematein('install') if $doit;
10181 #-> sub CPAN::Module::clean ;
10182 sub clean { shift->rematein('clean') }
10184 #-> sub CPAN::Module::inst_file ;
10187 $self->_file_in_path([@INC]);
10190 #-> sub CPAN::Module::available_file ;
10191 sub available_file {
10193 my $sep = $Config::Config{path_sep};
10194 my $perllib = $ENV{PERL5LIB};
10195 $perllib = $ENV{PERLLIB} unless defined $perllib;
10196 my @perllib = split(/$sep/,$perllib) if defined $perllib;
10197 $self->_file_in_path([@perllib,@INC]);
10200 #-> sub CPAN::Module::file_in_path ;
10201 sub _file_in_path {
10202 my($self,$path) = @_;
10203 my($dir,@packpath);
10204 @packpath = split /::/, $self->{ID};
10205 $packpath[-1] .= ".pm";
10206 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
10207 unshift @packpath, "Term", "ReadLine"; # historical reasons
10209 foreach $dir (@$path) {
10210 my $pmfile = File::Spec->catfile($dir,@packpath);
10218 #-> sub CPAN::Module::xs_file ;
10221 my($dir,@packpath);
10222 @packpath = split /::/, $self->{ID};
10223 push @packpath, $packpath[-1];
10224 $packpath[-1] .= "." . $Config::Config{'dlext'};
10225 foreach $dir (@INC) {
10226 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
10234 #-> sub CPAN::Module::inst_version ;
10237 my $parsefile = $self->inst_file or return;
10238 my $have = $self->parse_version($parsefile);
10242 #-> sub CPAN::Module::inst_version ;
10243 sub available_version {
10245 my $parsefile = $self->available_file or return;
10246 my $have = $self->parse_version($parsefile);
10250 #-> sub CPAN::Module::parse_version ;
10251 sub parse_version {
10252 my($self,$parsefile) = @_;
10253 my $have = MM->parse_version($parsefile);
10254 $have = "undef" unless defined $have && length $have;
10255 $have =~ s/^ //; # since the %vd hack these two lines here are needed
10256 $have =~ s/ $//; # trailing whitespace happens all the time
10258 $have = CPAN::Version->readable($have);
10260 $have =~ s/\s*//g; # stringify to float around floating point issues
10261 $have; # no stringify needed, \s* above matches always
10264 #-> sub CPAN::Module::reports
10267 $self->distribution->reports;
10280 CPAN - query, download and build perl modules from CPAN sites
10286 perl -MCPAN -e shell
10296 cpan> install Acme::Meta # in the shell
10298 CPAN::Shell->install("Acme::Meta"); # in perl
10302 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
10305 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
10309 $mo = CPAN::Shell->expandany($mod);
10310 $mo = CPAN::Shell->expand("Module",$mod); # same thing
10312 # distribution objects:
10314 $do = CPAN::Shell->expand("Module",$mod)->distribution;
10315 $do = CPAN::Shell->expandany($distro); # same thing
10316 $do = CPAN::Shell->expand("Distribution",
10317 $distro); # same thing
10321 The CPAN module automates or at least simplifies the make and install
10322 of perl modules and extensions. It includes some primitive searching
10323 capabilities and knows how to use Net::FTP or LWP or some external
10324 download clients to fetch the distributions from the net.
10326 These are fetched from one or more of the mirrored CPAN (Comprehensive
10327 Perl Archive Network) sites and unpacked in a dedicated directory.
10329 The CPAN module also supports the concept of named and versioned
10330 I<bundles> of modules. Bundles simplify the handling of sets of
10331 related modules. See Bundles below.
10333 The package contains a session manager and a cache manager. The
10334 session manager keeps track of what has been fetched, built and
10335 installed in the current session. The cache manager keeps track of the
10336 disk space occupied by the make processes and deletes excess space
10337 according to a simple FIFO mechanism.
10339 All methods provided are accessible in a programmer style and in an
10340 interactive shell style.
10342 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
10344 The interactive mode is entered by running
10346 perl -MCPAN -e shell
10352 which puts you into a readline interface. If C<Term::ReadKey> and
10353 either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
10354 it supports both history and command completion.
10356 Once you are on the command line, type C<h> to get a one page help
10357 screen and the rest should be self-explanatory.
10359 The function call C<shell> takes two optional arguments, one is the
10360 prompt, the second is the default initial command line (the latter
10361 only works if a real ReadLine interface module is installed).
10363 The most common uses of the interactive modes are
10367 =item Searching for authors, bundles, distribution files and modules
10369 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
10370 for each of the four categories and another, C<i> for any of the
10371 mentioned four. Each of the four entities is implemented as a class
10372 with slightly differing methods for displaying an object.
10374 Arguments you pass to these commands are either strings exactly matching
10375 the identification string of an object or regular expressions that are
10376 then matched case-insensitively against various attributes of the
10377 objects. The parser recognizes a regular expression only if you
10378 enclose it between two slashes.
10380 The principle is that the number of found objects influences how an
10381 item is displayed. If the search finds one item, the result is
10382 displayed with the rather verbose method C<as_string>, but if we find
10383 more than one, we display each object with the terse method
10386 =item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
10388 These commands take any number of arguments and investigate what is
10389 necessary to perform the action. If the argument is a distribution
10390 file name (recognized by embedded slashes), it is processed. If it is
10391 a module, CPAN determines the distribution file in which this module
10392 is included and processes that, following any dependencies named in
10393 the module's META.yml or Makefile.PL (this behavior is controlled by
10394 the configuration parameter C<prerequisites_policy>.)
10396 C<get> downloads a distribution file and untars or unzips it, C<make>
10397 builds it, C<test> runs the test suite, and C<install> installs it.
10399 Any C<make> or C<test> are run unconditionally. An
10401 install <distribution_file>
10403 also is run unconditionally. But for
10407 CPAN checks if an install is actually needed for it and prints
10408 I<module up to date> in the case that the distribution file containing
10409 the module doesn't need to be updated.
10411 CPAN also keeps track of what it has done within the current session
10412 and doesn't try to build a package a second time regardless if it
10413 succeeded or not. It does not repeat a test run if the test
10414 has been run successfully before. Same for install runs.
10416 The C<force> pragma may precede another command (currently: C<get>,
10417 C<make>, C<test>, or C<install>) and executes the command from scratch
10418 and tries to continue in case of some errors. See the section below on
10419 the C<force> and the C<fforce> pragma.
10421 The C<notest> pragma may be used to skip the test part in the build
10426 cpan> notest install Tk
10428 A C<clean> command results in a
10432 being executed within the distribution file's working directory.
10434 =item C<readme>, C<perldoc>, C<look> module or distribution
10436 C<readme> displays the README file of the associated distribution.
10437 C<Look> gets and untars (if not yet done) the distribution file,
10438 changes to the appropriate directory and opens a subshell process in
10439 that directory. C<perldoc> displays the pod documentation of the
10440 module in html or plain text format.
10444 =item C<ls> globbing_expression
10446 The first form lists all distribution files in and below an author's
10447 CPAN directory as they are stored in the CHECKUMS files distributed on
10448 CPAN. The listing goes recursive into all subdirectories.
10450 The second form allows to limit or expand the output with shell
10451 globbing as in the following examples:
10457 The last example is very slow and outputs extra progress indicators
10458 that break the alignment of the result.
10460 Note that globbing only lists directories explicitly asked for, for
10461 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
10462 regarded as a bug and may be changed in future versions.
10466 The C<failed> command reports all distributions that failed on one of
10467 C<make>, C<test> or C<install> for some reason in the currently
10468 running shell session.
10470 =item Persistence between sessions
10472 If the C<YAML> or the C<YAML::Syck> module is installed a record of
10473 the internal state of all modules is written to disk after each step.
10474 The files contain a signature of the currently running perl version
10477 If the configurations variable C<build_dir_reuse> is set to a true
10478 value, then CPAN.pm reads the collected YAML files. If the stored
10479 signature matches the currently running perl the stored state is
10480 loaded into memory such that effectively persistence between sessions
10483 =item The C<force> and the C<fforce> pragma
10485 To speed things up in complex installation scenarios, CPAN.pm keeps
10486 track of what it has already done and refuses to do some things a
10487 second time. A C<get>, a C<make>, and an C<install> are not repeated.
10488 A C<test> is only repeated if the previous test was unsuccessful. The
10489 diagnostic message when CPAN.pm refuses to do something a second time
10490 is one of I<Has already been >C<unwrapped|made|tested successfully> or
10491 something similar. Another situation where CPAN refuses to act is an
10492 C<install> if the according C<test> was not successful.
10494 In all these cases, the user can override the goatish behaviour by
10495 prepending the command with the word force, for example:
10497 cpan> force get Foo
10498 cpan> force make AUTHOR/Bar-3.14.tar.gz
10499 cpan> force test Baz
10500 cpan> force install Acme::Meta
10502 Each I<forced> command is executed with the according part of its
10505 The C<fforce> pragma is a variant that emulates a C<force get> which
10506 erases the entire memory followed by the action specified, effectively
10507 restarting the whole get/make/test/install procedure from scratch.
10511 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
10512 Batch jobs can run without a lockfile and do not disturb each other.
10514 The shell offers to run in I<degraded mode> when another process is
10515 holding the lockfile. This is an experimental feature that is not yet
10516 tested very well. This second shell then does not write the history
10517 file, does not use the metadata file and has a different prompt.
10521 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
10522 in the cpan-shell it is intended that you can press C<^C> anytime and
10523 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
10524 to clean up and leave the shell loop. You can emulate the effect of a
10525 SIGTERM by sending two consecutive SIGINTs, which usually means by
10526 pressing C<^C> twice.
10528 CPAN.pm ignores a SIGPIPE. If the user sets C<inactivity_timeout>, a
10529 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
10530 Build.PL> subprocess.
10536 The commands that are available in the shell interface are methods in
10537 the package CPAN::Shell. If you enter the shell command, all your
10538 input is split by the Text::ParseWords::shellwords() routine which
10539 acts like most shells do. The first word is being interpreted as the
10540 method to be called and the rest of the words are treated as arguments
10541 to this method. Continuation lines are supported if a line ends with a
10546 C<autobundle> writes a bundle file into the
10547 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
10548 a list of all modules that are both available from CPAN and currently
10549 installed within @INC. The name of the bundle file is based on the
10550 current date and a counter.
10554 Note: this feature is still in alpha state and may change in future
10555 versions of CPAN.pm
10557 This commands provides a statistical overview over recent download
10558 activities. The data for this is collected in the YAML file
10559 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
10560 configured or YAML not installed, then no stats are provided.
10564 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
10565 directory so that you can save your own preferences instead of the
10568 =head2 recent ***EXPERIMENTAL COMMAND***
10570 The C<recent> command downloads a list of recent uploads to CPAN and
10571 displays them I<slowly>. While the command is running $SIG{INT} is
10572 defined to mean that the loop shall be left after having displayed the
10575 B<Note>: This command requires XML::LibXML installed.
10577 B<Note>: This whole command currently is a bit klunky and will
10578 probably change in future versions of CPAN.pm but the general
10579 approach will likely stay.
10581 B<Note>: See also L<smoke>
10585 recompile() is a very special command in that it takes no argument and
10586 runs the make/test/install cycle with brute force over all installed
10587 dynamically loadable extensions (aka XS modules) with 'force' in
10588 effect. The primary purpose of this command is to finish a network
10589 installation. Imagine, you have a common source tree for two different
10590 architectures. You decide to do a completely independent fresh
10591 installation. You start on one architecture with the help of a Bundle
10592 file produced earlier. CPAN installs the whole Bundle for you, but
10593 when you try to repeat the job on the second architecture, CPAN
10594 responds with a C<"Foo up to date"> message for all modules. So you
10595 invoke CPAN's recompile on the second architecture and you're done.
10597 Another popular use for C<recompile> is to act as a rescue in case your
10598 perl breaks binary compatibility. If one of the modules that CPAN uses
10599 is in turn depending on binary compatibility (so you cannot run CPAN
10600 commands), then you should try the CPAN::Nox module for recovery.
10602 =head2 report Bundle|Distribution|Module
10604 The C<report> command temporarily turns on the C<test_report> config
10605 variable, then runs the C<force test> command with the given
10606 arguments. The C<force> pragma is used to re-run the tests and repeat
10607 every step that might have failed before.
10609 =head2 smoke ***EXPERIMENTAL COMMAND***
10611 B<*** WARNING: this command downloads and executes software from CPAN to
10612 your computer of completely unknown status. You should never do
10613 this with your normal account and better have a dedicated well
10614 separated and secured machine to do this. ***>
10616 The C<smoke> command takes the list of recent uploads to CPAN as
10617 provided by the C<recent> command and tests them all. While the
10618 command is running $SIG{INT} is defined to mean that the current item
10621 B<Note>: This whole command currently is a bit klunky and will
10622 probably change in future versions of CPAN.pm but the general
10623 approach will likely stay.
10625 B<Note>: See also L<recent>
10627 =head2 upgrade [Module|/Regex/]...
10629 The C<upgrade> command first runs an C<r> command with the given
10630 arguments and then installs the newest versions of all modules that
10631 were listed by that.
10633 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
10635 Although it may be considered internal, the class hierarchy does matter
10636 for both users and programmer. CPAN.pm deals with above mentioned four
10637 classes, and all those classes share a set of methods. A classical
10638 single polymorphism is in effect. A metaclass object registers all
10639 objects of all kinds and indexes them with a string. The strings
10640 referencing objects have a separated namespace (well, not completely
10645 words containing a "/" (slash) Distribution
10646 words starting with Bundle:: Bundle
10647 everything else Module or Author
10649 Modules know their associated Distribution objects. They always refer
10650 to the most recent official release. Developers may mark their releases
10651 as unstable development versions (by inserting an underbar into the
10652 module version number which will also be reflected in the distribution
10653 name when you run 'make dist'), so the really hottest and newest
10654 distribution is not always the default. If a module Foo circulates
10655 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
10656 way to install version 1.23 by saying
10660 This would install the complete distribution file (say
10661 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
10662 like to install version 1.23_90, you need to know where the
10663 distribution file resides on CPAN relative to the authors/id/
10664 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
10665 so you would have to say
10667 install BAR/Foo-1.23_90.tar.gz
10669 The first example will be driven by an object of the class
10670 CPAN::Module, the second by an object of class CPAN::Distribution.
10672 =head2 Integrating local directories
10674 Note: this feature is still in alpha state and may change in future
10675 versions of CPAN.pm
10677 Distribution objects are normally distributions from the CPAN, but
10678 there is a slightly degenerate case for Distribution objects, too, of
10679 projects held on the local disk. These distribution objects have the
10680 same name as the local directory and end with a dot. A dot by itself
10681 is also allowed for the current directory at the time CPAN.pm was
10682 used. All actions such as C<make>, C<test>, and C<install> are applied
10683 directly to that directory. This gives the command C<cpan .> an
10684 interesting touch: while the normal mantra of installing a CPAN module
10685 without CPAN.pm is one of
10687 perl Makefile.PL perl Build.PL
10688 ( go and get prerequisites )
10690 make test ./Build test
10691 make install ./Build install
10693 the command C<cpan .> does all of this at once. It figures out which
10694 of the two mantras is appropriate, fetches and installs all
10695 prerequisites, cares for them recursively and finally finishes the
10696 installation of the module in the current directory, be it a CPAN
10699 The typical usage case is for private modules or working copies of
10700 projects from remote repositories on the local disk.
10702 =head1 CONFIGURATION
10704 When the CPAN module is used for the first time, a configuration
10705 dialog tries to determine a couple of site specific options. The
10706 result of the dialog is stored in a hash reference C< $CPAN::Config >
10707 in a file CPAN/Config.pm.
10709 The default values defined in the CPAN/Config.pm file can be
10710 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
10711 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
10712 added to the search path of the CPAN module before the use() or
10713 require() statements. The mkmyconfig command writes this file for you.
10715 The C<o conf> command has various bells and whistles:
10719 =item completion support
10721 If you have a ReadLine module installed, you can hit TAB at any point
10722 of the commandline and C<o conf> will offer you completion for the
10723 built-in subcommands and/or config variable names.
10725 =item displaying some help: o conf help
10727 Displays a short help
10729 =item displaying current values: o conf [KEY]
10731 Displays the current value(s) for this config variable. Without KEY
10732 displays all subcommands and config variables.
10738 If KEY starts and ends with a slash the string in between is
10739 interpreted as a regular expression and only keys matching this regex
10746 =item changing of scalar values: o conf KEY VALUE
10748 Sets the config variable KEY to VALUE. The empty string can be
10749 specified as usual in shells, with C<''> or C<"">
10753 o conf wget /usr/bin/wget
10755 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
10757 If a config variable name ends with C<list>, it is a list. C<o conf
10758 KEY shift> removes the first element of the list, C<o conf KEY pop>
10759 removes the last element of the list. C<o conf KEYS unshift LIST>
10760 prepends a list of values to the list, C<o conf KEYS push LIST>
10761 appends a list of valued to the list.
10763 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
10766 Finally, any other list of arguments is taken as a new list value for
10767 the KEY variable discarding the previous value.
10771 o conf urllist unshift http://cpan.dev.local/CPAN
10772 o conf urllist splice 3 1
10773 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
10775 =item reverting to saved: o conf defaults
10777 Reverts all config variables to the state in the saved config file.
10779 =item saving the config: o conf commit
10781 Saves all config variables to the current config file (CPAN/Config.pm
10782 or CPAN/MyConfig.pm that was loaded at start).
10786 The configuration dialog can be started any time later again by
10787 issuing the command C< o conf init > in the CPAN shell. A subset of
10788 the configuration dialog can be run by issuing C<o conf init WORD>
10789 where WORD is any valid config variable or a regular expression.
10791 =head2 Config Variables
10793 Currently the following keys in the hash reference $CPAN::Config are
10796 applypatch path to external prg
10797 auto_commit commit all changes to config variables to disk
10798 build_cache size of cache for directories to build modules
10799 build_dir locally accessible directory to build modules
10800 build_dir_reuse boolean if distros in build_dir are persistent
10801 build_requires_install_policy
10802 to install or not to install when a module is
10803 only needed for building. yes|no|ask/yes|ask/no
10804 bzip2 path to external prg
10805 cache_metadata use serializer to cache metadata
10806 commands_quote prefered character to use for quoting external
10807 commands when running them. Defaults to double
10808 quote on Windows, single tick everywhere else;
10809 can be set to space to disable quoting
10810 check_sigs if signatures should be verified
10811 colorize_debug Term::ANSIColor attributes for debugging output
10812 colorize_output boolean if Term::ANSIColor should colorize output
10813 colorize_print Term::ANSIColor attributes for normal output
10814 colorize_warn Term::ANSIColor attributes for warnings
10815 commandnumber_in_prompt
10816 boolean if you want to see current command number
10817 cpan_home local directory reserved for this package
10818 curl path to external prg
10819 dontload_hash DEPRECATED
10820 dontload_list arrayref: modules in the list will not be
10821 loaded by the CPAN::has_inst() routine
10822 ftp path to external prg
10823 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
10824 ftp_proxy proxy host for ftp requests
10826 gpg path to external prg
10827 gzip location of external program gzip
10828 histfile file to maintain history between sessions
10829 histsize maximum number of lines to keep in histfile
10830 http_proxy proxy host for http requests
10831 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
10832 after this many seconds inactivity. Set to 0 to
10834 index_expire after this many days refetch index files
10835 inhibit_startup_message
10836 if true, does not print the startup message
10837 keep_source_where directory in which to keep the source (if we do)
10838 load_module_verbosity
10839 report loading of optional modules used by CPAN.pm
10840 lynx path to external prg
10841 make location of external make program
10842 make_arg arguments that should always be passed to 'make'
10843 make_install_make_command
10844 the make command for running 'make install', for
10845 example 'sudo make'
10846 make_install_arg same as make_arg for 'make install'
10847 makepl_arg arguments passed to 'perl Makefile.PL'
10848 mbuild_arg arguments passed to './Build'
10849 mbuild_install_arg arguments passed to './Build install'
10850 mbuild_install_build_command
10851 command to use instead of './Build' when we are
10852 in the install stage, for example 'sudo ./Build'
10853 mbuildpl_arg arguments passed to 'perl Build.PL'
10854 ncftp path to external prg
10855 ncftpget path to external prg
10856 no_proxy don't proxy to these hosts/domains (comma separated list)
10857 pager location of external program more (or any pager)
10858 password your password if you CPAN server wants one
10859 patch path to external prg
10860 prefer_installer legal values are MB and EUMM: if a module comes
10861 with both a Makefile.PL and a Build.PL, use the
10862 former (EUMM) or the latter (MB); if the module
10863 comes with only one of the two, that one will be
10865 prerequisites_policy
10866 what to do if you are missing module prerequisites
10867 ('follow' automatically, 'ask' me, or 'ignore')
10868 prefs_dir local directory to store per-distro build options
10869 proxy_user username for accessing an authenticating proxy
10870 proxy_pass password for accessing an authenticating proxy
10871 randomize_urllist add some randomness to the sequence of the urllist
10872 scan_cache controls scanning of cache ('atstart' or 'never')
10873 shell your favorite shell
10874 show_unparsable_versions
10875 boolean if r command tells which modules are versionless
10876 show_upload_date boolean if commands should try to determine upload date
10877 show_zero_versions boolean if r command tells for which modules $version==0
10878 tar location of external program tar
10879 tar_verbosity verbosity level for the tar command
10880 term_is_latin deprecated: if true Unicode is translated to ISO-8859-1
10881 (and nonsense for characters outside latin range)
10882 term_ornaments boolean to turn ReadLine ornamenting on/off
10883 test_report email test reports (if CPAN::Reporter is installed)
10884 unzip location of external program unzip
10885 urllist arrayref to nearby CPAN sites (or equivalent locations)
10886 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
10887 username your username if you CPAN server wants one
10888 wait_list arrayref to a wait server to try (See CPAN::WAIT)
10889 wget path to external prg
10890 yaml_load_code enable YAML code deserialisation
10891 yaml_module which module to use to read/write YAML files
10893 You can set and query each of these options interactively in the cpan
10894 shell with the C<o conf> or the C<o conf init> command as specified below.
10898 =item C<o conf E<lt>scalar optionE<gt>>
10900 prints the current value of the I<scalar option>
10902 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
10904 Sets the value of the I<scalar option> to I<value>
10906 =item C<o conf E<lt>list optionE<gt>>
10908 prints the current value of the I<list option> in MakeMaker's
10911 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
10913 shifts or pops the array in the I<list option> variable
10915 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
10917 works like the corresponding perl commands.
10919 =item interactive editing: o conf init [MATCH|LIST]
10921 Runs an interactive configuration dialog for matching variables.
10922 Without argument runs the dialog over all supported config variables.
10923 To specify a MATCH the argument must be enclosed by slashes.
10927 o conf init ftp_passive ftp_proxy
10928 o conf init /color/
10930 Note: this method of setting config variables often provides more
10931 explanation about the functioning of a variable than the manpage.
10935 =head2 CPAN::anycwd($path): Note on config variable getcwd
10937 CPAN.pm changes the current working directory often and needs to
10938 determine its own current working directory. Per default it uses
10939 Cwd::cwd but if this doesn't work on your system for some reason,
10940 alternatives can be configured according to the following table:
10958 Calls the external command cwd.
10962 =head2 Note on the format of the urllist parameter
10964 urllist parameters are URLs according to RFC 1738. We do a little
10965 guessing if your URL is not compliant, but if you have problems with
10966 C<file> URLs, please try the correct format. Either:
10968 file://localhost/whatever/ftp/pub/CPAN/
10972 file:///home/ftp/pub/CPAN/
10974 =head2 The urllist parameter has CD-ROM support
10976 The C<urllist> parameter of the configuration table contains a list of
10977 URLs that are to be used for downloading. If the list contains any
10978 C<file> URLs, CPAN always tries to get files from there first. This
10979 feature is disabled for index files. So the recommendation for the
10980 owner of a CD-ROM with CPAN contents is: include your local, possibly
10981 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
10983 o conf urllist push file://localhost/CDROM/CPAN
10985 CPAN.pm will then fetch the index files from one of the CPAN sites
10986 that come at the beginning of urllist. It will later check for each
10987 module if there is a local copy of the most recent version.
10989 Another peculiarity of urllist is that the site that we could
10990 successfully fetch the last file from automatically gets a preference
10991 token and is tried as the first site for the next request. So if you
10992 add a new site at runtime it may happen that the previously preferred
10993 site will be tried another time. This means that if you want to disallow
10994 a site for the next transfer, it must be explicitly removed from
10997 =head2 Maintaining the urllist parameter
10999 If you have YAML.pm (or some other YAML module configured in
11000 C<yaml_module>) installed, CPAN.pm collects a few statistical data
11001 about recent downloads. You can view the statistics with the C<hosts>
11002 command or inspect them directly by looking into the C<FTPstats.yml>
11003 file in your C<cpan_home> directory.
11005 To get some interesting statistics it is recommended to set the
11006 C<randomize_urllist> parameter that introduces some amount of
11007 randomness into the URL selection.
11009 =head2 The C<requires> and C<build_requires> dependency declarations
11011 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
11012 a distribution are treated differently depending on the config
11013 variable C<build_requires_install_policy>. By setting
11014 C<build_requires_install_policy> to C<no> such a module is not being
11015 installed. It is only built and tested and then kept in the list of
11016 tested but uninstalled modules. As such it is available during the
11017 build of the dependent module by integrating the path to the
11018 C<blib/arch> and C<blib/lib> directories in the environment variable
11019 PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
11020 both modules declared as C<requires> and those declared as
11021 C<build_requires> are treated alike. By setting to C<ask/yes> or
11022 C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
11024 =head2 Configuration for individual distributions (I<Distroprefs>)
11026 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
11027 still considered beta quality)
11029 Distributions on the CPAN usually behave according to what we call the
11030 CPAN mantra. Or since the event of Module::Build we should talk about
11033 perl Makefile.PL perl Build.PL
11035 make test ./Build test
11036 make install ./Build install
11038 But some modules cannot be built with this mantra. They try to get
11039 some extra data from the user via the environment, extra arguments or
11040 interactively thus disturbing the installation of large bundles like
11041 Phalanx100 or modules with many dependencies like Plagger.
11043 The distroprefs system of C<CPAN.pm> addresses this problem by
11044 allowing the user to specify extra informations and recipes in YAML
11051 pass additional arguments to one of the four commands,
11055 set environment variables
11059 instantiate an Expect object that reads from the console, waits for
11060 some regular expressions and enters some answers
11064 temporarily override assorted C<CPAN.pm> configuration variables
11068 specify dependencies that the original maintainer forgot to specify
11072 disable the installation of an object altogether
11076 See the YAML and Data::Dumper files that come with the C<CPAN.pm>
11077 distribution in the C<distroprefs/> directory for examples.
11081 The YAML files themselves must have the C<.yml> extension, all other
11082 files are ignored (for two exceptions see I<Fallback Data::Dumper and
11083 Storable> below). The containing directory can be specified in
11084 C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
11085 prefs_dir> in the CPAN shell to set and activate the distroprefs
11088 Every YAML file may contain arbitrary documents according to the YAML
11089 specification and every single document is treated as an entity that
11090 can specify the treatment of a single distribution.
11092 The names of the files can be picked freely, C<CPAN.pm> always reads
11093 all files (in alphabetical order) and takes the key C<match> (see
11094 below in I<Language Specs>) as a hashref containing match criteria
11095 that determine if the current distribution matches the YAML document
11098 =head2 Fallback Data::Dumper and Storable
11100 If neither your configured C<yaml_module> nor YAML.pm is installed
11101 CPAN.pm falls back to using Data::Dumper and Storable and looks for
11102 files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
11103 directory. These files are expected to contain one or more hashrefs.
11104 For Data::Dumper generated files, this is expected to be done with by
11105 defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
11108 ysh < somefile.yml > somefile.dd
11110 For Storable files the rule is that they must be constructed such that
11111 C<Storable::retrieve(file)> returns an array reference and the array
11112 elements represent one distropref object each. The conversion from
11113 YAML would look like so:
11115 perl -MYAML=LoadFile -MStorable=nstore -e '
11116 @y=LoadFile(shift);
11117 nstore(\@y, shift)' somefile.yml somefile.st
11119 In bootstrapping situations it is usually sufficient to translate only
11120 a few YAML files to Data::Dumper for the crucial modules like
11121 C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
11122 over Data::Dumper, remember to pull out a Storable version that writes
11123 an older format than all the other Storable versions that will need to
11128 The following example contains all supported keywords and structures
11129 with the exception of C<eexpect> which can be used instead of
11135 module: "Dancing::Queen"
11136 distribution: "^CHACHACHA/Dancing-"
11137 perl: "/usr/local/cariba-perl/bin/perl"
11139 archname: "freebsd"
11145 - "--somearg=specialcase"
11150 - "Which is your favorite fruit"
11162 commendline: "echo SKIPPING make"
11175 WANT_TO_INSTALL: YES
11178 - "Do you really want to install"
11182 - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
11185 configure_requires:
11188 Test::Exception: 0.25
11193 =head2 Language Specs
11195 Every YAML document represents a single hash reference. The valid keys
11196 in this hash are as follows:
11200 =item comment [scalar]
11204 =item cpanconfig [hash]
11206 Temporarily override assorted C<CPAN.pm> configuration variables.
11208 Supported are: C<build_requires_install_policy>, C<check_sigs>,
11209 C<make>, C<make_install_make_command>, C<prefer_installer>,
11210 C<test_report>. Please report as a bug when you need another one
11213 =item depends [hash] *** EXPERIMENTAL FEATURE ***
11215 All three types, namely C<configure_requires>, C<build_requires>, and
11216 C<requires> are supported in the way specified in the META.yml
11217 specification. The current implementation I<merges> the specified
11218 dependencies with those declared by the package maintainer. In a
11219 future implementation this may be changed to override the original
11222 =item disabled [boolean]
11224 Specifies that this distribution shall not be processed at all.
11226 =item goto [string]
11228 The canonical name of a delegate distribution that shall be installed
11229 instead. Useful when a new version, although it tests OK itself,
11230 breaks something else or a developer release or a fork is already
11231 uploaded that is better than the last released version.
11233 =item install [hash]
11235 Processing instructions for the C<make install> or C<./Build install>
11236 phase of the CPAN mantra. See below under I<Processiong Instructions>.
11240 Processing instructions for the C<make> or C<./Build> phase of the
11241 CPAN mantra. See below under I<Processiong Instructions>.
11245 A hashref with one or more of the keys C<distribution>, C<modules>,
11246 C<perl>, and C<perlconfig> that specify if a document is targeted at a
11247 specific CPAN distribution or installation.
11249 The corresponding values are interpreted as regular expressions. The
11250 C<distribution> related one will be matched against the canonical
11251 distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
11253 The C<module> related one will be matched against I<all> modules
11254 contained in the distribution until one module matches.
11256 The C<perl> related one will be matched against C<$^X> (but with the
11259 The value associated with C<perlconfig> is itself a hashref that is
11260 matched against corresponding values in the C<%Config::Config> hash
11261 living in the C< Config.pm > module.
11263 If more than one restriction of C<module>, C<distribution>, and
11264 C<perl> is specified, the results of the separately computed match
11265 values must all match. If this is the case then the hashref
11266 represented by the YAML document is returned as the preference
11267 structure for the current distribution.
11269 =item patches [array]
11271 An array of patches on CPAN or on the local disk to be applied in
11272 order via the external patch program. If the value for the C<-p>
11273 parameter is C<0> or C<1> is determined by reading the patch
11276 Note: if the C<applypatch> program is installed and C<CPAN::Config>
11277 knows about it B<and> a patch is written by the C<makepatch> program,
11278 then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
11279 and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
11284 Processing instructions for the C<perl Makefile.PL> or C<perl
11285 Build.PL> phase of the CPAN mantra. See below under I<Processiong
11290 Processing instructions for the C<make test> or C<./Build test> phase
11291 of the CPAN mantra. See below under I<Processiong Instructions>.
11295 =head2 Processing Instructions
11301 Arguments to be added to the command line
11305 A full commandline that will be executed as it stands by a system
11306 call. During the execution the environment variable PERL will is set
11307 to $^X (but with an absolute path). If C<commandline> is specified,
11308 the content of C<args> is not used.
11310 =item eexpect [hash]
11312 Extended C<expect>. This is a hash reference with four allowed keys,
11313 C<mode>, C<timeout>, C<reuse>, and C<talk>.
11315 C<mode> may have the values C<deterministic> for the case where all
11316 questions come in the order written down and C<anyorder> for the case
11317 where the questions may come in any order. The default mode is
11320 C<timeout> denotes a timeout in seconds. Floating point timeouts are
11321 OK. In the case of a C<mode=deterministic> the timeout denotes the
11322 timeout per question, in the case of C<mode=anyorder> it denotes the
11323 timeout per byte received from the stream or questions.
11325 C<talk> is a reference to an array that contains alternating questions
11326 and answers. Questions are regular expressions and answers are literal
11327 strings. The Expect module will then watch the stream coming from the
11328 execution of the external program (C<perl Makefile.PL>, C<perl
11329 Build.PL>, C<make>, etc.).
11331 In the case of C<mode=deterministic> the CPAN.pm will inject the
11332 according answer as soon as the stream matches the regular expression.
11334 In the case of C<mode=anyorder> CPAN.pm will answer a question as soon
11335 as the timeout is reached for the next byte in the input stream. In
11336 this mode you can use the C<reuse> parameter to decide what shall
11337 happen with a question-answer pair after it has been used. In the
11338 default case (reuse=0) it is removed from the array, so it cannot be
11339 used again accidentally. In this case, if you want to answer the
11340 question C<Do you really want to do that> several times, then it must
11341 be included in the array at least as often as you want this answer to
11342 be given. Setting the parameter C<reuse> to 1 makes this repetition
11347 Environment variables to be set during the command
11349 =item expect [array]
11351 C<< expect: <array> >> is a short notation for
11354 mode: deterministic
11360 =head2 Schema verification with C<Kwalify>
11362 If you have the C<Kwalify> module installed (which is part of the
11363 Bundle::CPANxxl), then all your distroprefs files are checked for
11364 syntactical correctness.
11366 =head2 Example Distroprefs Files
11368 C<CPAN.pm> comes with a collection of example YAML files. Note that these
11369 are really just examples and should not be used without care because
11370 they cannot fit everybody's purpose. After all the authors of the
11371 packages that ask questions had a need to ask, so you should watch
11372 their questions and adjust the examples to your environment and your
11373 needs. You have beend warned:-)
11375 =head1 PROGRAMMER'S INTERFACE
11377 If you do not enter the shell, the available shell commands are both
11378 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
11379 functions in the calling package (C<install(...)>). Before calling low-level
11380 commands it makes sense to initialize components of CPAN you need, e.g.:
11382 CPAN::HandleConfig->load;
11383 CPAN::Shell::setup_output;
11384 CPAN::Index->reload;
11386 High-level commands do such initializations automatically.
11388 There's currently only one class that has a stable interface -
11389 CPAN::Shell. All commands that are available in the CPAN shell are
11390 methods of the class CPAN::Shell. Each of the commands that produce
11391 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
11392 the IDs of all modules within the list.
11396 =item expand($type,@things)
11398 The IDs of all objects available within a program are strings that can
11399 be expanded to the corresponding real objects with the
11400 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
11401 list of CPAN::Module objects according to the C<@things> arguments
11402 given. In scalar context it only returns the first element of the
11405 =item expandany(@things)
11407 Like expand, but returns objects of the appropriate type, i.e.
11408 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
11409 CPAN::Distribution objects for distributions. Note: it does not expand
11410 to CPAN::Author objects.
11412 =item Programming Examples
11414 This enables the programmer to do operations that combine
11415 functionalities that are available in the shell.
11417 # install everything that is outdated on my disk:
11418 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
11420 # install my favorite programs if necessary:
11421 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)) {
11422 CPAN::Shell->install($mod);
11425 # list all modules on my disk that have no VERSION number
11426 for $mod (CPAN::Shell->expand("Module","/./")) {
11427 next unless $mod->inst_file;
11428 # MakeMaker convention for undefined $VERSION:
11429 next unless $mod->inst_version eq "undef";
11430 print "No VERSION in ", $mod->id, "\n";
11433 # find out which distribution on CPAN contains a module:
11434 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
11436 Or if you want to write a cronjob to watch The CPAN, you could list
11437 all modules that need updating. First a quick and dirty way:
11439 perl -e 'use CPAN; CPAN::Shell->r;'
11441 If you don't want to get any output in the case that all modules are
11442 up to date, you can parse the output of above command for the regular
11443 expression //modules are up to date// and decide to mail the output
11444 only if it doesn't match. Ick?
11446 If you prefer to do it more in a programmer style in one single
11447 process, maybe something like this suits you better:
11449 # list all modules on my disk that have newer versions on CPAN
11450 for $mod (CPAN::Shell->expand("Module","/./")) {
11451 next unless $mod->inst_file;
11452 next if $mod->uptodate;
11453 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
11454 $mod->id, $mod->inst_version, $mod->cpan_version;
11457 If that gives you too much output every day, you maybe only want to
11458 watch for three modules. You can write
11460 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")) {
11462 as the first line instead. Or you can combine some of the above
11465 # watch only for a new mod_perl module
11466 $mod = CPAN::Shell->expand("Module","mod_perl");
11467 exit if $mod->uptodate;
11468 # new mod_perl arrived, let me know all update recommendations
11473 =head2 Methods in the other Classes
11477 =item CPAN::Author::as_glimpse()
11479 Returns a one-line description of the author
11481 =item CPAN::Author::as_string()
11483 Returns a multi-line description of the author
11485 =item CPAN::Author::email()
11487 Returns the author's email address
11489 =item CPAN::Author::fullname()
11491 Returns the author's name
11493 =item CPAN::Author::name()
11495 An alias for fullname
11497 =item CPAN::Bundle::as_glimpse()
11499 Returns a one-line description of the bundle
11501 =item CPAN::Bundle::as_string()
11503 Returns a multi-line description of the bundle
11505 =item CPAN::Bundle::clean()
11507 Recursively runs the C<clean> method on all items contained in the bundle.
11509 =item CPAN::Bundle::contains()
11511 Returns a list of objects' IDs contained in a bundle. The associated
11512 objects may be bundles, modules or distributions.
11514 =item CPAN::Bundle::force($method,@args)
11516 Forces CPAN to perform a task that it normally would have refused to
11517 do. Force takes as arguments a method name to be called and any number
11518 of additional arguments that should be passed to the called method.
11519 The internals of the object get the needed changes so that CPAN.pm
11520 does not refuse to take the action. The C<force> is passed recursively
11521 to all contained objects. See also the section above on the C<force>
11522 and the C<fforce> pragma.
11524 =item CPAN::Bundle::get()
11526 Recursively runs the C<get> method on all items contained in the bundle
11528 =item CPAN::Bundle::inst_file()
11530 Returns the highest installed version of the bundle in either @INC or
11531 C<$CPAN::Config->{cpan_home}>. Note that this is different from
11532 CPAN::Module::inst_file.
11534 =item CPAN::Bundle::inst_version()
11536 Like CPAN::Bundle::inst_file, but returns the $VERSION
11538 =item CPAN::Bundle::uptodate()
11540 Returns 1 if the bundle itself and all its members are uptodate.
11542 =item CPAN::Bundle::install()
11544 Recursively runs the C<install> method on all items contained in the bundle
11546 =item CPAN::Bundle::make()
11548 Recursively runs the C<make> method on all items contained in the bundle
11550 =item CPAN::Bundle::readme()
11552 Recursively runs the C<readme> method on all items contained in the bundle
11554 =item CPAN::Bundle::test()
11556 Recursively runs the C<test> method on all items contained in the bundle
11558 =item CPAN::Distribution::as_glimpse()
11560 Returns a one-line description of the distribution
11562 =item CPAN::Distribution::as_string()
11564 Returns a multi-line description of the distribution
11566 =item CPAN::Distribution::author
11568 Returns the CPAN::Author object of the maintainer who uploaded this
11571 =item CPAN::Distribution::pretty_id()
11573 Returns a string of the form "AUTHORID/TARBALL", where AUTHORID is the
11574 author's PAUSE ID and TARBALL is the distribution filename.
11576 =item CPAN::Distribution::base_id()
11578 Returns the distribution filename without any archive suffix. E.g
11581 =item CPAN::Distribution::clean()
11583 Changes to the directory where the distribution has been unpacked and
11584 runs C<make clean> there.
11586 =item CPAN::Distribution::containsmods()
11588 Returns a list of IDs of modules contained in a distribution file.
11589 Only works for distributions listed in the 02packages.details.txt.gz
11590 file. This typically means that only the most recent version of a
11591 distribution is covered.
11593 =item CPAN::Distribution::cvs_import()
11595 Changes to the directory where the distribution has been unpacked and
11596 runs something like
11598 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
11602 =item CPAN::Distribution::dir()
11604 Returns the directory into which this distribution has been unpacked.
11606 =item CPAN::Distribution::force($method,@args)
11608 Forces CPAN to perform a task that it normally would have refused to
11609 do. Force takes as arguments a method name to be called and any number
11610 of additional arguments that should be passed to the called method.
11611 The internals of the object get the needed changes so that CPAN.pm
11612 does not refuse to take the action. See also the section above on the
11613 C<force> and the C<fforce> pragma.
11615 =item CPAN::Distribution::get()
11617 Downloads the distribution from CPAN and unpacks it. Does nothing if
11618 the distribution has already been downloaded and unpacked within the
11621 =item CPAN::Distribution::install()
11623 Changes to the directory where the distribution has been unpacked and
11624 runs the external command C<make install> there. If C<make> has not
11625 yet been run, it will be run first. A C<make test> will be issued in
11626 any case and if this fails, the install will be canceled. The
11627 cancellation can be avoided by letting C<force> run the C<install> for
11630 This install method has only the power to install the distribution if
11631 there are no dependencies in the way. To install an object and all of
11632 its dependencies, use CPAN::Shell->install.
11634 Note that install() gives no meaningful return value. See uptodate().
11636 =item CPAN::Distribution::install_tested()
11638 Install all the distributions that have been tested sucessfully but
11639 not yet installed. See also C<is_tested>.
11641 =item CPAN::Distribution::isa_perl()
11643 Returns 1 if this distribution file seems to be a perl distribution.
11644 Normally this is derived from the file name only, but the index from
11645 CPAN can contain a hint to achieve a return value of true for other
11648 =item CPAN::Distribution::is_tested()
11650 List all the distributions that have been tested sucessfully but not
11651 yet installed. See also C<install_tested>.
11653 =item CPAN::Distribution::look()
11655 Changes to the directory where the distribution has been unpacked and
11656 opens a subshell there. Exiting the subshell returns.
11658 =item CPAN::Distribution::make()
11660 First runs the C<get> method to make sure the distribution is
11661 downloaded and unpacked. Changes to the directory where the
11662 distribution has been unpacked and runs the external commands C<perl
11663 Makefile.PL> or C<perl Build.PL> and C<make> there.
11665 =item CPAN::Distribution::perldoc()
11667 Downloads the pod documentation of the file associated with a
11668 distribution (in html format) and runs it through the external
11669 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
11670 isn't available, it converts it to plain text with external
11671 command html2text and runs it through the pager specified
11672 in C<$CPAN::Config->{pager}>
11674 =item CPAN::Distribution::prefs()
11676 Returns the hash reference from the first matching YAML file that the
11677 user has deposited in the C<prefs_dir/> directory. The first
11678 succeeding match wins. The files in the C<prefs_dir/> are processed
11679 alphabetically and the canonical distroname (e.g.
11680 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
11681 stored in the $root->{match}{distribution} attribute value.
11682 Additionally all module names contained in a distribution are matched
11683 agains the regular expressions in the $root->{match}{module} attribute
11684 value. The two match values are ANDed together. Each of the two
11685 attributes are optional.
11687 =item CPAN::Distribution::prereq_pm()
11689 Returns the hash reference that has been announced by a distribution
11690 as the the C<requires> and C<build_requires> elements. These can be
11691 declared either by the C<META.yml> (if authoritative) or can be
11692 deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
11693 or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
11694 a comment in the produced C<Makefile>. I<Note>: this method only works
11695 after an attempt has been made to C<make> the distribution. Returns
11698 =item CPAN::Distribution::readme()
11700 Downloads the README file associated with a distribution and runs it
11701 through the pager specified in C<$CPAN::Config->{pager}>.
11703 =item CPAN::Distribution::reports()
11705 Downloads report data for this distribution from cpantesters.perl.org
11706 and displays a subset of them.
11708 =item CPAN::Distribution::read_yaml()
11710 Returns the content of the META.yml of this distro as a hashref. Note:
11711 works only after an attempt has been made to C<make> the distribution.
11712 Returns undef otherwise. Also returns undef if the content of META.yml
11713 is not authoritative. (The rules about what exactly makes the content
11714 authoritative are still in flux.)
11716 =item CPAN::Distribution::test()
11718 Changes to the directory where the distribution has been unpacked and
11719 runs C<make test> there.
11721 =item CPAN::Distribution::uptodate()
11723 Returns 1 if all the modules contained in the distribution are
11724 uptodate. Relies on containsmods.
11726 =item CPAN::Index::force_reload()
11728 Forces a reload of all indices.
11730 =item CPAN::Index::reload()
11732 Reloads all indices if they have not been read for more than
11733 C<$CPAN::Config->{index_expire}> days.
11735 =item CPAN::InfoObj::dump()
11737 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
11738 inherit this method. It prints the data structure associated with an
11739 object. Useful for debugging. Note: the data structure is considered
11740 internal and thus subject to change without notice.
11742 =item CPAN::Module::as_glimpse()
11744 Returns a one-line description of the module in four columns: The
11745 first column contains the word C<Module>, the second column consists
11746 of one character: an equals sign if this module is already installed
11747 and uptodate, a less-than sign if this module is installed but can be
11748 upgraded, and a space if the module is not installed. The third column
11749 is the name of the module and the fourth column gives maintainer or
11750 distribution information.
11752 =item CPAN::Module::as_string()
11754 Returns a multi-line description of the module
11756 =item CPAN::Module::clean()
11758 Runs a clean on the distribution associated with this module.
11760 =item CPAN::Module::cpan_file()
11762 Returns the filename on CPAN that is associated with the module.
11764 =item CPAN::Module::cpan_version()
11766 Returns the latest version of this module available on CPAN.
11768 =item CPAN::Module::cvs_import()
11770 Runs a cvs_import on the distribution associated with this module.
11772 =item CPAN::Module::description()
11774 Returns a 44 character description of this module. Only available for
11775 modules listed in The Module List (CPAN/modules/00modlist.long.html
11776 or 00modlist.long.txt.gz)
11778 =item CPAN::Module::distribution()
11780 Returns the CPAN::Distribution object that contains the current
11781 version of this module.
11783 =item CPAN::Module::dslip_status()
11785 Returns a hash reference. The keys of the hash are the letters C<D>,
11786 C<S>, C<L>, C<I>, and <P>, for development status, support level,
11787 language, interface and public licence respectively. The data for the
11788 DSLIP status are collected by pause.perl.org when authors register
11789 their namespaces. The values of the 5 hash elements are one-character
11790 words whose meaning is described in the table below. There are also 5
11791 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
11792 verbose value of the 5 status variables.
11794 Where the 'DSLIP' characters have the following meanings:
11796 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
11797 i - Idea, listed to gain consensus or as a placeholder
11798 c - under construction but pre-alpha (not yet released)
11799 a/b - Alpha/Beta testing
11801 M - Mature (no rigorous definition)
11802 S - Standard, supplied with Perl 5
11807 u - Usenet newsgroup comp.lang.perl.modules
11808 n - None known, try comp.lang.perl.modules
11809 a - abandoned; volunteers welcome to take over maintainance
11812 p - Perl-only, no compiler needed, should be platform independent
11813 c - C and perl, a C compiler will be needed
11814 h - Hybrid, written in perl with optional C code, no compiler needed
11815 + - C++ and perl, a C++ compiler will be needed
11816 o - perl and another language other than C or C++
11818 I - Interface Style
11819 f - plain Functions, no references used
11820 h - hybrid, object and function interfaces available
11821 n - no interface at all (huh?)
11822 r - some use of unblessed References or ties
11823 O - Object oriented using blessed references and/or inheritance
11826 p - Standard-Perl: user may choose between GPL and Artistic
11827 g - GPL: GNU General Public License
11828 l - LGPL: "GNU Lesser General Public License" (previously known as
11829 "GNU Library General Public License")
11830 b - BSD: The BSD License
11831 a - Artistic license alone
11832 2 - Artistic license 2.0 or later
11833 o - open source: appoved by www.opensource.org
11834 d - allows distribution without restrictions
11835 r - restricted distribtion
11836 n - no license at all
11838 =item CPAN::Module::force($method,@args)
11840 Forces CPAN to perform a task that it normally would have refused to
11841 do. Force takes as arguments a method name to be called and any number
11842 of additional arguments that should be passed to the called method.
11843 The internals of the object get the needed changes so that CPAN.pm
11844 does not refuse to take the action. See also the section above on the
11845 C<force> and the C<fforce> pragma.
11847 =item CPAN::Module::get()
11849 Runs a get on the distribution associated with this module.
11851 =item CPAN::Module::inst_file()
11853 Returns the filename of the module found in @INC. The first file found
11854 is reported just like perl itself stops searching @INC when it finds a
11857 =item CPAN::Module::available_file()
11859 Returns the filename of the module found in PERL5LIB or @INC. The
11860 first file found is reported. The advantage of this method over
11861 C<inst_file> is that modules that have been tested but not yet
11862 installed are included because PERL5LIB keeps track of tested modules.
11864 =item CPAN::Module::inst_version()
11866 Returns the version number of the installed module in readable format.
11868 =item CPAN::Module::available_version()
11870 Returns the version number of the available module in readable format.
11872 =item CPAN::Module::install()
11874 Runs an C<install> on the distribution associated with this module.
11876 =item CPAN::Module::look()
11878 Changes to the directory where the distribution associated with this
11879 module has been unpacked and opens a subshell there. Exiting the
11882 =item CPAN::Module::make()
11884 Runs a C<make> on the distribution associated with this module.
11886 =item CPAN::Module::manpage_headline()
11888 If module is installed, peeks into the module's manpage, reads the
11889 headline and returns it. Moreover, if the module has been downloaded
11890 within this session, does the equivalent on the downloaded module even
11891 if it is not installed.
11893 =item CPAN::Module::perldoc()
11895 Runs a C<perldoc> on this module.
11897 =item CPAN::Module::readme()
11899 Runs a C<readme> on the distribution associated with this module.
11901 =item CPAN::Module::reports()
11903 Calls the reports() method on the associated distribution object.
11905 =item CPAN::Module::test()
11907 Runs a C<test> on the distribution associated with this module.
11909 =item CPAN::Module::uptodate()
11911 Returns 1 if the module is installed and up-to-date.
11913 =item CPAN::Module::userid()
11915 Returns the author's ID of the module.
11919 =head2 Cache Manager
11921 Currently the cache manager only keeps track of the build directory
11922 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
11923 deletes complete directories below C<build_dir> as soon as the size of
11924 all directories there gets bigger than $CPAN::Config->{build_cache}
11925 (in MB). The contents of this cache may be used for later
11926 re-installations that you intend to do manually, but will never be
11927 trusted by CPAN itself. This is due to the fact that the user might
11928 use these directories for building modules on different architectures.
11930 There is another directory ($CPAN::Config->{keep_source_where}) where
11931 the original distribution files are kept. This directory is not
11932 covered by the cache manager and must be controlled by the user. If
11933 you choose to have the same directory as build_dir and as
11934 keep_source_where directory, then your sources will be deleted with
11935 the same fifo mechanism.
11939 A bundle is just a perl module in the namespace Bundle:: that does not
11940 define any functions or methods. It usually only contains documentation.
11942 It starts like a perl module with a package declaration and a $VERSION
11943 variable. After that the pod section looks like any other pod with the
11944 only difference being that I<one special pod section> exists starting with
11949 In this pod section each line obeys the format
11951 Module_Name [Version_String] [- optional text]
11953 The only required part is the first field, the name of a module
11954 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
11955 of the line is optional. The comment part is delimited by a dash just
11956 as in the man page header.
11958 The distribution of a bundle should follow the same convention as
11959 other distributions.
11961 Bundles are treated specially in the CPAN package. If you say 'install
11962 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
11963 the modules in the CONTENTS section of the pod. You can install your
11964 own Bundles locally by placing a conformant Bundle file somewhere into
11965 your @INC path. The autobundle() command which is available in the
11966 shell interface does that for you by including all currently installed
11967 modules in a snapshot bundle file.
11969 =head1 PREREQUISITES
11971 If you have a local mirror of CPAN and can access all files with
11972 "file:" URLs, then you only need a perl better than perl5.003 to run
11973 this module. Otherwise Net::FTP is strongly recommended. LWP may be
11974 required for non-UNIX systems or if your nearest CPAN site is
11975 associated with a URL that is not C<ftp:>.
11977 If you have neither Net::FTP nor LWP, there is a fallback mechanism
11978 implemented for an external ftp command or for an external lynx
11983 =head2 Finding packages and VERSION
11985 This module presumes that all packages on CPAN
11991 declare their $VERSION variable in an easy to parse manner. This
11992 prerequisite can hardly be relaxed because it consumes far too much
11993 memory to load all packages into the running program just to determine
11994 the $VERSION variable. Currently all programs that are dealing with
11995 version use something like this
11997 perl -MExtUtils::MakeMaker -le \
11998 'print MM->parse_version(shift)' filename
12000 If you are author of a package and wonder if your $VERSION can be
12001 parsed, please try the above method.
12005 come as compressed or gzipped tarfiles or as zip files and contain a
12006 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
12007 without much enthusiasm).
12013 The debugging of this module is a bit complex, because we have
12014 interferences of the software producing the indices on CPAN, of the
12015 mirroring process on CPAN, of packaging, of configuration, of
12016 synchronicity, and of bugs within CPAN.pm.
12018 For debugging the code of CPAN.pm itself in interactive mode some more
12019 or less useful debugging aid can be turned on for most packages within
12020 CPAN.pm with one of
12024 =item o debug package...
12026 sets debug mode for packages.
12028 =item o debug -package...
12030 unsets debug mode for packages.
12034 turns debugging on for all packages.
12036 =item o debug number
12040 which sets the debugging packages directly. Note that C<o debug 0>
12041 turns debugging off.
12043 What seems quite a successful strategy is the combination of C<reload
12044 cpan> and the debugging switches. Add a new debug statement while
12045 running in the shell and then issue a C<reload cpan> and see the new
12046 debugging messages immediately without losing the current context.
12048 C<o debug> without an argument lists the valid package names and the
12049 current set of packages in debugging mode. C<o debug> has built-in
12050 completion support.
12052 For debugging of CPAN data there is the C<dump> command which takes
12053 the same arguments as make/test/install and outputs each object's
12054 Data::Dumper dump. If an argument looks like a perl variable and
12055 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
12056 Data::Dumper directly.
12058 =head2 Floppy, Zip, Offline Mode
12060 CPAN.pm works nicely without network too. If you maintain machines
12061 that are not networked at all, you should consider working with file:
12062 URLs. Of course, you have to collect your modules somewhere first. So
12063 you might use CPAN.pm to put together all you need on a networked
12064 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
12065 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
12066 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
12067 with this floppy. See also below the paragraph about CD-ROM support.
12069 =head2 Basic Utilities for Programmers
12073 =item has_inst($module)
12075 Returns true if the module is installed. Used to load all modules into
12076 the running CPAN.pm which are considered optional. The config variable
12077 C<dontload_list> can be used to intercept the C<has_inst()> call such
12078 that an optional module is not loaded despite being available. For
12079 example the following command will prevent that C<YAML.pm> is being
12082 cpan> o conf dontload_list push YAML
12084 See the source for details.
12086 =item has_usable($module)
12088 Returns true if the module is installed and is in a usable state. Only
12089 useful for a handful of modules that are used internally. See the
12090 source for details.
12092 =item instance($module)
12094 The constructor for all the singletons used to represent modules,
12095 distributions, authors and bundles. If the object already exists, this
12096 method returns the object, otherwise it calls the constructor.
12102 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
12103 install foreign, unmasked, unsigned code on your machine. We compare
12104 to a checksum that comes from the net just as the distribution file
12105 itself. But we try to make it easy to add security on demand:
12107 =head2 Cryptographically signed modules
12109 Since release 1.77 CPAN.pm has been able to verify cryptographically
12110 signed module distributions using Module::Signature. The CPAN modules
12111 can be signed by their authors, thus giving more security. The simple
12112 unsigned MD5 checksums that were used before by CPAN protect mainly
12113 against accidental file corruption.
12115 You will need to have Module::Signature installed, which in turn
12116 requires that you have at least one of Crypt::OpenPGP module or the
12117 command-line F<gpg> tool installed.
12119 You will also need to be able to connect over the Internet to the public
12120 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
12122 The configuration parameter check_sigs is there to turn signature
12123 checking on or off.
12127 Most functions in package CPAN are exported per default. The reason
12128 for this is that the primary use is intended for the cpan shell or for
12133 When the CPAN shell enters a subshell via the look command, it sets
12134 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
12137 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING
12138 to the ID of the running process. It also sets
12139 PERL5_CPANPLUS_IS_RUNNING to prevent runaway processes which could
12140 happen with older versions of Module::Install.
12142 When running C<perl Makefile.PL>, the environment variable
12143 C<PERL5_CPAN_IS_EXECUTING> is set to the full path of the
12144 C<Makefile.PL> that is being executed. This prevents runaway processes
12145 with newer versions of Module::Install.
12147 When the config variable ftp_passive is set, all downloads will be run
12148 with the environment variable FTP_PASSIVE set to this value. This is
12149 in general a good idea as it influences both Net::FTP and LWP based
12150 connections. The same effect can be achieved by starting the cpan
12151 shell with this environment variable set. For Net::FTP alone, one can
12152 also always set passive mode by running libnetcfg.
12154 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
12156 Populating a freshly installed perl with my favorite modules is pretty
12157 easy if you maintain a private bundle definition file. To get a useful
12158 blueprint of a bundle definition file, the command autobundle can be used
12159 on the CPAN shell command line. This command writes a bundle definition
12160 file for all modules that are installed for the currently running perl
12161 interpreter. It's recommended to run this command only once and from then
12162 on maintain the file manually under a private name, say
12163 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
12165 cpan> install Bundle::my_bundle
12167 then answer a few questions and then go out for a coffee.
12169 Maintaining a bundle definition file means keeping track of two
12170 things: dependencies and interactivity. CPAN.pm sometimes fails on
12171 calculating dependencies because not all modules define all MakeMaker
12172 attributes correctly, so a bundle definition file should specify
12173 prerequisites as early as possible. On the other hand, it's a bit
12174 annoying that many distributions need some interactive configuring. So
12175 what I try to accomplish in my private bundle file is to have the
12176 packages that need to be configured early in the file and the gentle
12177 ones later, so I can go out after a few minutes and leave CPAN.pm
12180 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
12182 Thanks to Graham Barr for contributing the following paragraphs about
12183 the interaction between perl, and various firewall configurations. For
12184 further information on firewalls, it is recommended to consult the
12185 documentation that comes with the ncftp program. If you are unable to
12186 go through the firewall with a simple Perl setup, it is very likely
12187 that you can configure ncftp so that it works for your firewall.
12189 =head2 Three basic types of firewalls
12191 Firewalls can be categorized into three basic types.
12195 =item http firewall
12197 This is where the firewall machine runs a web server and to access the
12198 outside world you must do it via the web server. If you set environment
12199 variables like http_proxy or ftp_proxy to a values beginning with http://
12200 or in your web browser you have to set proxy information then you know
12201 you are running an http firewall.
12203 To access servers outside these types of firewalls with perl (even for
12204 ftp) you will need to use LWP.
12208 This where the firewall machine runs an ftp server. This kind of
12209 firewall will only let you access ftp servers outside the firewall.
12210 This is usually done by connecting to the firewall with ftp, then
12211 entering a username like "user@outside.host.com"
12213 To access servers outside these type of firewalls with perl you
12214 will need to use Net::FTP.
12216 =item One way visibility
12218 I say one way visibility as these firewalls try to make themselves look
12219 invisible to the users inside the firewall. An FTP data connection is
12220 normally created by sending the remote server your IP address and then
12221 listening for the connection. But the remote server will not be able to
12222 connect to you because of the firewall. So for these types of firewall
12223 FTP connections need to be done in a passive mode.
12225 There are two that I can think off.
12231 If you are using a SOCKS firewall you will need to compile perl and link
12232 it with the SOCKS library, this is what is normally called a 'socksified'
12233 perl. With this executable you will be able to connect to servers outside
12234 the firewall as if it is not there.
12236 =item IP Masquerade
12238 This is the firewall implemented in the Linux kernel, it allows you to
12239 hide a complete network behind one IP address. With this firewall no
12240 special compiling is needed as you can access hosts directly.
12242 For accessing ftp servers behind such firewalls you usually need to
12243 set the environment variable C<FTP_PASSIVE> or the config variable
12244 ftp_passive to a true value.
12250 =head2 Configuring lynx or ncftp for going through a firewall
12252 If you can go through your firewall with e.g. lynx, presumably with a
12255 /usr/local/bin/lynx -pscott:tiger
12257 then you would configure CPAN.pm with the command
12259 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
12261 That's all. Similarly for ncftp or ftp, you would configure something
12264 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
12266 Your mileage may vary...
12274 I installed a new version of module X but CPAN keeps saying,
12275 I have the old version installed
12277 Most probably you B<do> have the old version installed. This can
12278 happen if a module installs itself into a different directory in the
12279 @INC path than it was previously installed. This is not really a
12280 CPAN.pm problem, you would have the same problem when installing the
12281 module manually. The easiest way to prevent this behaviour is to add
12282 the argument C<UNINST=1> to the C<make install> call, and that is why
12283 many people add this argument permanently by configuring
12285 o conf make_install_arg UNINST=1
12289 So why is UNINST=1 not the default?
12291 Because there are people who have their precise expectations about who
12292 may install where in the @INC path and who uses which @INC array. In
12293 fine tuned environments C<UNINST=1> can cause damage.
12297 I want to clean up my mess, and install a new perl along with
12298 all modules I have. How do I go about it?
12300 Run the autobundle command for your old perl and optionally rename the
12301 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
12302 with the Configure option prefix, e.g.
12304 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
12306 Install the bundle file you produced in the first step with something like
12308 cpan> install Bundle::mybundle
12314 When I install bundles or multiple modules with one command
12315 there is too much output to keep track of.
12317 You may want to configure something like
12319 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
12320 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
12322 so that STDOUT is captured in a file for later inspection.
12327 I am not root, how can I install a module in a personal directory?
12329 First of all, you will want to use your own configuration, not the one
12330 that your root user installed. If you do not have permission to write
12331 in the cpan directory that root has configured, you will be asked if
12332 you want to create your own config. Answering "yes" will bring you into
12333 CPAN's configuration stage, using the system config for all defaults except
12334 things that have to do with CPAN's work directory, saving your choices to
12335 your MyConfig.pm file.
12337 You can also manually initiate this process with the following command:
12339 % perl -MCPAN -e 'mkmyconfig'
12345 from the CPAN shell.
12347 You will most probably also want to configure something like this:
12349 o conf makepl_arg "LIB=~/myperl/lib \
12350 INSTALLMAN1DIR=~/myperl/man/man1 \
12351 INSTALLMAN3DIR=~/myperl/man/man3 \
12352 INSTALLSCRIPT=~/myperl/bin \
12353 INSTALLBIN=~/myperl/bin"
12355 and then (oh joy) the equivalent command for Module::Build. That would
12358 o conf mbuildpl_arg "--lib=~/myperl/lib \
12359 --installman1dir=~/myperl/man/man1 \
12360 --installman3dir=~/myperl/man/man3 \
12361 --installscript=~/myperl/bin \
12362 --installbin=~/myperl/bin"
12364 You can make this setting permanent like all C<o conf> settings with
12365 C<o conf commit> or by setting C<auto_commit> beforehand.
12367 You will have to add ~/myperl/man to the MANPATH environment variable
12368 and also tell your perl programs to look into ~/myperl/lib, e.g. by
12371 use lib "$ENV{HOME}/myperl/lib";
12373 or setting the PERL5LIB environment variable.
12375 While we're speaking about $ENV{HOME}, it might be worth mentioning,
12376 that for Windows we use the File::HomeDir module that provides an
12377 equivalent to the concept of the home directory on Unix.
12379 Another thing you should bear in mind is that the UNINST parameter can
12380 be dangerous when you are installing into a private area because you
12381 might accidentally remove modules that other people depend on that are
12382 not using the private area.
12386 How to get a package, unwrap it, and make a change before building it?
12388 Have a look at the C<look> (!) command.
12392 I installed a Bundle and had a couple of fails. When I
12393 retried, everything resolved nicely. Can this be fixed to work
12396 The reason for this is that CPAN does not know the dependencies of all
12397 modules when it starts out. To decide about the additional items to
12398 install, it just uses data found in the META.yml file or the generated
12399 Makefile. An undetected missing piece breaks the process. But it may
12400 well be that your Bundle installs some prerequisite later than some
12401 depending item and thus your second try is able to resolve everything.
12402 Please note, CPAN.pm does not know the dependency tree in advance and
12403 cannot sort the queue of things to install in a topologically correct
12404 order. It resolves perfectly well IF all modules declare the
12405 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
12406 the C<requires> stanza of Module::Build. For bundles which fail and
12407 you need to install often, it is recommended to sort the Bundle
12408 definition file manually.
12412 In our intranet we have many modules for internal use. How
12413 can I integrate these modules with CPAN.pm but without uploading
12414 the modules to CPAN?
12416 Have a look at the CPAN::Site module.
12420 When I run CPAN's shell, I get an error message about things in my
12421 /etc/inputrc (or ~/.inputrc) file.
12423 These are readline issues and can only be fixed by studying readline
12424 configuration on your architecture and adjusting the referenced file
12425 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
12426 and edit them. Quite often harmless changes like uppercasing or
12427 lowercasing some arguments solves the problem.
12431 Some authors have strange characters in their names.
12433 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
12434 expecting ISO-8859-1 charset, a converter can be activated by setting
12435 term_is_latin to a true value in your config file. One way of doing so
12438 cpan> o conf term_is_latin 1
12440 If other charset support is needed, please file a bugreport against
12441 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
12442 the support or maybe UTF-8 terminals become widely available.
12444 Note: this config variable is deprecated and will be removed in a
12445 future version of CPAN.pm. It will be replaced with the conventions
12446 around the family of $LANG and $LC_* environment variables.
12450 When an install fails for some reason and then I correct the error
12451 condition and retry, CPAN.pm refuses to install the module, saying
12452 C<Already tried without success>.
12454 Use the force pragma like so
12456 force install Foo::Bar
12462 and then 'make install' directly in the subshell.
12466 How do I install a "DEVELOPER RELEASE" of a module?
12468 By default, CPAN will install the latest non-developer release of a
12469 module. If you want to install a dev release, you have to specify the
12470 partial path starting with the author id to the tarball you wish to
12473 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
12475 Note that you can use the C<ls> command to get this path listed.
12479 How do I install a module and all its dependencies from the commandline,
12480 without being prompted for anything, despite my CPAN configuration
12483 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
12484 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
12485 asked any questions at all (assuming the modules you are installing are
12486 nice about obeying that variable as well):
12488 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
12492 How do I create a Module::Build based Build.PL derived from an
12493 ExtUtils::MakeMaker focused Makefile.PL?
12495 http://search.cpan.org/search?query=Module::Build::Convert
12497 http://www.refcnt.org/papers/module-build-convert
12501 What's the best CPAN site for me?
12503 The urllist config parameter is yours. You can add and remove sites at
12504 will. You should find out which sites have the best uptodateness,
12505 bandwidth, reliability, etc. and are topologically close to you. Some
12506 people prefer fast downloads, others uptodateness, others reliability.
12507 You decide which to try in which order.
12509 Henk P. Penning maintains a site that collects data about CPAN sites:
12511 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
12515 Why do I get asked the same questions every time I start the shell?
12517 You can make your configuration changes permanent by calling the
12518 command C<o conf commit>. Alternatively set the C<auto_commit>
12519 variable to true by running C<o conf init auto_commit> and answering
12520 the following question with yes.
12524 =head1 COMPATIBILITY
12526 =head2 OLD PERL VERSIONS
12528 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
12529 newer versions. It is getting more and more difficult to get the
12530 minimal prerequisites working on older perls. It is close to
12531 impossible to get the whole Bundle::CPAN working there. If you're in
12532 the position to have only these old versions, be advised that CPAN is
12533 designed to work fine without the Bundle::CPAN installed.
12535 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
12536 compatible with ancient perls and that File::Temp is listed as a
12537 prerequisite but CPAN has reasonable workarounds if it is missing.
12541 This module and its competitor, the CPANPLUS module, are both much
12542 cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
12543 more modular but it was never tried to make it compatible with CPAN.pm.
12545 =head1 SECURITY ADVICE
12547 This software enables you to upgrade software on your computer and so
12548 is inherently dangerous because the newly installed software may
12549 contain bugs and may alter the way your computer works or even make it
12550 unusable. Please consider backing up your data before every upgrade.
12554 Please report bugs via L<http://rt.cpan.org/>
12556 Before submitting a bug, please make sure that the traditional method
12557 of building a Perl module package from a shell by following the
12558 installation instructions of that package still works in your
12563 Andreas Koenig C<< <andk@cpan.org> >>
12567 This program is free software; you can redistribute it and/or
12568 modify it under the same terms as Perl itself.
12570 See L<http://www.perl.com/perl/misc/Artistic.html>
12572 =head1 TRANSLATIONS
12574 Kawai,Takanori provides a Japanese translation of this manpage at
12575 L<http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm>
12579 L<cpan>, L<CPAN::Nox>, L<CPAN::Version>