1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 # vim: ts=4 sts=4 sw=4:
5 $CPAN::VERSION = '1.9301';
6 $CPAN::VERSION =~ s/_//;
8 # we need to run chdir all over and we would get at wrong libraries
12 if (File::Spec->can("rel2abs")) {
14 $inc = File::Spec->rel2abs($inc) unless ref $inc;
18 use CPAN::HandleConfig;
23 use CPAN::DeferedCode;
29 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
30 # 5.005_04 does not work without
32 use File::Basename ();
39 use Sys::Hostname qw(hostname);
40 use Text::ParseWords ();
43 # protect against "called too early"
49 require Mac::BuildTools if $^O eq 'MacOS';
50 if ($ENV{PERL5_CPAN_IS_RUNNING} && $$ != $ENV{PERL5_CPAN_IS_RUNNING}) {
51 $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} ||= $ENV{PERL5_CPAN_IS_RUNNING};
52 my $rec = $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} .= ",$$";
53 my @rec = split /,/, $rec;
54 # warn "# Note: Recursive call of CPAN.pm detected\n";
55 my $w = sprintf "# Note: CPAN.pm is running in process %d now", pop @rec;
61 my $sleep = @rec > 7 ? 300 : ($sleep{scalar @rec}||0);
62 my $verbose = @rec >= 4;
64 $w .= sprintf " which has been called by process %d", pop @rec;
67 $w .= ".\n\n# Sleeping $sleep seconds to protect other processes\n";
74 printf "\r#%5d", --$sleep;
79 $ENV{PERL5_CPAN_IS_RUNNING}=$$;
80 $ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735
82 END { $CPAN::End++; &cleanup; }
85 $CPAN::Frontend ||= "CPAN::Shell";
86 unless (@CPAN::Defaultsites) {
87 @CPAN::Defaultsites = map {
88 CPAN::URL->new(TEXT => $_, FROM => "DEF")
90 "http://www.perl.org/CPAN/",
91 "ftp://ftp.perl.org/pub/CPAN/";
93 # $CPAN::iCwd (i for initial)
94 $CPAN::iCwd ||= CPAN::anycwd();
95 $CPAN::Perl ||= CPAN::find_perl();
96 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
97 $CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf";
98 $CPAN::Defaultrecent ||= "http://cpan.uwinnipeg.ca/htdocs/cpan.xml";
100 # our globals are getting a mess
126 @CPAN::ISA = qw(CPAN::Debug Exporter);
128 # note that these functions live in CPAN::Shell and get executed via
129 # AUTOLOAD when called directly
156 sub soft_chdir_with_alternatives ($);
159 $autoload_recursion ||= 0;
161 #-> sub CPAN::AUTOLOAD ;
163 $autoload_recursion++;
167 warn "Refusing to autoload '$l' while signal pending";
168 $autoload_recursion--;
171 if ($autoload_recursion > 1) {
172 my $fullcommand = join " ", map { "'$_'" } $l, @_;
173 warn "Refusing to autoload $fullcommand in recursion\n";
174 $autoload_recursion--;
178 @export{@EXPORT} = '';
179 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
180 if (exists $export{$l}) {
183 die(qq{Unknown CPAN command "$AUTOLOAD". }.
184 qq{Type ? for help.\n});
186 $autoload_recursion--;
191 my $x = *SAVEOUT; # avoid warning
192 open($x,">&STDOUT") or die "dup failed";
198 while(defined($_=shift)) {
200 my ($m) = s/^>// ? ">" : "";
202 $_=shift unless length;
203 die "no dest" unless defined;
204 open(STDOUT,">$m$_") or die "open:$_:$!\n";
206 } elsif ( s/^\s*\|\s*// ) {
208 while(defined($_[0])){
209 $pipe .= ' ' . shift;
211 open(STDOUT,$pipe) or die "open:$pipe:$!\n";
220 return unless $redir;
222 ## redirect: unredirect and propagate errors. explicit close to wait for pipe.
224 open(STDOUT,">&SAVEOUT");
230 #-> sub CPAN::shell ;
233 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
234 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
236 my $oprompt = shift || CPAN::Prompt->new;
237 my $prompt = $oprompt;
238 my $commandline = shift || "";
239 $CPAN::CurrentCommandId ||= 1;
242 unless ($Suppress_readline) {
243 require Term::ReadLine;
246 $term->ReadLine eq "Term::ReadLine::Stub"
248 $term = Term::ReadLine->new('CPAN Monitor');
250 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
251 my $attribs = $term->Attribs;
252 $attribs->{attempted_completion_function} = sub {
253 &CPAN::Complete::gnu_cpl;
256 $readline::rl_completion_function =
257 $readline::rl_completion_function = 'CPAN::Complete::cpl';
259 if (my $histfile = $CPAN::Config->{'histfile'}) {{
260 unless ($term->can("AddHistory")) {
261 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
264 $META->readhist($term,$histfile);
266 for ($CPAN::Config->{term_ornaments}) { # alias
267 local $Term::ReadLine::termcap_nowarn = 1;
268 $term->ornaments($_) if defined;
270 # $term->OUT is autoflushed anyway
271 my $odef = select STDERR;
279 my @cwd = grep { defined $_ and length $_ }
281 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
282 File::Spec->rootdir();
283 my $try_detect_readline;
284 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
285 unless ($CPAN::Config->{inhibit_startup_message}) {
286 my $rl_avail = $Suppress_readline ? "suppressed" :
287 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
288 "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)";
289 $CPAN::Frontend->myprint(
291 cpan shell -- CPAN exploration and modules installation (v%s)
299 my($continuation) = "";
300 my $last_term_ornaments;
301 SHELLCOMMAND: while () {
302 if ($Suppress_readline) {
303 if ($Echo_readline) {
307 last SHELLCOMMAND unless defined ($_ = <> );
308 if ($Echo_readline) {
309 # backdoor: I could not find a way to record sessions
314 last SHELLCOMMAND unless
315 defined ($_ = $term->readline($prompt, $commandline));
317 $_ = "$continuation$_" if $continuation;
319 next SHELLCOMMAND if /^$/;
321 if (/^(?:q(?:uit)?|bye|exit)$/i) {
332 use vars qw($import_done);
333 CPAN->import(':DEFAULT') unless $import_done++;
334 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
341 eval { @line = Text::ParseWords::shellwords($_) };
342 warn($@), next SHELLCOMMAND if $@;
343 warn("Text::Parsewords could not parse the line [$_]"),
344 next SHELLCOMMAND unless @line;
345 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
346 my $command = shift @line;
348 local (*STDOUT)=*STDOUT;
349 @line = _redirect(@line);
350 CPAN::Shell->$command(@line)
358 my $dv = Dumpvalue->new(tick => '"');
359 Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
369 # pragmas for classic commands
378 # only commands that tell us something about failed distros
379 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
381 soft_chdir_with_alternatives(\@cwd);
382 $CPAN::Frontend->myprint("\n");
384 $CPAN::CurrentCommandId++;
388 $commandline = ""; # I do want to be able to pass a default to
389 # shell, but on the second command I see no
392 CPAN::Queue->nullify_queue;
393 if ($try_detect_readline) {
394 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
396 $CPAN::META->has_inst("Term::ReadLine::Perl")
398 delete $INC{"Term/ReadLine.pm"};
400 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
401 require Term::ReadLine;
402 $CPAN::Frontend->myprint("\n$redef subroutines in ".
403 "Term::ReadLine redefined\n");
407 if ($term and $term->can("ornaments")) {
408 for ($CPAN::Config->{term_ornaments}) { # alias
410 if (not defined $last_term_ornaments
411 or $_ != $last_term_ornaments
413 local $Term::ReadLine::termcap_nowarn = 1;
414 $term->ornaments($_);
415 $last_term_ornaments = $_;
418 undef $last_term_ornaments;
422 for my $class (qw(Module Distribution)) {
423 # again unsafe meta access?
424 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
425 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
426 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
427 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
431 $GOTOSHELL = 0; # not too often
432 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
437 soft_chdir_with_alternatives(\@cwd);
440 #-> CPAN::soft_chdir_with_alternatives ;
441 sub soft_chdir_with_alternatives ($) {
444 my $root = File::Spec->rootdir();
445 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
446 Trying '$root' as temporary haven.
451 if (chdir $cwd->[0]) {
455 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
456 Trying to chdir to "$cwd->[1]" instead.
460 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
468 if ( $Config::Config{d_flock} || $Config::Config{d_fcntl_can_lock} ) {
469 return flock $fh, $mode;
470 } elsif (!$Have_warned->{"d_flock"}++) {
471 $CPAN::Frontend->mywarn("Your OS does not seem to support locking; continuing and ignoring all locking issues\n");
472 $CPAN::Frontend->mysleep(5);
479 sub _yaml_module () {
480 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
482 $yaml_module ne "YAML"
484 !$CPAN::META->has_inst($yaml_module)
486 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
487 $yaml_module = "YAML";
489 if ($yaml_module eq "YAML"
491 $CPAN::META->has_inst($yaml_module)
493 $YAML::VERSION < 0.60
495 !$Have_warned->{"YAML"}++
497 $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n".
498 "I'll continue but problems are *very* likely to happen.\n"
500 $CPAN::Frontend->mysleep(5);
505 # CPAN::_yaml_loadfile
507 my($self,$local_file) = @_;
508 return +[] unless -s $local_file;
509 my $yaml_module = _yaml_module;
510 if ($CPAN::META->has_inst($yaml_module)) {
511 # temporarly enable yaml code deserialisation
513 # 5.6.2 could not do the local() with the reference
514 # so we do it manually instead
515 my $old_loadcode = ${"$yaml_module\::LoadCode"};
516 ${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
519 if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
520 eval { @yaml = $code->($local_file); };
522 # this shall not be done by the frontend
523 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
525 } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
527 open FH, $local_file or die "Could not open '$local_file': $!";
530 eval { @yaml = $code->($ystream); };
532 # this shall not be done by the frontend
533 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
536 ${"$yaml_module\::LoadCode"} = $old_loadcode;
539 # this shall not be done by the frontend
540 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
545 # CPAN::_yaml_dumpfile
547 my($self,$local_file,@what) = @_;
548 my $yaml_module = _yaml_module;
549 if ($CPAN::META->has_inst($yaml_module)) {
551 if (UNIVERSAL::isa($local_file, "FileHandle")) {
552 $code = UNIVERSAL::can($yaml_module, "Dump");
553 eval { print $local_file $code->(@what) };
554 } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
555 eval { $code->($local_file,@what); };
556 } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
558 open FH, ">$local_file" or die "Could not open '$local_file': $!";
559 print FH $code->(@what);
562 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
565 if (UNIVERSAL::isa($local_file, "FileHandle")) {
566 # I think this case does not justify a warning at all
568 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
573 sub _init_sqlite () {
574 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
575 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
576 unless $Have_warned->{"CPAN::SQLite"}++;
579 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
580 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
584 my $negative_cache = {};
585 sub _sqlite_running {
586 if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
587 # need to cache the result, otherwise too slow
588 return $negative_cache->{fact};
590 $negative_cache = {}; # reset
592 my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
593 return $ret if $ret; # fast anyway
594 $negative_cache->{time} = time;
595 return $negative_cache->{fact} = $ret;
599 package CPAN::CacheMgr;
601 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
607 use Fcntl qw(:flock);
608 use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
609 @CPAN::FTP::ISA = qw(CPAN::Debug);
611 package CPAN::LWP::UserAgent;
613 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
614 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
616 package CPAN::Complete;
618 @CPAN::Complete::ISA = qw(CPAN::Debug);
619 # Q: where is the "How do I add a new command" HOWTO?
620 # A: svn diff -r 1048:1049 where andk added the report command
621 @CPAN::Complete::COMMANDS = sort qw(
622 ? ! a b d h i m o q r u
657 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
658 @CPAN::Index::ISA = qw(CPAN::Debug);
661 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
664 package CPAN::InfoObj;
666 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
668 package CPAN::Author;
670 @CPAN::Author::ISA = qw(CPAN::InfoObj);
672 package CPAN::Distribution;
674 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
676 package CPAN::Bundle;
678 @CPAN::Bundle::ISA = qw(CPAN::Module);
680 package CPAN::Module;
682 @CPAN::Module::ISA = qw(CPAN::InfoObj);
684 package CPAN::Exception::RecursiveDependency;
686 use overload '""' => "as_string";
688 # a module sees its distribution (no version)
689 # a distribution sees its prereqs (which are module names) (usually with versions)
690 # a bundle sees its module names and/or its distributions (no version)
695 my (@deps,%seen,$loop_starts_with);
696 DCHAIN: for my $dep (@$deps) {
697 push @deps, {name => $dep, display_as => $dep};
699 $loop_starts_with = $dep;
704 for my $i (0..$#deps) {
705 my $x = $deps[$i]{name};
706 $in_loop ||= $x eq $loop_starts_with;
707 my $xo = CPAN::Shell->expandany($x) or next;
708 if ($xo->isa("CPAN::Module")) {
709 my $have = $xo->inst_version || "N/A";
710 my($want,$d,$want_type);
711 if ($i>0 and $d = $deps[$i-1]{name}) {
712 my $do = CPAN::Shell->expandany($d);
713 $want = $do->{prereq_pm}{requires}{$x};
715 $want_type = "requires: ";
717 $want = $do->{prereq_pm}{build_requires}{$x};
719 $want_type = "build_requires: ";
721 $want_type = "unknown status";
726 $want = $xo->cpan_version;
727 $want_type = "want: ";
729 $deps[$i]{have} = $have;
730 $deps[$i]{want_type} = $want_type;
731 $deps[$i]{want} = $want;
732 $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
733 } elsif ($xo->isa("CPAN::Distribution")) {
734 $deps[$i]{display_as} = $xo->pretty_id;
736 $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
738 $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
740 $xo->store_persistent_state; # otherwise I will not reach
741 # all involved parties for
745 bless { deps => \@deps }, $class;
750 my $ret = "\nRecursive dependency detected:\n ";
751 $ret .= join("\n => ", map {$_->{display_as}} @{$self->{deps}});
752 $ret .= ".\nCannot resolve.\n";
756 package CPAN::Exception::yaml_not_installed;
758 use overload '""' => "as_string";
761 my($class,$module,$file,$during) = @_;
762 bless { module => $module, file => $file, during => $during }, $class;
767 "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
770 package CPAN::Exception::yaml_process_error;
772 use overload '""' => "as_string";
775 my($class,$module,$file,$during,$error) = @_;
776 # my $at = Carp::longmess(""); # XXX find something more beautiful
777 bless { module => $module,
787 if ($self->{during}) {
789 if ($self->{module}) {
790 if ($self->{error}) {
791 return "Alert: While trying to '$self->{during}' YAML file\n".
792 " '$self->{file}'\n".
793 "with '$self->{module}' the following error was encountered:\n".
796 return "Alert: While trying to '$self->{during}' YAML file\n".
797 " '$self->{file}'\n".
798 "with '$self->{module}' some unknown error was encountered\n";
801 return "Alert: While trying to '$self->{during}' YAML file\n".
802 " '$self->{file}'\n".
803 "some unknown error was encountered\n";
806 return "Alert: While trying to '$self->{during}' some YAML file\n".
807 "some unknown error was encountered\n";
810 return "Alert: unknown error encountered\n";
814 package CPAN::Prompt; use overload '""' => "as_string";
815 use vars qw($prompt);
817 $CPAN::CurrentCommandId ||= 0;
823 unless ($CPAN::META->{LOCK}) {
824 $word = "nolock_cpan";
826 if ($CPAN::Config->{commandnumber_in_prompt}) {
827 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
833 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
834 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
835 # planned are things like age or quality
837 my($class,%args) = @_;
849 $self->{TEXT} = $set;
854 package CPAN::Distrostatus;
855 use overload '""' => "as_string",
857 use vars qw($something_has_failed_at);
859 my($class,$arg) = @_;
860 my $failed = substr($arg,0,2) eq "NO";
862 $something_has_failed_at = $CPAN::CurrentCommandId;
867 COMMANDID => $CPAN::CurrentCommandId,
871 sub something_has_just_failed () {
872 defined $something_has_failed_at &&
873 $something_has_failed_at == $CPAN::CurrentCommandId;
875 sub commandid { shift->{COMMANDID} }
876 sub failed { shift->{FAILED} }
880 $self->{TEXT} = $set;
904 "CPAN/Distroprefs.pm",
906 "CPAN/HandleConfig.pm",
909 "CPAN/Reporter/Config.pm",
910 "CPAN/Reporter/History.pm",
911 "CPAN/Reporter/PrereqCheck.pm",
917 # record the initial timestamp for reload.
918 $reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo };
919 @CPAN::Shell::ISA = qw(CPAN::Debug);
921 $COLOR_REGISTERED ||= 0;
924 '!' => "eval the rest of the line as perl",
926 autobundle => "wtite inventory into a bundle file",
927 b => "info about bundle",
929 clean => "clean up a distribution's build directory",
931 d => "info about a distribution",
934 failed => "list all failed actions within current session",
935 fforce => "redo a command from scratch",
936 force => "redo a command",
938 help => "overview over commands; 'help ...' explains specific commands",
939 hosts => "statistics about recently used hosts",
940 i => "info about authors/bundles/distributions/modules",
941 install => "install a distribution",
942 install_tested => "install all distributions tested OK",
943 is_tested => "list all distributions tested OK",
944 look => "open a subshell in a distribution's directory",
945 ls => "list distributions according to a glob",
946 m => "info about a module",
947 make => "make/build a distribution",
948 mkmyconfig => "write current config into a CPAN/MyConfig.pm file",
949 notest => "run a (usually install) command but leave out the test phase",
950 o => "'o conf ...' for config stuff; 'o debug ...' for debugging",
951 perldoc => "try to get a manpage for a module",
953 quit => "leave the cpan shell",
954 r => "review over upgradeable modules",
955 readme => "display the README of a distro woth a pager",
956 recent => "show recent uploads to the CPAN",
958 reload => "'reload cpan' or 'reload index'",
959 report => "test a distribution and send a test report to cpantesters",
960 reports => "info about reported tests from cpantesters",
963 test => "test a distribution",
964 u => "display uninstalled modules",
965 upgrade => "combine 'r' command with immediate installation",
968 $autoload_recursion ||= 0;
970 #-> sub CPAN::Shell::AUTOLOAD ;
972 $autoload_recursion++;
974 my $class = shift(@_);
975 # warn "autoload[$l] class[$class]";
978 warn "Refusing to autoload '$l' while signal pending";
979 $autoload_recursion--;
982 if ($autoload_recursion > 1) {
983 my $fullcommand = join " ", map { "'$_'" } $l, @_;
984 warn "Refusing to autoload $fullcommand in recursion\n";
985 $autoload_recursion--;
989 # XXX needs to be reconsidered
990 if ($CPAN::META->has_inst('CPAN::WAIT')) {
993 $CPAN::Frontend->mywarn(qq{
994 Commands starting with "w" require CPAN::WAIT to be installed.
995 Please consider installing CPAN::WAIT to use the fulltext index.
996 For this you just need to type
1001 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
1005 $autoload_recursion--;
1012 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
1014 # from here on only subs.
1015 ################################################################################
1017 sub _perl_fingerprint {
1018 my($self,$other_fingerprint) = @_;
1019 my $dll = eval {OS2::DLLname()};
1022 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
1024 my $mtime_perl = (-f CPAN::find_perl ? (stat(_))[9] : '-1');
1025 my $this_fingerprint = {
1026 '$^X' => CPAN::find_perl,
1027 sitearchexp => $Config::Config{sitearchexp},
1028 'mtime_$^X' => $mtime_perl,
1029 'mtime_dll' => $mtime_dll,
1031 if ($other_fingerprint) {
1032 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
1033 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
1035 # mandatory keys since 1.88_57
1036 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
1037 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
1041 return $this_fingerprint;
1045 sub suggest_myconfig () {
1046 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
1047 $CPAN::Frontend->myprint("You don't seem to have a user ".
1048 "configuration (MyConfig.pm) yet.\n");
1049 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
1050 "user configuration now? (Y/n)",
1052 if($new =~ m{^y}i) {
1053 CPAN::Shell->mkmyconfig();
1056 $CPAN::Frontend->mydie("OK, giving up.");
1061 #-> sub CPAN::all_objects ;
1063 my($mgr,$class) = @_;
1064 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1065 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
1066 CPAN::Index->reload;
1067 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
1070 # Called by shell, not in batch mode. In batch mode I see no risk in
1071 # having many processes updating something as installations are
1072 # continually checked at runtime. In shell mode I suspect it is
1073 # unintentional to open more than one shell at a time
1075 #-> sub CPAN::checklock ;
1078 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
1079 if (-f $lockfile && -M _ > 0) {
1080 my $fh = FileHandle->new($lockfile) or
1081 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
1082 my $otherpid = <$fh>;
1083 my $otherhost = <$fh>;
1085 if (defined $otherpid && $otherpid) {
1088 if (defined $otherhost && $otherhost) {
1091 my $thishost = hostname();
1092 if (defined $otherhost && defined $thishost &&
1093 $otherhost ne '' && $thishost ne '' &&
1094 $otherhost ne $thishost) {
1095 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
1096 "reports other host $otherhost and other ".
1097 "process $otherpid.\n".
1098 "Cannot proceed.\n"));
1099 } elsif ($RUN_DEGRADED) {
1100 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
1101 } elsif (defined $otherpid && $otherpid) {
1102 return if $$ == $otherpid; # should never happen
1103 $CPAN::Frontend->mywarn(
1105 There seems to be running another CPAN process (pid $otherpid). Contacting...
1107 if (kill 0, $otherpid or $!{EPERM}) {
1108 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
1110 CPAN::Shell::colorable_makemaker_prompt
1111 (qq{Shall I try to run in degraded }.
1112 qq{mode? (Y/n)},"y");
1113 if ($ans =~ /^y/i) {
1114 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
1115 Please report if something unexpected happens\n");
1117 for ($CPAN::Config) {
1119 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
1120 $_->{commandnumber_in_prompt} = 0; # visibility
1121 $_->{histfile} = ""; # who should win otherwise?
1122 $_->{cache_metadata} = 0; # better would be a lock?
1123 $_->{use_sqlite} = 0; # better would be a write lock!
1126 $CPAN::Frontend->mydie("
1127 You may want to kill the other job and delete the lockfile. On UNIX try:
1132 } elsif (-w $lockfile) {
1134 CPAN::Shell::colorable_makemaker_prompt
1135 (qq{Other job not responding. Shall I overwrite }.
1136 qq{the lockfile '$lockfile'? (Y/n)},"y");
1137 $CPAN::Frontend->myexit("Ok, bye\n")
1138 unless $ans =~ /^y/i;
1141 qq{Lockfile '$lockfile' not writeable by you. }.
1142 qq{Cannot proceed.\n}.
1143 qq{ On UNIX try:\n}.
1144 qq{ rm '$lockfile'\n}.
1145 qq{ and then rerun us.\n}
1149 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
1150 "'$lockfile', please remove. Cannot proceed.\n"));
1153 my $dotcpan = $CPAN::Config->{cpan_home};
1154 eval { File::Path::mkpath($dotcpan);};
1156 # A special case at least for Jarkko.
1157 my $firsterror = $@;
1161 $symlinkcpan = readlink $dotcpan;
1162 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
1163 eval { File::Path::mkpath($symlinkcpan); };
1167 $CPAN::Frontend->mywarn(qq{
1168 Working directory $symlinkcpan created.
1172 unless (-d $dotcpan) {
1174 Your configuration suggests "$dotcpan" as your
1175 CPAN.pm working directory. I could not create this directory due
1176 to this error: $firsterror\n};
1178 As "$dotcpan" is a symlink to "$symlinkcpan",
1179 I tried to create that, but I failed with this error: $seconderror
1182 Please make sure the directory exists and is writable.
1184 $CPAN::Frontend->mywarn($mess);
1185 return suggest_myconfig;
1187 } # $@ after eval mkpath $dotcpan
1188 if (0) { # to test what happens when a race condition occurs
1189 for (reverse 1..10) {
1195 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
1197 unless ($fh = FileHandle->new("+>>$lockfile")) {
1198 if ($! =~ /Permission/) {
1199 $CPAN::Frontend->mywarn(qq{
1201 Your configuration suggests that CPAN.pm should use a working
1203 $CPAN::Config->{cpan_home}
1204 Unfortunately we could not create the lock file
1206 due to permission problems.
1208 Please make sure that the configuration variable
1209 \$CPAN::Config->{cpan_home}
1210 points to a directory where you can write a .lock file. You can set
1211 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
1214 return suggest_myconfig;
1218 while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) {
1220 $CPAN::Frontend->mydie("Giving up\n");
1222 $CPAN::Frontend->mysleep($sleep++);
1223 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
1229 $fh->print($$, "\n");
1230 $fh->print(hostname(), "\n");
1231 $self->{LOCK} = $lockfile;
1232 $self->{LOCKFH} = $fh;
1237 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
1242 &cleanup if $Signal;
1243 die "Got yet another signal" if $Signal > 1;
1244 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
1245 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
1249 # From: Larry Wall <larry@wall.org>
1250 # Subject: Re: deprecating SIGDIE
1251 # To: perl5-porters@perl.org
1252 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
1254 # The original intent of __DIE__ was only to allow you to substitute one
1255 # kind of death for another on an application-wide basis without respect
1256 # to whether you were in an eval or not. As a global backstop, it should
1257 # not be used any more lightly (or any more heavily :-) than class
1258 # UNIVERSAL. Any attempt to build a general exception model on it should
1259 # be politely squashed. Any bug that causes every eval {} to have to be
1260 # modified should be not so politely squashed.
1262 # Those are my current opinions. It is also my optinion that polite
1263 # arguments degenerate to personal arguments far too frequently, and that
1264 # when they do, it's because both people wanted it to, or at least didn't
1265 # sufficiently want it not to.
1269 # global backstop to cleanup if we should really die
1270 $SIG{__DIE__} = \&cleanup;
1271 $self->debug("Signal handler set.") if $CPAN::DEBUG;
1274 #-> sub CPAN::DESTROY ;
1276 &cleanup; # need an eval?
1279 #-> sub CPAN::anycwd ;
1282 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
1287 sub cwd {Cwd::cwd();}
1289 #-> sub CPAN::getcwd ;
1290 sub getcwd {Cwd::getcwd();}
1292 #-> sub CPAN::fastcwd ;
1293 sub fastcwd {Cwd::fastcwd();}
1295 #-> sub CPAN::backtickcwd ;
1296 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
1298 #-> sub CPAN::find_perl ;
1300 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
1302 my $candidate = File::Spec->catfile($CPAN::iCwd,$^X);
1303 $^X = $perl = $candidate if MM->maybe_command($candidate);
1306 my ($component,$perl_name);
1307 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
1308 PATH_COMPONENT: foreach $component (File::Spec->path(),
1309 $Config::Config{'binexp'}) {
1310 next unless defined($component) && $component;
1311 my($abs) = File::Spec->catfile($component,$perl_name);
1312 if (MM->maybe_command($abs)) {
1323 #-> sub CPAN::exists ;
1325 my($mgr,$class,$id) = @_;
1326 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1327 CPAN::Index->reload;
1328 ### Carp::croak "exists called without class argument" unless $class;
1330 $id =~ s/:+/::/g if $class eq "CPAN::Module";
1332 if (CPAN::_sqlite_running) {
1333 $exists = (exists $META->{readonly}{$class}{$id} or
1334 $CPAN::SQLite->set($class, $id));
1336 $exists = exists $META->{readonly}{$class}{$id};
1338 $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1341 #-> sub CPAN::delete ;
1343 my($mgr,$class,$id) = @_;
1344 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1345 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1348 #-> sub CPAN::has_usable
1349 # has_inst is sometimes too optimistic, we should replace it with this
1350 # has_usable whenever a case is given
1352 my($self,$mod,$message) = @_;
1353 return 1 if $HAS_USABLE->{$mod};
1354 my $has_inst = $self->has_inst($mod,$message);
1355 return unless $has_inst;
1358 LWP => [ # we frequently had "Can't locate object
1359 # method "new" via package "LWP::UserAgent" at
1360 # (eval 69) line 2006
1362 sub {require LWP::UserAgent},
1363 sub {require HTTP::Request},
1364 sub {require URI::URL},
1367 sub {require Net::FTP},
1368 sub {require Net::Config},
1370 'File::HomeDir' => [
1371 sub {require File::HomeDir;
1372 unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) {
1373 for ("Will not use File::HomeDir, need 0.52\n") {
1374 $CPAN::Frontend->mywarn($_);
1381 sub {require Archive::Tar;
1382 unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.00)) {
1383 for ("Will not use Archive::Tar, need 1.00\n") {
1384 $CPAN::Frontend->mywarn($_);
1391 # XXX we should probably delete from
1392 # %INC too so we can load after we
1393 # installed a new enough version --
1395 sub {require File::Temp;
1396 unless (CPAN::Version->vge(File::Temp::->VERSION,0.16)) {
1397 for ("Will not use File::Temp, need 0.16\n") {
1398 $CPAN::Frontend->mywarn($_);
1405 if ($usable->{$mod}) {
1406 for my $c (0..$#{$usable->{$mod}}) {
1407 my $code = $usable->{$mod}[$c];
1408 my $ret = eval { &$code() };
1409 $ret = "" unless defined $ret;
1411 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1416 return $HAS_USABLE->{$mod} = 1;
1419 #-> sub CPAN::has_inst
1421 my($self,$mod,$message) = @_;
1422 Carp::croak("CPAN->has_inst() called without an argument")
1423 unless defined $mod;
1424 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1425 keys %{$CPAN::Config->{dontload_hash}||{}},
1426 @{$CPAN::Config->{dontload_list}||[]};
1427 if (defined $message && $message eq "no" # afair only used by Nox
1431 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1439 # checking %INC is wrong, because $INC{LWP} may be true
1440 # although $INC{"URI/URL.pm"} may have failed. But as
1441 # I really want to say "bla loaded OK", I have to somehow
1443 ### warn "$file in %INC"; #debug
1445 } elsif (eval { require $file }) {
1446 # eval is good: if we haven't yet read the database it's
1447 # perfect and if we have installed the module in the meantime,
1448 # it tries again. The second require is only a NOOP returning
1449 # 1 if we had success, otherwise it's retrying
1451 my $mtime = (stat $INC{$file})[9];
1452 # privileged files loaded by has_inst; Note: we use $mtime
1453 # as a proxy for a checksum.
1454 $CPAN::Shell::reload->{$file} = $mtime;
1455 my $v = eval "\$$mod\::VERSION";
1456 $v = $v ? " (v$v)" : "";
1457 CPAN::Shell->optprint("load_module","CPAN: $mod loaded ok$v\n");
1458 if ($mod eq "CPAN::WAIT") {
1459 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1462 } elsif ($mod eq "Net::FTP") {
1463 $CPAN::Frontend->mywarn(qq{
1464 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1466 install Bundle::libnet
1468 }) unless $Have_warned->{"Net::FTP"}++;
1469 $CPAN::Frontend->mysleep(3);
1470 } elsif ($mod eq "Digest::SHA") {
1471 if ($Have_warned->{"Digest::SHA"}++) {
1472 $CPAN::Frontend->mywarn(qq{CPAN: checksum security checks disabled }.
1473 qq{because Digest::SHA not installed.\n});
1475 $CPAN::Frontend->mywarn(qq{
1476 CPAN: checksum security checks disabled because Digest::SHA not installed.
1477 Please consider installing the Digest::SHA module.
1480 $CPAN::Frontend->mysleep(2);
1482 } elsif ($mod eq "Module::Signature") {
1483 # NOT prefs_lookup, we are not a distro
1484 my $check_sigs = $CPAN::Config->{check_sigs};
1485 if (not $check_sigs) {
1486 # they do not want us:-(
1487 } elsif (not $Have_warned->{"Module::Signature"}++) {
1488 # No point in complaining unless the user can
1489 # reasonably install and use it.
1490 if (eval { require Crypt::OpenPGP; 1 } ||
1492 defined $CPAN::Config->{'gpg'}
1494 $CPAN::Config->{'gpg'} =~ /\S/
1497 $CPAN::Frontend->mywarn(qq{
1498 CPAN: Module::Signature security checks disabled because Module::Signature
1499 not installed. Please consider installing the Module::Signature module.
1500 You may also need to be able to connect over the Internet to the public
1501 keyservers like pgp.mit.edu (port 11371).
1504 $CPAN::Frontend->mysleep(2);
1508 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1513 #-> sub CPAN::instance ;
1515 my($mgr,$class,$id) = @_;
1516 CPAN::Index->reload;
1518 # unsafe meta access, ok?
1519 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1520 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1528 #-> sub CPAN::cleanup ;
1530 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1531 local $SIG{__DIE__} = '';
1536 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1537 $ineval = 1, last if
1538 $subroutine eq '(eval)';
1540 return if $ineval && !$CPAN::End;
1541 return unless defined $META->{LOCK};
1542 return unless -f $META->{LOCK};
1544 close $META->{LOCKFH};
1545 unlink $META->{LOCK};
1547 # Carp::cluck("DEBUGGING");
1548 if ( $CPAN::CONFIG_DIRTY ) {
1549 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1551 $CPAN::Frontend->myprint("Lockfile removed.\n");
1554 #-> sub CPAN::readhist
1556 my($self,$term,$histfile) = @_;
1557 my $histsize = $CPAN::Config->{'histsize'} || 100;
1558 $term->Attribs->{'MaxHistorySize'} = $histsize if (defined($term->Attribs->{'MaxHistorySize'}));
1559 my($fh) = FileHandle->new;
1560 open $fh, "<$histfile" or return;
1564 $term->AddHistory($_);
1569 #-> sub CPAN::savehist
1572 my($histfile,$histsize);
1573 unless ($histfile = $CPAN::Config->{'histfile'}) {
1574 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1577 $histsize = $CPAN::Config->{'histsize'} || 100;
1579 unless ($CPAN::term->can("GetHistory")) {
1580 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1586 my @h = $CPAN::term->GetHistory;
1587 splice @h, 0, @h-$histsize if @h>$histsize;
1588 my($fh) = FileHandle->new;
1589 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1590 local $\ = local $, = "\n";
1595 #-> sub CPAN::is_tested
1597 my($self,$what,$when) = @_;
1599 Carp::cluck("DEBUG: empty what");
1602 $self->{is_tested}{$what} = $when;
1605 #-> sub CPAN::reset_tested
1606 # forget all distributions tested -- resets what gets included in PERL5LIB
1609 $self->{is_tested} = {};
1612 #-> sub CPAN::is_installed
1613 # unsets the is_tested flag: as soon as the thing is installed, it is
1614 # not needed in set_perl5lib anymore
1616 my($self,$what) = @_;
1617 delete $self->{is_tested}{$what};
1620 sub _list_sorted_descending_is_tested {
1623 { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
1624 keys %{$self->{is_tested}}
1627 #-> sub CPAN::set_perl5lib
1628 # Notes on max environment variable length:
1629 # - Win32 : XP or later, 8191; Win2000 or NT4, 2047
1633 my($self,$for) = @_;
1635 (undef,undef,undef,$for) = caller(1);
1638 $self->{is_tested} ||= {};
1639 return unless %{$self->{is_tested}};
1640 my $env = $ENV{PERL5LIB};
1641 $env = $ENV{PERLLIB} unless defined $env;
1643 push @env, split /\Q$Config::Config{path_sep}\E/, $env if defined $env and length $env;
1644 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1645 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1647 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
1651 $CPAN::Frontend->optprint('perl5lib', "Prepending @dirs to PERL5LIB for '$for'\n");
1652 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1653 } elsif (@dirs < 24 ) {
1654 my @d = map {my $cp = $_;
1655 $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
1658 $CPAN::Frontend->optprint('perl5lib', "Prepending @d to PERL5LIB; ".
1659 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
1662 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1664 my $cnt = keys %{$self->{is_tested}};
1665 $CPAN::Frontend->optprint('perl5lib', "Prepending blib/arch and blib/lib of ".
1666 "$cnt build dirs to PERL5LIB; ".
1669 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1673 package CPAN::CacheMgr;
1676 #-> sub CPAN::CacheMgr::as_string ;
1678 eval { require Data::Dumper };
1680 return shift->SUPER::as_string;
1682 return Data::Dumper::Dumper(shift);
1686 #-> sub CPAN::CacheMgr::cachesize ;
1691 #-> sub CPAN::CacheMgr::tidyup ;
1694 return unless $CPAN::META->{LOCK};
1695 return unless -d $self->{ID};
1696 my @toremove = grep { $self->{SIZE}{$_}==0 } @{$self->{FIFO}};
1697 for my $current (0..$#toremove) {
1698 my $toremove = $toremove[$current];
1699 $CPAN::Frontend->myprint(sprintf(
1700 "DEL(%d/%d): %s \n",
1706 return if $CPAN::Signal;
1707 $self->_clean_cache($toremove);
1708 return if $CPAN::Signal;
1712 #-> sub CPAN::CacheMgr::dir ;
1717 #-> sub CPAN::CacheMgr::entries ;
1719 my($self,$dir) = @_;
1720 return unless defined $dir;
1721 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1722 $dir ||= $self->{ID};
1723 my($cwd) = CPAN::anycwd();
1724 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1725 my $dh = DirHandle->new(File::Spec->curdir)
1726 or Carp::croak("Couldn't opendir $dir: $!");
1729 next if $_ eq "." || $_ eq "..";
1731 push @entries, File::Spec->catfile($dir,$_);
1733 push @entries, File::Spec->catdir($dir,$_);
1735 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1738 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1739 sort { -M $a <=> -M $b} @entries;
1742 #-> sub CPAN::CacheMgr::disk_usage ;
1744 my($self,$dir,$fast) = @_;
1745 return if exists $self->{SIZE}{$dir};
1746 return if $CPAN::Signal;
1751 unless (chmod 0755, $dir) {
1752 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1753 "permission to change the permission; cannot ".
1754 "estimate disk usage of '$dir'\n");
1755 $CPAN::Frontend->mysleep(5);
1760 # nothing to say, no matter what the permissions
1763 $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
1767 $Du = 0; # placeholder
1771 $File::Find::prune++ if $CPAN::Signal;
1773 if ($^O eq 'MacOS') {
1775 my $cat = Mac::Files::FSpGetCatInfo($_);
1776 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1780 unless (chmod 0755, $_) {
1781 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1782 "the permission to change the permission; ".
1783 "can only partially estimate disk usage ".
1785 $CPAN::Frontend->mysleep(5);
1797 return if $CPAN::Signal;
1798 $self->{SIZE}{$dir} = $Du/1024/1024;
1799 unshift @{$self->{FIFO}}, $dir;
1800 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1801 $self->{DU} += $Du/1024/1024;
1805 #-> sub CPAN::CacheMgr::_clean_cache ;
1807 my($self,$dir) = @_;
1808 return unless -e $dir;
1809 unless (File::Spec->canonpath(File::Basename::dirname($dir))
1810 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
1811 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
1812 "will not remove\n");
1813 $CPAN::Frontend->mysleep(5);
1816 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1818 File::Path::rmtree($dir);
1820 if ($dir !~ /\.yml$/ && -f "$dir.yml") {
1821 my $yaml_module = CPAN::_yaml_module;
1822 if ($CPAN::META->has_inst($yaml_module)) {
1823 my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); };
1825 $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)");
1826 unlink "$dir.yml" or
1827 $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)");
1829 } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) {
1830 $CPAN::META->delete("CPAN::Distribution", $id);
1832 # XXX we should restore the state NOW, otherise this
1833 # distro does not exist until we read an index. BUG ALERT(?)
1835 # $CPAN::Frontend->mywarn (" +++\n");
1839 unlink "$dir.yml"; # may fail
1840 unless ($id_deleted) {
1841 CPAN->debug("no distro found associated with '$dir'");
1844 $self->{DU} -= $self->{SIZE}{$dir};
1845 delete $self->{SIZE}{$dir};
1848 #-> sub CPAN::CacheMgr::new ;
1855 ID => $CPAN::Config->{build_dir},
1856 MAX => $CPAN::Config->{'build_cache'},
1857 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1860 File::Path::mkpath($self->{ID});
1861 my $dh = DirHandle->new($self->{ID});
1862 bless $self, $class;
1865 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1867 CPAN->debug($debug) if $CPAN::DEBUG;
1871 #-> sub CPAN::CacheMgr::scan_cache ;
1874 return if $self->{SCAN} eq 'never';
1875 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1876 unless $self->{SCAN} eq 'atstart';
1877 return unless $CPAN::META->{LOCK};
1878 $CPAN::Frontend->myprint(
1879 sprintf("Scanning cache %s for sizes\n",
1882 my @entries = $self->entries($self->{ID});
1887 if ($self->{DU} > $self->{MAX}) {
1889 $self->disk_usage($e,1);
1891 $self->disk_usage($e);
1894 while (($painted/76) < ($i/@entries)) {
1895 $CPAN::Frontend->myprint($symbol);
1898 return if $CPAN::Signal;
1900 $CPAN::Frontend->myprint("DONE\n");
1904 package CPAN::Shell;
1907 #-> sub CPAN::Shell::h ;
1909 my($class,$about) = @_;
1910 if (defined $about) {
1912 if (exists $Help->{$about}) {
1913 if (ref $Help->{$about}) { # aliases
1914 $about = ${$Help->{$about}};
1916 $help = $Help->{$about};
1918 $help = "No help available";
1920 $CPAN::Frontend->myprint("$about\: $help\n");
1922 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1923 $CPAN::Frontend->myprint(qq{
1924 Display Information $filler (ver $CPAN::VERSION)
1925 command argument description
1926 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1927 i WORD or /REGEXP/ about any of the above
1928 ls AUTHOR or GLOB about files in the author's directory
1929 (with WORD being a module, bundle or author name or a distribution
1930 name of the form AUTHOR/DISTRIBUTION)
1932 Download, Test, Make, Install...
1933 get download clean make clean
1934 make make (implies get) look open subshell in dist directory
1935 test make test (implies make) readme display these README files
1936 install make install (implies test) perldoc display POD documentation
1939 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1940 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1943 force CMD try hard to do command fforce CMD try harder
1944 notest CMD skip testing
1947 h,? display this menu ! perl-code eval a perl command
1948 o conf [opt] set and query options q quit the cpan shell
1949 reload cpan load CPAN.pm again reload index load newer indices
1950 autobundle Snapshot recent latest CPAN uploads});
1956 #-> sub CPAN::Shell::a ;
1958 my($self,@arg) = @_;
1959 # authors are always UPPERCASE
1961 $_ = uc $_ unless /=/;
1963 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1966 #-> sub CPAN::Shell::globls ;
1968 my($self,$s,$pragmas) = @_;
1969 # ls is really very different, but we had it once as an ordinary
1970 # command in the Shell (upto rev. 321) and we could not handle
1972 my(@accept,@preexpand);
1973 if ($s =~ /[\*\?\/]/) {
1974 if ($CPAN::META->has_inst("Text::Glob")) {
1975 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1976 my $rau = Text::Glob::glob_to_regex(uc $au);
1977 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1979 push @preexpand, map { $_->id . "/" . $pathglob }
1980 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1982 my $rau = Text::Glob::glob_to_regex(uc $s);
1983 push @preexpand, map { $_->id }
1984 CPAN::Shell->expand_by_method('CPAN::Author',
1989 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1992 push @preexpand, uc $s;
1995 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1996 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
2001 my $silent = @accept>1;
2002 my $last_alpha = "";
2004 for my $a (@accept) {
2005 my($author,$pathglob);
2006 if ($a =~ m|(.*?)/(.*)|) {
2009 $author = CPAN::Shell->expand_by_method('CPAN::Author',
2012 or $CPAN::Frontend->mydie("No author found for $a2\n");
2014 $author = CPAN::Shell->expand_by_method('CPAN::Author',
2017 or $CPAN::Frontend->mydie("No author found for $a\n");
2020 my $alpha = substr $author->id, 0, 1;
2022 if ($alpha eq $last_alpha) {
2026 $last_alpha = $alpha;
2028 $CPAN::Frontend->myprint($ad);
2030 for my $pragma (@$pragmas) {
2031 if ($author->can($pragma)) {
2035 push @results, $author->ls($pathglob,$silent); # silent if
2038 for my $pragma (@$pragmas) {
2039 my $unpragma = "un$pragma";
2040 if ($author->can($unpragma)) {
2041 $author->$unpragma();
2048 #-> sub CPAN::Shell::local_bundles ;
2050 my($self,@which) = @_;
2051 my($incdir,$bdir,$dh);
2052 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
2053 my @bbase = "Bundle";
2054 while (my $bbase = shift @bbase) {
2055 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
2056 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
2057 if ($dh = DirHandle->new($bdir)) { # may fail
2059 for $entry ($dh->read) {
2060 next if $entry =~ /^\./;
2061 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
2062 if (-d File::Spec->catdir($bdir,$entry)) {
2063 push @bbase, "$bbase\::$entry";
2065 next unless $entry =~ s/\.pm(?!\n)\Z//;
2066 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
2074 #-> sub CPAN::Shell::b ;
2076 my($self,@which) = @_;
2077 CPAN->debug("which[@which]") if $CPAN::DEBUG;
2078 $self->local_bundles;
2079 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
2082 #-> sub CPAN::Shell::d ;
2083 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
2085 #-> sub CPAN::Shell::m ;
2086 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
2088 $CPAN::Frontend->myprint($self->format_result('Module',@_));
2091 #-> sub CPAN::Shell::i ;
2095 @args = '/./' unless @args;
2097 for my $type (qw/Bundle Distribution Module/) {
2098 push @result, $self->expand($type,@args);
2100 # Authors are always uppercase.
2101 push @result, $self->expand("Author", map { uc $_ } @args);
2103 my $result = @result == 1 ?
2104 $result[0]->as_string :
2106 "No objects found of any type for argument @args\n" :
2108 (map {$_->as_glimpse} @result),
2109 scalar @result, " items found\n",
2111 $CPAN::Frontend->myprint($result);
2114 #-> sub CPAN::Shell::o ;
2116 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
2117 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
2118 # probably have been called 'set' and 'o debug' maybe 'set debug' or
2119 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
2121 my($self,$o_type,@o_what) = @_;
2123 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
2124 if ($o_type eq 'conf') {
2126 ($cfilter) = $o_what[0] =~ m|^/(.*)/$| if @o_what;
2127 if (!@o_what or $cfilter) { # print all things, "o conf"
2129 my $qrfilter = eval 'qr/$cfilter/';
2131 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
2133 if (exists $INC{'CPAN/Config.pm'}) {
2134 push @from, $INC{'CPAN/Config.pm'};
2136 if (exists $INC{'CPAN/MyConfig.pm'}) {
2137 push @from, $INC{'CPAN/MyConfig.pm'};
2139 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
2140 $CPAN::Frontend->myprint(":\n");
2141 for $k (sort keys %CPAN::HandleConfig::can) {
2142 next unless $k =~ /$qrfilter/;
2143 $v = $CPAN::HandleConfig::can{$k};
2144 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
2146 $CPAN::Frontend->myprint("\n");
2147 for $k (sort keys %CPAN::HandleConfig::keys) {
2148 next unless $k =~ /$qrfilter/;
2149 CPAN::HandleConfig->prettyprint($k);
2151 $CPAN::Frontend->myprint("\n");
2153 if (CPAN::HandleConfig->edit(@o_what)) {
2155 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
2159 } elsif ($o_type eq 'debug') {
2161 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
2164 my($what) = shift @o_what;
2165 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
2166 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
2169 if ( exists $CPAN::DEBUG{$what} ) {
2170 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
2171 } elsif ($what =~ /^\d/) {
2172 $CPAN::DEBUG = $what;
2173 } elsif (lc $what eq 'all') {
2175 for (values %CPAN::DEBUG) {
2178 $CPAN::DEBUG = $max;
2181 for (keys %CPAN::DEBUG) {
2182 next unless lc($_) eq lc($what);
2183 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
2186 $CPAN::Frontend->myprint("unknown argument [$what]\n")
2191 my $raw = "Valid options for debug are ".
2192 join(", ",sort(keys %CPAN::DEBUG), 'all').
2193 qq{ or a number. Completion works on the options. }.
2194 qq{Case is ignored.};
2196 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
2197 $CPAN::Frontend->myprint("\n\n");
2200 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
2202 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
2203 $v = $CPAN::DEBUG{$k};
2204 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
2205 if $v & $CPAN::DEBUG;
2208 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
2211 $CPAN::Frontend->myprint(qq{
2213 conf set or get configuration variables
2214 debug set or get debugging options
2219 # CPAN::Shell::paintdots_onreload
2220 sub paintdots_onreload {
2223 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
2227 # $CPAN::Frontend->myprint(".($subr)");
2228 $CPAN::Frontend->myprint(".");
2229 if ($subr =~ /\bshell\b/i) {
2230 # warn "debug[$_[0]]";
2232 # It would be nice if we could detect that a
2233 # subroutine has actually changed, but for now we
2234 # practically always set the GOTOSHELL global
2244 #-> sub CPAN::Shell::hosts ;
2247 my $fullstats = CPAN::FTP->_ftp_statistics();
2248 my $history = $fullstats->{history} || [];
2250 while (my $last = pop @$history) {
2251 my $attempts = $last->{attempts} or next;
2254 $start = $attempts->[-1]{start};
2255 if ($#$attempts > 0) {
2256 for my $i (0..$#$attempts-1) {
2257 my $url = $attempts->[$i]{url} or next;
2262 $start = $last->{start};
2264 next unless $last->{thesiteurl}; # C-C? bad filenames?
2266 $S{end} ||= $last->{end};
2267 my $dltime = $last->{end} - $start;
2268 my $dlsize = $last->{filesize} || 0;
2269 my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
2270 my $s = $S{ok}{$url} ||= {};
2273 $s->{dlsize} += $dlsize/1024;
2275 $s->{dltime} += $dltime;
2278 for my $url (keys %{$S{ok}}) {
2279 next if $S{ok}{$url}{dltime} == 0; # div by zero
2280 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
2281 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
2285 for my $url (keys %{$S{no}}) {
2286 push @{$res->{no}}, [$S{no}{$url},
2290 my $R = ""; # report
2291 if ($S{start} && $S{end}) {
2292 $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
2293 $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown";
2295 if ($res->{ok} && @{$res->{ok}}) {
2296 $R .= sprintf "\nSuccessful downloads:
2297 N kB secs kB/s url\n";
2299 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
2300 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
2304 if ($res->{no} && @{$res->{no}}) {
2305 $R .= sprintf "\nUnsuccessful downloads:\n";
2307 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
2308 $R .= sprintf "%4d %s\n", @$_;
2312 $CPAN::Frontend->myprint($R);
2315 # here is where 'reload cpan' is done
2316 #-> sub CPAN::Shell::reload ;
2318 my($self,$command,@arg) = @_;
2320 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
2321 if ($command =~ /^cpan$/i) {
2323 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
2325 MFILE: for my $f (@relo) {
2326 next unless exists $INC{$f};
2330 $CPAN::Frontend->myprint("($p");
2331 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
2332 $self->_reload_this($f) or $failed++;
2333 my $v = eval "$p\::->VERSION";
2334 $CPAN::Frontend->myprint("v$v)");
2336 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
2338 my $errors = $failed == 1 ? "error" : "errors";
2339 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
2342 } elsif ($command =~ /^index$/i) {
2343 CPAN::Index->force_reload;
2345 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
2346 index re-reads the index files\n});
2350 # reload means only load again what we have loaded before
2351 #-> sub CPAN::Shell::_reload_this ;
2353 my($self,$f,$args) = @_;
2354 CPAN->debug("f[$f]") if $CPAN::DEBUG;
2355 return 1 unless $INC{$f}; # we never loaded this, so we do not
2357 my $pwd = CPAN::anycwd();
2358 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
2360 for my $inc (@INC) {
2361 $file = File::Spec->catfile($inc,split /\//, $f);
2365 CPAN->debug("file[$file]") if $CPAN::DEBUG;
2367 unless ($file && -f $file) {
2368 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
2370 unless (CPAN->has_inst("File::Basename")) {
2371 @inc = File::Basename::dirname($file);
2373 # do we ever need this?
2374 @inc = substr($file,0,-length($f)-1); # bring in back to me!
2377 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
2379 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
2382 my $mtime = (stat $file)[9];
2383 $reload->{$f} ||= -1;
2384 my $must_reload = $mtime != $reload->{$f};
2386 $must_reload ||= $args->{reloforce}; # o conf defaults needs this
2388 my $fh = FileHandle->new($file) or
2389 $CPAN::Frontend->mydie("Could not open $file: $!");
2392 my $content = <$fh>;
2393 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
2397 eval "require '$f'";
2402 $reload->{$f} = $mtime;
2404 $CPAN::Frontend->myprint("__unchanged__");
2409 #-> sub CPAN::Shell::mkmyconfig ;
2411 my($self, $cpanpm, %args) = @_;
2412 require CPAN::FirstTime;
2413 my $home = CPAN::HandleConfig::home;
2414 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
2415 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
2416 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
2417 CPAN::HandleConfig::require_myconfig_or_config;
2418 $CPAN::Config ||= {};
2423 keep_source_where => undef,
2426 CPAN::FirstTime::init($cpanpm, %args);
2429 #-> sub CPAN::Shell::_binary_extensions ;
2430 sub _binary_extensions {
2431 my($self) = shift @_;
2432 my(@result,$module,%seen,%need,$headerdone);
2433 for $module ($self->expand('Module','/./')) {
2434 my $file = $module->cpan_file;
2435 next if $file eq "N/A";
2436 next if $file =~ /^Contact Author/;
2437 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
2438 next if $dist->isa_perl;
2439 next unless $module->xs_file;
2441 $CPAN::Frontend->myprint(".");
2442 push @result, $module;
2444 # print join " | ", @result;
2445 $CPAN::Frontend->myprint("\n");
2449 #-> sub CPAN::Shell::recompile ;
2451 my($self) = shift @_;
2452 my($module,@module,$cpan_file,%dist);
2453 @module = $self->_binary_extensions();
2454 for $module (@module) { # we force now and compile later, so we
2456 $cpan_file = $module->cpan_file;
2457 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2459 $dist{$cpan_file}++;
2461 for $cpan_file (sort keys %dist) {
2462 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
2463 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2465 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
2466 # stop a package from recompiling,
2467 # e.g. IO-1.12 when we have perl5.003_10
2471 #-> sub CPAN::Shell::scripts ;
2473 my($self, $arg) = @_;
2474 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
2476 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
2477 unless ($CPAN::META->has_inst($req)) {
2478 $CPAN::Frontend->mywarn(" $req not available\n");
2481 my $p = HTML::LinkExtor->new();
2482 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
2483 unless (-f $indexfile) {
2484 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
2486 $p->parse_file($indexfile);
2489 if ($arg =~ s|^/(.+)/$|$1|) {
2490 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
2492 for my $l ($p->links) {
2493 my $tag = shift @$l;
2494 next unless $tag eq "a";
2496 my $href = $att{href};
2497 next unless $href =~ s|^\.\./authors/id/./../||;
2500 if ($href =~ $qrarg) {
2504 if ($href =~ /\Q$arg\E/) {
2512 # now filter for the latest version if there is more than one of a name
2518 $stems{$stem} ||= [];
2519 push @{$stems{$stem}}, $href;
2521 for (sort keys %stems) {
2523 if (@{$stems{$_}} > 1) {
2524 $highest = List::Util::reduce {
2525 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
2528 $highest = $stems{$_}[0];
2530 $CPAN::Frontend->myprint("$highest\n");
2534 #-> sub CPAN::Shell::report ;
2536 my($self,@args) = @_;
2537 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2538 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2540 local $CPAN::Config->{test_report} = 1;
2541 $self->force("test",@args); # force is there so that the test be
2542 # re-run (as documented)
2545 # compare with is_tested
2546 #-> sub CPAN::Shell::install_tested
2547 sub install_tested {
2548 my($self,@some) = @_;
2549 $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
2551 CPAN::Index->reload;
2553 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2554 my $yaml = "$b.yml";
2556 $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
2559 my $yaml_content = CPAN->_yaml_loadfile($yaml);
2560 my $id = $yaml_content->[0]{distribution}{ID};
2562 $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
2565 my $do = CPAN::Shell->expandany($id);
2567 $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
2570 unless ($do->{build_dir}) {
2571 $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
2574 unless ($do->{build_dir} eq $b) {
2575 $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
2581 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2582 return unless @some;
2584 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2585 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2586 return unless @some;
2588 # @some = grep { not $_->uptodate } @some;
2589 # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2590 # return unless @some;
2592 CPAN->debug("some[@some]");
2594 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2595 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2596 $CPAN::Frontend->mysleep(1);
2601 #-> sub CPAN::Shell::upgrade ;
2603 my($self,@args) = @_;
2604 $self->install($self->r(@args));
2607 #-> sub CPAN::Shell::_u_r_common ;
2609 my($self) = shift @_;
2610 my($what) = shift @_;
2611 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2612 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2613 $what && $what =~ /^[aru]$/;
2615 @args = '/./' unless @args;
2616 my(@result,$module,%seen,%need,$headerdone,
2617 $version_undefs,$version_zeroes,
2618 @version_undefs,@version_zeroes);
2619 $version_undefs = $version_zeroes = 0;
2620 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2621 my @expand = $self->expand('Module',@args);
2622 if ($CPAN::DEBUG) { # Looks like noise to me, was very useful for debugging
2623 # for metadata cache
2624 my $expand = scalar @expand;
2625 $CPAN::Frontend->myprint(sprintf "%d matches in the database, time[%d]\n", $expand, time);
2629 # hard to believe that the more complex sorting can lead to
2630 # stack curruptions on older perl
2631 @sexpand = sort {$a->id cmp $b->id} @expand;
2638 $a->[1]{ID} cmp $b->[1]{ID},
2640 [$_->_is_representative_module,
2646 $CPAN::Frontend->myprint(sprintf "sorted at time[%d]\n", time);
2649 MODULE: for $module (@sexpand) {
2650 my $file = $module->cpan_file;
2651 next MODULE unless defined $file; # ??
2652 $file =~ s!^./../!!;
2653 my($latest) = $module->cpan_version;
2654 my($inst_file) = $module->inst_file;
2655 CPAN->debug("file[$file]latest[$latest]") if $CPAN::DEBUG;
2657 return if $CPAN::Signal;
2659 eval { # version.pm involved!
2662 $have = $module->inst_version;
2663 } elsif ($what eq "r") {
2664 $have = $module->inst_version;
2666 if ($have eq "undef") {
2668 push @version_undefs, $module->as_glimpse;
2669 } elsif (CPAN::Version->vcmp($have,0)==0) {
2671 push @version_zeroes, $module->as_glimpse;
2673 ++$next_MODULE unless CPAN::Version->vgt($latest, $have);
2674 # to be pedantic we should probably say:
2675 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2676 # to catch the case where CPAN has a version 0 and we have a version undef
2677 } elsif ($what eq "u") {
2683 } elsif ($what eq "r") {
2685 } elsif ($what eq "u") {
2690 next MODULE if $next_MODULE;
2692 $CPAN::Frontend->mywarn
2693 (sprintf("Error while comparing cpan/installed versions of '%s':
2700 (defined $have ? $have : "[UNDEFINED]"),
2701 (ref $have ? ref $have : ""),
2703 (ref $latest ? ref $latest : ""),
2707 return if $CPAN::Signal; # this is sometimes lengthy
2710 push @result, sprintf "%s %s\n", $module->id, $have;
2711 } elsif ($what eq "r") {
2712 push @result, $module->id;
2713 next MODULE if $seen{$file}++;
2714 } elsif ($what eq "u") {
2715 push @result, $module->id;
2716 next MODULE if $seen{$file}++;
2717 next MODULE if $file =~ /^Contact/;
2719 unless ($headerdone++) {
2720 $CPAN::Frontend->myprint("\n");
2721 $CPAN::Frontend->myprint(sprintf(
2724 "Package namespace",
2736 $CPAN::META->has_inst("Term::ANSIColor")
2738 $module->description
2740 $color_on = Term::ANSIColor::color("green");
2741 $color_off = Term::ANSIColor::color("reset");
2743 $CPAN::Frontend->myprint(sprintf $sprintf,
2750 $need{$module->id}++;
2754 $CPAN::Frontend->myprint("No modules found for @args\n");
2755 } elsif ($what eq "r") {
2756 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2760 if ($version_zeroes) {
2761 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2762 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2763 qq{a version number of 0\n});
2764 if ($CPAN::Config->{show_zero_versions}) {
2766 $CPAN::Frontend->myprint(qq{ they are\n\t@version_zeroes\n});
2767 $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 0' }.
2768 qq{to hide them)\n});
2770 $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 1' }.
2771 qq{to show them)\n});
2774 if ($version_undefs) {
2775 my $s_has = $version_undefs > 1 ? "s have" : " has";
2776 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2777 qq{parseable version number\n});
2778 if ($CPAN::Config->{show_unparsable_versions}) {
2780 $CPAN::Frontend->myprint(qq{ they are\n\t@version_undefs\n});
2781 $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 0' }.
2782 qq{to hide them)\n});
2784 $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 1' }.
2785 qq{to show them)\n});
2792 #-> sub CPAN::Shell::r ;
2794 shift->_u_r_common("r",@_);
2797 #-> sub CPAN::Shell::u ;
2799 shift->_u_r_common("u",@_);
2802 #-> sub CPAN::Shell::failed ;
2804 my($self,$only_id,$silent) = @_;
2806 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2808 NAY: for my $nosayer ( # order matters!
2817 next unless exists $d->{$nosayer};
2818 next unless defined $d->{$nosayer};
2820 UNIVERSAL::can($d->{$nosayer},"failed") ?
2821 $d->{$nosayer}->failed :
2822 $d->{$nosayer} =~ /^NO/
2824 next NAY if $only_id && $only_id != (
2825 UNIVERSAL::can($d->{$nosayer},"commandid")
2827 $d->{$nosayer}->commandid
2829 $CPAN::CurrentCommandId
2834 next DIST unless $failed;
2838 # " %-45s: %s %s\n",
2841 UNIVERSAL::can($d->{$failed},"failed") ?
2843 $d->{$failed}->commandid,
2846 $d->{$failed}->text,
2847 $d->{$failed}{TIME}||0,
2860 $scope = "this command";
2861 } elsif ($CPAN::Index::HAVE_REANIMATED) {
2862 $scope = "this or a previous session";
2863 # it might be nice to have a section for previous session and
2866 $scope = "this session";
2873 map { sprintf "%5d %-45s: %s %s\n", @$_ }
2874 sort { $a->[0] <=> $b->[0] } @failed;
2877 map { sprintf " %-45s: %s %s\n", @$_[1..3] }
2884 $CPAN::Frontend->myprint("Failed during $scope:\n$print");
2885 } elsif (!$only_id || !$silent) {
2886 $CPAN::Frontend->myprint("Nothing failed in $scope\n");
2890 # XXX intentionally undocumented because completely bogus, unportable,
2893 #-> sub CPAN::Shell::status ;
2896 require Devel::Size;
2897 my $ps = FileHandle->new;
2898 open $ps, "/proc/$$/status";
2901 next unless /VmSize:\s+(\d+)/;
2905 $CPAN::Frontend->mywarn(sprintf(
2906 "%-27s %6d\n%-27s %6d\n",
2910 Devel::Size::total_size($CPAN::META)/1024,
2912 for my $k (sort keys %$CPAN::META) {
2913 next unless substr($k,0,4) eq "read";
2914 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2915 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2916 warn sprintf " %-25s %6d (keys: %6d)\n",
2918 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2919 scalar keys %{$CPAN::META->{$k}{$k2}};
2924 # compare with install_tested
2925 #-> sub CPAN::Shell::is_tested
2928 CPAN::Index->reload;
2929 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2931 if ($CPAN::META->{is_tested}{$b}) {
2932 $time = scalar(localtime $CPAN::META->{is_tested}{$b});
2934 $time = scalar localtime;
2937 $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
2941 #-> sub CPAN::Shell::autobundle ;
2944 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2945 my(@bundle) = $self->_u_r_common("a",@_);
2946 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2947 File::Path::mkpath($todir);
2948 unless (-d $todir) {
2949 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2952 my($y,$m,$d) = (localtime)[5,4,3];
2956 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2957 my($to) = File::Spec->catfile($todir,"$me.pm");
2959 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2960 $to = File::Spec->catfile($todir,"$me.pm");
2962 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2964 "package Bundle::$me;\n\n",
2965 "\$VERSION = '0.01';\n\n",
2969 "Bundle::$me - Snapshot of installation on ",
2970 $Config::Config{'myhostname'},
2973 "\n\n=head1 SYNOPSIS\n\n",
2974 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2975 "=head1 CONTENTS\n\n",
2976 join("\n", @bundle),
2977 "\n\n=head1 CONFIGURATION\n\n",
2979 "\n\n=head1 AUTHOR\n\n",
2980 "This Bundle has been generated automatically ",
2981 "by the autobundle routine in CPAN.pm.\n",
2984 $CPAN::Frontend->myprint("\nWrote bundle file
2988 #-> sub CPAN::Shell::expandany ;
2991 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2992 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2993 $s = CPAN::Distribution->normalize($s);
2994 return $CPAN::META->instance('CPAN::Distribution',$s);
2995 # Distributions spring into existence, not expand
2996 } elsif ($s =~ m|^Bundle::|) {
2997 $self->local_bundles; # scanning so late for bundles seems
2998 # both attractive and crumpy: always
2999 # current state but easy to forget
3001 return $self->expand('Bundle',$s);
3003 return $self->expand('Module',$s)
3004 if $CPAN::META->exists('CPAN::Module',$s);
3009 #-> sub CPAN::Shell::expand ;
3012 my($type,@args) = @_;
3013 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
3014 my $class = "CPAN::$type";
3015 my $methods = ['id'];
3016 for my $meth (qw(name)) {
3017 next unless $class->can($meth);
3018 push @$methods, $meth;
3020 $self->expand_by_method($class,$methods,@args);
3023 #-> sub CPAN::Shell::expand_by_method ;
3024 sub expand_by_method {
3026 my($class,$methods,@args) = @_;
3029 my($regex,$command);
3030 if ($arg =~ m|^/(.*)/$|) {
3032 # FIXME: there seem to be some ='s in the author data, which trigger
3033 # a failure here. This needs to be contemplated.
3034 # } elsif ($arg =~ m/=/) {
3038 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
3040 defined $regex ? $regex : "UNDEFINED",
3041 defined $command ? $command : "UNDEFINED",
3043 if (defined $regex) {
3044 if (CPAN::_sqlite_running) {
3045 CPAN::Index->reload;
3046 $CPAN::SQLite->search($class, $regex);
3049 $CPAN::META->all_objects($class)
3051 unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id) {
3052 # BUG, we got an empty object somewhere
3053 require Data::Dumper;
3054 CPAN->debug(sprintf(
3055 "Bug in CPAN: Empty id on obj[%s][%s]",
3057 Data::Dumper::Dumper($obj)
3061 for my $method (@$methods) {
3062 my $match = eval {$obj->$method() =~ /$regex/i};
3064 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
3065 $err ||= $@; # if we were too restrictive above
3066 $CPAN::Frontend->mydie("$err\n");
3073 } elsif ($command) {
3074 die "equal sign in command disabled (immature interface), ".
3076 ! \$CPAN::Shell::ADVANCED_QUERY=1
3077 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
3078 that may go away anytime.\n"
3079 unless $ADVANCED_QUERY;
3080 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
3081 my($matchcrit) = $criterion =~ m/^~(.+)/;
3085 $CPAN::META->all_objects($class)
3087 my $lhs = $self->$method() or next; # () for 5.00503
3089 push @m, $self if $lhs =~ m/$matchcrit/;
3091 push @m, $self if $lhs eq $criterion;
3096 if ( $class eq 'CPAN::Bundle' ) {
3097 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
3098 } elsif ($class eq "CPAN::Distribution") {
3099 $xarg = CPAN::Distribution->normalize($arg);
3103 if ($CPAN::META->exists($class,$xarg)) {
3104 $obj = $CPAN::META->instance($class,$xarg);
3105 } elsif ($CPAN::META->exists($class,$arg)) {
3106 $obj = $CPAN::META->instance($class,$arg);
3113 @m = sort {$a->id cmp $b->id} @m;
3114 if ( $CPAN::DEBUG ) {
3115 my $wantarray = wantarray;
3116 my $join_m = join ",", map {$_->id} @m;
3117 # $self->debug("wantarray[$wantarray]join_m[$join_m]");
3118 my $count = scalar @m;
3119 $self->debug("class[$class]wantarray[$wantarray]count m[$count]");
3121 return wantarray ? @m : $m[0];
3124 #-> sub CPAN::Shell::format_result ;
3127 my($type,@args) = @_;
3128 @args = '/./' unless @args;
3129 my(@result) = $self->expand($type,@args);
3130 my $result = @result == 1 ?
3131 $result[0]->as_string :
3133 "No objects of type $type found for argument @args\n" :
3135 (map {$_->as_glimpse} @result),
3136 scalar @result, " items found\n",
3141 #-> sub CPAN::Shell::report_fh ;
3143 my $installation_report_fh;
3144 my $previously_noticed = 0;
3147 return $installation_report_fh if $installation_report_fh;
3148 if ($CPAN::META->has_usable("File::Temp")) {
3149 $installation_report_fh
3151 dir => File::Spec->tmpdir,
3152 template => 'cpan_install_XXXX',
3157 unless ( $installation_report_fh ) {
3158 warn("Couldn't open installation report file; " .
3159 "no report file will be generated."
3160 ) unless $previously_noticed++;
3166 # The only reason for this method is currently to have a reliable
3167 # debugging utility that reveals which output is going through which
3168 # channel. No, I don't like the colors ;-)
3170 # to turn colordebugging on, write
3171 # cpan> o conf colorize_output 1
3173 #-> sub CPAN::Shell::colorize_output ;
3175 my $print_ornamented_have_warned = 0;
3176 sub colorize_output {
3177 my $colorize_output = $CPAN::Config->{colorize_output};
3178 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
3179 unless ($print_ornamented_have_warned++) {
3180 # no myprint/mywarn within myprint/mywarn!
3181 warn "Colorize_output is set to true but Term::ANSIColor is not
3182 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
3184 $colorize_output = 0;
3186 return $colorize_output;
3191 #-> sub CPAN::Shell::print_ornamented ;
3192 sub print_ornamented {
3193 my($self,$what,$ornament) = @_;
3194 return unless defined $what;
3196 local $| = 1; # Flush immediately
3197 if ( $CPAN::Be_Silent ) {
3198 print {report_fh()} $what;
3201 my $swhat = "$what"; # stringify if it is an object
3202 if ($CPAN::Config->{term_is_latin}) {
3203 # note: deprecated, need to switch to $LANG and $LC_*
3206 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
3208 if ($self->colorize_output) {
3209 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
3210 # if you want to have this configurable, please file a bugreport
3211 $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
3213 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
3215 print "Term::ANSIColor rejects color[$ornament]: $@\n
3216 Please choose a different color (Hint: try 'o conf init /color/')\n";
3218 # GGOLDBACH/Test-GreaterVersion-0.008 broke without this
3219 # $trailer construct. We want the newline be the last thing if
3220 # there is a newline at the end ensuring that the next line is
3221 # empty for other players
3223 $trailer = $1 if $swhat =~ s/([\r\n]+)\z//;
3226 Term::ANSIColor::color("reset"),
3233 #-> sub CPAN::Shell::myprint ;
3235 # where is myprint/mywarn/Frontend/etc. documented? Where to use what?
3236 # I think, we send everything to STDOUT and use print for normal/good
3237 # news and warn for news that need more attention. Yes, this is our
3238 # working contract for now.
3240 my($self,$what) = @_;
3241 $self->print_ornamented($what,
3242 $CPAN::Config->{colorize_print}||'bold blue on_white',
3247 my($self,$category,$what) = @_;
3248 my $vname = $category . "_verbosity";
3249 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
3250 if (!$CPAN::Config->{$vname}
3251 || $CPAN::Config->{$vname} =~ /^v/
3253 $CPAN::Frontend->myprint($what);
3257 #-> sub CPAN::Shell::myexit ;
3259 my($self,$what) = @_;
3260 $self->myprint($what);
3264 #-> sub CPAN::Shell::mywarn ;
3266 my($self,$what) = @_;
3267 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
3270 # only to be used for shell commands
3271 #-> sub CPAN::Shell::mydie ;
3273 my($self,$what) = @_;
3274 $self->mywarn($what);
3276 # If it is the shell, we want the following die to be silent,
3277 # but if it is not the shell, we would need a 'die $what'. We need
3278 # to take care that only shell commands use mydie. Is this
3284 # sub CPAN::Shell::colorable_makemaker_prompt ;
3285 sub colorable_makemaker_prompt {
3287 if (CPAN::Shell->colorize_output) {
3288 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
3289 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
3292 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
3293 if (CPAN::Shell->colorize_output) {
3294 print Term::ANSIColor::color('reset');
3299 # use this only for unrecoverable errors!
3300 #-> sub CPAN::Shell::unrecoverable_error ;
3301 sub unrecoverable_error {
3302 my($self,$what) = @_;
3303 my @lines = split /\n/, $what;
3305 for my $l (@lines) {
3306 $longest = length $l if length $l > $longest;
3308 $longest = 62 if $longest > 62;
3309 for my $l (@lines) {
3310 if ($l =~ /^\s*$/) {
3315 if (length $l < 66) {
3316 $l = pack "A66 A*", $l, "<==";
3320 unshift @lines, "\n";
3321 $self->mydie(join "", @lines);
3324 #-> sub CPAN::Shell::mysleep ;
3326 my($self, $sleep) = @_;
3327 if (CPAN->has_inst("Time::HiRes")) {
3328 Time::HiRes::sleep($sleep);
3330 sleep($sleep < 1 ? 1 : int($sleep + 0.5));
3334 #-> sub CPAN::Shell::setup_output ;
3336 return if -t STDOUT;
3337 my $odef = select STDERR;
3344 #-> sub CPAN::Shell::rematein ;
3345 # RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
3348 my($meth,@some) = @_;
3350 while($meth =~ /^(ff?orce|notest)$/) {
3351 push @pragma, $meth;
3352 $meth = shift @some or
3353 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
3357 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
3359 # Here is the place to set "test_count" on all involved parties to
3360 # 0. We then can pass this counter on to the involved
3361 # distributions and those can refuse to test if test_count > X. In
3362 # the first stab at it we could use a 1 for "X".
3364 # But when do I reset the distributions to start with 0 again?
3365 # Jost suggested to have a random or cycling interaction ID that
3366 # we pass through. But the ID is something that is just left lying
3367 # around in addition to the counter, so I'd prefer to set the
3368 # counter to 0 now, and repeat at the end of the loop. But what
3369 # about dependencies? They appear later and are not reset, they
3370 # enter the queue but not its copy. How do they get a sensible
3373 # With configure_requires, "get" is vulnerable in recursion.
3375 my $needs_recursion_protection = "get|make|test|install";
3377 # construct the queue
3379 STHING: foreach $s (@some) {
3382 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
3384 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
3385 } elsif ($s =~ m|^/|) { # looks like a regexp
3386 if (substr($s,-1,1) eq ".") {
3387 $obj = CPAN::Shell->expandany($s);
3389 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
3390 "not supported.\nRejecting argument '$s'\n");
3391 $CPAN::Frontend->mysleep(2);
3394 } elsif ($meth eq "ls") {
3395 $self->globls($s,\@pragma);
3398 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
3399 $obj = CPAN::Shell->expandany($s);
3402 } elsif (ref $obj) {
3403 if ($meth =~ /^($needs_recursion_protection)$/) {
3404 # it would be silly to check for recursion for look or dump
3405 # (we are in CPAN::Shell::rematein)
3406 CPAN->debug("Going to test against recursion") if $CPAN::DEBUG;
3407 eval { $obj->color_cmd_tmps(0,1); };
3410 and $@->isa("CPAN::Exception::RecursiveDependency")) {
3411 $CPAN::Frontend->mywarn($@);
3415 Carp::confess(sprintf "DEBUG: \$\@[%s]ref[%s]", $@, ref $@);
3421 CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c");
3423 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
3424 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
3425 if ($meth =~ /^(dump|ls|reports)$/) {
3428 $CPAN::Frontend->mywarn(
3430 "Don't be silly, you can't $meth ",
3434 $CPAN::Frontend->mysleep(2);
3436 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
3437 CPAN::InfoObj->dump($s);
3440 ->mywarn(qq{Warning: Cannot $meth $s, }.
3441 qq{don't know what it is.
3446 to find objects with matching identifiers.
3448 $CPAN::Frontend->mysleep(2);
3452 # queuerunner (please be warned: when I started to change the
3453 # queue to hold objects instead of names, I made one or two
3454 # mistakes and never found which. I reverted back instead)
3455 QITEM: while (my $q = CPAN::Queue->first) {
3457 my $s = $q->as_string;
3458 my $reqtype = $q->reqtype || "";
3459 $obj = CPAN::Shell->expandany($s);
3461 # don't know how this can happen, maybe we should panic,
3462 # but maybe we get a solution from the first user who hits
3463 # this unfortunate exception?
3464 $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
3465 "to an object. Skipping.\n");
3466 $CPAN::Frontend->mysleep(5);
3467 CPAN::Queue->delete_first($s);
3470 $obj->{reqtype} ||= "";
3472 # force debugging because CPAN::SQLite somehow delivers us
3475 # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
3477 CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
3478 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
3480 if ($obj->{reqtype}) {
3481 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
3482 $obj->{reqtype} = $reqtype;
3484 exists $obj->{install}
3487 UNIVERSAL::can($obj->{install},"failed") ?
3488 $obj->{install}->failed :
3489 $obj->{install} =~ /^NO/
3492 delete $obj->{install};
3493 $CPAN::Frontend->mywarn
3494 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
3498 $obj->{reqtype} = $reqtype;
3501 for my $pragma (@pragma) {
3504 $obj->can($pragma)) {
3505 $obj->$pragma($meth);
3508 if (UNIVERSAL::can($obj, 'called_for')) {
3509 $obj->called_for($s);
3511 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
3512 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
3515 if ($meth =~ /^(report)$/) { # they came here with a pragma?
3517 } elsif (! UNIVERSAL::can($obj,$meth)) {
3519 my $serialized = "";
3521 } elsif ($CPAN::META->has_inst("YAML::Syck")) {
3522 $serialized = YAML::Syck::Dump($obj);
3523 } elsif ($CPAN::META->has_inst("YAML")) {
3524 $serialized = YAML::Dump($obj);
3525 } elsif ($CPAN::META->has_inst("Data::Dumper")) {
3526 $serialized = Data::Dumper::Dumper($obj);
3529 $serialized = overload::StrVal($obj);
3531 CPAN->debug("Going to panic. meth[$meth]s[$s]") if $CPAN::DEBUG;
3532 $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
3533 } elsif ($obj->$meth()) {
3534 CPAN::Queue->delete($s);
3535 CPAN->debug("From queue deleted. meth[$meth]s[$s]") if $CPAN::DEBUG;
3537 CPAN->debug("Failed. pragma[@pragma]meth[$meth]") if $CPAN::DEBUG;
3541 for my $pragma (@pragma) {
3542 my $unpragma = "un$pragma";
3543 if ($obj->can($unpragma)) {
3547 if ($CPAN::Config->{halt_on_failure}
3549 CPAN::Distrostatus::something_has_just_failed()
3551 $CPAN::Frontend->mywarn("Stopping: '$meth' failed for '$s'.\n");
3552 CPAN::Queue->nullify_queue;
3555 CPAN::Queue->delete_first($s);
3557 if ($meth =~ /^($needs_recursion_protection)$/) {
3558 for my $obj (@qcopy) {
3559 $obj->color_cmd_tmps(0,0);
3564 #-> sub CPAN::Shell::recent ;
3567 if ($CPAN::META->has_inst("XML::LibXML")) {
3568 my $url = $CPAN::Defaultrecent;
3569 $CPAN::Frontend->myprint("Going to fetch '$url'\n");
3570 unless ($CPAN::META->has_usable("LWP")) {
3571 $CPAN::Frontend->mydie("LWP not installed; cannot continue");
3573 CPAN::LWP::UserAgent->config;
3575 eval { $Ua = CPAN::LWP::UserAgent->new; };
3577 $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
3579 my $resp = $Ua->get($url);
3580 unless ($resp->is_success) {
3581 $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
3583 $CPAN::Frontend->myprint("DONE\n\n");
3584 my $xml = XML::LibXML->new->parse_string($resp->content);
3586 my $s = $xml->serialize(2);
3587 $s =~ s/\n\s*\n/\n/g;
3588 $CPAN::Frontend->myprint($s);
3592 if ($url =~ /winnipeg/) {
3593 my $pubdate = $xml->findvalue("/rss/channel/pubDate");
3594 $CPAN::Frontend->myprint(" pubDate: $pubdate\n\n");
3595 for my $eitem ($xml->findnodes("/rss/channel/item")) {
3596 my $distro = $eitem->findvalue("enclosure/\@url");
3597 $distro =~ s|.*?/authors/id/./../||;
3598 my $size = $eitem->findvalue("enclosure/\@length");
3599 my $desc = $eitem->findvalue("description");
3600 $desc =~ s/.+? - //;
3601 $CPAN::Frontend->myprint("$distro [$size b]\n $desc\n");
3602 push @distros, $distro;
3604 } elsif ($url =~ /search.*uploads.rdf/) {
3605 # xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
3606 # xmlns="http://purl.org/rss/1.0/"
3607 # xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/"
3608 # xmlns:dc="http://purl.org/dc/elements/1.1/"
3609 # xmlns:syn="http://purl.org/rss/1.0/modules/syndication/"
3610 # xmlns:admin="http://webns.net/mvcb/"
3613 my $dc_date = $xml->findvalue("//*[local-name(.) = 'RDF']/*[local-name(.) = 'channel']/*[local-name(.) = 'date']");
3614 $CPAN::Frontend->myprint(" dc:date: $dc_date\n\n");
3615 my $finish_eitem = 0;
3616 local $SIG{INT} = sub { $finish_eitem = 1 };
3617 EITEM: for my $eitem ($xml->findnodes("//*[local-name(.) = 'RDF']/*[local-name(.) = 'item']")) {
3618 my $distro = $eitem->findvalue("\@rdf:about");
3619 $distro =~ s|.*~||; # remove up to the tilde before the name
3620 $distro =~ s|/$||; # remove trailing slash
3621 $distro =~ s|([^/]+)|\U$1\E|; # upcase the name
3622 my $author = uc $1 or die "distro[$distro] without author, cannot continue";
3623 my $desc = $eitem->findvalue("*[local-name(.) = 'description']");
3625 SUBDIRTEST: while () {
3626 last SUBDIRTEST if ++$i >= 6; # half a dozen must do!
3627 if (my @ret = $self->globls("$distro*")) {
3628 @ret = grep {$_->[2] !~ /meta/} @ret;
3629 @ret = grep {length $_->[2]} @ret;
3631 $distro = "$author/$ret[0][2]";
3635 $distro =~ s|/|/*/|; # allow it to reside in a subdirectory
3638 next EITEM if $distro =~ m|\*|; # did not find the thing
3639 $CPAN::Frontend->myprint("____$desc\n");
3640 push @distros, $distro;
3641 last EITEM if $finish_eitem;
3646 # deprecated old version
3647 $CPAN::Frontend->mydie("no XML::LibXML installed, cannot continue\n");
3651 #-> sub CPAN::Shell::smoke ;
3654 my $distros = $self->recent;
3655 DISTRO: for my $distro (@$distros) {
3656 next if $distro =~ m|/Bundle-|; # XXX crude heuristic to skip bundles
3657 $CPAN::Frontend->myprint(sprintf "Going to download and test '$distro'\n");
3660 local $SIG{INT} = sub { $skip = 1 };
3662 $CPAN::Frontend->myprint(sprintf "\r%2d (Hit ^C to skip)", 10-$_);
3665 $CPAN::Frontend->myprint(" skipped\n");
3670 $CPAN::Frontend->myprint("\r \n"); # leave the dirty line with a newline
3671 $self->test($distro);
3676 # set up the dispatching methods
3678 for my $command (qw(
3695 *$command = sub { shift->rematein($command, @_); };
3699 package CPAN::LWP::UserAgent;
3703 return if $SETUPDONE;
3704 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3705 require LWP::UserAgent;
3706 @ISA = qw(Exporter LWP::UserAgent);
3709 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
3713 sub get_basic_credentials {
3714 my($self, $realm, $uri, $proxy) = @_;
3715 if ($USER && $PASSWD) {
3716 return ($USER, $PASSWD);
3719 ($USER,$PASSWD) = $self->get_proxy_credentials();
3721 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
3723 return($USER,$PASSWD);
3726 sub get_proxy_credentials {
3728 my ($user, $password);
3729 if ( defined $CPAN::Config->{proxy_user} ) {
3730 $user = $CPAN::Config->{proxy_user};
3731 $password = $CPAN::Config->{proxy_pass} || "";
3732 return ($user, $password);
3734 my $username_prompt = "\nProxy authentication needed!
3735 (Note: to permanently configure username and password run
3736 o conf proxy_user your_username
3737 o conf proxy_pass your_password
3739 ($user, $password) =
3740 _get_username_and_password_from_user($username_prompt);
3741 return ($user,$password);
3744 sub get_non_proxy_credentials {
3746 my ($user,$password);
3747 if ( defined $CPAN::Config->{username} ) {
3748 $user = $CPAN::Config->{username};
3749 $password = $CPAN::Config->{password} || "";
3750 return ($user, $password);
3752 my $username_prompt = "\nAuthentication needed!
3753 (Note: to permanently configure username and password run
3754 o conf username your_username
3755 o conf password your_password
3758 ($user, $password) =
3759 _get_username_and_password_from_user($username_prompt);
3760 return ($user,$password);
3763 sub _get_username_and_password_from_user {
3764 my $username_message = shift;
3765 my ($username,$password);
3767 ExtUtils::MakeMaker->import(qw(prompt));
3768 $username = prompt($username_message);
3769 if ($CPAN::META->has_inst("Term::ReadKey")) {
3770 Term::ReadKey::ReadMode("noecho");
3773 $CPAN::Frontend->mywarn(
3774 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
3777 $password = prompt("Password:");
3779 if ($CPAN::META->has_inst("Term::ReadKey")) {
3780 Term::ReadKey::ReadMode("restore");
3782 $CPAN::Frontend->myprint("\n\n");
3783 return ($username,$password);
3786 # mirror(): Its purpose is to deal with proxy authentication. When we
3787 # call SUPER::mirror, we relly call the mirror method in
3788 # LWP::UserAgent. LWP::UserAgent will then call
3789 # $self->get_basic_credentials or some equivalent and this will be
3790 # $self->dispatched to our own get_basic_credentials method.
3792 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3794 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3795 # although we have gone through our get_basic_credentials, the proxy
3796 # server refuses to connect. This could be a case where the username or
3797 # password has changed in the meantime, so I'm trying once again without
3798 # $USER and $PASSWD to give the get_basic_credentials routine another
3799 # chance to set $USER and $PASSWD.
3801 # mirror(): Its purpose is to deal with proxy authentication. When we
3802 # call SUPER::mirror, we relly call the mirror method in
3803 # LWP::UserAgent. LWP::UserAgent will then call
3804 # $self->get_basic_credentials or some equivalent and this will be
3805 # $self->dispatched to our own get_basic_credentials method.
3807 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3809 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3810 # although we have gone through our get_basic_credentials, the proxy
3811 # server refuses to connect. This could be a case where the username or
3812 # password has changed in the meantime, so I'm trying once again without
3813 # $USER and $PASSWD to give the get_basic_credentials routine another
3814 # chance to set $USER and $PASSWD.
3817 my($self,$url,$aslocal) = @_;
3818 my $result = $self->SUPER::mirror($url,$aslocal);
3819 if ($result->code == 407) {
3822 $result = $self->SUPER::mirror($url,$aslocal);
3830 #-> sub CPAN::FTP::ftp_statistics
3831 # if they want to rewrite, they need to pass in a filehandle
3832 sub _ftp_statistics {
3834 my $locktype = $fh ? LOCK_EX : LOCK_SH;
3835 $fh ||= FileHandle->new;
3836 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3837 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
3840 while (!CPAN::_flock($fh, $locktype|LOCK_NB)) {
3841 $waitstart ||= localtime();
3843 $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
3845 $CPAN::Frontend->mysleep($sleep);
3848 } elsif ($sleep <=6) {
3852 my $stats = eval { CPAN->_yaml_loadfile($file); };
3855 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
3856 $CPAN::Frontend->myprint("Warning (usually harmless): $@");
3858 } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
3859 $CPAN::Frontend->mydie($@);
3862 $CPAN::Frontend->mydie($@);
3868 #-> sub CPAN::FTP::_mytime
3870 if (CPAN->has_inst("Time::HiRes")) {
3871 return Time::HiRes::time();
3877 #-> sub CPAN::FTP::_new_stats
3879 my($self,$file) = @_;
3888 #-> sub CPAN::FTP::_add_to_statistics
3889 sub _add_to_statistics {
3890 my($self,$stats) = @_;
3891 my $yaml_module = CPAN::_yaml_module;
3892 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
3893 if ($CPAN::META->has_inst($yaml_module)) {
3894 $stats->{thesiteurl} = $ThesiteURL;
3895 $stats->{end} = CPAN::FTP::_mytime();
3896 my $fh = FileHandle->new;
3900 @debug = $time if $sdebug;
3901 my $fullstats = $self->_ftp_statistics($fh);
3903 $fullstats->{history} ||= [];
3904 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3905 push @debug, time if $sdebug;
3906 push @{$fullstats->{history}}, $stats;
3907 # YAML.pm 0.62 is unacceptably slow with 999;
3908 # YAML::Syck 0.82 has no noticable performance problem with 999;
3909 my $ftpstats_size = $CPAN::Config->{ftpstats_size} || 99;
3910 my $ftpstats_period = $CPAN::Config->{ftpstats_period} || 14;
3912 @{$fullstats->{history}} > $ftpstats_size
3913 || $time - $fullstats->{history}[0]{start} > 86400*$ftpstats_period
3915 shift @{$fullstats->{history}}
3917 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3918 push @debug, time if $sdebug;
3919 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
3920 # need no eval because if this fails, it is serious
3921 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3922 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
3924 local $CPAN::DEBUG = 512; # FTP
3926 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
3927 "after[%d]at[%d]oldest[%s]dumped backat[%d]",
3931 # Win32 cannot rename a file to an existing filename
3932 unlink($sfile) if ($^O eq 'MSWin32');
3933 _copy_stat($sfile, "$sfile.$$") if -e $sfile;
3934 rename "$sfile.$$", $sfile
3935 or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
3939 # Copy some stat information (owner, group, mode and) from one file to
3941 # This is a utility function which might be moved to a utility repository.
3942 #-> sub CPAN::FTP::_copy_stat
3944 my($src, $dest) = @_;
3945 my @stat = stat($src);
3947 $CPAN::Frontend->mywarn("Can't stat '$src': $!\n");
3952 chmod $stat[2], $dest
3953 or $CPAN::Frontend->mywarn("Can't chmod '$dest' to " . sprintf("0%o", $stat[2]) . ": $!\n");
3957 chown $stat[4], $stat[5], $dest
3959 my $save_err = $!; # otherwise it's lost in the get... calls
3960 $CPAN::Frontend->mywarn("Can't chown '$dest' to " .
3961 (getpwuid($stat[4]))[0] . "/" .
3962 (getgrgid($stat[5]))[0] . ": $save_err\n"
3969 # if file is CHECKSUMS, suggest the place where we got the file to be
3970 # checked from, maybe only for young files?
3971 #-> sub CPAN::FTP::_recommend_url_for
3972 sub _recommend_url_for {
3973 my($self, $file) = @_;
3974 my $urllist = $self->_get_urllist;
3975 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3976 my $fullstats = $self->_ftp_statistics();
3977 my $history = $fullstats->{history} || [];
3978 while (my $last = pop @$history) {
3979 last if $last->{end} - time > 3600; # only young results are interesting
3980 next unless $last->{file}; # dirname of nothing dies!
3981 next unless $file eq File::Basename::dirname($last->{file});
3982 return $last->{thesiteurl};
3985 if ($CPAN::Config->{randomize_urllist}
3987 rand(1) < $CPAN::Config->{randomize_urllist}
3989 $urllist->[int rand scalar @$urllist];
3995 #-> sub CPAN::FTP::_get_urllist
3998 $CPAN::Config->{urllist} ||= [];
3999 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
4000 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
4001 $CPAN::Config->{urllist} = [];
4003 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
4004 for my $u (@urllist) {
4005 CPAN->debug("u[$u]") if $CPAN::DEBUG;
4006 if (UNIVERSAL::can($u,"text")) {
4007 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
4009 $u .= "/" unless substr($u,-1) eq "/";
4010 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
4016 #-> sub CPAN::FTP::ftp_get ;
4018 my($class,$host,$dir,$file,$target) = @_;
4020 qq[Going to fetch file [$file] from dir [$dir]
4021 on host [$host] as local [$target]\n]
4023 my $ftp = Net::FTP->new($host);
4025 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
4028 return 0 unless defined $ftp;
4029 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
4030 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
4031 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) {
4032 my $msg = $ftp->message;
4033 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
4036 unless ( $ftp->cwd($dir) ) {
4037 my $msg = $ftp->message;
4038 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
4042 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
4043 unless ( $ftp->get($file,$target) ) {
4044 my $msg = $ftp->message;
4045 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
4048 $ftp->quit; # it's ok if this fails
4052 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
4054 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
4055 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
4057 # > *** 1562,1567 ****
4058 # > --- 1562,1580 ----
4059 # > return 1 if substr($url,0,4) eq "file";
4060 # > return 1 unless $url =~ m|://([^/]+)|;
4062 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
4064 # > + $proxy =~ m|://([^/:]+)|;
4066 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
4067 # > + if ($noproxy) {
4068 # > + if ($host !~ /$noproxy$/) {
4069 # > + $host = $proxy;
4072 # > + $host = $proxy;
4075 # > require Net::Ping;
4076 # > return 1 unless $Net::Ping::VERSION >= 2;
4080 #-> sub CPAN::FTP::localize ;
4082 my($self,$file,$aslocal,$force) = @_;
4084 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
4085 unless defined $aslocal;
4086 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
4089 if ($^O eq 'MacOS') {
4090 # Comment by AK on 2000-09-03: Uniq short filenames would be
4091 # available in CHECKSUMS file
4092 my($name, $path) = File::Basename::fileparse($aslocal, '');
4093 if (length($name) > 31) {
4104 my $size = 31 - length($suf);
4105 while (length($name) > $size) {
4109 $aslocal = File::Spec->catfile($path, $name);
4113 if (-f $aslocal && -r _ && !($force & 1)) {
4115 if ($size = -s $aslocal) {
4116 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
4119 # empty file from a previous unsuccessful attempt to download it
4121 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
4122 "could not remove.");
4125 my($maybe_restore) = 0;
4127 rename $aslocal, "$aslocal.bak$$";
4131 my($aslocal_dir) = File::Basename::dirname($aslocal);
4132 $self->mymkpath($aslocal_dir); # too early for file URLs / RT #28438
4133 # Inheritance is not easier to manage than a few if/else branches
4134 if ($CPAN::META->has_usable('LWP::UserAgent')) {
4136 CPAN::LWP::UserAgent->config;
4137 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
4139 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
4143 $Ua->proxy('ftp', $var)
4144 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
4145 $Ua->proxy('http', $var)
4146 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
4148 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
4152 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
4153 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
4156 # Try the list of urls for each single object. We keep a record
4157 # where we did get a file from
4158 my(@reordered,$last);
4159 my $ccurllist = $self->_get_urllist;
4160 $last = $#$ccurllist;
4161 if ($force & 2) { # local cpans probably out of date, don't reorder
4162 @reordered = (0..$last);
4166 (substr($ccurllist->[$b],0,4) eq "file")
4168 (substr($ccurllist->[$a],0,4) eq "file")
4170 defined($ThesiteURL)
4172 ($ccurllist->[$b] eq $ThesiteURL)
4174 ($ccurllist->[$a] eq $ThesiteURL)
4179 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
4185 ["dleasy", "http","defaultsites"],
4186 ["dlhard", "http","defaultsites"],
4187 ["dleasy", "ftp", "defaultsites"],
4188 ["dlhard", "ftp", "defaultsites"],
4189 ["dlhardest","", "defaultsites"],
4192 @levels = grep {$_->[0] eq $Themethod} @all_levels;
4193 push @levels, grep {$_->[0] ne $Themethod} @all_levels;
4195 @levels = @all_levels;
4197 @levels = qw/dleasy/ if $^O eq 'MacOS';
4199 local $ENV{FTP_PASSIVE} =
4200 exists $CPAN::Config->{ftp_passive} ?
4201 $CPAN::Config->{ftp_passive} : 1;
4203 my $stats = $self->_new_stats($file);
4204 for ($CPAN::Config->{connect_to_internet_ok}) {
4205 $connect_to_internet_ok = $_ if not defined $connect_to_internet_ok and defined $_;
4207 LEVEL: for $levelno (0..$#levels) {
4208 my $level_tuple = $levels[$levelno];
4209 my($level,$scheme,$sitetag) = @$level_tuple;
4210 my $defaultsites = $sitetag && $sitetag eq "defaultsites";
4212 if ($defaultsites) {
4213 unless (defined $connect_to_internet_ok) {
4214 $CPAN::Frontend->myprint(sprintf qq{
4215 I would like to connect to one of the following sites to get '%s':
4220 join("",map { " ".$_->text."\n" } @CPAN::Defaultsites),
4222 my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes");
4223 if ($answer =~ /^y/i) {
4224 $connect_to_internet_ok = 1;
4226 $connect_to_internet_ok = 0;
4229 if ($connect_to_internet_ok) {
4230 @urllist = @CPAN::Defaultsites;
4235 my @host_seq = $level =~ /dleasy/ ?
4236 @reordered : 0..$last; # reordered has file and $Thesiteurl first
4237 @urllist = map { $ccurllist->[$_] } @host_seq;
4239 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
4240 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
4241 if (my $recommend = $self->_recommend_url_for($file)) {
4242 @urllist = grep { $_ ne $recommend } @urllist;
4243 unshift @urllist, $recommend;
4245 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
4246 $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats);
4248 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
4249 if ($ret eq $aslocal_tempfile) {
4250 # if we got it exactly as we asked for, only then we
4252 rename $aslocal_tempfile, $aslocal
4253 or $CPAN::Frontend->mydie("Error while trying to rename ".
4254 "'$ret' to '$aslocal': $!");
4257 $Themethod = $level;
4259 # utime $now, $now, $aslocal; # too bad, if we do that, we
4260 # might alter a local mirror
4261 $self->debug("level[$level]") if $CPAN::DEBUG;
4264 unlink $aslocal_tempfile;
4265 last if $CPAN::Signal; # need to cleanup
4269 $stats->{filesize} = -s $ret;
4271 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
4272 $self->_add_to_statistics($stats);
4273 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
4275 unlink "$aslocal.bak$$";
4278 unless ($CPAN::Signal) {
4281 if (@{$CPAN::Config->{urllist}}) {
4283 qq{Please check, if the URLs I found in your configuration file \(}.
4284 join(", ", @{$CPAN::Config->{urllist}}).
4287 push @mess, qq{Your urllist is empty!};
4289 push @mess, qq{The urllist can be edited.},
4290 qq{E.g. with 'o conf urllist push ftp://myurl/'};
4291 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
4292 $CPAN::Frontend->mywarn("Could not fetch $file\n");
4293 $CPAN::Frontend->mysleep(2);
4295 if ($maybe_restore) {
4296 rename "$aslocal.bak$$", $aslocal;
4297 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
4298 $self->ls($aslocal));
4305 my($self, $aslocal_dir) = @_;
4306 File::Path::mkpath($aslocal_dir);
4307 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
4308 qq{directory "$aslocal_dir".
4309 I\'ll continue, but if you encounter problems, they may be due
4310 to insufficient permissions.\n}) unless -w $aslocal_dir;
4318 $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme;
4319 my $method = "host$level";
4320 $self->$method($h, @_);
4324 my($self,$stats,$method,$url) = @_;
4325 push @{$stats->{attempts}}, {
4332 # package CPAN::FTP;
4334 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4336 HOSTEASY: for $ro_url (@$host_seq) {
4337 $self->_set_attempt($stats,"dleasy",$ro_url);
4338 my $url .= "$ro_url$file";
4339 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
4340 if ($url =~ /^file:/) {
4342 if ($CPAN::META->has_inst('URI::URL')) {
4343 my $u = URI::URL->new($url);
4345 } else { # works only on Unix, is poorly constructed, but
4346 # hopefully better than nothing.
4347 # RFC 1738 says fileurl BNF is
4348 # fileurl = "file://" [ host | "localhost" ] "/" fpath
4349 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
4351 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
4352 $l =~ s|^file:||; # assume they
4356 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
4358 $self->debug("local file[$l]") if $CPAN::DEBUG;
4359 if ( -f $l && -r _) {
4360 $ThesiteURL = $ro_url;
4363 if ($l =~ /(.+)\.gz$/) {
4365 if ( -f $ungz && -r _) {
4366 $ThesiteURL = $ro_url;
4370 # Maybe mirror has compressed it?
4372 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
4373 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
4375 $ThesiteURL = $ro_url;
4379 $CPAN::Frontend->mywarn("Could not find '$l'\n");
4381 $self->debug("it was not a file URL") if $CPAN::DEBUG;
4382 if ($CPAN::META->has_usable('LWP')) {
4383 $CPAN::Frontend->myprint("Fetching with LWP:
4387 CPAN::LWP::UserAgent->config;
4388 eval { $Ua = CPAN::LWP::UserAgent->new; };
4390 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
4393 my $res = $Ua->mirror($url, $aslocal);
4394 if ($res->is_success) {
4395 $ThesiteURL = $ro_url;
4397 utime $now, $now, $aslocal; # download time is more
4398 # important than upload
4401 } elsif ($url !~ /\.gz(?!\n)\Z/) {
4402 my $gzurl = "$url.gz";
4403 $CPAN::Frontend->myprint("Fetching with LWP:
4406 $res = $Ua->mirror($gzurl, "$aslocal.gz");
4407 if ($res->is_success) {
4408 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
4409 $ThesiteURL = $ro_url;
4414 $CPAN::Frontend->myprint(sprintf(
4415 "LWP failed with code[%s] message[%s]\n",
4419 # Alan Burlison informed me that in firewall environments
4420 # Net::FTP can still succeed where LWP fails. So we do not
4421 # skip Net::FTP anymore when LWP is available.
4424 $CPAN::Frontend->mywarn(" LWP not available\n");
4426 return if $CPAN::Signal;
4427 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4428 # that's the nice and easy way thanks to Graham
4429 $self->debug("recognized ftp") if $CPAN::DEBUG;
4430 my($host,$dir,$getfile) = ($1,$2,$3);
4431 if ($CPAN::META->has_usable('Net::FTP')) {
4433 $CPAN::Frontend->myprint("Fetching with Net::FTP:
4436 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
4437 "aslocal[$aslocal]") if $CPAN::DEBUG;
4438 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
4439 $ThesiteURL = $ro_url;
4442 if ($aslocal !~ /\.gz(?!\n)\Z/) {
4443 my $gz = "$aslocal.gz";
4444 $CPAN::Frontend->myprint("Fetching with Net::FTP
4447 if (CPAN::FTP->ftp_get($host,
4451 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
4453 $ThesiteURL = $ro_url;
4459 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
4463 UNIVERSAL::can($ro_url,"text")
4465 $ro_url->{FROM} eq "USER"
4467 ##address #17973: default URLs should not try to override
4468 ##user-defined URLs just because LWP is not available
4469 my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats);
4470 return $ret if $ret;
4472 return if $CPAN::Signal;
4476 # package CPAN::FTP;
4478 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4480 # Came back if Net::FTP couldn't establish connection (or
4481 # failed otherwise) Maybe they are behind a firewall, but they
4482 # gave us a socksified (or other) ftp program...
4485 my($devnull) = $CPAN::Config->{devnull} || "";
4487 my($aslocal_dir) = File::Basename::dirname($aslocal);
4488 File::Path::mkpath($aslocal_dir);
4489 HOSTHARD: for $ro_url (@$host_seq) {
4490 $self->_set_attempt($stats,"dlhard",$ro_url);
4491 my $url = "$ro_url$file";
4492 my($proto,$host,$dir,$getfile);
4494 # Courtesy Mark Conty mark_conty@cargill.com change from
4495 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4497 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
4498 # proto not yet used
4499 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
4501 next HOSTHARD; # who said, we could ftp anything except ftp?
4503 next HOSTHARD if $proto eq "file"; # file URLs would have had
4504 # success above. Likely a bogus URL
4506 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
4508 # Try the most capable first and leave ncftp* for last as it only
4510 my $proxy_vars = $self->_proxy_vars($ro_url);
4511 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
4512 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
4513 next unless defined $funkyftp;
4514 next if $funkyftp =~ /^\s*$/;
4516 my($asl_ungz, $asl_gz);
4517 ($asl_ungz = $aslocal) =~ s/\.gz//;
4518 $asl_gz = "$asl_ungz.gz";
4520 my($src_switch) = "";
4522 my($stdout_redir) = " > $asl_ungz";
4524 $src_switch = " -source";
4525 } elsif ($f eq "ncftp") {
4526 $src_switch = " -c";
4527 } elsif ($f eq "wget") {
4528 $src_switch = " -O $asl_ungz";
4530 } elsif ($f eq 'curl') {
4531 $src_switch = ' -L -f -s -S --netrc-optional';
4532 if ($proxy_vars->{http_proxy}) {
4533 $src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"};
4537 if ($f eq "ncftpget") {
4538 $chdir = "cd $aslocal_dir && ";
4541 $CPAN::Frontend->myprint(
4543 Trying with "$funkyftp$src_switch" to get
4547 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
4548 $self->debug("system[$system]") if $CPAN::DEBUG;
4549 my($wstatus) = system($system);
4551 # lynx returns 0 when it fails somewhere
4553 my $content = do { local *FH;
4554 open FH, $asl_ungz or die;
4557 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
4558 $CPAN::Frontend->mywarn(qq{
4559 No success, the file that lynx has downloaded looks like an error message:
4562 $CPAN::Frontend->mysleep(1);
4566 $CPAN::Frontend->myprint(qq{
4567 No success, the file that lynx has downloaded is an empty file.
4572 if ($wstatus == 0) {
4575 } elsif ($asl_ungz ne $aslocal) {
4576 # test gzip integrity
4577 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
4578 # e.g. foo.tar is gzipped --> foo.tar.gz
4579 rename $asl_ungz, $aslocal;
4581 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
4584 $ThesiteURL = $ro_url;
4586 } elsif ($url !~ /\.gz(?!\n)\Z/) {
4588 -f $asl_ungz && -s _ == 0;
4589 my $gz = "$aslocal.gz";
4590 my $gzurl = "$url.gz";
4591 $CPAN::Frontend->myprint(
4593 Trying with "$funkyftp$src_switch" to get
4596 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
4597 $self->debug("system[$system]") if $CPAN::DEBUG;
4599 if (($wstatus = system($system)) == 0
4603 # test gzip integrity
4604 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
4605 if ($ct && $ct->gtest) {
4606 $ct->gunzip($aslocal);
4608 # somebody uncompressed file for us?
4609 rename $asl_ungz, $aslocal;
4611 $ThesiteURL = $ro_url;
4614 unlink $asl_gz if -f $asl_gz;
4617 my $estatus = $wstatus >> 8;
4618 my $size = -f $aslocal ?
4619 ", left\n$aslocal with size ".-s _ :
4620 "\nWarning: expected file [$aslocal] doesn't exist";
4621 $CPAN::Frontend->myprint(qq{
4622 System call "$system"
4623 returned status $estatus (wstat $wstatus)$size
4626 return if $CPAN::Signal;
4627 } # transfer programs
4631 #-> CPAN::FTP::_proxy_vars
4633 my($self,$url) = @_;
4635 my $http_proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
4637 my($host) = $url =~ m|://([^/:]+)|;
4639 my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'} || "";
4640 my @noproxy = split /\s*,\s*/, $noproxy;
4642 DOMAIN: for my $domain (@noproxy) {
4643 if ($host =~ /\Q$domain\E$/) { # cf. LWP::UserAgent
4649 $CPAN::Frontend->mywarn(" Could not determine host from http_proxy '$http_proxy'\n");
4653 &CPAN::LWP::UserAgent::get_proxy_credentials();
4655 proxy_user => $user,
4656 proxy_pass => $pass,
4657 http_proxy => $http_proxy
4664 # package CPAN::FTP;
4666 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4668 return unless @$host_seq;
4670 my($aslocal_dir) = File::Basename::dirname($aslocal);
4671 File::Path::mkpath($aslocal_dir);
4672 my $ftpbin = $CPAN::Config->{ftp};
4673 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
4674 $CPAN::Frontend->myprint("No external ftp command available\n\n");
4677 $CPAN::Frontend->mywarn(qq{
4678 As a last ressort we now switch to the external ftp command '$ftpbin'
4681 Doing so often leads to problems that are hard to diagnose.
4683 If you're victim of such problems, please consider unsetting the ftp
4684 config variable with
4690 $CPAN::Frontend->mysleep(2);
4691 HOSTHARDEST: for $ro_url (@$host_seq) {
4692 $self->_set_attempt($stats,"dlhardest",$ro_url);
4693 my $url = "$ro_url$file";
4694 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
4695 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4698 my($host,$dir,$getfile) = ($1,$2,$3);
4700 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
4701 $ctime,$blksize,$blocks) = stat($aslocal);
4702 $timestamp = $mtime ||= 0;
4703 my($netrc) = CPAN::FTP::netrc->new;
4704 my($netrcfile) = $netrc->netrc;
4705 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
4706 my $targetfile = File::Basename::basename($aslocal);
4712 map("cd $_", split /\//, $dir), # RFC 1738
4714 "get $getfile $targetfile",
4718 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
4719 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
4720 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
4722 $netrc->contains($host))) if $CPAN::DEBUG;
4723 if ($netrc->protected) {
4724 my $dialog = join "", map { " $_\n" } @dialog;
4726 if ($netrc->contains($host)) {
4727 $netrc_explain = "Relying that your .netrc entry for '$host' ".
4728 "manages the login";
4730 $netrc_explain = "Relying that your default .netrc entry ".
4731 "manages the login";
4733 $CPAN::Frontend->myprint(qq{
4734 Trying with external ftp to get
4737 Going to send the dialog
4741 $self->talk_ftp("$ftpbin$verbose $host",
4743 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4744 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4746 if ($mtime > $timestamp) {
4747 $CPAN::Frontend->myprint("GOT $aslocal\n");
4748 $ThesiteURL = $ro_url;
4751 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
4753 return if $CPAN::Signal;
4755 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
4756 qq{correctly protected.\n});
4759 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
4760 nor does it have a default entry\n");
4763 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
4764 # then and login manually to host, using e-mail as
4766 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
4770 "user anonymous $Config::Config{'cf_email'}"
4772 my $dialog = join "", map { " $_\n" } @dialog;
4773 $CPAN::Frontend->myprint(qq{
4774 Trying with external ftp to get
4776 Going to send the dialog
4780 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
4781 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4782 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4784 if ($mtime > $timestamp) {
4785 $CPAN::Frontend->myprint("GOT $aslocal\n");
4786 $ThesiteURL = $ro_url;
4789 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
4791 return if $CPAN::Signal;
4792 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
4793 $CPAN::Frontend->mysleep(2);
4797 # package CPAN::FTP;
4799 my($self,$command,@dialog) = @_;
4800 my $fh = FileHandle->new;
4801 $fh->open("|$command") or die "Couldn't open ftp: $!";
4802 foreach (@dialog) { $fh->print("$_\n") }
4803 $fh->close; # Wait for process to complete
4805 my $estatus = $wstatus >> 8;
4806 $CPAN::Frontend->myprint(qq{
4807 Subprocess "|$command"
4808 returned status $estatus (wstat $wstatus)
4812 # find2perl needs modularization, too, all the following is stolen
4816 my($self,$name) = @_;
4817 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
4818 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
4820 my($perms,%user,%group);
4824 $blocks = int(($blocks + 1) / 2);
4827 $blocks = int(($sizemm + 1023) / 1024);
4830 if (-f _) { $perms = '-'; }
4831 elsif (-d _) { $perms = 'd'; }
4832 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
4833 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
4834 elsif (-p _) { $perms = 'p'; }
4835 elsif (-S _) { $perms = 's'; }
4836 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
4838 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
4839 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
4840 my $tmpmode = $mode;
4841 my $tmp = $rwx[$tmpmode & 7];
4843 $tmp = $rwx[$tmpmode & 7] . $tmp;
4845 $tmp = $rwx[$tmpmode & 7] . $tmp;
4846 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
4847 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
4848 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
4851 my $user = $user{$uid} || $uid; # too lazy to implement lookup
4852 my $group = $group{$gid} || $gid;
4854 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4856 my($moname) = $moname[$mon];
4857 if (-M _ > 365.25 / 2) {
4858 $timeyear = $year + 1900;
4861 $timeyear = sprintf("%02d:%02d", $hour, $min);
4864 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
4878 package CPAN::FTP::netrc;
4881 # package CPAN::FTP::netrc;
4884 my $home = CPAN::HandleConfig::home;
4885 my $file = File::Spec->catfile($home,".netrc");
4887 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4888 $atime,$mtime,$ctime,$blksize,$blocks)
4893 my($fh,@machines,$hasdefault);
4895 $fh = FileHandle->new or die "Could not create a filehandle";
4897 if($fh->open($file)) {
4898 $protected = ($mode & 077) == 0;
4900 NETRC: while (<$fh>) {
4901 my(@tokens) = split " ", $_;
4902 TOKEN: while (@tokens) {
4903 my($t) = shift @tokens;
4904 if ($t eq "default") {
4908 last TOKEN if $t eq "macdef";
4909 if ($t eq "machine") {
4910 push @machines, shift @tokens;
4915 $file = $hasdefault = $protected = "";
4919 'mach' => [@machines],
4921 'hasdefault' => $hasdefault,
4922 'protected' => $protected,
4926 # CPAN::FTP::netrc::hasdefault;
4927 sub hasdefault { shift->{'hasdefault'} }
4928 sub netrc { shift->{'netrc'} }
4929 sub protected { shift->{'protected'} }
4931 my($self,$mach) = @_;
4932 for ( @{$self->{'mach'}} ) {
4933 return 1 if $_ eq $mach;
4938 package CPAN::Complete;
4942 my($text, $line, $start, $end) = @_;
4943 my(@perlret) = cpl($text, $line, $start);
4944 # find longest common match. Can anybody show me how to peruse
4945 # T::R::Gnu to have this done automatically? Seems expensive.
4946 return () unless @perlret;
4947 my($newtext) = $text;
4948 for (my $i = length($text)+1;;$i++) {
4949 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4950 my $try = substr($perlret[0],0,$i);
4951 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4952 # warn "try[$try]tries[@tries]";
4953 if (@tries == @perlret) {
4959 ($newtext,@perlret);
4962 #-> sub CPAN::Complete::cpl ;
4964 my($word,$line,$pos) = @_;
4968 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4970 if ($line =~ s/^((?:notest|f?force)\s*)//) {
4974 if ($pos == 0 || $line =~ /^(?:h(?:elp)?|\?)\s/) {
4975 @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS;
4976 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4978 } elsif ($line =~ /^(a|ls)\s/) {
4979 @return = cplx('CPAN::Author',uc($word));
4980 } elsif ($line =~ /^b\s/) {
4981 CPAN::Shell->local_bundles;
4982 @return = cplx('CPAN::Bundle',$word);
4983 } elsif ($line =~ /^d\s/) {
4984 @return = cplx('CPAN::Distribution',$word);
4985 } elsif ($line =~ m/^(
4986 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4988 if ($word =~ /^Bundle::/) {
4989 CPAN::Shell->local_bundles;
4991 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4992 } elsif ($line =~ /^i\s/) {
4993 @return = cpl_any($word);
4994 } elsif ($line =~ /^reload\s/) {
4995 @return = cpl_reload($word,$line,$pos);
4996 } elsif ($line =~ /^o\s/) {
4997 @return = cpl_option($word,$line,$pos);
4998 } elsif ($line =~ m/^\S+\s/ ) {
4999 # fallback for future commands and what we have forgotten above
5000 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
5007 #-> sub CPAN::Complete::cplx ;
5009 my($class, $word) = @_;
5010 if (CPAN::_sqlite_running) {
5011 $CPAN::SQLite->search($class, "^\Q$word\E");
5013 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
5016 #-> sub CPAN::Complete::cpl_any ;
5020 cplx('CPAN::Author',$word),
5021 cplx('CPAN::Bundle',$word),
5022 cplx('CPAN::Distribution',$word),
5023 cplx('CPAN::Module',$word),
5027 #-> sub CPAN::Complete::cpl_reload ;
5029 my($word,$line,$pos) = @_;
5031 my(@words) = split " ", $line;
5032 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
5033 my(@ok) = qw(cpan index);
5034 return @ok if @words == 1;
5035 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
5038 #-> sub CPAN::Complete::cpl_option ;
5040 my($word,$line,$pos) = @_;
5042 my(@words) = split " ", $line;
5043 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
5044 my(@ok) = qw(conf debug);
5045 return @ok if @words == 1;
5046 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
5048 } elsif ($words[1] eq 'index') {
5050 } elsif ($words[1] eq 'conf') {
5051 return CPAN::HandleConfig::cpl(@_);
5052 } elsif ($words[1] eq 'debug') {
5053 return sort grep /^\Q$word\E/i,
5054 sort keys %CPAN::DEBUG, 'all';
5058 package CPAN::Index;
5061 #-> sub CPAN::Index::force_reload ;
5064 $CPAN::Index::LAST_TIME = 0;
5068 #-> sub CPAN::Index::reload ;
5070 my($self,$force) = @_;
5073 # XXX check if a newer one is available. (We currently read it
5074 # from time to time)
5075 for ($CPAN::Config->{index_expire}) {
5076 $_ = 0.001 unless $_ && $_ > 0.001;
5078 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
5079 # debug here when CPAN doesn't seem to read the Metadata
5081 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
5083 unless ($CPAN::META->{PROTOCOL}) {
5084 $self->read_metadata_cache;
5085 $CPAN::META->{PROTOCOL} ||= "1.0";
5087 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
5088 # warn "Setting last_time to 0";
5089 $LAST_TIME = 0; # No warning necessary
5091 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
5094 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
5096 # IFF we are developing, it helps to wipe out the memory
5097 # between reloads, otherwise it is not what a user expects.
5098 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
5099 $CPAN::META = CPAN->new;
5102 local $LAST_TIME = $time;
5103 local $CPAN::META->{PROTOCOL} = PROTOCOL;
5105 my $needshort = $^O eq "dos";
5107 $self->rd_authindex($self
5109 "authors/01mailrc.txt.gz",
5111 File::Spec->catfile('authors', '01mailrc.gz') :
5112 File::Spec->catfile('authors', '01mailrc.txt.gz'),
5115 $debug = "timing reading 01[".($t2 - $time)."]";
5117 return if $CPAN::Signal; # this is sometimes lengthy
5118 $self->rd_modpacks($self
5120 "modules/02packages.details.txt.gz",
5122 File::Spec->catfile('modules', '02packag.gz') :
5123 File::Spec->catfile('modules', '02packages.details.txt.gz'),
5126 $debug .= "02[".($t2 - $time)."]";
5128 return if $CPAN::Signal; # this is sometimes lengthy
5129 $self->rd_modlist($self
5131 "modules/03modlist.data.gz",
5133 File::Spec->catfile('modules', '03mlist.gz') :
5134 File::Spec->catfile('modules', '03modlist.data.gz'),
5136 $self->write_metadata_cache;
5138 $debug .= "03[".($t2 - $time)."]";
5140 CPAN->debug($debug) if $CPAN::DEBUG;
5142 if ($CPAN::Config->{build_dir_reuse}) {
5143 $self->reanimate_build_dir;
5145 if (CPAN::_sqlite_running) {
5146 $CPAN::SQLite->reload(time => $time, force => $force)
5150 $CPAN::META->{PROTOCOL} = PROTOCOL;
5153 #-> sub CPAN::Index::reanimate_build_dir ;
5154 sub reanimate_build_dir {
5156 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
5159 return if $HAVE_REANIMATED++;
5160 my $d = $CPAN::Config->{build_dir};
5161 my $dh = DirHandle->new;
5162 opendir $dh, $d or return; # does not exist
5167 my @candidates = map { $_->[0] }
5168 sort { $b->[1] <=> $a->[1] }
5169 map { [ $_, -M File::Spec->catfile($d,$_) ] }
5170 grep {/\.yml$/} readdir $dh;
5171 unless (@candidates) {
5172 $CPAN::Frontend->myprint("Build_dir empty, nothing to restore\n");
5175 $CPAN::Frontend->myprint
5176 (sprintf("Going to read %d yaml file%s from %s/\n",
5178 @candidates==1 ? "" : "s",
5179 $CPAN::Config->{build_dir}
5181 my $start = CPAN::FTP::_mytime;
5182 DISTRO: for $i (0..$#candidates) {
5183 my $dirent = $candidates[$i];
5184 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
5186 warn "Error while parsing file '$dirent'; error: '$@'";
5190 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
5191 my $key = $c->{distribution}{ID};
5192 for my $k (keys %{$c->{distribution}}) {
5193 if ($c->{distribution}{$k}
5194 && ref $c->{distribution}{$k}
5195 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
5196 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
5200 #we tried to restore only if element already
5201 #exists; but then we do not work with metadata
5204 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
5205 = $c->{distribution};
5206 for my $skipper (qw(
5208 configure_requires_later
5209 configure_requires_later_for
5217 negative_prefs_cache
5219 delete $do->{$skipper};
5222 if ($do->tested_ok_but_not_installed) {
5223 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
5228 while (($painted/76) < ($i/@candidates)) {
5229 $CPAN::Frontend->myprint(".");
5233 my $took = CPAN::FTP::_mytime - $start;
5234 $CPAN::Frontend->myprint(sprintf(
5235 "DONE\nRestored the state of %s (in %.4f secs)\n",
5236 $restored || "none",
5242 #-> sub CPAN::Index::reload_x ;
5244 my($cl,$wanted,$localname,$force) = @_;
5245 $force |= 2; # means we're dealing with an index here
5246 CPAN::HandleConfig->load; # we should guarantee loading wherever
5247 # we rely on Config XXX
5248 $localname ||= $wanted;
5249 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
5253 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
5256 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
5257 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
5258 qq{day$s. I\'ll use that.});
5261 $force |= 1; # means we're quite serious about it.
5263 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
5266 #-> sub CPAN::Index::rd_authindex ;
5268 my($cl, $index_target) = @_;
5269 return unless defined $index_target;
5270 return if CPAN::_sqlite_running;
5272 $CPAN::Frontend->myprint("Going to read $index_target\n");
5274 tie *FH, 'CPAN::Tarzip', $index_target;
5277 push @lines, split /\012/ while <FH>;
5281 my($userid,$fullname,$email) =
5282 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
5283 $fullname ||= $email;
5284 if ($userid && $fullname && $email) {
5285 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
5286 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
5288 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
5291 while (($painted/76) < ($i/@lines)) {
5292 $CPAN::Frontend->myprint(".");
5295 return if $CPAN::Signal;
5297 $CPAN::Frontend->myprint("DONE\n");
5301 my($self,$dist) = @_;
5302 $dist = $self->{'id'} unless defined $dist;
5303 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
5307 #-> sub CPAN::Index::rd_modpacks ;
5309 my($self, $index_target) = @_;
5310 return unless defined $index_target;
5311 return if CPAN::_sqlite_running;
5312 $CPAN::Frontend->myprint("Going to read $index_target\n");
5313 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
5315 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
5318 while (my $bytes = $fh->READ(\$chunk,8192)) {
5321 my @lines = split /\012/, $slurp;
5322 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
5325 my($line_count,$last_updated);
5327 my $shift = shift(@lines);
5328 last if $shift =~ /^\s*$/;
5329 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
5330 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
5332 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
5333 if (not defined $line_count) {
5335 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
5336 Please check the validity of the index file by comparing it to more
5337 than one CPAN mirror. I'll continue but problems seem likely to
5341 $CPAN::Frontend->mysleep(5);
5342 } elsif ($line_count != scalar @lines) {
5344 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
5345 contains a Line-Count header of %d but I see %d lines there. Please
5346 check the validity of the index file by comparing it to more than one
5347 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
5348 $index_target, $line_count, scalar(@lines));
5351 if (not defined $last_updated) {
5353 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
5354 Please check the validity of the index file by comparing it to more
5355 than one CPAN mirror. I'll continue but problems seem likely to
5359 $CPAN::Frontend->mysleep(5);
5363 ->myprint(sprintf qq{ Database was generated on %s\n},
5365 $DATE_OF_02 = $last_updated;
5368 if ($CPAN::META->has_inst('HTTP::Date')) {
5370 $age -= HTTP::Date::str2time($last_updated);
5372 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
5373 require Time::Local;
5374 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
5375 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
5376 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
5383 qq{Warning: This index file is %d days old.
5384 Please check the host you chose as your CPAN mirror for staleness.
5385 I'll continue but problems seem likely to happen.\a\n},
5388 } elsif ($age < -1) {
5392 qq{Warning: Your system date is %d days behind this index file!
5394 Timestamp index file: %s
5395 Please fix your system time, problems with the make command expected.\n},
5405 # A necessity since we have metadata_cache: delete what isn't
5407 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
5408 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
5413 # before 1.56 we split into 3 and discarded the rest. From
5414 # 1.57 we assign remaining text to $comment thus allowing to
5415 # influence isa_perl
5416 my($mod,$version,$dist,$comment) = split " ", $_, 4;
5417 unless ($mod && defined $version && $dist) {
5418 $CPAN::Frontend->mywarn("Could not split line[$_]\n");
5421 my($bundle,$id,$userid);
5423 if ($mod eq 'CPAN' &&
5425 CPAN::Queue->exists('Bundle::CPAN') ||
5426 CPAN::Queue->exists('CPAN')
5430 if ($version > $CPAN::VERSION) {
5431 $CPAN::Frontend->mywarn(qq{
5432 New CPAN.pm version (v$version) available.
5433 [Currently running version is v$CPAN::VERSION]
5434 You might want to try
5437 to both upgrade CPAN.pm and run the new version without leaving
5438 the current session.
5441 $CPAN::Frontend->mysleep(2);
5442 $CPAN::Frontend->myprint(qq{\n});
5444 last if $CPAN::Signal;
5445 } elsif ($mod =~ /^Bundle::(.*)/) {
5450 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
5451 # Let's make it a module too, because bundles have so much
5452 # in common with modules.
5454 # Changed in 1.57_63: seems like memory bloat now without
5455 # any value, so commented out
5457 # $CPAN::META->instance('CPAN::Module',$mod);
5461 # instantiate a module object
5462 $id = $CPAN::META->instance('CPAN::Module',$mod);
5466 # Although CPAN prohibits same name with different version the
5467 # indexer may have changed the version for the same distro
5468 # since the last time ("Force Reindexing" feature)
5469 if ($id->cpan_file ne $dist
5471 $id->cpan_version ne $version
5473 $userid = $id->userid || $self->userid($dist);
5475 'CPAN_USERID' => $userid,
5476 'CPAN_VERSION' => $version,
5477 'CPAN_FILE' => $dist,
5481 # instantiate a distribution object
5482 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
5483 # we do not need CONTAINSMODS unless we do something with
5484 # this dist, so we better produce it on demand.
5486 ## my $obj = $CPAN::META->instance(
5487 ## 'CPAN::Distribution' => $dist
5489 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
5491 $CPAN::META->instance(
5492 'CPAN::Distribution' => $dist
5494 'CPAN_USERID' => $userid,
5495 'CPAN_COMMENT' => $comment,
5499 for my $name ($mod,$dist) {
5500 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
5501 $exists{$name} = undef;
5505 while (($painted/76) < ($i/@lines)) {
5506 $CPAN::Frontend->myprint(".");
5509 return if $CPAN::Signal;
5511 $CPAN::Frontend->myprint("DONE\n");
5513 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
5514 for my $o ($CPAN::META->all_objects($class)) {
5515 next if exists $exists{$o->{ID}};
5516 $CPAN::META->delete($class,$o->{ID});
5517 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
5524 #-> sub CPAN::Index::rd_modlist ;
5526 my($cl,$index_target) = @_;
5527 return unless defined $index_target;
5528 return if CPAN::_sqlite_running;
5529 $CPAN::Frontend->myprint("Going to read $index_target\n");
5530 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
5534 while (my $bytes = $fh->READ(\$chunk,8192)) {
5537 my @eval2 = split /\012/, $slurp;
5540 my $shift = shift(@eval2);
5541 if ($shift =~ /^Date:\s+(.*)/) {
5542 if ($DATE_OF_03 eq $1) {
5543 $CPAN::Frontend->myprint("Unchanged.\n");
5548 last if $shift =~ /^\s*$/;
5550 push @eval2, q{CPAN::Modulelist->data;};
5552 my($compmt) = Safe->new("CPAN::Safe1");
5553 my($eval2) = join("\n", @eval2);
5554 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
5555 my $ret = $compmt->reval($eval2);
5556 Carp::confess($@) if $@;
5557 return if $CPAN::Signal;
5559 my $until = keys(%$ret);
5561 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
5563 my $obj = $CPAN::META->instance("CPAN::Module",$_);
5564 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
5565 $obj->set(%{$ret->{$_}});
5567 while (($painted/76) < ($i/$until)) {
5568 $CPAN::Frontend->myprint(".");
5571 return if $CPAN::Signal;
5573 $CPAN::Frontend->myprint("DONE\n");
5576 #-> sub CPAN::Index::write_metadata_cache ;
5577 sub write_metadata_cache {
5579 return unless $CPAN::Config->{'cache_metadata'};
5580 return if CPAN::_sqlite_running;
5581 return unless $CPAN::META->has_usable("Storable");
5583 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
5584 CPAN::Distribution)) {
5585 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
5587 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5588 $cache->{last_time} = $LAST_TIME;
5589 $cache->{DATE_OF_02} = $DATE_OF_02;
5590 $cache->{PROTOCOL} = PROTOCOL;
5591 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
5592 eval { Storable::nstore($cache, $metadata_file) };
5593 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5596 #-> sub CPAN::Index::read_metadata_cache ;
5597 sub read_metadata_cache {
5599 return unless $CPAN::Config->{'cache_metadata'};
5600 return if CPAN::_sqlite_running;
5601 return unless $CPAN::META->has_usable("Storable");
5602 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5603 return unless -r $metadata_file and -f $metadata_file;
5604 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
5606 eval { $cache = Storable::retrieve($metadata_file) };
5607 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5608 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')) {
5612 if (exists $cache->{PROTOCOL}) {
5613 if (PROTOCOL > $cache->{PROTOCOL}) {
5614 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
5615 "with protocol v%s, requiring v%s\n",
5622 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
5623 "with protocol v1.0\n");
5628 while(my($class,$v) = each %$cache) {
5629 next unless $class =~ /^CPAN::/;
5630 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
5631 while (my($id,$ro) = each %$v) {
5632 $CPAN::META->{readwrite}{$class}{$id} ||=
5633 $class->new(ID=>$id, RO=>$ro);
5638 unless ($clcnt) { # sanity check
5639 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
5642 if ($idcnt < 1000) {
5643 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
5644 "in $metadata_file\n");
5647 $CPAN::META->{PROTOCOL} ||=
5648 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
5649 # does initialize to some protocol
5650 $LAST_TIME = $cache->{last_time};
5651 $DATE_OF_02 = $cache->{DATE_OF_02};
5652 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
5653 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
5657 package CPAN::InfoObj;
5663 exists $self->{RO} and return $self->{RO};
5666 #-> sub CPAN::InfoObj::cpan_userid
5671 return $ro->{CPAN_USERID} || "N/A";
5673 $self->debug("ID[$self->{ID}]");
5674 # N/A for bundles found locally
5679 sub id { shift->{ID}; }
5681 #-> sub CPAN::InfoObj::new ;
5683 my $this = bless {}, shift;
5688 # The set method may only be used by code that reads index data or
5689 # otherwise "objective" data from the outside world. All session
5690 # related material may do anything else with instance variables but
5691 # must not touch the hash under the RO attribute. The reason is that
5692 # the RO hash gets written to Metadata file and is thus persistent.
5694 #-> sub CPAN::InfoObj::safe_chdir ;
5696 my($self,$todir) = @_;
5697 # we die if we cannot chdir and we are debuggable
5698 Carp::confess("safe_chdir called without todir argument")
5699 unless defined $todir and length $todir;
5701 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5705 unless (-x $todir) {
5706 unless (chmod 0755, $todir) {
5707 my $cwd = CPAN::anycwd();
5708 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
5709 "permission to change the permission; cannot ".
5710 "chdir to '$todir'\n");
5711 $CPAN::Frontend->mysleep(5);
5712 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5713 qq{to todir[$todir]: $!});
5717 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
5720 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5723 my $cwd = CPAN::anycwd();
5724 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5725 qq{to todir[$todir] (a chmod has been issued): $!});
5730 #-> sub CPAN::InfoObj::set ;
5732 my($self,%att) = @_;
5733 my $class = ref $self;
5735 # This must be ||=, not ||, because only if we write an empty
5736 # reference, only then the set method will write into the readonly
5737 # area. But for Distributions that spring into existence, maybe
5738 # because of a typo, we do not like it that they are written into
5739 # the readonly area and made permanent (at least for a while) and
5740 # that is why we do not "allow" other places to call ->set.
5741 unless ($self->id) {
5742 CPAN->debug("Bug? Empty ID, rejecting");
5745 my $ro = $self->{RO} =
5746 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
5748 while (my($k,$v) = each %att) {
5753 #-> sub CPAN::InfoObj::as_glimpse ;
5757 my $class = ref($self);
5758 $class =~ s/^CPAN:://;
5759 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
5760 push @m, sprintf "%-15s %s\n", $class, $id;
5764 #-> sub CPAN::InfoObj::as_string ;
5768 my $class = ref($self);
5769 $class =~ s/^CPAN:://;
5770 push @m, $class, " id = $self->{ID}\n";
5772 unless ($ro = $self->ro) {
5773 if (substr($self->{ID},-1,1) eq ".") { # directory
5776 $CPAN::Frontend->mywarn("Unknown object $self->{ID}\n");
5777 $CPAN::Frontend->mysleep(5);
5781 for (sort keys %$ro) {
5782 # next if m/^(ID|RO)$/;
5784 if ($_ eq "CPAN_USERID") {
5786 $extra .= $self->fullname;
5787 my $email; # old perls!
5788 if ($email = $CPAN::META->instance("CPAN::Author",
5791 $extra .= " <$email>";
5793 $extra .= " <no email>";
5796 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
5797 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
5800 next unless defined $ro->{$_};
5801 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
5803 KEY: for (sort keys %$self) {
5804 next if m/^(ID|RO)$/;
5805 unless (defined $self->{$_}) {
5809 if (ref($self->{$_}) eq "ARRAY") {
5810 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
5811 } elsif (ref($self->{$_}) eq "HASH") {
5813 if (/^CONTAINSMODS$/) {
5814 $value = join(" ",sort keys %{$self->{$_}});
5815 } elsif (/^prereq_pm$/) {
5817 my $v = $self->{$_};
5818 for my $x (sort keys %$v) {
5820 for my $y (sort keys %{$v->{$x}}) {
5821 push @svalue, "$y=>$v->{$x}{$y}";
5823 push @value, "$x\:" . join ",", @svalue if @svalue;
5825 $value = join ";", @value;
5827 $value = $self->{$_};
5835 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
5841 #-> sub CPAN::InfoObj::fullname ;
5844 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
5847 #-> sub CPAN::InfoObj::dump ;
5849 my($self, $what) = @_;
5850 unless ($CPAN::META->has_inst("Data::Dumper")) {
5851 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
5853 local $Data::Dumper::Sortkeys;
5854 $Data::Dumper::Sortkeys = 1;
5855 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
5856 if (length $out > 100000) {
5857 my $fh_pager = FileHandle->new;
5858 local($SIG{PIPE}) = "IGNORE";
5859 my $pager = $CPAN::Config->{'pager'} || "cat";
5860 $fh_pager->open("|$pager")
5861 or die "Could not open pager $pager\: $!";
5862 $fh_pager->print($out);
5865 $CPAN::Frontend->myprint($out);
5869 package CPAN::Author;
5872 #-> sub CPAN::Author::force
5878 #-> sub CPAN::Author::force
5881 delete $self->{force};
5884 #-> sub CPAN::Author::id
5887 my $id = $self->{ID};
5888 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
5892 #-> sub CPAN::Author::as_glimpse ;
5896 my $class = ref($self);
5897 $class =~ s/^CPAN:://;
5898 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
5906 #-> sub CPAN::Author::fullname ;
5908 shift->ro->{FULLNAME};
5912 #-> sub CPAN::Author::email ;
5913 sub email { shift->ro->{EMAIL}; }
5915 #-> sub CPAN::Author::ls ;
5918 my $glob = shift || "";
5919 my $silent = shift || 0;
5922 # adapted from CPAN::Distribution::verifyCHECKSUM ;
5923 my(@csf); # chksumfile
5924 @csf = $self->id =~ /(.)(.)(.*)/;
5925 $csf[1] = join "", @csf[0,1];
5926 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
5928 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
5929 unless (grep {$_->[2] eq $csf[1]} @dl) {
5930 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
5933 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
5934 unless (grep {$_->[2] eq $csf[2]} @dl) {
5935 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5938 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5940 if ($CPAN::META->has_inst("Text::Glob")) {
5941 my $rglob = Text::Glob::glob_to_regex($glob);
5942 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5944 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5947 unless ($silent >= 2) {
5948 $CPAN::Frontend->myprint(join "", map {
5949 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5950 } sort { $a->[2] cmp $b->[2] } @dl);
5955 # returns an array of arrays, the latter contain (size,mtime,filename)
5956 #-> sub CPAN::Author::dir_listing ;
5959 my $chksumfile = shift;
5960 my $recursive = shift;
5961 my $may_ftp = shift;
5964 File::Spec->catfile($CPAN::Config->{keep_source_where},
5965 "authors", "id", @$chksumfile);
5969 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5970 # hazard. (Without GPG installed they are not that much better,
5972 $fh = FileHandle->new;
5973 if (open($fh, $lc_want)) {
5974 my $line = <$fh>; close $fh;
5975 unlink($lc_want) unless $line =~ /PGP/;
5979 # connect "force" argument with "index_expire".
5980 my $force = $self->{force};
5981 if (my @stat = stat $lc_want) {
5982 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5986 $lc_file = CPAN::FTP->localize(
5987 "authors/id/@$chksumfile",
5992 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5993 $chksumfile->[-1] .= ".gz";
5994 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5997 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5998 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
6004 $lc_file = $lc_want;
6005 # we *could* second-guess and if the user has a file: URL,
6006 # then we could look there. But on the other hand, if they do
6007 # have a file: URL, wy did they choose to set
6008 # $CPAN::Config->{show_upload_date} to false?
6011 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
6012 $fh = FileHandle->new;
6014 if (open $fh, $lc_file) {
6017 $eval =~ s/\015?\012/\n/g;
6019 my($compmt) = Safe->new();
6020 $cksum = $compmt->reval($eval);
6022 rename $lc_file, "$lc_file.bad";
6023 Carp::confess($@) if $@;
6025 } elsif ($may_ftp) {
6026 Carp::carp "Could not open '$lc_file' for reading.";
6028 # Maybe should warn: "You may want to set show_upload_date to a true value"
6032 for $f (sort keys %$cksum) {
6033 if (exists $cksum->{$f}{isdir}) {
6035 my(@dir) = @$chksumfile;
6037 push @dir, $f, "CHECKSUMS";
6039 [$_->[0], $_->[1], "$f/$_->[2]"]
6040 } $self->dir_listing(\@dir,1,$may_ftp);
6042 push @result, [ 0, "-", $f ];
6046 ($cksum->{$f}{"size"}||0),
6047 $cksum->{$f}{"mtime"}||"---",
6055 #-> sub CPAN::Author::reports
6057 $CPAN::Frontend->mywarn("reports on authors not implemented.
6058 Please file a bugreport if you need this.\n");
6061 package CPAN::Distribution;
6064 use CPAN::Distroprefs;
6069 my $ro = $self->ro or return;
6073 #-> CPAN::Distribution::undelay
6077 "configure_requires_later",
6078 "configure_requires_later_for",
6082 delete $self->{$delayer};
6086 #-> CPAN::Distribution::is_dot_dist
6089 return substr($self->id,-1,1) eq ".";
6092 # add the A/AN/ stuff
6093 #-> CPAN::Distribution::normalize
6096 $s = $self->id unless defined $s;
6097 if (substr($s,-1,1) eq ".") {
6098 # using a global because we are sometimes called as static method
6099 if (!$CPAN::META->{LOCK}
6100 && !$CPAN::Have_warned->{"$s is unlocked"}++
6102 $CPAN::Frontend->mywarn("You are visiting the local directory
6104 without lock, take care that concurrent processes do not do likewise.\n");
6105 $CPAN::Frontend->mysleep(1);
6108 $s = "$CPAN::iCwd/.";
6109 } elsif (File::Spec->file_name_is_absolute($s)) {
6110 } elsif (File::Spec->can("rel2abs")) {
6111 $s = File::Spec->rel2abs($s);
6113 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
6115 CPAN->debug("s[$s]") if $CPAN::DEBUG;
6116 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
6117 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
6118 $_->{build_dir} = $s;
6119 $_->{archived} = "local_directory";
6120 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
6126 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
6128 return $s if $s =~ m:^N/A|^Contact Author: ;
6129 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4|;
6130 CPAN->debug("s[$s]") if $CPAN::DEBUG;
6135 #-> sub CPAN::Distribution::author ;
6139 if (substr($self->id,-1,1) eq ".") {
6140 $authorid = "LOCAL";
6142 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
6144 CPAN::Shell->expand("Author",$authorid);
6147 # tries to get the yaml from CPAN instead of the distro itself:
6148 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
6151 my $meta = $self->pretty_id;
6152 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
6153 my(@ls) = CPAN::Shell->globls($meta);
6154 my $norm = $self->normalize($meta);
6158 File::Spec->catfile(
6159 $CPAN::Config->{keep_source_where},
6164 $self->debug("Doing localize") if $CPAN::DEBUG;
6165 unless ($local_file =
6166 CPAN::FTP->localize("authors/id/$norm",
6168 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
6170 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
6173 #-> sub CPAN::Distribution::cpan_userid
6176 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
6179 return $self->SUPER::cpan_userid;
6182 #-> sub CPAN::Distribution::pretty_id
6186 return $id unless $id =~ m|^./../|;
6190 #-> sub CPAN::Distribution::base_id
6193 my $id = $self->pretty_id();
6194 my $base_id = File::Basename::basename($id);
6195 $base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i;
6199 #-> sub CPAN::Distribution::tested_ok_but_not_installed
6200 sub tested_ok_but_not_installed {
6204 && $self->{build_dir}
6205 && (UNIVERSAL::can($self->{make_test},"failed") ?
6206 ! $self->{make_test}->failed :
6207 $self->{make_test} =~ /^YES/
6212 $self->{install}->failed
6218 # mark as dirty/clean for the sake of recursion detection. $color=1
6219 # means "in use", $color=0 means "not in use anymore". $color=2 means
6220 # we have determined prereqs now and thus insist on passing this
6221 # through (at least) once again.
6223 #-> sub CPAN::Distribution::color_cmd_tmps ;
6224 sub color_cmd_tmps {
6226 my($depth) = shift || 0;
6227 my($color) = shift || 0;
6228 my($ancestors) = shift || [];
6229 # a distribution needs to recurse into its prereq_pms
6231 return if exists $self->{incommandcolor}
6233 && $self->{incommandcolor}==$color;
6234 if ($depth>=$CPAN::MAX_RECURSION) {
6235 die(CPAN::Exception::RecursiveDependency->new($ancestors));
6237 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6238 my $prereq_pm = $self->prereq_pm;
6239 if (defined $prereq_pm) {
6240 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
6241 keys %{$prereq_pm->{build_requires}||{}}) {
6242 next PREREQ if $pre eq "perl";
6244 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
6245 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
6246 $CPAN::Frontend->mysleep(2);
6249 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6253 delete $self->{sponsored_mods};
6255 # as we are at the end of a command, we'll give up this
6256 # reminder of a broken test. Other commands may test this guy
6257 # again. Maybe 'badtestcnt' should be renamed to
6258 # 'make_test_failed_within_command'?
6259 delete $self->{badtestcnt};
6261 $self->{incommandcolor} = $color;
6264 #-> sub CPAN::Distribution::as_string ;
6267 $self->containsmods;
6269 $self->SUPER::as_string(@_);
6272 #-> sub CPAN::Distribution::containsmods ;
6275 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
6276 my $dist_id = $self->{ID};
6277 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
6278 my $mod_file = $mod->cpan_file or next;
6279 my $mod_id = $mod->{ID} or next;
6280 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
6282 if ($CPAN::Signal) {
6283 delete $self->{CONTAINSMODS};
6286 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
6288 keys %{$self->{CONTAINSMODS}||={}};
6291 #-> sub CPAN::Distribution::upload_date ;
6294 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
6295 my(@local_wanted) = split(/\//,$self->id);
6296 my $filename = pop @local_wanted;
6297 push @local_wanted, "CHECKSUMS";
6298 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
6299 return unless $author;
6300 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
6302 my($dirent) = grep { $_->[2] eq $filename } @dl;
6303 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
6304 return unless $dirent->[1];
6305 return $self->{UPLOAD_DATE} = $dirent->[1];
6308 #-> sub CPAN::Distribution::uptodate ;
6312 foreach $c ($self->containsmods) {
6313 my $obj = CPAN::Shell->expandany($c);
6314 unless ($obj->uptodate) {
6315 my $id = $self->pretty_id;
6316 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
6323 #-> sub CPAN::Distribution::called_for ;
6326 $self->{CALLED_FOR} = $id if defined $id;
6327 return $self->{CALLED_FOR};
6330 #-> sub CPAN::Distribution::get ;
6333 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
6334 if (my $goto = $self->prefs->{goto}) {
6335 $CPAN::Frontend->mywarn
6337 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
6339 $self->{prefs_file},
6340 $self->{prefs_file_doc},
6342 return $self->goto($goto);
6344 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6346 : ($ENV{PERLLIB} || "");
6347 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
6348 $CPAN::META->set_perl5lib;
6349 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6353 my $goodbye_message;
6354 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
6355 if ($self->prefs->{disabled} && ! $self->{force_update}) {
6357 "Disabled via prefs file '%s' doc %d",
6358 $self->{prefs_file},
6359 $self->{prefs_file_doc},
6362 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
6363 $goodbye_message = "[disabled] -- NA $why";
6364 # note: not intended to be persistent but at least visible
6365 # during this session
6367 if (exists $self->{build_dir} && -d $self->{build_dir}
6368 && ($self->{modulebuild}||$self->{writemakefile})
6370 # this deserves print, not warn:
6371 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
6372 "$self->{build_dir}\n"
6377 # although we talk about 'force' we shall not test on
6378 # force directly. New model of force tries to refrain from
6379 # direct checking of force.
6380 exists $self->{unwrapped} and (
6381 UNIVERSAL::can($self->{unwrapped},"failed") ?
6382 $self->{unwrapped}->failed :
6383 $self->{unwrapped} =~ /^NO/
6385 and push @e, "Unwrapping had some problem, won't try again without force";
6388 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e);
6389 if ($goodbye_message) {
6390 $self->goodbye($goodbye_message);
6395 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
6398 unless ($self->{build_dir} && -d $self->{build_dir}) {
6399 $self->get_file_onto_local_disk;
6400 return if $CPAN::Signal;
6401 $self->check_integrity;
6402 return if $CPAN::Signal;
6403 (my $packagedir,$local_file) = $self->run_preps_on_packagedir;
6404 if (exists $self->{writemakefile} && ref $self->{writemakefile}
6405 && $self->{writemakefile}->can("failed") &&
6406 $self->{writemakefile}->failed) {
6409 $packagedir ||= $self->{build_dir};
6410 $self->{build_dir} = $packagedir;
6413 if ($CPAN::Signal) {
6414 $self->safe_chdir($sub_wd);
6417 return $self->choose_MM_or_MB($local_file);
6420 #-> CPAN::Distribution::get_file_onto_local_disk
6421 sub get_file_onto_local_disk {
6424 return if $self->is_dot_dist;
6427 File::Spec->catfile(
6428 $CPAN::Config->{keep_source_where},
6431 split(/\//,$self->id)
6434 $self->debug("Doing localize") if $CPAN::DEBUG;
6435 unless ($local_file =
6436 CPAN::FTP->localize("authors/id/$self->{ID}",
6439 if ($CPAN::Index::DATE_OF_02) {
6440 $note = "Note: Current database in memory was generated ".
6441 "on $CPAN::Index::DATE_OF_02\n";
6443 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
6446 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
6447 $self->{localfile} = $local_file;
6451 #-> CPAN::Distribution::check_integrity
6452 sub check_integrity {
6455 return if $self->is_dot_dist;
6456 if ($CPAN::META->has_inst("Digest::SHA")) {
6457 $self->debug("Digest::SHA is installed, verifying");
6458 $self->verifyCHECKSUM;
6460 $self->debug("Digest::SHA is NOT installed");
6464 #-> CPAN::Distribution::run_preps_on_packagedir
6465 sub run_preps_on_packagedir {
6467 return if $self->is_dot_dist;
6469 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
6470 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
6471 $self->safe_chdir($builddir);
6472 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
6473 File::Path::rmtree("tmp-$$");
6474 unless (mkdir "tmp-$$", 0755) {
6475 $CPAN::Frontend->unrecoverable_error(<<EOF);
6476 Couldn't mkdir '$builddir/tmp-$$': $!
6478 Cannot continue: Please find the reason why I cannot make the
6481 and fix the problem, then retry.
6485 if ($CPAN::Signal) {
6488 $self->safe_chdir("tmp-$$");
6493 my $local_file = $self->{localfile};
6494 my $ct = eval{CPAN::Tarzip->new($local_file)};
6496 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
6497 delete $self->{build_dir};
6500 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) {
6501 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
6502 $self->untar_me($ct);
6503 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
6504 $self->unzip_me($ct);
6506 $self->{was_uncompressed}++ unless $ct->gtest();
6507 $local_file = $self->handle_singlefile($local_file);
6510 # we are still in the tmp directory!
6511 # Let's check if the package has its own directory.
6512 my $dh = DirHandle->new(File::Spec->curdir)
6513 or Carp::croak("Couldn't opendir .: $!");
6514 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
6515 if (grep { $_ eq "pax_global_header" } @readdir) {
6516 $CPAN::Frontend->mywarn("Your (un)tar seems to have extracted a file named 'pax_global_header'
6517 from the tarball '$local_file'.
6518 This is almost certainly an error. Please upgrade your tar.
6519 I'll ignore this file for now.
6520 See also http://rt.cpan.org/Ticket/Display.html?id=38932\n");
6521 $CPAN::Frontend->mysleep(5);
6522 @readdir = grep { $_ ne "pax_global_header" } @readdir;
6526 # XXX here we want in each branch File::Temp to protect all build_dir directories
6527 if (CPAN->has_usable("File::Temp")) {
6531 if (@readdir == 1 && -d $readdir[0]) {
6532 $tdir_base = $readdir[0];
6533 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
6535 unless ($dh2 = DirHandle->new($from_dir)) {
6536 my($mode) = (stat $from_dir)[2];
6539 "Couldn't opendir '%s', mode '%o': %s",
6544 $CPAN::Frontend->mywarn("$why\n");
6545 $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why");
6548 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
6550 my $userid = $self->cpan_userid;
6551 CPAN->debug("userid[$userid]");
6552 if (!$userid or $userid eq "N/A") {
6555 $tdir_base = $userid;
6556 $from_dir = File::Spec->curdir;
6557 @dirents = @readdir;
6559 $packagedir = File::Temp::tempdir(
6560 "$tdir_base-XXXXXX",
6565 for $f (@dirents) { # is already without "." and ".."
6566 my $from = File::Spec->catdir($from_dir,$f);
6567 my $to = File::Spec->catdir($packagedir,$f);
6568 unless (File::Copy::move($from,$to)) {
6570 $from = File::Spec->rel2abs($from);
6571 Carp::confess("Couldn't move $from to $to: $err");
6574 } else { # older code below, still better than nothing when there is no File::Temp
6576 if (@readdir == 1 && -d $readdir[0]) {
6577 $distdir = $readdir[0];
6578 $packagedir = File::Spec->catdir($builddir,$distdir);
6579 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
6581 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
6583 File::Path::rmtree($packagedir);
6584 unless (File::Copy::move($distdir,$packagedir)) {
6585 $CPAN::Frontend->unrecoverable_error(<<EOF);
6586 Couldn't move '$distdir' to '$packagedir': $!
6588 Cannot continue: Please find the reason why I cannot move
6589 $builddir/tmp-$$/$distdir
6592 and fix the problem, then retry
6596 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
6603 my $userid = $self->cpan_userid;
6604 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
6605 if (!$userid or $userid eq "N/A") {
6608 my $pragmatic_dir = $userid . '000';
6609 $pragmatic_dir =~ s/\W_//g;
6610 $pragmatic_dir++ while -d "../$pragmatic_dir";
6611 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
6612 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
6613 File::Path::mkpath($packagedir);
6615 for $f (@readdir) { # is already without "." and ".."
6616 my $to = File::Spec->catdir($packagedir,$f);
6617 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
6621 $self->{build_dir} = $packagedir;
6622 $self->safe_chdir($builddir);
6623 File::Path::rmtree("tmp-$$");
6625 $self->safe_chdir($packagedir);
6626 $self->_signature_business();
6627 $self->safe_chdir($builddir);
6629 return($packagedir,$local_file);
6632 #-> sub CPAN::Distribution::parse_meta_yml ;
6633 sub parse_meta_yml {
6635 my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir";
6636 my $yaml = File::Spec->catfile($build_dir,"META.yml");
6637 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
6638 return unless -f $yaml;
6641 require Parse::Metayaml; # hypothetical
6642 $early_yaml = Parse::Metayaml::LoadFile($yaml)->[0];
6644 unless ($early_yaml) {
6645 eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; };
6647 unless ($early_yaml) {
6653 #-> sub CPAN::Distribution::satisfy_requires ;
6654 sub satisfy_requires {
6656 if (my @prereq = $self->unsat_prereq("later")) {
6657 if ($prereq[0][0] eq "perl") {
6658 my $need = "requires perl '$prereq[0][1]'";
6659 my $id = $self->pretty_id;
6660 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6661 $self->{make} = CPAN::Distrostatus->new("NO $need");
6662 $self->store_persistent_state;
6663 die "[prereq] -- NOT OK\n";
6665 my $follow = eval { $self->follow_prereqs("later",@prereq); };
6668 # signal success to the queuerunner
6670 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
6671 $CPAN::Frontend->mywarn($@);
6672 die "[depend] -- NOT OK\n";
6678 #-> sub CPAN::Distribution::satisfy_configure_requires ;
6679 sub satisfy_configure_requires {
6681 my $enable_configure_requires = 1;
6682 if (!$enable_configure_requires) {
6684 # if we return 1 here, everything is as before we introduced
6685 # configure_requires that means, things with
6686 # configure_requires simply fail, all others succeed
6688 my @prereq = $self->unsat_prereq("configure_requires_later") or return 1;
6689 if ($self->{configure_requires_later}) {
6690 for my $k (keys %{$self->{configure_requires_later_for}||{}}) {
6691 if ($self->{configure_requires_later_for}{$k}>1) {
6692 # we must not come here a second time
6693 $CPAN::Frontend->mywarn("Panic: Some prerequisites is not available, please investigate...");
6695 $CPAN::Frontend->mydie
6698 ({self=>$self, prereq=>\@prereq})
6703 if ($prereq[0][0] eq "perl") {
6704 my $need = "requires perl '$prereq[0][1]'";
6705 my $id = $self->pretty_id;
6706 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6707 $self->{make} = CPAN::Distrostatus->new("NO $need");
6708 $self->store_persistent_state;
6709 return $self->goodbye("[prereq] -- NOT OK");
6712 $self->follow_prereqs("configure_requires_later", @prereq);
6717 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
6718 $CPAN::Frontend->mywarn($@);
6719 return $self->goodbye("[depend] -- NOT OK");
6722 die "never reached";
6725 #-> sub CPAN::Distribution::choose_MM_or_MB ;
6726 sub choose_MM_or_MB {
6727 my($self,$local_file) = @_;
6728 $self->satisfy_configure_requires() or return;
6729 my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL");
6730 my($mpl_exists) = -f $mpl;
6731 unless ($mpl_exists) {
6732 # NFS has been reported to have racing problems after the
6733 # renaming of a directory in some environments.
6735 $CPAN::Frontend->mysleep(1);
6736 my $mpldh = DirHandle->new($self->{build_dir})
6737 or Carp::croak("Couldn't opendir $self->{build_dir}: $!");
6738 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
6741 my $prefer_installer = "eumm"; # eumm|mb
6742 if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) {
6743 if ($mpl_exists) { # they *can* choose
6744 if ($CPAN::META->has_inst("Module::Build")) {
6745 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
6746 q{prefer_installer});
6749 $prefer_installer = "mb";
6752 return unless $self->patch;
6753 if (lc($prefer_installer) eq "rand") {
6754 $prefer_installer = rand()<.5 ? "eumm" : "mb";
6756 if (lc($prefer_installer) eq "mb") {
6757 $self->{modulebuild} = 1;
6758 } elsif ($self->{archived} eq "patch") {
6759 # not an edge case, nothing to install for sure
6760 my $why = "A patch file cannot be installed";
6761 $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n");
6762 $self->{writemakefile} = CPAN::Distrostatus->new("NO $why");
6763 } elsif (! $mpl_exists) {
6764 $self->_edge_cases($mpl,$local_file);
6766 if ($self->{build_dir}
6768 $CPAN::Config->{build_dir_reuse}
6770 $self->store_persistent_state;
6775 #-> CPAN::Distribution::store_persistent_state
6776 sub store_persistent_state {
6778 my $dir = $self->{build_dir};
6779 unless (File::Spec->canonpath(File::Basename::dirname($dir))
6780 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
6781 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
6782 "will not store persistent state\n");
6785 my $file = sprintf "%s.yml", $dir;
6786 my $yaml_module = CPAN::_yaml_module;
6787 if ($CPAN::META->has_inst($yaml_module)) {
6788 CPAN->_yaml_dumpfile(
6792 perl => CPAN::_perl_fingerprint,
6793 distribution => $self,
6797 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
6798 "will not store persistent state\n");
6802 #-> CPAN::Distribution::try_download
6804 my($self,$patch) = @_;
6805 my $norm = $self->normalize($patch);
6807 File::Spec->catfile(
6808 $CPAN::Config->{keep_source_where},
6813 $self->debug("Doing localize") if $CPAN::DEBUG;
6814 return CPAN::FTP->localize("authors/id/$norm",
6819 my $stdpatchargs = "";
6820 #-> CPAN::Distribution::patch
6823 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
6824 my $patches = $self->prefs->{patches};
6826 $self->debug("patches[$patches]") if $CPAN::DEBUG;
6828 return unless @$patches;
6829 $self->safe_chdir($self->{build_dir});
6830 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
6831 my $patchbin = $CPAN::Config->{patch};
6832 unless ($patchbin && length $patchbin) {
6833 $CPAN::Frontend->mydie("No external patch command configured\n\n".
6834 "Please run 'o conf init /patch/'\n\n");
6836 unless (MM->maybe_command($patchbin)) {
6837 $CPAN::Frontend->mydie("No external patch command available\n\n".
6838 "Please run 'o conf init /patch/'\n\n");
6840 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
6841 local $ENV{PATCH_GET} = 0; # formerly known as -g0
6842 unless ($stdpatchargs) {
6843 my $system = "$patchbin --version |";
6845 open FH, $system or die "Could not fork '$system': $!";
6848 PARSEVERSION: while (<FH>) {
6849 if (/^patch\s+([\d\.]+)/) {
6855 $stdpatchargs = "-N --fuzz=3";
6857 $stdpatchargs = "-N";
6860 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
6861 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
6862 for my $patch (@$patches) {
6863 unless (-f $patch) {
6864 if (my $trydl = $self->try_download($patch)) {
6867 my $fail = "Could not find patch '$patch'";
6868 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6869 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6870 delete $self->{build_dir};
6874 $CPAN::Frontend->myprint(" $patch\n");
6875 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
6878 my $ppp = $self->_patch_p_parameter($readfh);
6879 if ($ppp eq "applypatch") {
6880 $pcommand = "$CPAN::Config->{applypatch} -verbose";
6882 my $thispatchargs = join " ", $stdpatchargs, $ppp;
6883 $pcommand = "$patchbin $thispatchargs";
6886 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
6887 my $writefh = FileHandle->new;
6888 $CPAN::Frontend->myprint(" $pcommand\n");
6889 unless (open $writefh, "|$pcommand") {
6890 my $fail = "Could not fork '$pcommand'";
6891 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6892 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6893 delete $self->{build_dir};
6896 while (my $x = $readfh->READLINE) {
6899 unless (close $writefh) {
6900 my $fail = "Could not apply patch '$patch'";
6901 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6902 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6903 delete $self->{build_dir};
6913 sub _patch_p_parameter {
6916 my $cnt_p0files = 0;
6918 while ($_ = $fh->READLINE) {
6920 $CPAN::Config->{applypatch}
6922 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
6926 next unless /^[\*\+]{3}\s(\S+)/;
6929 $cnt_p0files++ if -f $file;
6930 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
6933 return "-p1" unless $cnt_files;
6934 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
6937 #-> sub CPAN::Distribution::_edge_cases
6938 # with "configure" or "Makefile" or single file scripts
6940 my($self,$mpl,$local_file) = @_;
6941 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
6945 my $build_dir = $self->{build_dir};
6946 my($configure) = File::Spec->catfile($build_dir,"Configure");
6947 if (-f $configure) {
6948 # do we have anything to do?
6949 $self->{configure} = $configure;
6950 } elsif (-f File::Spec->catfile($build_dir,"Makefile")) {
6951 $CPAN::Frontend->mywarn(qq{
6952 Package comes with a Makefile and without a Makefile.PL.
6953 We\'ll try to build it with that Makefile then.
6955 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6956 $CPAN::Frontend->mysleep(2);
6958 my $cf = $self->called_for || "unknown";
6963 $cf =~ s|[/\\:]||g; # risk of filesystem damage
6964 $cf = "unknown" unless length($cf);
6965 if (my $crap = $self->_contains_crap($build_dir)) {
6966 my $why = qq{Package contains $crap; not recognized as a perl package, giving up};
6967 $CPAN::Frontend->mywarn("$why\n");
6968 $self->{writemakefile} = CPAN::Distrostatus->new(qq{NO -- $why});
6971 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
6972 (The test -f "$mpl" returned false.)
6973 Writing one on our own (setting NAME to $cf)\a\n});
6974 $self->{had_no_makefile_pl}++;
6975 $CPAN::Frontend->mysleep(3);
6977 # Writing our own Makefile.PL
6979 my $exefile_stanza = "";
6980 if ($self->{archived} eq "maybe_pl") {
6981 $exefile_stanza = $self->_exefile_stanza($build_dir,$local_file);
6984 my $fh = FileHandle->new;
6986 or Carp::croak("Could not open >$mpl: $!");
6988 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
6989 # because there was no Makefile.PL supplied.
6990 # Autogenerated on: }.scalar localtime().qq{
6992 use ExtUtils::MakeMaker;
6994 NAME => q[$cf],$exefile_stanza
7001 #-> CPAN;:Distribution::_contains_crap
7002 sub _contains_crap {
7003 my($self,$dir) = @_;
7004 my(@dirs, $dh, @files);
7005 opendir $dh, $dir or return;
7007 for $dirent (readdir $dh) {
7008 next if $dirent =~ /^\.\.?$/;
7009 my $path = File::Spec->catdir($dir,$dirent);
7011 push @dirs, $dirent;
7012 } elsif (-f $path) {
7013 push @files, $dirent;
7016 if (@dirs && @files) {
7017 return "both files[@files] and directories[@dirs]";
7018 } elsif (@files > 2) {
7019 return "several files[@files] but no Makefile.PL or Build.PL";
7024 #-> CPAN;:Distribution::_exefile_stanza
7025 sub _exefile_stanza {
7026 my($self,$build_dir,$local_file) = @_;
7028 my $fh = FileHandle->new;
7029 my $script_file = File::Spec->catfile($build_dir,$local_file);
7030 $fh->open($script_file)
7031 or Carp::croak("Could not open script '$script_file': $!");
7033 # name parsen und prereq
7034 my($state) = "poddir";
7035 my($name, $prereq) = ("", "");
7037 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
7040 } elsif ($1 eq 'PREREQUISITES') {
7043 } elsif ($state =~ m{^(name|prereq)$}) {
7048 } elsif ($state eq "name") {
7053 } elsif ($state eq "prereq") {
7056 } elsif (/^=cut\b/) {
7063 s{.*<}{}; # strip X<...>
7067 $prereq = join " ", split /\s+/, $prereq;
7068 my($PREREQ_PM) = join("\n", map {
7069 s{.*<}{}; # strip X<...>
7071 if (/[\s\'\"]/) { # prose?
7073 s/[^\w:]$//; # period?
7074 " "x28 . "'$_' => 0,";
7076 } split /\s*,\s*/, $prereq);
7079 my $to_file = File::Spec->catfile($build_dir, $name);
7080 rename $script_file, $to_file
7081 or die "Can't rename $script_file to $to_file: $!";
7085 EXE_FILES => ['$name'],
7092 #-> CPAN::Distribution::_signature_business
7093 sub _signature_business {
7095 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
7098 if ($CPAN::META->has_inst("Module::Signature")) {
7099 if (-f "SIGNATURE") {
7100 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
7101 my $rv = Module::Signature::verify();
7102 if ($rv != Module::Signature::SIGNATURE_OK() and
7103 $rv != Module::Signature::SIGNATURE_MISSING()) {
7104 $CPAN::Frontend->mywarn(
7105 qq{\nSignature invalid for }.
7106 qq{distribution file. }.
7107 qq{Please investigate.\n\n}
7111 sprintf(qq{I'd recommend removing %s. Some error occured }.
7112 qq{while checking its signature, so it could }.
7113 qq{be invalid. Maybe you have configured }.
7114 qq{your 'urllist' with a bad URL. Please check this }.
7115 qq{array with 'o conf urllist' and retry. Or }.
7116 qq{examine the distribution in a subshell. Try
7124 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
7125 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
7126 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
7128 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
7129 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
7132 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
7135 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
7140 #-> CPAN::Distribution::untar_me ;
7143 $self->{archived} = "tar";
7144 my $result = eval { $ct->untar() };
7146 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
7148 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
7152 # CPAN::Distribution::unzip_me ;
7155 $self->{archived} = "zip";
7157 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
7159 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
7164 sub handle_singlefile {
7165 my($self,$local_file) = @_;
7167 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ) {
7168 $self->{archived} = "pm";
7169 } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) {
7170 $self->{archived} = "patch";
7172 $self->{archived} = "maybe_pl";
7175 my $to = File::Basename::basename($local_file);
7176 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
7177 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
7178 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
7180 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
7183 if (File::Copy::cp($local_file,".")) {
7184 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
7186 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
7192 #-> sub CPAN::Distribution::new ;
7194 my($class,%att) = @_;
7196 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
7198 my $this = { %att };
7199 return bless $this, $class;
7202 #-> sub CPAN::Distribution::look ;
7206 if ($^O eq 'MacOS') {
7207 $self->Mac::BuildTools::look;
7211 if ( $CPAN::Config->{'shell'} ) {
7212 $CPAN::Frontend->myprint(qq{
7213 Trying to open a subshell in the build directory...
7216 $CPAN::Frontend->myprint(qq{
7217 Your configuration does not define a value for subshells.
7218 Please define it with "o conf shell <your shell>"
7222 my $dist = $self->id;
7224 unless ($dir = $self->dir) {
7227 unless ($dir ||= $self->dir) {
7228 $CPAN::Frontend->mywarn(qq{
7229 Could not determine which directory to use for looking at $dist.
7233 my $pwd = CPAN::anycwd();
7234 $self->safe_chdir($dir);
7235 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
7237 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
7238 $ENV{CPAN_SHELL_LEVEL} += 1;
7239 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
7241 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7243 : ($ENV{PERLLIB} || "");
7245 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
7246 $CPAN::META->set_perl5lib;
7247 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7249 unless (system($shell) == 0) {
7251 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
7254 $self->safe_chdir($pwd);
7257 # CPAN::Distribution::cvs_import ;
7261 my $dir = $self->dir;
7263 my $package = $self->called_for;
7264 my $module = $CPAN::META->instance('CPAN::Module', $package);
7265 my $version = $module->cpan_version;
7267 my $userid = $self->cpan_userid;
7269 my $cvs_dir = (split /\//, $dir)[-1];
7270 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
7272 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
7274 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
7275 if ($cvs_site_perl) {
7276 $cvs_dir = "$cvs_site_perl/$cvs_dir";
7278 my $cvs_log = qq{"imported $package $version sources"};
7279 $version =~ s/\./_/g;
7280 # XXX cvs: undocumented and unclear how it was meant to work
7281 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
7282 "$cvs_dir", $userid, "v$version");
7284 my $pwd = CPAN::anycwd();
7285 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
7287 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
7289 $CPAN::Frontend->myprint(qq{@cmd\n});
7290 system(@cmd) == 0 or
7292 $CPAN::Frontend->mydie("cvs import failed");
7293 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
7296 #-> sub CPAN::Distribution::readme ;
7299 my($dist) = $self->id;
7300 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
7301 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
7304 File::Spec->catfile(
7305 $CPAN::Config->{keep_source_where},
7308 split(/\//,"$sans.readme"),
7310 $self->debug("Doing localize") if $CPAN::DEBUG;
7311 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
7313 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
7315 if ($^O eq 'MacOS') {
7316 Mac::BuildTools::launch_file($local_file);
7320 my $fh_pager = FileHandle->new;
7321 local($SIG{PIPE}) = "IGNORE";
7322 my $pager = $CPAN::Config->{'pager'} || "cat";
7323 $fh_pager->open("|$pager")
7324 or die "Could not open pager $pager\: $!";
7325 my $fh_readme = FileHandle->new;
7326 $fh_readme->open($local_file)
7327 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
7328 $CPAN::Frontend->myprint(qq{
7333 $fh_pager->print(<$fh_readme>);
7337 #-> sub CPAN::Distribution::verifyCHECKSUM ;
7338 sub verifyCHECKSUM {
7342 $self->{CHECKSUM_STATUS} ||= "";
7343 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
7344 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7346 my($lc_want,$lc_file,@local,$basename);
7347 @local = split(/\//,$self->id);
7349 push @local, "CHECKSUMS";
7351 File::Spec->catfile($CPAN::Config->{keep_source_where},
7352 "authors", "id", @local);
7354 if (my $size = -s $lc_want) {
7355 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
7356 if ($self->CHECKSUM_check_file($lc_want,1)) {
7357 return $self->{CHECKSUM_STATUS} = "OK";
7360 $lc_file = CPAN::FTP->localize("authors/id/@local",
7363 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
7364 $local[-1] .= ".gz";
7365 $lc_file = CPAN::FTP->localize("authors/id/@local",
7368 $lc_file =~ s/\.gz(?!\n)\Z//;
7369 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
7374 if ($self->CHECKSUM_check_file($lc_file)) {
7375 return $self->{CHECKSUM_STATUS} = "OK";
7379 #-> sub CPAN::Distribution::SIG_check_file ;
7380 sub SIG_check_file {
7381 my($self,$chk_file) = @_;
7382 my $rv = eval { Module::Signature::_verify($chk_file) };
7384 if ($rv == Module::Signature::SIGNATURE_OK()) {
7385 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
7386 return $self->{SIG_STATUS} = "OK";
7388 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
7389 qq{distribution file. }.
7390 qq{Please investigate.\n\n}.
7392 $CPAN::META->instance(
7397 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
7398 is invalid. Maybe you have configured your 'urllist' with
7399 a bad URL. Please check this array with 'o conf urllist', and
7402 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
7406 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
7408 # sloppy is 1 when we have an old checksums file that maybe is good
7411 sub CHECKSUM_check_file {
7412 my($self,$chk_file,$sloppy) = @_;
7413 my($cksum,$file,$basename);
7416 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
7417 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
7420 if ($CPAN::META->has_inst("Module::Signature")) {
7421 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
7422 $self->SIG_check_file($chk_file);
7424 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
7428 $file = $self->{localfile};
7429 $basename = File::Basename::basename($file);
7430 my $fh = FileHandle->new;
7431 if (open $fh, $chk_file) {
7434 $eval =~ s/\015?\012/\n/g;
7436 my($compmt) = Safe->new();
7437 $cksum = $compmt->reval($eval);
7439 rename $chk_file, "$chk_file.bad";
7440 Carp::confess($@) if $@;
7443 Carp::carp "Could not open $chk_file for reading";
7446 if (! ref $cksum or ref $cksum ne "HASH") {
7447 $CPAN::Frontend->mywarn(qq{
7448 Warning: checksum file '$chk_file' broken.
7450 When trying to read that file I expected to get a hash reference
7451 for further processing, but got garbage instead.
7453 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
7454 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
7455 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
7457 } elsif (exists $cksum->{$basename}{sha256}) {
7458 $self->debug("Found checksum for $basename:" .
7459 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
7463 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
7465 $fh = CPAN::Tarzip->TIEHANDLE($file);
7468 my $dg = Digest::SHA->new(256);
7471 while ($fh->READ($ref, 4096) > 0) {
7474 my $hexdigest = $dg->hexdigest;
7475 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
7479 $CPAN::Frontend->myprint("Checksum for $file ok\n");
7480 return $self->{CHECKSUM_STATUS} = "OK";
7482 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
7483 qq{distribution file. }.
7484 qq{Please investigate.\n\n}.
7486 $CPAN::META->instance(
7491 my $wrap = qq{I\'d recommend removing $file. Its
7492 checksum is incorrect. Maybe you have configured your 'urllist' with
7493 a bad URL. Please check this array with 'o conf urllist', and
7496 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
7498 # former versions just returned here but this seems a
7499 # serious threat that deserves a die
7501 # $CPAN::Frontend->myprint("\n\n");
7505 # close $fh if fileno($fh);
7508 unless ($self->{CHECKSUM_STATUS}) {
7509 $CPAN::Frontend->mywarn(qq{
7510 Warning: No checksum for $basename in $chk_file.
7512 The cause for this may be that the file is very new and the checksum
7513 has not yet been calculated, but it may also be that something is
7514 going awry right now.
7516 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
7517 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
7519 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
7524 #-> sub CPAN::Distribution::eq_CHECKSUM ;
7526 my($self,$fh,$expect) = @_;
7527 if ($CPAN::META->has_inst("Digest::SHA")) {
7528 my $dg = Digest::SHA->new(256);
7530 while (read($fh, $data, 4096)) {
7533 my $hexdigest = $dg->hexdigest;
7534 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
7535 return $hexdigest eq $expect;
7540 #-> sub CPAN::Distribution::force ;
7542 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
7543 # effect by autoinspection, not by inspecting a global variable. One
7544 # of the reason why this was chosen to work that way was the treatment
7545 # of dependencies. They should not automatically inherit the force
7546 # status. But this has the downside that ^C and die() will return to
7547 # the prompt but will not be able to reset the force_update
7548 # attributes. We try to correct for it currently in the read_metadata
7549 # routine, and immediately before we check for a Signal. I hope this
7550 # works out in one of v1.57_53ff
7552 # "Force get forgets previous error conditions"
7554 #-> sub CPAN::Distribution::fforce ;
7556 my($self, $method) = @_;
7557 $self->force($method,1);
7560 #-> sub CPAN::Distribution::force ;
7562 my($self, $method,$fforce) = @_;
7580 "prereq_pm_detected",
7594 my $methodmatch = 0;
7596 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
7597 $methodmatch = 1 if $fforce || $phase eq $method;
7598 next unless $methodmatch;
7599 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
7600 if ($phase eq "get") {
7601 if (substr($self->id,-1,1) eq "."
7602 && $att =~ /(unwrapped|build_dir|archived)/ ) {
7603 # cannot be undone for local distros
7606 if ($att eq "build_dir"
7607 && $self->{build_dir}
7608 && $CPAN::META->{is_tested}
7610 delete $CPAN::META->{is_tested}{$self->{build_dir}};
7612 } elsif ($phase eq "test") {
7613 if ($att eq "make_test"
7614 && $self->{make_test}
7615 && $self->{make_test}{COMMANDID}
7616 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
7618 # endless loop too likely
7622 delete $self->{$att};
7623 if ($ldebug || $CPAN::DEBUG) {
7624 # local $CPAN::DEBUG = 16; # Distribution
7625 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
7629 if ($method && $method =~ /make|test|install/) {
7630 $self->{force_update} = 1; # name should probably have been force_install
7634 #-> sub CPAN::Distribution::notest ;
7636 my($self, $method) = @_;
7637 # $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method");
7638 $self->{"notest"}++; # name should probably have been force_install
7641 #-> sub CPAN::Distribution::unnotest ;
7644 # warn "XDEBUG: deleting notest";
7645 delete $self->{notest};
7648 #-> sub CPAN::Distribution::unforce ;
7651 delete $self->{force_update};
7654 #-> sub CPAN::Distribution::isa_perl ;
7657 my $file = File::Basename::basename($self->id);
7658 if ($file =~ m{ ^ perl
7667 \.tar[._-](?:gz|bz2)
7671 } elsif ($self->cpan_comment
7673 $self->cpan_comment =~ /isa_perl\(.+?\)/) {
7679 #-> sub CPAN::Distribution::perl ;
7684 carp __PACKAGE__ . "::perl was called without parameters.";
7686 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
7690 #-> sub CPAN::Distribution::make ;
7693 if (my $goto = $self->prefs->{goto}) {
7694 return $self->goto($goto);
7696 my $make = $self->{modulebuild} ? "Build" : "make";
7697 # Emergency brake if they said install Pippi and get newest perl
7698 if ($self->isa_perl) {
7700 $self->called_for ne $self->id &&
7701 ! $self->{force_update}
7703 # if we die here, we break bundles
7706 qq{The most recent version "%s" of the module "%s"
7707 is part of the perl-%s distribution. To install that, you need to run
7708 force install %s --or--
7711 $CPAN::META->instance(
7720 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
7721 $CPAN::Frontend->mysleep(1);
7725 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
7727 return if $self->prefs->{disabled} && ! $self->{force_update};
7728 if ($self->{configure_requires_later}) {
7731 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7733 : ($ENV{PERLLIB} || "");
7734 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
7735 $CPAN::META->set_perl5lib;
7736 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7738 if ($CPAN::Signal) {
7739 delete $self->{force_update};
7746 if (!$self->{archived} || $self->{archived} eq "NO") {
7747 push @e, "Is neither a tar nor a zip archive.";
7750 if (!$self->{unwrapped}
7752 UNIVERSAL::can($self->{unwrapped},"failed") ?
7753 $self->{unwrapped}->failed :
7754 $self->{unwrapped} =~ /^NO/
7756 push @e, "Had problems unarchiving. Please build manually";
7759 unless ($self->{force_update}) {
7760 exists $self->{signature_verify} and
7762 UNIVERSAL::can($self->{signature_verify},"failed") ?
7763 $self->{signature_verify}->failed :
7764 $self->{signature_verify} =~ /^NO/
7766 and push @e, "Did not pass the signature test.";
7769 if (exists $self->{writemakefile} &&
7771 UNIVERSAL::can($self->{writemakefile},"failed") ?
7772 $self->{writemakefile}->failed :
7773 $self->{writemakefile} =~ /^NO/
7775 # XXX maybe a retry would be in order?
7776 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
7777 $self->{writemakefile}->text :
7778 $self->{writemakefile};
7779 $err =~ s/^NO\s*(--\s+)?//;
7780 $err ||= "Had some problem writing Makefile";
7781 $err .= ", won't make";
7785 if (defined $self->{make}) {
7786 if (UNIVERSAL::can($self->{make},"failed") ?
7787 $self->{make}->failed :
7788 $self->{make} =~ /^NO/) {
7789 if ($self->{force_update}) {
7790 # Trying an already failed 'make' (unless somebody else blocks)
7792 # introduced for turning recursion detection into a distrostatus
7793 my $error = length $self->{make}>3
7794 ? substr($self->{make},3) : "Unknown error";
7795 $CPAN::Frontend->mywarn("Could not make: $error\n");
7796 $self->store_persistent_state;
7800 push @e, "Has already been made";
7801 my $wait_for_prereqs = eval { $self->satisfy_requires };
7802 return 1 if $wait_for_prereqs; # tells queuerunner to continue
7803 return $self->goodbye($@) if $@; # tells queuerunner to stop
7807 my $later = $self->{later} || $self->{configure_requires_later};
7808 if ($later) { # see also undelay
7814 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7815 $builddir = $self->dir or
7816 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
7817 unless (chdir $builddir) {
7818 push @e, "Couldn't chdir to '$builddir': $!";
7820 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
7822 if ($CPAN::Signal) {
7823 delete $self->{force_update};
7826 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
7827 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
7829 if ($^O eq 'MacOS') {
7830 Mac::BuildTools::make($self);
7835 while (my($k,$v) = each %ENV) {
7836 next unless defined $v;
7842 if ($self->prefs->{pl}) {
7843 $pl_commandline = $self->prefs->{pl}{commandline};
7845 if ($pl_commandline) {
7846 $system = $pl_commandline;
7848 } elsif ($self->{'configure'}) {
7849 $system = $self->{'configure'};
7850 } elsif ($self->{modulebuild}) {
7851 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
7852 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
7854 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
7856 # This needs a handler that can be turned on or off:
7857 # $switch = "-MExtUtils::MakeMaker ".
7858 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
7860 my $makepl_arg = $self->_make_phase_arg("pl");
7861 $ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir},
7863 $system = sprintf("%s%s Makefile.PL%s",
7865 $switch ? " $switch" : "",
7866 $makepl_arg ? " $makepl_arg" : "",
7870 if ($self->prefs->{pl}) {
7871 $pl_env = $self->prefs->{pl}{env};
7874 for my $e (keys %$pl_env) {
7875 $ENV{$e} = $pl_env->{$e};
7878 if (exists $self->{writemakefile}) {
7880 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
7881 my($ret,$pid,$output);
7884 if ($CPAN::Config->{inactivity_timeout}) {
7886 if ($Config::Config{d_alarm}
7888 $Config::Config{d_alarm} eq "define"
7892 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
7893 "variable 'inactivity_timeout' to ".
7894 "'$CPAN::Config->{inactivity_timeout}'. But ".
7895 "on this machine the system call 'alarm' ".
7896 "isn't available. This means that we cannot ".
7897 "provide the feature of intercepting long ".
7898 "waiting code and will turn this feature off.\n"
7900 $CPAN::Config->{inactivity_timeout} = 0;
7903 if ($go_via_alarm) {
7904 if ( $self->_should_report('pl') ) {
7905 ($output, $ret) = CPAN::Reporter::record_command(
7907 $CPAN::Config->{inactivity_timeout},
7909 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
7913 alarm $CPAN::Config->{inactivity_timeout};
7914 local $SIG{CHLD}; # = sub { wait };
7915 if (defined($pid = fork)) {
7920 # note, this exec isn't necessary if
7921 # inactivity_timeout is 0. On the Mac I'd
7922 # suggest, we set it always to 0.
7926 $CPAN::Frontend->myprint("Cannot fork: $!");
7935 $CPAN::Frontend->myprint($err);
7936 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
7938 $self->store_persistent_state;
7939 return $self->goodbye("$system -- TIMED OUT");
7943 if (my $expect_model = $self->_prefs_with_expect("pl")) {
7944 # XXX probably want to check _should_report here and warn
7945 # about not being able to use CPAN::Reporter with expect
7946 $ret = $self->_run_via_expect($system,'writemakefile',$expect_model);
7948 && $self->{writemakefile}
7949 && $self->{writemakefile}->failed) {
7954 elsif ( $self->_should_report('pl') ) {
7955 ($output, $ret) = CPAN::Reporter::record_command($system);
7956 CPAN::Reporter::grade_PL( $self, $system, $output, $ret );
7959 $ret = system($system);
7962 $self->{writemakefile} = CPAN::Distrostatus
7963 ->new("NO '$system' returned status $ret");
7964 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
7965 $self->store_persistent_state;
7966 return $self->goodbye("$system -- NOT OK");
7969 if (-f "Makefile" || -f "Build") {
7970 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
7971 delete $self->{make_clean}; # if cleaned before, enable next
7973 my $makefile = $self->{modulebuild} ? "Build" : "Makefile";
7974 my $why = "No '$makefile' created";
7975 $CPAN::Frontend->mywarn($why);
7976 $self->{writemakefile} = CPAN::Distrostatus
7977 ->new(qq{NO -- $why\n});
7978 $self->store_persistent_state;
7979 return $self->goodbye("$system -- NOT OK");
7982 if ($CPAN::Signal) {
7983 delete $self->{force_update};
7986 my $wait_for_prereqs = eval { $self->satisfy_requires };
7987 return 1 if $wait_for_prereqs; # tells queuerunner to continue
7988 return $self->goodbye($@) if $@; # tells queuerunner to stop
7989 if ($CPAN::Signal) {
7990 delete $self->{force_update};
7993 my $make_commandline;
7994 if ($self->prefs->{make}) {
7995 $make_commandline = $self->prefs->{make}{commandline};
7997 if ($make_commandline) {
7998 $system = $make_commandline;
7999 $ENV{PERL} = CPAN::find_perl;
8001 if ($self->{modulebuild}) {
8002 unless (-f "Build") {
8003 my $cwd = CPAN::anycwd();
8004 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
8005 " in cwd[$cwd]. Danger, Will Robinson!\n");
8006 $CPAN::Frontend->mysleep(5);
8008 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
8010 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
8012 $system =~ s/\s+$//;
8013 my $make_arg = $self->_make_phase_arg("make");
8014 $system = sprintf("%s%s",
8016 $make_arg ? " $make_arg" : "",
8020 if ($self->prefs->{make}) {
8021 $make_env = $self->prefs->{make}{env};
8023 if ($make_env) { # overriding the local ENV of PL, not the outer
8024 # ENV, but unlikely to be a risk
8025 for my $e (keys %$make_env) {
8026 $ENV{$e} = $make_env->{$e};
8029 my $expect_model = $self->_prefs_with_expect("make");
8030 my $want_expect = 0;
8031 if ( $expect_model && @{$expect_model->{talk}} ) {
8032 my $can_expect = $CPAN::META->has_inst("Expect");
8036 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
8042 # XXX probably want to check _should_report here and
8043 # warn about not being able to use CPAN::Reporter with expect
8044 $system_ok = $self->_run_via_expect($system,'make',$expect_model) == 0;
8046 elsif ( $self->_should_report('make') ) {
8047 my ($output, $ret) = CPAN::Reporter::record_command($system);
8048 CPAN::Reporter::grade_make( $self, $system, $output, $ret );
8049 $system_ok = ! $ret;
8052 $system_ok = system($system) == 0;
8054 $self->introduce_myself;
8056 $CPAN::Frontend->myprint(" $system -- OK\n");
8057 $self->{make} = CPAN::Distrostatus->new("YES");
8059 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
8060 $self->{make} = CPAN::Distrostatus->new("NO");
8061 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8063 $self->store_persistent_state;
8066 # CPAN::Distribution::goodbye ;
8068 my($self,$goodbye) = @_;
8069 my $id = $self->pretty_id;
8070 $CPAN::Frontend->mywarn(" $id\n $goodbye\n");
8074 # CPAN::Distribution::_run_via_expect ;
8075 sub _run_via_expect {
8076 my($self,$system,$phase,$expect_model) = @_;
8077 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
8078 if ($CPAN::META->has_inst("Expect")) {
8079 my $expo = Expect->new; # expo Expect object;
8080 $expo->spawn($system);
8081 $expect_model->{mode} ||= "deterministic";
8082 if ($expect_model->{mode} eq "deterministic") {
8083 return $self->_run_via_expect_deterministic($expo,$phase,$expect_model);
8084 } elsif ($expect_model->{mode} eq "anyorder") {
8085 return $self->_run_via_expect_anyorder($expo,$phase,$expect_model);
8087 die "Panic: Illegal expect mode: $expect_model->{mode}";
8090 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
8091 return system($system);
8095 sub _run_via_expect_anyorder {
8096 my($self,$expo,$phase,$expect_model) = @_;
8097 my $timeout = $expect_model->{timeout} || 5;
8098 my $reuse = $expect_model->{reuse};
8099 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
8101 my $timeout_start = time;
8103 my($eof,$ran_into_timeout);
8104 # XXX not up to the full power of expect. one could certainly
8105 # wrap all of the talk pairs into a single expect call and on
8106 # success tweak it and step ahead to the next question. The
8107 # current implementation unnecessarily limits itself to a
8109 my @match = $expo->expect(1,
8114 $ran_into_timeout++;
8121 $but .= $expo->clear_accum;
8124 return $expo->exitstatus();
8125 } elsif ($ran_into_timeout) {
8126 # warn "DEBUG: they are asking a question, but[$but]";
8127 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
8128 my($next,$send) = @expectacopy[$i,$i+1];
8129 my $regex = eval "qr{$next}";
8130 # warn "DEBUG: will compare with regex[$regex].";
8131 if ($but =~ /$regex/) {
8132 # warn "DEBUG: will send send[$send]";
8134 # never allow reusing an QA pair unless they told us
8135 splice @expectacopy, $i, 2 unless $reuse;
8139 my $have_waited = time - $timeout_start;
8140 if ($have_waited < $timeout) {
8141 # warn "DEBUG: have_waited[$have_waited]timeout[$timeout]";
8144 my $why = "could not answer a question during the dialog";
8145 $CPAN::Frontend->mywarn("Failing: $why\n");
8147 CPAN::Distrostatus->new("NO $why");
8153 sub _run_via_expect_deterministic {
8154 my($self,$expo,$phase,$expect_model) = @_;
8155 my $ran_into_timeout;
8157 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
8158 my $expecta = $expect_model->{talk};
8159 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
8160 my($re,$send) = @$expecta[$i,$i+1];
8161 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
8162 my $regex = eval "qr{$re}";
8163 $expo->expect($timeout,
8165 my $but = $expo->clear_accum;
8166 $CPAN::Frontend->mywarn("EOF (maybe harmless)
8167 expected[$regex]\nbut[$but]\n\n");
8171 my $but = $expo->clear_accum;
8172 $CPAN::Frontend->mywarn("TIMEOUT
8173 expected[$regex]\nbut[$but]\n\n");
8174 $ran_into_timeout++;
8177 if ($ran_into_timeout) {
8178 # note that the caller expects 0 for success
8180 CPAN::Distrostatus->new("NO timeout during expect dialog");
8182 } elsif ($ran_into_eof) {
8188 return $expo->exitstatus();
8191 #-> CPAN::Distribution::_validate_distropref
8192 sub _validate_distropref {
8193 my($self,@args) = @_;
8195 $CPAN::META->has_inst("CPAN::Kwalify")
8197 $CPAN::META->has_inst("Kwalify")
8199 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
8201 $CPAN::Frontend->mywarn($@);
8204 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
8208 #-> CPAN::Distribution::_find_prefs
8211 my $distroid = $self->pretty_id;
8212 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
8213 my $prefs_dir = $CPAN::Config->{prefs_dir};
8214 return if $prefs_dir =~ /^\s*$/;
8215 eval { File::Path::mkpath($prefs_dir); };
8217 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
8219 my $yaml_module = CPAN::_yaml_module;
8222 if ($CPAN::META->has_inst($yaml_module)) {
8223 $ext_map->{yml} = 'CPAN';
8226 if ($CPAN::META->has_inst("Data::Dumper")) {
8227 push @fallbacks, $ext_map->{dd} = 'Data::Dumper';
8229 if ($CPAN::META->has_inst("Storable")) {
8230 push @fallbacks, $ext_map->{st} = 'Storable';
8234 unless ($self->{have_complained_about_missing_yaml}++) {
8235 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
8236 "to @fallbacks to read prefs '$prefs_dir'\n");
8239 unless ($self->{have_complained_about_missing_yaml}++) {
8240 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
8241 "read prefs '$prefs_dir'\n");
8245 my $finder = CPAN::Distroprefs->find($prefs_dir, $ext_map);
8246 DIRENT: while (my $result = $finder->next) {
8247 if ($result->is_warning) {
8248 $CPAN::Frontend->mywarn($result->as_string);
8249 $CPAN::Frontend->mysleep(1);
8251 } elsif ($result->is_fatal) {
8252 $CPAN::Frontend->mydie($result->as_string);
8255 my @prefs = @{ $result->prefs };
8257 ELEMENT: for my $y (0..$#prefs) {
8258 my $pref = $prefs[$y];
8259 $self->_validate_distropref($pref->data, $result->abs, $y);
8261 # I don't know why we silently skip when there's no match, but
8262 # complain if there's an empty match hashref, and there's no
8263 # comment explaining why -- hdp, 2008-03-18
8264 unless ($pref->has_any_match) {
8268 unless ($pref->has_valid_subkeys) {
8269 $CPAN::Frontend->mydie(sprintf
8270 "Nonconforming .%s file '%s': " .
8271 "missing match/* subattribute. " .
8272 "Please remove, cannot continue.",
8273 $result->ext, $result->abs,
8279 distribution => $distroid,
8280 perl => \&CPAN::find_perl,
8281 perlconfig => \%Config::Config,
8282 module => sub { [ $self->containsmods ] },
8285 if ($pref->matches($arg)) {
8287 prefs => $pref->data,
8288 prefs_file => $result->abs,
8289 prefs_file_doc => $y,
8298 # CPAN::Distribution::prefs
8301 if (exists $self->{negative_prefs_cache}
8303 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
8305 delete $self->{negative_prefs_cache};
8306 delete $self->{prefs};
8308 if (exists $self->{prefs}) {
8309 return $self->{prefs}; # XXX comment out during debugging
8311 if ($CPAN::Config->{prefs_dir}) {
8312 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
8313 my $prefs = $self->_find_prefs();
8314 $prefs ||= ""; # avoid warning next line
8315 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
8317 for my $x (qw(prefs prefs_file prefs_file_doc)) {
8318 $self->{$x} = $prefs->{$x};
8322 File::Basename::basename($self->{prefs_file}),
8323 $self->{prefs_file_doc},
8325 my $filler1 = "_" x 22;
8326 my $filler2 = int(66 - length($bs))/2;
8327 $filler2 = 0 if $filler2 < 0;
8328 $filler2 = " " x $filler2;
8329 $CPAN::Frontend->myprint("
8330 $filler1 D i s t r o P r e f s $filler1
8331 $filler2 $bs $filler2
8333 $CPAN::Frontend->mysleep(1);
8334 return $self->{prefs};
8337 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
8338 return $self->{prefs} = +{};
8341 # CPAN::Distribution::_make_phase_arg
8342 sub _make_phase_arg {
8343 my($self, $phase) = @_;
8344 my $_make_phase_arg;
8345 my $prefs = $self->prefs;
8348 && exists $prefs->{$phase}
8349 && exists $prefs->{$phase}{args}
8350 && $prefs->{$phase}{args}
8352 $_make_phase_arg = join(" ",
8353 map {CPAN::HandleConfig
8354 ->safe_quote($_)} @{$prefs->{$phase}{args}},
8358 # cpan[2]> o conf make[TAB]
8359 # make make_install_make_command
8360 # make_arg makepl_arg
8362 # cpan[2]> o conf mbuild[TAB]
8363 # mbuild_arg mbuild_install_build_command
8364 # mbuild_install_arg mbuildpl_arg
8366 my $mantra; # must switch make/mbuild here
8367 if ($self->{modulebuild}) {
8375 test => "_test_arg", # does not really exist but maybe
8376 # will some day and now protects
8377 # us from unini warnings
8378 install => "_install_arg",
8380 my $phase_underscore_meshup = $map{$phase};
8381 my $what = sprintf "%s%s", $mantra, $phase_underscore_meshup;
8383 $_make_phase_arg ||= $CPAN::Config->{$what};
8384 return $_make_phase_arg;
8387 # CPAN::Distribution::_make_command
8394 CPAN::HandleConfig->prefs_lookup($self,
8396 || $Config::Config{make}
8400 # Old style call, without object. Deprecated
8401 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
8404 CPAN::HandleConfig->prefs_lookup($self,q{make})
8405 || $CPAN::Config->{make}
8406 || $Config::Config{make}
8411 #-> sub CPAN::Distribution::follow_prereqs ;
8412 sub follow_prereqs {
8415 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
8416 return unless @prereq_tuples;
8417 my(@good_prereq_tuples);
8418 for my $p (@prereq_tuples) {
8419 # XXX watch out for foul ones
8421 push @good_prereq_tuples, $p;
8423 my $pretty_id = $self->pretty_id;
8425 b => "build_requires",
8429 my($filler1,$filler2,$filler3,$filler4);
8430 my $unsat = "Unsatisfied dependencies detected during";
8431 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
8433 my $r = int(($w - length($unsat))/2);
8434 my $l = $w - length($unsat) - $r;
8435 $filler1 = "-"x4 . " "x$l;
8436 $filler2 = " "x$r . "-"x4 . "\n";
8439 my $r = int(($w - length($pretty_id))/2);
8440 my $l = $w - length($pretty_id) - $r;
8441 $filler3 = "-"x4 . " "x$l;
8442 $filler4 = " "x$r . "-"x4 . "\n";
8445 myprint("$filler1 $unsat $filler2".
8446 "$filler3 $pretty_id $filler4".
8447 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @good_prereq_tuples),
8450 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
8452 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
8453 my $answer = CPAN::Shell::colorable_makemaker_prompt(
8454 "Shall I follow them and prepend them to the queue
8455 of modules we are processing right now?", "yes");
8456 $follow = $answer =~ /^\s*y/i;
8458 my @prereq = map { $_=>[0] } @good_prereq_tuples;
8461 myprint(" Ignoring dependencies on modules @prereq\n");
8465 # color them as dirty
8466 for my $gp (@good_prereq_tuples) {
8467 # warn "calling color_cmd_tmps(0,1)";
8469 my $any = CPAN::Shell->expandany($p);
8470 $self->{$slot . "_for"}{$any->id}++;
8472 $any->color_cmd_tmps(0,2);
8474 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
8475 $CPAN::Frontend->mysleep(2);
8478 # queue them and re-queue yourself
8479 CPAN::Queue->jumpqueue({qmod => $id, reqtype => $self->{reqtype}},
8480 map {+{qmod=>$_->[0],reqtype=>$_->[1]}} reverse @good_prereq_tuples);
8481 $self->{$slot} = "Delayed until after prerequisites";
8482 return 1; # signal success to the queuerunner
8487 sub _feature_depends {
8489 my $meta_yml = $self->parse_meta_yml();
8490 my $optf = $meta_yml->{optional_features} or return;
8491 if (!ref $optf or ref $optf ne "HASH"){
8492 $CPAN::Frontend->mywarn("The content of optional_features is not a HASH reference. Cannot use it.\n");
8495 my $wantf = $self->prefs->{features} or return;
8496 if (!ref $wantf or ref $wantf ne "ARRAY"){
8497 $CPAN::Frontend->mywarn("The content of 'features' is not an ARRAY reference. Cannot use it.\n");
8501 for my $wf (@$wantf) {
8502 if (my $f = $optf->{$wf}) {
8503 $CPAN::Frontend->myprint("Found the demanded feature '$wf' that ".
8504 "is accompanied by this description:\n".
8508 # configure_requires currently not in the spec, unlikely to be useful anyway
8509 for my $reqtype (qw(configure_requires build_requires requires)) {
8510 my $reqhash = $f->{$reqtype} or next;
8511 while (my($k,$v) = each %$reqhash) {
8512 $dep->{$reqtype}{$k} = $v;
8516 $CPAN::Frontend->mywarn("The demanded feature '$wf' was not ".
8517 "found in the META.yml file".
8525 #-> sub CPAN::Distribution::unsat_prereq ;
8526 # return ([Foo,"r"],[Bar,"b"]) for normal modules
8527 # return ([perl=>5.008]) if we need a newer perl than we are running under
8528 # (sorry for the inconsistency, it was an accident)
8530 my($self,$slot) = @_;
8531 my(%merged,$prereq_pm);
8532 my $prefs_depends = $self->prefs->{depends}||{};
8533 my $feature_depends = $self->_feature_depends();
8534 if ($slot eq "configure_requires_later") {
8535 my $meta_yml = $self->parse_meta_yml();
8536 if (defined $meta_yml && (! ref $meta_yml || ref $meta_yml ne "HASH")) {
8537 $CPAN::Frontend->mywarn("The content of META.yml is defined but not a HASH reference. Cannot use it.\n");
8541 %{$meta_yml->{configure_requires}||{}},
8542 %{$prefs_depends->{configure_requires}||{}},
8543 %{$feature_depends->{configure_requires}||{}},
8545 $prereq_pm = {}; # configure_requires defined as "b"
8546 } elsif ($slot eq "later") {
8547 my $prereq_pm_0 = $self->prereq_pm || {};
8548 for my $reqtype (qw(requires build_requires)) {
8549 $prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it
8550 for my $dep ($prefs_depends,$feature_depends) {
8551 for my $k (keys %{$dep->{$reqtype}||{}}) {
8552 $prereq_pm->{$reqtype}{$k} = $dep->{$reqtype}{$k};
8556 %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
8558 die "Panic: illegal slot '$slot'";
8561 my @merged = %merged;
8562 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
8563 NEED: while (my($need_module, $need_version) = each %merged) {
8564 my($available_version,$available_file,$nmo);
8565 if ($need_module eq "perl") {
8566 $available_version = $];
8567 $available_file = CPAN::find_perl;
8569 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
8570 next if $nmo->uptodate;
8571 $available_file = $nmo->available_file;
8573 # if they have not specified a version, we accept any installed one
8574 if (defined $available_file
8575 and ( # a few quick shortcurcuits
8576 not defined $need_version
8577 or $need_version eq '0' # "==" would trigger warning when not numeric
8578 or $need_version eq "undef"
8583 $available_version = $nmo->available_version;
8586 # We only want to install prereqs if either they're not installed
8587 # or if the installed version is too old. We cannot omit this
8588 # check, because if 'force' is in effect, nobody else will check.
8589 if (defined $available_file) {
8590 my $fulfills_all_version_rqs = $self->_fulfills_all_version_rqs
8591 ($need_module,$available_file,$available_version,$need_version);
8592 next NEED if $fulfills_all_version_rqs;
8595 if ($need_module eq "perl") {
8596 return ["perl", $need_version];
8598 $self->{sponsored_mods}{$need_module} ||= 0;
8599 CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG;
8600 if (my $sponsoring = $self->{sponsored_mods}{$need_module}++) {
8601 # We have already sponsored it and for some reason it's still
8602 # not available. So we do ... what??
8604 # if we push it again, we have a potential infinite loop
8606 # The following "next" was a very problematic construct.
8607 # It helped a lot but broke some day and had to be
8610 # We must be able to deal with modules that come again and
8611 # again as a prereq and have themselves prereqs and the
8612 # queue becomes long but finally we would find the correct
8613 # order. The RecursiveDependency check should trigger a
8614 # die when it's becoming too weird. Unfortunately removing
8615 # this next breaks many other things.
8617 # The bug that brought this up is described in Todo under
8618 # "5.8.9 cannot install Compress::Zlib"
8620 # next; # this is the next that had to go away
8622 # The following "next NEED" are fine and the error message
8623 # explains well what is going on. For example when the DBI
8624 # fails and consequently DBD::SQLite fails and now we are
8625 # processing CPAN::SQLite. Then we must have a "next" for
8626 # DBD::SQLite. How can we get it and how can we identify
8627 # all other cases we must identify?
8629 my $do = $nmo->distribution;
8630 next NEED unless $do; # not on CPAN
8631 if (CPAN::Version->vcmp($need_version, $nmo->ro->{CPAN_VERSION}) > 0){
8632 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8633 "'$need_module => $need_version' ".
8634 "for '$self->{ID}' seems ".
8635 "not available according to the indexes\n"
8639 NOSAYER: for my $nosayer (
8648 if ($do->{$nosayer}) {
8649 my $selfid = $self->pretty_id;
8650 my $did = $do->pretty_id;
8651 if (UNIVERSAL::can($do->{$nosayer},"failed") ?
8652 $do->{$nosayer}->failed :
8653 $do->{$nosayer} =~ /^NO/) {
8654 if ($nosayer eq "make_test"
8656 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
8660 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8661 "'$need_module => $need_version' ".
8662 "for '$selfid' failed when ".
8663 "processing '$did' with ".
8664 "'$nosayer => $do->{$nosayer}'. Continuing, ".
8665 "but chances to succeed are limited.\n"
8667 $CPAN::Frontend->mysleep($sponsoring/10);
8669 } else { # the other guy succeeded
8670 if ($nosayer =~ /^(install|make_test)$/) {
8672 # DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz
8673 # in 2007-03 for 'make install'
8674 # and 2008-04: #30464 (for 'make test')
8675 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
8676 "'$need_module => $need_version' ".
8677 "for '$selfid' already built ".
8678 "but the result looks suspicious. ".
8679 "Skipping another build attempt, ".
8680 "to prevent looping endlessly.\n"
8688 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
8689 push @need, [$need_module,$needed_as];
8691 my @unfolded = map { "[".join(",",@$_)."]" } @need;
8692 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
8696 sub _fulfills_all_version_rqs {
8697 my($self,$need_module,$available_file,$available_version,$need_version) = @_;
8698 my(@all_requirements) = split /\s*,\s*/, $need_version;
8701 RQ: for my $rq (@all_requirements) {
8702 if ($rq =~ s|>=\s*||) {
8703 } elsif ($rq =~ s|>\s*||) {
8705 if (CPAN::Version->vgt($available_version,$rq)) {
8709 } elsif ($rq =~ s|!=\s*||) {
8711 if (CPAN::Version->vcmp($available_version,$rq)) {
8717 } elsif ($rq =~ m|<=?\s*|) {
8719 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
8723 if (! CPAN::Version->vgt($rq, $available_version)) {
8726 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
8727 "available_version[%s]rq[%s]ok[%d]",
8731 CPAN::Version->readable($rq),
8735 return $ok == @all_requirements;
8738 #-> sub CPAN::Distribution::read_yaml ;
8741 return $self->{yaml_content} if exists $self->{yaml_content};
8743 unless ($build_dir = $self->{build_dir}) {
8744 # maybe permission on build_dir was missing
8745 $CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n");
8748 my $yaml = File::Spec->catfile($build_dir,"META.yml");
8749 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
8750 return unless -f $yaml;
8751 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
8753 $CPAN::Frontend->mywarn("Could not read ".
8754 "'$yaml'. Falling back to other ".
8755 "methods to determine prerequisites\n");
8756 return $self->{yaml_content} = undef; # if we die, then we
8757 # cannot read YAML's own
8760 # not "authoritative"
8761 for ($self->{yaml_content}) {
8762 if (defined $_ && (! ref $_ || ref $_ ne "HASH")) {
8763 $CPAN::Frontend->mywarn("META.yml does not seem to be conforming, cannot use it.\n");
8764 $self->{yaml_content} = +{};
8767 if (not exists $self->{yaml_content}{dynamic_config}
8768 or $self->{yaml_content}{dynamic_config}
8770 $self->{yaml_content} = undef;
8772 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
8774 return $self->{yaml_content};
8777 #-> sub CPAN::Distribution::prereq_pm ;
8780 $self->{prereq_pm_detected} ||= 0;
8781 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
8782 return $self->{prereq_pm} if $self->{prereq_pm_detected};
8783 return unless $self->{writemakefile} # no need to have succeeded
8784 # but we must have run it
8785 || $self->{modulebuild};
8786 unless ($self->{build_dir}) {
8789 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
8790 $self->{writemakefile}||"",
8791 $self->{modulebuild}||"",
8794 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
8795 $req = $yaml->{requires} || {};
8796 $breq = $yaml->{build_requires} || {};
8797 undef $req unless ref $req eq "HASH" && %$req;
8799 if ($yaml->{generated_by} &&
8800 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
8801 my $eummv = do { local $^W = 0; $1+0; };
8802 if ($eummv < 6.2501) {
8803 # thanks to Slaven for digging that out: MM before
8804 # that could be wrong because it could reflect a
8811 while (my($k,$v) = each %{$req||{}}) {
8814 } elsif ($k =~ /[A-Za-z]/ &&
8816 $CPAN::META->exists("Module",$v)
8818 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
8819 "requires hash: $k => $v; I'll take both ".
8820 "key and value as a module name\n");
8821 $CPAN::Frontend->mysleep(1);
8827 $req = $areq if $do_replace;
8830 unless ($req || $breq) {
8832 unless ( $build_dir = $self->{build_dir} ) {
8835 my $makefile = File::Spec->catfile($build_dir,"Makefile");
8839 $fh = FileHandle->new("<$makefile\0")) {
8840 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
8843 last if /MakeMaker post_initialize section/;
8845 \s+PREREQ_PM\s+=>\s+(.+)
8848 # warn "Found prereq expr[$p]";
8850 # Regexp modified by A.Speer to remember actual version of file
8851 # PREREQ_PM hash key wants, then add to
8852 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ) {
8853 # In case a prereq is mentioned twice, complain.
8854 if ( defined $req->{$1} ) {
8855 warn "Warning: PREREQ_PM mentions $1 more than once, ".
8856 "last mention wins";
8858 my($m,$n) = ($1,$2);
8859 if ($n =~ /^q\[(.*?)\]$/) {
8868 unless ($req || $breq) {
8869 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
8870 my $buildfile = File::Spec->catfile($build_dir,"Build");
8871 if (-f $buildfile) {
8872 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
8873 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
8874 if (-f $build_prereqs) {
8875 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
8876 my $content = do { local *FH;
8877 open FH, $build_prereqs
8878 or $CPAN::Frontend->mydie("Could not open ".
8879 "'$build_prereqs': $!");
8883 my $bphash = eval $content;
8886 $req = $bphash->{requires} || +{};
8887 $breq = $bphash->{build_requires} || +{};
8893 && ! -f "Makefile.PL"
8894 && ! exists $req->{"Module::Build"}
8895 && ! $CPAN::META->has_inst("Module::Build")) {
8896 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
8897 "undeclared prerequisite.\n".
8898 " Adding it now as such.\n"
8900 $CPAN::Frontend->mysleep(5);
8901 $req->{"Module::Build"} = 0;
8902 delete $self->{writemakefile};
8904 if ($req || $breq) {
8905 $self->{prereq_pm_detected}++;
8906 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
8910 #-> sub CPAN::Distribution::test ;
8913 if (my $goto = $self->prefs->{goto}) {
8914 return $self->goto($goto);
8917 return if $self->prefs->{disabled} && ! $self->{force_update};
8918 if ($CPAN::Signal) {
8919 delete $self->{force_update};
8922 # warn "XDEBUG: checking for notest: $self->{notest} $self";
8923 if ($self->{notest}) {
8924 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
8928 my $make = $self->{modulebuild} ? "Build" : "make";
8930 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
8932 : ($ENV{PERLLIB} || "");
8934 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
8935 $CPAN::META->set_perl5lib;
8936 local $ENV{MAKEFLAGS}; # protect us from outer make calls
8938 $CPAN::Frontend->myprint("Running $make test\n");
8942 if ($self->{make} or $self->{later}) {
8946 "Make had some problems, won't test";
8949 exists $self->{make} and
8951 UNIVERSAL::can($self->{make},"failed") ?
8952 $self->{make}->failed :
8953 $self->{make} =~ /^NO/
8954 ) and push @e, "Can't test without successful make";
8955 $self->{badtestcnt} ||= 0;
8956 if ($self->{badtestcnt} > 0) {
8957 require Data::Dumper;
8958 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
8959 push @e, "Won't repeat unsuccessful test during this command";
8962 push @e, $self->{later} if $self->{later};
8963 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
8965 if (exists $self->{build_dir}) {
8966 if (exists $self->{make_test}) {
8968 UNIVERSAL::can($self->{make_test},"failed") ?
8969 $self->{make_test}->failed :
8970 $self->{make_test} =~ /^NO/
8973 UNIVERSAL::can($self->{make_test},"commandid")
8975 $self->{make_test}->commandid == $CPAN::CurrentCommandId
8977 push @e, "Has already been tested within this command";
8980 push @e, "Has already been tested successfully";
8981 # if global "is_tested" has been cleared, we need to mark this to
8982 # be added to PERL5LIB if not already installed
8983 if ($self->tested_ok_but_not_installed) {
8984 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
8989 push @e, "Has no own directory";
8991 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8992 unless (chdir $self->{build_dir}) {
8993 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8995 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8997 $self->debug("Changed directory to $self->{build_dir}")
9000 if ($^O eq 'MacOS') {
9001 Mac::BuildTools::make_test($self);
9005 if ($self->{modulebuild}) {
9006 my $thm = CPAN::Shell->expand("Module","Test::Harness");
9007 my $v = $thm->inst_version;
9008 if (CPAN::Version->vlt($v,2.62)) {
9009 # XXX Eric Wilhelm reported this as a bug: klapperl:
9010 # Test::Harness 3.0 self-tests, so that should be 'unless
9011 # installing Test::Harness'
9012 unless ($self->id eq $thm->distribution->id) {
9013 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
9014 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
9015 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
9021 if ( ! $self->{force_update} ) {
9022 # bypass actual tests if "trust_test_report_history" and have a report
9023 my $have_tested_fcn;
9024 if ( $CPAN::Config->{trust_test_report_history}
9025 && $CPAN::META->has_inst("CPAN::Reporter::History")
9026 && ( $have_tested_fcn = CPAN::Reporter::History->can("have_tested" ))) {
9027 if ( my @reports = $have_tested_fcn->( dist => $self->base_id ) ) {
9028 # Do nothing if grade was DISCARD
9029 if ( $reports[-1]->{grade} =~ /^(?:PASS|UNKNOWN)$/ ) {
9030 $self->{make_test} = CPAN::Distrostatus->new("YES");
9031 # if global "is_tested" has been cleared, we need to mark this to
9032 # be added to PERL5LIB if not already installed
9033 if ($self->tested_ok_but_not_installed) {
9034 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
9036 $CPAN::Frontend->myprint("Found prior test report -- OK\n");
9039 elsif ( $reports[-1]->{grade} =~ /^(?:FAIL|NA)$/ ) {
9040 $self->{make_test} = CPAN::Distrostatus->new("NO");
9041 $self->{badtestcnt}++;
9042 $CPAN::Frontend->mywarn("Found prior test report -- NOT OK\n");
9050 my $prefs_test = $self->prefs->{test};
9052 = exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") {
9053 $system = $commandline;
9054 $ENV{PERL} = CPAN::find_perl;
9055 } elsif ($self->{modulebuild}) {
9056 $system = sprintf "%s test", $self->_build_command();
9057 unless (-e "Build") {
9058 my $id = $self->pretty_id;
9059 $CPAN::Frontend->mywarn("Alert: no 'Build' file found while trying to test '$id'");
9062 $system = join " ", $self->_make_command(), "test";
9064 my $make_test_arg = $self->_make_phase_arg("test");
9065 $system = sprintf("%s%s",
9067 $make_test_arg ? " $make_test_arg" : "",
9071 while (my($k,$v) = each %ENV) {
9072 next unless defined $v;
9077 if ($self->prefs->{test}) {
9078 $test_env = $self->prefs->{test}{env};
9081 for my $e (keys %$test_env) {
9082 $ENV{$e} = $test_env->{$e};
9085 my $expect_model = $self->_prefs_with_expect("test");
9086 my $want_expect = 0;
9087 if ( $expect_model && @{$expect_model->{talk}} ) {
9088 my $can_expect = $CPAN::META->has_inst("Expect");
9092 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
9093 "testing without\n");
9097 if ($self->_should_report('test')) {
9098 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
9099 "not supported when distroprefs specify ".
9100 "an interactive test\n");
9102 $tests_ok = $self->_run_via_expect($system,'test',$expect_model) == 0;
9103 } elsif ( $self->_should_report('test') ) {
9104 $tests_ok = CPAN::Reporter::test($self, $system);
9106 $tests_ok = system($system) == 0;
9108 $self->introduce_myself;
9113 # local $CPAN::DEBUG = 16; # Distribution
9114 for my $m (keys %{$self->{sponsored_mods}}) {
9115 next unless $self->{sponsored_mods}{$m} > 0;
9116 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
9117 # XXX we need available_version which reflects
9118 # $ENV{PERL5LIB} so that already tested but not yet
9119 # installed modules are counted.
9120 my $available_version = $m_obj->available_version;
9121 my $available_file = $m_obj->available_file;
9122 if ($available_version &&
9123 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
9125 CPAN->debug("m[$m] good enough available_version[$available_version]")
9127 } elsif ($available_file
9129 !$self->{prereq_pm}{$m}
9131 $self->{prereq_pm}{$m} == 0
9134 # lex Class::Accessor::Chained::Fast which has no $VERSION
9135 CPAN->debug("m[$m] have available_file[$available_file]")
9143 my $which = join ",", @prereq;
9144 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
9145 "$cnt dependencies missing ($which)";
9146 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
9147 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
9148 $self->store_persistent_state;
9149 return $self->goodbye("[dependencies] -- NA");
9153 $CPAN::Frontend->myprint(" $system -- OK\n");
9154 $self->{make_test} = CPAN::Distrostatus->new("YES");
9155 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
9156 # probably impossible to need the next line because badtestcnt
9157 # has a lifespan of one command
9158 delete $self->{badtestcnt};
9160 $self->{make_test} = CPAN::Distrostatus->new("NO");
9161 $self->{badtestcnt}++;
9162 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
9163 CPAN::Shell->optprint
9166 ("//hint// to see the cpan-testers results for installing this module, try:
9170 $self->store_persistent_state;
9173 sub _prefs_with_expect {
9174 my($self,$where) = @_;
9175 return unless my $prefs = $self->prefs;
9176 return unless my $where_prefs = $prefs->{$where};
9177 if ($where_prefs->{expect}) {
9179 mode => "deterministic",
9181 talk => $where_prefs->{expect},
9183 } elsif ($where_prefs->{"eexpect"}) {
9184 return $where_prefs->{"eexpect"};
9189 #-> sub CPAN::Distribution::clean ;
9192 my $make = $self->{modulebuild} ? "Build" : "make";
9193 $CPAN::Frontend->myprint("Running $make clean\n");
9194 unless (exists $self->{archived}) {
9195 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
9196 "/untarred, nothing done\n");
9199 unless (exists $self->{build_dir}) {
9200 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
9203 if (exists $self->{writemakefile}
9204 and $self->{writemakefile}->failed
9206 $CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n");
9211 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
9212 push @e, "make clean already called once";
9213 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
9215 chdir $self->{build_dir} or
9216 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
9217 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
9219 if ($^O eq 'MacOS') {
9220 Mac::BuildTools::make_clean($self);
9225 if ($self->{modulebuild}) {
9226 unless (-f "Build") {
9227 my $cwd = CPAN::anycwd();
9228 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
9229 " in cwd[$cwd]. Danger, Will Robinson!");
9230 $CPAN::Frontend->mysleep(5);
9232 $system = sprintf "%s clean", $self->_build_command();
9234 $system = join " ", $self->_make_command(), "clean";
9236 my $system_ok = system($system) == 0;
9237 $self->introduce_myself;
9239 $CPAN::Frontend->myprint(" $system -- OK\n");
9243 # Jost Krieger pointed out that this "force" was wrong because
9244 # it has the effect that the next "install" on this distribution
9245 # will untar everything again. Instead we should bring the
9246 # object's state back to where it is after untarring.
9257 $self->{make_clean} = CPAN::Distrostatus->new("YES");
9260 # Hmmm, what to do if make clean failed?
9262 $self->{make_clean} = CPAN::Distrostatus->new("NO");
9263 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
9265 # 2006-02-27: seems silly to me to force a make now
9266 # $self->force("make"); # so that this directory won't be used again
9269 $self->store_persistent_state;
9272 #-> sub CPAN::Distribution::goto ;
9274 my($self,$goto) = @_;
9275 $goto = $self->normalize($goto);
9277 "Goto '$goto' via prefs file '%s' doc %d",
9278 $self->{prefs_file},
9279 $self->{prefs_file_doc},
9281 $self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
9282 # 2007-07-16 akoenig : Better than NA would be if we could inherit
9283 # the status of the $goto distro but given the exceptional nature
9284 # of 'goto' I feel reluctant to implement it
9285 my $goodbye_message = "[goto] -- NA $why";
9286 $self->goodbye($goodbye_message);
9288 # inject into the queue
9290 CPAN::Queue->delete($self->id);
9291 CPAN::Queue->jumpqueue({qmod => $goto, reqtype => $self->{reqtype}});
9293 # and run where we left off
9295 my($method) = (caller(1))[3];
9296 CPAN->instance("CPAN::Distribution",$goto)->$method();
9297 CPAN::Queue->delete_first($goto);
9300 #-> sub CPAN::Distribution::install ;
9303 if (my $goto = $self->prefs->{goto}) {
9304 return $self->goto($goto);
9307 unless ($self->{badtestcnt}) {
9310 if ($CPAN::Signal) {
9311 delete $self->{force_update};
9314 my $make = $self->{modulebuild} ? "Build" : "make";
9315 $CPAN::Frontend->myprint("Running $make install\n");
9318 if ($self->{make} or $self->{later}) {
9322 "Make had some problems, won't install";
9325 exists $self->{make} and
9327 UNIVERSAL::can($self->{make},"failed") ?
9328 $self->{make}->failed :
9329 $self->{make} =~ /^NO/
9331 push @e, "Make had returned bad status, install seems impossible";
9333 if (exists $self->{build_dir}) {
9335 push @e, "Has no own directory";
9338 if (exists $self->{make_test} and
9340 UNIVERSAL::can($self->{make_test},"failed") ?
9341 $self->{make_test}->failed :
9342 $self->{make_test} =~ /^NO/
9344 if ($self->{force_update}) {
9345 $self->{make_test}->text("FAILED but failure ignored because ".
9346 "'force' in effect");
9348 push @e, "make test had returned bad status, ".
9349 "won't install without force"
9352 if (exists $self->{install}) {
9353 if (UNIVERSAL::can($self->{install},"text") ?
9354 $self->{install}->text eq "YES" :
9355 $self->{install} =~ /^YES/
9357 $CPAN::Frontend->myprint(" Already done\n");
9358 $CPAN::META->is_installed($self->{build_dir});
9361 # comment in Todo on 2006-02-11; maybe retry?
9362 push @e, "Already tried without success";
9366 push @e, $self->{later} if $self->{later};
9367 push @e, $self->{configure_requires_later} if $self->{configure_requires_later};
9369 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
9370 unless (chdir $self->{build_dir}) {
9371 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
9373 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
9375 $self->debug("Changed directory to $self->{build_dir}")
9378 if ($^O eq 'MacOS') {
9379 Mac::BuildTools::make_install($self);
9384 if (my $commandline = $self->prefs->{install}{commandline}) {
9385 $system = $commandline;
9386 $ENV{PERL} = CPAN::find_perl;
9387 } elsif ($self->{modulebuild}) {
9388 my($mbuild_install_build_command) =
9389 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
9390 $CPAN::Config->{mbuild_install_build_command} ?
9391 $CPAN::Config->{mbuild_install_build_command} :
9392 $self->_build_command();
9393 $system = sprintf("%s install %s",
9394 $mbuild_install_build_command,
9395 $CPAN::Config->{mbuild_install_arg},
9398 my($make_install_make_command) =
9399 CPAN::HandleConfig->prefs_lookup($self,
9400 q{make_install_make_command})
9401 || $self->_make_command();
9402 $system = sprintf("%s install %s",
9403 $make_install_make_command,
9404 $CPAN::Config->{make_install_arg},
9408 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
9409 my $brip = CPAN::HandleConfig->prefs_lookup($self,
9410 q{build_requires_install_policy});
9413 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
9414 my $want_install = "yes";
9415 if ($reqtype eq "b") {
9416 if ($brip eq "no") {
9417 $want_install = "no";
9418 } elsif ($brip =~ m|^ask/(.+)|) {
9420 $default = "yes" unless $default =~ /^(y|n)/i;
9422 CPAN::Shell::colorable_makemaker_prompt
9423 ("$id is just needed temporarily during building or testing. ".
9424 "Do you want to install it permanently? (Y/n)",
9428 unless ($want_install =~ /^y/i) {
9429 my $is_only = "is only 'build_requires'";
9430 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
9431 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
9432 delete $self->{force_update};
9435 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
9437 : ($ENV{PERLLIB} || "");
9439 local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
9440 $CPAN::META->set_perl5lib;
9441 my($pipe) = FileHandle->new("$system $stderr |") || Carp::croak
9442 ("Can't execute $system: $!");
9445 print $_; # intentionally NOT use Frontend->myprint because it
9446 # looks irritating when we markup in color what we
9447 # just pass through from an external program
9451 my $close_ok = $? == 0;
9452 $self->introduce_myself;
9454 $CPAN::Frontend->myprint(" $system -- OK\n");
9455 $CPAN::META->is_installed($self->{build_dir});
9456 $self->{install} = CPAN::Distrostatus->new("YES");
9458 $self->{install} = CPAN::Distrostatus->new("NO");
9459 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
9461 CPAN::HandleConfig->prefs_lookup($self,
9462 q{make_install_make_command});
9464 $makeout =~ /permission/s
9468 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
9472 $CPAN::Frontend->myprint(
9474 qq{ You may have to su }.
9475 qq{to root to install the package\n}.
9476 qq{ (Or you may want to run something like\n}.
9477 qq{ o conf make_install_make_command 'sudo make'\n}.
9478 qq{ to raise your permissions.}
9482 delete $self->{force_update};
9484 $self->store_persistent_state;
9487 sub introduce_myself {
9489 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
9492 #-> sub CPAN::Distribution::dir ;
9497 #-> sub CPAN::Distribution::perldoc ;
9501 my($dist) = $self->id;
9502 my $package = $self->called_for;
9504 $self->_display_url( $CPAN::Defaultdocs . $package );
9507 #-> sub CPAN::Distribution::_check_binary ;
9509 my ($dist,$shell,$binary) = @_;
9512 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
9515 if ($CPAN::META->has_inst("File::Which")) {
9516 return File::Which::which($binary);
9519 $pid = open README, "which $binary|"
9520 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
9526 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
9530 $CPAN::Frontend->myprint(qq{ + $out \n})
9531 if $CPAN::DEBUG && $out;
9536 #-> sub CPAN::Distribution::_display_url ;
9538 my($self,$url) = @_;
9539 my($res,$saved_file,$pid,$out);
9541 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
9544 # should we define it in the config instead?
9545 my $html_converter = "html2text.pl";
9547 my $web_browser = $CPAN::Config->{'lynx'} || undef;
9548 my $web_browser_out = $web_browser
9549 ? CPAN::Distribution->_check_binary($self,$web_browser)
9552 if ($web_browser_out) {
9553 # web browser found, run the action
9554 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
9555 $CPAN::Frontend->myprint(qq{system[$browser $url]})
9557 $CPAN::Frontend->myprint(qq{
9560 with browser $browser
9562 $CPAN::Frontend->mysleep(1);
9563 system("$browser $url");
9564 if ($saved_file) { 1 while unlink($saved_file) }
9566 # web browser not found, let's try text only
9567 my $html_converter_out =
9568 CPAN::Distribution->_check_binary($self,$html_converter);
9569 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
9571 if ($html_converter_out ) {
9572 # html2text found, run it
9573 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
9574 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
9575 unless defined($saved_file);
9578 $pid = open README, "$html_converter $saved_file |"
9579 or $CPAN::Frontend->mydie(qq{
9580 Could not fork '$html_converter $saved_file': $!});
9582 if ($CPAN::META->has_usable("File::Temp")) {
9583 $fh = File::Temp->new(
9584 dir => File::Spec->tmpdir,
9585 template => 'cpan_htmlconvert_XXXX',
9589 $filename = $fh->filename;
9591 $filename = "cpan_htmlconvert_$$.txt";
9592 $fh = FileHandle->new();
9593 open $fh, ">$filename" or die;
9599 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
9600 my $tmpin = $fh->filename;
9601 $CPAN::Frontend->myprint(sprintf(qq{
9603 saved output to %s\n},
9611 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
9612 my $fh_pager = FileHandle->new;
9613 local($SIG{PIPE}) = "IGNORE";
9614 my $pager = $CPAN::Config->{'pager'} || "cat";
9615 $fh_pager->open("|$pager")
9616 or $CPAN::Frontend->mydie(qq{
9617 Could not open pager '$pager': $!});
9618 $CPAN::Frontend->myprint(qq{
9623 $CPAN::Frontend->mysleep(1);
9624 $fh_pager->print(<FH>);
9627 # coldn't find the web browser or html converter
9628 $CPAN::Frontend->myprint(qq{
9629 You need to install lynx or $html_converter to use this feature.});
9634 #-> sub CPAN::Distribution::_getsave_url ;
9636 my($dist, $shell, $url) = @_;
9638 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
9642 if ($CPAN::META->has_usable("File::Temp")) {
9643 $fh = File::Temp->new(
9644 dir => File::Spec->tmpdir,
9645 template => "cpan_getsave_url_XXXX",
9649 $filename = $fh->filename;
9651 $fh = FileHandle->new;
9652 $filename = "cpan_getsave_url_$$.html";
9654 my $tmpin = $filename;
9655 if ($CPAN::META->has_usable('LWP')) {
9656 $CPAN::Frontend->myprint("Fetching with LWP:
9660 CPAN::LWP::UserAgent->config;
9661 eval { $Ua = CPAN::LWP::UserAgent->new; };
9663 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
9667 $Ua->proxy('http', $var)
9668 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
9670 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
9673 my $req = HTTP::Request->new(GET => $url);
9674 $req->header('Accept' => 'text/html');
9675 my $res = $Ua->request($req);
9676 if ($res->is_success) {
9677 $CPAN::Frontend->myprint(" + request successful.\n")
9679 print $fh $res->content;
9681 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
9685 $CPAN::Frontend->myprint(sprintf(
9686 "LWP failed with code[%s], message[%s]\n",
9693 $CPAN::Frontend->mywarn(" LWP not available\n");
9698 #-> sub CPAN::Distribution::_build_command
9699 sub _build_command {
9701 if ($^O eq "MSWin32") { # special code needed at least up to
9702 # Module::Build 0.2611 and 0.2706; a fix
9703 # in M:B has been promised 2006-01-30
9704 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
9705 return "$perl ./Build";
9710 #-> sub CPAN::Distribution::_should_report
9711 sub _should_report {
9712 my($self, $phase) = @_;
9713 die "_should_report() requires a 'phase' argument"
9714 if ! defined $phase;
9717 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
9719 return unless $test_report;
9721 # don't repeat if we cached a result
9722 return $self->{should_report}
9723 if exists $self->{should_report};
9725 # don't report if we generated a Makefile.PL
9726 if ( $self->{had_no_makefile_pl} ) {
9727 $CPAN::Frontend->mywarn(
9728 "Will not send CPAN Testers report with generated Makefile.PL.\n"
9730 return $self->{should_report} = 0;
9734 if ( ! $CPAN::META->has_inst("CPAN::Reporter")) {
9735 $CPAN::Frontend->mywarn(
9736 "CPAN::Reporter not installed. No reports will be sent.\n"
9738 return $self->{should_report} = 0;
9742 my $crv = CPAN::Reporter->VERSION;
9743 if ( CPAN::Version->vlt( $crv, 0.99 ) ) {
9744 # don't cache $self->{should_report} -- need to check each phase
9745 if ( $phase eq 'test' ) {
9749 $CPAN::Frontend->mywarn(
9750 "Reporting on the '$phase' phase requires CPAN::Reporter 0.99, but \n" .
9751 "you only have version $crv\. Only 'test' phase reports will be sent.\n"
9758 if ($self->is_dot_dist) {
9759 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
9760 "for local directories\n");
9761 return $self->{should_report} = 0;
9763 if ($self->prefs->{patches}
9765 @{$self->prefs->{patches}}
9769 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
9770 "when the source has been patched\n");
9771 return $self->{should_report} = 0;
9774 # proceed and cache success
9775 return $self->{should_report} = 1;
9778 #-> sub CPAN::Distribution::reports
9781 my $pathname = $self->id;
9782 $CPAN::Frontend->myprint("Distribution: $pathname\n");
9784 unless ($CPAN::META->has_inst("CPAN::DistnameInfo")) {
9785 $CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot continue");
9787 unless ($CPAN::META->has_usable("LWP")) {
9788 $CPAN::Frontend->mydie("LWP not installed; cannot continue");
9790 unless ($CPAN::META->has_usable("File::Temp")) {
9791 $CPAN::Frontend->mydie("File::Temp not installed; cannot continue");
9794 my $d = CPAN::DistnameInfo->new($pathname);
9796 my $dist = $d->dist; # "CPAN-DistnameInfo"
9797 my $version = $d->version; # "0.02"
9798 my $maturity = $d->maturity; # "released"
9799 my $filename = $d->filename; # "CPAN-DistnameInfo-0.02.tar.gz"
9800 my $cpanid = $d->cpanid; # "GBARR"
9801 my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
9803 my $url = sprintf "http://cpantesters.perl.org/show/%s.yaml", $dist;
9805 CPAN::LWP::UserAgent->config;
9807 eval { $Ua = CPAN::LWP::UserAgent->new; };
9809 $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
9811 $CPAN::Frontend->myprint("Fetching '$url'...");
9812 my $resp = $Ua->get($url);
9813 unless ($resp->is_success) {
9814 $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
9816 $CPAN::Frontend->myprint("DONE\n\n");
9817 my $yaml = $resp->content;
9818 # was fuer ein Umweg!
9819 my $fh = File::Temp->new(
9820 dir => File::Spec->tmpdir,
9821 template => 'cpan_reports_XXXX',
9825 my $tfilename = $fh->filename;
9827 close $fh or $CPAN::Frontend->mydie("Could not close '$tfilename': $!");
9828 my $unserialized = CPAN->_yaml_loadfile($tfilename)->[0];
9829 unlink $tfilename or $CPAN::Frontend->mydie("Could not unlink '$tfilename': $!");
9831 my $this_version_seen;
9832 for my $rep (@$unserialized) {
9833 my $rversion = $rep->{version};
9834 if ($rversion eq $version) {
9835 unless ($this_version_seen++) {
9836 $CPAN::Frontend->myprint ("$rep->{version}:\n");
9838 $CPAN::Frontend->myprint
9839 (sprintf("%1s%1s%-4s %s on %s %s (%s)\n",
9840 $rep->{archname} eq $Config::Config{archname}?"*":"",
9841 $rep->{action}eq"PASS"?"+":$rep->{action}eq"FAIL"?"-":"",
9844 ucfirst $rep->{osname},
9849 $other_versions{$rep->{version}}++;
9852 unless ($this_version_seen) {
9853 $CPAN::Frontend->myprint("No reports found for version '$version'
9854 Reports for other versions:\n");
9855 for my $v (sort keys %other_versions) {
9856 $CPAN::Frontend->myprint(" $v\: $other_versions{$v}\n");
9859 $url =~ s/\.yaml/.html/;
9860 $CPAN::Frontend->myprint("See $url for details\n");
9863 package CPAN::Bundle;
9868 $CPAN::Frontend->myprint($self->as_string);
9871 #-> CPAN::Bundle::undelay
9874 delete $self->{later};
9875 for my $c ( $self->contains ) {
9876 my $obj = CPAN::Shell->expandany($c) or next;
9881 # mark as dirty/clean
9882 #-> sub CPAN::Bundle::color_cmd_tmps ;
9883 sub color_cmd_tmps {
9885 my($depth) = shift || 0;
9886 my($color) = shift || 0;
9887 my($ancestors) = shift || [];
9888 # a module needs to recurse to its cpan_file, a distribution needs
9889 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
9891 return if exists $self->{incommandcolor}
9893 && $self->{incommandcolor}==$color;
9894 if ($depth>=$CPAN::MAX_RECURSION) {
9895 die(CPAN::Exception::RecursiveDependency->new($ancestors));
9897 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
9899 for my $c ( $self->contains ) {
9900 my $obj = CPAN::Shell->expandany($c) or next;
9901 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
9902 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
9904 # never reached code?
9906 #delete $self->{badtestcnt};
9908 $self->{incommandcolor} = $color;
9911 #-> sub CPAN::Bundle::as_string ;
9915 # following line must be "=", not "||=" because we have a moving target
9916 $self->{INST_VERSION} = $self->inst_version;
9917 return $self->SUPER::as_string;
9920 #-> sub CPAN::Bundle::contains ;
9923 my($inst_file) = $self->inst_file || "";
9924 my($id) = $self->id;
9925 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
9926 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
9929 unless ($inst_file) {
9930 # Try to get at it in the cpan directory
9931 $self->debug("no inst_file") if $CPAN::DEBUG;
9933 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
9934 $cpan_file = $self->cpan_file;
9935 if ($cpan_file eq "N/A") {
9936 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
9937 Maybe stale symlink? Maybe removed during session? Giving up.\n");
9939 my $dist = $CPAN::META->instance('CPAN::Distribution',
9941 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
9943 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
9944 my($todir) = $CPAN::Config->{'cpan_home'};
9945 my(@me,$from,$to,$me);
9946 @me = split /::/, $self->id;
9948 $me = File::Spec->catfile(@me);
9949 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
9950 $to = File::Spec->catfile($todir,$me);
9951 File::Path::mkpath(File::Basename::dirname($to));
9952 File::Copy::copy($from, $to)
9953 or Carp::confess("Couldn't copy $from to $to: $!");
9957 my $fh = FileHandle->new;
9959 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
9961 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
9963 $in_cont = m/^=(?!head1\s+(?i-xsm:CONTENTS))/ ? 0 :
9964 m/^=head1\s+(?i-xsm:CONTENTS)/ ? 1 : $in_cont;
9965 next unless $in_cont;
9970 push @result, (split " ", $_, 2)[0];
9973 delete $self->{STATUS};
9974 $self->{CONTAINS} = \@result;
9975 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
9977 $CPAN::Frontend->mywarn(qq{
9978 The bundle file "$inst_file" may be a broken
9979 bundlefile. It seems not to contain any bundle definition.
9980 Please check the file and if it is bogus, please delete it.
9981 Sorry for the inconvenience.
9987 #-> sub CPAN::Bundle::find_bundle_file
9988 # $where is in local format, $what is in unix format
9989 sub find_bundle_file {
9990 my($self,$where,$what) = @_;
9991 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
9992 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
9993 ### my $bu = File::Spec->catfile($where,$what);
9994 ### return $bu if -f $bu;
9995 my $manifest = File::Spec->catfile($where,"MANIFEST");
9996 unless (-f $manifest) {
9997 require ExtUtils::Manifest;
9998 my $cwd = CPAN::anycwd();
9999 $self->safe_chdir($where);
10000 ExtUtils::Manifest::mkmanifest();
10001 $self->safe_chdir($cwd);
10003 my $fh = FileHandle->new($manifest)
10004 or Carp::croak("Couldn't open $manifest: $!");
10006 my $bundle_filename = $what;
10007 $bundle_filename =~ s|Bundle.*/||;
10008 my $bundle_unixpath;
10011 my($file) = /(\S+)/;
10012 if ($file =~ m|\Q$what\E$|) {
10013 $bundle_unixpath = $file;
10014 # return File::Spec->catfile($where,$bundle_unixpath); # bad
10017 # retry if she managed to have no Bundle directory
10018 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
10020 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
10021 if $bundle_unixpath;
10022 Carp::croak("Couldn't find a Bundle file in $where");
10025 # needs to work quite differently from Module::inst_file because of
10026 # cpan_home/Bundle/ directory and the possibility that we have
10027 # shadowing effect. As it makes no sense to take the first in @INC for
10028 # Bundles, we parse them all for $VERSION and take the newest.
10030 #-> sub CPAN::Bundle::inst_file ;
10035 @me = split /::/, $self->id;
10037 my($incdir,$bestv);
10038 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
10039 my $parsefile = File::Spec->catfile($incdir, @me);
10040 CPAN->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
10041 next unless -f $parsefile;
10042 my $have = eval { MM->parse_version($parsefile); };
10044 $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
10046 if (!$bestv || CPAN::Version->vgt($have,$bestv)) {
10047 $self->{INST_FILE} = $parsefile;
10048 $self->{INST_VERSION} = $bestv = $have;
10051 $self->{INST_FILE};
10054 #-> sub CPAN::Bundle::inst_version ;
10057 $self->inst_file; # finds INST_VERSION as side effect
10058 $self->{INST_VERSION};
10061 #-> sub CPAN::Bundle::rematein ;
10063 my($self,$meth) = @_;
10064 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
10065 my($id) = $self->id;
10066 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
10067 unless $self->inst_file || $self->cpan_file;
10069 for $s ($self->contains) {
10070 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
10071 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
10072 if ($type eq 'CPAN::Distribution') {
10073 $CPAN::Frontend->mywarn(qq{
10074 The Bundle }.$self->id.qq{ contains
10075 explicitly a file '$s'.
10076 Going to $meth that.
10078 $CPAN::Frontend->mysleep(5);
10080 # possibly noisy action:
10081 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
10082 my $obj = $CPAN::META->instance($type,$s);
10083 $obj->{reqtype} = $self->{reqtype};
10088 # If a bundle contains another that contains an xs_file we have here,
10089 # we just don't bother I suppose
10090 #-> sub CPAN::Bundle::xs_file
10095 #-> sub CPAN::Bundle::force ;
10096 sub fforce { shift->rematein('fforce',@_); }
10097 #-> sub CPAN::Bundle::force ;
10098 sub force { shift->rematein('force',@_); }
10099 #-> sub CPAN::Bundle::notest ;
10100 sub notest { shift->rematein('notest',@_); }
10101 #-> sub CPAN::Bundle::get ;
10102 sub get { shift->rematein('get',@_); }
10103 #-> sub CPAN::Bundle::make ;
10104 sub make { shift->rematein('make',@_); }
10105 #-> sub CPAN::Bundle::test ;
10108 # $self->{badtestcnt} ||= 0;
10109 $self->rematein('test',@_);
10111 #-> sub CPAN::Bundle::install ;
10114 $self->rematein('install',@_);
10116 #-> sub CPAN::Bundle::clean ;
10117 sub clean { shift->rematein('clean',@_); }
10119 #-> sub CPAN::Bundle::uptodate ;
10122 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
10124 foreach $c ($self->contains) {
10125 my $obj = CPAN::Shell->expandany($c);
10126 return 0 unless $obj->uptodate;
10131 #-> sub CPAN::Bundle::readme ;
10134 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
10135 No File found for bundle } . $self->id . qq{\n}), return;
10136 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
10137 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
10140 package CPAN::Module;
10144 #-> sub CPAN::Module::userid
10147 my $ro = $self->ro;
10149 return $ro->{userid} || $ro->{CPAN_USERID};
10151 #-> sub CPAN::Module::description
10154 my $ro = $self->ro or return "";
10158 #-> sub CPAN::Module::distribution
10161 CPAN::Shell->expand("Distribution",$self->cpan_file);
10164 #-> sub CPAN::Module::_is_representative_module
10165 sub _is_representative_module {
10167 return $self->{_is_representative_module} if defined $self->{_is_representative_module};
10168 my $pm = $self->cpan_file or return $self->{_is_representative_module} = 0;
10170 $pm =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i; # see base_id
10171 $pm =~ s|-\d+\.\d+.+$||;
10172 $pm =~ s|-[\d\.]+$||;
10174 $self->{_is_representative_module} = $pm eq $self->{ID} ? 1 : 0;
10175 # warn "DEBUG: $pm eq $self->{ID} => $self->{_is_representative_module}";
10176 $self->{_is_representative_module};
10179 #-> sub CPAN::Module::undelay
10182 delete $self->{later};
10183 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
10188 # mark as dirty/clean
10189 #-> sub CPAN::Module::color_cmd_tmps ;
10190 sub color_cmd_tmps {
10192 my($depth) = shift || 0;
10193 my($color) = shift || 0;
10194 my($ancestors) = shift || [];
10195 # a module needs to recurse to its cpan_file
10197 return if exists $self->{incommandcolor}
10199 && $self->{incommandcolor}==$color;
10200 return if $color==0 && !$self->{incommandcolor};
10202 if ( $self->uptodate ) {
10203 $self->{incommandcolor} = $color;
10205 } elsif (my $have_version = $self->available_version) {
10206 # maybe what we have is good enough
10208 my $who_asked_for_me = $ancestors->[-1];
10209 my $obj = CPAN::Shell->expandany($who_asked_for_me);
10211 } elsif ($obj->isa("CPAN::Bundle")) {
10212 # bundles cannot specify a minimum version
10214 } elsif ($obj->isa("CPAN::Distribution")) {
10215 if (my $prereq_pm = $obj->prereq_pm) {
10216 for my $k (keys %$prereq_pm) {
10217 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
10218 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
10219 $self->{incommandcolor} = $color;
10229 $self->{incommandcolor} = $color; # set me before recursion,
10230 # so we can break it
10232 if ($depth>=$CPAN::MAX_RECURSION) {
10233 die(CPAN::Exception::RecursiveDependency->new($ancestors));
10235 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
10237 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
10238 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
10242 # delete $self->{badtestcnt};
10244 $self->{incommandcolor} = $color;
10247 #-> sub CPAN::Module::as_glimpse ;
10251 my $class = ref($self);
10252 $class =~ s/^CPAN:://;
10254 my $color_off = "";
10256 $CPAN::Shell::COLOR_REGISTERED
10258 $CPAN::META->has_inst("Term::ANSIColor")
10262 $color_on = Term::ANSIColor::color("green");
10263 $color_off = Term::ANSIColor::color("reset");
10265 my $uptodateness = " ";
10266 unless ($class eq "Bundle") {
10267 my $u = $self->uptodate;
10268 $uptodateness = $u ? "=" : "<" if defined $u;
10271 my $d = $self->distribution;
10272 $d ? $d -> pretty_id : $self->cpan_userid;
10274 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
10285 #-> sub CPAN::Module::dslip_status
10289 # development status
10290 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
10291 pre-alpha alpha beta released
10294 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
10295 developer comp.lang.perl.*
10298 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
10300 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
10302 object-oriented pragma
10305 @{$stat->{P}}{qw,p g l b a 2 o d r n,} = qw,Standard-Perl
10307 BSD Artistic Artistic_2
10309 distribution_allowed
10310 restricted_distribution
10312 for my $x (qw(d s l i p)) {
10313 $stat->{$x}{' '} = 'unknown';
10314 $stat->{$x}{'?'} = 'unknown';
10316 my $ro = $self->ro;
10317 return +{} unless $ro && $ro->{statd};
10324 DV => $stat->{D}{$ro->{statd}},
10325 SV => $stat->{S}{$ro->{stats}},
10326 LV => $stat->{L}{$ro->{statl}},
10327 IV => $stat->{I}{$ro->{stati}},
10328 PV => $stat->{P}{$ro->{statp}},
10332 #-> sub CPAN::Module::as_string ;
10336 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
10337 my $class = ref($self);
10338 $class =~ s/^CPAN:://;
10340 push @m, $class, " id = $self->{ID}\n";
10341 my $sprintf = " %-12s %s\n";
10342 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
10343 if $self->description;
10344 my $sprintf2 = " %-12s %s (%s)\n";
10346 $userid = $self->userid;
10349 if ($author = CPAN::Shell->expand('Author',$userid)) {
10352 if ($m = $author->email) {
10359 $author->fullname . $email
10363 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
10364 if $self->cpan_version;
10365 if (my $cpan_file = $self->cpan_file) {
10366 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
10367 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
10368 my $upload_date = $dist->upload_date;
10369 if ($upload_date) {
10370 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
10374 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
10375 my $dslip = $self->dslip_status;
10379 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
10381 my $local_file = $self->inst_file;
10382 unless ($self->{MANPAGE}) {
10385 $manpage = $self->manpage_headline($local_file);
10387 # If we have already untarred it, we should look there
10388 my $dist = $CPAN::META->instance('CPAN::Distribution',
10390 # warn "dist[$dist]";
10391 # mff=manifest file; mfh=manifest handle
10396 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
10398 $mfh = FileHandle->new($mff)
10400 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
10401 my $lfre = $self->id; # local file RE
10403 $lfre .= "\\.pm\$";
10404 my($lfl); # local file file
10406 my(@mflines) = <$mfh>;
10411 while (length($lfre)>5 and !$lfl) {
10412 ($lfl) = grep /$lfre/, @mflines;
10413 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
10414 $lfre =~ s/.+?\.//;
10416 $lfl =~ s/\s.*//; # remove comments
10417 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
10418 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
10419 # warn "lfl_abs[$lfl_abs]";
10421 $manpage = $self->manpage_headline($lfl_abs);
10425 $self->{MANPAGE} = $manpage if $manpage;
10428 for $item (qw/MANPAGE/) {
10429 push @m, sprintf($sprintf, $item, $self->{$item})
10430 if exists $self->{$item};
10432 for $item (qw/CONTAINS/) {
10433 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
10434 if exists $self->{$item} && @{$self->{$item}};
10436 push @m, sprintf($sprintf, 'INST_FILE',
10437 $local_file || "(not installed)");
10438 push @m, sprintf($sprintf, 'INST_VERSION',
10439 $self->inst_version) if $local_file;
10440 if (%{$CPAN::META->{is_tested}||{}}) { # XXX needs to be methodified somehow
10441 my $available_file = $self->available_file;
10442 if ($available_file && $available_file ne $local_file) {
10443 push @m, sprintf($sprintf, 'AVAILABLE_FILE', $available_file);
10444 push @m, sprintf($sprintf, 'AVAILABLE_VERSION', $self->available_version);
10450 #-> sub CPAN::Module::manpage_headline
10451 sub manpage_headline {
10452 my($self,$local_file) = @_;
10453 my(@local_file) = $local_file;
10454 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
10455 push @local_file, $local_file;
10457 for $locf (@local_file) {
10458 next unless -f $locf;
10459 my $fh = FileHandle->new($locf)
10460 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
10464 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
10465 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
10466 next unless $inpod;
10482 #-> sub CPAN::Module::cpan_file ;
10483 # Note: also inherited by CPAN::Bundle
10486 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
10487 unless ($self->ro) {
10488 CPAN::Index->reload;
10490 my $ro = $self->ro;
10491 if ($ro && defined $ro->{CPAN_FILE}) {
10492 return $ro->{CPAN_FILE};
10494 my $userid = $self->userid;
10496 if ($CPAN::META->exists("CPAN::Author",$userid)) {
10497 my $author = $CPAN::META->instance("CPAN::Author",
10499 my $fullname = $author->fullname;
10500 my $email = $author->email;
10501 unless (defined $fullname && defined $email) {
10502 return sprintf("Contact Author %s",
10506 return "Contact Author $fullname <$email>";
10508 return "Contact Author $userid (Email address not available)";
10516 #-> sub CPAN::Module::cpan_version ;
10520 my $ro = $self->ro;
10522 # Can happen with modules that are not on CPAN
10525 $ro->{CPAN_VERSION} = 'undef'
10526 unless defined $ro->{CPAN_VERSION};
10527 $ro->{CPAN_VERSION};
10530 #-> sub CPAN::Module::force ;
10533 $self->{force_update} = 1;
10536 #-> sub CPAN::Module::fforce ;
10539 $self->{force_update} = 2;
10542 #-> sub CPAN::Module::notest ;
10545 # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module");
10549 #-> sub CPAN::Module::rematein ;
10551 my($self,$meth) = @_;
10552 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
10555 my $cpan_file = $self->cpan_file;
10556 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/) {
10557 $CPAN::Frontend->mywarn(sprintf qq{
10558 The module %s isn\'t available on CPAN.
10560 Either the module has not yet been uploaded to CPAN, or it is
10561 temporary unavailable. Please contact the author to find out
10562 more about the status. Try 'i %s'.
10569 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
10570 $pack->called_for($self->id);
10571 if (exists $self->{force_update}) {
10572 if ($self->{force_update} == 2) {
10573 $pack->fforce($meth);
10575 $pack->force($meth);
10578 $pack->notest($meth) if exists $self->{notest} && $self->{notest};
10580 $pack->{reqtype} ||= "";
10581 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
10582 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
10583 if ($pack->{reqtype}) {
10584 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
10585 $pack->{reqtype} = $self->{reqtype};
10587 exists $pack->{install}
10590 UNIVERSAL::can($pack->{install},"failed") ?
10591 $pack->{install}->failed :
10592 $pack->{install} =~ /^NO/
10595 delete $pack->{install};
10596 $CPAN::Frontend->mywarn
10597 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
10601 $pack->{reqtype} = $self->{reqtype};
10604 my $success = eval {
10608 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
10609 $pack->unnotest if $pack->can("unnotest") && exists $self->{notest};
10610 delete $self->{force_update};
10611 delete $self->{notest};
10618 #-> sub CPAN::Module::perldoc ;
10619 sub perldoc { shift->rematein('perldoc') }
10620 #-> sub CPAN::Module::readme ;
10621 sub readme { shift->rematein('readme') }
10622 #-> sub CPAN::Module::look ;
10623 sub look { shift->rematein('look') }
10624 #-> sub CPAN::Module::cvs_import ;
10625 sub cvs_import { shift->rematein('cvs_import') }
10626 #-> sub CPAN::Module::get ;
10627 sub get { shift->rematein('get',@_) }
10628 #-> sub CPAN::Module::make ;
10629 sub make { shift->rematein('make') }
10630 #-> sub CPAN::Module::test ;
10633 # $self->{badtestcnt} ||= 0;
10634 $self->rematein('test',@_);
10637 #-> sub CPAN::Module::uptodate ;
10641 my $inst = $self->inst_version or return undef;
10642 my $cpan = $self->cpan_version;
10644 CPAN::Version->vgt($cpan,$inst) and return 0;
10645 CPAN->debug(join("",
10646 "returning uptodate. inst_file[",
10648 "cpan[$cpan] inst[$inst]")) if $CPAN::DEBUG;
10652 #-> sub CPAN::Module::install ;
10656 if ($self->uptodate
10658 not exists $self->{force_update}
10660 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
10662 $self->inst_version,
10667 my $ro = $self->ro;
10668 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
10669 $CPAN::Frontend->mywarn(qq{
10670 \n\n\n ***WARNING***
10671 The module $self->{ID} has no active maintainer.\n\n\n
10673 $CPAN::Frontend->mysleep(5);
10675 return $doit ? $self->rematein('install') : 1;
10677 #-> sub CPAN::Module::clean ;
10678 sub clean { shift->rematein('clean') }
10680 #-> sub CPAN::Module::inst_file ;
10683 $self->_file_in_path([@INC]);
10686 #-> sub CPAN::Module::available_file ;
10687 sub available_file {
10689 my $sep = $Config::Config{path_sep};
10690 my $perllib = $ENV{PERL5LIB};
10691 $perllib = $ENV{PERLLIB} unless defined $perllib;
10692 my @perllib = split(/$sep/,$perllib) if defined $perllib;
10694 if ($CPAN::Perl5lib_tempfile) {
10695 my $yaml = CPAN->_yaml_loadfile($CPAN::Perl5lib_tempfile);
10696 @cpan_perl5inc = @{$yaml->[0]{inc} || []};
10698 $self->_file_in_path([@cpan_perl5inc,@perllib,@INC]);
10701 #-> sub CPAN::Module::file_in_path ;
10702 sub _file_in_path {
10703 my($self,$path) = @_;
10704 my($dir,@packpath);
10705 @packpath = split /::/, $self->{ID};
10706 $packpath[-1] .= ".pm";
10707 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
10708 unshift @packpath, "Term", "ReadLine"; # historical reasons
10710 foreach $dir (@$path) {
10711 my $pmfile = File::Spec->catfile($dir,@packpath);
10719 #-> sub CPAN::Module::xs_file ;
10722 my($dir,@packpath);
10723 @packpath = split /::/, $self->{ID};
10724 push @packpath, $packpath[-1];
10725 $packpath[-1] .= "." . $Config::Config{'dlext'};
10726 foreach $dir (@INC) {
10727 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
10735 #-> sub CPAN::Module::inst_version ;
10738 my $parsefile = $self->inst_file or return;
10739 my $have = $self->parse_version($parsefile);
10743 #-> sub CPAN::Module::inst_version ;
10744 sub available_version {
10746 my $parsefile = $self->available_file or return;
10747 my $have = $self->parse_version($parsefile);
10751 #-> sub CPAN::Module::parse_version ;
10752 sub parse_version {
10753 my($self,$parsefile) = @_;
10754 my $have = eval { MM->parse_version($parsefile); };
10756 $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
10758 my $leastsanity = eval { defined $have && length $have; };
10759 $have = "undef" unless $leastsanity;
10760 $have =~ s/^ //; # since the %vd hack these two lines here are needed
10761 $have =~ s/ $//; # trailing whitespace happens all the time
10763 $have = CPAN::Version->readable($have);
10765 $have =~ s/\s*//g; # stringify to float around floating point issues
10766 $have; # no stringify needed, \s* above matches always
10769 #-> sub CPAN::Module::reports
10772 $self->distribution->reports;
10785 CPAN - query, download and build perl modules from CPAN sites
10791 perl -MCPAN -e shell
10801 cpan> install Acme::Meta # in the shell
10803 CPAN::Shell->install("Acme::Meta"); # in perl
10807 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
10810 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
10814 $mo = CPAN::Shell->expandany($mod);
10815 $mo = CPAN::Shell->expand("Module",$mod); # same thing
10817 # distribution objects:
10819 $do = CPAN::Shell->expand("Module",$mod)->distribution;
10820 $do = CPAN::Shell->expandany($distro); # same thing
10821 $do = CPAN::Shell->expand("Distribution",
10822 $distro); # same thing
10826 The CPAN module automates or at least simplifies the make and install
10827 of perl modules and extensions. It includes some primitive searching
10828 capabilities and knows how to use Net::FTP or LWP or some external
10829 download clients to fetch the distributions from the net.
10831 These are fetched from one or more of the mirrored CPAN (Comprehensive
10832 Perl Archive Network) sites and unpacked in a dedicated directory.
10834 The CPAN module also supports the concept of named and versioned
10835 I<bundles> of modules. Bundles simplify the handling of sets of
10836 related modules. See Bundles below.
10838 The package contains a session manager and a cache manager. The
10839 session manager keeps track of what has been fetched, built and
10840 installed in the current session. The cache manager keeps track of the
10841 disk space occupied by the make processes and deletes excess space
10842 according to a simple FIFO mechanism.
10844 All methods provided are accessible in a programmer style and in an
10845 interactive shell style.
10847 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
10849 The interactive mode is entered by running
10851 perl -MCPAN -e shell
10857 which puts you into a readline interface. If C<Term::ReadKey> and
10858 either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
10859 it supports both history and command completion.
10861 Once you are on the command line, type C<h> to get a one page help
10862 screen and the rest should be self-explanatory.
10864 The function call C<shell> takes two optional arguments, one is the
10865 prompt, the second is the default initial command line (the latter
10866 only works if a real ReadLine interface module is installed).
10868 The most common uses of the interactive modes are
10872 =item Searching for authors, bundles, distribution files and modules
10874 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
10875 for each of the four categories and another, C<i> for any of the
10876 mentioned four. Each of the four entities is implemented as a class
10877 with slightly differing methods for displaying an object.
10879 Arguments you pass to these commands are either strings exactly matching
10880 the identification string of an object or regular expressions that are
10881 then matched case-insensitively against various attributes of the
10882 objects. The parser recognizes a regular expression only if you
10883 enclose it between two slashes.
10885 The principle is that the number of found objects influences how an
10886 item is displayed. If the search finds one item, the result is
10887 displayed with the rather verbose method C<as_string>, but if we find
10888 more than one, we display each object with the terse method
10893 cpan> m Acme::MetaSyntactic
10894 Module id = Acme::MetaSyntactic
10895 CPAN_USERID BOOK (Philippe Bruhat (BooK) <[...]>)
10897 CPAN_FILE B/BO/BOOK/Acme-MetaSyntactic-0.99.tar.gz
10898 UPLOAD_DATE 2006-11-06
10899 MANPAGE Acme::MetaSyntactic - Themed metasyntactic variables names
10900 INST_FILE /usr/local/lib/perl/5.10.0/Acme/MetaSyntactic.pm
10905 FULLNAME Philippe Bruhat (BooK)
10906 cpan> d BOOK/Acme-MetaSyntactic-0.99.tar.gz
10907 Distribution id = B/BO/BOOK/Acme-MetaSyntactic-0.99.tar.gz
10908 CPAN_USERID BOOK (Philippe Bruhat (BooK) <[...]>)
10909 CONTAINSMODS Acme::MetaSyntactic Acme::MetaSyntactic::Alias [...]
10910 UPLOAD_DATE 2006-11-06
10912 Module = Acme::MetaSyntactic::loremipsum (BOOK/Acme-MetaSyntactic-0.99.tar.gz)
10913 Module Text::Lorem (ADEOLA/Text-Lorem-0.3.tar.gz)
10914 Module Text::Lorem::More (RKRIMEN/Text-Lorem-More-0.12.tar.gz)
10915 Module Text::Lorem::More::Source (RKRIMEN/Text-Lorem-More-0.12.tar.gz)
10917 Distribution BEATNIK/Filter-NumberLines-0.02.tar.gz
10918 Module = DateTime::TimeZone::Europe::Berlin (DROLSKY/DateTime-TimeZone-0.7904.tar.gz)
10919 Module Filter::NumberLines (BEATNIK/Filter-NumberLines-0.02.tar.gz)
10922 The examples illustrate several aspects: the first three queries
10923 target modules, authors, or distros directly and yield exactly one
10924 result. The last two use regular expressions and yield several
10925 results. The last one targets all of bundles, modules, authors, and
10926 distros simultaneously. When more than one result is available, they
10927 are printed in one-line format.
10929 =item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
10931 These commands take any number of arguments and investigate what is
10932 necessary to perform the action. If the argument is a distribution
10933 file name (recognized by embedded slashes), it is processed. If it is
10934 a module, CPAN determines the distribution file in which this module
10935 is included and processes that, following any dependencies named in
10936 the module's META.yml or Makefile.PL (this behavior is controlled by
10937 the configuration parameter C<prerequisites_policy>.)
10939 C<get> downloads a distribution file and untars or unzips it, C<make>
10940 builds it, C<test> runs the test suite, and C<install> installs it.
10942 Any C<make> or C<test> are run unconditionally. An
10944 install <distribution_file>
10946 also is run unconditionally. But for
10950 CPAN checks if an install is actually needed for it and prints
10951 I<module up to date> in the case that the distribution file containing
10952 the module doesn't need to be updated.
10954 CPAN also keeps track of what it has done within the current session
10955 and doesn't try to build a package a second time regardless if it
10956 succeeded or not. It does not repeat a test run if the test
10957 has been run successfully before. Same for install runs.
10959 The C<force> pragma may precede another command (currently: C<get>,
10960 C<make>, C<test>, or C<install>) and executes the command from scratch
10961 and tries to continue in case of some errors. See the section below on
10962 the C<force> and the C<fforce> pragma.
10964 The C<notest> pragma may be used to skip the test part in the build
10969 cpan> notest install Tk
10971 A C<clean> command results in a
10975 being executed within the distribution file's working directory.
10977 =item C<readme>, C<perldoc>, C<look> module or distribution
10979 C<readme> displays the README file of the associated distribution.
10980 C<Look> gets and untars (if not yet done) the distribution file,
10981 changes to the appropriate directory and opens a subshell process in
10982 that directory. C<perldoc> displays the pod documentation of the
10983 module in html or plain text format.
10987 =item C<ls> globbing_expression
10989 The first form lists all distribution files in and below an author's
10990 CPAN directory as they are stored in the CHECKUMS files distributed on
10991 CPAN. The listing goes recursive into all subdirectories.
10993 The second form allows to limit or expand the output with shell
10994 globbing as in the following examples:
11000 The last example is very slow and outputs extra progress indicators
11001 that break the alignment of the result.
11003 Note that globbing only lists directories explicitly asked for, for
11004 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
11005 regarded as a bug and may be changed in future versions.
11009 The C<failed> command reports all distributions that failed on one of
11010 C<make>, C<test> or C<install> for some reason in the currently
11011 running shell session.
11013 =item Persistence between sessions
11015 If the C<YAML> or the C<YAML::Syck> module is installed a record of
11016 the internal state of all modules is written to disk after each step.
11017 The files contain a signature of the currently running perl version
11020 If the configurations variable C<build_dir_reuse> is set to a true
11021 value, then CPAN.pm reads the collected YAML files. If the stored
11022 signature matches the currently running perl the stored state is
11023 loaded into memory such that effectively persistence between sessions
11026 =item The C<force> and the C<fforce> pragma
11028 To speed things up in complex installation scenarios, CPAN.pm keeps
11029 track of what it has already done and refuses to do some things a
11030 second time. A C<get>, a C<make>, and an C<install> are not repeated.
11031 A C<test> is only repeated if the previous test was unsuccessful. The
11032 diagnostic message when CPAN.pm refuses to do something a second time
11033 is one of I<Has already been >C<unwrapped|made|tested successfully> or
11034 something similar. Another situation where CPAN refuses to act is an
11035 C<install> if the according C<test> was not successful.
11037 In all these cases, the user can override the goatish behaviour by
11038 prepending the command with the word force, for example:
11040 cpan> force get Foo
11041 cpan> force make AUTHOR/Bar-3.14.tar.gz
11042 cpan> force test Baz
11043 cpan> force install Acme::Meta
11045 Each I<forced> command is executed with the according part of its
11048 The C<fforce> pragma is a variant that emulates a C<force get> which
11049 erases the entire memory followed by the action specified, effectively
11050 restarting the whole get/make/test/install procedure from scratch.
11054 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
11055 Batch jobs can run without a lockfile and do not disturb each other.
11057 The shell offers to run in I<degraded mode> when another process is
11058 holding the lockfile. This is an experimental feature that is not yet
11059 tested very well. This second shell then does not write the history
11060 file, does not use the metadata file and has a different prompt.
11064 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
11065 in the cpan-shell it is intended that you can press C<^C> anytime and
11066 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
11067 to clean up and leave the shell loop. You can emulate the effect of a
11068 SIGTERM by sending two consecutive SIGINTs, which usually means by
11069 pressing C<^C> twice.
11071 CPAN.pm ignores a SIGPIPE. If the user sets C<inactivity_timeout>, a
11072 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
11073 Build.PL> subprocess.
11079 The commands that are available in the shell interface are methods in
11080 the package CPAN::Shell. If you enter the shell command, all your
11081 input is split by the Text::ParseWords::shellwords() routine which
11082 acts like most shells do. The first word is being interpreted as the
11083 method to be called and the rest of the words are treated as arguments
11084 to this method. Continuation lines are supported if a line ends with a
11089 C<autobundle> writes a bundle file into the
11090 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
11091 a list of all modules that are both available from CPAN and currently
11092 installed within @INC. The name of the bundle file is based on the
11093 current date and a counter.
11097 Note: this feature is still in alpha state and may change in future
11098 versions of CPAN.pm
11100 This commands provides a statistical overview over recent download
11101 activities. The data for this is collected in the YAML file
11102 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
11103 configured or YAML not installed, then no stats are provided.
11107 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
11108 directory so that you can save your own preferences instead of the
11111 =head2 recent ***EXPERIMENTAL COMMAND***
11113 The C<recent> command downloads a list of recent uploads to CPAN and
11114 displays them I<slowly>. While the command is running $SIG{INT} is
11115 defined to mean that the loop shall be left after having displayed the
11118 B<Note>: This command requires XML::LibXML installed.
11120 B<Note>: This whole command currently is just a hack and will
11121 probably change in future versions of CPAN.pm but the general
11122 approach will likely stay.
11124 B<Note>: See also L<smoke>
11128 recompile() is a very special command in that it takes no argument and
11129 runs the make/test/install cycle with brute force over all installed
11130 dynamically loadable extensions (aka XS modules) with 'force' in
11131 effect. The primary purpose of this command is to finish a network
11132 installation. Imagine, you have a common source tree for two different
11133 architectures. You decide to do a completely independent fresh
11134 installation. You start on one architecture with the help of a Bundle
11135 file produced earlier. CPAN installs the whole Bundle for you, but
11136 when you try to repeat the job on the second architecture, CPAN
11137 responds with a C<"Foo up to date"> message for all modules. So you
11138 invoke CPAN's recompile on the second architecture and you're done.
11140 Another popular use for C<recompile> is to act as a rescue in case your
11141 perl breaks binary compatibility. If one of the modules that CPAN uses
11142 is in turn depending on binary compatibility (so you cannot run CPAN
11143 commands), then you should try the CPAN::Nox module for recovery.
11145 =head2 report Bundle|Distribution|Module
11147 The C<report> command temporarily turns on the C<test_report> config
11148 variable, then runs the C<force test> command with the given
11149 arguments. The C<force> pragma is used to re-run the tests and repeat
11150 every step that might have failed before.
11152 =head2 smoke ***EXPERIMENTAL COMMAND***
11154 B<*** WARNING: this command downloads and executes software from CPAN to
11155 your computer of completely unknown status. You should never do
11156 this with your normal account and better have a dedicated well
11157 separated and secured machine to do this. ***>
11159 The C<smoke> command takes the list of recent uploads to CPAN as
11160 provided by the C<recent> command and tests them all. While the
11161 command is running $SIG{INT} is defined to mean that the current item
11164 B<Note>: This whole command currently is just a hack and will
11165 probably change in future versions of CPAN.pm but the general
11166 approach will likely stay.
11168 B<Note>: See also L<recent>
11170 =head2 upgrade [Module|/Regex/]...
11172 The C<upgrade> command first runs an C<r> command with the given
11173 arguments and then installs the newest versions of all modules that
11174 were listed by that.
11176 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
11178 Although it may be considered internal, the class hierarchy does matter
11179 for both users and programmer. CPAN.pm deals with above mentioned four
11180 classes, and all those classes share a set of methods. A classical
11181 single polymorphism is in effect. A metaclass object registers all
11182 objects of all kinds and indexes them with a string. The strings
11183 referencing objects have a separated namespace (well, not completely
11188 words containing a "/" (slash) Distribution
11189 words starting with Bundle:: Bundle
11190 everything else Module or Author
11192 Modules know their associated Distribution objects. They always refer
11193 to the most recent official release. Developers may mark their releases
11194 as unstable development versions (by inserting an underbar into the
11195 module version number which will also be reflected in the distribution
11196 name when you run 'make dist'), so the really hottest and newest
11197 distribution is not always the default. If a module Foo circulates
11198 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
11199 way to install version 1.23 by saying
11203 This would install the complete distribution file (say
11204 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
11205 like to install version 1.23_90, you need to know where the
11206 distribution file resides on CPAN relative to the authors/id/
11207 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
11208 so you would have to say
11210 install BAR/Foo-1.23_90.tar.gz
11212 The first example will be driven by an object of the class
11213 CPAN::Module, the second by an object of class CPAN::Distribution.
11215 =head2 Integrating local directories
11217 Note: this feature is still in alpha state and may change in future
11218 versions of CPAN.pm
11220 Distribution objects are normally distributions from the CPAN, but
11221 there is a slightly degenerate case for Distribution objects, too, of
11222 projects held on the local disk. These distribution objects have the
11223 same name as the local directory and end with a dot. A dot by itself
11224 is also allowed for the current directory at the time CPAN.pm was
11225 used. All actions such as C<make>, C<test>, and C<install> are applied
11226 directly to that directory. This gives the command C<cpan .> an
11227 interesting touch: while the normal mantra of installing a CPAN module
11228 without CPAN.pm is one of
11230 perl Makefile.PL perl Build.PL
11231 ( go and get prerequisites )
11233 make test ./Build test
11234 make install ./Build install
11236 the command C<cpan .> does all of this at once. It figures out which
11237 of the two mantras is appropriate, fetches and installs all
11238 prerequisites, cares for them recursively and finally finishes the
11239 installation of the module in the current directory, be it a CPAN
11242 The typical usage case is for private modules or working copies of
11243 projects from remote repositories on the local disk.
11247 The usual shell redirection symbols C< | > and C<< > >> are recognized
11248 by the cpan shell when surrounded by whitespace. So piping into a
11249 pager and redirecting output into a file works quite similar to any
11252 =head1 CONFIGURATION
11254 When the CPAN module is used for the first time, a configuration
11255 dialog tries to determine a couple of site specific options. The
11256 result of the dialog is stored in a hash reference C< $CPAN::Config >
11257 in a file CPAN/Config.pm.
11259 The default values defined in the CPAN/Config.pm file can be
11260 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
11261 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
11262 added to the search path of the CPAN module before the use() or
11263 require() statements. The mkmyconfig command writes this file for you.
11265 The C<o conf> command has various bells and whistles:
11269 =item completion support
11271 If you have a ReadLine module installed, you can hit TAB at any point
11272 of the commandline and C<o conf> will offer you completion for the
11273 built-in subcommands and/or config variable names.
11275 =item displaying some help: o conf help
11277 Displays a short help
11279 =item displaying current values: o conf [KEY]
11281 Displays the current value(s) for this config variable. Without KEY
11282 displays all subcommands and config variables.
11288 If KEY starts and ends with a slash the string in between is
11289 interpreted as a regular expression and only keys matching this regex
11296 =item changing of scalar values: o conf KEY VALUE
11298 Sets the config variable KEY to VALUE. The empty string can be
11299 specified as usual in shells, with C<''> or C<"">
11303 o conf wget /usr/bin/wget
11305 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
11307 If a config variable name ends with C<list>, it is a list. C<o conf
11308 KEY shift> removes the first element of the list, C<o conf KEY pop>
11309 removes the last element of the list. C<o conf KEYS unshift LIST>
11310 prepends a list of values to the list, C<o conf KEYS push LIST>
11311 appends a list of valued to the list.
11313 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
11316 Finally, any other list of arguments is taken as a new list value for
11317 the KEY variable discarding the previous value.
11321 o conf urllist unshift http://cpan.dev.local/CPAN
11322 o conf urllist splice 3 1
11323 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
11325 =item reverting to saved: o conf defaults
11327 Reverts all config variables to the state in the saved config file.
11329 =item saving the config: o conf commit
11331 Saves all config variables to the current config file (CPAN/Config.pm
11332 or CPAN/MyConfig.pm that was loaded at start).
11336 The configuration dialog can be started any time later again by
11337 issuing the command C< o conf init > in the CPAN shell. A subset of
11338 the configuration dialog can be run by issuing C<o conf init WORD>
11339 where WORD is any valid config variable or a regular expression.
11341 =head2 Config Variables
11343 Currently the following keys in the hash reference $CPAN::Config are
11346 applypatch path to external prg
11347 auto_commit commit all changes to config variables to disk
11348 build_cache size of cache for directories to build modules
11349 build_dir locally accessible directory to build modules
11350 build_dir_reuse boolean if distros in build_dir are persistent
11351 build_requires_install_policy
11352 to install or not to install when a module is
11353 only needed for building. yes|no|ask/yes|ask/no
11354 bzip2 path to external prg
11355 cache_metadata use serializer to cache metadata
11356 check_sigs if signatures should be verified
11357 colorize_debug Term::ANSIColor attributes for debugging output
11358 colorize_output boolean if Term::ANSIColor should colorize output
11359 colorize_print Term::ANSIColor attributes for normal output
11360 colorize_warn Term::ANSIColor attributes for warnings
11361 commandnumber_in_prompt
11362 boolean if you want to see current command number
11363 commands_quote prefered character to use for quoting external
11364 commands when running them. Defaults to double
11365 quote on Windows, single tick everywhere else;
11366 can be set to space to disable quoting
11367 connect_to_internet_ok
11368 if we shall ask if opening a connection is ok before
11369 urllist is specified
11370 cpan_home local directory reserved for this package
11371 curl path to external prg
11372 dontload_hash DEPRECATED
11373 dontload_list arrayref: modules in the list will not be
11374 loaded by the CPAN::has_inst() routine
11375 ftp path to external prg
11376 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
11377 ftp_proxy proxy host for ftp requests
11378 ftpstats_period max number of days to keep download statistics
11379 ftpstats_size max number of items to keep in the download statistics
11381 gpg path to external prg
11382 gzip location of external program gzip
11383 halt_on_failure stop processing after the first failure of queued
11384 items or dependencies
11385 histfile file to maintain history between sessions
11386 histsize maximum number of lines to keep in histfile
11387 http_proxy proxy host for http requests
11388 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
11389 after this many seconds inactivity. Set to 0 to
11391 index_expire after this many days refetch index files
11392 inhibit_startup_message
11393 if true, does not print the startup message
11394 keep_source_where directory in which to keep the source (if we do)
11395 load_module_verbosity
11396 report loading of optional modules used by CPAN.pm
11397 lynx path to external prg
11398 make location of external make program
11399 make_arg arguments that should always be passed to 'make'
11400 make_install_make_command
11401 the make command for running 'make install', for
11402 example 'sudo make'
11403 make_install_arg same as make_arg for 'make install'
11404 makepl_arg arguments passed to 'perl Makefile.PL'
11405 mbuild_arg arguments passed to './Build'
11406 mbuild_install_arg arguments passed to './Build install'
11407 mbuild_install_build_command
11408 command to use instead of './Build' when we are
11409 in the install stage, for example 'sudo ./Build'
11410 mbuildpl_arg arguments passed to 'perl Build.PL'
11411 ncftp path to external prg
11412 ncftpget path to external prg
11413 no_proxy don't proxy to these hosts/domains (comma separated list)
11414 pager location of external program more (or any pager)
11415 password your password if you CPAN server wants one
11416 patch path to external prg
11417 perl5lib_verbosity verbosity level for PERL5LIB additions
11418 prefer_installer legal values are MB and EUMM: if a module comes
11419 with both a Makefile.PL and a Build.PL, use the
11420 former (EUMM) or the latter (MB); if the module
11421 comes with only one of the two, that one will be
11423 prerequisites_policy
11424 what to do if you are missing module prerequisites
11425 ('follow' automatically, 'ask' me, or 'ignore')
11426 prefs_dir local directory to store per-distro build options
11427 proxy_user username for accessing an authenticating proxy
11428 proxy_pass password for accessing an authenticating proxy
11429 randomize_urllist add some randomness to the sequence of the urllist
11430 scan_cache controls scanning of cache ('atstart' or 'never')
11431 shell your favorite shell
11432 show_unparsable_versions
11433 boolean if r command tells which modules are versionless
11434 show_upload_date boolean if commands should try to determine upload date
11435 show_zero_versions boolean if r command tells for which modules $version==0
11436 tar location of external program tar
11437 tar_verbosity verbosity level for the tar command
11438 term_is_latin deprecated: if true Unicode is translated to ISO-8859-1
11439 (and nonsense for characters outside latin range)
11440 term_ornaments boolean to turn ReadLine ornamenting on/off
11441 test_report email test reports (if CPAN::Reporter is installed)
11442 trust_test_report_history
11443 skip testing when previously tested ok (according to
11444 CPAN::Reporter history)
11445 unzip location of external program unzip
11446 urllist arrayref to nearby CPAN sites (or equivalent locations)
11447 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
11448 username your username if you CPAN server wants one
11449 wait_list arrayref to a wait server to try (See CPAN::WAIT)
11450 wget path to external prg
11451 yaml_load_code enable YAML code deserialisation via CPAN::DeferedCode
11452 yaml_module which module to use to read/write YAML files
11454 You can set and query each of these options interactively in the cpan
11455 shell with the C<o conf> or the C<o conf init> command as specified below.
11459 =item C<o conf E<lt>scalar optionE<gt>>
11461 prints the current value of the I<scalar option>
11463 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
11465 Sets the value of the I<scalar option> to I<value>
11467 =item C<o conf E<lt>list optionE<gt>>
11469 prints the current value of the I<list option> in MakeMaker's
11472 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
11474 shifts or pops the array in the I<list option> variable
11476 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
11478 works like the corresponding perl commands.
11480 =item interactive editing: o conf init [MATCH|LIST]
11482 Runs an interactive configuration dialog for matching variables.
11483 Without argument runs the dialog over all supported config variables.
11484 To specify a MATCH the argument must be enclosed by slashes.
11488 o conf init ftp_passive ftp_proxy
11489 o conf init /color/
11491 Note: this method of setting config variables often provides more
11492 explanation about the functioning of a variable than the manpage.
11496 =head2 CPAN::anycwd($path): Note on config variable getcwd
11498 CPAN.pm changes the current working directory often and needs to
11499 determine its own current working directory. Per default it uses
11500 Cwd::cwd but if this doesn't work on your system for some reason,
11501 alternatives can be configured according to the following table:
11519 Calls the external command cwd.
11523 =head2 Note on the format of the urllist parameter
11525 urllist parameters are URLs according to RFC 1738. We do a little
11526 guessing if your URL is not compliant, but if you have problems with
11527 C<file> URLs, please try the correct format. Either:
11529 file://localhost/whatever/ftp/pub/CPAN/
11533 file:///home/ftp/pub/CPAN/
11535 =head2 The urllist parameter has CD-ROM support
11537 The C<urllist> parameter of the configuration table contains a list of
11538 URLs that are to be used for downloading. If the list contains any
11539 C<file> URLs, CPAN always tries to get files from there first. This
11540 feature is disabled for index files. So the recommendation for the
11541 owner of a CD-ROM with CPAN contents is: include your local, possibly
11542 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
11544 o conf urllist push file://localhost/CDROM/CPAN
11546 CPAN.pm will then fetch the index files from one of the CPAN sites
11547 that come at the beginning of urllist. It will later check for each
11548 module if there is a local copy of the most recent version.
11550 Another peculiarity of urllist is that the site that we could
11551 successfully fetch the last file from automatically gets a preference
11552 token and is tried as the first site for the next request. So if you
11553 add a new site at runtime it may happen that the previously preferred
11554 site will be tried another time. This means that if you want to disallow
11555 a site for the next transfer, it must be explicitly removed from
11558 =head2 Maintaining the urllist parameter
11560 If you have YAML.pm (or some other YAML module configured in
11561 C<yaml_module>) installed, CPAN.pm collects a few statistical data
11562 about recent downloads. You can view the statistics with the C<hosts>
11563 command or inspect them directly by looking into the C<FTPstats.yml>
11564 file in your C<cpan_home> directory.
11566 To get some interesting statistics it is recommended to set the
11567 C<randomize_urllist> parameter that introduces some amount of
11568 randomness into the URL selection.
11570 =head2 The C<requires> and C<build_requires> dependency declarations
11572 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
11573 a distribution are treated differently depending on the config
11574 variable C<build_requires_install_policy>. By setting
11575 C<build_requires_install_policy> to C<no> such a module is not being
11576 installed. It is only built and tested and then kept in the list of
11577 tested but uninstalled modules. As such it is available during the
11578 build of the dependent module by integrating the path to the
11579 C<blib/arch> and C<blib/lib> directories in the environment variable
11580 PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
11581 both modules declared as C<requires> and those declared as
11582 C<build_requires> are treated alike. By setting to C<ask/yes> or
11583 C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
11585 =head2 Configuration for individual distributions (I<Distroprefs>)
11587 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
11588 still considered beta quality)
11590 Distributions on the CPAN usually behave according to what we call the
11591 CPAN mantra. Or since the event of Module::Build we should talk about
11594 perl Makefile.PL perl Build.PL
11596 make test ./Build test
11597 make install ./Build install
11599 But some modules cannot be built with this mantra. They try to get
11600 some extra data from the user via the environment, extra arguments or
11601 interactively thus disturbing the installation of large bundles like
11602 Phalanx100 or modules with many dependencies like Plagger.
11604 The distroprefs system of C<CPAN.pm> addresses this problem by
11605 allowing the user to specify extra informations and recipes in YAML
11612 pass additional arguments to one of the four commands,
11616 set environment variables
11620 instantiate an Expect object that reads from the console, waits for
11621 some regular expressions and enters some answers
11625 temporarily override assorted C<CPAN.pm> configuration variables
11629 specify dependencies that the original maintainer forgot to specify
11633 disable the installation of an object altogether
11637 See the YAML and Data::Dumper files that come with the C<CPAN.pm>
11638 distribution in the C<distroprefs/> directory for examples.
11642 The YAML files themselves must have the C<.yml> extension, all other
11643 files are ignored (for two exceptions see I<Fallback Data::Dumper and
11644 Storable> below). The containing directory can be specified in
11645 C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
11646 prefs_dir> in the CPAN shell to set and activate the distroprefs
11649 Every YAML file may contain arbitrary documents according to the YAML
11650 specification and every single document is treated as an entity that
11651 can specify the treatment of a single distribution.
11653 The names of the files can be picked freely, C<CPAN.pm> always reads
11654 all files (in alphabetical order) and takes the key C<match> (see
11655 below in I<Language Specs>) as a hashref containing match criteria
11656 that determine if the current distribution matches the YAML document
11659 =head2 Fallback Data::Dumper and Storable
11661 If neither your configured C<yaml_module> nor YAML.pm is installed
11662 CPAN.pm falls back to using Data::Dumper and Storable and looks for
11663 files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
11664 directory. These files are expected to contain one or more hashrefs.
11665 For Data::Dumper generated files, this is expected to be done with by
11666 defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
11669 ysh < somefile.yml > somefile.dd
11671 For Storable files the rule is that they must be constructed such that
11672 C<Storable::retrieve(file)> returns an array reference and the array
11673 elements represent one distropref object each. The conversion from
11674 YAML would look like so:
11676 perl -MYAML=LoadFile -MStorable=nstore -e '
11677 @y=LoadFile(shift);
11678 nstore(\@y, shift)' somefile.yml somefile.st
11680 In bootstrapping situations it is usually sufficient to translate only
11681 a few YAML files to Data::Dumper for the crucial modules like
11682 C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
11683 over Data::Dumper, remember to pull out a Storable version that writes
11684 an older format than all the other Storable versions that will need to
11689 The following example contains all supported keywords and structures
11690 with the exception of C<eexpect> which can be used instead of
11696 module: "Dancing::Queen"
11697 distribution: "^CHACHACHA/Dancing-"
11698 perl: "/usr/local/cariba-perl/bin/perl"
11700 archname: "freebsd"
11702 DANCING_FLOOR: "Shubiduh"
11708 - "--somearg=specialcase"
11713 - "Which is your favorite fruit"
11725 commendline: "echo SKIPPING make"
11738 WANT_TO_INSTALL: YES
11741 - "Do you really want to install"
11745 - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
11748 configure_requires:
11751 Test::Exception: 0.25
11756 =head2 Language Specs
11758 Every YAML document represents a single hash reference. The valid keys
11759 in this hash are as follows:
11763 =item comment [scalar]
11767 =item cpanconfig [hash]
11769 Temporarily override assorted C<CPAN.pm> configuration variables.
11771 Supported are: C<build_requires_install_policy>, C<check_sigs>,
11772 C<make>, C<make_install_make_command>, C<prefer_installer>,
11773 C<test_report>. Please report as a bug when you need another one
11776 =item depends [hash] *** EXPERIMENTAL FEATURE ***
11778 All three types, namely C<configure_requires>, C<build_requires>, and
11779 C<requires> are supported in the way specified in the META.yml
11780 specification. The current implementation I<merges> the specified
11781 dependencies with those declared by the package maintainer. In a
11782 future implementation this may be changed to override the original
11785 =item disabled [boolean]
11787 Specifies that this distribution shall not be processed at all.
11789 =item features [array] *** EXPERIMENTAL FEATURE ***
11791 Experimental implementation to deal with optional_features from
11792 META.yml. Still needs coordination with installer software and
11793 currently only works for META.yml declaring C<dynamic_config=0>. Use
11796 =item goto [string]
11798 The canonical name of a delegate distribution that shall be installed
11799 instead. Useful when a new version, although it tests OK itself,
11800 breaks something else or a developer release or a fork is already
11801 uploaded that is better than the last released version.
11803 =item install [hash]
11805 Processing instructions for the C<make install> or C<./Build install>
11806 phase of the CPAN mantra. See below under I<Processing Instructions>.
11810 Processing instructions for the C<make> or C<./Build> phase of the
11811 CPAN mantra. See below under I<Processing Instructions>.
11815 A hashref with one or more of the keys C<distribution>, C<modules>,
11816 C<perl>, C<perlconfig>, and C<env> that specify if a document is
11817 targeted at a specific CPAN distribution or installation.
11819 The corresponding values are interpreted as regular expressions. The
11820 C<distribution> related one will be matched against the canonical
11821 distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
11823 The C<module> related one will be matched against I<all> modules
11824 contained in the distribution until one module matches.
11826 The C<perl> related one will be matched against C<$^X> (but with the
11829 The value associated with C<perlconfig> is itself a hashref that is
11830 matched against corresponding values in the C<%Config::Config> hash
11831 living in the C<Config.pm> module.
11833 The value associated with C<env> is itself a hashref that is
11834 matched against corresponding values in the C<%ENV> hash.
11836 If more than one restriction of C<module>, C<distribution>, etc. is
11837 specified, the results of the separately computed match values must
11838 all match. If this is the case then the hashref represented by the
11839 YAML document is returned as the preference structure for the current
11842 =item patches [array]
11844 An array of patches on CPAN or on the local disk to be applied in
11845 order via the external patch program. If the value for the C<-p>
11846 parameter is C<0> or C<1> is determined by reading the patch
11849 Note: if the C<applypatch> program is installed and C<CPAN::Config>
11850 knows about it B<and> a patch is written by the C<makepatch> program,
11851 then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
11852 and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
11857 Processing instructions for the C<perl Makefile.PL> or C<perl
11858 Build.PL> phase of the CPAN mantra. See below under I<Processing
11863 Processing instructions for the C<make test> or C<./Build test> phase
11864 of the CPAN mantra. See below under I<Processing Instructions>.
11868 =head2 Processing Instructions
11874 Arguments to be added to the command line
11878 A full commandline that will be executed as it stands by a system
11879 call. During the execution the environment variable PERL will is set
11880 to $^X (but with an absolute path). If C<commandline> is specified,
11881 the content of C<args> is not used.
11883 =item eexpect [hash]
11885 Extended C<expect>. This is a hash reference with four allowed keys,
11886 C<mode>, C<timeout>, C<reuse>, and C<talk>.
11888 C<mode> may have the values C<deterministic> for the case where all
11889 questions come in the order written down and C<anyorder> for the case
11890 where the questions may come in any order. The default mode is
11893 C<timeout> denotes a timeout in seconds. Floating point timeouts are
11894 OK. In the case of a C<mode=deterministic> the timeout denotes the
11895 timeout per question, in the case of C<mode=anyorder> it denotes the
11896 timeout per byte received from the stream or questions.
11898 C<talk> is a reference to an array that contains alternating questions
11899 and answers. Questions are regular expressions and answers are literal
11900 strings. The Expect module will then watch the stream coming from the
11901 execution of the external program (C<perl Makefile.PL>, C<perl
11902 Build.PL>, C<make>, etc.).
11904 In the case of C<mode=deterministic> the CPAN.pm will inject the
11905 according answer as soon as the stream matches the regular expression.
11907 In the case of C<mode=anyorder> CPAN.pm will answer a question as soon
11908 as the timeout is reached for the next byte in the input stream. In
11909 this mode you can use the C<reuse> parameter to decide what shall
11910 happen with a question-answer pair after it has been used. In the
11911 default case (reuse=0) it is removed from the array, so it cannot be
11912 used again accidentally. In this case, if you want to answer the
11913 question C<Do you really want to do that> several times, then it must
11914 be included in the array at least as often as you want this answer to
11915 be given. Setting the parameter C<reuse> to 1 makes this repetition
11920 Environment variables to be set during the command
11922 =item expect [array]
11924 C<< expect: <array> >> is a short notation for
11927 mode: deterministic
11933 =head2 Schema verification with C<Kwalify>
11935 If you have the C<Kwalify> module installed (which is part of the
11936 Bundle::CPANxxl), then all your distroprefs files are checked for
11937 syntactical correctness.
11939 =head2 Example Distroprefs Files
11941 C<CPAN.pm> comes with a collection of example YAML files. Note that these
11942 are really just examples and should not be used without care because
11943 they cannot fit everybody's purpose. After all the authors of the
11944 packages that ask questions had a need to ask, so you should watch
11945 their questions and adjust the examples to your environment and your
11946 needs. You have beend warned:-)
11948 =head1 PROGRAMMER'S INTERFACE
11950 If you do not enter the shell, the available shell commands are both
11951 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
11952 functions in the calling package (C<install(...)>). Before calling low-level
11953 commands it makes sense to initialize components of CPAN you need, e.g.:
11955 CPAN::HandleConfig->load;
11956 CPAN::Shell::setup_output;
11957 CPAN::Index->reload;
11959 High-level commands do such initializations automatically.
11961 There's currently only one class that has a stable interface -
11962 CPAN::Shell. All commands that are available in the CPAN shell are
11963 methods of the class CPAN::Shell. Each of the commands that produce
11964 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
11965 the IDs of all modules within the list.
11969 =item expand($type,@things)
11971 The IDs of all objects available within a program are strings that can
11972 be expanded to the corresponding real objects with the
11973 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
11974 list of CPAN::Module objects according to the C<@things> arguments
11975 given. In scalar context it only returns the first element of the
11978 =item expandany(@things)
11980 Like expand, but returns objects of the appropriate type, i.e.
11981 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
11982 CPAN::Distribution objects for distributions. Note: it does not expand
11983 to CPAN::Author objects.
11985 =item Programming Examples
11987 This enables the programmer to do operations that combine
11988 functionalities that are available in the shell.
11990 # install everything that is outdated on my disk:
11991 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
11993 # install my favorite programs if necessary:
11994 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)) {
11995 CPAN::Shell->install($mod);
11998 # list all modules on my disk that have no VERSION number
11999 for $mod (CPAN::Shell->expand("Module","/./")) {
12000 next unless $mod->inst_file;
12001 # MakeMaker convention for undefined $VERSION:
12002 next unless $mod->inst_version eq "undef";
12003 print "No VERSION in ", $mod->id, "\n";
12006 # find out which distribution on CPAN contains a module:
12007 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
12009 Or if you want to write a cronjob to watch The CPAN, you could list
12010 all modules that need updating. First a quick and dirty way:
12012 perl -e 'use CPAN; CPAN::Shell->r;'
12014 If you don't want to get any output in the case that all modules are
12015 up to date, you can parse the output of above command for the regular
12016 expression //modules are up to date// and decide to mail the output
12017 only if it doesn't match. Ick?
12019 If you prefer to do it more in a programmer style in one single
12020 process, maybe something like this suits you better:
12022 # list all modules on my disk that have newer versions on CPAN
12023 for $mod (CPAN::Shell->expand("Module","/./")) {
12024 next unless $mod->inst_file;
12025 next if $mod->uptodate;
12026 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
12027 $mod->id, $mod->inst_version, $mod->cpan_version;
12030 If that gives you too much output every day, you maybe only want to
12031 watch for three modules. You can write
12033 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")) {
12035 as the first line instead. Or you can combine some of the above
12038 # watch only for a new mod_perl module
12039 $mod = CPAN::Shell->expand("Module","mod_perl");
12040 exit if $mod->uptodate;
12041 # new mod_perl arrived, let me know all update recommendations
12046 =head2 Methods in the other Classes
12050 =item CPAN::Author::as_glimpse()
12052 Returns a one-line description of the author
12054 =item CPAN::Author::as_string()
12056 Returns a multi-line description of the author
12058 =item CPAN::Author::email()
12060 Returns the author's email address
12062 =item CPAN::Author::fullname()
12064 Returns the author's name
12066 =item CPAN::Author::name()
12068 An alias for fullname
12070 =item CPAN::Bundle::as_glimpse()
12072 Returns a one-line description of the bundle
12074 =item CPAN::Bundle::as_string()
12076 Returns a multi-line description of the bundle
12078 =item CPAN::Bundle::clean()
12080 Recursively runs the C<clean> method on all items contained in the bundle.
12082 =item CPAN::Bundle::contains()
12084 Returns a list of objects' IDs contained in a bundle. The associated
12085 objects may be bundles, modules or distributions.
12087 =item CPAN::Bundle::force($method,@args)
12089 Forces CPAN to perform a task that it normally would have refused to
12090 do. Force takes as arguments a method name to be called and any number
12091 of additional arguments that should be passed to the called method.
12092 The internals of the object get the needed changes so that CPAN.pm
12093 does not refuse to take the action. The C<force> is passed recursively
12094 to all contained objects. See also the section above on the C<force>
12095 and the C<fforce> pragma.
12097 =item CPAN::Bundle::get()
12099 Recursively runs the C<get> method on all items contained in the bundle
12101 =item CPAN::Bundle::inst_file()
12103 Returns the highest installed version of the bundle in either @INC or
12104 C<$CPAN::Config->{cpan_home}>. Note that this is different from
12105 CPAN::Module::inst_file.
12107 =item CPAN::Bundle::inst_version()
12109 Like CPAN::Bundle::inst_file, but returns the $VERSION
12111 =item CPAN::Bundle::uptodate()
12113 Returns 1 if the bundle itself and all its members are uptodate.
12115 =item CPAN::Bundle::install()
12117 Recursively runs the C<install> method on all items contained in the bundle
12119 =item CPAN::Bundle::make()
12121 Recursively runs the C<make> method on all items contained in the bundle
12123 =item CPAN::Bundle::readme()
12125 Recursively runs the C<readme> method on all items contained in the bundle
12127 =item CPAN::Bundle::test()
12129 Recursively runs the C<test> method on all items contained in the bundle
12131 =item CPAN::Distribution::as_glimpse()
12133 Returns a one-line description of the distribution
12135 =item CPAN::Distribution::as_string()
12137 Returns a multi-line description of the distribution
12139 =item CPAN::Distribution::author
12141 Returns the CPAN::Author object of the maintainer who uploaded this
12144 =item CPAN::Distribution::pretty_id()
12146 Returns a string of the form "AUTHORID/TARBALL", where AUTHORID is the
12147 author's PAUSE ID and TARBALL is the distribution filename.
12149 =item CPAN::Distribution::base_id()
12151 Returns the distribution filename without any archive suffix. E.g
12154 =item CPAN::Distribution::clean()
12156 Changes to the directory where the distribution has been unpacked and
12157 runs C<make clean> there.
12159 =item CPAN::Distribution::containsmods()
12161 Returns a list of IDs of modules contained in a distribution file.
12162 Only works for distributions listed in the 02packages.details.txt.gz
12163 file. This typically means that only the most recent version of a
12164 distribution is covered.
12166 =item CPAN::Distribution::cvs_import()
12168 Changes to the directory where the distribution has been unpacked and
12169 runs something like
12171 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
12175 =item CPAN::Distribution::dir()
12177 Returns the directory into which this distribution has been unpacked.
12179 =item CPAN::Distribution::force($method,@args)
12181 Forces CPAN to perform a task that it normally would have refused to
12182 do. Force takes as arguments a method name to be called and any number
12183 of additional arguments that should be passed to the called method.
12184 The internals of the object get the needed changes so that CPAN.pm
12185 does not refuse to take the action. See also the section above on the
12186 C<force> and the C<fforce> pragma.
12188 =item CPAN::Distribution::get()
12190 Downloads the distribution from CPAN and unpacks it. Does nothing if
12191 the distribution has already been downloaded and unpacked within the
12194 =item CPAN::Distribution::install()
12196 Changes to the directory where the distribution has been unpacked and
12197 runs the external command C<make install> there. If C<make> has not
12198 yet been run, it will be run first. A C<make test> will be issued in
12199 any case and if this fails, the install will be canceled. The
12200 cancellation can be avoided by letting C<force> run the C<install> for
12203 This install method has only the power to install the distribution if
12204 there are no dependencies in the way. To install an object and all of
12205 its dependencies, use CPAN::Shell->install.
12207 Note that install() gives no meaningful return value. See uptodate().
12209 =item CPAN::Distribution::install_tested()
12211 Install all the distributions that have been tested sucessfully but
12212 not yet installed. See also C<is_tested>.
12214 =item CPAN::Distribution::isa_perl()
12216 Returns 1 if this distribution file seems to be a perl distribution.
12217 Normally this is derived from the file name only, but the index from
12218 CPAN can contain a hint to achieve a return value of true for other
12221 =item CPAN::Distribution::look()
12223 Changes to the directory where the distribution has been unpacked and
12224 opens a subshell there. Exiting the subshell returns.
12226 =item CPAN::Distribution::make()
12228 First runs the C<get> method to make sure the distribution is
12229 downloaded and unpacked. Changes to the directory where the
12230 distribution has been unpacked and runs the external commands C<perl
12231 Makefile.PL> or C<perl Build.PL> and C<make> there.
12233 =item CPAN::Distribution::perldoc()
12235 Downloads the pod documentation of the file associated with a
12236 distribution (in html format) and runs it through the external
12237 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
12238 isn't available, it converts it to plain text with external
12239 command html2text and runs it through the pager specified
12240 in C<$CPAN::Config->{pager}>
12242 =item CPAN::Distribution::prefs()
12244 Returns the hash reference from the first matching YAML file that the
12245 user has deposited in the C<prefs_dir/> directory. The first
12246 succeeding match wins. The files in the C<prefs_dir/> are processed
12247 alphabetically and the canonical distroname (e.g.
12248 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
12249 stored in the $root->{match}{distribution} attribute value.
12250 Additionally all module names contained in a distribution are matched
12251 agains the regular expressions in the $root->{match}{module} attribute
12252 value. The two match values are ANDed together. Each of the two
12253 attributes are optional.
12255 =item CPAN::Distribution::prereq_pm()
12257 Returns the hash reference that has been announced by a distribution
12258 as the the C<requires> and C<build_requires> elements. These can be
12259 declared either by the C<META.yml> (if authoritative) or can be
12260 deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
12261 or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
12262 a comment in the produced C<Makefile>. I<Note>: this method only works
12263 after an attempt has been made to C<make> the distribution. Returns
12266 =item CPAN::Distribution::readme()
12268 Downloads the README file associated with a distribution and runs it
12269 through the pager specified in C<$CPAN::Config->{pager}>.
12271 =item CPAN::Distribution::reports()
12273 Downloads report data for this distribution from cpantesters.perl.org
12274 and displays a subset of them.
12276 =item CPAN::Distribution::read_yaml()
12278 Returns the content of the META.yml of this distro as a hashref. Note:
12279 works only after an attempt has been made to C<make> the distribution.
12280 Returns undef otherwise. Also returns undef if the content of META.yml
12281 is not authoritative. (The rules about what exactly makes the content
12282 authoritative are still in flux.)
12284 =item CPAN::Distribution::test()
12286 Changes to the directory where the distribution has been unpacked and
12287 runs C<make test> there.
12289 =item CPAN::Distribution::uptodate()
12291 Returns 1 if all the modules contained in the distribution are
12292 uptodate. Relies on containsmods.
12294 =item CPAN::Index::force_reload()
12296 Forces a reload of all indices.
12298 =item CPAN::Index::reload()
12300 Reloads all indices if they have not been read for more than
12301 C<$CPAN::Config->{index_expire}> days.
12303 =item CPAN::InfoObj::dump()
12305 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
12306 inherit this method. It prints the data structure associated with an
12307 object. Useful for debugging. Note: the data structure is considered
12308 internal and thus subject to change without notice.
12310 =item CPAN::Module::as_glimpse()
12312 Returns a one-line description of the module in four columns: The
12313 first column contains the word C<Module>, the second column consists
12314 of one character: an equals sign if this module is already installed
12315 and uptodate, a less-than sign if this module is installed but can be
12316 upgraded, and a space if the module is not installed. The third column
12317 is the name of the module and the fourth column gives maintainer or
12318 distribution information.
12320 =item CPAN::Module::as_string()
12322 Returns a multi-line description of the module
12324 =item CPAN::Module::clean()
12326 Runs a clean on the distribution associated with this module.
12328 =item CPAN::Module::cpan_file()
12330 Returns the filename on CPAN that is associated with the module.
12332 =item CPAN::Module::cpan_version()
12334 Returns the latest version of this module available on CPAN.
12336 =item CPAN::Module::cvs_import()
12338 Runs a cvs_import on the distribution associated with this module.
12340 =item CPAN::Module::description()
12342 Returns a 44 character description of this module. Only available for
12343 modules listed in The Module List (CPAN/modules/00modlist.long.html
12344 or 00modlist.long.txt.gz)
12346 =item CPAN::Module::distribution()
12348 Returns the CPAN::Distribution object that contains the current
12349 version of this module.
12351 =item CPAN::Module::dslip_status()
12353 Returns a hash reference. The keys of the hash are the letters C<D>,
12354 C<S>, C<L>, C<I>, and <P>, for development status, support level,
12355 language, interface and public licence respectively. The data for the
12356 DSLIP status are collected by pause.perl.org when authors register
12357 their namespaces. The values of the 5 hash elements are one-character
12358 words whose meaning is described in the table below. There are also 5
12359 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
12360 verbose value of the 5 status variables.
12362 Where the 'DSLIP' characters have the following meanings:
12364 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
12365 i - Idea, listed to gain consensus or as a placeholder
12366 c - under construction but pre-alpha (not yet released)
12367 a/b - Alpha/Beta testing
12369 M - Mature (no rigorous definition)
12370 S - Standard, supplied with Perl 5
12375 u - Usenet newsgroup comp.lang.perl.modules
12376 n - None known, try comp.lang.perl.modules
12377 a - abandoned; volunteers welcome to take over maintainance
12380 p - Perl-only, no compiler needed, should be platform independent
12381 c - C and perl, a C compiler will be needed
12382 h - Hybrid, written in perl with optional C code, no compiler needed
12383 + - C++ and perl, a C++ compiler will be needed
12384 o - perl and another language other than C or C++
12386 I - Interface Style
12387 f - plain Functions, no references used
12388 h - hybrid, object and function interfaces available
12389 n - no interface at all (huh?)
12390 r - some use of unblessed References or ties
12391 O - Object oriented using blessed references and/or inheritance
12394 p - Standard-Perl: user may choose between GPL and Artistic
12395 g - GPL: GNU General Public License
12396 l - LGPL: "GNU Lesser General Public License" (previously known as
12397 "GNU Library General Public License")
12398 b - BSD: The BSD License
12399 a - Artistic license alone
12400 2 - Artistic license 2.0 or later
12401 o - open source: appoved by www.opensource.org
12402 d - allows distribution without restrictions
12403 r - restricted distribtion
12404 n - no license at all
12406 =item CPAN::Module::force($method,@args)
12408 Forces CPAN to perform a task that it normally would have refused to
12409 do. Force takes as arguments a method name to be called and any number
12410 of additional arguments that should be passed to the called method.
12411 The internals of the object get the needed changes so that CPAN.pm
12412 does not refuse to take the action. See also the section above on the
12413 C<force> and the C<fforce> pragma.
12415 =item CPAN::Module::get()
12417 Runs a get on the distribution associated with this module.
12419 =item CPAN::Module::inst_file()
12421 Returns the filename of the module found in @INC. The first file found
12422 is reported just like perl itself stops searching @INC when it finds a
12425 =item CPAN::Module::available_file()
12427 Returns the filename of the module found in PERL5LIB or @INC. The
12428 first file found is reported. The advantage of this method over
12429 C<inst_file> is that modules that have been tested but not yet
12430 installed are included because PERL5LIB keeps track of tested modules.
12432 =item CPAN::Module::inst_version()
12434 Returns the version number of the installed module in readable format.
12436 =item CPAN::Module::available_version()
12438 Returns the version number of the available module in readable format.
12440 =item CPAN::Module::install()
12442 Runs an C<install> on the distribution associated with this module.
12444 =item CPAN::Module::look()
12446 Changes to the directory where the distribution associated with this
12447 module has been unpacked and opens a subshell there. Exiting the
12450 =item CPAN::Module::make()
12452 Runs a C<make> on the distribution associated with this module.
12454 =item CPAN::Module::manpage_headline()
12456 If module is installed, peeks into the module's manpage, reads the
12457 headline and returns it. Moreover, if the module has been downloaded
12458 within this session, does the equivalent on the downloaded module even
12459 if it is not installed.
12461 =item CPAN::Module::perldoc()
12463 Runs a C<perldoc> on this module.
12465 =item CPAN::Module::readme()
12467 Runs a C<readme> on the distribution associated with this module.
12469 =item CPAN::Module::reports()
12471 Calls the reports() method on the associated distribution object.
12473 =item CPAN::Module::test()
12475 Runs a C<test> on the distribution associated with this module.
12477 =item CPAN::Module::uptodate()
12479 Returns 1 if the module is installed and up-to-date.
12481 =item CPAN::Module::userid()
12483 Returns the author's ID of the module.
12487 =head2 Cache Manager
12489 Currently the cache manager only keeps track of the build directory
12490 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
12491 deletes complete directories below C<build_dir> as soon as the size of
12492 all directories there gets bigger than $CPAN::Config->{build_cache}
12493 (in MB). The contents of this cache may be used for later
12494 re-installations that you intend to do manually, but will never be
12495 trusted by CPAN itself. This is due to the fact that the user might
12496 use these directories for building modules on different architectures.
12498 There is another directory ($CPAN::Config->{keep_source_where}) where
12499 the original distribution files are kept. This directory is not
12500 covered by the cache manager and must be controlled by the user. If
12501 you choose to have the same directory as build_dir and as
12502 keep_source_where directory, then your sources will be deleted with
12503 the same fifo mechanism.
12507 A bundle is just a perl module in the namespace Bundle:: that does not
12508 define any functions or methods. It usually only contains documentation.
12510 It starts like a perl module with a package declaration and a $VERSION
12511 variable. After that the pod section looks like any other pod with the
12512 only difference being that I<one special pod section> exists starting with
12517 In this pod section each line obeys the format
12519 Module_Name [Version_String] [- optional text]
12521 The only required part is the first field, the name of a module
12522 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
12523 of the line is optional. The comment part is delimited by a dash just
12524 as in the man page header.
12526 The distribution of a bundle should follow the same convention as
12527 other distributions.
12529 Bundles are treated specially in the CPAN package. If you say 'install
12530 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
12531 the modules in the CONTENTS section of the pod. You can install your
12532 own Bundles locally by placing a conformant Bundle file somewhere into
12533 your @INC path. The autobundle() command which is available in the
12534 shell interface does that for you by including all currently installed
12535 modules in a snapshot bundle file.
12537 =head1 PREREQUISITES
12539 If you have a local mirror of CPAN and can access all files with
12540 "file:" URLs, then you only need a perl better than perl5.003 to run
12541 this module. Otherwise Net::FTP is strongly recommended. LWP may be
12542 required for non-UNIX systems or if your nearest CPAN site is
12543 associated with a URL that is not C<ftp:>.
12545 If you have neither Net::FTP nor LWP, there is a fallback mechanism
12546 implemented for an external ftp command or for an external lynx
12551 =head2 Finding packages and VERSION
12553 This module presumes that all packages on CPAN
12559 declare their $VERSION variable in an easy to parse manner. This
12560 prerequisite can hardly be relaxed because it consumes far too much
12561 memory to load all packages into the running program just to determine
12562 the $VERSION variable. Currently all programs that are dealing with
12563 version use something like this
12565 perl -MExtUtils::MakeMaker -le \
12566 'print MM->parse_version(shift)' filename
12568 If you are author of a package and wonder if your $VERSION can be
12569 parsed, please try the above method.
12573 come as compressed or gzipped tarfiles or as zip files and contain a
12574 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
12575 without much enthusiasm).
12581 The debugging of this module is a bit complex, because we have
12582 interferences of the software producing the indices on CPAN, of the
12583 mirroring process on CPAN, of packaging, of configuration, of
12584 synchronicity, and of bugs within CPAN.pm.
12586 For debugging the code of CPAN.pm itself in interactive mode some more
12587 or less useful debugging aid can be turned on for most packages within
12588 CPAN.pm with one of
12592 =item o debug package...
12594 sets debug mode for packages.
12596 =item o debug -package...
12598 unsets debug mode for packages.
12602 turns debugging on for all packages.
12604 =item o debug number
12608 which sets the debugging packages directly. Note that C<o debug 0>
12609 turns debugging off.
12611 What seems quite a successful strategy is the combination of C<reload
12612 cpan> and the debugging switches. Add a new debug statement while
12613 running in the shell and then issue a C<reload cpan> and see the new
12614 debugging messages immediately without losing the current context.
12616 C<o debug> without an argument lists the valid package names and the
12617 current set of packages in debugging mode. C<o debug> has built-in
12618 completion support.
12620 For debugging of CPAN data there is the C<dump> command which takes
12621 the same arguments as make/test/install and outputs each object's
12622 Data::Dumper dump. If an argument looks like a perl variable and
12623 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
12624 Data::Dumper directly.
12626 =head2 Floppy, Zip, Offline Mode
12628 CPAN.pm works nicely without network too. If you maintain machines
12629 that are not networked at all, you should consider working with file:
12630 URLs. Of course, you have to collect your modules somewhere first. So
12631 you might use CPAN.pm to put together all you need on a networked
12632 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
12633 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
12634 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
12635 with this floppy. See also below the paragraph about CD-ROM support.
12637 =head2 Basic Utilities for Programmers
12641 =item has_inst($module)
12643 Returns true if the module is installed. Used to load all modules into
12644 the running CPAN.pm which are considered optional. The config variable
12645 C<dontload_list> can be used to intercept the C<has_inst()> call such
12646 that an optional module is not loaded despite being available. For
12647 example the following command will prevent that C<YAML.pm> is being
12650 cpan> o conf dontload_list push YAML
12652 See the source for details.
12654 =item has_usable($module)
12656 Returns true if the module is installed and is in a usable state. Only
12657 useful for a handful of modules that are used internally. See the
12658 source for details.
12660 =item instance($module)
12662 The constructor for all the singletons used to represent modules,
12663 distributions, authors and bundles. If the object already exists, this
12664 method returns the object, otherwise it calls the constructor.
12670 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
12671 install foreign, unmasked, unsigned code on your machine. We compare
12672 to a checksum that comes from the net just as the distribution file
12673 itself. But we try to make it easy to add security on demand:
12675 =head2 Cryptographically signed modules
12677 Since release 1.77 CPAN.pm has been able to verify cryptographically
12678 signed module distributions using Module::Signature. The CPAN modules
12679 can be signed by their authors, thus giving more security. The simple
12680 unsigned MD5 checksums that were used before by CPAN protect mainly
12681 against accidental file corruption.
12683 You will need to have Module::Signature installed, which in turn
12684 requires that you have at least one of Crypt::OpenPGP module or the
12685 command-line F<gpg> tool installed.
12687 You will also need to be able to connect over the Internet to the public
12688 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
12690 The configuration parameter check_sigs is there to turn signature
12691 checking on or off.
12695 Most functions in package CPAN are exported per default. The reason
12696 for this is that the primary use is intended for the cpan shell or for
12701 When the CPAN shell enters a subshell via the look command, it sets
12702 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
12705 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING
12706 to the ID of the running process. It also sets
12707 PERL5_CPANPLUS_IS_RUNNING to prevent runaway processes which could
12708 happen with older versions of Module::Install.
12710 When running C<perl Makefile.PL>, the environment variable
12711 C<PERL5_CPAN_IS_EXECUTING> is set to the full path of the
12712 C<Makefile.PL> that is being executed. This prevents runaway processes
12713 with newer versions of Module::Install.
12715 When the config variable ftp_passive is set, all downloads will be run
12716 with the environment variable FTP_PASSIVE set to this value. This is
12717 in general a good idea as it influences both Net::FTP and LWP based
12718 connections. The same effect can be achieved by starting the cpan
12719 shell with this environment variable set. For Net::FTP alone, one can
12720 also always set passive mode by running libnetcfg.
12722 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
12724 Populating a freshly installed perl with my favorite modules is pretty
12725 easy if you maintain a private bundle definition file. To get a useful
12726 blueprint of a bundle definition file, the command autobundle can be used
12727 on the CPAN shell command line. This command writes a bundle definition
12728 file for all modules that are installed for the currently running perl
12729 interpreter. It's recommended to run this command only once and from then
12730 on maintain the file manually under a private name, say
12731 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
12733 cpan> install Bundle::my_bundle
12735 then answer a few questions and then go out for a coffee.
12737 Maintaining a bundle definition file means keeping track of two
12738 things: dependencies and interactivity. CPAN.pm sometimes fails on
12739 calculating dependencies because not all modules define all MakeMaker
12740 attributes correctly, so a bundle definition file should specify
12741 prerequisites as early as possible. On the other hand, it's a bit
12742 annoying that many distributions need some interactive configuring. So
12743 what I try to accomplish in my private bundle file is to have the
12744 packages that need to be configured early in the file and the gentle
12745 ones later, so I can go out after a few minutes and leave CPAN.pm
12748 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
12750 Thanks to Graham Barr for contributing the following paragraphs about
12751 the interaction between perl, and various firewall configurations. For
12752 further information on firewalls, it is recommended to consult the
12753 documentation that comes with the ncftp program. If you are unable to
12754 go through the firewall with a simple Perl setup, it is very likely
12755 that you can configure ncftp so that it works for your firewall.
12757 =head2 Three basic types of firewalls
12759 Firewalls can be categorized into three basic types.
12763 =item http firewall
12765 This is where the firewall machine runs a web server and to access the
12766 outside world you must do it via the web server. If you set environment
12767 variables like http_proxy or ftp_proxy to a values beginning with http://
12768 or in your web browser you have to set proxy information then you know
12769 you are running an http firewall.
12771 To access servers outside these types of firewalls with perl (even for
12772 ftp) you will need to use LWP.
12776 This where the firewall machine runs an ftp server. This kind of
12777 firewall will only let you access ftp servers outside the firewall.
12778 This is usually done by connecting to the firewall with ftp, then
12779 entering a username like "user@outside.host.com"
12781 To access servers outside these type of firewalls with perl you
12782 will need to use Net::FTP.
12784 =item One way visibility
12786 I say one way visibility as these firewalls try to make themselves look
12787 invisible to the users inside the firewall. An FTP data connection is
12788 normally created by sending the remote server your IP address and then
12789 listening for the connection. But the remote server will not be able to
12790 connect to you because of the firewall. So for these types of firewall
12791 FTP connections need to be done in a passive mode.
12793 There are two that I can think off.
12799 If you are using a SOCKS firewall you will need to compile perl and link
12800 it with the SOCKS library, this is what is normally called a 'socksified'
12801 perl. With this executable you will be able to connect to servers outside
12802 the firewall as if it is not there.
12804 =item IP Masquerade
12806 This is the firewall implemented in the Linux kernel, it allows you to
12807 hide a complete network behind one IP address. With this firewall no
12808 special compiling is needed as you can access hosts directly.
12810 For accessing ftp servers behind such firewalls you usually need to
12811 set the environment variable C<FTP_PASSIVE> or the config variable
12812 ftp_passive to a true value.
12818 =head2 Configuring lynx or ncftp for going through a firewall
12820 If you can go through your firewall with e.g. lynx, presumably with a
12823 /usr/local/bin/lynx -pscott:tiger
12825 then you would configure CPAN.pm with the command
12827 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
12829 That's all. Similarly for ncftp or ftp, you would configure something
12832 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
12834 Your mileage may vary...
12842 I installed a new version of module X but CPAN keeps saying,
12843 I have the old version installed
12845 Most probably you B<do> have the old version installed. This can
12846 happen if a module installs itself into a different directory in the
12847 @INC path than it was previously installed. This is not really a
12848 CPAN.pm problem, you would have the same problem when installing the
12849 module manually. The easiest way to prevent this behaviour is to add
12850 the argument C<UNINST=1> to the C<make install> call, and that is why
12851 many people add this argument permanently by configuring
12853 o conf make_install_arg UNINST=1
12857 So why is UNINST=1 not the default?
12859 Because there are people who have their precise expectations about who
12860 may install where in the @INC path and who uses which @INC array. In
12861 fine tuned environments C<UNINST=1> can cause damage.
12865 I want to clean up my mess, and install a new perl along with
12866 all modules I have. How do I go about it?
12868 Run the autobundle command for your old perl and optionally rename the
12869 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
12870 with the Configure option prefix, e.g.
12872 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
12874 Install the bundle file you produced in the first step with something like
12876 cpan> install Bundle::mybundle
12882 When I install bundles or multiple modules with one command
12883 there is too much output to keep track of.
12885 You may want to configure something like
12887 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
12888 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
12890 so that STDOUT is captured in a file for later inspection.
12895 I am not root, how can I install a module in a personal directory?
12897 First of all, you will want to use your own configuration, not the one
12898 that your root user installed. If you do not have permission to write
12899 in the cpan directory that root has configured, you will be asked if
12900 you want to create your own config. Answering "yes" will bring you into
12901 CPAN's configuration stage, using the system config for all defaults except
12902 things that have to do with CPAN's work directory, saving your choices to
12903 your MyConfig.pm file.
12905 You can also manually initiate this process with the following command:
12907 % perl -MCPAN -e 'mkmyconfig'
12913 from the CPAN shell.
12915 You will most probably also want to configure something like this:
12917 o conf makepl_arg "LIB=~/myperl/lib \
12918 INSTALLMAN1DIR=~/myperl/man/man1 \
12919 INSTALLMAN3DIR=~/myperl/man/man3 \
12920 INSTALLSCRIPT=~/myperl/bin \
12921 INSTALLBIN=~/myperl/bin"
12923 and then (oh joy) the equivalent command for Module::Build. That would
12926 o conf mbuildpl_arg "--lib=~/myperl/lib \
12927 --installman1dir=~/myperl/man/man1 \
12928 --installman3dir=~/myperl/man/man3 \
12929 --installscript=~/myperl/bin \
12930 --installbin=~/myperl/bin"
12932 You can make this setting permanent like all C<o conf> settings with
12933 C<o conf commit> or by setting C<auto_commit> beforehand.
12935 You will have to add ~/myperl/man to the MANPATH environment variable
12936 and also tell your perl programs to look into ~/myperl/lib, e.g. by
12939 use lib "$ENV{HOME}/myperl/lib";
12941 or setting the PERL5LIB environment variable.
12943 While we're speaking about $ENV{HOME}, it might be worth mentioning,
12944 that for Windows we use the File::HomeDir module that provides an
12945 equivalent to the concept of the home directory on Unix.
12947 Another thing you should bear in mind is that the UNINST parameter can
12948 be dangerous when you are installing into a private area because you
12949 might accidentally remove modules that other people depend on that are
12950 not using the private area.
12954 How to get a package, unwrap it, and make a change before building it?
12956 Have a look at the C<look> (!) command.
12960 I installed a Bundle and had a couple of fails. When I
12961 retried, everything resolved nicely. Can this be fixed to work
12964 The reason for this is that CPAN does not know the dependencies of all
12965 modules when it starts out. To decide about the additional items to
12966 install, it just uses data found in the META.yml file or the generated
12967 Makefile. An undetected missing piece breaks the process. But it may
12968 well be that your Bundle installs some prerequisite later than some
12969 depending item and thus your second try is able to resolve everything.
12970 Please note, CPAN.pm does not know the dependency tree in advance and
12971 cannot sort the queue of things to install in a topologically correct
12972 order. It resolves perfectly well IF all modules declare the
12973 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
12974 the C<requires> stanza of Module::Build. For bundles which fail and
12975 you need to install often, it is recommended to sort the Bundle
12976 definition file manually.
12980 In our intranet we have many modules for internal use. How
12981 can I integrate these modules with CPAN.pm but without uploading
12982 the modules to CPAN?
12984 Have a look at the CPAN::Site module.
12988 When I run CPAN's shell, I get an error message about things in my
12989 /etc/inputrc (or ~/.inputrc) file.
12991 These are readline issues and can only be fixed by studying readline
12992 configuration on your architecture and adjusting the referenced file
12993 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
12994 and edit them. Quite often harmless changes like uppercasing or
12995 lowercasing some arguments solves the problem.
12999 Some authors have strange characters in their names.
13001 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
13002 expecting ISO-8859-1 charset, a converter can be activated by setting
13003 term_is_latin to a true value in your config file. One way of doing so
13006 cpan> o conf term_is_latin 1
13008 If other charset support is needed, please file a bugreport against
13009 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
13010 the support or maybe UTF-8 terminals become widely available.
13012 Note: this config variable is deprecated and will be removed in a
13013 future version of CPAN.pm. It will be replaced with the conventions
13014 around the family of $LANG and $LC_* environment variables.
13018 When an install fails for some reason and then I correct the error
13019 condition and retry, CPAN.pm refuses to install the module, saying
13020 C<Already tried without success>.
13022 Use the force pragma like so
13024 force install Foo::Bar
13030 and then 'make install' directly in the subshell.
13034 How do I install a "DEVELOPER RELEASE" of a module?
13036 By default, CPAN will install the latest non-developer release of a
13037 module. If you want to install a dev release, you have to specify the
13038 partial path starting with the author id to the tarball you wish to
13041 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
13043 Note that you can use the C<ls> command to get this path listed.
13047 How do I install a module and all its dependencies from the commandline,
13048 without being prompted for anything, despite my CPAN configuration
13051 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
13052 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
13053 asked any questions at all (assuming the modules you are installing are
13054 nice about obeying that variable as well):
13056 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
13060 How do I create a Module::Build based Build.PL derived from an
13061 ExtUtils::MakeMaker focused Makefile.PL?
13063 http://search.cpan.org/search?query=Module::Build::Convert
13065 http://www.refcnt.org/papers/module-build-convert
13069 I'm frequently irritated with the CPAN shell's inability to help me
13070 select a good mirror.
13072 The urllist config parameter is yours. You can add and remove sites at
13073 will. You should find out which sites have the best uptodateness,
13074 bandwidth, reliability, etc. and are topologically close to you. Some
13075 people prefer fast downloads, others uptodateness, others reliability.
13076 You decide which to try in which order.
13078 Henk P. Penning maintains a site that collects data about CPAN sites:
13080 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
13082 Also, feel free to play with experimental features. Run
13084 o conf init randomize_urllist ftpstats_period ftpstats_size
13086 and choose your favorite parameters. After a few downloads running the
13087 C<hosts> command will probably assist you in choosing the best mirror
13092 Why do I get asked the same questions every time I start the shell?
13094 You can make your configuration changes permanent by calling the
13095 command C<o conf commit>. Alternatively set the C<auto_commit>
13096 variable to true by running C<o conf init auto_commit> and answering
13097 the following question with yes.
13101 Older versions of CPAN.pm had the original root directory of all
13102 tarballs in the build directory. Now there are always random
13103 characters appended to these directory names. Why was this done?
13105 The random characters are provided by File::Temp and ensure that each
13106 module's individual build directory is unique. This makes running
13107 CPAN.pm in concurrent processes simultaneously safe.
13111 Speaking of the build directory. Do I have to clean it up myself?
13113 You have the choice to set the config variable C<scan_cache> to
13114 C<never>. Then you must clean it up yourself. The other possible
13115 value, C<atstart> only cleans up the build directory when you start
13116 the CPAN shell. If you never start up the CPAN shell, you probably
13117 also have to clean up the build directory yourself.
13121 =head1 COMPATIBILITY
13123 =head2 OLD PERL VERSIONS
13125 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
13126 newer versions. It is getting more and more difficult to get the
13127 minimal prerequisites working on older perls. It is close to
13128 impossible to get the whole Bundle::CPAN working there. If you're in
13129 the position to have only these old versions, be advised that CPAN is
13130 designed to work fine without the Bundle::CPAN installed.
13132 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
13133 compatible with ancient perls and that File::Temp is listed as a
13134 prerequisite but CPAN has reasonable workarounds if it is missing.
13138 This module and its competitor, the CPANPLUS module, are both much
13139 cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
13140 more modular but it was never tried to make it compatible with CPAN.pm.
13142 =head1 SECURITY ADVICE
13144 This software enables you to upgrade software on your computer and so
13145 is inherently dangerous because the newly installed software may
13146 contain bugs and may alter the way your computer works or even make it
13147 unusable. Please consider backing up your data before every upgrade.
13151 Please report bugs via L<http://rt.cpan.org/>
13153 Before submitting a bug, please make sure that the traditional method
13154 of building a Perl module package from a shell by following the
13155 installation instructions of that package still works in your
13160 Andreas Koenig C<< <andk@cpan.org> >>
13164 This program is free software; you can redistribute it and/or
13165 modify it under the same terms as Perl itself.
13167 See L<http://www.perl.com/perl/misc/Artistic.html>
13169 =head1 TRANSLATIONS
13171 Kawai,Takanori provides a Japanese translation of this manpage at
13172 L<http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm>
13176 L<cpan>, L<CPAN::Nox>, L<CPAN::Version>