1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.90';
5 $CPAN::VERSION = eval $CPAN::VERSION if $CPAN::VERSION =~ /_/;
7 use CPAN::HandleConfig;
17 use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
18 # 5.005_04 does not work without
20 use File::Basename ();
28 use Sys::Hostname qw(hostname);
29 use Text::ParseWords ();
32 # we need to run chdir all over and we would get at wrong libraries
35 if (File::Spec->can("rel2abs")) {
37 $inc = File::Spec->rel2abs($inc) unless ref $inc;
43 require Mac::BuildTools if $^O eq 'MacOS';
44 $ENV{PERL5_CPAN_IS_RUNNING}=1;
45 $ENV{PERL5_CPANPLUS_IS_RUNNING}=1; # https://rt.cpan.org/Ticket/Display.html?id=23735
47 END { $CPAN::End++; &cleanup; }
50 $CPAN::Frontend ||= "CPAN::Shell";
51 unless (@CPAN::Defaultsites){
52 @CPAN::Defaultsites = map {
53 CPAN::URL->new(TEXT => $_, FROM => "DEF")
55 "http://www.perl.org/CPAN/",
56 "ftp://ftp.perl.org/pub/CPAN/";
58 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
59 $CPAN::Perl ||= CPAN::find_perl();
60 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
61 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
63 # our globals are getting a mess
90 @CPAN::ISA = qw(CPAN::Debug Exporter);
92 # note that these functions live in CPAN::Shell and get executed via
93 # AUTOLOAD when called directly
119 sub soft_chdir_with_alternatives ($);
122 $autoload_recursion ||= 0;
124 #-> sub CPAN::AUTOLOAD ;
126 $autoload_recursion++;
130 warn "Refusing to autoload '$l' while signal pending";
131 $autoload_recursion--;
134 if ($autoload_recursion > 1) {
135 my $fullcommand = join " ", map { "'$_'" } $l, @_;
136 warn "Refusing to autoload $fullcommand in recursion\n";
137 $autoload_recursion--;
141 @export{@EXPORT} = '';
142 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
143 if (exists $export{$l}){
146 die(qq{Unknown CPAN command "$AUTOLOAD". }.
147 qq{Type ? for help.\n});
149 $autoload_recursion--;
153 #-> sub CPAN::shell ;
156 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
157 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
159 my $oprompt = shift || CPAN::Prompt->new;
160 my $prompt = $oprompt;
161 my $commandline = shift || "";
162 $CPAN::CurrentCommandId ||= 1;
165 unless ($Suppress_readline) {
166 require Term::ReadLine;
169 $term->ReadLine eq "Term::ReadLine::Stub"
171 $term = Term::ReadLine->new('CPAN Monitor');
173 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
174 my $attribs = $term->Attribs;
175 $attribs->{attempted_completion_function} = sub {
176 &CPAN::Complete::gnu_cpl;
179 $readline::rl_completion_function =
180 $readline::rl_completion_function = 'CPAN::Complete::cpl';
182 if (my $histfile = $CPAN::Config->{'histfile'}) {{
183 unless ($term->can("AddHistory")) {
184 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
187 $META->readhist($term,$histfile);
189 for ($CPAN::Config->{term_ornaments}) { # alias
190 local $Term::ReadLine::termcap_nowarn = 1;
191 $term->ornaments($_) if defined;
193 # $term->OUT is autoflushed anyway
194 my $odef = select STDERR;
202 my @cwd = grep { defined $_ and length $_ }
204 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
205 File::Spec->rootdir();
206 my $try_detect_readline;
207 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
208 my $rl_avail = $Suppress_readline ? "suppressed" :
209 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
210 "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)";
212 unless ($CPAN::Config->{'inhibit_startup_message'}){
213 $CPAN::Frontend->myprint(
215 cpan shell -- CPAN exploration and modules installation (v%s)
223 my($continuation) = "";
224 my $last_term_ornaments;
225 SHELLCOMMAND: while () {
226 if ($Suppress_readline) {
227 if ($Echo_readline) {
231 last SHELLCOMMAND unless defined ($_ = <> );
232 if ($Echo_readline) {
233 # backdoor: I could not find a way to record sessions
238 last SHELLCOMMAND unless
239 defined ($_ = $term->readline($prompt, $commandline));
241 $_ = "$continuation$_" if $continuation;
243 next SHELLCOMMAND if /^$/;
244 $_ = 'h' if /^\s*\?/;
245 if (/^(?:q(?:uit)?|bye|exit)$/i) {
256 use vars qw($import_done);
257 CPAN->import(':DEFAULT') unless $import_done++;
258 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
265 eval { @line = Text::ParseWords::shellwords($_) };
266 warn($@), next SHELLCOMMAND if $@;
267 warn("Text::Parsewords could not parse the line [$_]"),
268 next SHELLCOMMAND unless @line;
269 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
270 my $command = shift @line;
271 eval { CPAN::Shell->$command(@line) };
272 if ($@ && "$@" =~ /\S/){
274 Carp::cluck("Catching error: '$@'");
276 if ($command =~ /^(make|test|install|ff?orce|notest|clean|report|upgrade)$/) {
277 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
279 soft_chdir_with_alternatives(\@cwd);
280 $CPAN::Frontend->myprint("\n");
282 $CPAN::CurrentCommandId++;
286 $commandline = ""; # I do want to be able to pass a default to
287 # shell, but on the second command I see no
290 CPAN::Queue->nullify_queue;
291 if ($try_detect_readline) {
292 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
294 $CPAN::META->has_inst("Term::ReadLine::Perl")
296 delete $INC{"Term/ReadLine.pm"};
298 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
299 require Term::ReadLine;
300 $CPAN::Frontend->myprint("\n$redef subroutines in ".
301 "Term::ReadLine redefined\n");
305 if ($term and $term->can("ornaments")) {
306 for ($CPAN::Config->{term_ornaments}) { # alias
308 if (not defined $last_term_ornaments
309 or $_ != $last_term_ornaments
311 local $Term::ReadLine::termcap_nowarn = 1;
312 $term->ornaments($_);
313 $last_term_ornaments = $_;
316 undef $last_term_ornaments;
320 for my $class (qw(Module Distribution)) {
321 # again unsafe meta access?
322 for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
323 next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
324 CPAN->debug("BUG: $class '$dm' was in command state, resetting");
325 delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
329 $GOTOSHELL = 0; # not too often
330 $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
335 soft_chdir_with_alternatives(\@cwd);
338 sub soft_chdir_with_alternatives ($) {
341 my $root = File::Spec->rootdir();
342 $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
343 Trying '$root' as temporary haven.
348 if (chdir $cwd->[0]) {
352 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
353 Trying to chdir to "$cwd->[1]" instead.
357 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
363 sub _yaml_module () {
364 my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
366 $yaml_module ne "YAML"
368 !$CPAN::META->has_inst($yaml_module)
370 # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
371 $yaml_module = "YAML";
373 if ($yaml_module eq "YAML"
375 $CPAN::META->has_inst($yaml_module)
377 $YAML::VERSION < 0.60
379 !$Have_warned->{"YAML"}++
381 $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n".
382 "I'll continue but problems are *very* likely to happen.\n"
384 $CPAN::Frontend->mysleep(5);
389 # CPAN::_yaml_loadfile
391 my($self,$local_file) = @_;
392 return +[] unless -s $local_file;
393 my $yaml_module = _yaml_module;
394 if ($CPAN::META->has_inst($yaml_module)) {
396 if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
398 eval { @yaml = $code->($local_file); };
400 # this shall not be done by the frontend
401 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
404 } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
406 open FH, $local_file or die "Could not open '$local_file': $!";
410 eval { @yaml = $code->($ystream); };
412 # this shall not be done by the frontend
413 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
418 # this shall not be done by the frontend
419 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
424 # CPAN::_yaml_dumpfile
426 my($self,$local_file,@what) = @_;
427 my $yaml_module = _yaml_module;
428 if ($CPAN::META->has_inst($yaml_module)) {
430 if (UNIVERSAL::isa($local_file, "FileHandle")) {
431 $code = UNIVERSAL::can($yaml_module, "Dump");
432 eval { print $local_file $code->(@what) };
433 } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
434 eval { $code->($local_file,@what); };
435 } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
437 open FH, ">$local_file" or die "Could not open '$local_file': $!";
438 print FH $code->(@what);
441 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
444 if (UNIVERSAL::isa($local_file, "FileHandle")) {
445 # I think this case does not justify a warning at all
447 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
452 sub _init_sqlite () {
453 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
454 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
455 unless $Have_warned->{"CPAN::SQLite"}++;
458 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
459 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
463 my $negative_cache = {};
464 sub _sqlite_running {
465 if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
466 # need to cache the result, otherwise too slow
467 return $negative_cache->{fact};
469 $negative_cache = {}; # reset
471 my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
472 return $ret if $ret; # fast anyway
473 $negative_cache->{time} = time;
474 return $negative_cache->{fact} = $ret;
478 package CPAN::CacheMgr;
480 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
485 use Fcntl qw(:flock);
486 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
487 @CPAN::FTP::ISA = qw(CPAN::Debug);
489 package CPAN::LWP::UserAgent;
491 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
492 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
494 package CPAN::Complete;
496 @CPAN::Complete::ISA = qw(CPAN::Debug);
497 # Q: where is the "How do I add a new command" HOWTO?
498 # A: svn diff -r 1048:1049 where andk added the report command
499 @CPAN::Complete::COMMANDS = sort qw(
500 ! a b d h i m o q r u
530 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
531 @CPAN::Index::ISA = qw(CPAN::Debug);
534 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
537 package CPAN::InfoObj;
539 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
541 package CPAN::Author;
543 @CPAN::Author::ISA = qw(CPAN::InfoObj);
545 package CPAN::Distribution;
547 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
549 package CPAN::Bundle;
551 @CPAN::Bundle::ISA = qw(CPAN::Module);
553 package CPAN::Module;
555 @CPAN::Module::ISA = qw(CPAN::InfoObj);
557 package CPAN::Exception::RecursiveDependency;
559 use overload '""' => "as_string";
561 # a module sees its distribution (no version)
562 # a distribution sees its prereqs (which are module names) (usually with versions)
563 # a bundle sees its module names and/or its distributions (no version)
568 my (@deps,%seen,$loop_starts_with);
569 DCHAIN: for my $dep (@$deps) {
570 push @deps, {name => $dep, display_as => $dep};
572 $loop_starts_with = $dep;
577 for my $i (0..$#deps) {
578 my $x = $deps[$i]{name};
579 $in_loop ||= $x eq $loop_starts_with;
580 my $xo = CPAN::Shell->expandany($x) or next;
581 if ($xo->isa("CPAN::Module")) {
582 my $have = $xo->inst_version || "N/A";
583 my($want,$d,$want_type);
584 if ($i>0 and $d = $deps[$i-1]{name}) {
585 my $do = CPAN::Shell->expandany($d);
586 $want = $do->{prereq_pm}{requires}{$x};
588 $want_type = "requires: ";
590 $want = $do->{prereq_pm}{build_requires}{$x};
592 $want_type = "build_requires: ";
594 $want_type = "unknown status";
599 $want = $xo->cpan_version;
600 $want_type = "want: ";
602 $deps[$i]{have} = $have;
603 $deps[$i]{want_type} = $want_type;
604 $deps[$i]{want} = $want;
605 $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
606 } elsif ($xo->isa("CPAN::Distribution")) {
607 $deps[$i]{display_as} = $xo->pretty_id;
609 $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
611 $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
613 $xo->store_persistent_state; # otherwise I will not reach
614 # all involved parties for
618 bless { deps => \@deps }, $class;
623 my $ret = "\nRecursive dependency detected:\n ";
624 $ret .= join("\n => ", map {$_->{display_as}} @{$self->{deps}});
625 $ret .= ".\nCannot resolve.\n";
629 package CPAN::Exception::yaml_not_installed;
631 use overload '""' => "as_string";
634 my($class,$module,$file,$during) = @_;
635 bless { module => $module, file => $file, during => $during }, $class;
640 "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
643 package CPAN::Exception::yaml_process_error;
645 use overload '""' => "as_string";
648 my($class,$module,$file,$during,$error) = @_;
649 bless { module => $module,
652 error => $error }, $class;
657 if ($self->{during}) {
659 if ($self->{module}) {
660 if ($self->{error}) {
661 return "Alert: While trying to '$self->{during}' YAML file\n".
662 " '$self->{file}'\n".
663 "with '$self->{module}' the following error was encountered:\n".
666 return "Alert: While trying to '$self->{during}' YAML file\n".
667 " '$self->{file}'\n".
668 "with '$self->{module}' some unknown error was encountered\n";
671 return "Alert: While trying to '$self->{during}' YAML file\n".
672 " '$self->{file}'\n".
673 "some unknown error was encountered\n";
676 return "Alert: While trying to '$self->{during}' some YAML file\n".
677 "some unknown error was encountered\n";
680 return "Alert: unknown error encountered\n";
684 package CPAN::Prompt; use overload '""' => "as_string";
685 use vars qw($prompt);
687 $CPAN::CurrentCommandId ||= 0;
693 unless ($CPAN::META->{LOCK}) {
694 $word = "nolock_cpan";
696 if ($CPAN::Config->{commandnumber_in_prompt}) {
697 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
703 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
704 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
705 # planned are things like age or quality
707 my($class,%args) = @_;
719 $self->{TEXT} = $set;
724 package CPAN::Distrostatus;
725 use overload '""' => "as_string",
728 my($class,$arg) = @_;
731 FAILED => substr($arg,0,2) eq "NO",
732 COMMANDID => $CPAN::CurrentCommandId,
736 sub commandid { shift->{COMMANDID} }
737 sub failed { shift->{FAILED} }
741 $self->{TEXT} = $set;
760 @CPAN::Shell::ISA = qw(CPAN::Debug);
761 $COLOR_REGISTERED ||= 0;
764 $autoload_recursion ||= 0;
766 #-> sub CPAN::Shell::AUTOLOAD ;
768 $autoload_recursion++;
770 my $class = shift(@_);
771 # warn "autoload[$l] class[$class]";
774 warn "Refusing to autoload '$l' while signal pending";
775 $autoload_recursion--;
778 if ($autoload_recursion > 1) {
779 my $fullcommand = join " ", map { "'$_'" } $l, @_;
780 warn "Refusing to autoload $fullcommand in recursion\n";
781 $autoload_recursion--;
785 # XXX needs to be reconsidered
786 if ($CPAN::META->has_inst('CPAN::WAIT')) {
789 $CPAN::Frontend->mywarn(qq{
790 Commands starting with "w" require CPAN::WAIT to be installed.
791 Please consider installing CPAN::WAIT to use the fulltext index.
792 For this you just need to type
797 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
801 $autoload_recursion--;
808 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
810 # from here on only subs.
811 ################################################################################
813 sub _perl_fingerprint {
814 my($self,$other_fingerprint) = @_;
815 my $dll = eval {OS2::DLLname()};
818 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
820 my $mtime_perl = (-f $^X ? (stat(_))[9] : '-1');
821 my $this_fingerprint = {
823 sitearchexp => $Config::Config{sitearchexp},
824 'mtime_$^X' => $mtime_perl,
825 'mtime_dll' => $mtime_dll,
827 if ($other_fingerprint) {
828 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
829 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
831 # mandatory keys since 1.88_57
832 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
833 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
837 return $this_fingerprint;
841 sub suggest_myconfig () {
842 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
843 $CPAN::Frontend->myprint("You don't seem to have a user ".
844 "configuration (MyConfig.pm) yet.\n");
845 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
846 "user configuration now? (Y/n)",
849 CPAN::Shell->mkmyconfig();
852 $CPAN::Frontend->mydie("OK, giving up.");
857 #-> sub CPAN::all_objects ;
859 my($mgr,$class) = @_;
860 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
861 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
863 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
866 # Called by shell, not in batch mode. In batch mode I see no risk in
867 # having many processes updating something as installations are
868 # continually checked at runtime. In shell mode I suspect it is
869 # unintentional to open more than one shell at a time
871 #-> sub CPAN::checklock ;
874 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
875 if (-f $lockfile && -M _ > 0) {
876 my $fh = FileHandle->new($lockfile) or
877 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
878 my $otherpid = <$fh>;
879 my $otherhost = <$fh>;
881 if (defined $otherpid && $otherpid) {
884 if (defined $otherhost && $otherhost) {
887 my $thishost = hostname();
888 if (defined $otherhost && defined $thishost &&
889 $otherhost ne '' && $thishost ne '' &&
890 $otherhost ne $thishost) {
891 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
892 "reports other host $otherhost and other ".
893 "process $otherpid.\n".
894 "Cannot proceed.\n"));
895 } elsif ($RUN_DEGRADED) {
896 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
897 } elsif (defined $otherpid && $otherpid) {
898 return if $$ == $otherpid; # should never happen
899 $CPAN::Frontend->mywarn(
901 There seems to be running another CPAN process (pid $otherpid). Contacting...
903 if (kill 0, $otherpid) {
904 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
906 CPAN::Shell::colorable_makemaker_prompt
907 (qq{Shall I try to run in degraded }.
908 qq{mode? (Y/n)},"y");
910 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
911 Please report if something unexpected happens\n");
913 for ($CPAN::Config) {
915 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
916 $_->{commandnumber_in_prompt} = 0; # visibility
917 $_->{histfile} = ""; # who should win otherwise?
918 $_->{cache_metadata} = 0; # better would be a lock?
919 $_->{use_sqlite} = 0; # better would be a write lock!
922 $CPAN::Frontend->mydie("
923 You may want to kill the other job and delete the lockfile. On UNIX try:
928 } elsif (-w $lockfile) {
930 CPAN::Shell::colorable_makemaker_prompt
931 (qq{Other job not responding. Shall I overwrite }.
932 qq{the lockfile '$lockfile'? (Y/n)},"y");
933 $CPAN::Frontend->myexit("Ok, bye\n")
934 unless $ans =~ /^y/i;
937 qq{Lockfile '$lockfile' not writeable by you. }.
938 qq{Cannot proceed.\n}.
940 qq{ rm '$lockfile'\n}.
941 qq{ and then rerun us.\n}
945 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
946 "'$lockfile', please remove. Cannot proceed.\n"));
949 my $dotcpan = $CPAN::Config->{cpan_home};
950 eval { File::Path::mkpath($dotcpan);};
952 # A special case at least for Jarkko.
957 $symlinkcpan = readlink $dotcpan;
958 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
959 eval { File::Path::mkpath($symlinkcpan); };
963 $CPAN::Frontend->mywarn(qq{
964 Working directory $symlinkcpan created.
968 unless (-d $dotcpan) {
970 Your configuration suggests "$dotcpan" as your
971 CPAN.pm working directory. I could not create this directory due
972 to this error: $firsterror\n};
974 As "$dotcpan" is a symlink to "$symlinkcpan",
975 I tried to create that, but I failed with this error: $seconderror
978 Please make sure the directory exists and is writable.
980 $CPAN::Frontend->myprint($mess);
981 return suggest_myconfig;
983 } # $@ after eval mkpath $dotcpan
984 if (0) { # to test what happens when a race condition occurs
985 for (reverse 1..10) {
991 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
993 unless ($fh = FileHandle->new("+>>$lockfile")) {
994 if ($! =~ /Permission/) {
995 $CPAN::Frontend->myprint(qq{
997 Your configuration suggests that CPAN.pm should use a working
999 $CPAN::Config->{cpan_home}
1000 Unfortunately we could not create the lock file
1002 due to permission problems.
1004 Please make sure that the configuration variable
1005 \$CPAN::Config->{cpan_home}
1006 points to a directory where you can write a .lock file. You can set
1007 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
1010 return suggest_myconfig;
1014 while (!flock $fh, LOCK_EX|LOCK_NB) {
1016 $CPAN::Frontend->mydie("Giving up\n");
1018 $CPAN::Frontend->mysleep($sleep++);
1019 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
1024 $fh->print($$, "\n");
1025 $fh->print(hostname(), "\n");
1026 $self->{LOCK} = $lockfile;
1027 $self->{LOCKFH} = $fh;
1032 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
1037 &cleanup if $Signal;
1038 die "Got yet another signal" if $Signal > 1;
1039 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
1040 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
1044 # From: Larry Wall <larry@wall.org>
1045 # Subject: Re: deprecating SIGDIE
1046 # To: perl5-porters@perl.org
1047 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
1049 # The original intent of __DIE__ was only to allow you to substitute one
1050 # kind of death for another on an application-wide basis without respect
1051 # to whether you were in an eval or not. As a global backstop, it should
1052 # not be used any more lightly (or any more heavily :-) than class
1053 # UNIVERSAL. Any attempt to build a general exception model on it should
1054 # be politely squashed. Any bug that causes every eval {} to have to be
1055 # modified should be not so politely squashed.
1057 # Those are my current opinions. It is also my optinion that polite
1058 # arguments degenerate to personal arguments far too frequently, and that
1059 # when they do, it's because both people wanted it to, or at least didn't
1060 # sufficiently want it not to.
1064 # global backstop to cleanup if we should really die
1065 $SIG{__DIE__} = \&cleanup;
1066 $self->debug("Signal handler set.") if $CPAN::DEBUG;
1069 #-> sub CPAN::DESTROY ;
1071 &cleanup; # need an eval?
1074 #-> sub CPAN::anycwd ;
1077 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
1082 sub cwd {Cwd::cwd();}
1084 #-> sub CPAN::getcwd ;
1085 sub getcwd {Cwd::getcwd();}
1087 #-> sub CPAN::fastcwd ;
1088 sub fastcwd {Cwd::fastcwd();}
1090 #-> sub CPAN::backtickcwd ;
1091 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
1093 #-> sub CPAN::find_perl ;
1095 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
1096 my $pwd = $CPAN::iCwd = CPAN::anycwd();
1097 my $candidate = File::Spec->catfile($pwd,$^X);
1098 $perl ||= $candidate if MM->maybe_command($candidate);
1101 my ($component,$perl_name);
1102 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
1103 PATH_COMPONENT: foreach $component (File::Spec->path(),
1104 $Config::Config{'binexp'}) {
1105 next unless defined($component) && $component;
1106 my($abs) = File::Spec->catfile($component,$perl_name);
1107 if (MM->maybe_command($abs)) {
1119 #-> sub CPAN::exists ;
1121 my($mgr,$class,$id) = @_;
1122 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1123 CPAN::Index->reload;
1124 ### Carp::croak "exists called without class argument" unless $class;
1126 $id =~ s/:+/::/g if $class eq "CPAN::Module";
1128 if (CPAN::_sqlite_running) {
1129 $exists = (exists $META->{readonly}{$class}{$id} or
1130 $CPAN::SQLite->set($class, $id));
1132 $exists = exists $META->{readonly}{$class}{$id};
1134 $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1137 #-> sub CPAN::delete ;
1139 my($mgr,$class,$id) = @_;
1140 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1141 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1144 #-> sub CPAN::has_usable
1145 # has_inst is sometimes too optimistic, we should replace it with this
1146 # has_usable whenever a case is given
1148 my($self,$mod,$message) = @_;
1149 return 1 if $HAS_USABLE->{$mod};
1150 my $has_inst = $self->has_inst($mod,$message);
1151 return unless $has_inst;
1154 LWP => [ # we frequently had "Can't locate object
1155 # method "new" via package "LWP::UserAgent" at
1156 # (eval 69) line 2006
1158 sub {require LWP::UserAgent},
1159 sub {require HTTP::Request},
1160 sub {require URI::URL},
1163 sub {require Net::FTP},
1164 sub {require Net::Config},
1166 'File::HomeDir' => [
1167 sub {require File::HomeDir;
1168 unless (File::HomeDir::->VERSION >= 0.52){
1169 for ("Will not use File::HomeDir, need 0.52\n") {
1170 $CPAN::Frontend->mywarn($_);
1177 sub {require Archive::Tar;
1178 unless (Archive::Tar::->VERSION >= 1.00) {
1179 for ("Will not use Archive::Tar, need 1.00\n") {
1180 $CPAN::Frontend->mywarn($_);
1187 if ($usable->{$mod}) {
1188 for my $c (0..$#{$usable->{$mod}}) {
1189 my $code = $usable->{$mod}[$c];
1190 my $ret = eval { &$code() };
1191 $ret = "" unless defined $ret;
1193 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1198 return $HAS_USABLE->{$mod} = 1;
1201 #-> sub CPAN::has_inst
1203 my($self,$mod,$message) = @_;
1204 Carp::croak("CPAN->has_inst() called without an argument")
1205 unless defined $mod;
1206 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1207 keys %{$CPAN::Config->{dontload_hash}||{}},
1208 @{$CPAN::Config->{dontload_list}||[]};
1209 if (defined $message && $message eq "no" # afair only used by Nox
1213 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1221 # checking %INC is wrong, because $INC{LWP} may be true
1222 # although $INC{"URI/URL.pm"} may have failed. But as
1223 # I really want to say "bla loaded OK", I have to somehow
1225 ### warn "$file in %INC"; #debug
1227 } elsif (eval { require $file }) {
1228 # eval is good: if we haven't yet read the database it's
1229 # perfect and if we have installed the module in the meantime,
1230 # it tries again. The second require is only a NOOP returning
1231 # 1 if we had success, otherwise it's retrying
1233 my $v = eval "\$$mod\::VERSION";
1234 $v = $v ? " (v$v)" : "";
1235 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
1236 if ($mod eq "CPAN::WAIT") {
1237 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1240 } elsif ($mod eq "Net::FTP") {
1241 $CPAN::Frontend->mywarn(qq{
1242 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1244 install Bundle::libnet
1246 }) unless $Have_warned->{"Net::FTP"}++;
1247 $CPAN::Frontend->mysleep(3);
1248 } elsif ($mod eq "Digest::SHA"){
1249 if ($Have_warned->{"Digest::SHA"}++) {
1250 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled }.
1251 qq{because Digest::SHA not installed.\n});
1253 $CPAN::Frontend->mywarn(qq{
1254 CPAN: checksum security checks disabled because Digest::SHA not installed.
1255 Please consider installing the Digest::SHA module.
1258 $CPAN::Frontend->mysleep(2);
1260 } elsif ($mod eq "Module::Signature"){
1261 # NOT prefs_lookup, we are not a distro
1262 my $check_sigs = $CPAN::Config->{check_sigs};
1263 if (not $check_sigs) {
1264 # they do not want us:-(
1265 } elsif (not $Have_warned->{"Module::Signature"}++) {
1266 # No point in complaining unless the user can
1267 # reasonably install and use it.
1268 if (eval { require Crypt::OpenPGP; 1 } ||
1270 defined $CPAN::Config->{'gpg'}
1272 $CPAN::Config->{'gpg'} =~ /\S/
1275 $CPAN::Frontend->mywarn(qq{
1276 CPAN: Module::Signature security checks disabled because Module::Signature
1277 not installed. Please consider installing the Module::Signature module.
1278 You may also need to be able to connect over the Internet to the public
1279 keyservers like pgp.mit.edu (port 11371).
1282 $CPAN::Frontend->mysleep(2);
1286 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1291 #-> sub CPAN::instance ;
1293 my($mgr,$class,$id) = @_;
1294 CPAN::Index->reload;
1296 # unsafe meta access, ok?
1297 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1298 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1306 #-> sub CPAN::cleanup ;
1308 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1309 local $SIG{__DIE__} = '';
1314 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1315 $ineval = 1, last if
1316 $subroutine eq '(eval)';
1318 return if $ineval && !$CPAN::End;
1319 return unless defined $META->{LOCK};
1320 return unless -f $META->{LOCK};
1322 close $META->{LOCKFH};
1323 unlink $META->{LOCK};
1325 # Carp::cluck("DEBUGGING");
1326 if ( $CPAN::CONFIG_DIRTY ) {
1327 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1329 $CPAN::Frontend->myprint("Lockfile removed.\n");
1332 #-> sub CPAN::readhist
1334 my($self,$term,$histfile) = @_;
1335 my($fh) = FileHandle->new;
1336 open $fh, "<$histfile" or last;
1340 $term->AddHistory($_);
1345 #-> sub CPAN::savehist
1348 my($histfile,$histsize);
1349 unless ($histfile = $CPAN::Config->{'histfile'}){
1350 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1353 $histsize = $CPAN::Config->{'histsize'} || 100;
1355 unless ($CPAN::term->can("GetHistory")) {
1356 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1362 my @h = $CPAN::term->GetHistory;
1363 splice @h, 0, @h-$histsize if @h>$histsize;
1364 my($fh) = FileHandle->new;
1365 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1366 local $\ = local $, = "\n";
1371 #-> sub CPAN::is_tested
1373 my($self,$what,$when) = @_;
1375 Carp::cluck("DEBUG: empty what");
1378 $self->{is_tested}{$what} = $when;
1381 #-> sub CPAN::is_installed
1382 # unsets the is_tested flag: as soon as the thing is installed, it is
1383 # not needed in set_perl5lib anymore
1385 my($self,$what) = @_;
1386 delete $self->{is_tested}{$what};
1389 sub _list_sorted_descending_is_tested {
1392 { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
1393 keys %{$self->{is_tested}}
1396 #-> sub CPAN::set_perl5lib
1398 my($self,$for) = @_;
1400 (undef,undef,undef,$for) = caller(1);
1403 $self->{is_tested} ||= {};
1404 return unless %{$self->{is_tested}};
1405 my $env = $ENV{PERL5LIB};
1406 $env = $ENV{PERLLIB} unless defined $env;
1408 push @env, $env if defined $env and length $env;
1409 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1410 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1412 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
1414 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
1415 } elsif (@dirs < 24) {
1416 my @d = map {my $cp = $_;
1417 $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
1420 $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
1421 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
1425 my $cnt = keys %{$self->{is_tested}};
1426 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
1427 "$cnt build dirs to PERL5LIB; ".
1432 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1435 package CPAN::CacheMgr;
1438 #-> sub CPAN::CacheMgr::as_string ;
1440 eval { require Data::Dumper };
1442 return shift->SUPER::as_string;
1444 return Data::Dumper::Dumper(shift);
1448 #-> sub CPAN::CacheMgr::cachesize ;
1453 #-> sub CPAN::CacheMgr::tidyup ;
1456 return unless $CPAN::META->{LOCK};
1457 return unless -d $self->{ID};
1458 while ($self->{DU} > $self->{'MAX'} ) {
1459 my($toremove) = shift @{$self->{FIFO}};
1460 unless ($toremove =~ /\.yml$/) {
1461 $CPAN::Frontend->myprint(sprintf(
1462 "DEL(%.1f>%.1fMB): %s \n",
1469 return if $CPAN::Signal;
1470 $self->_clean_cache($toremove);
1471 return if $CPAN::Signal;
1475 #-> sub CPAN::CacheMgr::dir ;
1480 #-> sub CPAN::CacheMgr::entries ;
1482 my($self,$dir) = @_;
1483 return unless defined $dir;
1484 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1485 $dir ||= $self->{ID};
1486 my($cwd) = CPAN::anycwd();
1487 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1488 my $dh = DirHandle->new(File::Spec->curdir)
1489 or Carp::croak("Couldn't opendir $dir: $!");
1492 next if $_ eq "." || $_ eq "..";
1494 push @entries, File::Spec->catfile($dir,$_);
1496 push @entries, File::Spec->catdir($dir,$_);
1498 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1501 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1502 sort { -M $b <=> -M $a} @entries;
1505 #-> sub CPAN::CacheMgr::disk_usage ;
1507 my($self,$dir) = @_;
1508 return if exists $self->{SIZE}{$dir};
1509 return if $CPAN::Signal;
1514 unless (chmod 0755, $dir) {
1515 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1516 "permission to change the permission; cannot ".
1517 "estimate disk usage of '$dir'\n");
1518 $CPAN::Frontend->mysleep(5);
1523 # nothing to say, no matter what the permissions
1526 $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
1531 $File::Find::prune++ if $CPAN::Signal;
1533 if ($^O eq 'MacOS') {
1535 my $cat = Mac::Files::FSpGetCatInfo($_);
1536 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1540 unless (chmod 0755, $_) {
1541 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1542 "the permission to change the permission; ".
1543 "can only partially estimate disk usage ".
1545 $CPAN::Frontend->mysleep(5);
1556 return if $CPAN::Signal;
1557 $self->{SIZE}{$dir} = $Du/1024/1024;
1558 push @{$self->{FIFO}}, $dir;
1559 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1560 $self->{DU} += $Du/1024/1024;
1564 #-> sub CPAN::CacheMgr::_clean_cache ;
1566 my($self,$dir) = @_;
1567 return unless -e $dir;
1568 unless (File::Spec->canonpath(File::Basename::dirname($dir))
1569 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
1570 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
1571 "will not remove\n");
1572 $CPAN::Frontend->mysleep(5);
1575 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1577 File::Path::rmtree($dir);
1579 if ($dir !~ /\.yml$/ && -f "$dir.yml") {
1580 my $yaml_module = CPAN::_yaml_module;
1581 if ($CPAN::META->has_inst($yaml_module)) {
1582 my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); };
1584 $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)");
1585 unlink "$dir.yml" or
1586 $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)");
1588 } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) {
1589 $CPAN::META->delete("CPAN::Distribution", $id);
1591 # XXX we should restore the state NOW, otherise this
1592 # distro does not exist until we read an index. BUG ALERT(?)
1594 # $CPAN::Frontend->mywarn (" +++\n");
1598 unlink "$dir.yml"; # may fail
1599 unless ($id_deleted) {
1600 CPAN->debug("no distro found associated with '$dir'");
1603 $self->{DU} -= $self->{SIZE}{$dir};
1604 delete $self->{SIZE}{$dir};
1607 #-> sub CPAN::CacheMgr::new ;
1614 ID => $CPAN::Config->{build_dir},
1615 MAX => $CPAN::Config->{'build_cache'},
1616 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1619 File::Path::mkpath($self->{ID});
1620 my $dh = DirHandle->new($self->{ID});
1621 bless $self, $class;
1624 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1626 CPAN->debug($debug) if $CPAN::DEBUG;
1630 #-> sub CPAN::CacheMgr::scan_cache ;
1633 return if $self->{SCAN} eq 'never';
1634 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1635 unless $self->{SCAN} eq 'atstart';
1636 return unless $CPAN::META->{LOCK};
1637 $CPAN::Frontend->myprint(
1638 sprintf("Scanning cache %s for sizes\n",
1641 my @entries = grep { !/^\.\.?$/ } $self->entries($self->{ID});
1645 # next if $e eq ".." || $e eq ".";
1646 $self->disk_usage($e);
1648 while (($painted/76) < ($i/@entries)) {
1649 $CPAN::Frontend->myprint(".");
1652 return if $CPAN::Signal;
1654 $CPAN::Frontend->myprint("DONE\n");
1658 package CPAN::Shell;
1661 #-> sub CPAN::Shell::h ;
1663 my($class,$about) = @_;
1664 if (defined $about) {
1665 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1667 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1668 $CPAN::Frontend->myprint(qq{
1669 Display Information $filler (ver $CPAN::VERSION)
1670 command argument description
1671 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1672 i WORD or /REGEXP/ about any of the above
1673 ls AUTHOR or GLOB about files in the author's directory
1674 (with WORD being a module, bundle or author name or a distribution
1675 name of the form AUTHOR/DISTRIBUTION)
1677 Download, Test, Make, Install...
1678 get download clean make clean
1679 make make (implies get) look open subshell in dist directory
1680 test make test (implies make) readme display these README files
1681 install make install (implies test) perldoc display POD documentation
1684 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1685 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1688 force CMD try hard to do command fforce CMD try harder
1689 notest CMD skip testing
1692 h,? display this menu ! perl-code eval a perl command
1693 o conf [opt] set and query options q quit the cpan shell
1694 reload cpan load CPAN.pm again reload index load newer indices
1695 autobundle Snapshot recent latest CPAN uploads});
1701 #-> sub CPAN::Shell::a ;
1703 my($self,@arg) = @_;
1704 # authors are always UPPERCASE
1706 $_ = uc $_ unless /=/;
1708 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1711 #-> sub CPAN::Shell::globls ;
1713 my($self,$s,$pragmas) = @_;
1714 # ls is really very different, but we had it once as an ordinary
1715 # command in the Shell (upto rev. 321) and we could not handle
1717 my(@accept,@preexpand);
1718 if ($s =~ /[\*\?\/]/) {
1719 if ($CPAN::META->has_inst("Text::Glob")) {
1720 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1721 my $rau = Text::Glob::glob_to_regex(uc $au);
1722 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1724 push @preexpand, map { $_->id . "/" . $pathglob }
1725 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1727 my $rau = Text::Glob::glob_to_regex(uc $s);
1728 push @preexpand, map { $_->id }
1729 CPAN::Shell->expand_by_method('CPAN::Author',
1734 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1737 push @preexpand, uc $s;
1740 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1741 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1746 my $silent = @accept>1;
1747 my $last_alpha = "";
1749 for my $a (@accept){
1750 my($author,$pathglob);
1751 if ($a =~ m|(.*?)/(.*)|) {
1754 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1757 or $CPAN::Frontend->mydie("No author found for $a2\n");
1759 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1762 or $CPAN::Frontend->mydie("No author found for $a\n");
1765 my $alpha = substr $author->id, 0, 1;
1767 if ($alpha eq $last_alpha) {
1771 $last_alpha = $alpha;
1773 $CPAN::Frontend->myprint($ad);
1775 for my $pragma (@$pragmas) {
1776 if ($author->can($pragma)) {
1780 push @results, $author->ls($pathglob,$silent); # silent if
1783 for my $pragma (@$pragmas) {
1784 my $unpragma = "un$pragma";
1785 if ($author->can($unpragma)) {
1786 $author->$unpragma();
1793 #-> sub CPAN::Shell::local_bundles ;
1795 my($self,@which) = @_;
1796 my($incdir,$bdir,$dh);
1797 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1798 my @bbase = "Bundle";
1799 while (my $bbase = shift @bbase) {
1800 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1801 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1802 if ($dh = DirHandle->new($bdir)) { # may fail
1804 for $entry ($dh->read) {
1805 next if $entry =~ /^\./;
1806 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1807 if (-d File::Spec->catdir($bdir,$entry)){
1808 push @bbase, "$bbase\::$entry";
1810 next unless $entry =~ s/\.pm(?!\n)\Z//;
1811 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1819 #-> sub CPAN::Shell::b ;
1821 my($self,@which) = @_;
1822 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1823 $self->local_bundles;
1824 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1827 #-> sub CPAN::Shell::d ;
1828 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1830 #-> sub CPAN::Shell::m ;
1831 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1833 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1836 #-> sub CPAN::Shell::i ;
1840 @args = '/./' unless @args;
1842 for my $type (qw/Bundle Distribution Module/) {
1843 push @result, $self->expand($type,@args);
1845 # Authors are always uppercase.
1846 push @result, $self->expand("Author", map { uc $_ } @args);
1848 my $result = @result == 1 ?
1849 $result[0]->as_string :
1851 "No objects found of any type for argument @args\n" :
1853 (map {$_->as_glimpse} @result),
1854 scalar @result, " items found\n",
1856 $CPAN::Frontend->myprint($result);
1859 #-> sub CPAN::Shell::o ;
1861 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1862 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1863 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1864 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1866 my($self,$o_type,@o_what) = @_;
1868 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1869 if ($o_type eq 'conf') {
1870 if (!@o_what) { # print all things, "o conf"
1872 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1874 if (exists $INC{'CPAN/Config.pm'}) {
1875 push @from, $INC{'CPAN/Config.pm'};
1877 if (exists $INC{'CPAN/MyConfig.pm'}) {
1878 push @from, $INC{'CPAN/MyConfig.pm'};
1880 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1881 $CPAN::Frontend->myprint(":\n");
1882 for $k (sort keys %CPAN::HandleConfig::can) {
1883 $v = $CPAN::HandleConfig::can{$k};
1884 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1886 $CPAN::Frontend->myprint("\n");
1887 for $k (sort keys %$CPAN::Config) {
1888 CPAN::HandleConfig->prettyprint($k);
1890 $CPAN::Frontend->myprint("\n");
1892 if (CPAN::HandleConfig->edit(@o_what)) {
1894 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1898 } elsif ($o_type eq 'debug') {
1900 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1903 my($what) = shift @o_what;
1904 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1905 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1908 if ( exists $CPAN::DEBUG{$what} ) {
1909 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1910 } elsif ($what =~ /^\d/) {
1911 $CPAN::DEBUG = $what;
1912 } elsif (lc $what eq 'all') {
1914 for (values %CPAN::DEBUG) {
1917 $CPAN::DEBUG = $max;
1920 for (keys %CPAN::DEBUG) {
1921 next unless lc($_) eq lc($what);
1922 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1925 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1930 my $raw = "Valid options for debug are ".
1931 join(", ",sort(keys %CPAN::DEBUG), 'all').
1932 qq{ or a number. Completion works on the options. }.
1933 qq{Case is ignored.};
1935 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1936 $CPAN::Frontend->myprint("\n\n");
1939 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1941 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1942 $v = $CPAN::DEBUG{$k};
1943 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1944 if $v & $CPAN::DEBUG;
1947 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1950 $CPAN::Frontend->myprint(qq{
1952 conf set or get configuration variables
1953 debug set or get debugging options
1958 # CPAN::Shell::paintdots_onreload
1959 sub paintdots_onreload {
1962 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1966 # $CPAN::Frontend->myprint(".($subr)");
1967 $CPAN::Frontend->myprint(".");
1968 if ($subr =~ /\bshell\b/i) {
1969 # warn "debug[$_[0]]";
1971 # It would be nice if we could detect that a
1972 # subroutine has actually changed, but for now we
1973 # practically always set the GOTOSHELL global
1983 #-> sub CPAN::Shell::hosts ;
1986 my $fullstats = CPAN::FTP->_ftp_statistics();
1987 my $history = $fullstats->{history} || [];
1989 while (my $last = pop @$history) {
1990 my $attempts = $last->{attempts} or next;
1993 $start = $attempts->[-1]{start};
1994 if ($#$attempts > 0) {
1995 for my $i (0..$#$attempts-1) {
1996 my $url = $attempts->[$i]{url} or next;
2001 $start = $last->{start};
2003 next unless $last->{thesiteurl}; # C-C? bad filenames?
2005 $S{end} ||= $last->{end};
2006 my $dltime = $last->{end} - $start;
2007 my $dlsize = $last->{filesize} || 0;
2008 my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
2009 my $s = $S{ok}{$url} ||= {};
2012 $s->{dlsize} += $dlsize/1024;
2014 $s->{dltime} += $dltime;
2017 for my $url (keys %{$S{ok}}) {
2018 next if $S{ok}{$url}{dltime} == 0; # div by zero
2019 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
2020 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
2024 for my $url (keys %{$S{no}}) {
2025 push @{$res->{no}}, [$S{no}{$url},
2029 my $R = ""; # report
2030 if ($S{start} && $S{end}) {
2031 $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
2032 $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown";
2034 if ($res->{ok} && @{$res->{ok}}) {
2035 $R .= sprintf "\nSuccessful downloads:
2036 N kB secs kB/s url\n";
2038 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
2039 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
2043 if ($res->{no} && @{$res->{no}}) {
2044 $R .= sprintf "\nUnsuccessful downloads:\n";
2046 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
2047 $R .= sprintf "%4d %s\n", @$_;
2051 $CPAN::Frontend->myprint($R);
2054 #-> sub CPAN::Shell::reload ;
2056 my($self,$command,@arg) = @_;
2058 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
2059 if ($command =~ /^cpan$/i) {
2061 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
2066 "CPAN/FirstTime.pm",
2067 "CPAN/HandleConfig.pm",
2075 MFILE: for my $f (@relo) {
2076 next unless exists $INC{$f};
2080 $CPAN::Frontend->myprint("($p");
2081 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
2082 $self->_reload_this($f) or $failed++;
2083 my $v = eval "$p\::->VERSION";
2084 $CPAN::Frontend->myprint("v$v)");
2086 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
2088 my $errors = $failed == 1 ? "error" : "errors";
2089 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
2092 } elsif ($command =~ /^index$/i) {
2093 CPAN::Index->force_reload;
2095 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
2096 index re-reads the index files\n});
2100 # reload means only load again what we have loaded before
2101 #-> sub CPAN::Shell::_reload_this ;
2103 my($self,$f,$args) = @_;
2104 CPAN->debug("f[$f]") if $CPAN::DEBUG;
2105 return 1 unless $INC{$f}; # we never loaded this, so we do not
2107 my $pwd = CPAN::anycwd();
2108 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
2110 for my $inc (@INC) {
2111 $file = File::Spec->catfile($inc,split /\//, $f);
2115 CPAN->debug("file[$file]") if $CPAN::DEBUG;
2117 unless ($file && -f $file) {
2118 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
2120 unless (CPAN->has_inst("File::Basename")) {
2121 @inc = File::Basename::dirname($file);
2123 # do we ever need this?
2124 @inc = substr($file,0,-length($f)-1); # bring in back to me!
2127 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
2129 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
2132 my $mtime = (stat $file)[9];
2133 $reload->{$f} ||= $^T;
2134 my $must_reload = $mtime > $reload->{$f};
2136 $must_reload ||= $args->{reloforce};
2138 my $fh = FileHandle->new($file) or
2139 $CPAN::Frontend->mydie("Could not open $file: $!");
2142 my $content = <$fh>;
2143 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
2147 eval "require '$f'";
2152 $reload->{$f} = time;
2154 $CPAN::Frontend->myprint("__unchanged__");
2159 #-> sub CPAN::Shell::mkmyconfig ;
2161 my($self, $cpanpm, %args) = @_;
2162 require CPAN::FirstTime;
2163 my $home = CPAN::HandleConfig::home;
2164 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
2165 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
2166 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
2167 CPAN::HandleConfig::require_myconfig_or_config;
2168 $CPAN::Config ||= {};
2173 keep_source_where => undef,
2176 CPAN::FirstTime::init($cpanpm, %args);
2179 #-> sub CPAN::Shell::_binary_extensions ;
2180 sub _binary_extensions {
2181 my($self) = shift @_;
2182 my(@result,$module,%seen,%need,$headerdone);
2183 for $module ($self->expand('Module','/./')) {
2184 my $file = $module->cpan_file;
2185 next if $file eq "N/A";
2186 next if $file =~ /^Contact Author/;
2187 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
2188 next if $dist->isa_perl;
2189 next unless $module->xs_file;
2191 $CPAN::Frontend->myprint(".");
2192 push @result, $module;
2194 # print join " | ", @result;
2195 $CPAN::Frontend->myprint("\n");
2199 #-> sub CPAN::Shell::recompile ;
2201 my($self) = shift @_;
2202 my($module,@module,$cpan_file,%dist);
2203 @module = $self->_binary_extensions();
2204 for $module (@module){ # we force now and compile later, so we
2206 $cpan_file = $module->cpan_file;
2207 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2209 $dist{$cpan_file}++;
2211 for $cpan_file (sort keys %dist) {
2212 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
2213 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2215 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
2216 # stop a package from recompiling,
2217 # e.g. IO-1.12 when we have perl5.003_10
2221 #-> sub CPAN::Shell::scripts ;
2223 my($self, $arg) = @_;
2224 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
2226 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
2227 unless ($CPAN::META->has_inst($req)) {
2228 $CPAN::Frontend->mywarn(" $req not available\n");
2231 my $p = HTML::LinkExtor->new();
2232 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
2233 unless (-f $indexfile) {
2234 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
2236 $p->parse_file($indexfile);
2239 if ($arg =~ s|^/(.+)/$|$1|) {
2240 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
2242 for my $l ($p->links) {
2243 my $tag = shift @$l;
2244 next unless $tag eq "a";
2246 my $href = $att{href};
2247 next unless $href =~ s|^\.\./authors/id/./../||;
2250 if ($href =~ $qrarg) {
2254 if ($href =~ /\Q$arg\E/) {
2262 # now filter for the latest version if there is more than one of a name
2268 $stems{$stem} ||= [];
2269 push @{$stems{$stem}}, $href;
2271 for (sort keys %stems) {
2273 if (@{$stems{$_}} > 1) {
2274 $highest = List::Util::reduce {
2275 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
2278 $highest = $stems{$_}[0];
2280 $CPAN::Frontend->myprint("$highest\n");
2284 #-> sub CPAN::Shell::report ;
2286 my($self,@args) = @_;
2287 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2288 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2290 local $CPAN::Config->{test_report} = 1;
2291 $self->force("test",@args); # force is there so that the test be
2292 # re-run (as documented)
2295 # compare with is_tested
2296 #-> sub CPAN::Shell::install_tested
2297 sub install_tested {
2298 my($self,@some) = @_;
2299 $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
2301 CPAN::Index->reload;
2303 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2304 my $yaml = "$b.yml";
2306 $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
2309 my $yaml_content = CPAN->_yaml_loadfile($yaml);
2310 my $id = $yaml_content->[0]{distribution}{ID};
2312 $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
2315 my $do = CPAN::Shell->expandany($id);
2317 $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
2320 unless ($do->{build_dir}) {
2321 $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
2324 unless ($do->{build_dir} eq $b) {
2325 $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
2331 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2332 return unless @some;
2334 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2335 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2336 return unless @some;
2338 # @some = grep { not $_->uptodate } @some;
2339 # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2340 # return unless @some;
2342 CPAN->debug("some[@some]");
2344 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2345 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2346 $CPAN::Frontend->mysleep(1);
2351 #-> sub CPAN::Shell::upgrade ;
2353 my($self,@args) = @_;
2354 $self->install($self->r(@args));
2357 #-> sub CPAN::Shell::_u_r_common ;
2359 my($self) = shift @_;
2360 my($what) = shift @_;
2361 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2362 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2363 $what && $what =~ /^[aru]$/;
2365 @args = '/./' unless @args;
2366 my(@result,$module,%seen,%need,$headerdone,
2367 $version_undefs,$version_zeroes);
2368 $version_undefs = $version_zeroes = 0;
2369 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2370 my @expand = $self->expand('Module',@args);
2371 my $expand = scalar @expand;
2372 if (0) { # Looks like noise to me, was very useful for debugging
2373 # for metadata cache
2374 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
2376 MODULE: for $module (@expand) {
2377 my $file = $module->cpan_file;
2378 next MODULE unless defined $file; # ??
2379 $file =~ s|^./../||;
2380 my($latest) = $module->cpan_version;
2381 my($inst_file) = $module->inst_file;
2383 return if $CPAN::Signal;
2386 $have = $module->inst_version;
2387 } elsif ($what eq "r") {
2388 $have = $module->inst_version;
2390 if ($have eq "undef"){
2392 } elsif ($have == 0){
2395 next MODULE unless CPAN::Version->vgt($latest, $have);
2396 # to be pedantic we should probably say:
2397 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2398 # to catch the case where CPAN has a version 0 and we have a version undef
2399 } elsif ($what eq "u") {
2405 } elsif ($what eq "r") {
2407 } elsif ($what eq "u") {
2411 return if $CPAN::Signal; # this is sometimes lengthy
2414 push @result, sprintf "%s %s\n", $module->id, $have;
2415 } elsif ($what eq "r") {
2416 push @result, $module->id;
2417 next MODULE if $seen{$file}++;
2418 } elsif ($what eq "u") {
2419 push @result, $module->id;
2420 next MODULE if $seen{$file}++;
2421 next MODULE if $file =~ /^Contact/;
2423 unless ($headerdone++){
2424 $CPAN::Frontend->myprint("\n");
2425 $CPAN::Frontend->myprint(sprintf(
2428 "Package namespace",
2440 $CPAN::META->has_inst("Term::ANSIColor")
2442 $module->description
2444 $color_on = Term::ANSIColor::color("green");
2445 $color_off = Term::ANSIColor::color("reset");
2447 $CPAN::Frontend->myprint(sprintf $sprintf,
2454 $need{$module->id}++;
2458 $CPAN::Frontend->myprint("No modules found for @args\n");
2459 } elsif ($what eq "r") {
2460 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2464 if ($version_zeroes) {
2465 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2466 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2467 qq{a version number of 0\n});
2469 if ($version_undefs) {
2470 my $s_has = $version_undefs > 1 ? "s have" : " has";
2471 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2472 qq{parseable version number\n});
2478 #-> sub CPAN::Shell::r ;
2480 shift->_u_r_common("r",@_);
2483 #-> sub CPAN::Shell::u ;
2485 shift->_u_r_common("u",@_);
2488 #-> sub CPAN::Shell::failed ;
2490 my($self,$only_id,$silent) = @_;
2492 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2494 NAY: for my $nosayer ( # order matters!
2503 next unless exists $d->{$nosayer};
2504 next unless defined $d->{$nosayer};
2506 UNIVERSAL::can($d->{$nosayer},"failed") ?
2507 $d->{$nosayer}->failed :
2508 $d->{$nosayer} =~ /^NO/
2510 next NAY if $only_id && $only_id != (
2511 UNIVERSAL::can($d->{$nosayer},"commandid")
2513 $d->{$nosayer}->commandid
2515 $CPAN::CurrentCommandId
2520 next DIST unless $failed;
2524 # " %-45s: %s %s\n",
2527 UNIVERSAL::can($d->{$failed},"failed") ?
2529 $d->{$failed}->commandid,
2532 $d->{$failed}->text,
2533 $d->{$failed}{TIME}||0,
2546 $scope = "this command";
2547 } elsif ($CPAN::Index::HAVE_REANIMATED) {
2548 $scope = "this or a previous session";
2549 # it might be nice to have a section for previous session and
2552 $scope = "this session";
2559 map { sprintf "%5d %-45s: %s %s\n", @$_ }
2560 sort { $a->[0] <=> $b->[0] } @failed;
2563 map { sprintf " %-45s: %s %s\n", @$_[1..3] }
2570 $CPAN::Frontend->myprint("Failed during $scope:\n$print");
2571 } elsif (!$only_id || !$silent) {
2572 $CPAN::Frontend->myprint("Nothing failed in $scope\n");
2576 # XXX intentionally undocumented because completely bogus, unportable,
2579 #-> sub CPAN::Shell::status ;
2582 require Devel::Size;
2583 my $ps = FileHandle->new;
2584 open $ps, "/proc/$$/status";
2587 next unless /VmSize:\s+(\d+)/;
2591 $CPAN::Frontend->mywarn(sprintf(
2592 "%-27s %6d\n%-27s %6d\n",
2596 Devel::Size::total_size($CPAN::META)/1024,
2598 for my $k (sort keys %$CPAN::META) {
2599 next unless substr($k,0,4) eq "read";
2600 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2601 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2602 warn sprintf " %-25s %6d (keys: %6d)\n",
2604 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2605 scalar keys %{$CPAN::META->{$k}{$k2}};
2610 # compare with install_tested
2611 #-> sub CPAN::Shell::is_tested
2614 CPAN::Index->reload;
2615 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2617 if ($CPAN::META->{is_tested}{$b}) {
2618 $time = scalar(localtime $CPAN::META->{is_tested}{$b});
2620 $time = scalar localtime;
2623 $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
2627 #-> sub CPAN::Shell::autobundle ;
2630 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2631 my(@bundle) = $self->_u_r_common("a",@_);
2632 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2633 File::Path::mkpath($todir);
2634 unless (-d $todir) {
2635 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2638 my($y,$m,$d) = (localtime)[5,4,3];
2642 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2643 my($to) = File::Spec->catfile($todir,"$me.pm");
2645 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2646 $to = File::Spec->catfile($todir,"$me.pm");
2648 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2650 "package Bundle::$me;\n\n",
2651 "\$VERSION = '0.01';\n\n",
2655 "Bundle::$me - Snapshot of installation on ",
2656 $Config::Config{'myhostname'},
2659 "\n\n=head1 SYNOPSIS\n\n",
2660 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2661 "=head1 CONTENTS\n\n",
2662 join("\n", @bundle),
2663 "\n\n=head1 CONFIGURATION\n\n",
2665 "\n\n=head1 AUTHOR\n\n",
2666 "This Bundle has been generated automatically ",
2667 "by the autobundle routine in CPAN.pm.\n",
2670 $CPAN::Frontend->myprint("\nWrote bundle file
2674 #-> sub CPAN::Shell::expandany ;
2677 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2678 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2679 $s = CPAN::Distribution->normalize($s);
2680 return $CPAN::META->instance('CPAN::Distribution',$s);
2681 # Distributions spring into existence, not expand
2682 } elsif ($s =~ m|^Bundle::|) {
2683 $self->local_bundles; # scanning so late for bundles seems
2684 # both attractive and crumpy: always
2685 # current state but easy to forget
2687 return $self->expand('Bundle',$s);
2689 return $self->expand('Module',$s)
2690 if $CPAN::META->exists('CPAN::Module',$s);
2695 #-> sub CPAN::Shell::expand ;
2698 my($type,@args) = @_;
2699 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2700 my $class = "CPAN::$type";
2701 my $methods = ['id'];
2702 for my $meth (qw(name)) {
2703 next unless $class->can($meth);
2704 push @$methods, $meth;
2706 $self->expand_by_method($class,$methods,@args);
2709 #-> sub CPAN::Shell::expand_by_method ;
2710 sub expand_by_method {
2712 my($class,$methods,@args) = @_;
2715 my($regex,$command);
2716 if ($arg =~ m|^/(.*)/$|) {
2718 } elsif ($arg =~ m/=/) {
2722 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2724 defined $regex ? $regex : "UNDEFINED",
2725 defined $command ? $command : "UNDEFINED",
2727 if (defined $regex) {
2728 if (CPAN::_sqlite_running) {
2729 $CPAN::SQLite->search($class, $regex);
2732 $CPAN::META->all_objects($class)
2734 unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id){
2735 # BUG, we got an empty object somewhere
2736 require Data::Dumper;
2737 CPAN->debug(sprintf(
2738 "Bug in CPAN: Empty id on obj[%s][%s]",
2740 Data::Dumper::Dumper($obj)
2744 for my $method (@$methods) {
2745 my $match = eval {$obj->$method() =~ /$regex/i};
2747 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2748 $err ||= $@; # if we were too restrictive above
2749 $CPAN::Frontend->mydie("$err\n");
2756 } elsif ($command) {
2757 die "equal sign in command disabled (immature interface), ".
2759 ! \$CPAN::Shell::ADVANCED_QUERY=1
2760 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2761 that may go away anytime.\n"
2762 unless $ADVANCED_QUERY;
2763 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2764 my($matchcrit) = $criterion =~ m/^~(.+)/;
2768 $CPAN::META->all_objects($class)
2770 my $lhs = $self->$method() or next; # () for 5.00503
2772 push @m, $self if $lhs =~ m/$matchcrit/;
2774 push @m, $self if $lhs eq $criterion;
2779 if ( $class eq 'CPAN::Bundle' ) {
2780 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2781 } elsif ($class eq "CPAN::Distribution") {
2782 $xarg = CPAN::Distribution->normalize($arg);
2786 if ($CPAN::META->exists($class,$xarg)) {
2787 $obj = $CPAN::META->instance($class,$xarg);
2788 } elsif ($CPAN::META->exists($class,$arg)) {
2789 $obj = $CPAN::META->instance($class,$arg);
2796 @m = sort {$a->id cmp $b->id} @m;
2797 if ( $CPAN::DEBUG ) {
2798 my $wantarray = wantarray;
2799 my $join_m = join ",", map {$_->id} @m;
2800 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2802 return wantarray ? @m : $m[0];
2805 #-> sub CPAN::Shell::format_result ;
2808 my($type,@args) = @_;
2809 @args = '/./' unless @args;
2810 my(@result) = $self->expand($type,@args);
2811 my $result = @result == 1 ?
2812 $result[0]->as_string :
2814 "No objects of type $type found for argument @args\n" :
2816 (map {$_->as_glimpse} @result),
2817 scalar @result, " items found\n",
2822 #-> sub CPAN::Shell::report_fh ;
2824 my $installation_report_fh;
2825 my $previously_noticed = 0;
2828 return $installation_report_fh if $installation_report_fh;
2829 if ($CPAN::META->has_inst("File::Temp")) {
2830 $installation_report_fh
2832 template => 'cpan_install_XXXX',
2837 unless ( $installation_report_fh ) {
2838 warn("Couldn't open installation report file; " .
2839 "no report file will be generated."
2840 ) unless $previously_noticed++;
2846 # The only reason for this method is currently to have a reliable
2847 # debugging utility that reveals which output is going through which
2848 # channel. No, I don't like the colors ;-)
2850 # to turn colordebugging on, write
2851 # cpan> o conf colorize_output 1
2853 #-> sub CPAN::Shell::print_ornamented ;
2855 my $print_ornamented_have_warned = 0;
2856 sub colorize_output {
2857 my $colorize_output = $CPAN::Config->{colorize_output};
2858 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2859 unless ($print_ornamented_have_warned++) {
2860 # no myprint/mywarn within myprint/mywarn!
2861 warn "Colorize_output is set to true but Term::ANSIColor is not
2862 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2864 $colorize_output = 0;
2866 return $colorize_output;
2871 #-> sub CPAN::Shell::print_ornamented ;
2872 sub print_ornamented {
2873 my($self,$what,$ornament) = @_;
2874 return unless defined $what;
2876 local $| = 1; # Flush immediately
2877 if ( $CPAN::Be_Silent ) {
2878 print {report_fh()} $what;
2881 my $swhat = "$what"; # stringify if it is an object
2882 if ($CPAN::Config->{term_is_latin}){
2885 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2887 if ($self->colorize_output) {
2888 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2889 # if you want to have this configurable, please file a bugreport
2890 $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
2892 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2894 print "Term::ANSIColor rejects color[$ornament]: $@\n
2895 Please choose a different color (Hint: try 'o conf init /color/')\n";
2899 Term::ANSIColor::color("reset");
2905 #-> sub CPAN::Shell::myprint ;
2907 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2908 # where to use what! I think, we send everything to STDOUT and use
2909 # print for normal/good news and warn for news that need more
2910 # attention. Yes, this is our working contract for now.
2912 my($self,$what) = @_;
2914 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2917 #-> sub CPAN::Shell::myexit ;
2919 my($self,$what) = @_;
2920 $self->myprint($what);
2924 #-> sub CPAN::Shell::mywarn ;
2926 my($self,$what) = @_;
2927 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2930 # only to be used for shell commands
2931 #-> sub CPAN::Shell::mydie ;
2933 my($self,$what) = @_;
2934 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2936 # If it is the shell, we want that the following die to be silent,
2937 # but if it is not the shell, we would need a 'die $what'. We need
2938 # to take care that only shell commands use mydie. Is this
2944 # sub CPAN::Shell::colorable_makemaker_prompt ;
2945 sub colorable_makemaker_prompt {
2947 if (CPAN::Shell->colorize_output) {
2948 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2949 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2952 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2953 if (CPAN::Shell->colorize_output) {
2954 print Term::ANSIColor::color('reset');
2959 # use this only for unrecoverable errors!
2960 #-> sub CPAN::Shell::unrecoverable_error ;
2961 sub unrecoverable_error {
2962 my($self,$what) = @_;
2963 my @lines = split /\n/, $what;
2965 for my $l (@lines) {
2966 $longest = length $l if length $l > $longest;
2968 $longest = 62 if $longest > 62;
2969 for my $l (@lines) {
2975 if (length $l < 66) {
2976 $l = pack "A66 A*", $l, "<==";
2980 unshift @lines, "\n";
2981 $self->mydie(join "", @lines);
2984 #-> sub CPAN::Shell::mysleep ;
2986 my($self, $sleep) = @_;
2987 use Time::HiRes qw(sleep);
2991 #-> sub CPAN::Shell::setup_output ;
2993 return if -t STDOUT;
2994 my $odef = select STDERR;
3001 #-> sub CPAN::Shell::rematein ;
3002 # RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
3005 my($meth,@some) = @_;
3007 while($meth =~ /^(ff?orce|notest)$/) {
3008 push @pragma, $meth;
3009 $meth = shift @some or
3010 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
3014 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
3016 # Here is the place to set "test_count" on all involved parties to
3017 # 0. We then can pass this counter on to the involved
3018 # distributions and those can refuse to test if test_count > X. In
3019 # the first stab at it we could use a 1 for "X".
3021 # But when do I reset the distributions to start with 0 again?
3022 # Jost suggested to have a random or cycling interaction ID that
3023 # we pass through. But the ID is something that is just left lying
3024 # around in addition to the counter, so I'd prefer to set the
3025 # counter to 0 now, and repeat at the end of the loop. But what
3026 # about dependencies? They appear later and are not reset, they
3027 # enter the queue but not its copy. How do they get a sensible
3030 my $needs_recursion_protection = "make|test|install";
3032 # construct the queue
3034 STHING: foreach $s (@some) {
3037 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
3039 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
3040 } elsif ($s =~ m|^/|) { # looks like a regexp
3041 if (substr($s,-1,1) eq ".") {
3042 $obj = CPAN::Shell->expandany($s);
3044 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
3045 "not supported.\nRejecting argument '$s'\n");
3046 $CPAN::Frontend->mysleep(2);
3049 } elsif ($meth eq "ls") {
3050 $self->globls($s,\@pragma);
3053 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
3054 $obj = CPAN::Shell->expandany($s);
3057 } elsif (ref $obj) {
3058 if ($meth =~ /^($needs_recursion_protection)$/) {
3059 # it would be silly to check for recursion for look or dump
3060 # (we are in CPAN::Shell::rematein)
3061 CPAN->debug("Going to test against recursion") if $CPAN::DEBUG;
3062 eval { $obj->color_cmd_tmps(0,1); };
3065 and $@->isa("CPAN::Exception::RecursiveDependency")) {
3066 $CPAN::Frontend->mywarn($@);
3070 Carp::confess(sprintf "DEBUG: \$\@[%s]ref[%s]", $@, ref $@);
3076 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
3078 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
3079 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
3080 if ($meth =~ /^(dump|ls)$/) {
3083 $CPAN::Frontend->mywarn(
3085 "Don't be silly, you can't $meth ",
3089 $CPAN::Frontend->mysleep(2);
3091 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
3092 CPAN::InfoObj->dump($s);
3095 ->mywarn(qq{Warning: Cannot $meth $s, }.
3096 qq{don't know what it is.
3101 to find objects with matching identifiers.
3103 $CPAN::Frontend->mysleep(2);
3107 # queuerunner (please be warned: when I started to change the
3108 # queue to hold objects instead of names, I made one or two
3109 # mistakes and never found which. I reverted back instead)
3110 while (my $q = CPAN::Queue->first) {
3112 my $s = $q->as_string;
3113 my $reqtype = $q->reqtype || "";
3114 $obj = CPAN::Shell->expandany($s);
3116 # don't know how this can happen, maybe we should panic,
3117 # but maybe we get a solution from the first user who hits
3118 # this unfortunate exception?
3119 $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
3120 "to an object. Skipping.\n");
3121 $CPAN::Frontend->mysleep(5);
3122 CPAN::Queue->delete_first($s);
3125 $obj->{reqtype} ||= "";
3127 # force debugging because CPAN::SQLite somehow delivers us
3130 # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
3132 CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
3133 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
3135 if ($obj->{reqtype}) {
3136 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
3137 $obj->{reqtype} = $reqtype;
3139 exists $obj->{install}
3142 UNIVERSAL::can($obj->{install},"failed") ?
3143 $obj->{install}->failed :
3144 $obj->{install} =~ /^NO/
3147 delete $obj->{install};
3148 $CPAN::Frontend->mywarn
3149 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
3153 $obj->{reqtype} = $reqtype;
3156 for my $pragma (@pragma) {
3159 $obj->can($pragma)){
3160 $obj->$pragma($meth);
3163 if (UNIVERSAL::can($obj, 'called_for')) {
3164 $obj->called_for($s);
3166 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
3167 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
3170 if (! UNIVERSAL::can($obj,$meth)) {
3172 my $serialized = "";
3174 } elsif ($CPAN::META->has_inst("YAML::Syck")) {
3175 $serialized = YAML::Syck::Dump($obj);
3176 } elsif ($CPAN::META->has_inst("YAML")) {
3177 $serialized = YAML::Dump($obj);
3178 } elsif ($CPAN::META->has_inst("Data::Dumper")) {
3179 $serialized = Data::Dumper::Dumper($obj);
3182 $serialized = overload::StrVal($obj);
3184 CPAN->debug("Going to panic. meth[$meth]s[$s]") if $CPAN::DEBUG;
3185 $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
3186 } elsif ($obj->$meth()){
3187 CPAN::Queue->delete($s);
3188 CPAN->debug("From queue deleted. meth[$meth]s[$s]") if $CPAN::DEBUG;
3190 CPAN->debug("Failed. pragma[@pragma]meth[$meth]") if $CPAN::DEBUG;
3194 for my $pragma (@pragma) {
3195 my $unpragma = "un$pragma";
3196 if ($obj->can($unpragma)) {
3200 CPAN::Queue->delete_first($s);
3202 if ($meth =~ /^($needs_recursion_protection)$/) {
3203 for my $obj (@qcopy) {
3204 $obj->color_cmd_tmps(0,0);
3209 #-> sub CPAN::Shell::recent ;
3213 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
3218 # set up the dispatching methods
3220 for my $command (qw(
3236 *$command = sub { shift->rematein($command, @_); };
3240 package CPAN::LWP::UserAgent;
3244 return if $SETUPDONE;
3245 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3246 require LWP::UserAgent;
3247 @ISA = qw(Exporter LWP::UserAgent);
3250 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
3254 sub get_basic_credentials {
3255 my($self, $realm, $uri, $proxy) = @_;
3256 if ($USER && $PASSWD) {
3257 return ($USER, $PASSWD);
3260 ($USER,$PASSWD) = $self->get_proxy_credentials();
3262 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
3264 return($USER,$PASSWD);
3267 sub get_proxy_credentials {
3269 my ($user, $password);
3270 if ( defined $CPAN::Config->{proxy_user} &&
3271 defined $CPAN::Config->{proxy_pass}) {
3272 $user = $CPAN::Config->{proxy_user};
3273 $password = $CPAN::Config->{proxy_pass};
3274 return ($user, $password);
3276 my $username_prompt = "\nProxy authentication needed!
3277 (Note: to permanently configure username and password run
3278 o conf proxy_user your_username
3279 o conf proxy_pass your_password
3281 ($user, $password) =
3282 _get_username_and_password_from_user($username_prompt);
3283 return ($user,$password);
3286 sub get_non_proxy_credentials {
3288 my ($user,$password);
3289 if ( defined $CPAN::Config->{username} &&
3290 defined $CPAN::Config->{password}) {
3291 $user = $CPAN::Config->{username};
3292 $password = $CPAN::Config->{password};
3293 return ($user, $password);
3295 my $username_prompt = "\nAuthentication needed!
3296 (Note: to permanently configure username and password run
3297 o conf username your_username
3298 o conf password your_password
3301 ($user, $password) =
3302 _get_username_and_password_from_user($username_prompt);
3303 return ($user,$password);
3306 sub _get_username_and_password_from_user {
3307 my $username_message = shift;
3308 my ($username,$password);
3310 ExtUtils::MakeMaker->import(qw(prompt));
3311 $username = prompt($username_message);
3312 if ($CPAN::META->has_inst("Term::ReadKey")) {
3313 Term::ReadKey::ReadMode("noecho");
3316 $CPAN::Frontend->mywarn(
3317 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
3320 $password = prompt("Password:");
3322 if ($CPAN::META->has_inst("Term::ReadKey")) {
3323 Term::ReadKey::ReadMode("restore");
3325 $CPAN::Frontend->myprint("\n\n");
3326 return ($username,$password);
3329 # mirror(): Its purpose is to deal with proxy authentication. When we
3330 # call SUPER::mirror, we relly call the mirror method in
3331 # LWP::UserAgent. LWP::UserAgent will then call
3332 # $self->get_basic_credentials or some equivalent and this will be
3333 # $self->dispatched to our own get_basic_credentials method.
3335 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3337 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3338 # although we have gone through our get_basic_credentials, the proxy
3339 # server refuses to connect. This could be a case where the username or
3340 # password has changed in the meantime, so I'm trying once again without
3341 # $USER and $PASSWD to give the get_basic_credentials routine another
3342 # chance to set $USER and $PASSWD.
3344 # mirror(): Its purpose is to deal with proxy authentication. When we
3345 # call SUPER::mirror, we relly call the mirror method in
3346 # LWP::UserAgent. LWP::UserAgent will then call
3347 # $self->get_basic_credentials or some equivalent and this will be
3348 # $self->dispatched to our own get_basic_credentials method.
3350 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3352 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3353 # although we have gone through our get_basic_credentials, the proxy
3354 # server refuses to connect. This could be a case where the username or
3355 # password has changed in the meantime, so I'm trying once again without
3356 # $USER and $PASSWD to give the get_basic_credentials routine another
3357 # chance to set $USER and $PASSWD.
3360 my($self,$url,$aslocal) = @_;
3361 my $result = $self->SUPER::mirror($url,$aslocal);
3362 if ($result->code == 407) {
3365 $result = $self->SUPER::mirror($url,$aslocal);
3373 #-> sub CPAN::FTP::ftp_statistics
3374 # if they want to rewrite, they need to pass in a filehandle
3375 sub _ftp_statistics {
3377 my $locktype = $fh ? LOCK_EX : LOCK_SH;
3378 $fh ||= FileHandle->new;
3379 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3380 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
3383 while (!flock $fh, $locktype|LOCK_NB) {
3384 $waitstart ||= localtime();
3386 $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
3388 $CPAN::Frontend->mysleep($sleep);
3391 } elsif ($sleep <=6) {
3395 my $stats = eval { CPAN->_yaml_loadfile($file); };
3398 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
3399 $CPAN::Frontend->myprint("Warning (usually harmless): $@");
3401 } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
3402 $CPAN::Frontend->mydie($@);
3405 $CPAN::Frontend->mydie($@);
3411 #-> sub CPAN::FTP::_mytime
3413 if (CPAN->has_inst("Time::HiRes")) {
3414 return Time::HiRes::time();
3420 #-> sub CPAN::FTP::_new_stats
3422 my($self,$file) = @_;
3431 #-> sub CPAN::FTP::_add_to_statistics
3432 sub _add_to_statistics {
3433 my($self,$stats) = @_;
3434 my $yaml_module = CPAN::_yaml_module;
3435 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
3436 if ($CPAN::META->has_inst($yaml_module)) {
3437 $stats->{thesiteurl} = $ThesiteURL;
3438 if (CPAN->has_inst("Time::HiRes")) {
3439 $stats->{end} = Time::HiRes::time();
3441 $stats->{end} = time;
3443 my $fh = FileHandle->new;
3447 @debug = $time if $sdebug;
3448 my $fullstats = $self->_ftp_statistics($fh);
3450 $fullstats->{history} ||= [];
3451 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3452 push @debug, time if $sdebug;
3453 push @{$fullstats->{history}}, $stats;
3454 # arbitrary hardcoded constants until somebody demands to have
3455 # them settable; YAML.pm 0.62 is unacceptably slow with 999;
3456 # YAML::Syck 0.82 has no noticable performance problem with 999;
3458 @{$fullstats->{history}} > 99
3459 || $time - $fullstats->{history}[0]{start} > 14*86400
3461 shift @{$fullstats->{history}}
3463 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3464 push @debug, time if $sdebug;
3465 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
3466 # need no eval because if this fails, it is serious
3467 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3468 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
3470 local $CPAN::DEBUG = 512; # FTP
3472 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
3473 "after[%d]at[%d]oldest[%s]dumped backat[%d]",
3477 # Win32 cannot rename a file to an existing filename
3478 unlink($sfile) if ($^O eq 'MSWin32');
3479 rename "$sfile.$$", $sfile
3480 or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
3484 # if file is CHECKSUMS, suggest the place where we got the file to be
3485 # checked from, maybe only for young files?
3486 #-> sub CPAN::FTP::_recommend_url_for
3487 sub _recommend_url_for {
3488 my($self, $file) = @_;
3489 my $urllist = $self->_get_urllist;
3490 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3491 my $fullstats = $self->_ftp_statistics();
3492 my $history = $fullstats->{history} || [];
3493 while (my $last = pop @$history) {
3494 last if $last->{end} - time > 3600; # only young results are interesting
3495 next unless $last->{file}; # dirname of nothing dies!
3496 next unless $file eq File::Basename::dirname($last->{file});
3497 return $last->{thesiteurl};
3500 if ($CPAN::Config->{randomize_urllist}
3502 rand(1) < $CPAN::Config->{randomize_urllist}
3504 $urllist->[int rand scalar @$urllist];
3510 #-> sub CPAN::FTP::_get_urllist
3513 $CPAN::Config->{urllist} ||= [];
3514 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3515 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3516 $CPAN::Config->{urllist} = [];
3518 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3519 for my $u (@urllist) {
3520 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3521 if (UNIVERSAL::can($u,"text")) {
3522 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3524 $u .= "/" unless substr($u,-1) eq "/";
3525 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3531 #-> sub CPAN::FTP::ftp_get ;
3533 my($class,$host,$dir,$file,$target) = @_;
3535 qq[Going to fetch file [$file] from dir [$dir]
3536 on host [$host] as local [$target]\n]
3538 my $ftp = Net::FTP->new($host);
3540 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3543 return 0 unless defined $ftp;
3544 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3545 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3546 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
3547 my $msg = $ftp->message;
3548 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3551 unless ( $ftp->cwd($dir) ){
3552 my $msg = $ftp->message;
3553 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3557 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3558 unless ( $ftp->get($file,$target) ){
3559 my $msg = $ftp->message;
3560 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3563 $ftp->quit; # it's ok if this fails
3567 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3569 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3570 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3572 # > *** 1562,1567 ****
3573 # > --- 1562,1580 ----
3574 # > return 1 if substr($url,0,4) eq "file";
3575 # > return 1 unless $url =~ m|://([^/]+)|;
3577 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3579 # > + $proxy =~ m|://([^/:]+)|;
3581 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3582 # > + if ($noproxy) {
3583 # > + if ($host !~ /$noproxy$/) {
3584 # > + $host = $proxy;
3587 # > + $host = $proxy;
3590 # > require Net::Ping;
3591 # > return 1 unless $Net::Ping::VERSION >= 2;
3595 #-> sub CPAN::FTP::localize ;
3597 my($self,$file,$aslocal,$force) = @_;
3599 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3600 unless defined $aslocal;
3601 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3604 if ($^O eq 'MacOS') {
3605 # Comment by AK on 2000-09-03: Uniq short filenames would be
3606 # available in CHECKSUMS file
3607 my($name, $path) = File::Basename::fileparse($aslocal, '');
3608 if (length($name) > 31) {
3619 my $size = 31 - length($suf);
3620 while (length($name) > $size) {
3624 $aslocal = File::Spec->catfile($path, $name);
3628 if (-f $aslocal && -r _ && !($force & 1)){
3630 if ($size = -s $aslocal) {
3631 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3634 # empty file from a previous unsuccessful attempt to download it
3636 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3637 "could not remove.");
3640 my($maybe_restore) = 0;
3642 rename $aslocal, "$aslocal.bak$$";
3646 my($aslocal_dir) = File::Basename::dirname($aslocal);
3647 File::Path::mkpath($aslocal_dir);
3648 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
3649 qq{directory "$aslocal_dir".
3650 I\'ll continue, but if you encounter problems, they may be due
3651 to insufficient permissions.\n}) unless -w $aslocal_dir;
3653 # Inheritance is not easier to manage than a few if/else branches
3654 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3656 CPAN::LWP::UserAgent->config;
3657 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3659 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3663 $Ua->proxy('ftp', $var)
3664 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3665 $Ua->proxy('http', $var)
3666 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3669 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
3671 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
3672 # > use ones that require basic autorization.
3674 # > Example of when I use it manually in my own stuff:
3676 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
3677 # > $req->proxy_authorization_basic("username","password");
3678 # > $res = $ua->request($req);
3682 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3686 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3687 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3690 # Try the list of urls for each single object. We keep a record
3691 # where we did get a file from
3692 my(@reordered,$last);
3693 my $ccurllist = $self->_get_urllist;
3694 $last = $#$ccurllist;
3695 if ($force & 2) { # local cpans probably out of date, don't reorder
3696 @reordered = (0..$last);
3700 (substr($ccurllist->[$b],0,4) eq "file")
3702 (substr($ccurllist->[$a],0,4) eq "file")
3704 defined($ThesiteURL)
3706 ($ccurllist->[$b] eq $ThesiteURL)
3708 ($ccurllist->[$a] eq $ThesiteURL)
3713 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3715 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
3717 @levels = qw/easy hard hardest/;
3719 @levels = qw/easy/ if $^O eq 'MacOS';
3721 local $ENV{FTP_PASSIVE} =
3722 exists $CPAN::Config->{ftp_passive} ?
3723 $CPAN::Config->{ftp_passive} : 1;
3725 my $stats = $self->_new_stats($file);
3726 LEVEL: for $levelno (0..$#levels) {
3727 my $level = $levels[$levelno];
3728 my $method = "host$level";
3729 my @host_seq = $level eq "easy" ?
3730 @reordered : 0..$last; # reordered has CDROM up front
3731 my @urllist = map { $ccurllist->[$_] } @host_seq;
3732 for my $u (@CPAN::Defaultsites) {
3733 push @urllist, $u unless grep { $_ eq $u } @urllist;
3735 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3736 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
3737 if (my $recommend = $self->_recommend_url_for($file)) {
3738 @urllist = grep { $_ ne $recommend } @urllist;
3739 unshift @urllist, $recommend;
3741 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3742 $ret = $self->$method(\@urllist,$file,$aslocal_tempfile,$stats);
3744 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
3745 if ($ret eq $aslocal_tempfile) {
3746 # if we got it exactly as we asked for, only then we
3748 rename $aslocal_tempfile, $aslocal
3749 or $CPAN::Frontend->mydie("Error while trying to rename ".
3750 "'$ret' to '$aslocal': $!");
3753 $Themethod = $level;
3755 # utime $now, $now, $aslocal; # too bad, if we do that, we
3756 # might alter a local mirror
3757 $self->debug("level[$level]") if $CPAN::DEBUG;
3760 unlink $aslocal_tempfile;
3761 last if $CPAN::Signal; # need to cleanup
3765 $stats->{filesize} = -s $ret;
3767 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
3768 $self->_add_to_statistics($stats);
3769 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
3771 unlink "$aslocal.bak$$";
3774 unless ($CPAN::Signal) {
3777 if (@{$CPAN::Config->{urllist}}) {
3779 qq{Please check, if the URLs I found in your configuration file \(}.
3780 join(", ", @{$CPAN::Config->{urllist}}).
3783 push @mess, qq{Your urllist is empty!};
3785 push @mess, qq{The urllist can be edited.},
3786 qq{E.g. with 'o conf urllist push ftp://myurl/'};
3787 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
3788 $CPAN::Frontend->mywarn("Could not fetch $file\n");
3789 $CPAN::Frontend->mysleep(2);
3791 if ($maybe_restore) {
3792 rename "$aslocal.bak$$", $aslocal;
3793 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
3794 $self->ls($aslocal));
3801 my($self,$stats,$method,$url) = @_;
3802 push @{$stats->{attempts}}, {
3809 # package CPAN::FTP;
3811 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3813 HOSTEASY: for $ro_url (@$host_seq) {
3814 $self->_set_attempt($stats,"easy",$ro_url);
3815 my $url .= "$ro_url$file";
3816 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
3817 if ($url =~ /^file:/) {
3819 if ($CPAN::META->has_inst('URI::URL')) {
3820 my $u = URI::URL->new($url);
3822 } else { # works only on Unix, is poorly constructed, but
3823 # hopefully better than nothing.
3824 # RFC 1738 says fileurl BNF is
3825 # fileurl = "file://" [ host | "localhost" ] "/" fpath
3826 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
3828 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
3829 $l =~ s|^file:||; # assume they
3833 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
3835 $self->debug("local file[$l]") if $CPAN::DEBUG;
3836 if ( -f $l && -r _) {
3837 $ThesiteURL = $ro_url;
3840 if ($l =~ /(.+)\.gz$/) {
3842 if ( -f $ungz && -r _) {
3843 $ThesiteURL = $ro_url;
3847 # Maybe mirror has compressed it?
3849 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
3850 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
3852 $ThesiteURL = $ro_url;
3857 $self->debug("it was not a file URL") if $CPAN::DEBUG;
3858 if ($CPAN::META->has_usable('LWP')) {
3859 $CPAN::Frontend->myprint("Fetching with LWP:
3863 CPAN::LWP::UserAgent->config;
3864 eval { $Ua = CPAN::LWP::UserAgent->new; };
3866 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3869 my $res = $Ua->mirror($url, $aslocal);
3870 if ($res->is_success) {
3871 $ThesiteURL = $ro_url;
3873 utime $now, $now, $aslocal; # download time is more
3874 # important than upload
3877 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3878 my $gzurl = "$url.gz";
3879 $CPAN::Frontend->myprint("Fetching with LWP:
3882 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3883 if ($res->is_success) {
3884 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
3885 $ThesiteURL = $ro_url;
3890 $CPAN::Frontend->myprint(sprintf(
3891 "LWP failed with code[%s] message[%s]\n",
3895 # Alan Burlison informed me that in firewall environments
3896 # Net::FTP can still succeed where LWP fails. So we do not
3897 # skip Net::FTP anymore when LWP is available.
3900 $CPAN::Frontend->mywarn(" LWP not available\n");
3902 return if $CPAN::Signal;
3903 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3904 # that's the nice and easy way thanks to Graham
3905 $self->debug("recognized ftp") if $CPAN::DEBUG;
3906 my($host,$dir,$getfile) = ($1,$2,$3);
3907 if ($CPAN::META->has_usable('Net::FTP')) {
3909 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3912 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3913 "aslocal[$aslocal]") if $CPAN::DEBUG;
3914 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3915 $ThesiteURL = $ro_url;
3918 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3919 my $gz = "$aslocal.gz";
3920 $CPAN::Frontend->myprint("Fetching with Net::FTP
3923 if (CPAN::FTP->ftp_get($host,
3927 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
3929 $ThesiteURL = $ro_url;
3935 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
3939 UNIVERSAL::can($ro_url,"text")
3941 $ro_url->{FROM} eq "USER"
3943 ##address #17973: default URLs should not try to override
3944 ##user-defined URLs just because LWP is not available
3945 my $ret = $self->hosthard([$ro_url],$file,$aslocal,$stats);
3946 return $ret if $ret;
3948 return if $CPAN::Signal;
3952 # package CPAN::FTP;
3954 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3956 # Came back if Net::FTP couldn't establish connection (or
3957 # failed otherwise) Maybe they are behind a firewall, but they
3958 # gave us a socksified (or other) ftp program...
3961 my($devnull) = $CPAN::Config->{devnull} || "";
3963 my($aslocal_dir) = File::Basename::dirname($aslocal);
3964 File::Path::mkpath($aslocal_dir);
3965 HOSTHARD: for $ro_url (@$host_seq) {
3966 $self->_set_attempt($stats,"hard",$ro_url);
3967 my $url = "$ro_url$file";
3968 my($proto,$host,$dir,$getfile);
3970 # Courtesy Mark Conty mark_conty@cargill.com change from
3971 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3973 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3974 # proto not yet used
3975 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3977 next HOSTHARD; # who said, we could ftp anything except ftp?
3979 next HOSTHARD if $proto eq "file"; # file URLs would have had
3980 # success above. Likely a bogus URL
3982 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3984 # Try the most capable first and leave ncftp* for last as it only
3986 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3987 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3988 next unless defined $funkyftp;
3989 next if $funkyftp =~ /^\s*$/;
3991 my($asl_ungz, $asl_gz);
3992 ($asl_ungz = $aslocal) =~ s/\.gz//;
3993 $asl_gz = "$asl_ungz.gz";
3995 my($src_switch) = "";
3997 my($stdout_redir) = " > $asl_ungz";
3999 $src_switch = " -source";
4000 } elsif ($f eq "ncftp"){
4001 $src_switch = " -c";
4002 } elsif ($f eq "wget"){
4003 $src_switch = " -O $asl_ungz";
4005 } elsif ($f eq 'curl'){
4006 $src_switch = ' -L -f -s -S --netrc-optional';
4009 if ($f eq "ncftpget"){
4010 $chdir = "cd $aslocal_dir && ";
4013 $CPAN::Frontend->myprint(
4015 Trying with "$funkyftp$src_switch" to get
4019 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
4020 $self->debug("system[$system]") if $CPAN::DEBUG;
4021 my($wstatus) = system($system);
4023 # lynx returns 0 when it fails somewhere
4025 my $content = do { local *FH;
4026 open FH, $asl_ungz or die;
4029 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
4030 $CPAN::Frontend->mywarn(qq{
4031 No success, the file that lynx has has downloaded looks like an error message:
4034 $CPAN::Frontend->mysleep(1);
4038 $CPAN::Frontend->myprint(qq{
4039 No success, the file that lynx has has downloaded is an empty file.
4044 if ($wstatus == 0) {
4047 } elsif ($asl_ungz ne $aslocal) {
4048 # test gzip integrity
4049 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
4050 # e.g. foo.tar is gzipped --> foo.tar.gz
4051 rename $asl_ungz, $aslocal;
4053 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
4056 $ThesiteURL = $ro_url;
4058 } elsif ($url !~ /\.gz(?!\n)\Z/) {
4060 -f $asl_ungz && -s _ == 0;
4061 my $gz = "$aslocal.gz";
4062 my $gzurl = "$url.gz";
4063 $CPAN::Frontend->myprint(
4065 Trying with "$funkyftp$src_switch" to get
4068 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
4069 $self->debug("system[$system]") if $CPAN::DEBUG;
4071 if (($wstatus = system($system)) == 0
4075 # test gzip integrity
4076 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
4077 if ($ct && $ct->gtest) {
4078 $ct->gunzip($aslocal);
4080 # somebody uncompressed file for us?
4081 rename $asl_ungz, $aslocal;
4083 $ThesiteURL = $ro_url;
4086 unlink $asl_gz if -f $asl_gz;
4089 my $estatus = $wstatus >> 8;
4090 my $size = -f $aslocal ?
4091 ", left\n$aslocal with size ".-s _ :
4092 "\nWarning: expected file [$aslocal] doesn't exist";
4093 $CPAN::Frontend->myprint(qq{
4094 System call "$system"
4095 returned status $estatus (wstat $wstatus)$size
4098 return if $CPAN::Signal;
4099 } # transfer programs
4103 # package CPAN::FTP;
4105 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4108 my($aslocal_dir) = File::Basename::dirname($aslocal);
4109 File::Path::mkpath($aslocal_dir);
4110 my $ftpbin = $CPAN::Config->{ftp};
4111 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
4112 $CPAN::Frontend->myprint("No external ftp command available\n\n");
4115 $CPAN::Frontend->mywarn(qq{
4116 As a last ressort we now switch to the external ftp command '$ftpbin'
4119 Doing so often leads to problems that are hard to diagnose.
4121 If you're victim of such problems, please consider unsetting the ftp
4122 config variable with
4128 $CPAN::Frontend->mysleep(2);
4129 HOSTHARDEST: for $ro_url (@$host_seq) {
4130 $self->_set_attempt($stats,"hardest",$ro_url);
4131 my $url = "$ro_url$file";
4132 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
4133 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4136 my($host,$dir,$getfile) = ($1,$2,$3);
4138 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
4139 $ctime,$blksize,$blocks) = stat($aslocal);
4140 $timestamp = $mtime ||= 0;
4141 my($netrc) = CPAN::FTP::netrc->new;
4142 my($netrcfile) = $netrc->netrc;
4143 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
4144 my $targetfile = File::Basename::basename($aslocal);
4150 map("cd $_", split /\//, $dir), # RFC 1738
4152 "get $getfile $targetfile",
4156 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
4157 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
4158 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
4160 $netrc->contains($host))) if $CPAN::DEBUG;
4161 if ($netrc->protected) {
4162 my $dialog = join "", map { " $_\n" } @dialog;
4164 if ($netrc->contains($host)) {
4165 $netrc_explain = "Relying that your .netrc entry for '$host' ".
4166 "manages the login";
4168 $netrc_explain = "Relying that your default .netrc entry ".
4169 "manages the login";
4171 $CPAN::Frontend->myprint(qq{
4172 Trying with external ftp to get
4175 Going to send the dialog
4179 $self->talk_ftp("$ftpbin$verbose $host",
4181 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4182 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4184 if ($mtime > $timestamp) {
4185 $CPAN::Frontend->myprint("GOT $aslocal\n");
4186 $ThesiteURL = $ro_url;
4189 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
4191 return if $CPAN::Signal;
4193 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
4194 qq{correctly protected.\n});
4197 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
4198 nor does it have a default entry\n");
4201 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
4202 # then and login manually to host, using e-mail as
4204 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
4208 "user anonymous $Config::Config{'cf_email'}"
4210 my $dialog = join "", map { " $_\n" } @dialog;
4211 $CPAN::Frontend->myprint(qq{
4212 Trying with external ftp to get
4214 Going to send the dialog
4218 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
4219 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4220 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4222 if ($mtime > $timestamp) {
4223 $CPAN::Frontend->myprint("GOT $aslocal\n");
4224 $ThesiteURL = $ro_url;
4227 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
4229 return if $CPAN::Signal;
4230 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
4231 $CPAN::Frontend->mysleep(2);
4235 # package CPAN::FTP;
4237 my($self,$command,@dialog) = @_;
4238 my $fh = FileHandle->new;
4239 $fh->open("|$command") or die "Couldn't open ftp: $!";
4240 foreach (@dialog) { $fh->print("$_\n") }
4241 $fh->close; # Wait for process to complete
4243 my $estatus = $wstatus >> 8;
4244 $CPAN::Frontend->myprint(qq{
4245 Subprocess "|$command"
4246 returned status $estatus (wstat $wstatus)
4250 # find2perl needs modularization, too, all the following is stolen
4254 my($self,$name) = @_;
4255 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
4256 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
4258 my($perms,%user,%group);
4262 $blocks = int(($blocks + 1) / 2);
4265 $blocks = int(($sizemm + 1023) / 1024);
4268 if (-f _) { $perms = '-'; }
4269 elsif (-d _) { $perms = 'd'; }
4270 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
4271 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
4272 elsif (-p _) { $perms = 'p'; }
4273 elsif (-S _) { $perms = 's'; }
4274 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
4276 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
4277 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
4278 my $tmpmode = $mode;
4279 my $tmp = $rwx[$tmpmode & 7];
4281 $tmp = $rwx[$tmpmode & 7] . $tmp;
4283 $tmp = $rwx[$tmpmode & 7] . $tmp;
4284 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
4285 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
4286 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
4289 my $user = $user{$uid} || $uid; # too lazy to implement lookup
4290 my $group = $group{$gid} || $gid;
4292 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4294 my($moname) = $moname[$mon];
4295 if (-M _ > 365.25 / 2) {
4296 $timeyear = $year + 1900;
4299 $timeyear = sprintf("%02d:%02d", $hour, $min);
4302 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
4316 package CPAN::FTP::netrc;
4319 # package CPAN::FTP::netrc;
4322 my $home = CPAN::HandleConfig::home;
4323 my $file = File::Spec->catfile($home,".netrc");
4325 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4326 $atime,$mtime,$ctime,$blksize,$blocks)
4331 my($fh,@machines,$hasdefault);
4333 $fh = FileHandle->new or die "Could not create a filehandle";
4335 if($fh->open($file)){
4336 $protected = ($mode & 077) == 0;
4338 NETRC: while (<$fh>) {
4339 my(@tokens) = split " ", $_;
4340 TOKEN: while (@tokens) {
4341 my($t) = shift @tokens;
4342 if ($t eq "default"){
4346 last TOKEN if $t eq "macdef";
4347 if ($t eq "machine") {
4348 push @machines, shift @tokens;
4353 $file = $hasdefault = $protected = "";
4357 'mach' => [@machines],
4359 'hasdefault' => $hasdefault,
4360 'protected' => $protected,
4364 # CPAN::FTP::netrc::hasdefault;
4365 sub hasdefault { shift->{'hasdefault'} }
4366 sub netrc { shift->{'netrc'} }
4367 sub protected { shift->{'protected'} }
4369 my($self,$mach) = @_;
4370 for ( @{$self->{'mach'}} ) {
4371 return 1 if $_ eq $mach;
4376 package CPAN::Complete;
4380 my($text, $line, $start, $end) = @_;
4381 my(@perlret) = cpl($text, $line, $start);
4382 # find longest common match. Can anybody show me how to peruse
4383 # T::R::Gnu to have this done automatically? Seems expensive.
4384 return () unless @perlret;
4385 my($newtext) = $text;
4386 for (my $i = length($text)+1;;$i++) {
4387 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4388 my $try = substr($perlret[0],0,$i);
4389 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4390 # warn "try[$try]tries[@tries]";
4391 if (@tries == @perlret) {
4397 ($newtext,@perlret);
4400 #-> sub CPAN::Complete::cpl ;
4402 my($word,$line,$pos) = @_;
4406 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4408 if ($line =~ s/^((?:notest|f?force)\s*)//) {
4413 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
4414 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4416 } elsif ($line =~ /^(a|ls)\s/) {
4417 @return = cplx('CPAN::Author',uc($word));
4418 } elsif ($line =~ /^b\s/) {
4419 CPAN::Shell->local_bundles;
4420 @return = cplx('CPAN::Bundle',$word);
4421 } elsif ($line =~ /^d\s/) {
4422 @return = cplx('CPAN::Distribution',$word);
4423 } elsif ($line =~ m/^(
4424 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4426 if ($word =~ /^Bundle::/) {
4427 CPAN::Shell->local_bundles;
4429 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4430 } elsif ($line =~ /^i\s/) {
4431 @return = cpl_any($word);
4432 } elsif ($line =~ /^reload\s/) {
4433 @return = cpl_reload($word,$line,$pos);
4434 } elsif ($line =~ /^o\s/) {
4435 @return = cpl_option($word,$line,$pos);
4436 } elsif ($line =~ m/^\S+\s/ ) {
4437 # fallback for future commands and what we have forgotten above
4438 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4445 #-> sub CPAN::Complete::cplx ;
4447 my($class, $word) = @_;
4448 if (CPAN::_sqlite_running) {
4449 $CPAN::SQLite->search($class, "^\Q$word\E");
4451 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
4454 #-> sub CPAN::Complete::cpl_any ;
4458 cplx('CPAN::Author',$word),
4459 cplx('CPAN::Bundle',$word),
4460 cplx('CPAN::Distribution',$word),
4461 cplx('CPAN::Module',$word),
4465 #-> sub CPAN::Complete::cpl_reload ;
4467 my($word,$line,$pos) = @_;
4469 my(@words) = split " ", $line;
4470 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4471 my(@ok) = qw(cpan index);
4472 return @ok if @words == 1;
4473 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4476 #-> sub CPAN::Complete::cpl_option ;
4478 my($word,$line,$pos) = @_;
4480 my(@words) = split " ", $line;
4481 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4482 my(@ok) = qw(conf debug);
4483 return @ok if @words == 1;
4484 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4486 } elsif ($words[1] eq 'index') {
4488 } elsif ($words[1] eq 'conf') {
4489 return CPAN::HandleConfig::cpl(@_);
4490 } elsif ($words[1] eq 'debug') {
4491 return sort grep /^\Q$word\E/i,
4492 sort keys %CPAN::DEBUG, 'all';
4496 package CPAN::Index;
4499 #-> sub CPAN::Index::force_reload ;
4502 $CPAN::Index::LAST_TIME = 0;
4506 #-> sub CPAN::Index::reload ;
4508 my($self,$force) = @_;
4511 # XXX check if a newer one is available. (We currently read it
4512 # from time to time)
4513 for ($CPAN::Config->{index_expire}) {
4514 $_ = 0.001 unless $_ && $_ > 0.001;
4516 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4517 # debug here when CPAN doesn't seem to read the Metadata
4519 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4521 unless ($CPAN::META->{PROTOCOL}) {
4522 $self->read_metadata_cache;
4523 $CPAN::META->{PROTOCOL} ||= "1.0";
4525 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4526 # warn "Setting last_time to 0";
4527 $LAST_TIME = 0; # No warning necessary
4529 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4532 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4534 # IFF we are developing, it helps to wipe out the memory
4535 # between reloads, otherwise it is not what a user expects.
4536 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4537 $CPAN::META = CPAN->new;
4540 local $LAST_TIME = $time;
4541 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4543 my $needshort = $^O eq "dos";
4545 $self->rd_authindex($self
4547 "authors/01mailrc.txt.gz",
4549 File::Spec->catfile('authors', '01mailrc.gz') :
4550 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4553 $debug = "timing reading 01[".($t2 - $time)."]";
4555 return if $CPAN::Signal; # this is sometimes lengthy
4556 $self->rd_modpacks($self
4558 "modules/02packages.details.txt.gz",
4560 File::Spec->catfile('modules', '02packag.gz') :
4561 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4564 $debug .= "02[".($t2 - $time)."]";
4566 return if $CPAN::Signal; # this is sometimes lengthy
4567 $self->rd_modlist($self
4569 "modules/03modlist.data.gz",
4571 File::Spec->catfile('modules', '03mlist.gz') :
4572 File::Spec->catfile('modules', '03modlist.data.gz'),
4574 $self->write_metadata_cache;
4576 $debug .= "03[".($t2 - $time)."]";
4578 CPAN->debug($debug) if $CPAN::DEBUG;
4580 if ($CPAN::Config->{build_dir_reuse}) {
4581 $self->reanimate_build_dir;
4583 if (CPAN::_sqlite_running) {
4584 $CPAN::SQLite->reload(time => $time, force => $force)
4588 $CPAN::META->{PROTOCOL} = PROTOCOL;
4591 #-> sub CPAN::Index::reanimate_build_dir ;
4592 sub reanimate_build_dir {
4594 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4597 return if $HAVE_REANIMATED++;
4598 my $d = $CPAN::Config->{build_dir};
4599 my $dh = DirHandle->new;
4600 opendir $dh, $d or return; # does not exist
4605 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4606 my @candidates = map { $_->[0] }
4607 sort { $b->[1] <=> $a->[1] }
4608 map { [ $_, -M File::Spec->catfile($d,$_) ] }
4609 grep {/\.yml$/} readdir $dh;
4610 DISTRO: for $i (0..$#candidates) {
4611 my $dirent = $candidates[$i];
4612 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
4614 warn "Error while parsing file '$dirent'; error: '$@'";
4618 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4619 my $key = $c->{distribution}{ID};
4620 for my $k (keys %{$c->{distribution}}) {
4621 if ($c->{distribution}{$k}
4622 && ref $c->{distribution}{$k}
4623 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4624 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
4628 #we tried to restore only if element already
4629 #exists; but then we do not work with metadata
4632 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
4633 = $c->{distribution};
4634 for my $skipper (qw(badtestcnt notest force_update)) {
4635 delete $do->{$skipper};
4638 if ($do->{make_test}
4640 && !$do->{make_test}->failed
4644 $do->{install}->failed
4647 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
4652 while (($painted/76) < ($i/@candidates)) {
4653 $CPAN::Frontend->myprint(".");
4657 $CPAN::Frontend->myprint(sprintf(
4658 "DONE\nFound %s old build%s, restored the state of %s\n",
4659 @candidates ? sprintf("%d",scalar @candidates) : "no",
4660 @candidates==1 ? "" : "s",
4661 $restored || "none",
4666 #-> sub CPAN::Index::reload_x ;
4668 my($cl,$wanted,$localname,$force) = @_;
4669 $force |= 2; # means we're dealing with an index here
4670 CPAN::HandleConfig->load; # we should guarantee loading wherever
4671 # we rely on Config XXX
4672 $localname ||= $wanted;
4673 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
4677 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
4680 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
4681 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
4682 qq{day$s. I\'ll use that.});
4685 $force |= 1; # means we're quite serious about it.
4687 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
4690 #-> sub CPAN::Index::rd_authindex ;
4692 my($cl, $index_target) = @_;
4693 return unless defined $index_target;
4694 return if CPAN::_sqlite_running;
4696 $CPAN::Frontend->myprint("Going to read $index_target\n");
4698 tie *FH, 'CPAN::Tarzip', $index_target;
4701 push @lines, split /\012/ while <FH>;
4705 my($userid,$fullname,$email) =
4706 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
4707 $fullname ||= $email;
4708 if ($userid && $fullname && $email){
4709 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
4710 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
4712 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
4715 while (($painted/76) < ($i/@lines)) {
4716 $CPAN::Frontend->myprint(".");
4719 return if $CPAN::Signal;
4721 $CPAN::Frontend->myprint("DONE\n");
4725 my($self,$dist) = @_;
4726 $dist = $self->{'id'} unless defined $dist;
4727 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
4731 #-> sub CPAN::Index::rd_modpacks ;
4733 my($self, $index_target) = @_;
4734 return unless defined $index_target;
4735 return if CPAN::_sqlite_running;
4736 $CPAN::Frontend->myprint("Going to read $index_target\n");
4737 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4739 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
4742 while (my $bytes = $fh->READ(\$chunk,8192)) {
4745 my @lines = split /\012/, $slurp;
4746 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
4749 my($line_count,$last_updated);
4751 my $shift = shift(@lines);
4752 last if $shift =~ /^\s*$/;
4753 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
4754 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
4756 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
4757 if (not defined $line_count) {
4759 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
4760 Please check the validity of the index file by comparing it to more
4761 than one CPAN mirror. I'll continue but problems seem likely to
4765 $CPAN::Frontend->mysleep(5);
4766 } elsif ($line_count != scalar @lines) {
4768 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
4769 contains a Line-Count header of %d but I see %d lines there. Please
4770 check the validity of the index file by comparing it to more than one
4771 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
4772 $index_target, $line_count, scalar(@lines));
4775 if (not defined $last_updated) {
4777 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
4778 Please check the validity of the index file by comparing it to more
4779 than one CPAN mirror. I'll continue but problems seem likely to
4783 $CPAN::Frontend->mysleep(5);
4787 ->myprint(sprintf qq{ Database was generated on %s\n},
4789 $DATE_OF_02 = $last_updated;
4792 if ($CPAN::META->has_inst('HTTP::Date')) {
4794 $age -= HTTP::Date::str2time($last_updated);
4796 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
4797 require Time::Local;
4798 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
4799 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
4800 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
4807 qq{Warning: This index file is %d days old.
4808 Please check the host you chose as your CPAN mirror for staleness.
4809 I'll continue but problems seem likely to happen.\a\n},
4812 } elsif ($age < -1) {
4816 qq{Warning: Your system date is %d days behind this index file!
4818 Timestamp index file: %s
4819 Please fix your system time, problems with the make command expected.\n},
4829 # A necessity since we have metadata_cache: delete what isn't
4831 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
4832 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
4837 # before 1.56 we split into 3 and discarded the rest. From
4838 # 1.57 we assign remaining text to $comment thus allowing to
4839 # influence isa_perl
4840 my($mod,$version,$dist,$comment) = split " ", $_, 4;
4841 my($bundle,$id,$userid);
4843 if ($mod eq 'CPAN' &&
4845 CPAN::Queue->exists('Bundle::CPAN') ||
4846 CPAN::Queue->exists('CPAN')
4850 if ($version > $CPAN::VERSION){
4851 $CPAN::Frontend->mywarn(qq{
4852 New CPAN.pm version (v$version) available.
4853 [Currently running version is v$CPAN::VERSION]
4854 You might want to try
4857 to both upgrade CPAN.pm and run the new version without leaving
4858 the current session.
4861 $CPAN::Frontend->mysleep(2);
4862 $CPAN::Frontend->myprint(qq{\n});
4864 last if $CPAN::Signal;
4865 } elsif ($mod =~ /^Bundle::(.*)/) {
4870 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
4871 # Let's make it a module too, because bundles have so much
4872 # in common with modules.
4874 # Changed in 1.57_63: seems like memory bloat now without
4875 # any value, so commented out
4877 # $CPAN::META->instance('CPAN::Module',$mod);
4881 # instantiate a module object
4882 $id = $CPAN::META->instance('CPAN::Module',$mod);
4886 # Although CPAN prohibits same name with different version the
4887 # indexer may have changed the version for the same distro
4888 # since the last time ("Force Reindexing" feature)
4889 if ($id->cpan_file ne $dist
4891 $id->cpan_version ne $version
4893 $userid = $id->userid || $self->userid($dist);
4895 'CPAN_USERID' => $userid,
4896 'CPAN_VERSION' => $version,
4897 'CPAN_FILE' => $dist,
4901 # instantiate a distribution object
4902 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
4903 # we do not need CONTAINSMODS unless we do something with
4904 # this dist, so we better produce it on demand.
4906 ## my $obj = $CPAN::META->instance(
4907 ## 'CPAN::Distribution' => $dist
4909 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
4911 $CPAN::META->instance(
4912 'CPAN::Distribution' => $dist
4914 'CPAN_USERID' => $userid,
4915 'CPAN_COMMENT' => $comment,
4919 for my $name ($mod,$dist) {
4920 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
4921 $exists{$name} = undef;
4925 while (($painted/76) < ($i/@lines)) {
4926 $CPAN::Frontend->myprint(".");
4929 return if $CPAN::Signal;
4931 $CPAN::Frontend->myprint("DONE\n");
4933 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
4934 for my $o ($CPAN::META->all_objects($class)) {
4935 next if exists $exists{$o->{ID}};
4936 $CPAN::META->delete($class,$o->{ID});
4937 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
4944 #-> sub CPAN::Index::rd_modlist ;
4946 my($cl,$index_target) = @_;
4947 return unless defined $index_target;
4948 return if CPAN::_sqlite_running;
4949 $CPAN::Frontend->myprint("Going to read $index_target\n");
4950 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4954 while (my $bytes = $fh->READ(\$chunk,8192)) {
4957 my @eval2 = split /\012/, $slurp;
4960 my $shift = shift(@eval2);
4961 if ($shift =~ /^Date:\s+(.*)/){
4962 if ($DATE_OF_03 eq $1){
4963 $CPAN::Frontend->myprint("Unchanged.\n");
4968 last if $shift =~ /^\s*$/;
4970 push @eval2, q{CPAN::Modulelist->data;};
4972 my($comp) = Safe->new("CPAN::Safe1");
4973 my($eval2) = join("\n", @eval2);
4974 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4975 my $ret = $comp->reval($eval2);
4976 Carp::confess($@) if $@;
4977 return if $CPAN::Signal;
4979 my $until = keys(%$ret);
4981 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4983 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4984 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4985 $obj->set(%{$ret->{$_}});
4987 while (($painted/76) < ($i/$until)) {
4988 $CPAN::Frontend->myprint(".");
4991 return if $CPAN::Signal;
4993 $CPAN::Frontend->myprint("DONE\n");
4996 #-> sub CPAN::Index::write_metadata_cache ;
4997 sub write_metadata_cache {
4999 return unless $CPAN::Config->{'cache_metadata'};
5000 return if CPAN::_sqlite_running;
5001 return unless $CPAN::META->has_usable("Storable");
5003 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
5004 CPAN::Distribution)) {
5005 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
5007 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5008 $cache->{last_time} = $LAST_TIME;
5009 $cache->{DATE_OF_02} = $DATE_OF_02;
5010 $cache->{PROTOCOL} = PROTOCOL;
5011 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
5012 eval { Storable::nstore($cache, $metadata_file) };
5013 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5016 #-> sub CPAN::Index::read_metadata_cache ;
5017 sub read_metadata_cache {
5019 return unless $CPAN::Config->{'cache_metadata'};
5020 return if CPAN::_sqlite_running;
5021 return unless $CPAN::META->has_usable("Storable");
5022 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
5023 return unless -r $metadata_file and -f $metadata_file;
5024 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
5026 eval { $cache = Storable::retrieve($metadata_file) };
5027 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
5028 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
5032 if (exists $cache->{PROTOCOL}) {
5033 if (PROTOCOL > $cache->{PROTOCOL}) {
5034 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
5035 "with protocol v%s, requiring v%s\n",
5042 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
5043 "with protocol v1.0\n");
5048 while(my($class,$v) = each %$cache) {
5049 next unless $class =~ /^CPAN::/;
5050 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
5051 while (my($id,$ro) = each %$v) {
5052 $CPAN::META->{readwrite}{$class}{$id} ||=
5053 $class->new(ID=>$id, RO=>$ro);
5058 unless ($clcnt) { # sanity check
5059 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
5062 if ($idcnt < 1000) {
5063 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
5064 "in $metadata_file\n");
5067 $CPAN::META->{PROTOCOL} ||=
5068 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
5069 # does initialize to some protocol
5070 $LAST_TIME = $cache->{last_time};
5071 $DATE_OF_02 = $cache->{DATE_OF_02};
5072 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
5073 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
5077 package CPAN::InfoObj;
5082 exists $self->{RO} and return $self->{RO};
5085 #-> sub CPAN::InfoObj::cpan_userid
5090 return $ro->{CPAN_USERID} || "N/A";
5092 $self->debug("ID[$self->{ID}]");
5093 # N/A for bundles found locally
5098 sub id { shift->{ID}; }
5100 #-> sub CPAN::InfoObj::new ;
5102 my $this = bless {}, shift;
5107 # The set method may only be used by code that reads index data or
5108 # otherwise "objective" data from the outside world. All session
5109 # related material may do anything else with instance variables but
5110 # must not touch the hash under the RO attribute. The reason is that
5111 # the RO hash gets written to Metadata file and is thus persistent.
5113 #-> sub CPAN::InfoObj::safe_chdir ;
5115 my($self,$todir) = @_;
5116 # we die if we cannot chdir and we are debuggable
5117 Carp::confess("safe_chdir called without todir argument")
5118 unless defined $todir and length $todir;
5120 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5124 unless (-x $todir) {
5125 unless (chmod 0755, $todir) {
5126 my $cwd = CPAN::anycwd();
5127 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
5128 "permission to change the permission; cannot ".
5129 "chdir to '$todir'\n");
5130 $CPAN::Frontend->mysleep(5);
5131 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5132 qq{to todir[$todir]: $!});
5136 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
5139 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5142 my $cwd = CPAN::anycwd();
5143 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5144 qq{to todir[$todir] (a chmod has been issued): $!});
5149 #-> sub CPAN::InfoObj::set ;
5151 my($self,%att) = @_;
5152 my $class = ref $self;
5154 # This must be ||=, not ||, because only if we write an empty
5155 # reference, only then the set method will write into the readonly
5156 # area. But for Distributions that spring into existence, maybe
5157 # because of a typo, we do not like it that they are written into
5158 # the readonly area and made permanent (at least for a while) and
5159 # that is why we do not "allow" other places to call ->set.
5160 unless ($self->id) {
5161 CPAN->debug("Bug? Empty ID, rejecting");
5164 my $ro = $self->{RO} =
5165 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
5167 while (my($k,$v) = each %att) {
5172 #-> sub CPAN::InfoObj::as_glimpse ;
5176 my $class = ref($self);
5177 $class =~ s/^CPAN:://;
5178 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
5179 push @m, sprintf "%-15s %s\n", $class, $id;
5183 #-> sub CPAN::InfoObj::as_string ;
5187 my $class = ref($self);
5188 $class =~ s/^CPAN:://;
5189 push @m, $class, " id = $self->{ID}\n";
5191 unless ($ro = $self->ro) {
5192 if (substr($self->{ID},-1,1) eq ".") { # directory
5195 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
5198 for (sort keys %$ro) {
5199 # next if m/^(ID|RO)$/;
5201 if ($_ eq "CPAN_USERID") {
5203 $extra .= $self->fullname;
5204 my $email; # old perls!
5205 if ($email = $CPAN::META->instance("CPAN::Author",
5208 $extra .= " <$email>";
5210 $extra .= " <no email>";
5213 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
5214 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
5217 next unless defined $ro->{$_};
5218 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
5220 KEY: for (sort keys %$self) {
5221 next if m/^(ID|RO)$/;
5222 unless (defined $self->{$_}) {
5226 if (ref($self->{$_}) eq "ARRAY") {
5227 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
5228 } elsif (ref($self->{$_}) eq "HASH") {
5230 if (/^CONTAINSMODS$/) {
5231 $value = join(" ",sort keys %{$self->{$_}});
5232 } elsif (/^prereq_pm$/) {
5234 my $v = $self->{$_};
5235 for my $x (sort keys %$v) {
5237 for my $y (sort keys %{$v->{$x}}) {
5238 push @svalue, "$y=>$v->{$x}{$y}";
5240 push @value, "$x\:" . join ",", @svalue if @svalue;
5242 $value = join ";", @value;
5244 $value = $self->{$_};
5252 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
5258 #-> sub CPAN::InfoObj::fullname ;
5261 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
5264 #-> sub CPAN::InfoObj::dump ;
5266 my($self, $what) = @_;
5267 unless ($CPAN::META->has_inst("Data::Dumper")) {
5268 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
5270 local $Data::Dumper::Sortkeys;
5271 $Data::Dumper::Sortkeys = 1;
5272 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
5273 if (length $out > 100000) {
5274 my $fh_pager = FileHandle->new;
5275 local($SIG{PIPE}) = "IGNORE";
5276 my $pager = $CPAN::Config->{'pager'} || "cat";
5277 $fh_pager->open("|$pager")
5278 or die "Could not open pager $pager\: $!";
5279 $fh_pager->print($out);
5282 $CPAN::Frontend->myprint($out);
5286 package CPAN::Author;
5289 #-> sub CPAN::Author::force
5295 #-> sub CPAN::Author::force
5298 delete $self->{force};
5301 #-> sub CPAN::Author::id
5304 my $id = $self->{ID};
5305 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
5309 #-> sub CPAN::Author::as_glimpse ;
5313 my $class = ref($self);
5314 $class =~ s/^CPAN:://;
5315 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
5323 #-> sub CPAN::Author::fullname ;
5325 shift->ro->{FULLNAME};
5329 #-> sub CPAN::Author::email ;
5330 sub email { shift->ro->{EMAIL}; }
5332 #-> sub CPAN::Author::ls ;
5335 my $glob = shift || "";
5336 my $silent = shift || 0;
5339 # adapted from CPAN::Distribution::verifyCHECKSUM ;
5340 my(@csf); # chksumfile
5341 @csf = $self->id =~ /(.)(.)(.*)/;
5342 $csf[1] = join "", @csf[0,1];
5343 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
5345 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
5346 unless (grep {$_->[2] eq $csf[1]} @dl) {
5347 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
5350 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
5351 unless (grep {$_->[2] eq $csf[2]} @dl) {
5352 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5355 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5357 if ($CPAN::META->has_inst("Text::Glob")) {
5358 my $rglob = Text::Glob::glob_to_regex($glob);
5359 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5361 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5364 $CPAN::Frontend->myprint(join "", map {
5365 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5366 } sort { $a->[2] cmp $b->[2] } @dl);
5370 # returns an array of arrays, the latter contain (size,mtime,filename)
5371 #-> sub CPAN::Author::dir_listing ;
5374 my $chksumfile = shift;
5375 my $recursive = shift;
5376 my $may_ftp = shift;
5379 File::Spec->catfile($CPAN::Config->{keep_source_where},
5380 "authors", "id", @$chksumfile);
5384 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5385 # hazard. (Without GPG installed they are not that much better,
5387 $fh = FileHandle->new;
5388 if (open($fh, $lc_want)) {
5389 my $line = <$fh>; close $fh;
5390 unlink($lc_want) unless $line =~ /PGP/;
5394 # connect "force" argument with "index_expire".
5395 my $force = $self->{force};
5396 if (my @stat = stat $lc_want) {
5397 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5401 $lc_file = CPAN::FTP->localize(
5402 "authors/id/@$chksumfile",
5407 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5408 $chksumfile->[-1] .= ".gz";
5409 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5412 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5413 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
5419 $lc_file = $lc_want;
5420 # we *could* second-guess and if the user has a file: URL,
5421 # then we could look there. But on the other hand, if they do
5422 # have a file: URL, wy did they choose to set
5423 # $CPAN::Config->{show_upload_date} to false?
5426 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
5427 $fh = FileHandle->new;
5429 if (open $fh, $lc_file){
5432 $eval =~ s/\015?\012/\n/g;
5434 my($comp) = Safe->new();
5435 $cksum = $comp->reval($eval);
5437 rename $lc_file, "$lc_file.bad";
5438 Carp::confess($@) if $@;
5440 } elsif ($may_ftp) {
5441 Carp::carp "Could not open '$lc_file' for reading.";
5443 # Maybe should warn: "You may want to set show_upload_date to a true value"
5447 for $f (sort keys %$cksum) {
5448 if (exists $cksum->{$f}{isdir}) {
5450 my(@dir) = @$chksumfile;
5452 push @dir, $f, "CHECKSUMS";
5454 [$_->[0], $_->[1], "$f/$_->[2]"]
5455 } $self->dir_listing(\@dir,1,$may_ftp);
5457 push @result, [ 0, "-", $f ];
5461 ($cksum->{$f}{"size"}||0),
5462 $cksum->{$f}{"mtime"}||"---",
5470 package CPAN::Distribution;
5476 my $ro = $self->ro or return;
5480 # CPAN::Distribution::undelay
5483 delete $self->{later};
5486 # add the A/AN/ stuff
5487 # CPAN::Distribution::normalize
5490 $s = $self->id unless defined $s;
5491 if (substr($s,-1,1) eq ".") {
5492 # using a global because we are sometimes called as static method
5493 if (!$CPAN::META->{LOCK}
5494 && !$CPAN::Have_warned->{"$s is unlocked"}++
5496 $CPAN::Frontend->mywarn("You are visiting the local directory
5498 without lock, take care that concurrent processes do not do likewise.\n");
5499 $CPAN::Frontend->mysleep(1);
5502 $s = "$CPAN::iCwd/.";
5503 } elsif (File::Spec->file_name_is_absolute($s)) {
5504 } elsif (File::Spec->can("rel2abs")) {
5505 $s = File::Spec->rel2abs($s);
5507 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5509 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5510 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5511 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5512 $_->{build_dir} = $s;
5513 $_->{archived} = "local_directory";
5514 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5520 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5522 return $s if $s =~ m:^N/A|^Contact Author: ;
5523 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5524 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5525 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5530 #-> sub CPAN::Distribution::author ;
5534 if (substr($self->id,-1,1) eq ".") {
5535 $authorid = "LOCAL";
5537 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5539 CPAN::Shell->expand("Author",$authorid);
5542 # tries to get the yaml from CPAN instead of the distro itself:
5543 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5546 my $meta = $self->pretty_id;
5547 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5548 my(@ls) = CPAN::Shell->globls($meta);
5549 my $norm = $self->normalize($meta);
5553 File::Spec->catfile(
5554 $CPAN::Config->{keep_source_where},
5559 $self->debug("Doing localize") if $CPAN::DEBUG;
5560 unless ($local_file =
5561 CPAN::FTP->localize("authors/id/$norm",
5563 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5565 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5568 #-> sub CPAN::Distribution::cpan_userid
5571 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5574 return $self->SUPER::cpan_userid;
5577 #-> sub CPAN::Distribution::pretty_id
5581 return $id unless $id =~ m|^./../|;
5585 # mark as dirty/clean for the sake of recursion detection. $color=1
5586 # means "in use", $color=0 means "not in use anymore". $color=2 means
5587 # we have determined prereqs now and thus insist on passing this
5588 # through (at least) once again.
5590 #-> sub CPAN::Distribution::color_cmd_tmps ;
5591 sub color_cmd_tmps {
5593 my($depth) = shift || 0;
5594 my($color) = shift || 0;
5595 my($ancestors) = shift || [];
5596 # a distribution needs to recurse into its prereq_pms
5598 return if exists $self->{incommandcolor}
5600 && $self->{incommandcolor}==$color;
5601 if ($depth>=$CPAN::MAX_RECURSION){
5602 die(CPAN::Exception::RecursiveDependency->new($ancestors));
5604 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5605 my $prereq_pm = $self->prereq_pm;
5606 if (defined $prereq_pm) {
5607 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5608 keys %{$prereq_pm->{build_requires}||{}}) {
5609 next PREREQ if $pre eq "perl";
5611 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5612 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5613 $CPAN::Frontend->mysleep(2);
5616 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5620 delete $self->{sponsored_mods};
5622 # as we are at the end of a command, we'll give up this
5623 # reminder of a broken test. Other commands may test this guy
5624 # again. Maybe 'badtestcnt' should be renamed to
5625 # 'make_test_failed_within_command'?
5626 delete $self->{badtestcnt};
5628 $self->{incommandcolor} = $color;
5631 #-> sub CPAN::Distribution::as_string ;
5634 $self->containsmods;
5636 $self->SUPER::as_string(@_);
5639 #-> sub CPAN::Distribution::containsmods ;
5642 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
5643 my $dist_id = $self->{ID};
5644 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
5645 my $mod_file = $mod->cpan_file or next;
5646 my $mod_id = $mod->{ID} or next;
5647 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
5649 if ($CPAN::Signal) {
5650 delete $self->{CONTAINSMODS};
5653 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
5655 keys %{$self->{CONTAINSMODS}||{}};
5658 #-> sub CPAN::Distribution::upload_date ;
5661 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
5662 my(@local_wanted) = split(/\//,$self->id);
5663 my $filename = pop @local_wanted;
5664 push @local_wanted, "CHECKSUMS";
5665 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
5666 return unless $author;
5667 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
5669 my($dirent) = grep { $_->[2] eq $filename } @dl;
5670 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
5671 return unless $dirent->[1];
5672 return $self->{UPLOAD_DATE} = $dirent->[1];
5675 #-> sub CPAN::Distribution::uptodate ;
5679 foreach $c ($self->containsmods) {
5680 my $obj = CPAN::Shell->expandany($c);
5681 unless ($obj->uptodate){
5682 my $id = $self->pretty_id;
5683 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
5690 #-> sub CPAN::Distribution::called_for ;
5693 $self->{CALLED_FOR} = $id if defined $id;
5694 return $self->{CALLED_FOR};
5697 #-> sub CPAN::Distribution::get ;
5700 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
5701 if (my $goto = $self->prefs->{goto}) {
5702 $CPAN::Frontend->mywarn
5704 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
5706 $self->{prefs_file},
5707 $self->{prefs_file_doc},
5709 return $self->goto($goto);
5711 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5713 : ($ENV{PERLLIB} || "");
5715 $CPAN::META->set_perl5lib;
5716 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5720 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
5721 if ($self->prefs->{disabled}) {
5723 "Disabled via prefs file '%s' doc %d",
5724 $self->{prefs_file},
5725 $self->{prefs_file_doc},
5728 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $why");
5729 # note: not intended to be persistent but at least visible
5730 # during this session
5732 if (exists $self->{build_dir} && -d $self->{build_dir}) {
5733 # this deserves print, not warn:
5734 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
5735 "$self->{build_dir}\n"
5740 # although we talk about 'force' we shall not test on
5741 # force directly. New model of force tries to refrain from
5742 # direct checking of force.
5743 exists $self->{unwrapped} and (
5744 UNIVERSAL::can($self->{unwrapped},"failed") ?
5745 $self->{unwrapped}->failed :
5746 $self->{unwrapped} =~ /^NO/
5748 and push @e, "Unwrapping had some problem, won't try again without force";
5751 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e) and return if @e;
5753 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
5756 # Get the file on local disk
5761 File::Spec->catfile(
5762 $CPAN::Config->{keep_source_where},
5765 split(/\//,$self->id)
5768 $self->debug("Doing localize") if $CPAN::DEBUG;
5769 unless ($local_file =
5770 CPAN::FTP->localize("authors/id/$self->{ID}",
5773 if ($CPAN::Index::DATE_OF_02) {
5774 $note = "Note: Current database in memory was generated ".
5775 "on $CPAN::Index::DATE_OF_02\n";
5777 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
5780 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
5781 $self->{localfile} = $local_file;
5782 return if $CPAN::Signal;
5787 if ($CPAN::META->has_inst("Digest::SHA")) {
5788 $self->debug("Digest::SHA is installed, verifying");
5789 $self->verifyCHECKSUM;
5791 $self->debug("Digest::SHA is NOT installed");
5793 return if $CPAN::Signal;
5796 # Create a clean room and go there
5798 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
5799 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
5800 $self->safe_chdir($builddir);
5801 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
5802 File::Path::rmtree("tmp-$$");
5803 unless (mkdir "tmp-$$", 0755) {
5804 $CPAN::Frontend->unrecoverable_error(<<EOF);
5805 Couldn't mkdir '$builddir/tmp-$$': $!
5807 Cannot continue: Please find the reason why I cannot make the
5810 and fix the problem, then retry.
5815 $self->safe_chdir($sub_wd);
5818 $self->safe_chdir("tmp-$$");
5823 my $ct = eval{CPAN::Tarzip->new($local_file)};
5825 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
5826 delete $self->{build_dir};
5829 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
5830 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
5831 $self->untar_me($ct);
5832 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
5833 $self->unzip_me($ct);
5835 $self->{was_uncompressed}++ unless $ct->gtest();
5836 $local_file = $self->handle_singlefile($local_file);
5839 # we are still in the tmp directory!
5840 # Let's check if the package has its own directory.
5841 my $dh = DirHandle->new(File::Spec->curdir)
5842 or Carp::croak("Couldn't opendir .: $!");
5843 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
5846 # XXX here we want in each branch File::Temp to protect all build_dir directories
5847 if (CPAN->has_inst("File::Temp")) {
5851 if (@readdir == 1 && -d $readdir[0]) {
5852 $tdir_base = $readdir[0];
5853 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
5854 my $dh2 = DirHandle->new($from_dir)
5855 or Carp::croak("Couldn't opendir $from_dir: $!");
5856 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
5858 my $userid = $self->cpan_userid;
5859 CPAN->debug("userid[$userid]");
5860 if (!$userid or $userid eq "N/A") {
5863 $tdir_base = $userid;
5864 $from_dir = File::Spec->curdir;
5865 @dirents = @readdir;
5867 $packagedir = File::Temp::tempdir(
5868 "$tdir_base-XXXXXX",
5873 for $f (@dirents) { # is already without "." and ".."
5874 my $from = File::Spec->catdir($from_dir,$f);
5875 my $to = File::Spec->catdir($packagedir,$f);
5876 unless (File::Copy::move($from,$to)) {
5878 $from = File::Spec->rel2abs($from);
5879 Carp::confess("Couldn't move $from to $to: $err");
5882 } else { # older code below, still better than nothing when there is no File::Temp
5884 if (@readdir == 1 && -d $readdir[0]) {
5885 $distdir = $readdir[0];
5886 $packagedir = File::Spec->catdir($builddir,$distdir);
5887 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
5889 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
5891 File::Path::rmtree($packagedir);
5892 unless (File::Copy::move($distdir,$packagedir)) {
5893 $CPAN::Frontend->unrecoverable_error(<<EOF);
5894 Couldn't move '$distdir' to '$packagedir': $!
5896 Cannot continue: Please find the reason why I cannot move
5897 $builddir/tmp-$$/$distdir
5900 and fix the problem, then retry
5904 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
5911 my $userid = $self->cpan_userid;
5912 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
5913 if (!$userid or $userid eq "N/A") {
5916 my $pragmatic_dir = $userid . '000';
5917 $pragmatic_dir =~ s/\W_//g;
5918 $pragmatic_dir++ while -d "../$pragmatic_dir";
5919 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
5920 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
5921 File::Path::mkpath($packagedir);
5923 for $f (@readdir) { # is already without "." and ".."
5924 my $to = File::Spec->catdir($packagedir,$f);
5925 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
5930 $self->safe_chdir($sub_wd);
5934 $self->{build_dir} = $packagedir;
5935 $self->safe_chdir($builddir);
5936 File::Path::rmtree("tmp-$$");
5938 $self->safe_chdir($packagedir);
5939 $self->_signature_business();
5940 $self->safe_chdir($builddir);
5941 return if $CPAN::Signal;
5944 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
5945 my($mpl_exists) = -f $mpl;
5946 unless ($mpl_exists) {
5947 # NFS has been reported to have racing problems after the
5948 # renaming of a directory in some environments.
5950 $CPAN::Frontend->mysleep(1);
5951 my $mpldh = DirHandle->new($packagedir)
5952 or Carp::croak("Couldn't opendir $packagedir: $!");
5953 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
5956 my $prefer_installer = "eumm"; # eumm|mb
5957 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
5958 if ($mpl_exists) { # they *can* choose
5959 if ($CPAN::META->has_inst("Module::Build")) {
5960 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
5961 q{prefer_installer});
5964 $prefer_installer = "mb";
5967 return unless $self->patch;
5968 if (lc($prefer_installer) eq "mb") {
5969 $self->{modulebuild} = 1;
5970 } elsif ($self->{archived} eq "patch") {
5971 # not an edge case, nothing to install for sure
5972 my $why = "A patch file cannot be installed";
5973 $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n");
5974 $self->{writemakefile} = CPAN::Distrostatus->new("NO $why");
5975 } elsif (! $mpl_exists) {
5976 $self->_edge_cases($mpl,$packagedir,$local_file);
5978 if ($self->{build_dir}
5980 $CPAN::Config->{build_dir_reuse}
5982 $self->store_persistent_state;
5988 #-> CPAN::Distribution::store_persistent_state
5989 sub store_persistent_state {
5991 my $dir = $self->{build_dir};
5992 unless (File::Spec->canonpath(File::Basename::dirname($dir))
5993 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
5994 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
5995 "will not store persistent state\n");
5998 my $file = sprintf "%s.yml", $dir;
5999 my $yaml_module = CPAN::_yaml_module;
6000 if ($CPAN::META->has_inst($yaml_module)) {
6001 CPAN->_yaml_dumpfile(
6005 perl => CPAN::_perl_fingerprint,
6006 distribution => $self,
6010 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
6011 "will not store persistent state\n");
6015 #-> CPAN::Distribution::patch
6017 my($self,$patch) = @_;
6018 my $norm = $self->normalize($patch);
6020 File::Spec->catfile(
6021 $CPAN::Config->{keep_source_where},
6026 $self->debug("Doing localize") if $CPAN::DEBUG;
6027 return CPAN::FTP->localize("authors/id/$norm",
6031 #-> CPAN::Distribution::patch
6034 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
6035 my $patches = $self->prefs->{patches};
6037 $self->debug("patches[$patches]") if $CPAN::DEBUG;
6039 return unless @$patches;
6040 $self->safe_chdir($self->{build_dir});
6041 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
6042 my $patchbin = $CPAN::Config->{patch};
6043 unless ($patchbin && length $patchbin) {
6044 $CPAN::Frontend->mydie("No external patch command configured\n\n".
6045 "Please run 'o conf init /patch/'\n\n");
6047 unless (MM->maybe_command($patchbin)) {
6048 $CPAN::Frontend->mydie("No external patch command available\n\n".
6049 "Please run 'o conf init /patch/'\n\n");
6051 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
6052 local $ENV{PATCH_GET} = 0; # shall replace -g0 which is not
6053 # supported everywhere (and then,
6054 # not ever necessary there)
6055 my $stdpatchargs = "-N --fuzz=3";
6056 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
6057 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
6058 for my $patch (@$patches) {
6059 unless (-f $patch) {
6060 if (my $trydl = $self->try_download($patch)) {
6063 my $fail = "Could not find patch '$patch'";
6064 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6065 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6066 delete $self->{build_dir};
6070 $CPAN::Frontend->myprint(" $patch\n");
6071 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
6074 my $ppp = $self->_patch_p_parameter($readfh);
6075 if ($ppp eq "applypatch") {
6076 $pcommand = "$CPAN::Config->{applypatch} -verbose";
6078 my $thispatchargs = join " ", $stdpatchargs, $ppp;
6079 $pcommand = "$patchbin $thispatchargs";
6082 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
6083 my $writefh = FileHandle->new;
6084 $CPAN::Frontend->myprint(" $pcommand\n");
6085 unless (open $writefh, "|$pcommand") {
6086 my $fail = "Could not fork '$pcommand'";
6087 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6088 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6089 delete $self->{build_dir};
6092 while (my $x = $readfh->READLINE) {
6095 unless (close $writefh) {
6096 my $fail = "Could not apply patch '$patch'";
6097 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
6098 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
6099 delete $self->{build_dir};
6108 sub _patch_p_parameter {
6111 my $cnt_p0files = 0;
6113 while ($_ = $fh->READLINE) {
6115 $CPAN::Config->{applypatch}
6117 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
6121 next unless /^[\*\+]{3}\s(\S+)/;
6124 $cnt_p0files++ if -f $file;
6125 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
6128 return "-p1" unless $cnt_files;
6129 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
6132 #-> sub CPAN::Distribution::_edge_cases
6133 # with "configure" or "Makefile" or single file scripts
6135 my($self,$mpl,$packagedir,$local_file) = @_;
6136 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
6140 my($configure) = File::Spec->catfile($packagedir,"Configure");
6141 if (-f $configure) {
6142 # do we have anything to do?
6143 $self->{configure} = $configure;
6144 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
6145 $CPAN::Frontend->mywarn(qq{
6146 Package comes with a Makefile and without a Makefile.PL.
6147 We\'ll try to build it with that Makefile then.
6149 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6150 $CPAN::Frontend->mysleep(2);
6152 my $cf = $self->called_for || "unknown";
6157 $cf =~ s|[/\\:]||g; # risk of filesystem damage
6158 $cf = "unknown" unless length($cf);
6159 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
6160 (The test -f "$mpl" returned false.)
6161 Writing one on our own (setting NAME to $cf)\a\n});
6162 $self->{had_no_makefile_pl}++;
6163 $CPAN::Frontend->mysleep(3);
6165 # Writing our own Makefile.PL
6168 if ($self->{archived} eq "maybe_pl") {
6169 my $fh = FileHandle->new;
6170 my $script_file = File::Spec->catfile($packagedir,$local_file);
6171 $fh->open($script_file)
6172 or Carp::croak("Could not open $script_file: $!");
6174 # name parsen und prereq
6175 my($state) = "poddir";
6176 my($name, $prereq) = ("", "");
6178 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
6181 } elsif ($1 eq 'PREREQUISITES') {
6184 } elsif ($state =~ m{^(name|prereq)$}) {
6189 } elsif ($state eq "name") {
6194 } elsif ($state eq "prereq") {
6197 } elsif (/^=cut\b/) {
6204 s{.*<}{}; # strip X<...>
6208 $prereq = join " ", split /\s+/, $prereq;
6209 my($PREREQ_PM) = join("\n", map {
6210 s{.*<}{}; # strip X<...>
6212 if (/[\s\'\"]/) { # prose?
6214 s/[^\w:]$//; # period?
6215 " "x28 . "'$_' => 0,";
6217 } split /\s*,\s*/, $prereq);
6220 EXE_FILES => ['$name'],
6226 my $to_file = File::Spec->catfile($packagedir, $name);
6227 rename $script_file, $to_file
6228 or die "Can't rename $script_file to $to_file: $!";
6232 my $fh = FileHandle->new;
6234 or Carp::croak("Could not open >$mpl: $!");
6236 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
6237 # because there was no Makefile.PL supplied.
6238 # Autogenerated on: }.scalar localtime().qq{
6240 use ExtUtils::MakeMaker;
6242 NAME => q[$cf],$script
6249 #-> CPAN::Distribution::_signature_business
6250 sub _signature_business {
6252 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6255 if ($CPAN::META->has_inst("Module::Signature")) {
6256 if (-f "SIGNATURE") {
6257 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6258 my $rv = Module::Signature::verify();
6259 if ($rv != Module::Signature::SIGNATURE_OK() and
6260 $rv != Module::Signature::SIGNATURE_MISSING()) {
6261 $CPAN::Frontend->mywarn(
6262 qq{\nSignature invalid for }.
6263 qq{distribution file. }.
6264 qq{Please investigate.\n\n}
6268 sprintf(qq{I'd recommend removing %s. Some error occured }.
6269 qq{while checking its signature, so it could }.
6270 qq{be invalid. Maybe you have configured }.
6271 qq{your 'urllist' with a bad URL. Please check this }.
6272 qq{array with 'o conf urllist' and retry. Or }.
6273 qq{examine the distribution in a subshell. Try
6281 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
6282 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
6283 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
6285 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
6286 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
6289 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
6292 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6297 #-> CPAN::Distribution::untar_me ;
6300 $self->{archived} = "tar";
6302 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6304 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
6308 # CPAN::Distribution::unzip_me ;
6311 $self->{archived} = "zip";
6313 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6315 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
6320 sub handle_singlefile {
6321 my($self,$local_file) = @_;
6323 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
6324 $self->{archived} = "pm";
6325 } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) {
6326 $self->{archived} = "patch";
6328 $self->{archived} = "maybe_pl";
6331 my $to = File::Basename::basename($local_file);
6332 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
6333 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
6334 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6336 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
6339 if (File::Copy::cp($local_file,".")) {
6340 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6342 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
6348 #-> sub CPAN::Distribution::new ;
6350 my($class,%att) = @_;
6352 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
6354 my $this = { %att };
6355 return bless $this, $class;
6358 #-> sub CPAN::Distribution::look ;
6362 if ($^O eq 'MacOS') {
6363 $self->Mac::BuildTools::look;
6367 if ( $CPAN::Config->{'shell'} ) {
6368 $CPAN::Frontend->myprint(qq{
6369 Trying to open a subshell in the build directory...
6372 $CPAN::Frontend->myprint(qq{
6373 Your configuration does not define a value for subshells.
6374 Please define it with "o conf shell <your shell>"
6378 my $dist = $self->id;
6380 unless ($dir = $self->dir) {
6383 unless ($dir ||= $self->dir) {
6384 $CPAN::Frontend->mywarn(qq{
6385 Could not determine which directory to use for looking at $dist.
6389 my $pwd = CPAN::anycwd();
6390 $self->safe_chdir($dir);
6391 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6393 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
6394 $ENV{CPAN_SHELL_LEVEL} += 1;
6395 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
6396 unless (system($shell) == 0) {
6398 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
6401 $self->safe_chdir($pwd);
6404 # CPAN::Distribution::cvs_import ;
6408 my $dir = $self->dir;
6410 my $package = $self->called_for;
6411 my $module = $CPAN::META->instance('CPAN::Module', $package);
6412 my $version = $module->cpan_version;
6414 my $userid = $self->cpan_userid;
6416 my $cvs_dir = (split /\//, $dir)[-1];
6417 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
6419 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
6421 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
6422 if ($cvs_site_perl) {
6423 $cvs_dir = "$cvs_site_perl/$cvs_dir";
6425 my $cvs_log = qq{"imported $package $version sources"};
6426 $version =~ s/\./_/g;
6427 # XXX cvs: undocumented and unclear how it was meant to work
6428 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
6429 "$cvs_dir", $userid, "v$version");
6431 my $pwd = CPAN::anycwd();
6432 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
6434 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6436 $CPAN::Frontend->myprint(qq{@cmd\n});
6437 system(@cmd) == 0 or
6439 $CPAN::Frontend->mydie("cvs import failed");
6440 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
6443 #-> sub CPAN::Distribution::readme ;
6446 my($dist) = $self->id;
6447 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
6448 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
6451 File::Spec->catfile(
6452 $CPAN::Config->{keep_source_where},
6455 split(/\//,"$sans.readme"),
6457 $self->debug("Doing localize") if $CPAN::DEBUG;
6458 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
6460 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
6462 if ($^O eq 'MacOS') {
6463 Mac::BuildTools::launch_file($local_file);
6467 my $fh_pager = FileHandle->new;
6468 local($SIG{PIPE}) = "IGNORE";
6469 my $pager = $CPAN::Config->{'pager'} || "cat";
6470 $fh_pager->open("|$pager")
6471 or die "Could not open pager $pager\: $!";
6472 my $fh_readme = FileHandle->new;
6473 $fh_readme->open($local_file)
6474 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
6475 $CPAN::Frontend->myprint(qq{
6480 $fh_pager->print(<$fh_readme>);
6484 #-> sub CPAN::Distribution::verifyCHECKSUM ;
6485 sub verifyCHECKSUM {
6489 $self->{CHECKSUM_STATUS} ||= "";
6490 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
6491 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6493 my($lc_want,$lc_file,@local,$basename);
6494 @local = split(/\//,$self->id);
6496 push @local, "CHECKSUMS";
6498 File::Spec->catfile($CPAN::Config->{keep_source_where},
6499 "authors", "id", @local);
6501 if (my $size = -s $lc_want) {
6502 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
6503 if ($self->CHECKSUM_check_file($lc_want,1)) {
6504 return $self->{CHECKSUM_STATUS} = "OK";
6507 $lc_file = CPAN::FTP->localize("authors/id/@local",
6510 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
6511 $local[-1] .= ".gz";
6512 $lc_file = CPAN::FTP->localize("authors/id/@local",
6515 $lc_file =~ s/\.gz(?!\n)\Z//;
6516 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
6521 if ($self->CHECKSUM_check_file($lc_file)) {
6522 return $self->{CHECKSUM_STATUS} = "OK";
6526 #-> sub CPAN::Distribution::SIG_check_file ;
6527 sub SIG_check_file {
6528 my($self,$chk_file) = @_;
6529 my $rv = eval { Module::Signature::_verify($chk_file) };
6531 if ($rv == Module::Signature::SIGNATURE_OK()) {
6532 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
6533 return $self->{SIG_STATUS} = "OK";
6535 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
6536 qq{distribution file. }.
6537 qq{Please investigate.\n\n}.
6539 $CPAN::META->instance(
6544 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
6545 is invalid. Maybe you have configured your 'urllist' with
6546 a bad URL. Please check this array with 'o conf urllist', and
6549 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6553 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
6555 # sloppy is 1 when we have an old checksums file that maybe is good
6558 sub CHECKSUM_check_file {
6559 my($self,$chk_file,$sloppy) = @_;
6560 my($cksum,$file,$basename);
6563 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
6564 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6567 if ($CPAN::META->has_inst("Module::Signature")) {
6568 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6569 $self->SIG_check_file($chk_file);
6571 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6575 $file = $self->{localfile};
6576 $basename = File::Basename::basename($file);
6577 my $fh = FileHandle->new;
6578 if (open $fh, $chk_file){
6581 $eval =~ s/\015?\012/\n/g;
6583 my($comp) = Safe->new();
6584 $cksum = $comp->reval($eval);
6586 rename $chk_file, "$chk_file.bad";
6587 Carp::confess($@) if $@;
6590 Carp::carp "Could not open $chk_file for reading";
6593 if (! ref $cksum or ref $cksum ne "HASH") {
6594 $CPAN::Frontend->mywarn(qq{
6595 Warning: checksum file '$chk_file' broken.
6597 When trying to read that file I expected to get a hash reference
6598 for further processing, but got garbage instead.
6600 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
6601 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6602 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
6604 } elsif (exists $cksum->{$basename}{sha256}) {
6605 $self->debug("Found checksum for $basename:" .
6606 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
6610 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
6612 $fh = CPAN::Tarzip->TIEHANDLE($file);
6615 my $dg = Digest::SHA->new(256);
6618 while ($fh->READ($ref, 4096) > 0){
6621 my $hexdigest = $dg->hexdigest;
6622 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
6626 $CPAN::Frontend->myprint("Checksum for $file ok\n");
6627 return $self->{CHECKSUM_STATUS} = "OK";
6629 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
6630 qq{distribution file. }.
6631 qq{Please investigate.\n\n}.
6633 $CPAN::META->instance(
6638 my $wrap = qq{I\'d recommend removing $file. Its
6639 checksum is incorrect. Maybe you have configured your 'urllist' with
6640 a bad URL. Please check this array with 'o conf urllist', and
6643 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6645 # former versions just returned here but this seems a
6646 # serious threat that deserves a die
6648 # $CPAN::Frontend->myprint("\n\n");
6652 # close $fh if fileno($fh);
6655 unless ($self->{CHECKSUM_STATUS}) {
6656 $CPAN::Frontend->mywarn(qq{
6657 Warning: No checksum for $basename in $chk_file.
6659 The cause for this may be that the file is very new and the checksum
6660 has not yet been calculated, but it may also be that something is
6661 going awry right now.
6663 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
6664 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6666 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
6671 #-> sub CPAN::Distribution::eq_CHECKSUM ;
6673 my($self,$fh,$expect) = @_;
6674 if ($CPAN::META->has_inst("Digest::SHA")) {
6675 my $dg = Digest::SHA->new(256);
6677 while (read($fh, $data, 4096)){
6680 my $hexdigest = $dg->hexdigest;
6681 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
6682 return $hexdigest eq $expect;
6687 #-> sub CPAN::Distribution::force ;
6689 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
6690 # effect by autoinspection, not by inspecting a global variable. One
6691 # of the reason why this was chosen to work that way was the treatment
6692 # of dependencies. They should not automatically inherit the force
6693 # status. But this has the downside that ^C and die() will return to
6694 # the prompt but will not be able to reset the force_update
6695 # attributes. We try to correct for it currently in the read_metadata
6696 # routine, and immediately before we check for a Signal. I hope this
6697 # works out in one of v1.57_53ff
6699 # "Force get forgets previous error conditions"
6701 #-> sub CPAN::Distribution::fforce ;
6703 my($self, $method) = @_;
6704 $self->force($method,1);
6707 #-> sub CPAN::Distribution::force ;
6709 my($self, $method,$fforce) = @_;
6727 "prereq_pm_detected",
6741 my $methodmatch = 0;
6743 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
6744 $methodmatch = 1 if $fforce || $phase eq $method;
6745 next unless $methodmatch;
6746 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
6747 if ($phase eq "get") {
6748 if (substr($self->id,-1,1) eq "."
6749 && $att =~ /(unwrapped|build_dir|archived)/ ) {
6750 # cannot be undone for local distros
6753 if ($att eq "build_dir"
6754 && $self->{build_dir}
6755 && $CPAN::META->{is_tested}
6757 delete $CPAN::META->{is_tested}{$self->{build_dir}};
6759 } elsif ($phase eq "test") {
6760 if ($att eq "make_test"
6761 && $self->{make_test}
6762 && $self->{make_test}{COMMANDID}
6763 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
6765 # endless loop too likely
6769 delete $self->{$att};
6770 if ($ldebug || $CPAN::DEBUG) {
6771 # local $CPAN::DEBUG = 16; # Distribution
6772 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
6776 if ($method && $method =~ /make|test|install/) {
6777 $self->{force_update} = 1; # name should probably have been force_install
6781 #-> sub CPAN::Distribution::notest ;
6783 my($self, $method) = @_;
6784 # $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method");
6785 $self->{"notest"}++; # name should probably have been force_install
6788 #-> sub CPAN::Distribution::unnotest ;
6791 # warn "XDEBUG: deleting notest";
6792 delete $self->{notest};
6795 #-> sub CPAN::Distribution::unforce ;
6798 delete $self->{force_update};
6801 #-> sub CPAN::Distribution::isa_perl ;
6804 my $file = File::Basename::basename($self->id);
6805 if ($file =~ m{ ^ perl
6814 \.tar[._-](?:gz|bz2)
6818 } elsif ($self->cpan_comment
6820 $self->cpan_comment =~ /isa_perl\(.+?\)/){
6826 #-> sub CPAN::Distribution::perl ;
6831 carp __PACKAGE__ . "::perl was called without parameters.";
6833 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
6837 #-> sub CPAN::Distribution::make ;
6840 if (my $goto = $self->prefs->{goto}) {
6841 return $self->goto($goto);
6843 my $make = $self->{modulebuild} ? "Build" : "make";
6844 # Emergency brake if they said install Pippi and get newest perl
6845 if ($self->isa_perl) {
6847 $self->called_for ne $self->id &&
6848 ! $self->{force_update}
6850 # if we die here, we break bundles
6853 qq{The most recent version "%s" of the module "%s"
6854 is part of the perl-%s distribution. To install that, you need to run
6855 force install %s --or--
6858 $CPAN::META->instance(
6867 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
6868 $CPAN::Frontend->mysleep(1);
6872 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
6874 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6876 : ($ENV{PERLLIB} || "");
6877 $CPAN::META->set_perl5lib;
6878 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6881 delete $self->{force_update};
6888 if (!$self->{archived} || $self->{archived} eq "NO") {
6889 push @e, "Is neither a tar nor a zip archive.";
6892 if (!$self->{unwrapped}
6894 UNIVERSAL::can($self->{unwrapped},"failed") ?
6895 $self->{unwrapped}->failed :
6896 $self->{unwrapped} =~ /^NO/
6898 push @e, "Had problems unarchiving. Please build manually";
6901 unless ($self->{force_update}) {
6902 exists $self->{signature_verify} and
6904 UNIVERSAL::can($self->{signature_verify},"failed") ?
6905 $self->{signature_verify}->failed :
6906 $self->{signature_verify} =~ /^NO/
6908 and push @e, "Did not pass the signature test.";
6911 if (exists $self->{writemakefile} &&
6913 UNIVERSAL::can($self->{writemakefile},"failed") ?
6914 $self->{writemakefile}->failed :
6915 $self->{writemakefile} =~ /^NO/
6917 # XXX maybe a retry would be in order?
6918 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
6919 $self->{writemakefile}->text :
6920 $self->{writemakefile};
6922 $err ||= "Had some problem writing Makefile";
6923 $err .= ", won't make";
6927 if (defined $self->{make}) {
6928 if ($self->{make}->failed) {
6929 if ($self->{force_update}) {
6930 # Trying an already failed 'make' (unless somebody else blocks)
6932 # introduced for turning recursion detection into a distrostatus
6933 my $error = length $self->{make}>3
6934 ? substr($self->{make},3) : "Unknown error";
6935 $CPAN::Frontend->mywarn("Could not make: $error\n");
6936 $self->store_persistent_state;
6940 push @e, "Has already been made";
6944 if ($self->{later}) { # see also undelay
6945 if ($self->unsat_prereq) {
6946 push @e, $self->{later};
6950 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6951 $builddir = $self->dir or
6952 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
6953 unless (chdir $builddir) {
6954 push @e, "Couldn't chdir to '$builddir': $!";
6956 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
6959 delete $self->{force_update};
6962 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
6963 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
6965 if ($^O eq 'MacOS') {
6966 Mac::BuildTools::make($self);
6971 while (my($k,$v) = each %ENV) {
6972 next unless defined $v;
6977 if (my $commandline = $self->prefs->{pl}{commandline}) {
6978 $system = $commandline;
6980 } elsif ($self->{'configure'}) {
6981 $system = $self->{'configure'};
6982 } elsif ($self->{modulebuild}) {
6983 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6984 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
6986 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6988 # This needs a handler that can be turned on or off:
6989 # $switch = "-MExtUtils::MakeMaker ".
6990 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
6992 my $makepl_arg = $self->make_x_arg("pl");
6993 $system = sprintf("%s%s Makefile.PL%s",
6995 $switch ? " $switch" : "",
6996 $makepl_arg ? " $makepl_arg" : "",
6999 if (my $env = $self->prefs->{pl}{env}) {
7000 for my $e (keys %$env) {
7001 $ENV{$e} = $env->{$e};
7004 if (exists $self->{writemakefile}) {
7006 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
7010 if ($CPAN::Config->{inactivity_timeout}) {
7012 if ($Config::Config{d_alarm}
7014 $Config::Config{d_alarm} eq "define"
7018 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
7019 "variable 'inactivity_timeout' to ".
7020 "'$CPAN::Config->{inactivity_timeout}'. But ".
7021 "on this machine the system call 'alarm' ".
7022 "isn't available. This means that we cannot ".
7023 "provide the feature of intercepting long ".
7024 "waiting code and will turn this feature off.\n"
7026 $CPAN::Config->{inactivity_timeout} = 0;
7029 if ($go_via_alarm) {
7031 alarm $CPAN::Config->{inactivity_timeout};
7032 local $SIG{CHLD}; # = sub { wait };
7033 if (defined($pid = fork)) {
7038 # note, this exec isn't necessary if
7039 # inactivity_timeout is 0. On the Mac I'd
7040 # suggest, we set it always to 0.
7044 $CPAN::Frontend->myprint("Cannot fork: $!");
7053 $CPAN::Frontend->myprint($err);
7054 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
7059 if (my $expect_model = $self->_prefs_with_expect("pl")) {
7060 $ret = $self->_run_via_expect($system,$expect_model);
7062 && $self->{writemakefile}
7063 && $self->{writemakefile}->failed) {
7068 $ret = system($system);
7071 $self->{writemakefile} = CPAN::Distrostatus
7072 ->new("NO '$system' returned status $ret");
7073 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
7074 $self->store_persistent_state;
7078 if (-f "Makefile" || -f "Build") {
7079 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
7080 delete $self->{make_clean}; # if cleaned before, enable next
7082 $self->{writemakefile} = CPAN::Distrostatus
7083 ->new(qq{NO -- Unknown reason});
7087 delete $self->{force_update};
7090 if (my @prereq = $self->unsat_prereq){
7091 if ($prereq[0][0] eq "perl") {
7092 my $need = "requires perl '$prereq[0][1]'";
7093 my $id = $self->pretty_id;
7094 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
7095 $self->{make} = CPAN::Distrostatus->new("NO $need");
7096 $self->store_persistent_state;
7099 my $follow = eval { $self->follow_prereqs(@prereq); };
7102 # signal success to the queuerunner
7104 } elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) {
7105 $CPAN::Frontend->mywarn($@);
7111 delete $self->{force_update};
7114 if (my $commandline = $self->prefs->{make}{commandline}) {
7115 $system = $commandline;
7118 if ($self->{modulebuild}) {
7119 unless (-f "Build") {
7120 my $cwd = CPAN::anycwd();
7121 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
7122 " in cwd[$cwd]. Danger, Will Robinson!");
7123 $CPAN::Frontend->mysleep(5);
7125 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
7127 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
7129 $system =~ s/\s+$//;
7130 my $make_arg = $self->make_x_arg("make");
7131 $system = sprintf("%s%s",
7133 $make_arg ? " $make_arg" : "",
7136 if (my $env = $self->prefs->{make}{env}) { # overriding the local
7137 # ENV of PL, not the
7139 # unlikely to be a risk
7140 for my $e (keys %$env) {
7141 $ENV{$e} = $env->{$e};
7144 my $expect_model = $self->_prefs_with_expect("make");
7145 my $want_expect = 0;
7146 if ( $expect_model && @{$expect_model->{talk}} ) {
7147 my $can_expect = $CPAN::META->has_inst("Expect");
7151 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7157 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
7159 $system_ok = system($system) == 0;
7161 $self->introduce_myself;
7163 $CPAN::Frontend->myprint(" $system -- OK\n");
7164 $self->{make} = CPAN::Distrostatus->new("YES");
7166 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
7167 $self->{make} = CPAN::Distrostatus->new("NO");
7168 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7170 $self->store_persistent_state;
7173 # CPAN::Distribution::_run_via_expect
7174 sub _run_via_expect {
7175 my($self,$system,$expect_model) = @_;
7176 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
7177 if ($CPAN::META->has_inst("Expect")) {
7178 my $expo = Expect->new; # expo Expect object;
7179 $expo->spawn($system);
7180 $expect_model->{mode} ||= "deterministic";
7181 if ($expect_model->{mode} eq "deterministic") {
7182 return $self->_run_via_expect_deterministic($expo,$expect_model);
7183 } elsif ($expect_model->{mode} eq "anyorder") {
7184 return $self->_run_via_expect_anyorder($expo,$expect_model);
7186 die "Panic: Illegal expect mode: $expect_model->{mode}";
7189 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
7190 return system($system);
7194 sub _run_via_expect_anyorder {
7195 my($self,$expo,$expect_model) = @_;
7196 my $timeout = $expect_model->{timeout} || 5;
7197 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
7200 my($eof,$ran_into_timeout);
7201 my @match = $expo->expect($timeout,
7206 $ran_into_timeout++;
7213 $but .= $expo->clear_accum;
7216 return $expo->exitstatus();
7217 } elsif ($ran_into_timeout) {
7218 # warn "DEBUG: they are asking a question, but[$but]";
7219 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
7220 my($next,$send) = @expectacopy[$i,$i+1];
7221 my $regex = eval "qr{$next}";
7222 # warn "DEBUG: will compare with regex[$regex].";
7223 if ($but =~ /$regex/) {
7224 # warn "DEBUG: will send send[$send]";
7226 splice @expectacopy, $i, 2; # never allow reusing an QA pair
7230 my $why = "could not answer a question during the dialog";
7231 $CPAN::Frontend->mywarn("Failing: $why\n");
7232 $self->{writemakefile} =
7233 CPAN::Distrostatus->new("NO $why");
7239 sub _run_via_expect_deterministic {
7240 my($self,$expo,$expect_model) = @_;
7241 my $ran_into_timeout;
7242 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
7243 my $expecta = $expect_model->{talk};
7244 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
7245 my($re,$send) = @$expecta[$i,$i+1];
7246 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
7247 my $regex = eval "qr{$re}";
7248 $expo->expect($timeout,
7250 my $but = $expo->clear_accum;
7251 $CPAN::Frontend->mywarn("EOF (maybe harmless)
7252 expected[$regex]\nbut[$but]\n\n");
7256 my $but = $expo->clear_accum;
7257 $CPAN::Frontend->mywarn("TIMEOUT
7258 expected[$regex]\nbut[$but]\n\n");
7259 $ran_into_timeout++;
7262 if ($ran_into_timeout){
7263 # note that the caller expects 0 for success
7264 $self->{writemakefile} =
7265 CPAN::Distrostatus->new("NO timeout during expect dialog");
7271 return $expo->exitstatus();
7274 #-> CPAN::Distribution::_validate_distropref
7275 sub _validate_distropref {
7276 my($self,@args) = @_;
7278 $CPAN::META->has_inst("CPAN::Kwalify")
7280 $CPAN::META->has_inst("Kwalify")
7282 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
7284 $CPAN::Frontend->mywarn($@);
7287 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
7291 #-> CPAN::Distribution::_find_prefs
7294 my $distroid = $self->pretty_id;
7295 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
7296 my $prefs_dir = $CPAN::Config->{prefs_dir};
7297 eval { File::Path::mkpath($prefs_dir); };
7299 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
7301 my $yaml_module = CPAN::_yaml_module;
7303 if ($CPAN::META->has_inst($yaml_module)) {
7304 push @extensions, "yml";
7307 if ($CPAN::META->has_inst("Data::Dumper")) {
7308 push @extensions, "dd";
7309 push @fallbacks, "Data::Dumper";
7311 if ($CPAN::META->has_inst("Storable")) {
7312 push @extensions, "st";
7313 push @fallbacks, "Storable";
7317 unless ($self->{have_complained_about_missing_yaml}++) {
7318 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
7319 "to @fallbacks to read prefs '$prefs_dir'\n");
7322 unless ($self->{have_complained_about_missing_yaml}++) {
7323 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
7324 "read prefs '$prefs_dir'\n");
7329 my $dh = DirHandle->new($prefs_dir)
7330 or die Carp::croak("Couldn't open '$prefs_dir': $!");
7331 DIRENT: for (sort $dh->read) {
7332 next if $_ eq "." || $_ eq "..";
7333 my $exte = join "|", @extensions;
7334 next unless /\.($exte)$/;
7336 my $abs = File::Spec->catfile($prefs_dir, $_);
7338 #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
7340 if ($thisexte eq "yml") {
7341 # need no eval because if we have no YAML we do not try to read *.yml
7342 #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7343 @distropref = @{CPAN->_yaml_loadfile($abs)};
7344 #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7345 } elsif ($thisexte eq "dd") {
7348 open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
7354 $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
7357 while (${"VAR".$i}) {
7358 push @distropref, ${"VAR".$i};
7361 } elsif ($thisexte eq "st") {
7362 # eval because Storable is never forward compatible
7363 eval { @distropref = @{scalar Storable::retrieve($abs)}; };
7365 $CPAN::Frontend->mywarn("Error reading distroprefs file ".
7366 "$_, skipping\: $@");
7367 $CPAN::Frontend->mysleep(4);
7372 #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7373 ELEMENT: for my $y (0..$#distropref) {
7374 my $distropref = $distropref[$y];
7375 $self->_validate_distropref($distropref,$abs,$y);
7376 my $match = $distropref->{match};
7378 #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
7382 # do not take the order of C<keys %$match> because
7383 # "module" is by far the slowest
7384 my $saw_valid_subkeys = 0;
7385 for my $sub_attribute (qw(distribution perl perlconfig module)) {
7386 next unless exists $match->{$sub_attribute};
7387 $saw_valid_subkeys++;
7388 my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
7389 if ($sub_attribute eq "module") {
7391 #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7392 my @modules = $self->containsmods;
7393 #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
7394 MODULE: for my $module (@modules) {
7395 $okm ||= $module =~ /$qr/;
7396 last MODULE if $okm;
7399 } elsif ($sub_attribute eq "distribution") {
7400 my $okd = $distroid =~ /$qr/;
7402 } elsif ($sub_attribute eq "perl") {
7403 my $okp = $^X =~ /$qr/;
7405 } elsif ($sub_attribute eq "perlconfig") {
7406 for my $perlconfigkey (keys %{$match->{perlconfig}}) {
7407 my $perlconfigval = $match->{perlconfig}->{$perlconfigkey};
7408 # XXX should probably warn if Config does not exist
7409 my $okpc = $Config::Config{$perlconfigkey} =~ /$perlconfigval/;
7414 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7415 "unknown sub_attribut '$sub_attribute'. ".
7417 "remove, cannot continue.");
7419 last if $ok == 0; # short circuit
7421 unless ($saw_valid_subkeys) {
7422 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7423 "missing match/* subattribute. ".
7425 "remove, cannot continue.");
7427 #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
7430 prefs => $distropref,
7432 prefs_file_doc => $y,
7444 # CPAN::Distribution::prefs
7447 if (exists $self->{negative_prefs_cache}
7449 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
7451 delete $self->{negative_prefs_cache};
7452 delete $self->{prefs};
7454 if (exists $self->{prefs}) {
7455 return $self->{prefs}; # XXX comment out during debugging
7457 if ($CPAN::Config->{prefs_dir}) {
7458 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
7459 my $prefs = $self->_find_prefs();
7460 $prefs ||= ""; # avoid warning next line
7461 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
7463 for my $x (qw(prefs prefs_file prefs_file_doc)) {
7464 $self->{$x} = $prefs->{$x};
7468 File::Basename::basename($self->{prefs_file}),
7469 $self->{prefs_file_doc},
7471 my $filler1 = "_" x 22;
7472 my $filler2 = int(66 - length($bs))/2;
7473 $filler2 = 0 if $filler2 < 0;
7474 $filler2 = " " x $filler2;
7475 $CPAN::Frontend->myprint("
7476 $filler1 D i s t r o P r e f s $filler1
7477 $filler2 $bs $filler2
7479 $CPAN::Frontend->mysleep(1);
7480 return $self->{prefs};
7483 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
7484 return $self->{prefs} = +{};
7487 # CPAN::Distribution::make_x_arg
7489 my($self, $whixh) = @_;
7491 my $prefs = $self->prefs;
7494 && exists $prefs->{$whixh}
7495 && exists $prefs->{$whixh}{args}
7496 && $prefs->{$whixh}{args}
7498 $make_x_arg = join(" ",
7499 map {CPAN::HandleConfig
7500 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
7503 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
7504 $make_x_arg ||= $CPAN::Config->{$what};
7508 # CPAN::Distribution::_make_command
7515 CPAN::HandleConfig->prefs_lookup($self,
7517 || $Config::Config{make}
7521 # Old style call, without object. Deprecated
7522 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
7525 CPAN::HandleConfig->prefs_lookup($self,q{make})
7526 || $CPAN::Config->{make}
7527 || $Config::Config{make}
7532 #-> sub CPAN::Distribution::follow_prereqs ;
7533 sub follow_prereqs {
7535 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
7536 return unless @prereq_tuples;
7537 my @prereq = map { $_->[0] } @prereq_tuples;
7538 my $pretty_id = $self->pretty_id;
7540 b => "build_requires",
7544 my($filler1,$filler2,$filler3,$filler4);
7546 my $unsat = "Unsatisfied dependencies detected during";
7547 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
7549 my $r = int(($w - length($unsat))/2);
7550 my $l = $w - length($unsat) - $r;
7551 $filler1 = "-"x4 . " "x$l;
7552 $filler2 = " "x$r . "-"x4 . "\n";
7555 my $r = int(($w - length($pretty_id))/2);
7556 my $l = $w - length($pretty_id) - $r;
7557 $filler3 = "-"x4 . " "x$l;
7558 $filler4 = " "x$r . "-"x4 . "\n";
7561 myprint("$filler1 $unsat $filler2".
7562 "$filler3 $pretty_id $filler4".
7563 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
7566 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
7568 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
7569 my $answer = CPAN::Shell::colorable_makemaker_prompt(
7570 "Shall I follow them and prepend them to the queue
7571 of modules we are processing right now?", "yes");
7572 $follow = $answer =~ /^\s*y/i;
7576 myprint(" Ignoring dependencies on modules @prereq\n");
7580 # color them as dirty
7581 for my $p (@prereq) {
7582 # warn "calling color_cmd_tmps(0,1)";
7583 my $any = CPAN::Shell->expandany($p);
7585 $any->color_cmd_tmps(0,2);
7587 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
7588 $CPAN::Frontend->mysleep(2);
7591 # queue them and re-queue yourself
7592 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
7593 reverse @prereq_tuples);
7594 $self->{later} = "Delayed until after prerequisites";
7595 return 1; # signal success to the queuerunner
7599 #-> sub CPAN::Distribution::unsat_prereq ;
7600 # return ([Foo=>1],[Bar=>1.2]) for normal modules
7601 # return ([perl=>5.008]) if we need a newer perl than we are running under
7604 my $prereq_pm = $self->prereq_pm or return;
7606 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
7607 my @merged = %merged;
7608 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
7609 NEED: while (my($need_module, $need_version) = each %merged) {
7610 my($available_version,$available_file,$nmo);
7611 if ($need_module eq "perl") {
7612 $available_version = $];
7613 $available_file = $^X;
7615 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
7616 next if $nmo->uptodate;
7617 $available_file = $nmo->available_file;
7619 # if they have not specified a version, we accept any installed one
7620 if (defined $available_file
7621 and ( # a few quick shortcurcuits
7622 not defined $need_version
7623 or $need_version eq '0' # "==" would trigger warning when not numeric
7624 or $need_version eq "undef"
7629 $available_version = $nmo->available_version;
7632 # We only want to install prereqs if either they're not installed
7633 # or if the installed version is too old. We cannot omit this
7634 # check, because if 'force' is in effect, nobody else will check.
7635 if (defined $available_file) {
7636 my(@all_requirements) = split /\s*,\s*/, $need_version;
7639 RQ: for my $rq (@all_requirements) {
7640 if ($rq =~ s|>=\s*||) {
7641 } elsif ($rq =~ s|>\s*||) {
7643 if (CPAN::Version->vgt($available_version,$rq)){
7647 } elsif ($rq =~ s|!=\s*||) {
7649 if (CPAN::Version->vcmp($available_version,$rq)){
7655 } elsif ($rq =~ m|<=?\s*|) {
7657 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
7661 if (! CPAN::Version->vgt($rq, $available_version)){
7664 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
7665 "available_version[%s]rq[%s]ok[%d]",
7669 CPAN::Version->readable($rq),
7673 next NEED if $ok == @all_requirements;
7676 if ($need_module eq "perl") {
7677 return ["perl", $need_version];
7679 if ($self->{sponsored_mods}{$need_module}++){
7680 # We have already sponsored it and for some reason it's still
7681 # not available. So we do ... what??
7683 # if we push it again, we have a potential infinite loop
7685 # The following "next" was a very problematic construct.
7686 # It helped a lot but broke some day and had to be
7689 # We must be able to deal with modules that come again and
7690 # again as a prereq and have themselves prereqs and the
7691 # queue becomes long but finally we would find the correct
7692 # order. The RecursiveDependency check should trigger a
7693 # die when it's becoming too weird. Unfortunately removing
7694 # this next breaks many other things.
7696 # The bug that brought this up is described in Todo under
7697 # "5.8.9 cannot install Compress::Zlib"
7699 # next; # this is the next that had to go away
7701 # The following "next NEED" are fine and the error message
7702 # explains well what is going on. For example when the DBI
7703 # fails and consequently DBD::SQLite fails and now we are
7704 # processing CPAN::SQLite. Then we must have a "next" for
7705 # DBD::SQLite. How can we get it and how can we identify
7706 # all other cases we must identify?
7708 my $do = $nmo->distribution;
7709 next NEED unless $do; # not on CPAN
7710 NOSAYER: for my $nosayer (
7719 if ($do->{$nosayer}) {
7720 if (UNIVERSAL::can($do->{$nosayer},"failed") ?
7721 $do->{$nosayer}->failed :
7722 $do->{$nosayer} =~ /^NO/) {
7723 if ($nosayer eq "make_test"
7725 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
7729 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
7730 "'$need_module => $need_version' ".
7731 "for '$self->{ID}' failed when ".
7732 "processing '$do->{ID}' with ".
7733 "'$nosayer => $do->{$nosayer}'. Continuing, ".
7734 "but chances to succeed are limited.\n"
7737 } else { # the other guy succeeded
7738 if ($nosayer eq "install") {
7740 # DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz
7742 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
7743 "'$need_module => $need_version' ".
7744 "for '$self->{ID}' already installed ".
7745 "but installation looks suspicious. ".
7746 "Skipping another installation attempt, ".
7747 "to prevent looping endlessly.\n"
7755 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
7756 push @need, [$need_module,$needed_as];
7758 my @unfolded = map { "[".join(",",@$_)."]" } @need;
7759 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
7763 #-> sub CPAN::Distribution::read_yaml ;
7766 return $self->{yaml_content} if exists $self->{yaml_content};
7767 my $build_dir = $self->{build_dir};
7768 my $yaml = File::Spec->catfile($build_dir,"META.yml");
7769 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
7770 return unless -f $yaml;
7771 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
7773 $CPAN::Frontend->mywarn("Could not read ".
7774 "'$yaml'. Falling back to other ".
7775 "methods to determine prerequisites\n");
7776 return $self->{yaml_content} = undef; # if we die, then we
7777 # cannot read YAML's own
7780 # not "authoritative"
7781 if (not exists $self->{yaml_content}{dynamic_config}
7782 or $self->{yaml_content}{dynamic_config}
7784 $self->{yaml_content} = undef;
7786 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
7788 return $self->{yaml_content};
7791 #-> sub CPAN::Distribution::prereq_pm ;
7794 $self->{prereq_pm_detected} ||= 0;
7795 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
7796 return $self->{prereq_pm} if $self->{prereq_pm_detected};
7797 return unless $self->{writemakefile} # no need to have succeeded
7798 # but we must have run it
7799 || $self->{modulebuild};
7800 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
7801 $self->{writemakefile}||"",
7802 $self->{modulebuild}||"",
7805 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
7806 $req = $yaml->{requires} || {};
7807 $breq = $yaml->{build_requires} || {};
7808 undef $req unless ref $req eq "HASH" && %$req;
7810 if ($yaml->{generated_by} &&
7811 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
7812 my $eummv = do { local $^W = 0; $1+0; };
7813 if ($eummv < 6.2501) {
7814 # thanks to Slaven for digging that out: MM before
7815 # that could be wrong because it could reflect a
7822 while (my($k,$v) = each %{$req||{}}) {
7825 } elsif ($k =~ /[A-Za-z]/ &&
7827 $CPAN::META->exists("Module",$v)
7829 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
7830 "requires hash: $k => $v; I'll take both ".
7831 "key and value as a module name\n");
7832 $CPAN::Frontend->mysleep(1);
7838 $req = $areq if $do_replace;
7841 unless ($req || $breq) {
7842 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7843 my $makefile = File::Spec->catfile($build_dir,"Makefile");
7847 $fh = FileHandle->new("<$makefile\0")) {
7848 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
7851 last if /MakeMaker post_initialize section/;
7853 \s+PREREQ_PM\s+=>\s+(.+)
7856 # warn "Found prereq expr[$p]";
7858 # Regexp modified by A.Speer to remember actual version of file
7859 # PREREQ_PM hash key wants, then add to
7860 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
7861 # In case a prereq is mentioned twice, complain.
7862 if ( defined $req->{$1} ) {
7863 warn "Warning: PREREQ_PM mentions $1 more than once, ".
7864 "last mention wins";
7866 my($m,$n) = ($1,$2);
7867 if ($n =~ /^q\[(.*?)\]$/) {
7876 unless ($req || $breq) {
7877 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7878 my $buildfile = File::Spec->catfile($build_dir,"Build");
7879 if (-f $buildfile) {
7880 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
7881 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
7882 if (-f $build_prereqs) {
7883 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
7884 my $content = do { local *FH;
7885 open FH, $build_prereqs
7886 or $CPAN::Frontend->mydie("Could not open ".
7887 "'$build_prereqs': $!");
7891 my $bphash = eval $content;
7894 $req = $bphash->{requires} || +{};
7895 $breq = $bphash->{build_requires} || +{};
7901 && ! -f "Makefile.PL"
7902 && ! exists $req->{"Module::Build"}
7903 && ! $CPAN::META->has_inst("Module::Build")) {
7904 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
7905 "undeclared prerequisite.\n".
7906 " Adding it now as such.\n"
7908 $CPAN::Frontend->mysleep(5);
7909 $req->{"Module::Build"} = 0;
7910 delete $self->{writemakefile};
7912 if ($req || $breq) {
7913 $self->{prereq_pm_detected}++;
7914 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
7918 #-> sub CPAN::Distribution::test ;
7921 if (my $goto = $self->prefs->{goto}) {
7922 return $self->goto($goto);
7926 delete $self->{force_update};
7929 # warn "XDEBUG: checking for notest: $self->{notest} $self";
7930 if ($self->{notest}) {
7931 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
7935 my $make = $self->{modulebuild} ? "Build" : "make";
7937 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7939 : ($ENV{PERLLIB} || "");
7941 $CPAN::META->set_perl5lib;
7942 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7944 $CPAN::Frontend->myprint("Running $make test\n");
7946 # if (my @prereq = $self->unsat_prereq){
7947 # if ( $CPAN::DEBUG ) {
7948 # require Data::Dumper;
7949 # CPAN->debug(sprintf "unsat_prereq[%s]", Data::Dumper::Dumper(\@prereq));
7951 # unless ($prereq[0][0] eq "perl") {
7952 # return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
7958 if ($self->{make} or $self->{later}) {
7962 "Make had some problems, won't test";
7965 exists $self->{make} and
7967 UNIVERSAL::can($self->{make},"failed") ?
7968 $self->{make}->failed :
7969 $self->{make} =~ /^NO/
7970 ) and push @e, "Can't test without successful make";
7971 $self->{badtestcnt} ||= 0;
7972 if ($self->{badtestcnt} > 0) {
7973 require Data::Dumper;
7974 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
7975 push @e, "Won't repeat unsuccessful test during this command";
7978 push @e, $self->{later} if $self->{later};
7980 if (exists $self->{build_dir}) {
7981 if (exists $self->{make_test}) {
7983 UNIVERSAL::can($self->{make_test},"failed") ?
7984 $self->{make_test}->failed :
7985 $self->{make_test} =~ /^NO/
7988 UNIVERSAL::can($self->{make_test},"commandid")
7990 $self->{make_test}->commandid == $CPAN::CurrentCommandId
7992 push @e, "Has already been tested within this command";
7995 push @e, "Has already been tested successfully";
7999 push @e, "Has no own directory";
8001 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8002 unless (chdir $self->{build_dir}) {
8003 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8005 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8007 $self->debug("Changed directory to $self->{build_dir}")
8010 if ($^O eq 'MacOS') {
8011 Mac::BuildTools::make_test($self);
8015 if ($self->{modulebuild}) {
8016 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
8017 if (CPAN::Version->vlt($v,2.62)) {
8018 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
8019 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
8020 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
8026 if (my $commandline = $self->prefs->{test}{commandline}) {
8027 $system = $commandline;
8029 } elsif ($self->{modulebuild}) {
8030 $system = sprintf "%s test", $self->_build_command();
8032 $system = join " ", $self->_make_command(), "test";
8034 my $make_test_arg = $self->make_x_arg("test");
8035 $system = sprintf("%s%s",
8037 $make_test_arg ? " $make_test_arg" : "",
8041 while (my($k,$v) = each %ENV) {
8042 next unless defined $v;
8046 if (my $env = $self->prefs->{test}{env}) {
8047 for my $e (keys %$env) {
8048 $ENV{$e} = $env->{$e};
8051 my $expect_model = $self->_prefs_with_expect("test");
8052 my $want_expect = 0;
8053 if ( $expect_model && @{$expect_model->{talk}} ) {
8054 my $can_expect = $CPAN::META->has_inst("Expect");
8058 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
8059 "testing without\n");
8062 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
8066 my $can_report = $CPAN::META->has_inst("CPAN::Reporter");
8070 $CPAN::Frontend->mywarn("CPAN::Reporter not installed, falling back to ".
8071 "testing without\n");
8074 my $ready_to_report = $want_report;
8075 if ($ready_to_report
8077 substr($self->id,-1,1) eq "."
8079 $self->author->id eq "LOCAL"
8082 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
8083 "for local directories\n");
8084 $ready_to_report = 0;
8086 if ($ready_to_report
8088 $self->prefs->{patches}
8090 @{$self->prefs->{patches}}
8094 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
8095 "when the source has been patched\n");
8096 $ready_to_report = 0;
8099 if ($ready_to_report) {
8100 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
8101 "not supported when distroprefs specify ".
8102 "an interactive test\n");
8104 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
8105 } elsif ( $ready_to_report ) {
8106 $tests_ok = CPAN::Reporter::test($self, $system);
8108 $tests_ok = system($system) == 0;
8110 $self->introduce_myself;
8115 # local $CPAN::DEBUG = 16; # Distribution
8116 for my $m (keys %{$self->{sponsored_mods}}) {
8117 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
8118 # XXX we need available_version which reflects
8119 # $ENV{PERL5LIB} so that already tested but not yet
8120 # installed modules are counted.
8121 my $available_version = $m_obj->available_version;
8122 my $available_file = $m_obj->available_file;
8123 if ($available_version &&
8124 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
8126 CPAN->debug("m[$m] good enough available_version[$available_version]")
8128 } elsif ($available_file
8130 !$self->{prereq_pm}{$m}
8132 $self->{prereq_pm}{$m} == 0
8135 # lex Class::Accessor::Chained::Fast which has no $VERSION
8136 CPAN->debug("m[$m] have available_file[$available_file]")
8144 my $which = join ",", @prereq;
8145 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
8146 "$cnt dependencies missing ($which)";
8147 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
8148 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
8149 $self->store_persistent_state;
8154 $CPAN::Frontend->myprint(" $system -- OK\n");
8155 $self->{make_test} = CPAN::Distrostatus->new("YES");
8156 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
8157 # probably impossible to need the next line because badtestcnt
8158 # has a lifespan of one command
8159 delete $self->{badtestcnt};
8161 $self->{make_test} = CPAN::Distrostatus->new("NO");
8162 $self->{badtestcnt}++;
8163 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8165 $self->store_persistent_state;
8168 sub _prefs_with_expect {
8169 my($self,$where) = @_;
8170 return unless my $prefs = $self->prefs;
8171 return unless my $where_prefs = $prefs->{$where};
8172 if ($where_prefs->{expect}) {
8174 mode => "deterministic",
8176 talk => $where_prefs->{expect},
8178 } elsif ($where_prefs->{"eexpect"}) {
8179 return $where_prefs->{"eexpect"};
8184 #-> sub CPAN::Distribution::clean ;
8187 my $make = $self->{modulebuild} ? "Build" : "make";
8188 $CPAN::Frontend->myprint("Running $make clean\n");
8189 unless (exists $self->{archived}) {
8190 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
8191 "/untarred, nothing done\n");
8194 unless (exists $self->{build_dir}) {
8195 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
8198 if (exists $self->{writemakefile}
8199 and $self->{writemakefile}->failed
8201 $CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n");
8206 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
8207 push @e, "make clean already called once";
8208 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8210 chdir $self->{build_dir} or
8211 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
8212 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
8214 if ($^O eq 'MacOS') {
8215 Mac::BuildTools::make_clean($self);
8220 if ($self->{modulebuild}) {
8221 unless (-f "Build") {
8222 my $cwd = CPAN::anycwd();
8223 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
8224 " in cwd[$cwd]. Danger, Will Robinson!");
8225 $CPAN::Frontend->mysleep(5);
8227 $system = sprintf "%s clean", $self->_build_command();
8229 $system = join " ", $self->_make_command(), "clean";
8231 my $system_ok = system($system) == 0;
8232 $self->introduce_myself;
8234 $CPAN::Frontend->myprint(" $system -- OK\n");
8238 # Jost Krieger pointed out that this "force" was wrong because
8239 # it has the effect that the next "install" on this distribution
8240 # will untar everything again. Instead we should bring the
8241 # object's state back to where it is after untarring.
8252 $self->{make_clean} = CPAN::Distrostatus->new("YES");
8255 # Hmmm, what to do if make clean failed?
8257 $self->{make_clean} = CPAN::Distrostatus->new("NO");
8258 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
8260 # 2006-02-27: seems silly to me to force a make now
8261 # $self->force("make"); # so that this directory won't be used again
8264 $self->store_persistent_state;
8267 #-> sub CPAN::Distribution::goto ;
8269 my($self,$goto) = @_;
8270 $goto = $self->normalize($goto);
8272 # inject into the queue
8274 CPAN::Queue->delete($self->id);
8275 CPAN::Queue->jumpqueue([$goto,$self->{reqtype}]);
8277 # and run where we left off
8279 my($method) = (caller(1))[3];
8280 CPAN->instance("CPAN::Distribution",$goto)->$method;
8281 CPAN::Queue->delete_first($goto);
8284 #-> sub CPAN::Distribution::install ;
8287 if (my $goto = $self->prefs->{goto}) {
8288 return $self->goto($goto);
8291 unless ($self->{badtestcnt}) {
8295 delete $self->{force_update};
8298 my $make = $self->{modulebuild} ? "Build" : "make";
8299 $CPAN::Frontend->myprint("Running $make install\n");
8302 if ($self->{make} or $self->{later}) {
8306 "Make had some problems, won't install";
8309 exists $self->{make} and
8311 UNIVERSAL::can($self->{make},"failed") ?
8312 $self->{make}->failed :
8313 $self->{make} =~ /^NO/
8315 push @e, "Make had returned bad status, install seems impossible";
8317 if (exists $self->{build_dir}) {
8319 push @e, "Has no own directory";
8322 if (exists $self->{make_test} and
8324 UNIVERSAL::can($self->{make_test},"failed") ?
8325 $self->{make_test}->failed :
8326 $self->{make_test} =~ /^NO/
8328 if ($self->{force_update}) {
8329 $self->{make_test}->text("FAILED but failure ignored because ".
8330 "'force' in effect");
8332 push @e, "make test had returned bad status, ".
8333 "won't install without force"
8336 if (exists $self->{install}) {
8337 if (UNIVERSAL::can($self->{install},"text") ?
8338 $self->{install}->text eq "YES" :
8339 $self->{install} =~ /^YES/
8341 $CPAN::Frontend->myprint(" Already done\n");
8342 $CPAN::META->is_installed($self->{build_dir});
8345 # comment in Todo on 2006-02-11; maybe retry?
8346 push @e, "Already tried without success";
8350 push @e, $self->{later} if $self->{later};
8352 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8353 unless (chdir $self->{build_dir}) {
8354 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8356 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8358 $self->debug("Changed directory to $self->{build_dir}")
8361 if ($^O eq 'MacOS') {
8362 Mac::BuildTools::make_install($self);
8367 if (my $commandline = $self->prefs->{install}{commandline}) {
8368 $system = $commandline;
8370 } elsif ($self->{modulebuild}) {
8371 my($mbuild_install_build_command) =
8372 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
8373 $CPAN::Config->{mbuild_install_build_command} ?
8374 $CPAN::Config->{mbuild_install_build_command} :
8375 $self->_build_command();
8376 $system = sprintf("%s install %s",
8377 $mbuild_install_build_command,
8378 $CPAN::Config->{mbuild_install_arg},
8381 my($make_install_make_command) =
8382 CPAN::HandleConfig->prefs_lookup($self,
8383 q{make_install_make_command})
8384 || $self->_make_command();
8385 $system = sprintf("%s install %s",
8386 $make_install_make_command,
8387 $CPAN::Config->{make_install_arg},
8391 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
8392 my $brip = CPAN::HandleConfig->prefs_lookup($self,
8393 q{build_requires_install_policy});
8396 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
8397 my $want_install = "yes";
8398 if ($reqtype eq "b") {
8399 if ($brip eq "no") {
8400 $want_install = "no";
8401 } elsif ($brip =~ m|^ask/(.+)|) {
8403 $default = "yes" unless $default =~ /^(y|n)/i;
8405 CPAN::Shell::colorable_makemaker_prompt
8406 ("$id is just needed temporarily during building or testing. ".
8407 "Do you want to install it permanently? (Y/n)",
8411 unless ($want_install =~ /^y/i) {
8412 my $is_only = "is only 'build_requires'";
8413 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
8414 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
8415 delete $self->{force_update};
8418 my($pipe) = FileHandle->new("$system $stderr |");
8421 print $_; # intentionally NOT use Frontend->myprint because it
8422 # looks irritating when we markup in color what we
8423 # just pass through from an external program
8427 my $close_ok = $? == 0;
8428 $self->introduce_myself;
8430 $CPAN::Frontend->myprint(" $system -- OK\n");
8431 $CPAN::META->is_installed($self->{build_dir});
8432 $self->{install} = CPAN::Distrostatus->new("YES");
8434 $self->{install} = CPAN::Distrostatus->new("NO");
8435 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8437 CPAN::HandleConfig->prefs_lookup($self,
8438 q{make_install_make_command});
8440 $makeout =~ /permission/s
8444 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
8448 $CPAN::Frontend->myprint(
8450 qq{ You may have to su }.
8451 qq{to root to install the package\n}.
8452 qq{ (Or you may want to run something like\n}.
8453 qq{ o conf make_install_make_command 'sudo make'\n}.
8454 qq{ to raise your permissions.}
8458 delete $self->{force_update};
8460 $self->store_persistent_state;
8463 sub introduce_myself {
8465 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
8468 #-> sub CPAN::Distribution::dir ;
8473 #-> sub CPAN::Distribution::perldoc ;
8477 my($dist) = $self->id;
8478 my $package = $self->called_for;
8480 $self->_display_url( $CPAN::Defaultdocs . $package );
8483 #-> sub CPAN::Distribution::_check_binary ;
8485 my ($dist,$shell,$binary) = @_;
8488 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
8491 if ($CPAN::META->has_inst("File::Which")) {
8492 return File::Which::which($binary);
8495 $pid = open README, "which $binary|"
8496 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
8502 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
8506 $CPAN::Frontend->myprint(qq{ + $out \n})
8507 if $CPAN::DEBUG && $out;
8512 #-> sub CPAN::Distribution::_display_url ;
8514 my($self,$url) = @_;
8515 my($res,$saved_file,$pid,$out);
8517 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
8520 # should we define it in the config instead?
8521 my $html_converter = "html2text";
8523 my $web_browser = $CPAN::Config->{'lynx'} || undef;
8524 my $web_browser_out = $web_browser
8525 ? CPAN::Distribution->_check_binary($self,$web_browser)
8528 if ($web_browser_out) {
8529 # web browser found, run the action
8530 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
8531 $CPAN::Frontend->myprint(qq{system[$browser $url]})
8533 $CPAN::Frontend->myprint(qq{
8536 with browser $browser
8538 $CPAN::Frontend->mysleep(1);
8539 system("$browser $url");
8540 if ($saved_file) { 1 while unlink($saved_file) }
8542 # web browser not found, let's try text only
8543 my $html_converter_out =
8544 CPAN::Distribution->_check_binary($self,$html_converter);
8545 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
8547 if ($html_converter_out ) {
8548 # html2text found, run it
8549 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
8550 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
8551 unless defined($saved_file);
8554 $pid = open README, "$html_converter $saved_file |"
8555 or $CPAN::Frontend->mydie(qq{
8556 Could not fork '$html_converter $saved_file': $!});
8558 if ($CPAN::META->has_inst("File::Temp")) {
8559 $fh = File::Temp->new(
8560 template => 'cpan_htmlconvert_XXXX',
8564 $filename = $fh->filename;
8566 $filename = "cpan_htmlconvert_$$.txt";
8567 $fh = FileHandle->new();
8568 open $fh, ">$filename" or die;
8574 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
8575 my $tmpin = $fh->filename;
8576 $CPAN::Frontend->myprint(sprintf(qq{
8578 saved output to %s\n},
8586 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
8587 my $fh_pager = FileHandle->new;
8588 local($SIG{PIPE}) = "IGNORE";
8589 my $pager = $CPAN::Config->{'pager'} || "cat";
8590 $fh_pager->open("|$pager")
8591 or $CPAN::Frontend->mydie(qq{
8592 Could not open pager '$pager': $!});
8593 $CPAN::Frontend->myprint(qq{
8598 $CPAN::Frontend->mysleep(1);
8599 $fh_pager->print(<FH>);
8602 # coldn't find the web browser or html converter
8603 $CPAN::Frontend->myprint(qq{
8604 You need to install lynx or $html_converter to use this feature.});
8609 #-> sub CPAN::Distribution::_getsave_url ;
8611 my($dist, $shell, $url) = @_;
8613 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
8617 if ($CPAN::META->has_inst("File::Temp")) {
8618 $fh = File::Temp->new(
8619 template => "cpan_getsave_url_XXXX",
8623 $filename = $fh->filename;
8625 $fh = FileHandle->new;
8626 $filename = "cpan_getsave_url_$$.html";
8628 my $tmpin = $filename;
8629 if ($CPAN::META->has_usable('LWP')) {
8630 $CPAN::Frontend->myprint("Fetching with LWP:
8634 CPAN::LWP::UserAgent->config;
8635 eval { $Ua = CPAN::LWP::UserAgent->new; };
8637 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
8641 $Ua->proxy('http', $var)
8642 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
8644 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
8647 my $req = HTTP::Request->new(GET => $url);
8648 $req->header('Accept' => 'text/html');
8649 my $res = $Ua->request($req);
8650 if ($res->is_success) {
8651 $CPAN::Frontend->myprint(" + request successful.\n")
8653 print $fh $res->content;
8655 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
8659 $CPAN::Frontend->myprint(sprintf(
8660 "LWP failed with code[%s], message[%s]\n",
8667 $CPAN::Frontend->mywarn(" LWP not available\n");
8672 # sub CPAN::Distribution::_build_command
8673 sub _build_command {
8675 if ($^O eq "MSWin32") { # special code needed at least up to
8676 # Module::Build 0.2611 and 0.2706; a fix
8677 # in M:B has been promised 2006-01-30
8678 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
8679 return "$perl ./Build";
8684 package CPAN::Bundle;
8689 $CPAN::Frontend->myprint($self->as_string);
8692 #-> CPAN::Bundle::undelay
8695 delete $self->{later};
8696 for my $c ( $self->contains ) {
8697 my $obj = CPAN::Shell->expandany($c) or next;
8702 # mark as dirty/clean
8703 #-> sub CPAN::Bundle::color_cmd_tmps ;
8704 sub color_cmd_tmps {
8706 my($depth) = shift || 0;
8707 my($color) = shift || 0;
8708 my($ancestors) = shift || [];
8709 # a module needs to recurse to its cpan_file, a distribution needs
8710 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
8712 return if exists $self->{incommandcolor}
8714 && $self->{incommandcolor}==$color;
8715 if ($depth>=$CPAN::MAX_RECURSION){
8716 die(CPAN::Exception::RecursiveDependency->new($ancestors));
8718 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8720 for my $c ( $self->contains ) {
8721 my $obj = CPAN::Shell->expandany($c) or next;
8722 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
8723 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8725 # never reached code?
8727 #delete $self->{badtestcnt};
8729 $self->{incommandcolor} = $color;
8732 #-> sub CPAN::Bundle::as_string ;
8736 # following line must be "=", not "||=" because we have a moving target
8737 $self->{INST_VERSION} = $self->inst_version;
8738 return $self->SUPER::as_string;
8741 #-> sub CPAN::Bundle::contains ;
8744 my($inst_file) = $self->inst_file || "";
8745 my($id) = $self->id;
8746 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
8747 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
8750 unless ($inst_file) {
8751 # Try to get at it in the cpan directory
8752 $self->debug("no inst_file") if $CPAN::DEBUG;
8754 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
8755 $cpan_file = $self->cpan_file;
8756 if ($cpan_file eq "N/A") {
8757 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
8758 Maybe stale symlink? Maybe removed during session? Giving up.\n");
8760 my $dist = $CPAN::META->instance('CPAN::Distribution',
8762 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
8764 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
8765 my($todir) = $CPAN::Config->{'cpan_home'};
8766 my(@me,$from,$to,$me);
8767 @me = split /::/, $self->id;
8769 $me = File::Spec->catfile(@me);
8770 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
8771 $to = File::Spec->catfile($todir,$me);
8772 File::Path::mkpath(File::Basename::dirname($to));
8773 File::Copy::copy($from, $to)
8774 or Carp::confess("Couldn't copy $from to $to: $!");
8778 my $fh = FileHandle->new;
8780 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
8782 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
8784 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
8785 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
8786 next unless $in_cont;
8791 push @result, (split " ", $_, 2)[0];
8794 delete $self->{STATUS};
8795 $self->{CONTAINS} = \@result;
8796 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
8798 $CPAN::Frontend->mywarn(qq{
8799 The bundle file "$inst_file" may be a broken
8800 bundlefile. It seems not to contain any bundle definition.
8801 Please check the file and if it is bogus, please delete it.
8802 Sorry for the inconvenience.
8808 #-> sub CPAN::Bundle::find_bundle_file
8809 # $where is in local format, $what is in unix format
8810 sub find_bundle_file {
8811 my($self,$where,$what) = @_;
8812 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
8813 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
8814 ### my $bu = File::Spec->catfile($where,$what);
8815 ### return $bu if -f $bu;
8816 my $manifest = File::Spec->catfile($where,"MANIFEST");
8817 unless (-f $manifest) {
8818 require ExtUtils::Manifest;
8819 my $cwd = CPAN::anycwd();
8820 $self->safe_chdir($where);
8821 ExtUtils::Manifest::mkmanifest();
8822 $self->safe_chdir($cwd);
8824 my $fh = FileHandle->new($manifest)
8825 or Carp::croak("Couldn't open $manifest: $!");
8827 my $bundle_filename = $what;
8828 $bundle_filename =~ s|Bundle.*/||;
8829 my $bundle_unixpath;
8832 my($file) = /(\S+)/;
8833 if ($file =~ m|\Q$what\E$|) {
8834 $bundle_unixpath = $file;
8835 # return File::Spec->catfile($where,$bundle_unixpath); # bad
8838 # retry if she managed to have no Bundle directory
8839 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
8841 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
8842 if $bundle_unixpath;
8843 Carp::croak("Couldn't find a Bundle file in $where");
8846 # needs to work quite differently from Module::inst_file because of
8847 # cpan_home/Bundle/ directory and the possibility that we have
8848 # shadowing effect. As it makes no sense to take the first in @INC for
8849 # Bundles, we parse them all for $VERSION and take the newest.
8851 #-> sub CPAN::Bundle::inst_file ;
8856 @me = split /::/, $self->id;
8859 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
8860 my $bfile = File::Spec->catfile($incdir, @me);
8861 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
8862 next unless -f $bfile;
8863 my $foundv = MM->parse_version($bfile);
8864 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
8865 $self->{INST_FILE} = $bfile;
8866 $self->{INST_VERSION} = $bestv = $foundv;
8872 #-> sub CPAN::Bundle::inst_version ;
8875 $self->inst_file; # finds INST_VERSION as side effect
8876 $self->{INST_VERSION};
8879 #-> sub CPAN::Bundle::rematein ;
8881 my($self,$meth) = @_;
8882 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
8883 my($id) = $self->id;
8884 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
8885 unless $self->inst_file || $self->cpan_file;
8887 for $s ($self->contains) {
8888 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
8889 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
8890 if ($type eq 'CPAN::Distribution') {
8891 $CPAN::Frontend->mywarn(qq{
8892 The Bundle }.$self->id.qq{ contains
8893 explicitly a file '$s'.
8894 Going to $meth that.
8896 $CPAN::Frontend->mysleep(5);
8898 # possibly noisy action:
8899 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
8900 my $obj = $CPAN::META->instance($type,$s);
8901 $obj->{reqtype} = $self->{reqtype};
8906 # If a bundle contains another that contains an xs_file we have here,
8907 # we just don't bother I suppose
8908 #-> sub CPAN::Bundle::xs_file
8913 #-> sub CPAN::Bundle::force ;
8914 sub fforce { shift->rematein('fforce',@_); }
8915 #-> sub CPAN::Bundle::force ;
8916 sub force { shift->rematein('force',@_); }
8917 #-> sub CPAN::Bundle::notest ;
8918 sub notest { shift->rematein('notest',@_); }
8919 #-> sub CPAN::Bundle::get ;
8920 sub get { shift->rematein('get',@_); }
8921 #-> sub CPAN::Bundle::make ;
8922 sub make { shift->rematein('make',@_); }
8923 #-> sub CPAN::Bundle::test ;
8926 # $self->{badtestcnt} ||= 0;
8927 $self->rematein('test',@_);
8929 #-> sub CPAN::Bundle::install ;
8932 $self->rematein('install',@_);
8934 #-> sub CPAN::Bundle::clean ;
8935 sub clean { shift->rematein('clean',@_); }
8937 #-> sub CPAN::Bundle::uptodate ;
8940 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
8942 foreach $c ($self->contains) {
8943 my $obj = CPAN::Shell->expandany($c);
8944 return 0 unless $obj->uptodate;
8949 #-> sub CPAN::Bundle::readme ;
8952 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
8953 No File found for bundle } . $self->id . qq{\n}), return;
8954 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
8955 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
8958 package CPAN::Module;
8962 # sub CPAN::Module::userid
8967 return $ro->{userid} || $ro->{CPAN_USERID};
8969 # sub CPAN::Module::description
8972 my $ro = $self->ro or return "";
8978 CPAN::Shell->expand("Distribution",$self->cpan_file);
8981 # sub CPAN::Module::undelay
8984 delete $self->{later};
8985 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8990 # mark as dirty/clean
8991 #-> sub CPAN::Module::color_cmd_tmps ;
8992 sub color_cmd_tmps {
8994 my($depth) = shift || 0;
8995 my($color) = shift || 0;
8996 my($ancestors) = shift || [];
8997 # a module needs to recurse to its cpan_file
8999 return if exists $self->{incommandcolor}
9001 && $self->{incommandcolor}==$color;
9002 return if $color==0 && !$self->{incommandcolor};
9004 if ( $self->uptodate ) {
9005 $self->{incommandcolor} = $color;
9007 } elsif (my $have_version = $self->available_version) {
9008 # maybe what we have is good enough
9010 my $who_asked_for_me = $ancestors->[-1];
9011 my $obj = CPAN::Shell->expandany($who_asked_for_me);
9013 } elsif ($obj->isa("CPAN::Bundle")) {
9014 # bundles cannot specify a minimum version
9016 } elsif ($obj->isa("CPAN::Distribution")) {
9017 if (my $prereq_pm = $obj->prereq_pm) {
9018 for my $k (keys %$prereq_pm) {
9019 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
9020 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
9021 $self->{incommandcolor} = $color;
9031 $self->{incommandcolor} = $color; # set me before recursion,
9032 # so we can break it
9034 if ($depth>=$CPAN::MAX_RECURSION){
9035 die(CPAN::Exception::RecursiveDependency->new($ancestors));
9037 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
9039 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
9040 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
9044 # delete $self->{badtestcnt};
9046 $self->{incommandcolor} = $color;
9049 #-> sub CPAN::Module::as_glimpse ;
9053 my $class = ref($self);
9054 $class =~ s/^CPAN:://;
9058 $CPAN::Shell::COLOR_REGISTERED
9060 $CPAN::META->has_inst("Term::ANSIColor")
9064 $color_on = Term::ANSIColor::color("green");
9065 $color_off = Term::ANSIColor::color("reset");
9067 my $uptodateness = " ";
9068 if ($class eq "Bundle") {
9069 } elsif ($self->uptodate) {
9070 $uptodateness = "=";
9071 } elsif ($self->inst_version) {
9072 $uptodateness = "<";
9074 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
9080 ($self->distribution ?
9081 $self->distribution->pretty_id :
9088 #-> sub CPAN::Module::dslip_status
9092 # development status
9093 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
9094 pre-alpha alpha beta released
9097 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
9098 developer comp.lang.perl.*
9101 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
9103 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
9105 object-oriented pragma
9108 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
9112 distribution_allowed
9113 restricted_distribution
9115 for my $x (qw(d s l i p)) {
9116 $stat->{$x}{' '} = 'unknown';
9117 $stat->{$x}{'?'} = 'unknown';
9120 return +{} unless $ro && $ro->{statd};
9127 DV => $stat->{D}{$ro->{statd}},
9128 SV => $stat->{S}{$ro->{stats}},
9129 LV => $stat->{L}{$ro->{statl}},
9130 IV => $stat->{I}{$ro->{stati}},
9131 PV => $stat->{P}{$ro->{statp}},
9135 #-> sub CPAN::Module::as_string ;
9139 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
9140 my $class = ref($self);
9141 $class =~ s/^CPAN:://;
9143 push @m, $class, " id = $self->{ID}\n";
9144 my $sprintf = " %-12s %s\n";
9145 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
9146 if $self->description;
9147 my $sprintf2 = " %-12s %s (%s)\n";
9149 $userid = $self->userid;
9152 if ($author = CPAN::Shell->expand('Author',$userid)) {
9155 if ($m = $author->email) {
9162 $author->fullname . $email
9166 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
9167 if $self->cpan_version;
9168 if (my $cpan_file = $self->cpan_file){
9169 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
9170 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
9171 my $upload_date = $dist->upload_date;
9173 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
9177 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
9178 my $dslip = $self->dslip_status;
9182 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
9184 my $local_file = $self->inst_file;
9185 unless ($self->{MANPAGE}) {
9188 $manpage = $self->manpage_headline($local_file);
9190 # If we have already untarred it, we should look there
9191 my $dist = $CPAN::META->instance('CPAN::Distribution',
9193 # warn "dist[$dist]";
9194 # mff=manifest file; mfh=manifest handle
9199 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
9201 $mfh = FileHandle->new($mff)
9203 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
9204 my $lfre = $self->id; # local file RE
9207 my($lfl); # local file file
9209 my(@mflines) = <$mfh>;
9214 while (length($lfre)>5 and !$lfl) {
9215 ($lfl) = grep /$lfre/, @mflines;
9216 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
9219 $lfl =~ s/\s.*//; # remove comments
9220 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
9221 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
9222 # warn "lfl_abs[$lfl_abs]";
9224 $manpage = $self->manpage_headline($lfl_abs);
9228 $self->{MANPAGE} = $manpage if $manpage;
9231 for $item (qw/MANPAGE/) {
9232 push @m, sprintf($sprintf, $item, $self->{$item})
9233 if exists $self->{$item};
9235 for $item (qw/CONTAINS/) {
9236 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
9237 if exists $self->{$item} && @{$self->{$item}};
9239 push @m, sprintf($sprintf, 'INST_FILE',
9240 $local_file || "(not installed)");
9241 push @m, sprintf($sprintf, 'INST_VERSION',
9242 $self->inst_version) if $local_file;
9246 sub manpage_headline {
9247 my($self,$local_file) = @_;
9248 my(@local_file) = $local_file;
9249 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
9250 push @local_file, $local_file;
9252 for $locf (@local_file) {
9253 next unless -f $locf;
9254 my $fh = FileHandle->new($locf)
9255 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
9259 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
9260 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
9277 #-> sub CPAN::Module::cpan_file ;
9278 # Note: also inherited by CPAN::Bundle
9281 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
9282 unless ($self->ro) {
9283 CPAN::Index->reload;
9286 if ($ro && defined $ro->{CPAN_FILE}){
9287 return $ro->{CPAN_FILE};
9289 my $userid = $self->userid;
9291 if ($CPAN::META->exists("CPAN::Author",$userid)) {
9292 my $author = $CPAN::META->instance("CPAN::Author",
9294 my $fullname = $author->fullname;
9295 my $email = $author->email;
9296 unless (defined $fullname && defined $email) {
9297 return sprintf("Contact Author %s",
9301 return "Contact Author $fullname <$email>";
9303 return "Contact Author $userid (Email address not available)";
9311 #-> sub CPAN::Module::cpan_version ;
9317 # Can happen with modules that are not on CPAN
9320 $ro->{CPAN_VERSION} = 'undef'
9321 unless defined $ro->{CPAN_VERSION};
9322 $ro->{CPAN_VERSION};
9325 #-> sub CPAN::Module::force ;
9328 $self->{force_update} = 1;
9331 #-> sub CPAN::Module::fforce ;
9334 $self->{force_update} = 2;
9337 #-> sub CPAN::Module::notest ;
9340 # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module");
9344 #-> sub CPAN::Module::rematein ;
9346 my($self,$meth) = @_;
9347 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
9350 my $cpan_file = $self->cpan_file;
9351 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
9352 $CPAN::Frontend->mywarn(sprintf qq{
9353 The module %s isn\'t available on CPAN.
9355 Either the module has not yet been uploaded to CPAN, or it is
9356 temporary unavailable. Please contact the author to find out
9357 more about the status. Try 'i %s'.
9364 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
9365 $pack->called_for($self->id);
9366 if (exists $self->{force_update}){
9367 if ($self->{force_update} == 2) {
9368 $pack->fforce($meth);
9370 $pack->force($meth);
9373 $pack->notest($meth) if exists $self->{notest} && $self->{notest};
9375 $pack->{reqtype} ||= "";
9376 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
9377 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
9378 if ($pack->{reqtype}) {
9379 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
9380 $pack->{reqtype} = $self->{reqtype};
9382 exists $pack->{install}
9385 UNIVERSAL::can($pack->{install},"failed") ?
9386 $pack->{install}->failed :
9387 $pack->{install} =~ /^NO/
9390 delete $pack->{install};
9391 $CPAN::Frontend->mywarn
9392 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
9396 $pack->{reqtype} = $self->{reqtype};
9399 my $success = eval {
9403 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
9404 $pack->unnotest if $pack->can("unnotest") && exists $self->{notest};
9405 delete $self->{force_update};
9406 delete $self->{notest};
9413 #-> sub CPAN::Module::perldoc ;
9414 sub perldoc { shift->rematein('perldoc') }
9415 #-> sub CPAN::Module::readme ;
9416 sub readme { shift->rematein('readme') }
9417 #-> sub CPAN::Module::look ;
9418 sub look { shift->rematein('look') }
9419 #-> sub CPAN::Module::cvs_import ;
9420 sub cvs_import { shift->rematein('cvs_import') }
9421 #-> sub CPAN::Module::get ;
9422 sub get { shift->rematein('get',@_) }
9423 #-> sub CPAN::Module::make ;
9424 sub make { shift->rematein('make') }
9425 #-> sub CPAN::Module::test ;
9428 # $self->{badtestcnt} ||= 0;
9429 $self->rematein('test',@_);
9431 #-> sub CPAN::Module::uptodate ;
9434 local($_); # protect against a bug in MakeMaker 6.17
9435 my($latest) = $self->cpan_version;
9437 my($inst_file) = $self->inst_file;
9439 if (defined $inst_file) {
9440 $have = $self->inst_version;
9445 ! CPAN::Version->vgt($latest, $have)
9447 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
9448 "latest[$latest] have[$have]") if $CPAN::DEBUG;
9453 #-> sub CPAN::Module::install ;
9459 not exists $self->{force_update}
9461 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
9463 $self->inst_version,
9469 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
9470 $CPAN::Frontend->mywarn(qq{
9471 \n\n\n ***WARNING***
9472 The module $self->{ID} has no active maintainer.\n\n\n
9474 $CPAN::Frontend->mysleep(5);
9476 $self->rematein('install') if $doit;
9478 #-> sub CPAN::Module::clean ;
9479 sub clean { shift->rematein('clean') }
9481 #-> sub CPAN::Module::inst_file ;
9484 $self->_file_in_path([@INC]);
9487 #-> sub CPAN::Module::available_file ;
9488 sub available_file {
9490 my $sep = $Config::Config{path_sep};
9491 my $perllib = $ENV{PERL5LIB};
9492 $perllib = $ENV{PERLLIB} unless defined $perllib;
9493 my @perllib = split(/$sep/,$perllib) if defined $perllib;
9494 $self->_file_in_path([@perllib,@INC]);
9497 #-> sub CPAN::Module::file_in_path ;
9499 my($self,$path) = @_;
9501 @packpath = split /::/, $self->{ID};
9502 $packpath[-1] .= ".pm";
9503 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
9504 unshift @packpath, "Term", "ReadLine"; # historical reasons
9506 foreach $dir (@$path) {
9507 my $pmfile = File::Spec->catfile($dir,@packpath);
9515 #-> sub CPAN::Module::xs_file ;
9519 @packpath = split /::/, $self->{ID};
9520 push @packpath, $packpath[-1];
9521 $packpath[-1] .= "." . $Config::Config{'dlext'};
9522 foreach $dir (@INC) {
9523 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
9531 #-> sub CPAN::Module::inst_version ;
9534 my $parsefile = $self->inst_file or return;
9535 my $have = $self->parse_version($parsefile);
9539 #-> sub CPAN::Module::inst_version ;
9540 sub available_version {
9542 my $parsefile = $self->available_file or return;
9543 my $have = $self->parse_version($parsefile);
9547 #-> sub CPAN::Module::parse_version ;
9549 my($self,$parsefile) = @_;
9550 my $have = MM->parse_version($parsefile);
9551 $have = "undef" unless defined $have && length $have;
9552 $have =~ s/^ //; # since the %vd hack these two lines here are needed
9553 $have =~ s/ $//; # trailing whitespace happens all the time
9555 $have = CPAN::Version->readable($have);
9557 $have =~ s/\s*//g; # stringify to float around floating point issues
9558 $have; # no stringify needed, \s* above matches always
9571 CPAN - query, download and build perl modules from CPAN sites
9577 perl -MCPAN -e shell
9587 cpan> install Acme::Meta # in the shell
9589 CPAN::Shell->install("Acme::Meta"); # in perl
9593 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
9596 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
9600 $mo = CPAN::Shell->expandany($mod);
9601 $mo = CPAN::Shell->expand("Module",$mod); # same thing
9603 # distribution objects:
9605 $do = CPAN::Shell->expand("Module",$mod)->distribution;
9606 $do = CPAN::Shell->expandany($distro); # same thing
9607 $do = CPAN::Shell->expand("Distribution",
9608 $distro); # same thing
9612 The CPAN module automates or at least simplifies the make and install
9613 of perl modules and extensions. It includes some primitive searching
9614 capabilities and knows how to use Net::FTP or LWP or some external
9615 download clients to fetch the distributions from the net.
9617 These are fetched from one or more of the mirrored CPAN (Comprehensive
9618 Perl Archive Network) sites and unpacked in a dedicated directory.
9620 The CPAN module also supports the concept of named and versioned
9621 I<bundles> of modules. Bundles simplify the handling of sets of
9622 related modules. See Bundles below.
9624 The package contains a session manager and a cache manager. The
9625 session manager keeps track of what has been fetched, built and
9626 installed in the current session. The cache manager keeps track of the
9627 disk space occupied by the make processes and deletes excess space
9628 according to a simple FIFO mechanism.
9630 All methods provided are accessible in a programmer style and in an
9631 interactive shell style.
9633 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
9635 The interactive mode is entered by running
9637 perl -MCPAN -e shell
9643 which puts you into a readline interface. If C<Term::ReadKey> and
9644 either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
9645 it supports both history and command completion.
9647 Once you are on the command line, type C<h> to get a one page help
9648 screen and the rest should be self-explanatory.
9650 The function call C<shell> takes two optional arguments, one is the
9651 prompt, the second is the default initial command line (the latter
9652 only works if a real ReadLine interface module is installed).
9654 The most common uses of the interactive modes are
9658 =item Searching for authors, bundles, distribution files and modules
9660 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
9661 for each of the four categories and another, C<i> for any of the
9662 mentioned four. Each of the four entities is implemented as a class
9663 with slightly differing methods for displaying an object.
9665 Arguments you pass to these commands are either strings exactly matching
9666 the identification string of an object or regular expressions that are
9667 then matched case-insensitively against various attributes of the
9668 objects. The parser recognizes a regular expression only if you
9669 enclose it between two slashes.
9671 The principle is that the number of found objects influences how an
9672 item is displayed. If the search finds one item, the result is
9673 displayed with the rather verbose method C<as_string>, but if we find
9674 more than one, we display each object with the terse method
9677 =item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
9679 These commands take any number of arguments and investigate what is
9680 necessary to perform the action. If the argument is a distribution
9681 file name (recognized by embedded slashes), it is processed. If it is
9682 a module, CPAN determines the distribution file in which this module
9683 is included and processes that, following any dependencies named in
9684 the module's META.yml or Makefile.PL (this behavior is controlled by
9685 the configuration parameter C<prerequisites_policy>.)
9687 C<get> downloads a distribution file and untars or unzips it, C<make>
9688 builds it, C<test> runs the test suite, and C<install> installs it.
9690 Any C<make> or C<test> are run unconditionally. An
9692 install <distribution_file>
9694 also is run unconditionally. But for
9698 CPAN checks if an install is actually needed for it and prints
9699 I<module up to date> in the case that the distribution file containing
9700 the module doesn't need to be updated.
9702 CPAN also keeps track of what it has done within the current session
9703 and doesn't try to build a package a second time regardless if it
9704 succeeded or not. It does not repeat a test run if the test
9705 has been run successfully before. Same for install runs.
9707 The C<force> pragma may precede another command (currently: C<get>,
9708 C<make>, C<test>, or C<install>) and executes the command from scratch
9709 and tries to continue in case of some errors. See the section below on
9710 the C<force> and the C<fforce> pragma.
9712 The C<notest> pragma may be used to skip the test part in the build
9717 cpan> notest install Tk
9719 A C<clean> command results in a
9723 being executed within the distribution file's working directory.
9725 =item C<readme>, C<perldoc>, C<look> module or distribution
9727 C<readme> displays the README file of the associated distribution.
9728 C<Look> gets and untars (if not yet done) the distribution file,
9729 changes to the appropriate directory and opens a subshell process in
9730 that directory. C<perldoc> displays the pod documentation of the
9731 module in html or plain text format.
9735 =item C<ls> globbing_expression
9737 The first form lists all distribution files in and below an author's
9738 CPAN directory as they are stored in the CHECKUMS files distributed on
9739 CPAN. The listing goes recursive into all subdirectories.
9741 The second form allows to limit or expand the output with shell
9742 globbing as in the following examples:
9748 The last example is very slow and outputs extra progress indicators
9749 that break the alignment of the result.
9751 Note that globbing only lists directories explicitly asked for, for
9752 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
9753 regarded as a bug and may be changed in future versions.
9757 The C<failed> command reports all distributions that failed on one of
9758 C<make>, C<test> or C<install> for some reason in the currently
9759 running shell session.
9761 =item Persistence between sessions
9763 If the C<YAML> or the c<YAML::Syck> module is installed a record of
9764 the internal state of all modules is written to disk after each step.
9765 The files contain a signature of the currently running perl version
9768 If the configurations variable C<build_dir_reuse> is set to a true
9769 value, then CPAN.pm reads the collected YAML files. If the stored
9770 signature matches the currently running perl the stored state is
9771 loaded into memory such that effectively persistence between sessions
9774 =item The C<force> and the C<fforce> pragma
9776 To speed things up in complex installation scenarios, CPAN.pm keeps
9777 track of what it has already done and refuses to do some things a
9778 second time. A C<get>, a C<make>, and an C<install> are not repeated.
9779 A C<test> is only repeated if the previous test was unsuccessful. The
9780 diagnostic message when CPAN.pm refuses to do something a second time
9781 is one of I<Has already been >C<unwrapped|made|tested successfully> or
9782 something similar. Another situation where CPAN refuses to act is an
9783 C<install> if the according C<test> was not successful.
9785 In all these cases, the user can override the goatish behaviour by
9786 prepending the command with the word force, for example:
9789 cpan> force make AUTHOR/Bar-3.14.tar.gz
9790 cpan> force test Baz
9791 cpan> force install Acme::Meta
9793 Each I<forced> command is executed with the according part of its
9796 The C<fforce> pragma is a variant that emulates a C<force get> which
9797 erases the entire memory followed by the action specified, effectively
9798 restarting the whole get/make/test/install procedure from scratch.
9802 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
9803 Batch jobs can run without a lockfile and do not disturb each other.
9805 The shell offers to run in I<degraded mode> when another process is
9806 holding the lockfile. This is an experimental feature that is not yet
9807 tested very well. This second shell then does not write the history
9808 file, does not use the metadata file and has a different prompt.
9812 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
9813 in the cpan-shell it is intended that you can press C<^C> anytime and
9814 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
9815 to clean up and leave the shell loop. You can emulate the effect of a
9816 SIGTERM by sending two consecutive SIGINTs, which usually means by
9817 pressing C<^C> twice.
9819 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
9820 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
9821 Build.PL> subprocess.
9827 The commands that are available in the shell interface are methods in
9828 the package CPAN::Shell. If you enter the shell command, all your
9829 input is split by the Text::ParseWords::shellwords() routine which
9830 acts like most shells do. The first word is being interpreted as the
9831 method to be called and the rest of the words are treated as arguments
9832 to this method. Continuation lines are supported if a line ends with a
9837 C<autobundle> writes a bundle file into the
9838 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
9839 a list of all modules that are both available from CPAN and currently
9840 installed within @INC. The name of the bundle file is based on the
9841 current date and a counter.
9845 Note: this feature is still in alpha state and may change in future
9848 This commands provides a statistical overview over recent download
9849 activities. The data for this is collected in the YAML file
9850 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
9851 configured or YAML not installed, then no stats are provided.
9855 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
9856 directory so that you can save your own preferences instead of the
9861 recompile() is a very special command in that it takes no argument and
9862 runs the make/test/install cycle with brute force over all installed
9863 dynamically loadable extensions (aka XS modules) with 'force' in
9864 effect. The primary purpose of this command is to finish a network
9865 installation. Imagine, you have a common source tree for two different
9866 architectures. You decide to do a completely independent fresh
9867 installation. You start on one architecture with the help of a Bundle
9868 file produced earlier. CPAN installs the whole Bundle for you, but
9869 when you try to repeat the job on the second architecture, CPAN
9870 responds with a C<"Foo up to date"> message for all modules. So you
9871 invoke CPAN's recompile on the second architecture and you're done.
9873 Another popular use for C<recompile> is to act as a rescue in case your
9874 perl breaks binary compatibility. If one of the modules that CPAN uses
9875 is in turn depending on binary compatibility (so you cannot run CPAN
9876 commands), then you should try the CPAN::Nox module for recovery.
9878 =head2 report Bundle|Distribution|Module
9880 The C<report> command temporarily turns on the C<test_report> config
9881 variable, then runs the C<force test> command with the given
9882 arguments. The C<force> pragma is used to re-run the tests and repeat
9883 every step that might have failed before.
9885 =head2 upgrade [Module|/Regex/]...
9887 The C<upgrade> command first runs an C<r> command with the given
9888 arguments and then installs the newest versions of all modules that
9889 were listed by that.
9891 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
9893 Although it may be considered internal, the class hierarchy does matter
9894 for both users and programmer. CPAN.pm deals with above mentioned four
9895 classes, and all those classes share a set of methods. A classical
9896 single polymorphism is in effect. A metaclass object registers all
9897 objects of all kinds and indexes them with a string. The strings
9898 referencing objects have a separated namespace (well, not completely
9903 words containing a "/" (slash) Distribution
9904 words starting with Bundle:: Bundle
9905 everything else Module or Author
9907 Modules know their associated Distribution objects. They always refer
9908 to the most recent official release. Developers may mark their releases
9909 as unstable development versions (by inserting an underbar into the
9910 module version number which will also be reflected in the distribution
9911 name when you run 'make dist'), so the really hottest and newest
9912 distribution is not always the default. If a module Foo circulates
9913 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
9914 way to install version 1.23 by saying
9918 This would install the complete distribution file (say
9919 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
9920 like to install version 1.23_90, you need to know where the
9921 distribution file resides on CPAN relative to the authors/id/
9922 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
9923 so you would have to say
9925 install BAR/Foo-1.23_90.tar.gz
9927 The first example will be driven by an object of the class
9928 CPAN::Module, the second by an object of class CPAN::Distribution.
9930 =head2 Integrating local directories
9932 Note: this feature is still in alpha state and may change in future
9935 Distribution objects are normally distributions from the CPAN, but
9936 there is a slightly degenerate case for Distribution objects, too, of
9937 projects held on the local disk. These distribution objects have the
9938 same name as the local directory and end with a dot. A dot by itself
9939 is also allowed for the current directory at the time CPAN.pm was
9940 used. All actions such as C<make>, C<test>, and C<install> are applied
9941 directly to that directory. This gives the command C<cpan .> an
9942 interesting touch: while the normal mantra of installing a CPAN module
9943 without CPAN.pm is one of
9945 perl Makefile.PL perl Build.PL
9946 ( go and get prerequisites )
9948 make test ./Build test
9949 make install ./Build install
9951 the command C<cpan .> does all of this at once. It figures out which
9952 of the two mantras is appropriate, fetches and installs all
9953 prerequisites, cares for them recursively and finally finishes the
9954 installation of the module in the current directory, be it a CPAN
9957 The typical usage case is for private modules or working copies of
9958 projects from remote repositories on the local disk.
9960 =head1 CONFIGURATION
9962 When the CPAN module is used for the first time, a configuration
9963 dialog tries to determine a couple of site specific options. The
9964 result of the dialog is stored in a hash reference C< $CPAN::Config >
9965 in a file CPAN/Config.pm.
9967 The default values defined in the CPAN/Config.pm file can be
9968 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
9969 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
9970 added to the search path of the CPAN module before the use() or
9971 require() statements. The mkmyconfig command writes this file for you.
9973 The C<o conf> command has various bells and whistles:
9977 =item completion support
9979 If you have a ReadLine module installed, you can hit TAB at any point
9980 of the commandline and C<o conf> will offer you completion for the
9981 built-in subcommands and/or config variable names.
9983 =item displaying some help: o conf help
9985 Displays a short help
9987 =item displaying current values: o conf [KEY]
9989 Displays the current value(s) for this config variable. Without KEY
9990 displays all subcommands and config variables.
9996 =item changing of scalar values: o conf KEY VALUE
9998 Sets the config variable KEY to VALUE. The empty string can be
9999 specified as usual in shells, with C<''> or C<"">
10003 o conf wget /usr/bin/wget
10005 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
10007 If a config variable name ends with C<list>, it is a list. C<o conf
10008 KEY shift> removes the first element of the list, C<o conf KEY pop>
10009 removes the last element of the list. C<o conf KEYS unshift LIST>
10010 prepends a list of values to the list, C<o conf KEYS push LIST>
10011 appends a list of valued to the list.
10013 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
10016 Finally, any other list of arguments is taken as a new list value for
10017 the KEY variable discarding the previous value.
10021 o conf urllist unshift http://cpan.dev.local/CPAN
10022 o conf urllist splice 3 1
10023 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
10025 =item reverting to saved: o conf defaults
10027 Reverts all config variables to the state in the saved config file.
10029 =item saving the config: o conf commit
10031 Saves all config variables to the current config file (CPAN/Config.pm
10032 or CPAN/MyConfig.pm that was loaded at start).
10036 The configuration dialog can be started any time later again by
10037 issuing the command C< o conf init > in the CPAN shell. A subset of
10038 the configuration dialog can be run by issuing C<o conf init WORD>
10039 where WORD is any valid config variable or a regular expression.
10041 =head2 Config Variables
10043 Currently the following keys in the hash reference $CPAN::Config are
10046 applypatch path to external prg
10047 auto_commit commit all changes to config variables to disk
10048 build_cache size of cache for directories to build modules
10049 build_dir locally accessible directory to build modules
10050 build_dir_reuse boolean if distros in build_dir are persistent
10051 build_requires_install_policy
10052 to install or not to install when a module is
10053 only needed for building. yes|no|ask/yes|ask/no
10054 bzip2 path to external prg
10055 cache_metadata use serializer to cache metadata
10056 commands_quote prefered character to use for quoting external
10057 commands when running them. Defaults to double
10058 quote on Windows, single tick everywhere else;
10059 can be set to space to disable quoting
10060 check_sigs if signatures should be verified
10061 colorize_debug Term::ANSIColor attributes for debugging output
10062 colorize_output boolean if Term::ANSIColor should colorize output
10063 colorize_print Term::ANSIColor attributes for normal output
10064 colorize_warn Term::ANSIColor attributes for warnings
10065 commandnumber_in_prompt
10066 boolean if you want to see current command number
10067 cpan_home local directory reserved for this package
10068 curl path to external prg
10069 dontload_hash DEPRECATED
10070 dontload_list arrayref: modules in the list will not be
10071 loaded by the CPAN::has_inst() routine
10072 ftp path to external prg
10073 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
10074 ftp_proxy proxy host for ftp requests
10076 gpg path to external prg
10077 gzip location of external program gzip
10078 histfile file to maintain history between sessions
10079 histsize maximum number of lines to keep in histfile
10080 http_proxy proxy host for http requests
10081 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
10082 after this many seconds inactivity. Set to 0 to
10084 index_expire after this many days refetch index files
10085 inhibit_startup_message
10086 if true, does not print the startup message
10087 keep_source_where directory in which to keep the source (if we do)
10088 lynx path to external prg
10089 make location of external make program
10090 make_arg arguments that should always be passed to 'make'
10091 make_install_make_command
10092 the make command for running 'make install', for
10093 example 'sudo make'
10094 make_install_arg same as make_arg for 'make install'
10095 makepl_arg arguments passed to 'perl Makefile.PL'
10096 mbuild_arg arguments passed to './Build'
10097 mbuild_install_arg arguments passed to './Build install'
10098 mbuild_install_build_command
10099 command to use instead of './Build' when we are
10100 in the install stage, for example 'sudo ./Build'
10101 mbuildpl_arg arguments passed to 'perl Build.PL'
10102 ncftp path to external prg
10103 ncftpget path to external prg
10104 no_proxy don't proxy to these hosts/domains (comma separated list)
10105 pager location of external program more (or any pager)
10106 password your password if you CPAN server wants one
10107 patch path to external prg
10108 prefer_installer legal values are MB and EUMM: if a module comes
10109 with both a Makefile.PL and a Build.PL, use the
10110 former (EUMM) or the latter (MB); if the module
10111 comes with only one of the two, that one will be
10113 prerequisites_policy
10114 what to do if you are missing module prerequisites
10115 ('follow' automatically, 'ask' me, or 'ignore')
10116 prefs_dir local directory to store per-distro build options
10117 proxy_user username for accessing an authenticating proxy
10118 proxy_pass password for accessing an authenticating proxy
10119 randomize_urllist add some randomness to the sequence of the urllist
10120 scan_cache controls scanning of cache ('atstart' or 'never')
10121 shell your favorite shell
10122 show_upload_date boolean if commands should try to determine upload date
10123 tar location of external program tar
10124 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
10125 (and nonsense for characters outside latin range)
10126 term_ornaments boolean to turn ReadLine ornamenting on/off
10127 test_report email test reports (if CPAN::Reporter is installed)
10128 unzip location of external program unzip
10129 urllist arrayref to nearby CPAN sites (or equivalent locations)
10130 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
10131 username your username if you CPAN server wants one
10132 wait_list arrayref to a wait server to try (See CPAN::WAIT)
10133 wget path to external prg
10134 yaml_module which module to use to read/write YAML files
10136 You can set and query each of these options interactively in the cpan
10137 shell with the C<o conf> or the C<o conf init> command as specified below.
10141 =item C<o conf E<lt>scalar optionE<gt>>
10143 prints the current value of the I<scalar option>
10145 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
10147 Sets the value of the I<scalar option> to I<value>
10149 =item C<o conf E<lt>list optionE<gt>>
10151 prints the current value of the I<list option> in MakeMaker's
10154 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
10156 shifts or pops the array in the I<list option> variable
10158 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
10160 works like the corresponding perl commands.
10162 =item interactive editing: o conf init [MATCH|LIST]
10164 Runs an interactive configuration dialog for matching variables.
10165 Without argument runs the dialog over all supported config variables.
10166 To specify a MATCH the argument must be enclosed by slashes.
10170 o conf init ftp_passive ftp_proxy
10171 o conf init /color/
10173 Note: this method of setting config variables often provides more
10174 explanation about the functioning of a variable than the manpage.
10178 =head2 CPAN::anycwd($path): Note on config variable getcwd
10180 CPAN.pm changes the current working directory often and needs to
10181 determine its own current working directory. Per default it uses
10182 Cwd::cwd but if this doesn't work on your system for some reason,
10183 alternatives can be configured according to the following table:
10201 Calls the external command cwd.
10205 =head2 Note on the format of the urllist parameter
10207 urllist parameters are URLs according to RFC 1738. We do a little
10208 guessing if your URL is not compliant, but if you have problems with
10209 C<file> URLs, please try the correct format. Either:
10211 file://localhost/whatever/ftp/pub/CPAN/
10215 file:///home/ftp/pub/CPAN/
10217 =head2 The urllist parameter has CD-ROM support
10219 The C<urllist> parameter of the configuration table contains a list of
10220 URLs that are to be used for downloading. If the list contains any
10221 C<file> URLs, CPAN always tries to get files from there first. This
10222 feature is disabled for index files. So the recommendation for the
10223 owner of a CD-ROM with CPAN contents is: include your local, possibly
10224 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
10226 o conf urllist push file://localhost/CDROM/CPAN
10228 CPAN.pm will then fetch the index files from one of the CPAN sites
10229 that come at the beginning of urllist. It will later check for each
10230 module if there is a local copy of the most recent version.
10232 Another peculiarity of urllist is that the site that we could
10233 successfully fetch the last file from automatically gets a preference
10234 token and is tried as the first site for the next request. So if you
10235 add a new site at runtime it may happen that the previously preferred
10236 site will be tried another time. This means that if you want to disallow
10237 a site for the next transfer, it must be explicitly removed from
10240 =head2 Maintaining the urllist parameter
10242 If you have YAML.pm (or some other YAML module configured in
10243 C<yaml_module>) installed, CPAN.pm collects a few statistical data
10244 about recent downloads. You can view the statistics with the C<hosts>
10245 command or inspect them directly by looking into the C<FTPstats.yml>
10246 file in your C<cpan_home> directory.
10248 To get some interesting statistics it is recommended to set the
10249 C<randomize_urllist> parameter that introduces some amount of
10250 randomness into the URL selection.
10252 =head2 The C<requires> and C<build_requires> dependency declarations
10254 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
10255 a distribution are treated differently depending on the config
10256 variable C<build_requires_install_policy>. By setting
10257 C<build_requires_install_policy> to C<no> such a module is not being
10258 installed. It is only built and tested and then kept in the list of
10259 tested but uninstalled modules. As such it is available during the
10260 build of the dependent module by integrating the path to the
10261 C<blib/arch> and C<blib/lib> directories in the environment variable
10262 PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
10263 both modules declared as C<requires> and those declared as
10264 C<build_requires> are treated alike. By setting to C<ask/yes> or
10265 C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
10267 =head2 Configuration for individual distributions (I<Distroprefs>)
10269 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
10270 still considered beta quality)
10272 Distributions on the CPAN usually behave according to what we call the
10273 CPAN mantra. Or since the event of Module::Build we should talk about
10276 perl Makefile.PL perl Build.PL
10278 make test ./Build test
10279 make install ./Build install
10281 But some modules cannot be built with this mantra. They try to get
10282 some extra data from the user via the environment, extra arguments or
10283 interactively thus disturbing the installation of large bundles like
10284 Phalanx100 or modules with many dependencies like Plagger.
10286 The distroprefs system of C<CPAN.pm> addresses this problem by
10287 allowing the user to specify extra informations and recipes in YAML
10294 pass additional arguments to one of the four commands,
10298 set environment variables
10302 instantiate an Expect object that reads from the console, waits for
10303 some regular expressions and enters some answers
10307 temporarily override assorted C<CPAN.pm> configuration variables
10311 disable the installation of an object altogether
10315 See the YAML and Data::Dumper files that come with the C<CPAN.pm>
10316 distribution in the C<distroprefs/> directory for examples.
10320 The YAML files themselves must have the C<.yml> extension, all other
10321 files are ignored (for two exceptions see I<Fallback Data::Dumper and
10322 Storable> below). The containing directory can be specified in
10323 C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
10324 prefs_dir> in the CPAN shell to set and activate the distroprefs
10327 Every YAML file may contain arbitrary documents according to the YAML
10328 specification and every single document is treated as an entity that
10329 can specify the treatment of a single distribution.
10331 The names of the files can be picked freely, C<CPAN.pm> always reads
10332 all files (in alphabetical order) and takes the key C<match> (see
10333 below in I<Language Specs>) as a hashref containing match criteria
10334 that determine if the current distribution matches the YAML document
10337 =head2 Fallback Data::Dumper and Storable
10339 If neither your configured C<yaml_module> nor YAML.pm is installed
10340 CPAN.pm falls back to using Data::Dumper and Storable and looks for
10341 files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
10342 directory. These files are expected to contain one or more hashrefs.
10343 For Data::Dumper generated files, this is expected to be done with by
10344 defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
10347 ysh < somefile.yml > somefile.dd
10349 For Storable files the rule is that they must be constructed such that
10350 C<Storable::retrieve(file)> returns an array reference and the array
10351 elements represent one distropref object each. The conversion from
10352 YAML would look like so:
10354 perl -MYAML=LoadFile -MStorable=nstore -e '
10355 @y=LoadFile(shift);
10356 nstore(\@y, shift)' somefile.yml somefile.st
10358 In bootstrapping situations it is usually sufficient to translate only
10359 a few YAML files to Data::Dumper for the crucial modules like
10360 C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
10361 over Data::Dumper, remember to pull out a Storable version that writes
10362 an older format than all the other Storable versions that will need to
10367 The following example contains all supported keywords and structures
10368 with the exception of C<eexpect> which can be used instead of
10374 module: "Dancing::Queen"
10375 distribution: "^CHACHACHA/Dancing-"
10376 perl: "/usr/local/cariba-perl/bin/perl"
10378 archname: "freebsd"
10384 - "--somearg=specialcase"
10389 - "Which is your favorite fruit"
10401 commendline: "echo SKIPPING make"
10414 WANT_TO_INSTALL: YES
10417 - "Do you really want to install"
10421 - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
10424 =head2 Language Specs
10426 Every YAML document represents a single hash reference. The valid keys
10427 in this hash are as follows:
10431 =item comment [scalar]
10435 =item cpanconfig [hash]
10437 Temporarily override assorted C<CPAN.pm> configuration variables.
10439 Supported are: C<build_requires_install_policy>, C<check_sigs>,
10440 C<make>, C<make_install_make_command>, C<prefer_installer>,
10441 C<test_report>. Please report as a bug when you need another one
10444 =item disabled [boolean]
10446 Specifies that this distribution shall not be processed at all.
10448 =item goto [string]
10450 The canonical name of a delegate distribution that shall be installed
10451 instead. Useful when a new version, although it tests OK itself,
10452 breaks something else or a developer release or a fork is already
10453 uploaded that is better than the last released version.
10455 =item install [hash]
10457 Processing instructions for the C<make install> or C<./Build install>
10458 phase of the CPAN mantra. See below under I<Processiong Instructions>.
10462 Processing instructions for the C<make> or C<./Build> phase of the
10463 CPAN mantra. See below under I<Processiong Instructions>.
10467 A hashref with one or more of the keys C<distribution>, C<modules>,
10468 C<perl>, and C<perlconfig> that specify if a document is targeted at a
10469 specific CPAN distribution or installation.
10471 The corresponding values are interpreted as regular expressions. The
10472 C<distribution> related one will be matched against the canonical
10473 distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
10475 The C<module> related one will be matched against I<all> modules
10476 contained in the distribution until one module matches.
10478 The C<perl> related one will be matched against C<$^X>.
10480 The value associated with C<perlconfig> is itself a hashref that is
10481 matched against corresponding values in the C<%Config::Config> hash
10482 living in the C< Config.pm > module.
10484 If more than one restriction of C<module>, C<distribution>, and
10485 C<perl> is specified, the results of the separately computed match
10486 values must all match. If this is the case then the hashref
10487 represented by the YAML document is returned as the preference
10488 structure for the current distribution.
10490 =item patches [array]
10492 An array of patches on CPAN or on the local disk to be applied in
10493 order via the external patch program. If the value for the C<-p>
10494 parameter is C<0> or C<1> is determined by reading the patch
10497 Note: if the C<applypatch> program is installed and C<CPAN::Config>
10498 knows about it B<and> a patch is written by the C<makepatch> program,
10499 then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
10500 and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
10505 Processing instructions for the C<perl Makefile.PL> or C<perl
10506 Build.PL> phase of the CPAN mantra. See below under I<Processiong
10511 Processing instructions for the C<make test> or C<./Build test> phase
10512 of the CPAN mantra. See below under I<Processiong Instructions>.
10516 =head2 Processing Instructions
10522 Arguments to be added to the command line
10526 A full commandline that will be executed as it stands by a system
10527 call. During the execution the environment variable PERL will is set
10528 to $^X. If C<commandline> is specified, the content of C<args> is not
10531 =item eexpect [hash]
10533 Extended C<expect>. This is a hash reference with three allowed keys,
10534 C<mode>, C<timeout>, and C<talk>.
10536 C<mode> may have the values C<deterministic> for the case where all
10537 questions come in the order written down and C<anyorder> for the case
10538 where the questions may come in any order. The default mode is
10541 C<timeout> denotes a timeout in seconds. Floating point timeouts are
10542 OK. In the case of a C<mode=deterministic> the timeout denotes the
10543 timeout per question, in the case of C<mode=anyorder> it denotes the
10544 timeout per byte received from the stream or questions.
10546 C<talk> is a reference to an array that contains alternating questions
10547 and answers. Questions are regular expressions and answers are literal
10548 strings. The Expect module will then watch the stream coming from the
10549 execution of the external program (C<perl Makefile.PL>, C<perl
10550 Build.PL>, C<make>, etc.).
10552 In the case of C<mode=deterministic> the CPAN.pm will inject the
10553 according answer as soon as the stream matches the regular expression.
10554 In the case of C<mode=anyorder> the CPAN.pm will answer a question as
10555 soon as the timeout is reached for the next byte in the input stream.
10556 In the latter case it removes the according question/answer pair from
10557 the array, so if you want to answer the question C<Do you really want
10558 to do that> several times, then it must be included in the array at
10559 least as often as you want this answer to be given.
10563 Environment variables to be set during the command
10565 =item expect [array]
10567 C<< expect: <array> >> is a short notation for
10570 mode: deterministic
10576 =head2 Schema verification with C<Kwalify>
10578 If you have the C<Kwalify> module installed (which is part of the
10579 Bundle::CPANxxl), then all your distroprefs files are checked for
10580 syntactical correctness.
10582 =head2 Example Distroprefs Files
10584 C<CPAN.pm> comes with a collection of example YAML files. Note that these
10585 are really just examples and should not be used without care because
10586 they cannot fit everybody's purpose. After all the authors of the
10587 packages that ask questions had a need to ask, so you should watch
10588 their questions and adjust the examples to your environment and your
10589 needs. You have beend warned:-)
10591 =head1 PROGRAMMER'S INTERFACE
10593 If you do not enter the shell, the available shell commands are both
10594 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
10595 functions in the calling package (C<install(...)>). Before calling low-level
10596 commands it makes sense to initialize components of CPAN you need, e.g.:
10598 CPAN::HandleConfig->load;
10599 CPAN::Shell::setup_output;
10600 CPAN::Index->reload;
10602 High-level commands do such initializations automatically.
10604 There's currently only one class that has a stable interface -
10605 CPAN::Shell. All commands that are available in the CPAN shell are
10606 methods of the class CPAN::Shell. Each of the commands that produce
10607 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
10608 the IDs of all modules within the list.
10612 =item expand($type,@things)
10614 The IDs of all objects available within a program are strings that can
10615 be expanded to the corresponding real objects with the
10616 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
10617 list of CPAN::Module objects according to the C<@things> arguments
10618 given. In scalar context it only returns the first element of the
10621 =item expandany(@things)
10623 Like expand, but returns objects of the appropriate type, i.e.
10624 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
10625 CPAN::Distribution objects for distributions. Note: it does not expand
10626 to CPAN::Author objects.
10628 =item Programming Examples
10630 This enables the programmer to do operations that combine
10631 functionalities that are available in the shell.
10633 # install everything that is outdated on my disk:
10634 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
10636 # install my favorite programs if necessary:
10637 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
10638 CPAN::Shell->install($mod);
10641 # list all modules on my disk that have no VERSION number
10642 for $mod (CPAN::Shell->expand("Module","/./")){
10643 next unless $mod->inst_file;
10644 # MakeMaker convention for undefined $VERSION:
10645 next unless $mod->inst_version eq "undef";
10646 print "No VERSION in ", $mod->id, "\n";
10649 # find out which distribution on CPAN contains a module:
10650 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
10652 Or if you want to write a cronjob to watch The CPAN, you could list
10653 all modules that need updating. First a quick and dirty way:
10655 perl -e 'use CPAN; CPAN::Shell->r;'
10657 If you don't want to get any output in the case that all modules are
10658 up to date, you can parse the output of above command for the regular
10659 expression //modules are up to date// and decide to mail the output
10660 only if it doesn't match. Ick?
10662 If you prefer to do it more in a programmer style in one single
10663 process, maybe something like this suits you better:
10665 # list all modules on my disk that have newer versions on CPAN
10666 for $mod (CPAN::Shell->expand("Module","/./")){
10667 next unless $mod->inst_file;
10668 next if $mod->uptodate;
10669 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
10670 $mod->id, $mod->inst_version, $mod->cpan_version;
10673 If that gives you too much output every day, you maybe only want to
10674 watch for three modules. You can write
10676 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
10678 as the first line instead. Or you can combine some of the above
10681 # watch only for a new mod_perl module
10682 $mod = CPAN::Shell->expand("Module","mod_perl");
10683 exit if $mod->uptodate;
10684 # new mod_perl arrived, let me know all update recommendations
10689 =head2 Methods in the other Classes
10693 =item CPAN::Author::as_glimpse()
10695 Returns a one-line description of the author
10697 =item CPAN::Author::as_string()
10699 Returns a multi-line description of the author
10701 =item CPAN::Author::email()
10703 Returns the author's email address
10705 =item CPAN::Author::fullname()
10707 Returns the author's name
10709 =item CPAN::Author::name()
10711 An alias for fullname
10713 =item CPAN::Bundle::as_glimpse()
10715 Returns a one-line description of the bundle
10717 =item CPAN::Bundle::as_string()
10719 Returns a multi-line description of the bundle
10721 =item CPAN::Bundle::clean()
10723 Recursively runs the C<clean> method on all items contained in the bundle.
10725 =item CPAN::Bundle::contains()
10727 Returns a list of objects' IDs contained in a bundle. The associated
10728 objects may be bundles, modules or distributions.
10730 =item CPAN::Bundle::force($method,@args)
10732 Forces CPAN to perform a task that it normally would have refused to
10733 do. Force takes as arguments a method name to be called and any number
10734 of additional arguments that should be passed to the called method.
10735 The internals of the object get the needed changes so that CPAN.pm
10736 does not refuse to take the action. The C<force> is passed recursively
10737 to all contained objects. See also the section above on the C<force>
10738 and the C<fforce> pragma.
10740 =item CPAN::Bundle::get()
10742 Recursively runs the C<get> method on all items contained in the bundle
10744 =item CPAN::Bundle::inst_file()
10746 Returns the highest installed version of the bundle in either @INC or
10747 C<$CPAN::Config->{cpan_home}>. Note that this is different from
10748 CPAN::Module::inst_file.
10750 =item CPAN::Bundle::inst_version()
10752 Like CPAN::Bundle::inst_file, but returns the $VERSION
10754 =item CPAN::Bundle::uptodate()
10756 Returns 1 if the bundle itself and all its members are uptodate.
10758 =item CPAN::Bundle::install()
10760 Recursively runs the C<install> method on all items contained in the bundle
10762 =item CPAN::Bundle::make()
10764 Recursively runs the C<make> method on all items contained in the bundle
10766 =item CPAN::Bundle::readme()
10768 Recursively runs the C<readme> method on all items contained in the bundle
10770 =item CPAN::Bundle::test()
10772 Recursively runs the C<test> method on all items contained in the bundle
10774 =item CPAN::Distribution::as_glimpse()
10776 Returns a one-line description of the distribution
10778 =item CPAN::Distribution::as_string()
10780 Returns a multi-line description of the distribution
10782 =item CPAN::Distribution::author
10784 Returns the CPAN::Author object of the maintainer who uploaded this
10787 =item CPAN::Distribution::clean()
10789 Changes to the directory where the distribution has been unpacked and
10790 runs C<make clean> there.
10792 =item CPAN::Distribution::containsmods()
10794 Returns a list of IDs of modules contained in a distribution file.
10795 Only works for distributions listed in the 02packages.details.txt.gz
10796 file. This typically means that only the most recent version of a
10797 distribution is covered.
10799 =item CPAN::Distribution::cvs_import()
10801 Changes to the directory where the distribution has been unpacked and
10802 runs something like
10804 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
10808 =item CPAN::Distribution::dir()
10810 Returns the directory into which this distribution has been unpacked.
10812 =item CPAN::Distribution::force($method,@args)
10814 Forces CPAN to perform a task that it normally would have refused to
10815 do. Force takes as arguments a method name to be called and any number
10816 of additional arguments that should be passed to the called method.
10817 The internals of the object get the needed changes so that CPAN.pm
10818 does not refuse to take the action. See also the section above on the
10819 C<force> and the C<fforce> pragma.
10821 =item CPAN::Distribution::get()
10823 Downloads the distribution from CPAN and unpacks it. Does nothing if
10824 the distribution has already been downloaded and unpacked within the
10827 =item CPAN::Distribution::install()
10829 Changes to the directory where the distribution has been unpacked and
10830 runs the external command C<make install> there. If C<make> has not
10831 yet been run, it will be run first. A C<make test> will be issued in
10832 any case and if this fails, the install will be canceled. The
10833 cancellation can be avoided by letting C<force> run the C<install> for
10836 This install method has only the power to install the distribution if
10837 there are no dependencies in the way. To install an object and all of
10838 its dependencies, use CPAN::Shell->install.
10840 Note that install() gives no meaningful return value. See uptodate().
10842 =item CPAN::Distribution::install_tested()
10844 Install all the distributions that have been tested sucessfully but
10845 not yet installed. See also C<is_tested>.
10847 =item CPAN::Distribution::isa_perl()
10849 Returns 1 if this distribution file seems to be a perl distribution.
10850 Normally this is derived from the file name only, but the index from
10851 CPAN can contain a hint to achieve a return value of true for other
10854 =item CPAN::Distribution::is_tested()
10856 List all the distributions that have been tested sucessfully but not
10857 yet installed. See also C<install_tested>.
10859 =item CPAN::Distribution::look()
10861 Changes to the directory where the distribution has been unpacked and
10862 opens a subshell there. Exiting the subshell returns.
10864 =item CPAN::Distribution::make()
10866 First runs the C<get> method to make sure the distribution is
10867 downloaded and unpacked. Changes to the directory where the
10868 distribution has been unpacked and runs the external commands C<perl
10869 Makefile.PL> or C<perl Build.PL> and C<make> there.
10871 =item CPAN::Distribution::perldoc()
10873 Downloads the pod documentation of the file associated with a
10874 distribution (in html format) and runs it through the external
10875 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
10876 isn't available, it converts it to plain text with external
10877 command html2text and runs it through the pager specified
10878 in C<$CPAN::Config->{pager}>
10880 =item CPAN::Distribution::prefs()
10882 Returns the hash reference from the first matching YAML file that the
10883 user has deposited in the C<prefs_dir/> directory. The first
10884 succeeding match wins. The files in the C<prefs_dir/> are processed
10885 alphabetically and the canonical distroname (e.g.
10886 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
10887 stored in the $root->{match}{distribution} attribute value.
10888 Additionally all module names contained in a distribution are matched
10889 agains the regular expressions in the $root->{match}{module} attribute
10890 value. The two match values are ANDed together. Each of the two
10891 attributes are optional.
10893 =item CPAN::Distribution::prereq_pm()
10895 Returns the hash reference that has been announced by a distribution
10896 as the the C<requires> and C<build_requires> elements. These can be
10897 declared either by the C<META.yml> (if authoritative) or can be
10898 deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
10899 or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
10900 a comment in the produced C<Makefile>. I<Note>: this method only works
10901 after an attempt has been made to C<make> the distribution. Returns
10904 =item CPAN::Distribution::readme()
10906 Downloads the README file associated with a distribution and runs it
10907 through the pager specified in C<$CPAN::Config->{pager}>.
10909 =item CPAN::Distribution::read_yaml()
10911 Returns the content of the META.yml of this distro as a hashref. Note:
10912 works only after an attempt has been made to C<make> the distribution.
10913 Returns undef otherwise. Also returns undef if the content of META.yml
10914 is not authoritative. (The rules about what exactly makes the content
10915 authoritative are still in flux.)
10917 =item CPAN::Distribution::test()
10919 Changes to the directory where the distribution has been unpacked and
10920 runs C<make test> there.
10922 =item CPAN::Distribution::uptodate()
10924 Returns 1 if all the modules contained in the distribution are
10925 uptodate. Relies on containsmods.
10927 =item CPAN::Index::force_reload()
10929 Forces a reload of all indices.
10931 =item CPAN::Index::reload()
10933 Reloads all indices if they have not been read for more than
10934 C<$CPAN::Config->{index_expire}> days.
10936 =item CPAN::InfoObj::dump()
10938 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
10939 inherit this method. It prints the data structure associated with an
10940 object. Useful for debugging. Note: the data structure is considered
10941 internal and thus subject to change without notice.
10943 =item CPAN::Module::as_glimpse()
10945 Returns a one-line description of the module in four columns: The
10946 first column contains the word C<Module>, the second column consists
10947 of one character: an equals sign if this module is already installed
10948 and uptodate, a less-than sign if this module is installed but can be
10949 upgraded, and a space if the module is not installed. The third column
10950 is the name of the module and the fourth column gives maintainer or
10951 distribution information.
10953 =item CPAN::Module::as_string()
10955 Returns a multi-line description of the module
10957 =item CPAN::Module::clean()
10959 Runs a clean on the distribution associated with this module.
10961 =item CPAN::Module::cpan_file()
10963 Returns the filename on CPAN that is associated with the module.
10965 =item CPAN::Module::cpan_version()
10967 Returns the latest version of this module available on CPAN.
10969 =item CPAN::Module::cvs_import()
10971 Runs a cvs_import on the distribution associated with this module.
10973 =item CPAN::Module::description()
10975 Returns a 44 character description of this module. Only available for
10976 modules listed in The Module List (CPAN/modules/00modlist.long.html
10977 or 00modlist.long.txt.gz)
10979 =item CPAN::Module::distribution()
10981 Returns the CPAN::Distribution object that contains the current
10982 version of this module.
10984 =item CPAN::Module::dslip_status()
10986 Returns a hash reference. The keys of the hash are the letters C<D>,
10987 C<S>, C<L>, C<I>, and <P>, for development status, support level,
10988 language, interface and public licence respectively. The data for the
10989 DSLIP status are collected by pause.perl.org when authors register
10990 their namespaces. The values of the 5 hash elements are one-character
10991 words whose meaning is described in the table below. There are also 5
10992 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
10993 verbose value of the 5 status variables.
10995 Where the 'DSLIP' characters have the following meanings:
10997 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
10998 i - Idea, listed to gain consensus or as a placeholder
10999 c - under construction but pre-alpha (not yet released)
11000 a/b - Alpha/Beta testing
11002 M - Mature (no rigorous definition)
11003 S - Standard, supplied with Perl 5
11008 u - Usenet newsgroup comp.lang.perl.modules
11009 n - None known, try comp.lang.perl.modules
11010 a - abandoned; volunteers welcome to take over maintainance
11013 p - Perl-only, no compiler needed, should be platform independent
11014 c - C and perl, a C compiler will be needed
11015 h - Hybrid, written in perl with optional C code, no compiler needed
11016 + - C++ and perl, a C++ compiler will be needed
11017 o - perl and another language other than C or C++
11019 I - Interface Style
11020 f - plain Functions, no references used
11021 h - hybrid, object and function interfaces available
11022 n - no interface at all (huh?)
11023 r - some use of unblessed References or ties
11024 O - Object oriented using blessed references and/or inheritance
11027 p - Standard-Perl: user may choose between GPL and Artistic
11028 g - GPL: GNU General Public License
11029 l - LGPL: "GNU Lesser General Public License" (previously known as
11030 "GNU Library General Public License")
11031 b - BSD: The BSD License
11032 a - Artistic license alone
11033 o - open source: appoved by www.opensource.org
11034 d - allows distribution without restrictions
11035 r - restricted distribtion
11036 n - no license at all
11038 =item CPAN::Module::force($method,@args)
11040 Forces CPAN to perform a task that it normally would have refused to
11041 do. Force takes as arguments a method name to be called and any number
11042 of additional arguments that should be passed to the called method.
11043 The internals of the object get the needed changes so that CPAN.pm
11044 does not refuse to take the action. See also the section above on the
11045 C<force> and the C<fforce> pragma.
11047 =item CPAN::Module::get()
11049 Runs a get on the distribution associated with this module.
11051 =item CPAN::Module::inst_file()
11053 Returns the filename of the module found in @INC. The first file found
11054 is reported just like perl itself stops searching @INC when it finds a
11057 =item CPAN::Module::available_file()
11059 Returns the filename of the module found in PERL5LIB or @INC. The
11060 first file found is reported. The advantage of this method over
11061 C<inst_file> is that modules that have been tested but not yet
11062 installed are included because PERL5LIB keeps track of tested modules.
11064 =item CPAN::Module::inst_version()
11066 Returns the version number of the installed module in readable format.
11068 =item CPAN::Module::available_version()
11070 Returns the version number of the available module in readable format.
11072 =item CPAN::Module::install()
11074 Runs an C<install> on the distribution associated with this module.
11076 =item CPAN::Module::look()
11078 Changes to the directory where the distribution associated with this
11079 module has been unpacked and opens a subshell there. Exiting the
11082 =item CPAN::Module::make()
11084 Runs a C<make> on the distribution associated with this module.
11086 =item CPAN::Module::manpage_headline()
11088 If module is installed, peeks into the module's manpage, reads the
11089 headline and returns it. Moreover, if the module has been downloaded
11090 within this session, does the equivalent on the downloaded module even
11091 if it is not installed.
11093 =item CPAN::Module::perldoc()
11095 Runs a C<perldoc> on this module.
11097 =item CPAN::Module::readme()
11099 Runs a C<readme> on the distribution associated with this module.
11101 =item CPAN::Module::test()
11103 Runs a C<test> on the distribution associated with this module.
11105 =item CPAN::Module::uptodate()
11107 Returns 1 if the module is installed and up-to-date.
11109 =item CPAN::Module::userid()
11111 Returns the author's ID of the module.
11115 =head2 Cache Manager
11117 Currently the cache manager only keeps track of the build directory
11118 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
11119 deletes complete directories below C<build_dir> as soon as the size of
11120 all directories there gets bigger than $CPAN::Config->{build_cache}
11121 (in MB). The contents of this cache may be used for later
11122 re-installations that you intend to do manually, but will never be
11123 trusted by CPAN itself. This is due to the fact that the user might
11124 use these directories for building modules on different architectures.
11126 There is another directory ($CPAN::Config->{keep_source_where}) where
11127 the original distribution files are kept. This directory is not
11128 covered by the cache manager and must be controlled by the user. If
11129 you choose to have the same directory as build_dir and as
11130 keep_source_where directory, then your sources will be deleted with
11131 the same fifo mechanism.
11135 A bundle is just a perl module in the namespace Bundle:: that does not
11136 define any functions or methods. It usually only contains documentation.
11138 It starts like a perl module with a package declaration and a $VERSION
11139 variable. After that the pod section looks like any other pod with the
11140 only difference being that I<one special pod section> exists starting with
11145 In this pod section each line obeys the format
11147 Module_Name [Version_String] [- optional text]
11149 The only required part is the first field, the name of a module
11150 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
11151 of the line is optional. The comment part is delimited by a dash just
11152 as in the man page header.
11154 The distribution of a bundle should follow the same convention as
11155 other distributions.
11157 Bundles are treated specially in the CPAN package. If you say 'install
11158 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
11159 the modules in the CONTENTS section of the pod. You can install your
11160 own Bundles locally by placing a conformant Bundle file somewhere into
11161 your @INC path. The autobundle() command which is available in the
11162 shell interface does that for you by including all currently installed
11163 modules in a snapshot bundle file.
11165 =head1 PREREQUISITES
11167 If you have a local mirror of CPAN and can access all files with
11168 "file:" URLs, then you only need a perl better than perl5.003 to run
11169 this module. Otherwise Net::FTP is strongly recommended. LWP may be
11170 required for non-UNIX systems or if your nearest CPAN site is
11171 associated with a URL that is not C<ftp:>.
11173 If you have neither Net::FTP nor LWP, there is a fallback mechanism
11174 implemented for an external ftp command or for an external lynx
11179 =head2 Finding packages and VERSION
11181 This module presumes that all packages on CPAN
11187 declare their $VERSION variable in an easy to parse manner. This
11188 prerequisite can hardly be relaxed because it consumes far too much
11189 memory to load all packages into the running program just to determine
11190 the $VERSION variable. Currently all programs that are dealing with
11191 version use something like this
11193 perl -MExtUtils::MakeMaker -le \
11194 'print MM->parse_version(shift)' filename
11196 If you are author of a package and wonder if your $VERSION can be
11197 parsed, please try the above method.
11201 come as compressed or gzipped tarfiles or as zip files and contain a
11202 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
11203 without much enthusiasm).
11209 The debugging of this module is a bit complex, because we have
11210 interferences of the software producing the indices on CPAN, of the
11211 mirroring process on CPAN, of packaging, of configuration, of
11212 synchronicity, and of bugs within CPAN.pm.
11214 For debugging the code of CPAN.pm itself in interactive mode some more
11215 or less useful debugging aid can be turned on for most packages within
11216 CPAN.pm with one of
11220 =item o debug package...
11222 sets debug mode for packages.
11224 =item o debug -package...
11226 unsets debug mode for packages.
11230 turns debugging on for all packages.
11232 =item o debug number
11236 which sets the debugging packages directly. Note that C<o debug 0>
11237 turns debugging off.
11239 What seems quite a successful strategy is the combination of C<reload
11240 cpan> and the debugging switches. Add a new debug statement while
11241 running in the shell and then issue a C<reload cpan> and see the new
11242 debugging messages immediately without losing the current context.
11244 C<o debug> without an argument lists the valid package names and the
11245 current set of packages in debugging mode. C<o debug> has built-in
11246 completion support.
11248 For debugging of CPAN data there is the C<dump> command which takes
11249 the same arguments as make/test/install and outputs each object's
11250 Data::Dumper dump. If an argument looks like a perl variable and
11251 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
11252 Data::Dumper directly.
11254 =head2 Floppy, Zip, Offline Mode
11256 CPAN.pm works nicely without network too. If you maintain machines
11257 that are not networked at all, you should consider working with file:
11258 URLs. Of course, you have to collect your modules somewhere first. So
11259 you might use CPAN.pm to put together all you need on a networked
11260 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
11261 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
11262 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
11263 with this floppy. See also below the paragraph about CD-ROM support.
11265 =head2 Basic Utilities for Programmers
11269 =item has_inst($module)
11271 Returns true if the module is installed. Used to load all modules into
11272 the running CPAN.pm which are considered optional. The config variable
11273 C<dontload_list> can be used to intercept the C<has_inst()> call such
11274 that an optional module is not loaded despite being available. For
11275 example the following command will prevent that C<YAML.pm> is being
11278 cpan> o conf dontload_list push YAML
11280 See the source for details.
11282 =item has_usable($module)
11284 Returns true if the module is installed and is in a usable state. Only
11285 useful for a handful of modules that are used internally. See the
11286 source for details.
11288 =item instance($module)
11290 The constructor for all the singletons used to represent modules,
11291 distributions, authors and bundles. If the object already exists, this
11292 method returns the object, otherwise it calls the constructor.
11298 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
11299 install foreign, unmasked, unsigned code on your machine. We compare
11300 to a checksum that comes from the net just as the distribution file
11301 itself. But we try to make it easy to add security on demand:
11303 =head2 Cryptographically signed modules
11305 Since release 1.77 CPAN.pm has been able to verify cryptographically
11306 signed module distributions using Module::Signature. The CPAN modules
11307 can be signed by their authors, thus giving more security. The simple
11308 unsigned MD5 checksums that were used before by CPAN protect mainly
11309 against accidental file corruption.
11311 You will need to have Module::Signature installed, which in turn
11312 requires that you have at least one of Crypt::OpenPGP module or the
11313 command-line F<gpg> tool installed.
11315 You will also need to be able to connect over the Internet to the public
11316 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
11318 The configuration parameter check_sigs is there to turn signature
11319 checking on or off.
11323 Most functions in package CPAN are exported per default. The reason
11324 for this is that the primary use is intended for the cpan shell or for
11329 When the CPAN shell enters a subshell via the look command, it sets
11330 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
11333 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING.
11335 When the config variable ftp_passive is set, all downloads will be run
11336 with the environment variable FTP_PASSIVE set to this value. This is
11337 in general a good idea as it influences both Net::FTP and LWP based
11338 connections. The same effect can be achieved by starting the cpan
11339 shell with this environment variable set. For Net::FTP alone, one can
11340 also always set passive mode by running libnetcfg.
11342 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
11344 Populating a freshly installed perl with my favorite modules is pretty
11345 easy if you maintain a private bundle definition file. To get a useful
11346 blueprint of a bundle definition file, the command autobundle can be used
11347 on the CPAN shell command line. This command writes a bundle definition
11348 file for all modules that are installed for the currently running perl
11349 interpreter. It's recommended to run this command only once and from then
11350 on maintain the file manually under a private name, say
11351 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
11353 cpan> install Bundle::my_bundle
11355 then answer a few questions and then go out for a coffee.
11357 Maintaining a bundle definition file means keeping track of two
11358 things: dependencies and interactivity. CPAN.pm sometimes fails on
11359 calculating dependencies because not all modules define all MakeMaker
11360 attributes correctly, so a bundle definition file should specify
11361 prerequisites as early as possible. On the other hand, it's a bit
11362 annoying that many distributions need some interactive configuring. So
11363 what I try to accomplish in my private bundle file is to have the
11364 packages that need to be configured early in the file and the gentle
11365 ones later, so I can go out after a few minutes and leave CPAN.pm
11368 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
11370 Thanks to Graham Barr for contributing the following paragraphs about
11371 the interaction between perl, and various firewall configurations. For
11372 further information on firewalls, it is recommended to consult the
11373 documentation that comes with the ncftp program. If you are unable to
11374 go through the firewall with a simple Perl setup, it is very likely
11375 that you can configure ncftp so that it works for your firewall.
11377 =head2 Three basic types of firewalls
11379 Firewalls can be categorized into three basic types.
11383 =item http firewall
11385 This is where the firewall machine runs a web server and to access the
11386 outside world you must do it via the web server. If you set environment
11387 variables like http_proxy or ftp_proxy to a values beginning with http://
11388 or in your web browser you have to set proxy information then you know
11389 you are running an http firewall.
11391 To access servers outside these types of firewalls with perl (even for
11392 ftp) you will need to use LWP.
11396 This where the firewall machine runs an ftp server. This kind of
11397 firewall will only let you access ftp servers outside the firewall.
11398 This is usually done by connecting to the firewall with ftp, then
11399 entering a username like "user@outside.host.com"
11401 To access servers outside these type of firewalls with perl you
11402 will need to use Net::FTP.
11404 =item One way visibility
11406 I say one way visibility as these firewalls try to make themselves look
11407 invisible to the users inside the firewall. An FTP data connection is
11408 normally created by sending the remote server your IP address and then
11409 listening for the connection. But the remote server will not be able to
11410 connect to you because of the firewall. So for these types of firewall
11411 FTP connections need to be done in a passive mode.
11413 There are two that I can think off.
11419 If you are using a SOCKS firewall you will need to compile perl and link
11420 it with the SOCKS library, this is what is normally called a 'socksified'
11421 perl. With this executable you will be able to connect to servers outside
11422 the firewall as if it is not there.
11424 =item IP Masquerade
11426 This is the firewall implemented in the Linux kernel, it allows you to
11427 hide a complete network behind one IP address. With this firewall no
11428 special compiling is needed as you can access hosts directly.
11430 For accessing ftp servers behind such firewalls you usually need to
11431 set the environment variable C<FTP_PASSIVE> or the config variable
11432 ftp_passive to a true value.
11438 =head2 Configuring lynx or ncftp for going through a firewall
11440 If you can go through your firewall with e.g. lynx, presumably with a
11443 /usr/local/bin/lynx -pscott:tiger
11445 then you would configure CPAN.pm with the command
11447 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
11449 That's all. Similarly for ncftp or ftp, you would configure something
11452 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
11454 Your mileage may vary...
11462 I installed a new version of module X but CPAN keeps saying,
11463 I have the old version installed
11465 Most probably you B<do> have the old version installed. This can
11466 happen if a module installs itself into a different directory in the
11467 @INC path than it was previously installed. This is not really a
11468 CPAN.pm problem, you would have the same problem when installing the
11469 module manually. The easiest way to prevent this behaviour is to add
11470 the argument C<UNINST=1> to the C<make install> call, and that is why
11471 many people add this argument permanently by configuring
11473 o conf make_install_arg UNINST=1
11477 So why is UNINST=1 not the default?
11479 Because there are people who have their precise expectations about who
11480 may install where in the @INC path and who uses which @INC array. In
11481 fine tuned environments C<UNINST=1> can cause damage.
11485 I want to clean up my mess, and install a new perl along with
11486 all modules I have. How do I go about it?
11488 Run the autobundle command for your old perl and optionally rename the
11489 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
11490 with the Configure option prefix, e.g.
11492 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
11494 Install the bundle file you produced in the first step with something like
11496 cpan> install Bundle::mybundle
11502 When I install bundles or multiple modules with one command
11503 there is too much output to keep track of.
11505 You may want to configure something like
11507 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
11508 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
11510 so that STDOUT is captured in a file for later inspection.
11515 I am not root, how can I install a module in a personal directory?
11517 First of all, you will want to use your own configuration, not the one
11518 that your root user installed. If you do not have permission to write
11519 in the cpan directory that root has configured, you will be asked if
11520 you want to create your own config. Answering "yes" will bring you into
11521 CPAN's configuration stage, using the system config for all defaults except
11522 things that have to do with CPAN's work directory, saving your choices to
11523 your MyConfig.pm file.
11525 You can also manually initiate this process with the following command:
11527 % perl -MCPAN -e 'mkmyconfig'
11533 from the CPAN shell.
11535 You will most probably also want to configure something like this:
11537 o conf makepl_arg "LIB=~/myperl/lib \
11538 INSTALLMAN1DIR=~/myperl/man/man1 \
11539 INSTALLMAN3DIR=~/myperl/man/man3 \
11540 INSTALLSCRIPT=~/myperl/bin \
11541 INSTALLBIN=~/myperl/bin"
11543 and then (oh joy) the equivalent command for Module::Build.
11545 You can make this setting permanent like all C<o conf> settings with
11546 C<o conf commit> or by setting C<auto_commit> beforehand.
11548 You will have to add ~/myperl/man to the MANPATH environment variable
11549 and also tell your perl programs to look into ~/myperl/lib, e.g. by
11552 use lib "$ENV{HOME}/myperl/lib";
11554 or setting the PERL5LIB environment variable.
11556 While we're speaking about $ENV{HOME}, it might be worth mentioning,
11557 that for Windows we use the File::HomeDir module that provides an
11558 equivalent to the concept of the home directory on Unix.
11560 Another thing you should bear in mind is that the UNINST parameter can
11561 be dnagerous when you are installing into a private area because you
11562 might accidentally remove modules that other people depend on that are
11563 not using the private area.
11567 How to get a package, unwrap it, and make a change before building it?
11569 Have a look at the C<look> (!) command.
11573 I installed a Bundle and had a couple of fails. When I
11574 retried, everything resolved nicely. Can this be fixed to work
11577 The reason for this is that CPAN does not know the dependencies of all
11578 modules when it starts out. To decide about the additional items to
11579 install, it just uses data found in the META.yml file or the generated
11580 Makefile. An undetected missing piece breaks the process. But it may
11581 well be that your Bundle installs some prerequisite later than some
11582 depending item and thus your second try is able to resolve everything.
11583 Please note, CPAN.pm does not know the dependency tree in advance and
11584 cannot sort the queue of things to install in a topologically correct
11585 order. It resolves perfectly well IF all modules declare the
11586 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
11587 the C<requires> stanza of Module::Build. For bundles which fail and
11588 you need to install often, it is recommended to sort the Bundle
11589 definition file manually.
11593 In our intranet we have many modules for internal use. How
11594 can I integrate these modules with CPAN.pm but without uploading
11595 the modules to CPAN?
11597 Have a look at the CPAN::Site module.
11601 When I run CPAN's shell, I get an error message about things in my
11602 /etc/inputrc (or ~/.inputrc) file.
11604 These are readline issues and can only be fixed by studying readline
11605 configuration on your architecture and adjusting the referenced file
11606 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
11607 and edit them. Quite often harmless changes like uppercasing or
11608 lowercasing some arguments solves the problem.
11612 Some authors have strange characters in their names.
11614 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
11615 expecting ISO-8859-1 charset, a converter can be activated by setting
11616 term_is_latin to a true value in your config file. One way of doing so
11619 cpan> o conf term_is_latin 1
11621 If other charset support is needed, please file a bugreport against
11622 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
11623 the support or maybe UTF-8 terminals become widely available.
11627 When an install fails for some reason and then I correct the error
11628 condition and retry, CPAN.pm refuses to install the module, saying
11629 C<Already tried without success>.
11631 Use the force pragma like so
11633 force install Foo::Bar
11639 and then 'make install' directly in the subshell.
11643 How do I install a "DEVELOPER RELEASE" of a module?
11645 By default, CPAN will install the latest non-developer release of a
11646 module. If you want to install a dev release, you have to specify the
11647 partial path starting with the author id to the tarball you wish to
11650 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
11652 Note that you can use the C<ls> command to get this path listed.
11656 How do I install a module and all its dependencies from the commandline,
11657 without being prompted for anything, despite my CPAN configuration
11660 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
11661 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
11662 asked any questions at all (assuming the modules you are installing are
11663 nice about obeying that variable as well):
11665 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
11669 How do I create a Module::Build based Build.PL derived from an
11670 ExtUtils::MakeMaker focused Makefile.PL?
11672 http://search.cpan.org/search?query=Module::Build::Convert
11674 http://www.refcnt.org/papers/module-build-convert
11678 What's the best CPAN site for me?
11680 The urllist config parameter is yours. You can add and remove sites at
11681 will. You should find out which sites have the best uptodateness,
11682 bandwidth, reliability, etc. and are topologically close to you. Some
11683 people prefer fast downloads, others uptodateness, others reliability.
11684 You decide which to try in which order.
11686 Henk P. Penning maintains a site that collects data about CPAN sites:
11688 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
11692 =head1 COMPATIBILITY
11694 =head2 OLD PERL VERSIONS
11696 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
11697 newer versions. It is getting more and more difficult to get the
11698 minimal prerequisites working on older perls. It is close to
11699 impossible to get the whole Bundle::CPAN working there. If you're in
11700 the position to have only these old versions, be advised that CPAN is
11701 designed to work fine without the Bundle::CPAN installed.
11703 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
11704 compatible with ancient perls and that File::Temp is listed as a
11705 prerequisite but CPAN has reasonable workarounds if it is missing.
11709 This module and its competitor, the CPANPLUS module, are both much
11710 cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
11711 more modular but it was never tried to make it compatible with CPAN.pm.
11713 =head1 SECURITY ADVICE
11715 This software enables you to upgrade software on your computer and so
11716 is inherently dangerous because the newly installed software may
11717 contain bugs and may alter the way your computer works or even make it
11718 unusable. Please consider backing up your data before every upgrade.
11722 Please report bugs via http://rt.cpan.org/
11724 Before submitting a bug, please make sure that the traditional method
11725 of building a Perl module package from a shell by following the
11726 installation instructions of that package still works in your
11731 Andreas Koenig C<< <andk@cpan.org> >>
11735 This program is free software; you can redistribute it and/or
11736 modify it under the same terms as Perl itself.
11738 See L<http://www.perl.com/perl/misc/Artistic.html>
11740 =head1 TRANSLATIONS
11742 Kawai,Takanori provides a Japanese translation of this manpage at
11743 http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm
11747 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)