1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $CPAN::VERSION = '1.88_78';
5 $CPAN::VERSION = eval $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 (try 'install Bundle::CPAN')";
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";
376 # CPAN::_yaml_loadfile
378 my($self,$local_file) = @_;
379 return +[] unless -s $local_file;
380 my $yaml_module = _yaml_module;
381 if ($CPAN::META->has_inst($yaml_module)) {
383 if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
385 eval { @yaml = $code->($local_file); };
387 # this shall not be done by the frontend
388 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
391 } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
393 open FH, $local_file or die "Could not open '$local_file': $!";
397 eval { @yaml = $code->($ystream); };
399 # this shall not be done by the frontend
400 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
405 # this shall not be done by the frontend
406 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
411 # CPAN::_yaml_dumpfile
413 my($self,$local_file,@what) = @_;
414 my $yaml_module = _yaml_module;
415 if ($CPAN::META->has_inst($yaml_module)) {
417 if (UNIVERSAL::isa($local_file, "FileHandle")) {
418 $code = UNIVERSAL::can($yaml_module, "Dump");
419 eval { print $local_file $code->(@what) };
420 } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
421 eval { $code->($local_file,@what); };
422 } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
424 open FH, ">$local_file" or die "Could not open '$local_file': $!";
425 print FH $code->(@what);
428 die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
431 if (UNIVERSAL::isa($local_file, "FileHandle")) {
432 # I think this case does not justify a warning at all
434 die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
439 sub _init_sqlite () {
440 unless ($CPAN::META->has_inst("CPAN::SQLite")) {
441 $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
442 unless $Have_warned->{"CPAN::SQLite"}++;
445 require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
446 $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
450 my $negative_cache = {};
451 sub _sqlite_running {
452 if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
453 # need to cache the result, otherwise too slow
454 return $negative_cache->{fact};
456 $negative_cache = {}; # reset
458 my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
459 return $ret if $ret; # fast anyway
460 $negative_cache->{time} = time;
461 return $negative_cache->{fact} = $ret;
465 package CPAN::CacheMgr;
467 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
472 use Fcntl qw(:flock);
473 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
474 @CPAN::FTP::ISA = qw(CPAN::Debug);
476 package CPAN::LWP::UserAgent;
478 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
479 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
481 package CPAN::Complete;
483 @CPAN::Complete::ISA = qw(CPAN::Debug);
484 # Q: where is the "How do I add a new command" HOWTO?
485 # A: svn diff -r 1048:1049 where andk added the report command
486 @CPAN::Complete::COMMANDS = sort qw(
487 ! a b d h i m o q r u
517 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
518 @CPAN::Index::ISA = qw(CPAN::Debug);
521 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
524 package CPAN::InfoObj;
526 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
528 package CPAN::Author;
530 @CPAN::Author::ISA = qw(CPAN::InfoObj);
532 package CPAN::Distribution;
534 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
536 package CPAN::Bundle;
538 @CPAN::Bundle::ISA = qw(CPAN::Module);
540 package CPAN::Module;
542 @CPAN::Module::ISA = qw(CPAN::InfoObj);
544 package CPAN::Exception::RecursiveDependency;
546 use overload '""' => "as_string";
548 # a module sees its distribution (no version)
549 # a distribution sees its prereqs (which are module names) (usually with versions)
550 # a bundle sees its module names and/or its distributions (no version)
557 for my $dep (@$deps) {
559 last if $seen{$dep}++;
561 bless { deps => \@deps }, $class;
566 "\nRecursive dependency detected:\n " .
567 join("\n => ", @{$self->{deps}}) .
568 ".\nCannot continue.\n";
571 package CPAN::Exception::yaml_not_installed;
573 use overload '""' => "as_string";
576 my($class,$module,$file,$during) = @_;
577 bless { module => $module, file => $file, during => $during }, $class;
582 "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
585 package CPAN::Exception::yaml_process_error;
587 use overload '""' => "as_string";
590 my($class,$module,$file,$during,$error) = shift;
591 bless { module => $module,
594 error => $error }, $class;
599 "Alert: While trying to $self->{during} YAML file\n".
601 "with '$self->{module}' the following error was encountered:\n".
605 package CPAN::Prompt; use overload '""' => "as_string";
606 use vars qw($prompt);
608 $CPAN::CurrentCommandId ||= 0;
614 unless ($CPAN::META->{LOCK}) {
615 $word = "nolock_cpan";
617 if ($CPAN::Config->{commandnumber_in_prompt}) {
618 sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
624 package CPAN::URL; use overload '""' => "as_string", fallback => 1;
625 # accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
626 # planned are things like age or quality
628 my($class,%args) = @_;
640 $self->{TEXT} = $set;
645 package CPAN::Distrostatus;
646 use overload '""' => "as_string",
649 my($class,$arg) = @_;
652 FAILED => substr($arg,0,2) eq "NO",
653 COMMANDID => $CPAN::CurrentCommandId,
657 sub commandid { shift->{COMMANDID} }
658 sub failed { shift->{FAILED} }
662 $self->{TEXT} = $set;
681 @CPAN::Shell::ISA = qw(CPAN::Debug);
682 $COLOR_REGISTERED ||= 0;
685 $autoload_recursion ||= 0;
687 #-> sub CPAN::Shell::AUTOLOAD ;
689 $autoload_recursion++;
691 my $class = shift(@_);
692 # warn "autoload[$l] class[$class]";
695 warn "Refusing to autoload '$l' while signal pending";
696 $autoload_recursion--;
699 if ($autoload_recursion > 1) {
700 my $fullcommand = join " ", map { "'$_'" } $l, @_;
701 warn "Refusing to autoload $fullcommand in recursion\n";
702 $autoload_recursion--;
706 # XXX needs to be reconsidered
707 if ($CPAN::META->has_inst('CPAN::WAIT')) {
710 $CPAN::Frontend->mywarn(qq{
711 Commands starting with "w" require CPAN::WAIT to be installed.
712 Please consider installing CPAN::WAIT to use the fulltext index.
713 For this you just need to type
718 $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
722 $autoload_recursion--;
729 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
731 # from here on only subs.
732 ################################################################################
734 sub _perl_fingerprint {
735 my($self,$other_fingerprint) = @_;
736 my $dll = eval {OS2::DLLname()};
739 $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
741 my $mtime_perl = (-f $^X ? (stat(_))[9] : '-1');
742 my $this_fingerprint = {
744 sitearchexp => $Config::Config{sitearchexp},
745 'mtime_$^X' => $mtime_perl,
746 'mtime_dll' => $mtime_dll,
748 if ($other_fingerprint) {
749 if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
750 $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
752 # mandatory keys since 1.88_57
753 for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
754 return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
758 return $this_fingerprint;
762 sub suggest_myconfig () {
763 SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
764 $CPAN::Frontend->myprint("You don't seem to have a user ".
765 "configuration (MyConfig.pm) yet.\n");
766 my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
767 "user configuration now? (Y/n)",
770 CPAN::Shell->mkmyconfig();
773 $CPAN::Frontend->mydie("OK, giving up.");
778 #-> sub CPAN::all_objects ;
780 my($mgr,$class) = @_;
781 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
782 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
784 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
787 # Called by shell, not in batch mode. In batch mode I see no risk in
788 # having many processes updating something as installations are
789 # continually checked at runtime. In shell mode I suspect it is
790 # unintentional to open more than one shell at a time
792 #-> sub CPAN::checklock ;
795 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
796 if (-f $lockfile && -M _ > 0) {
797 my $fh = FileHandle->new($lockfile) or
798 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
799 my $otherpid = <$fh>;
800 my $otherhost = <$fh>;
802 if (defined $otherpid && $otherpid) {
805 if (defined $otherhost && $otherhost) {
808 my $thishost = hostname();
809 if (defined $otherhost && defined $thishost &&
810 $otherhost ne '' && $thishost ne '' &&
811 $otherhost ne $thishost) {
812 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
813 "reports other host $otherhost and other ".
814 "process $otherpid.\n".
815 "Cannot proceed.\n"));
816 } elsif ($RUN_DEGRADED) {
817 $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
818 } elsif (defined $otherpid && $otherpid) {
819 return if $$ == $otherpid; # should never happen
820 $CPAN::Frontend->mywarn(
822 There seems to be running another CPAN process (pid $otherpid). Contacting...
824 if (kill 0, $otherpid) {
825 $CPAN::Frontend->mywarn(qq{Other job is running.\n});
827 CPAN::Shell::colorable_makemaker_prompt
828 (qq{Shall I try to run in degraded }.
829 qq{mode? (Y/n)},"y");
831 $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
832 Please report if something unexpected happens\n");
834 for ($CPAN::Config) {
836 # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
837 $_->{commandnumber_in_prompt} = 0; # visibility
838 $_->{histfile} = ""; # who should win otherwise?
839 $_->{cache_metadata} = 0; # better would be a lock?
840 $_->{use_sqlite} = 0; # better would be a write lock!
843 $CPAN::Frontend->mydie("
844 You may want to kill the other job and delete the lockfile. On UNIX try:
849 } elsif (-w $lockfile) {
851 CPAN::Shell::colorable_makemaker_prompt
852 (qq{Other job not responding. Shall I overwrite }.
853 qq{the lockfile '$lockfile'? (Y/n)},"y");
854 $CPAN::Frontend->myexit("Ok, bye\n")
855 unless $ans =~ /^y/i;
858 qq{Lockfile '$lockfile' not writeable by you. }.
859 qq{Cannot proceed.\n}.
861 qq{ rm '$lockfile'\n}.
862 qq{ and then rerun us.\n}
866 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
867 "'$lockfile', please remove. Cannot proceed.\n"));
870 my $dotcpan = $CPAN::Config->{cpan_home};
871 eval { File::Path::mkpath($dotcpan);};
873 # A special case at least for Jarkko.
878 $symlinkcpan = readlink $dotcpan;
879 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
880 eval { File::Path::mkpath($symlinkcpan); };
884 $CPAN::Frontend->mywarn(qq{
885 Working directory $symlinkcpan created.
889 unless (-d $dotcpan) {
891 Your configuration suggests "$dotcpan" as your
892 CPAN.pm working directory. I could not create this directory due
893 to this error: $firsterror\n};
895 As "$dotcpan" is a symlink to "$symlinkcpan",
896 I tried to create that, but I failed with this error: $seconderror
899 Please make sure the directory exists and is writable.
901 $CPAN::Frontend->myprint($mess);
902 return suggest_myconfig;
904 } # $@ after eval mkpath $dotcpan
905 if (0) { # to test what happens when a race condition occurs
906 for (reverse 1..10) {
912 if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
914 unless ($fh = FileHandle->new("+>>$lockfile")) {
915 if ($! =~ /Permission/) {
916 $CPAN::Frontend->myprint(qq{
918 Your configuration suggests that CPAN.pm should use a working
920 $CPAN::Config->{cpan_home}
921 Unfortunately we could not create the lock file
923 due to permission problems.
925 Please make sure that the configuration variable
926 \$CPAN::Config->{cpan_home}
927 points to a directory where you can write a .lock file. You can set
928 this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
931 return suggest_myconfig;
935 while (!flock $fh, LOCK_EX|LOCK_NB) {
937 $CPAN::Frontend->mydie("Giving up\n");
939 $CPAN::Frontend->mysleep($sleep++);
940 $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
945 $fh->print($$, "\n");
946 $fh->print(hostname(), "\n");
947 $self->{LOCK} = $lockfile;
948 $self->{LOCKFH} = $fh;
953 $CPAN::Frontend->mydie("Got SIG$sig, leaving");
959 die "Got yet another signal" if $Signal > 1;
960 $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
961 $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
965 # From: Larry Wall <larry@wall.org>
966 # Subject: Re: deprecating SIGDIE
967 # To: perl5-porters@perl.org
968 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
970 # The original intent of __DIE__ was only to allow you to substitute one
971 # kind of death for another on an application-wide basis without respect
972 # to whether you were in an eval or not. As a global backstop, it should
973 # not be used any more lightly (or any more heavily :-) than class
974 # UNIVERSAL. Any attempt to build a general exception model on it should
975 # be politely squashed. Any bug that causes every eval {} to have to be
976 # modified should be not so politely squashed.
978 # Those are my current opinions. It is also my optinion that polite
979 # arguments degenerate to personal arguments far too frequently, and that
980 # when they do, it's because both people wanted it to, or at least didn't
981 # sufficiently want it not to.
985 # global backstop to cleanup if we should really die
986 $SIG{__DIE__} = \&cleanup;
987 $self->debug("Signal handler set.") if $CPAN::DEBUG;
990 #-> sub CPAN::DESTROY ;
992 &cleanup; # need an eval?
995 #-> sub CPAN::anycwd ;
998 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
1003 sub cwd {Cwd::cwd();}
1005 #-> sub CPAN::getcwd ;
1006 sub getcwd {Cwd::getcwd();}
1008 #-> sub CPAN::fastcwd ;
1009 sub fastcwd {Cwd::fastcwd();}
1011 #-> sub CPAN::backtickcwd ;
1012 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
1014 #-> sub CPAN::find_perl ;
1016 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
1017 my $pwd = $CPAN::iCwd = CPAN::anycwd();
1018 my $candidate = File::Spec->catfile($pwd,$^X);
1019 $perl ||= $candidate if MM->maybe_command($candidate);
1022 my ($component,$perl_name);
1023 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
1024 PATH_COMPONENT: foreach $component (File::Spec->path(),
1025 $Config::Config{'binexp'}) {
1026 next unless defined($component) && $component;
1027 my($abs) = File::Spec->catfile($component,$perl_name);
1028 if (MM->maybe_command($abs)) {
1040 #-> sub CPAN::exists ;
1042 my($mgr,$class,$id) = @_;
1043 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1044 CPAN::Index->reload;
1045 ### Carp::croak "exists called without class argument" unless $class;
1047 $id =~ s/:+/::/g if $class eq "CPAN::Module";
1049 if (CPAN::_sqlite_running) {
1050 $exists = (exists $META->{readonly}{$class}{$id} or
1051 $CPAN::SQLite->set($class, $id));
1053 $exists = exists $META->{readonly}{$class}{$id};
1055 $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1058 #-> sub CPAN::delete ;
1060 my($mgr,$class,$id) = @_;
1061 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
1062 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
1065 #-> sub CPAN::has_usable
1066 # has_inst is sometimes too optimistic, we should replace it with this
1067 # has_usable whenever a case is given
1069 my($self,$mod,$message) = @_;
1070 return 1 if $HAS_USABLE->{$mod};
1071 my $has_inst = $self->has_inst($mod,$message);
1072 return unless $has_inst;
1075 LWP => [ # we frequently had "Can't locate object
1076 # method "new" via package "LWP::UserAgent" at
1077 # (eval 69) line 2006
1079 sub {require LWP::UserAgent},
1080 sub {require HTTP::Request},
1081 sub {require URI::URL},
1084 sub {require Net::FTP},
1085 sub {require Net::Config},
1087 'File::HomeDir' => [
1088 sub {require File::HomeDir;
1089 unless (File::HomeDir::->VERSION >= 0.52){
1090 for ("Will not use File::HomeDir, need 0.52\n") {
1091 $CPAN::Frontend->mywarn($_);
1098 sub {require Archive::Tar;
1099 unless (Archive::Tar::->VERSION >= 1.00) {
1100 for ("Will not use Archive::Tar, need 1.00\n") {
1101 $CPAN::Frontend->mywarn($_);
1108 if ($usable->{$mod}) {
1109 for my $c (0..$#{$usable->{$mod}}) {
1110 my $code = $usable->{$mod}[$c];
1111 my $ret = eval { &$code() };
1112 $ret = "" unless defined $ret;
1114 # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
1119 return $HAS_USABLE->{$mod} = 1;
1122 #-> sub CPAN::has_inst
1124 my($self,$mod,$message) = @_;
1125 Carp::croak("CPAN->has_inst() called without an argument")
1126 unless defined $mod;
1127 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
1128 keys %{$CPAN::Config->{dontload_hash}||{}},
1129 @{$CPAN::Config->{dontload_list}||[]};
1130 if (defined $message && $message eq "no" # afair only used by Nox
1134 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
1142 # checking %INC is wrong, because $INC{LWP} may be true
1143 # although $INC{"URI/URL.pm"} may have failed. But as
1144 # I really want to say "bla loaded OK", I have to somehow
1146 ### warn "$file in %INC"; #debug
1148 } elsif (eval { require $file }) {
1149 # eval is good: if we haven't yet read the database it's
1150 # perfect and if we have installed the module in the meantime,
1151 # it tries again. The second require is only a NOOP returning
1152 # 1 if we had success, otherwise it's retrying
1154 my $v = eval "\$$mod\::VERSION";
1155 $v = $v ? " (v$v)" : "";
1156 $CPAN::Frontend->myprint("CPAN: $mod loaded ok$v\n");
1157 if ($mod eq "CPAN::WAIT") {
1158 push @CPAN::Shell::ISA, 'CPAN::WAIT';
1161 } elsif ($mod eq "Net::FTP") {
1162 $CPAN::Frontend->mywarn(qq{
1163 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
1165 install Bundle::libnet
1167 }) unless $Have_warned->{"Net::FTP"}++;
1168 $CPAN::Frontend->mysleep(3);
1169 } elsif ($mod eq "Digest::SHA"){
1170 if ($Have_warned->{"Digest::SHA"}++) {
1171 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled }.
1172 qq{because Digest::SHA not installed.\n});
1174 $CPAN::Frontend->mywarn(qq{
1175 CPAN: checksum security checks disabled because Digest::SHA not installed.
1176 Please consider installing the Digest::SHA module.
1179 $CPAN::Frontend->mysleep(2);
1181 } elsif ($mod eq "Module::Signature"){
1182 # NOT prefs_lookup, we are not a distro
1183 my $check_sigs = $CPAN::Config->{check_sigs};
1184 if (not $check_sigs) {
1185 # they do not want us:-(
1186 } elsif (not $Have_warned->{"Module::Signature"}++) {
1187 # No point in complaining unless the user can
1188 # reasonably install and use it.
1189 if (eval { require Crypt::OpenPGP; 1 } ||
1191 defined $CPAN::Config->{'gpg'}
1193 $CPAN::Config->{'gpg'} =~ /\S/
1196 $CPAN::Frontend->mywarn(qq{
1197 CPAN: Module::Signature security checks disabled because Module::Signature
1198 not installed. Please consider installing the Module::Signature module.
1199 You may also need to be able to connect over the Internet to the public
1200 keyservers like pgp.mit.edu (port 11371).
1203 $CPAN::Frontend->mysleep(2);
1207 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
1212 #-> sub CPAN::instance ;
1214 my($mgr,$class,$id) = @_;
1215 CPAN::Index->reload;
1217 # unsafe meta access, ok?
1218 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
1219 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
1227 #-> sub CPAN::cleanup ;
1229 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
1230 local $SIG{__DIE__} = '';
1235 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
1236 $ineval = 1, last if
1237 $subroutine eq '(eval)';
1239 return if $ineval && !$CPAN::End;
1240 return unless defined $META->{LOCK};
1241 return unless -f $META->{LOCK};
1243 close $META->{LOCKFH};
1244 unlink $META->{LOCK};
1246 # Carp::cluck("DEBUGGING");
1247 if ( $CPAN::CONFIG_DIRTY ) {
1248 $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
1250 $CPAN::Frontend->myprint("Lockfile removed.\n");
1253 #-> sub CPAN::readhist
1255 my($self,$term,$histfile) = @_;
1256 my($fh) = FileHandle->new;
1257 open $fh, "<$histfile" or last;
1261 $term->AddHistory($_);
1266 #-> sub CPAN::savehist
1269 my($histfile,$histsize);
1270 unless ($histfile = $CPAN::Config->{'histfile'}){
1271 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
1274 $histsize = $CPAN::Config->{'histsize'} || 100;
1276 unless ($CPAN::term->can("GetHistory")) {
1277 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
1283 my @h = $CPAN::term->GetHistory;
1284 splice @h, 0, @h-$histsize if @h>$histsize;
1285 my($fh) = FileHandle->new;
1286 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
1287 local $\ = local $, = "\n";
1292 #-> sub CPAN::is_tested
1294 my($self,$what,$when) = @_;
1296 Carp::cluck("DEBUG: empty what");
1299 $self->{is_tested}{$what} = $when;
1302 #-> sub CPAN::is_installed
1303 # unsets the is_tested flag: as soon as the thing is installed, it is
1304 # not needed in set_perl5lib anymore
1306 my($self,$what) = @_;
1307 delete $self->{is_tested}{$what};
1310 sub _list_sorted_descending_is_tested {
1313 { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
1314 keys %{$self->{is_tested}}
1317 #-> sub CPAN::set_perl5lib
1319 my($self,$for) = @_;
1321 (undef,undef,undef,$for) = caller(1);
1324 $self->{is_tested} ||= {};
1325 return unless %{$self->{is_tested}};
1326 my $env = $ENV{PERL5LIB};
1327 $env = $ENV{PERLLIB} unless defined $env;
1329 push @env, $env if defined $env and length $env;
1330 #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1331 #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1333 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
1335 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB for '$for'\n");
1336 } elsif (@dirs < 24) {
1337 my @d = map {my $cp = $_;
1338 $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
1341 $CPAN::Frontend->myprint("Prepending @d to PERL5LIB; ".
1342 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
1346 my $cnt = keys %{$self->{is_tested}};
1347 $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib of ".
1348 "$cnt build dirs to PERL5LIB; ".
1353 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1356 package CPAN::CacheMgr;
1359 #-> sub CPAN::CacheMgr::as_string ;
1361 eval { require Data::Dumper };
1363 return shift->SUPER::as_string;
1365 return Data::Dumper::Dumper(shift);
1369 #-> sub CPAN::CacheMgr::cachesize ;
1374 #-> sub CPAN::CacheMgr::tidyup ;
1377 return unless $CPAN::META->{LOCK};
1378 return unless -d $self->{ID};
1379 while ($self->{DU} > $self->{'MAX'} ) {
1380 my($toremove) = shift @{$self->{FIFO}};
1381 unless ($toremove =~ /\.yml$/) {
1382 $CPAN::Frontend->myprint(sprintf(
1383 "DEL(%.1f>%.1fMB): %s \n",
1390 return if $CPAN::Signal;
1391 $self->_clean_cache($toremove);
1392 return if $CPAN::Signal;
1396 #-> sub CPAN::CacheMgr::dir ;
1401 #-> sub CPAN::CacheMgr::entries ;
1403 my($self,$dir) = @_;
1404 return unless defined $dir;
1405 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1406 $dir ||= $self->{ID};
1407 my($cwd) = CPAN::anycwd();
1408 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1409 my $dh = DirHandle->new(File::Spec->curdir)
1410 or Carp::croak("Couldn't opendir $dir: $!");
1413 next if $_ eq "." || $_ eq "..";
1415 push @entries, File::Spec->catfile($dir,$_);
1417 push @entries, File::Spec->catdir($dir,$_);
1419 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1422 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1423 sort { -M $b <=> -M $a} @entries;
1426 #-> sub CPAN::CacheMgr::disk_usage ;
1428 my($self,$dir) = @_;
1429 return if exists $self->{SIZE}{$dir};
1430 return if $CPAN::Signal;
1435 unless (chmod 0755, $dir) {
1436 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1437 "permission to change the permission; cannot ".
1438 "estimate disk usage of '$dir'\n");
1439 $CPAN::Frontend->mysleep(5);
1444 # nothing to say, no matter what the permissions
1447 $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
1452 $File::Find::prune++ if $CPAN::Signal;
1454 if ($^O eq 'MacOS') {
1456 my $cat = Mac::Files::FSpGetCatInfo($_);
1457 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1461 unless (chmod 0755, $_) {
1462 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1463 "the permission to change the permission; ".
1464 "can only partially estimate disk usage ".
1466 $CPAN::Frontend->mysleep(5);
1477 return if $CPAN::Signal;
1478 $self->{SIZE}{$dir} = $Du/1024/1024;
1479 push @{$self->{FIFO}}, $dir;
1480 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1481 $self->{DU} += $Du/1024/1024;
1485 #-> sub CPAN::CacheMgr::_clean_cache ;
1487 my($self,$dir) = @_;
1488 return unless -e $dir;
1489 unless (File::Spec->canonpath(File::Basename::dirname($dir))
1490 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
1491 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
1492 "will not remove\n");
1493 $CPAN::Frontend->mysleep(5);
1496 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1498 File::Path::rmtree($dir);
1500 if ($dir !~ /\.yml$/ && -f "$dir.yml") {
1501 my $yaml_module = CPAN::_yaml_module;
1502 if ($CPAN::META->has_inst($yaml_module)) {
1503 my($peek_yaml) = CPAN->_yaml_loadfile("$dir.yml");
1504 if (my $id = $peek_yaml->[0]{distribution}{ID}) {
1505 $CPAN::META->delete("CPAN::Distribution", $id);
1506 # $CPAN::Frontend->mywarn (" +++\n");
1510 unlink "$dir.yml"; # may fail
1511 unless ($id_deleted) {
1512 CPAN->debug("no distro found associated with '$dir'");
1515 $self->{DU} -= $self->{SIZE}{$dir};
1516 delete $self->{SIZE}{$dir};
1519 #-> sub CPAN::CacheMgr::new ;
1526 ID => $CPAN::Config->{build_dir},
1527 MAX => $CPAN::Config->{'build_cache'},
1528 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1531 File::Path::mkpath($self->{ID});
1532 my $dh = DirHandle->new($self->{ID});
1533 bless $self, $class;
1536 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1538 CPAN->debug($debug) if $CPAN::DEBUG;
1542 #-> sub CPAN::CacheMgr::scan_cache ;
1545 return if $self->{SCAN} eq 'never';
1546 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1547 unless $self->{SCAN} eq 'atstart';
1548 return unless $CPAN::META->{LOCK};
1549 $CPAN::Frontend->myprint(
1550 sprintf("Scanning cache %s for sizes\n",
1553 my @entries = grep { !/^\.\.?$/ } $self->entries($self->{ID});
1557 # next if $e eq ".." || $e eq ".";
1558 $self->disk_usage($e);
1560 while (($painted/76) < ($i/@entries)) {
1561 $CPAN::Frontend->myprint(".");
1564 return if $CPAN::Signal;
1566 $CPAN::Frontend->myprint("DONE\n");
1570 package CPAN::Shell;
1573 #-> sub CPAN::Shell::h ;
1575 my($class,$about) = @_;
1576 if (defined $about) {
1577 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1579 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1580 $CPAN::Frontend->myprint(qq{
1581 Display Information $filler (ver $CPAN::VERSION)
1582 command argument description
1583 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1584 i WORD or /REGEXP/ about any of the above
1585 ls AUTHOR or GLOB about files in the author's directory
1586 (with WORD being a module, bundle or author name or a distribution
1587 name of the form AUTHOR/DISTRIBUTION)
1589 Download, Test, Make, Install...
1590 get download clean make clean
1591 make make (implies get) look open subshell in dist directory
1592 test make test (implies make) readme display these README files
1593 install make install (implies test) perldoc display POD documentation
1596 r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules
1597 upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules
1600 force CMD try hard to do command fforce CMD try harder
1601 notest CMD skip testing
1604 h,? display this menu ! perl-code eval a perl command
1605 o conf [opt] set and query options q quit the cpan shell
1606 reload cpan load CPAN.pm again reload index load newer indices
1607 autobundle Snapshot recent latest CPAN uploads});
1613 #-> sub CPAN::Shell::a ;
1615 my($self,@arg) = @_;
1616 # authors are always UPPERCASE
1618 $_ = uc $_ unless /=/;
1620 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1623 #-> sub CPAN::Shell::globls ;
1625 my($self,$s,$pragmas) = @_;
1626 # ls is really very different, but we had it once as an ordinary
1627 # command in the Shell (upto rev. 321) and we could not handle
1629 my(@accept,@preexpand);
1630 if ($s =~ /[\*\?\/]/) {
1631 if ($CPAN::META->has_inst("Text::Glob")) {
1632 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1633 my $rau = Text::Glob::glob_to_regex(uc $au);
1634 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1636 push @preexpand, map { $_->id . "/" . $pathglob }
1637 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1639 my $rau = Text::Glob::glob_to_regex(uc $s);
1640 push @preexpand, map { $_->id }
1641 CPAN::Shell->expand_by_method('CPAN::Author',
1646 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1649 push @preexpand, uc $s;
1652 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1653 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1658 my $silent = @accept>1;
1659 my $last_alpha = "";
1661 for my $a (@accept){
1662 my($author,$pathglob);
1663 if ($a =~ m|(.*?)/(.*)|) {
1666 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1669 or $CPAN::Frontend->mydie("No author found for $a2\n");
1671 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1674 or $CPAN::Frontend->mydie("No author found for $a\n");
1677 my $alpha = substr $author->id, 0, 1;
1679 if ($alpha eq $last_alpha) {
1683 $last_alpha = $alpha;
1685 $CPAN::Frontend->myprint($ad);
1687 for my $pragma (@$pragmas) {
1688 if ($author->can($pragma)) {
1692 push @results, $author->ls($pathglob,$silent); # silent if
1695 for my $pragma (@$pragmas) {
1696 my $unpragma = "un$pragma";
1697 if ($author->can($unpragma)) {
1698 $author->$unpragma();
1705 #-> sub CPAN::Shell::local_bundles ;
1707 my($self,@which) = @_;
1708 my($incdir,$bdir,$dh);
1709 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1710 my @bbase = "Bundle";
1711 while (my $bbase = shift @bbase) {
1712 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1713 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1714 if ($dh = DirHandle->new($bdir)) { # may fail
1716 for $entry ($dh->read) {
1717 next if $entry =~ /^\./;
1718 next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
1719 if (-d File::Spec->catdir($bdir,$entry)){
1720 push @bbase, "$bbase\::$entry";
1722 next unless $entry =~ s/\.pm(?!\n)\Z//;
1723 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1731 #-> sub CPAN::Shell::b ;
1733 my($self,@which) = @_;
1734 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1735 $self->local_bundles;
1736 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1739 #-> sub CPAN::Shell::d ;
1740 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1742 #-> sub CPAN::Shell::m ;
1743 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1745 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1748 #-> sub CPAN::Shell::i ;
1752 @args = '/./' unless @args;
1754 for my $type (qw/Bundle Distribution Module/) {
1755 push @result, $self->expand($type,@args);
1757 # Authors are always uppercase.
1758 push @result, $self->expand("Author", map { uc $_ } @args);
1760 my $result = @result == 1 ?
1761 $result[0]->as_string :
1763 "No objects found of any type for argument @args\n" :
1765 (map {$_->as_glimpse} @result),
1766 scalar @result, " items found\n",
1768 $CPAN::Frontend->myprint($result);
1771 #-> sub CPAN::Shell::o ;
1773 # CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
1774 # conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
1775 # probably have been called 'set' and 'o debug' maybe 'set debug' or
1776 # 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
1778 my($self,$o_type,@o_what) = @_;
1780 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1781 if ($o_type eq 'conf') {
1782 if (!@o_what) { # print all things, "o conf"
1784 $CPAN::Frontend->myprint("\$CPAN::Config options from ");
1786 if (exists $INC{'CPAN/Config.pm'}) {
1787 push @from, $INC{'CPAN/Config.pm'};
1789 if (exists $INC{'CPAN/MyConfig.pm'}) {
1790 push @from, $INC{'CPAN/MyConfig.pm'};
1792 $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
1793 $CPAN::Frontend->myprint(":\n");
1794 for $k (sort keys %CPAN::HandleConfig::can) {
1795 $v = $CPAN::HandleConfig::can{$k};
1796 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1798 $CPAN::Frontend->myprint("\n");
1799 for $k (sort keys %$CPAN::Config) {
1800 CPAN::HandleConfig->prettyprint($k);
1802 $CPAN::Frontend->myprint("\n");
1804 if (CPAN::HandleConfig->edit(@o_what)) {
1806 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1810 } elsif ($o_type eq 'debug') {
1812 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1815 my($what) = shift @o_what;
1816 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1817 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1820 if ( exists $CPAN::DEBUG{$what} ) {
1821 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1822 } elsif ($what =~ /^\d/) {
1823 $CPAN::DEBUG = $what;
1824 } elsif (lc $what eq 'all') {
1826 for (values %CPAN::DEBUG) {
1829 $CPAN::DEBUG = $max;
1832 for (keys %CPAN::DEBUG) {
1833 next unless lc($_) eq lc($what);
1834 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1837 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1842 my $raw = "Valid options for debug are ".
1843 join(", ",sort(keys %CPAN::DEBUG), 'all').
1844 qq{ or a number. Completion works on the options. }.
1845 qq{Case is ignored.};
1847 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1848 $CPAN::Frontend->myprint("\n\n");
1851 $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
1853 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1854 $v = $CPAN::DEBUG{$k};
1855 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1856 if $v & $CPAN::DEBUG;
1859 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1862 $CPAN::Frontend->myprint(qq{
1864 conf set or get configuration variables
1865 debug set or get debugging options
1870 # CPAN::Shell::paintdots_onreload
1871 sub paintdots_onreload {
1874 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1878 # $CPAN::Frontend->myprint(".($subr)");
1879 $CPAN::Frontend->myprint(".");
1880 if ($subr =~ /\bshell\b/i) {
1881 # warn "debug[$_[0]]";
1883 # It would be nice if we could detect that a
1884 # subroutine has actually changed, but for now we
1885 # practically always set the GOTOSHELL global
1895 #-> sub CPAN::Shell::hosts ;
1898 my $fullstats = CPAN::FTP->_ftp_statistics();
1899 my $history = $fullstats->{history} || [];
1901 while (my $last = pop @$history) {
1902 my $attempts = $last->{attempts} or next;
1905 $start = $attempts->[-1]{start};
1906 if ($#$attempts > 0) {
1907 for my $i (0..$#$attempts-1) {
1908 my $url = $attempts->[$i]{url} or next;
1913 $start = $last->{start};
1915 next unless $last->{thesiteurl}; # C-C? bad filenames?
1917 $S{end} ||= $last->{end};
1918 my $dltime = $last->{end} - $start;
1919 my $dlsize = $last->{filesize} || 0;
1920 my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
1921 my $s = $S{ok}{$url} ||= {};
1924 $s->{dlsize} += $dlsize/1024;
1926 $s->{dltime} += $dltime;
1929 for my $url (keys %{$S{ok}}) {
1930 next if $S{ok}{$url}{dltime} == 0; # div by zero
1931 push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
1932 $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
1936 for my $url (keys %{$S{no}}) {
1937 push @{$res->{no}}, [$S{no}{$url},
1941 my $R = ""; # report
1942 if ($S{start} && $S{end}) {
1943 $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
1944 $R .= sprintf "Log ends : %s\n", $S{end} ? scalar(localtime $S{end}) : "unknown";
1946 if ($res->{ok} && @{$res->{ok}}) {
1947 $R .= sprintf "\nSuccessful downloads:
1948 N kB secs kB/s url\n";
1950 for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
1951 $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
1955 if ($res->{no} && @{$res->{no}}) {
1956 $R .= sprintf "\nUnsuccessful downloads:\n";
1958 for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
1959 $R .= sprintf "%4d %s\n", @$_;
1963 $CPAN::Frontend->myprint($R);
1966 #-> sub CPAN::Shell::reload ;
1968 my($self,$command,@arg) = @_;
1970 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1971 if ($command =~ /^cpan$/i) {
1973 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1978 "CPAN/FirstTime.pm",
1979 "CPAN/HandleConfig.pm",
1987 MFILE: for my $f (@relo) {
1988 next unless exists $INC{$f};
1992 $CPAN::Frontend->myprint("($p");
1993 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1994 $self->_reload_this($f) or $failed++;
1995 my $v = eval "$p\::->VERSION";
1996 $CPAN::Frontend->myprint("v$v)");
1998 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
2000 my $errors = $failed == 1 ? "error" : "errors";
2001 $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
2004 } elsif ($command =~ /^index$/i) {
2005 CPAN::Index->force_reload;
2007 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN modules
2008 index re-reads the index files\n});
2012 # reload means only load again what we have loaded before
2013 #-> sub CPAN::Shell::_reload_this ;
2015 my($self,$f,$args) = @_;
2016 CPAN->debug("f[$f]") if $CPAN::DEBUG;
2017 return 1 unless $INC{$f}; # we never loaded this, so we do not
2019 my $pwd = CPAN::anycwd();
2020 CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
2022 for my $inc (@INC) {
2023 $file = File::Spec->catfile($inc,split /\//, $f);
2027 CPAN->debug("file[$file]") if $CPAN::DEBUG;
2029 unless ($file && -f $file) {
2030 # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
2032 unless (CPAN->has_inst("File::Basename")) {
2033 @inc = File::Basename::dirname($file);
2035 # do we ever need this?
2036 @inc = substr($file,0,-length($f)-1); # bring in back to me!
2039 CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
2041 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
2044 my $mtime = (stat $file)[9];
2045 $reload->{$f} ||= $^T;
2046 my $must_reload = $mtime > $reload->{$f};
2048 $must_reload ||= $args->{reloforce};
2050 my $fh = FileHandle->new($file) or
2051 $CPAN::Frontend->mydie("Could not open $file: $!");
2054 my $content = <$fh>;
2055 CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
2059 eval "require '$f'";
2064 $reload->{$f} = time;
2066 $CPAN::Frontend->myprint("__unchanged__");
2071 #-> sub CPAN::Shell::mkmyconfig ;
2073 my($self, $cpanpm, %args) = @_;
2074 require CPAN::FirstTime;
2075 my $home = CPAN::HandleConfig::home;
2076 $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
2077 File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
2078 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
2079 CPAN::HandleConfig::require_myconfig_or_config;
2080 $CPAN::Config ||= {};
2085 keep_source_where => undef,
2088 CPAN::FirstTime::init($cpanpm, %args);
2091 #-> sub CPAN::Shell::_binary_extensions ;
2092 sub _binary_extensions {
2093 my($self) = shift @_;
2094 my(@result,$module,%seen,%need,$headerdone);
2095 for $module ($self->expand('Module','/./')) {
2096 my $file = $module->cpan_file;
2097 next if $file eq "N/A";
2098 next if $file =~ /^Contact Author/;
2099 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
2100 next if $dist->isa_perl;
2101 next unless $module->xs_file;
2103 $CPAN::Frontend->myprint(".");
2104 push @result, $module;
2106 # print join " | ", @result;
2107 $CPAN::Frontend->myprint("\n");
2111 #-> sub CPAN::Shell::recompile ;
2113 my($self) = shift @_;
2114 my($module,@module,$cpan_file,%dist);
2115 @module = $self->_binary_extensions();
2116 for $module (@module){ # we force now and compile later, so we
2118 $cpan_file = $module->cpan_file;
2119 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2121 $dist{$cpan_file}++;
2123 for $cpan_file (sort keys %dist) {
2124 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
2125 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2127 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
2128 # stop a package from recompiling,
2129 # e.g. IO-1.12 when we have perl5.003_10
2133 #-> sub CPAN::Shell::scripts ;
2135 my($self, $arg) = @_;
2136 $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");
2138 for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
2139 unless ($CPAN::META->has_inst($req)) {
2140 $CPAN::Frontend->mywarn(" $req not available\n");
2143 my $p = HTML::LinkExtor->new();
2144 my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
2145 unless (-f $indexfile) {
2146 $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
2148 $p->parse_file($indexfile);
2151 if ($arg =~ s|^/(.+)/$|$1|) {
2152 $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
2154 for my $l ($p->links) {
2155 my $tag = shift @$l;
2156 next unless $tag eq "a";
2158 my $href = $att{href};
2159 next unless $href =~ s|^\.\./authors/id/./../||;
2162 if ($href =~ $qrarg) {
2166 if ($href =~ /\Q$arg\E/) {
2174 # now filter for the latest version if there is more than one of a name
2180 $stems{$stem} ||= [];
2181 push @{$stems{$stem}}, $href;
2183 for (sort keys %stems) {
2185 if (@{$stems{$_}} > 1) {
2186 $highest = List::Util::reduce {
2187 Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
2190 $highest = $stems{$_}[0];
2192 $CPAN::Frontend->myprint("$highest\n");
2196 #-> sub CPAN::Shell::report ;
2198 my($self,@args) = @_;
2199 unless ($CPAN::META->has_inst("CPAN::Reporter")) {
2200 $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
2202 local $CPAN::Config->{test_report} = 1;
2203 $self->force("test",@args); # force is there so that the test be
2204 # re-run (as documented)
2207 # compare with is_tested
2208 #-> sub CPAN::Shell::install_tested
2209 sub install_tested {
2210 my($self,@some) = @_;
2211 $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
2213 CPAN::Index->reload;
2215 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2216 my $yaml = "$b.yml";
2218 $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
2221 my $yaml_content = CPAN->_yaml_loadfile($yaml);
2222 my $id = $yaml_content->[0]{distribution}{ID};
2224 $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
2227 my $do = CPAN::Shell->expandany($id);
2229 $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
2232 unless ($do->{build_dir}) {
2233 $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
2236 unless ($do->{build_dir} eq $b) {
2237 $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
2243 $CPAN::Frontend->mywarn("No tested distributions found.\n"),
2244 return unless @some;
2246 @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
2247 $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
2248 return unless @some;
2250 # @some = grep { not $_->uptodate } @some;
2251 # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
2252 # return unless @some;
2254 CPAN->debug("some[@some]");
2256 my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
2257 $CPAN::Frontend->myprint("install_tested: Running for $id\n");
2258 $CPAN::Frontend->mysleep(1);
2263 #-> sub CPAN::Shell::upgrade ;
2265 my($self,@args) = @_;
2266 $self->install($self->r(@args));
2269 #-> sub CPAN::Shell::_u_r_common ;
2271 my($self) = shift @_;
2272 my($what) = shift @_;
2273 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
2274 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
2275 $what && $what =~ /^[aru]$/;
2277 @args = '/./' unless @args;
2278 my(@result,$module,%seen,%need,$headerdone,
2279 $version_undefs,$version_zeroes);
2280 $version_undefs = $version_zeroes = 0;
2281 my $sprintf = "%s%-25s%s %9s %9s %s\n";
2282 my @expand = $self->expand('Module',@args);
2283 my $expand = scalar @expand;
2284 if (0) { # Looks like noise to me, was very useful for debugging
2285 # for metadata cache
2286 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
2288 MODULE: for $module (@expand) {
2289 my $file = $module->cpan_file;
2290 next MODULE unless defined $file; # ??
2291 $file =~ s|^./../||;
2292 my($latest) = $module->cpan_version;
2293 my($inst_file) = $module->inst_file;
2295 return if $CPAN::Signal;
2298 $have = $module->inst_version;
2299 } elsif ($what eq "r") {
2300 $have = $module->inst_version;
2302 if ($have eq "undef"){
2304 } elsif ($have == 0){
2307 next MODULE unless CPAN::Version->vgt($latest, $have);
2308 # to be pedantic we should probably say:
2309 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
2310 # to catch the case where CPAN has a version 0 and we have a version undef
2311 } elsif ($what eq "u") {
2317 } elsif ($what eq "r") {
2319 } elsif ($what eq "u") {
2323 return if $CPAN::Signal; # this is sometimes lengthy
2326 push @result, sprintf "%s %s\n", $module->id, $have;
2327 } elsif ($what eq "r") {
2328 push @result, $module->id;
2329 next MODULE if $seen{$file}++;
2330 } elsif ($what eq "u") {
2331 push @result, $module->id;
2332 next MODULE if $seen{$file}++;
2333 next MODULE if $file =~ /^Contact/;
2335 unless ($headerdone++){
2336 $CPAN::Frontend->myprint("\n");
2337 $CPAN::Frontend->myprint(sprintf(
2340 "Package namespace",
2352 $CPAN::META->has_inst("Term::ANSIColor")
2354 $module->description
2356 $color_on = Term::ANSIColor::color("green");
2357 $color_off = Term::ANSIColor::color("reset");
2359 $CPAN::Frontend->myprint(sprintf $sprintf,
2366 $need{$module->id}++;
2370 $CPAN::Frontend->myprint("No modules found for @args\n");
2371 } elsif ($what eq "r") {
2372 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
2376 if ($version_zeroes) {
2377 my $s_has = $version_zeroes > 1 ? "s have" : " has";
2378 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
2379 qq{a version number of 0\n});
2381 if ($version_undefs) {
2382 my $s_has = $version_undefs > 1 ? "s have" : " has";
2383 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
2384 qq{parseable version number\n});
2390 #-> sub CPAN::Shell::r ;
2392 shift->_u_r_common("r",@_);
2395 #-> sub CPAN::Shell::u ;
2397 shift->_u_r_common("u",@_);
2400 #-> sub CPAN::Shell::failed ;
2402 my($self,$only_id,$silent) = @_;
2404 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
2406 NAY: for my $nosayer ( # order matters!
2415 next unless exists $d->{$nosayer};
2416 next unless defined $d->{$nosayer};
2418 UNIVERSAL::can($d->{$nosayer},"failed") ?
2419 $d->{$nosayer}->failed :
2420 $d->{$nosayer} =~ /^NO/
2422 next NAY if $only_id && $only_id != (
2423 UNIVERSAL::can($d->{$nosayer},"commandid")
2425 $d->{$nosayer}->commandid
2427 $CPAN::CurrentCommandId
2432 next DIST unless $failed;
2436 # " %-45s: %s %s\n",
2439 UNIVERSAL::can($d->{$failed},"failed") ?
2441 $d->{$failed}->commandid,
2444 $d->{$failed}->text,
2445 $d->{$failed}{TIME}||0,
2458 $scope = "this command";
2459 } elsif ($CPAN::Index::HAVE_REANIMATED) {
2460 $scope = "this or a previous session";
2461 # it might be nice to have a section for previous session and
2464 $scope = "this session";
2471 map { sprintf "%5d %-45s: %s %s\n", @$_ }
2472 sort { $a->[0] <=> $b->[0] } @failed;
2475 map { sprintf " %-45s: %s %s\n", @$_[1..3] }
2482 $CPAN::Frontend->myprint("Failed during $scope:\n$print");
2483 } elsif (!$only_id || !$silent) {
2484 $CPAN::Frontend->myprint("Nothing failed in $scope\n");
2488 # XXX intentionally undocumented because completely bogus, unportable,
2491 #-> sub CPAN::Shell::status ;
2494 require Devel::Size;
2495 my $ps = FileHandle->new;
2496 open $ps, "/proc/$$/status";
2499 next unless /VmSize:\s+(\d+)/;
2503 $CPAN::Frontend->mywarn(sprintf(
2504 "%-27s %6d\n%-27s %6d\n",
2508 Devel::Size::total_size($CPAN::META)/1024,
2510 for my $k (sort keys %$CPAN::META) {
2511 next unless substr($k,0,4) eq "read";
2512 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
2513 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
2514 warn sprintf " %-25s %6d (keys: %6d)\n",
2516 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
2517 scalar keys %{$CPAN::META->{$k}{$k2}};
2522 # compare with install_tested
2523 #-> sub CPAN::Shell::is_tested
2526 CPAN::Index->reload;
2527 for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
2529 if ($CPAN::META->{is_tested}{$b}) {
2530 $time = scalar(localtime $CPAN::META->{is_tested}{$b});
2532 $time = scalar localtime;
2535 $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
2539 #-> sub CPAN::Shell::autobundle ;
2542 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
2543 my(@bundle) = $self->_u_r_common("a",@_);
2544 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2545 File::Path::mkpath($todir);
2546 unless (-d $todir) {
2547 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
2550 my($y,$m,$d) = (localtime)[5,4,3];
2554 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
2555 my($to) = File::Spec->catfile($todir,"$me.pm");
2557 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
2558 $to = File::Spec->catfile($todir,"$me.pm");
2560 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
2562 "package Bundle::$me;\n\n",
2563 "\$VERSION = '0.01';\n\n",
2567 "Bundle::$me - Snapshot of installation on ",
2568 $Config::Config{'myhostname'},
2571 "\n\n=head1 SYNOPSIS\n\n",
2572 "perl -MCPAN -e 'install Bundle::$me'\n\n",
2573 "=head1 CONTENTS\n\n",
2574 join("\n", @bundle),
2575 "\n\n=head1 CONFIGURATION\n\n",
2577 "\n\n=head1 AUTHOR\n\n",
2578 "This Bundle has been generated automatically ",
2579 "by the autobundle routine in CPAN.pm.\n",
2582 $CPAN::Frontend->myprint("\nWrote bundle file
2586 #-> sub CPAN::Shell::expandany ;
2589 CPAN->debug("s[$s]") if $CPAN::DEBUG;
2590 if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
2591 $s = CPAN::Distribution->normalize($s);
2592 return $CPAN::META->instance('CPAN::Distribution',$s);
2593 # Distributions spring into existence, not expand
2594 } elsif ($s =~ m|^Bundle::|) {
2595 $self->local_bundles; # scanning so late for bundles seems
2596 # both attractive and crumpy: always
2597 # current state but easy to forget
2599 return $self->expand('Bundle',$s);
2601 return $self->expand('Module',$s)
2602 if $CPAN::META->exists('CPAN::Module',$s);
2607 #-> sub CPAN::Shell::expand ;
2610 my($type,@args) = @_;
2611 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
2612 my $class = "CPAN::$type";
2613 my $methods = ['id'];
2614 for my $meth (qw(name)) {
2615 next unless $class->can($meth);
2616 push @$methods, $meth;
2618 $self->expand_by_method($class,$methods,@args);
2621 #-> sub CPAN::Shell::expand_by_method ;
2622 sub expand_by_method {
2624 my($class,$methods,@args) = @_;
2627 my($regex,$command);
2628 if ($arg =~ m|^/(.*)/$|) {
2630 } elsif ($arg =~ m/=/) {
2634 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
2636 defined $regex ? $regex : "UNDEFINED",
2637 defined $command ? $command : "UNDEFINED",
2639 if (defined $regex) {
2640 if (CPAN::_sqlite_running) {
2641 $CPAN::SQLite->search($class, $regex);
2644 $CPAN::META->all_objects($class)
2646 unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id){
2647 # BUG, we got an empty object somewhere
2648 require Data::Dumper;
2649 CPAN->debug(sprintf(
2650 "Bug in CPAN: Empty id on obj[%s][%s]",
2652 Data::Dumper::Dumper($obj)
2656 for my $method (@$methods) {
2657 my $match = eval {$obj->$method() =~ /$regex/i};
2659 my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
2660 $err ||= $@; # if we were too restrictive above
2661 $CPAN::Frontend->mydie("$err\n");
2668 } elsif ($command) {
2669 die "equal sign in command disabled (immature interface), ".
2671 ! \$CPAN::Shell::ADVANCED_QUERY=1
2672 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
2673 that may go away anytime.\n"
2674 unless $ADVANCED_QUERY;
2675 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
2676 my($matchcrit) = $criterion =~ m/^~(.+)/;
2680 $CPAN::META->all_objects($class)
2682 my $lhs = $self->$method() or next; # () for 5.00503
2684 push @m, $self if $lhs =~ m/$matchcrit/;
2686 push @m, $self if $lhs eq $criterion;
2691 if ( $class eq 'CPAN::Bundle' ) {
2692 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
2693 } elsif ($class eq "CPAN::Distribution") {
2694 $xarg = CPAN::Distribution->normalize($arg);
2698 if ($CPAN::META->exists($class,$xarg)) {
2699 $obj = $CPAN::META->instance($class,$xarg);
2700 } elsif ($CPAN::META->exists($class,$arg)) {
2701 $obj = $CPAN::META->instance($class,$arg);
2708 @m = sort {$a->id cmp $b->id} @m;
2709 if ( $CPAN::DEBUG ) {
2710 my $wantarray = wantarray;
2711 my $join_m = join ",", map {$_->id} @m;
2712 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2714 return wantarray ? @m : $m[0];
2717 #-> sub CPAN::Shell::format_result ;
2720 my($type,@args) = @_;
2721 @args = '/./' unless @args;
2722 my(@result) = $self->expand($type,@args);
2723 my $result = @result == 1 ?
2724 $result[0]->as_string :
2726 "No objects of type $type found for argument @args\n" :
2728 (map {$_->as_glimpse} @result),
2729 scalar @result, " items found\n",
2734 #-> sub CPAN::Shell::report_fh ;
2736 my $installation_report_fh;
2737 my $previously_noticed = 0;
2740 return $installation_report_fh if $installation_report_fh;
2741 if ($CPAN::META->has_inst("File::Temp")) {
2742 $installation_report_fh
2744 template => 'cpan_install_XXXX',
2749 unless ( $installation_report_fh ) {
2750 warn("Couldn't open installation report file; " .
2751 "no report file will be generated."
2752 ) unless $previously_noticed++;
2758 # The only reason for this method is currently to have a reliable
2759 # debugging utility that reveals which output is going through which
2760 # channel. No, I don't like the colors ;-)
2762 # to turn colordebugging on, write
2763 # cpan> o conf colorize_output 1
2765 #-> sub CPAN::Shell::print_ornamented ;
2767 my $print_ornamented_have_warned = 0;
2768 sub colorize_output {
2769 my $colorize_output = $CPAN::Config->{colorize_output};
2770 if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
2771 unless ($print_ornamented_have_warned++) {
2772 # no myprint/mywarn within myprint/mywarn!
2773 warn "Colorize_output is set to true but Term::ANSIColor is not
2774 installed. To activate colorized output, please install Term::ANSIColor.\n\n";
2776 $colorize_output = 0;
2778 return $colorize_output;
2783 #-> sub CPAN::Shell::print_ornamented ;
2784 sub print_ornamented {
2785 my($self,$what,$ornament) = @_;
2786 return unless defined $what;
2788 local $| = 1; # Flush immediately
2789 if ( $CPAN::Be_Silent ) {
2790 print {report_fh()} $what;
2793 my $swhat = "$what"; # stringify if it is an object
2794 if ($CPAN::Config->{term_is_latin}){
2797 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2799 if ($self->colorize_output) {
2800 if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
2801 # if you want to have this configurable, please file a bugreport
2802 $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
2804 my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
2806 print "Term::ANSIColor rejects color[$ornament]: $@\n
2807 Please choose a different color (Hint: try 'o conf init /color/')\n";
2811 Term::ANSIColor::color("reset");
2817 #-> sub CPAN::Shell::myprint ;
2819 # where is myprint/mywarn/Frontend/etc. documented? We need guidelines
2820 # where to use what! I think, we send everything to STDOUT and use
2821 # print for normal/good news and warn for news that need more
2822 # attention. Yes, this is our working contract for now.
2824 my($self,$what) = @_;
2826 $self->print_ornamented($what, $CPAN::Config->{colorize_print}||'bold blue on_white');
2829 #-> sub CPAN::Shell::myexit ;
2831 my($self,$what) = @_;
2832 $self->myprint($what);
2836 #-> sub CPAN::Shell::mywarn ;
2838 my($self,$what) = @_;
2839 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2842 # only to be used for shell commands
2843 #-> sub CPAN::Shell::mydie ;
2845 my($self,$what) = @_;
2846 $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
2848 # If it is the shell, we want that the following die to be silent,
2849 # but if it is not the shell, we would need a 'die $what'. We need
2850 # to take care that only shell commands use mydie. Is this
2856 # sub CPAN::Shell::colorable_makemaker_prompt ;
2857 sub colorable_makemaker_prompt {
2859 if (CPAN::Shell->colorize_output) {
2860 my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
2861 my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
2864 my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
2865 if (CPAN::Shell->colorize_output) {
2866 print Term::ANSIColor::color('reset');
2871 # use this only for unrecoverable errors!
2872 #-> sub CPAN::Shell::unrecoverable_error ;
2873 sub unrecoverable_error {
2874 my($self,$what) = @_;
2875 my @lines = split /\n/, $what;
2877 for my $l (@lines) {
2878 $longest = length $l if length $l > $longest;
2880 $longest = 62 if $longest > 62;
2881 for my $l (@lines) {
2887 if (length $l < 66) {
2888 $l = pack "A66 A*", $l, "<==";
2892 unshift @lines, "\n";
2893 $self->mydie(join "", @lines);
2896 #-> sub CPAN::Shell::mysleep ;
2898 my($self, $sleep) = @_;
2899 use Time::HiRes qw(sleep);
2903 #-> sub CPAN::Shell::setup_output ;
2905 return if -t STDOUT;
2906 my $odef = select STDERR;
2913 #-> sub CPAN::Shell::rematein ;
2914 # RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
2917 my($meth,@some) = @_;
2919 while($meth =~ /^(ff?orce|notest)$/) {
2920 push @pragma, $meth;
2921 $meth = shift @some or
2922 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2926 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2928 # Here is the place to set "test_count" on all involved parties to
2929 # 0. We then can pass this counter on to the involved
2930 # distributions and those can refuse to test if test_count > X. In
2931 # the first stab at it we could use a 1 for "X".
2933 # But when do I reset the distributions to start with 0 again?
2934 # Jost suggested to have a random or cycling interaction ID that
2935 # we pass through. But the ID is something that is just left lying
2936 # around in addition to the counter, so I'd prefer to set the
2937 # counter to 0 now, and repeat at the end of the loop. But what
2938 # about dependencies? They appear later and are not reset, they
2939 # enter the queue but not its copy. How do they get a sensible
2942 my $needs_recursion_protection = "make|test|install";
2944 # construct the queue
2946 STHING: foreach $s (@some) {
2949 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2951 } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
2952 } elsif ($s =~ m|^/|) { # looks like a regexp
2953 if (substr($s,-1,1) eq ".") {
2954 $obj = CPAN::Shell->expandany($s);
2956 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2957 "not supported.\nRejecting argument '$s'\n");
2958 $CPAN::Frontend->mysleep(2);
2961 } elsif ($meth eq "ls") {
2962 $self->globls($s,\@pragma);
2965 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2966 $obj = CPAN::Shell->expandany($s);
2969 } elsif (ref $obj) {
2970 if ($meth =~ /^($needs_recursion_protection)$/) {
2971 # silly for look or dump
2972 $obj->color_cmd_tmps(0,1);
2974 CPAN::Queue->new(qmod => $obj->id, reqtype => "c");
2976 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2977 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2978 if ($meth =~ /^(dump|ls)$/) {
2981 $CPAN::Frontend->mywarn(
2983 "Don't be silly, you can't $meth ",
2987 $CPAN::Frontend->mysleep(2);
2989 } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
2990 CPAN::InfoObj->dump($s);
2993 ->mywarn(qq{Warning: Cannot $meth $s, }.
2994 qq{don't know what it is.
2999 to find objects with matching identifiers.
3001 $CPAN::Frontend->mysleep(2);
3005 # queuerunner (please be warned: when I started to change the
3006 # queue to hold objects instead of names, I made one or two
3007 # mistakes and never found which. I reverted back instead)
3008 while (my $q = CPAN::Queue->first) {
3010 my $s = $q->as_string;
3011 my $reqtype = $q->reqtype || "";
3012 $obj = CPAN::Shell->expandany($s);
3014 # don't know how this can happen, maybe we should panic,
3015 # but maybe we get a solution from the first user who hits
3016 # this unfortunate exception?
3017 $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
3018 "to an object. Skipping.\n");
3019 $CPAN::Frontend->mysleep(5);
3020 CPAN::Queue->delete_first($s);
3023 $obj->{reqtype} ||= "";
3025 # force debugging because CPAN::SQLite somehow delivers us
3028 # local $CPAN::DEBUG = 1024; # Shell; probably fixed now
3030 CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
3031 "q-reqtype[$reqtype]") if $CPAN::DEBUG;
3033 if ($obj->{reqtype}) {
3034 if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
3035 $obj->{reqtype} = $reqtype;
3037 exists $obj->{install}
3040 UNIVERSAL::can($obj->{install},"failed") ?
3041 $obj->{install}->failed :
3042 $obj->{install} =~ /^NO/
3045 delete $obj->{install};
3046 $CPAN::Frontend->mywarn
3047 ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
3051 $obj->{reqtype} = $reqtype;
3054 for my $pragma (@pragma) {
3057 $obj->can($pragma)){
3058 $obj->$pragma($meth);
3061 if (UNIVERSAL::can($obj, 'called_for')) {
3062 $obj->called_for($s);
3064 CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
3065 qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;
3068 if (! UNIVERSAL::can($obj,$meth)) {
3070 my $serialized = "";
3072 } elsif ($CPAN::META->has_inst("YAML::Syck")) {
3073 $serialized = YAML::Syck::Dump($obj);
3074 } elsif ($CPAN::META->has_inst("YAML")) {
3075 $serialized = YAML::Dump($obj);
3076 } elsif ($CPAN::META->has_inst("Data::Dumper")) {
3077 $serialized = Data::Dumper::Dumper($obj);
3080 $serialized = overload::StrVal($obj);
3082 $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
3083 } elsif ($obj->$meth()){
3084 CPAN::Queue->delete($s);
3086 CPAN->debug("failed");
3090 for my $pragma (@pragma) {
3091 my $unpragma = "un$pragma";
3092 if ($obj->can($unpragma)) {
3096 CPAN::Queue->delete_first($s);
3098 if ($meth =~ /^($needs_recursion_protection)$/) {
3099 for my $obj (@qcopy) {
3100 $obj->color_cmd_tmps(0,0);
3105 #-> sub CPAN::Shell::recent ;
3109 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
3114 # set up the dispatching methods
3116 for my $command (qw(
3132 *$command = sub { shift->rematein($command, @_); };
3136 package CPAN::LWP::UserAgent;
3140 return if $SETUPDONE;
3141 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3142 require LWP::UserAgent;
3143 @ISA = qw(Exporter LWP::UserAgent);
3146 $CPAN::Frontend->mywarn(" LWP::UserAgent not available\n");
3150 sub get_basic_credentials {
3151 my($self, $realm, $uri, $proxy) = @_;
3152 if ($USER && $PASSWD) {
3153 return ($USER, $PASSWD);
3156 ($USER,$PASSWD) = $self->get_proxy_credentials();
3158 ($USER,$PASSWD) = $self->get_non_proxy_credentials();
3160 return($USER,$PASSWD);
3163 sub get_proxy_credentials {
3165 my ($user, $password);
3166 if ( defined $CPAN::Config->{proxy_user} &&
3167 defined $CPAN::Config->{proxy_pass}) {
3168 $user = $CPAN::Config->{proxy_user};
3169 $password = $CPAN::Config->{proxy_pass};
3170 return ($user, $password);
3172 my $username_prompt = "\nProxy authentication needed!
3173 (Note: to permanently configure username and password run
3174 o conf proxy_user your_username
3175 o conf proxy_pass your_password
3177 ($user, $password) =
3178 _get_username_and_password_from_user($username_prompt);
3179 return ($user,$password);
3182 sub get_non_proxy_credentials {
3184 my ($user,$password);
3185 if ( defined $CPAN::Config->{username} &&
3186 defined $CPAN::Config->{password}) {
3187 $user = $CPAN::Config->{username};
3188 $password = $CPAN::Config->{password};
3189 return ($user, $password);
3191 my $username_prompt = "\nAuthentication needed!
3192 (Note: to permanently configure username and password run
3193 o conf username your_username
3194 o conf password your_password
3197 ($user, $password) =
3198 _get_username_and_password_from_user($username_prompt);
3199 return ($user,$password);
3202 sub _get_username_and_password_from_user {
3203 my $username_message = shift;
3204 my ($username,$password);
3206 ExtUtils::MakeMaker->import(qw(prompt));
3207 $username = prompt($username_message);
3208 if ($CPAN::META->has_inst("Term::ReadKey")) {
3209 Term::ReadKey::ReadMode("noecho");
3212 $CPAN::Frontend->mywarn(
3213 "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
3216 $password = prompt("Password:");
3218 if ($CPAN::META->has_inst("Term::ReadKey")) {
3219 Term::ReadKey::ReadMode("restore");
3221 $CPAN::Frontend->myprint("\n\n");
3222 return ($username,$password);
3225 # mirror(): Its purpose is to deal with proxy authentication. When we
3226 # call SUPER::mirror, we relly call the mirror method in
3227 # LWP::UserAgent. LWP::UserAgent will then call
3228 # $self->get_basic_credentials or some equivalent and this will be
3229 # $self->dispatched to our own get_basic_credentials method.
3231 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3233 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3234 # although we have gone through our get_basic_credentials, the proxy
3235 # server refuses to connect. This could be a case where the username or
3236 # password has changed in the meantime, so I'm trying once again without
3237 # $USER and $PASSWD to give the get_basic_credentials routine another
3238 # chance to set $USER and $PASSWD.
3240 # mirror(): Its purpose is to deal with proxy authentication. When we
3241 # call SUPER::mirror, we relly call the mirror method in
3242 # LWP::UserAgent. LWP::UserAgent will then call
3243 # $self->get_basic_credentials or some equivalent and this will be
3244 # $self->dispatched to our own get_basic_credentials method.
3246 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
3248 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
3249 # although we have gone through our get_basic_credentials, the proxy
3250 # server refuses to connect. This could be a case where the username or
3251 # password has changed in the meantime, so I'm trying once again without
3252 # $USER and $PASSWD to give the get_basic_credentials routine another
3253 # chance to set $USER and $PASSWD.
3256 my($self,$url,$aslocal) = @_;
3257 my $result = $self->SUPER::mirror($url,$aslocal);
3258 if ($result->code == 407) {
3261 $result = $self->SUPER::mirror($url,$aslocal);
3269 #-> sub CPAN::FTP::ftp_statistics
3270 # if they want to rewrite, they need to pass in a filehandle
3271 sub _ftp_statistics {
3273 my $locktype = $fh ? LOCK_EX : LOCK_SH;
3274 $fh ||= FileHandle->new;
3275 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3276 open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!");
3279 while (!flock $fh, $locktype|LOCK_NB) {
3280 $waitstart ||= localtime();
3282 $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n");
3284 $CPAN::Frontend->mysleep($sleep);
3287 } elsif ($sleep <=6) {
3291 my $stats = eval { CPAN->_yaml_loadfile($file); };
3294 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
3295 $CPAN::Frontend->myprint("Warning (usually harmless): $@");
3297 } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
3298 $CPAN::Frontend->mydie($@);
3301 $CPAN::Frontend->mydie($@);
3307 #-> sub CPAN::FTP::_mytime
3309 if (CPAN->has_inst("Time::HiRes")) {
3310 return Time::HiRes::time();
3316 #-> sub CPAN::FTP::_new_stats
3318 my($self,$file) = @_;
3327 #-> sub CPAN::FTP::_add_to_statistics
3328 sub _add_to_statistics {
3329 my($self,$stats) = @_;
3330 my $yaml_module = CPAN::_yaml_module;
3331 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
3332 if ($CPAN::META->has_inst($yaml_module)) {
3333 $stats->{thesiteurl} = $ThesiteURL;
3334 if (CPAN->has_inst("Time::HiRes")) {
3335 $stats->{end} = Time::HiRes::time();
3337 $stats->{end} = time;
3339 my $fh = FileHandle->new;
3343 @debug = $time if $sdebug;
3344 my $fullstats = $self->_ftp_statistics($fh);
3346 $fullstats->{history} ||= [];
3347 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3348 push @debug, time if $sdebug;
3349 push @{$fullstats->{history}}, $stats;
3350 # arbitrary hardcoded constants until somebody demands to have
3351 # them settable; YAML.pm 0.62 is unacceptably slow with 999;
3352 # YAML::Syck 0.82 has no noticable performance problem with 999;
3354 @{$fullstats->{history}} > 99
3355 || $time - $fullstats->{history}[0]{start} > 14*86400
3357 shift @{$fullstats->{history}}
3359 push @debug, scalar @{$fullstats->{history}} if $sdebug;
3360 push @debug, time if $sdebug;
3361 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
3362 # need no eval because if this fails, it is serious
3363 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
3364 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
3365 if ( $sdebug||$CPAN::DEBUG ) {
3366 local $CPAN::DEBUG = 512; # FTP
3368 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
3369 "after[%d]at[%d]oldest[%s]dumped backat[%d]",
3373 # Win32 cannot rename a file to an existing filename
3374 unlink($sfile) if ($^O eq 'MSWin32');
3375 rename "$sfile.$$", $sfile
3376 or $CPAN::Frontend->mydie("Could not rename '$sfile.$$' to '$sfile': $!\n");
3380 # if file is CHECKSUMS, suggest the place where we got the file to be
3381 # checked from, maybe only for young files?
3382 #-> sub CPAN::FTP::_recommend_url_for
3383 sub _recommend_url_for {
3384 my($self, $file) = @_;
3385 my $urllist = $self->_get_urllist;
3386 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
3387 my $fullstats = $self->_ftp_statistics();
3388 my $history = $fullstats->{history} || [];
3389 while (my $last = pop @$history) {
3390 last if $last->{end} - time > 3600; # only young results are interesting
3391 next unless $last->{file}; # dirname of nothing dies!
3392 next unless $file eq File::Basename::dirname($last->{file});
3393 return $last->{thesiteurl};
3396 if ($CPAN::Config->{randomize_urllist}
3398 rand(1) < $CPAN::Config->{randomize_urllist}
3400 $urllist->[int rand scalar @$urllist];
3406 #-> sub CPAN::FTP::_get_urllist
3409 $CPAN::Config->{urllist} ||= [];
3410 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
3411 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
3412 $CPAN::Config->{urllist} = [];
3414 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
3415 for my $u (@urllist) {
3416 CPAN->debug("u[$u]") if $CPAN::DEBUG;
3417 if (UNIVERSAL::can($u,"text")) {
3418 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
3420 $u .= "/" unless substr($u,-1) eq "/";
3421 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
3427 #-> sub CPAN::FTP::ftp_get ;
3429 my($class,$host,$dir,$file,$target) = @_;
3431 qq[Going to fetch file [$file] from dir [$dir]
3432 on host [$host] as local [$target]\n]
3434 my $ftp = Net::FTP->new($host);
3436 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
3439 return 0 unless defined $ftp;
3440 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
3441 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
3442 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
3443 my $msg = $ftp->message;
3444 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
3447 unless ( $ftp->cwd($dir) ){
3448 my $msg = $ftp->message;
3449 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
3453 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
3454 unless ( $ftp->get($file,$target) ){
3455 my $msg = $ftp->message;
3456 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
3459 $ftp->quit; # it's ok if this fails
3463 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
3465 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
3466 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
3468 # > *** 1562,1567 ****
3469 # > --- 1562,1580 ----
3470 # > return 1 if substr($url,0,4) eq "file";
3471 # > return 1 unless $url =~ m|://([^/]+)|;
3473 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
3475 # > + $proxy =~ m|://([^/:]+)|;
3477 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
3478 # > + if ($noproxy) {
3479 # > + if ($host !~ /$noproxy$/) {
3480 # > + $host = $proxy;
3483 # > + $host = $proxy;
3486 # > require Net::Ping;
3487 # > return 1 unless $Net::Ping::VERSION >= 2;
3491 #-> sub CPAN::FTP::localize ;
3493 my($self,$file,$aslocal,$force) = @_;
3495 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
3496 unless defined $aslocal;
3497 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
3500 if ($^O eq 'MacOS') {
3501 # Comment by AK on 2000-09-03: Uniq short filenames would be
3502 # available in CHECKSUMS file
3503 my($name, $path) = File::Basename::fileparse($aslocal, '');
3504 if (length($name) > 31) {
3515 my $size = 31 - length($suf);
3516 while (length($name) > $size) {
3520 $aslocal = File::Spec->catfile($path, $name);
3524 if (-f $aslocal && -r _ && !($force & 1)){
3526 if ($size = -s $aslocal) {
3527 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
3530 # empty file from a previous unsuccessful attempt to download it
3532 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
3533 "could not remove.");
3536 my($maybe_restore) = 0;
3538 rename $aslocal, "$aslocal.bak$$";
3542 my($aslocal_dir) = File::Basename::dirname($aslocal);
3543 File::Path::mkpath($aslocal_dir);
3544 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
3545 qq{directory "$aslocal_dir".
3546 I\'ll continue, but if you encounter problems, they may be due
3547 to insufficient permissions.\n}) unless -w $aslocal_dir;
3549 # Inheritance is not easier to manage than a few if/else branches
3550 if ($CPAN::META->has_usable('LWP::UserAgent')) {
3552 CPAN::LWP::UserAgent->config;
3553 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
3555 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
3559 $Ua->proxy('ftp', $var)
3560 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
3561 $Ua->proxy('http', $var)
3562 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
3565 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
3567 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
3568 # > use ones that require basic autorization.
3570 # > Example of when I use it manually in my own stuff:
3572 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
3573 # > $req->proxy_authorization_basic("username","password");
3574 # > $res = $ua->request($req);
3578 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
3582 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
3583 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
3586 # Try the list of urls for each single object. We keep a record
3587 # where we did get a file from
3588 my(@reordered,$last);
3589 my $ccurllist = $self->_get_urllist;
3590 $last = $#$ccurllist;
3591 if ($force & 2) { # local cpans probably out of date, don't reorder
3592 @reordered = (0..$last);
3596 (substr($ccurllist->[$b],0,4) eq "file")
3598 (substr($ccurllist->[$a],0,4) eq "file")
3600 defined($ThesiteURL)
3602 ($ccurllist->[$b] eq $ThesiteURL)
3604 ($ccurllist->[$a] eq $ThesiteURL)
3609 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
3611 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
3613 @levels = qw/easy hard hardest/;
3615 @levels = qw/easy/ if $^O eq 'MacOS';
3617 local $ENV{FTP_PASSIVE} =
3618 exists $CPAN::Config->{ftp_passive} ?
3619 $CPAN::Config->{ftp_passive} : 1;
3621 my $stats = $self->_new_stats($file);
3622 LEVEL: for $levelno (0..$#levels) {
3623 my $level = $levels[$levelno];
3624 my $method = "host$level";
3625 my @host_seq = $level eq "easy" ?
3626 @reordered : 0..$last; # reordered has CDROM up front
3627 my @urllist = map { $ccurllist->[$_] } @host_seq;
3628 for my $u (@CPAN::Defaultsites) {
3629 push @urllist, $u unless grep { $_ eq $u } @urllist;
3631 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3632 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
3633 if (my $recommend = $self->_recommend_url_for($file)) {
3634 @urllist = grep { $_ ne $recommend } @urllist;
3635 unshift @urllist, $recommend;
3637 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
3638 $ret = $self->$method(\@urllist,$file,$aslocal_tempfile,$stats);
3640 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
3641 if ($ret eq $aslocal_tempfile) {
3642 # if we got it exactly as we asked for, only then we
3644 rename $aslocal_tempfile, $aslocal
3645 or $CPAN::Frontend->mydie("Error while trying to rename ".
3646 "'$ret' to '$aslocal': $!");
3649 $Themethod = $level;
3651 # utime $now, $now, $aslocal; # too bad, if we do that, we
3652 # might alter a local mirror
3653 $self->debug("level[$level]") if $CPAN::DEBUG;
3656 unlink $aslocal_tempfile;
3657 last if $CPAN::Signal; # need to cleanup
3661 $stats->{filesize} = -s $ret;
3663 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
3664 $self->_add_to_statistics($stats);
3665 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
3667 unlink "$aslocal.bak$$";
3670 unless ($CPAN::Signal) {
3673 if (@{$CPAN::Config->{urllist}}) {
3675 qq{Please check, if the URLs I found in your configuration file \(}.
3676 join(", ", @{$CPAN::Config->{urllist}}).
3679 push @mess, qq{Your urllist is empty!};
3681 push @mess, qq{The urllist can be edited.},
3682 qq{E.g. with 'o conf urllist push ftp://myurl/'};
3683 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
3684 $CPAN::Frontend->mywarn("Could not fetch $file\n");
3685 $CPAN::Frontend->mysleep(2);
3687 if ($maybe_restore) {
3688 rename "$aslocal.bak$$", $aslocal;
3689 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
3690 $self->ls($aslocal));
3697 my($self,$stats,$method,$url) = @_;
3698 push @{$stats->{attempts}}, {
3705 # package CPAN::FTP;
3707 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3709 HOSTEASY: for $ro_url (@$host_seq) {
3710 $self->_set_attempt($stats,"easy",$ro_url);
3711 my $url .= "$ro_url$file";
3712 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
3713 if ($url =~ /^file:/) {
3715 if ($CPAN::META->has_inst('URI::URL')) {
3716 my $u = URI::URL->new($url);
3718 } else { # works only on Unix, is poorly constructed, but
3719 # hopefully better than nothing.
3720 # RFC 1738 says fileurl BNF is
3721 # fileurl = "file://" [ host | "localhost" ] "/" fpath
3722 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
3724 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
3725 $l =~ s|^file:||; # assume they
3729 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
3731 $self->debug("local file[$l]") if $CPAN::DEBUG;
3732 if ( -f $l && -r _) {
3733 $ThesiteURL = $ro_url;
3736 if ($l =~ /(.+)\.gz$/) {
3738 if ( -f $ungz && -r _) {
3739 $ThesiteURL = $ro_url;
3743 # Maybe mirror has compressed it?
3745 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
3746 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
3748 $ThesiteURL = $ro_url;
3753 $self->debug("it was not a file URL") if $CPAN::DEBUG;
3754 if ($CPAN::META->has_usable('LWP')) {
3755 $CPAN::Frontend->myprint("Fetching with LWP:
3759 CPAN::LWP::UserAgent->config;
3760 eval { $Ua = CPAN::LWP::UserAgent->new; };
3762 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
3765 my $res = $Ua->mirror($url, $aslocal);
3766 if ($res->is_success) {
3767 $ThesiteURL = $ro_url;
3769 utime $now, $now, $aslocal; # download time is more
3770 # important than upload
3773 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3774 my $gzurl = "$url.gz";
3775 $CPAN::Frontend->myprint("Fetching with LWP:
3778 $res = $Ua->mirror($gzurl, "$aslocal.gz");
3779 if ($res->is_success) {
3780 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
3781 $ThesiteURL = $ro_url;
3786 $CPAN::Frontend->myprint(sprintf(
3787 "LWP failed with code[%s] message[%s]\n",
3791 # Alan Burlison informed me that in firewall environments
3792 # Net::FTP can still succeed where LWP fails. So we do not
3793 # skip Net::FTP anymore when LWP is available.
3796 $CPAN::Frontend->mywarn(" LWP not available\n");
3798 return if $CPAN::Signal;
3799 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3800 # that's the nice and easy way thanks to Graham
3801 $self->debug("recognized ftp") if $CPAN::DEBUG;
3802 my($host,$dir,$getfile) = ($1,$2,$3);
3803 if ($CPAN::META->has_usable('Net::FTP')) {
3805 $CPAN::Frontend->myprint("Fetching with Net::FTP:
3808 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
3809 "aslocal[$aslocal]") if $CPAN::DEBUG;
3810 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
3811 $ThesiteURL = $ro_url;
3814 if ($aslocal !~ /\.gz(?!\n)\Z/) {
3815 my $gz = "$aslocal.gz";
3816 $CPAN::Frontend->myprint("Fetching with Net::FTP
3819 if (CPAN::FTP->ftp_get($host,
3823 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
3825 $ThesiteURL = $ro_url;
3831 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
3835 UNIVERSAL::can($ro_url,"text")
3837 $ro_url->{FROM} eq "USER"
3839 ##address #17973: default URLs should not try to override
3840 ##user-defined URLs just because LWP is not available
3841 my $ret = $self->hosthard([$ro_url],$file,$aslocal,$stats);
3842 return $ret if $ret;
3844 return if $CPAN::Signal;
3848 # package CPAN::FTP;
3850 my($self,$host_seq,$file,$aslocal,$stats) = @_;
3852 # Came back if Net::FTP couldn't establish connection (or
3853 # failed otherwise) Maybe they are behind a firewall, but they
3854 # gave us a socksified (or other) ftp program...
3857 my($devnull) = $CPAN::Config->{devnull} || "";
3859 my($aslocal_dir) = File::Basename::dirname($aslocal);
3860 File::Path::mkpath($aslocal_dir);
3861 HOSTHARD: for $ro_url (@$host_seq) {
3862 $self->_set_attempt($stats,"hard",$ro_url);
3863 my $url = "$ro_url$file";
3864 my($proto,$host,$dir,$getfile);
3866 # Courtesy Mark Conty mark_conty@cargill.com change from
3867 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
3869 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
3870 # proto not yet used
3871 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
3873 next HOSTHARD; # who said, we could ftp anything except ftp?
3875 next HOSTHARD if $proto eq "file"; # file URLs would have had
3876 # success above. Likely a bogus URL
3878 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
3880 # Try the most capable first and leave ncftp* for last as it only
3882 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
3883 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
3884 next unless defined $funkyftp;
3885 next if $funkyftp =~ /^\s*$/;
3887 my($asl_ungz, $asl_gz);
3888 ($asl_ungz = $aslocal) =~ s/\.gz//;
3889 $asl_gz = "$asl_ungz.gz";
3891 my($src_switch) = "";
3893 my($stdout_redir) = " > $asl_ungz";
3895 $src_switch = " -source";
3896 } elsif ($f eq "ncftp"){
3897 $src_switch = " -c";
3898 } elsif ($f eq "wget"){
3899 $src_switch = " -O $asl_ungz";
3901 } elsif ($f eq 'curl'){
3902 $src_switch = ' -L -f -s -S --netrc-optional';
3905 if ($f eq "ncftpget"){
3906 $chdir = "cd $aslocal_dir && ";
3909 $CPAN::Frontend->myprint(
3911 Trying with "$funkyftp$src_switch" to get
3915 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
3916 $self->debug("system[$system]") if $CPAN::DEBUG;
3917 my($wstatus) = system($system);
3919 # lynx returns 0 when it fails somewhere
3921 my $content = do { local *FH;
3922 open FH, $asl_ungz or die;
3925 if ($content =~ /^<.*(<title>[45]|Error [45])/si) {
3926 $CPAN::Frontend->mywarn(qq{
3927 No success, the file that lynx has has downloaded looks like an error message:
3930 $CPAN::Frontend->mysleep(1);
3934 $CPAN::Frontend->myprint(qq{
3935 No success, the file that lynx has has downloaded is an empty file.
3940 if ($wstatus == 0) {
3943 } elsif ($asl_ungz ne $aslocal) {
3944 # test gzip integrity
3945 if (eval{CPAN::Tarzip->new($asl_ungz)->gtest}) {
3946 # e.g. foo.tar is gzipped --> foo.tar.gz
3947 rename $asl_ungz, $aslocal;
3949 eval{CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz)};
3952 $ThesiteURL = $ro_url;
3954 } elsif ($url !~ /\.gz(?!\n)\Z/) {
3956 -f $asl_ungz && -s _ == 0;
3957 my $gz = "$aslocal.gz";
3958 my $gzurl = "$url.gz";
3959 $CPAN::Frontend->myprint(
3961 Trying with "$funkyftp$src_switch" to get
3964 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
3965 $self->debug("system[$system]") if $CPAN::DEBUG;
3967 if (($wstatus = system($system)) == 0
3971 # test gzip integrity
3972 my $ct = eval{CPAN::Tarzip->new($asl_gz)};
3973 if ($ct && $ct->gtest) {
3974 $ct->gunzip($aslocal);
3976 # somebody uncompressed file for us?
3977 rename $asl_ungz, $aslocal;
3979 $ThesiteURL = $ro_url;
3982 unlink $asl_gz if -f $asl_gz;
3985 my $estatus = $wstatus >> 8;
3986 my $size = -f $aslocal ?
3987 ", left\n$aslocal with size ".-s _ :
3988 "\nWarning: expected file [$aslocal] doesn't exist";
3989 $CPAN::Frontend->myprint(qq{
3990 System call "$system"
3991 returned status $estatus (wstat $wstatus)$size
3994 return if $CPAN::Signal;
3995 } # transfer programs
3999 # package CPAN::FTP;
4001 my($self,$host_seq,$file,$aslocal,$stats) = @_;
4004 my($aslocal_dir) = File::Basename::dirname($aslocal);
4005 File::Path::mkpath($aslocal_dir);
4006 my $ftpbin = $CPAN::Config->{ftp};
4007 unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) {
4008 $CPAN::Frontend->myprint("No external ftp command available\n\n");
4011 $CPAN::Frontend->mywarn(qq{
4012 As a last ressort we now switch to the external ftp command '$ftpbin'
4015 Doing so often leads to problems that are hard to diagnose.
4017 If you're victim of such problems, please consider unsetting the ftp
4018 config variable with
4024 $CPAN::Frontend->mysleep(2);
4025 HOSTHARDEST: for $ro_url (@$host_seq) {
4026 $self->_set_attempt($stats,"hardest",$ro_url);
4027 my $url = "$ro_url$file";
4028 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
4029 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
4032 my($host,$dir,$getfile) = ($1,$2,$3);
4034 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
4035 $ctime,$blksize,$blocks) = stat($aslocal);
4036 $timestamp = $mtime ||= 0;
4037 my($netrc) = CPAN::FTP::netrc->new;
4038 my($netrcfile) = $netrc->netrc;
4039 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
4040 my $targetfile = File::Basename::basename($aslocal);
4046 map("cd $_", split /\//, $dir), # RFC 1738
4048 "get $getfile $targetfile",
4052 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
4053 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
4054 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
4056 $netrc->contains($host))) if $CPAN::DEBUG;
4057 if ($netrc->protected) {
4058 my $dialog = join "", map { " $_\n" } @dialog;
4060 if ($netrc->contains($host)) {
4061 $netrc_explain = "Relying that your .netrc entry for '$host' ".
4062 "manages the login";
4064 $netrc_explain = "Relying that your default .netrc entry ".
4065 "manages the login";
4067 $CPAN::Frontend->myprint(qq{
4068 Trying with external ftp to get
4071 Going to send the dialog
4075 $self->talk_ftp("$ftpbin$verbose $host",
4077 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4078 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4080 if ($mtime > $timestamp) {
4081 $CPAN::Frontend->myprint("GOT $aslocal\n");
4082 $ThesiteURL = $ro_url;
4085 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
4087 return if $CPAN::Signal;
4089 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
4090 qq{correctly protected.\n});
4093 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
4094 nor does it have a default entry\n");
4097 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
4098 # then and login manually to host, using e-mail as
4100 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
4104 "user anonymous $Config::Config{'cf_email'}"
4106 my $dialog = join "", map { " $_\n" } @dialog;
4107 $CPAN::Frontend->myprint(qq{
4108 Trying with external ftp to get
4110 Going to send the dialog
4114 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
4115 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4116 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
4118 if ($mtime > $timestamp) {
4119 $CPAN::Frontend->myprint("GOT $aslocal\n");
4120 $ThesiteURL = $ro_url;
4123 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
4125 return if $CPAN::Signal;
4126 $CPAN::Frontend->mywarn("Can't access URL $url.\n\n");
4127 $CPAN::Frontend->mysleep(2);
4131 # package CPAN::FTP;
4133 my($self,$command,@dialog) = @_;
4134 my $fh = FileHandle->new;
4135 $fh->open("|$command") or die "Couldn't open ftp: $!";
4136 foreach (@dialog) { $fh->print("$_\n") }
4137 $fh->close; # Wait for process to complete
4139 my $estatus = $wstatus >> 8;
4140 $CPAN::Frontend->myprint(qq{
4141 Subprocess "|$command"
4142 returned status $estatus (wstat $wstatus)
4146 # find2perl needs modularization, too, all the following is stolen
4150 my($self,$name) = @_;
4151 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
4152 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
4154 my($perms,%user,%group);
4158 $blocks = int(($blocks + 1) / 2);
4161 $blocks = int(($sizemm + 1023) / 1024);
4164 if (-f _) { $perms = '-'; }
4165 elsif (-d _) { $perms = 'd'; }
4166 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
4167 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
4168 elsif (-p _) { $perms = 'p'; }
4169 elsif (-S _) { $perms = 's'; }
4170 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
4172 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
4173 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
4174 my $tmpmode = $mode;
4175 my $tmp = $rwx[$tmpmode & 7];
4177 $tmp = $rwx[$tmpmode & 7] . $tmp;
4179 $tmp = $rwx[$tmpmode & 7] . $tmp;
4180 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
4181 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
4182 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
4185 my $user = $user{$uid} || $uid; # too lazy to implement lookup
4186 my $group = $group{$gid} || $gid;
4188 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
4190 my($moname) = $moname[$mon];
4191 if (-M _ > 365.25 / 2) {
4192 $timeyear = $year + 1900;
4195 $timeyear = sprintf("%02d:%02d", $hour, $min);
4198 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
4212 package CPAN::FTP::netrc;
4215 # package CPAN::FTP::netrc;
4218 my $home = CPAN::HandleConfig::home;
4219 my $file = File::Spec->catfile($home,".netrc");
4221 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
4222 $atime,$mtime,$ctime,$blksize,$blocks)
4227 my($fh,@machines,$hasdefault);
4229 $fh = FileHandle->new or die "Could not create a filehandle";
4231 if($fh->open($file)){
4232 $protected = ($mode & 077) == 0;
4234 NETRC: while (<$fh>) {
4235 my(@tokens) = split " ", $_;
4236 TOKEN: while (@tokens) {
4237 my($t) = shift @tokens;
4238 if ($t eq "default"){
4242 last TOKEN if $t eq "macdef";
4243 if ($t eq "machine") {
4244 push @machines, shift @tokens;
4249 $file = $hasdefault = $protected = "";
4253 'mach' => [@machines],
4255 'hasdefault' => $hasdefault,
4256 'protected' => $protected,
4260 # CPAN::FTP::netrc::hasdefault;
4261 sub hasdefault { shift->{'hasdefault'} }
4262 sub netrc { shift->{'netrc'} }
4263 sub protected { shift->{'protected'} }
4265 my($self,$mach) = @_;
4266 for ( @{$self->{'mach'}} ) {
4267 return 1 if $_ eq $mach;
4272 package CPAN::Complete;
4276 my($text, $line, $start, $end) = @_;
4277 my(@perlret) = cpl($text, $line, $start);
4278 # find longest common match. Can anybody show me how to peruse
4279 # T::R::Gnu to have this done automatically? Seems expensive.
4280 return () unless @perlret;
4281 my($newtext) = $text;
4282 for (my $i = length($text)+1;;$i++) {
4283 last unless length($perlret[0]) && length($perlret[0]) >= $i;
4284 my $try = substr($perlret[0],0,$i);
4285 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
4286 # warn "try[$try]tries[@tries]";
4287 if (@tries == @perlret) {
4293 ($newtext,@perlret);
4296 #-> sub CPAN::Complete::cpl ;
4298 my($word,$line,$pos) = @_;
4302 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4304 if ($line =~ s/^((?:notest|f?force)\s*)//) {
4309 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
4310 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
4312 } elsif ($line =~ /^(a|ls)\s/) {
4313 @return = cplx('CPAN::Author',uc($word));
4314 } elsif ($line =~ /^b\s/) {
4315 CPAN::Shell->local_bundles;
4316 @return = cplx('CPAN::Bundle',$word);
4317 } elsif ($line =~ /^d\s/) {
4318 @return = cplx('CPAN::Distribution',$word);
4319 } elsif ($line =~ m/^(
4320 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
4322 if ($word =~ /^Bundle::/) {
4323 CPAN::Shell->local_bundles;
4325 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4326 } elsif ($line =~ /^i\s/) {
4327 @return = cpl_any($word);
4328 } elsif ($line =~ /^reload\s/) {
4329 @return = cpl_reload($word,$line,$pos);
4330 } elsif ($line =~ /^o\s/) {
4331 @return = cpl_option($word,$line,$pos);
4332 } elsif ($line =~ m/^\S+\s/ ) {
4333 # fallback for future commands and what we have forgotten above
4334 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
4341 #-> sub CPAN::Complete::cplx ;
4343 my($class, $word) = @_;
4344 if (CPAN::_sqlite_running) {
4345 $CPAN::SQLite->search($class, "^\Q$word\E");
4347 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
4350 #-> sub CPAN::Complete::cpl_any ;
4354 cplx('CPAN::Author',$word),
4355 cplx('CPAN::Bundle',$word),
4356 cplx('CPAN::Distribution',$word),
4357 cplx('CPAN::Module',$word),
4361 #-> sub CPAN::Complete::cpl_reload ;
4363 my($word,$line,$pos) = @_;
4365 my(@words) = split " ", $line;
4366 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4367 my(@ok) = qw(cpan index);
4368 return @ok if @words == 1;
4369 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
4372 #-> sub CPAN::Complete::cpl_option ;
4374 my($word,$line,$pos) = @_;
4376 my(@words) = split " ", $line;
4377 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
4378 my(@ok) = qw(conf debug);
4379 return @ok if @words == 1;
4380 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
4382 } elsif ($words[1] eq 'index') {
4384 } elsif ($words[1] eq 'conf') {
4385 return CPAN::HandleConfig::cpl(@_);
4386 } elsif ($words[1] eq 'debug') {
4387 return sort grep /^\Q$word\E/i,
4388 sort keys %CPAN::DEBUG, 'all';
4392 package CPAN::Index;
4395 #-> sub CPAN::Index::force_reload ;
4398 $CPAN::Index::LAST_TIME = 0;
4402 #-> sub CPAN::Index::reload ;
4404 my($self,$force) = @_;
4407 # XXX check if a newer one is available. (We currently read it
4408 # from time to time)
4409 for ($CPAN::Config->{index_expire}) {
4410 $_ = 0.001 unless $_ && $_ > 0.001;
4412 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
4413 # debug here when CPAN doesn't seem to read the Metadata
4415 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
4417 unless ($CPAN::META->{PROTOCOL}) {
4418 $self->read_metadata_cache;
4419 $CPAN::META->{PROTOCOL} ||= "1.0";
4421 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
4422 # warn "Setting last_time to 0";
4423 $LAST_TIME = 0; # No warning necessary
4425 if ($LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
4428 # CPAN->debug("LAST_TIME[$LAST_TIME]index_expire[$CPAN::Config->{index_expire}]time[$time]");
4430 # IFF we are developing, it helps to wipe out the memory
4431 # between reloads, otherwise it is not what a user expects.
4432 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
4433 $CPAN::META = CPAN->new;
4436 local $LAST_TIME = $time;
4437 local $CPAN::META->{PROTOCOL} = PROTOCOL;
4439 my $needshort = $^O eq "dos";
4441 $self->rd_authindex($self
4443 "authors/01mailrc.txt.gz",
4445 File::Spec->catfile('authors', '01mailrc.gz') :
4446 File::Spec->catfile('authors', '01mailrc.txt.gz'),
4449 $debug = "timing reading 01[".($t2 - $time)."]";
4451 return if $CPAN::Signal; # this is sometimes lengthy
4452 $self->rd_modpacks($self
4454 "modules/02packages.details.txt.gz",
4456 File::Spec->catfile('modules', '02packag.gz') :
4457 File::Spec->catfile('modules', '02packages.details.txt.gz'),
4460 $debug .= "02[".($t2 - $time)."]";
4462 return if $CPAN::Signal; # this is sometimes lengthy
4463 $self->rd_modlist($self
4465 "modules/03modlist.data.gz",
4467 File::Spec->catfile('modules', '03mlist.gz') :
4468 File::Spec->catfile('modules', '03modlist.data.gz'),
4470 $self->write_metadata_cache;
4472 $debug .= "03[".($t2 - $time)."]";
4474 CPAN->debug($debug) if $CPAN::DEBUG;
4476 if ($CPAN::Config->{build_dir_reuse}) {
4477 $self->reanimate_build_dir;
4479 if (CPAN::_sqlite_running) {
4480 $CPAN::SQLite->reload(time => $time, force => $force)
4484 $CPAN::META->{PROTOCOL} = PROTOCOL;
4487 #-> sub CPAN::Index::reanimate_build_dir ;
4488 sub reanimate_build_dir {
4490 unless ($CPAN::META->has_inst($CPAN::Config->{yaml_module}||"YAML")) {
4493 return if $HAVE_REANIMATED++;
4494 my $d = $CPAN::Config->{build_dir};
4495 my $dh = DirHandle->new;
4496 opendir $dh, $d or return; # does not exist
4501 $CPAN::Frontend->myprint("Going to read $CPAN::Config->{build_dir}/\n");
4502 my @candidates = map { $_->[0] }
4503 sort { $b->[1] <=> $a->[1] }
4504 map { [ $_, -M File::Spec->catfile($d,$_) ] }
4505 grep {/\.yml$/} readdir $dh;
4506 DISTRO: for $dirent (@candidates) {
4507 my $y = eval {CPAN->_yaml_loadfile(File::Spec->catfile($d,$dirent))};
4510 if ($c && CPAN->_perl_fingerprint($c->{perl})) {
4511 my $key = $c->{distribution}{ID};
4512 for my $k (keys %{$c->{distribution}}) {
4513 if ($c->{distribution}{$k}
4514 && ref $c->{distribution}{$k}
4515 && UNIVERSAL::isa($c->{distribution}{$k},"CPAN::Distrostatus")) {
4516 $c->{distribution}{$k}{COMMANDID} = $i - @candidates;
4520 #we tried to restore only if element already
4521 #exists; but then we do not work with metadata
4524 = $CPAN::META->{readwrite}{'CPAN::Distribution'}{$key}
4525 = $c->{distribution};
4526 delete $do->{badtestcnt};
4528 if ($do->{make_test}
4530 && !$do->{make_test}->failed
4534 $do->{install}->failed
4537 $CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
4542 while (($painted/76) < ($i/@candidates)) {
4543 $CPAN::Frontend->myprint(".");
4547 $CPAN::Frontend->myprint(sprintf(
4548 "DONE\nFound %s old builds, restored the state of %s\n",
4549 @candidates ? sprintf("%d",scalar @candidates) : "no",
4550 $restored || "none",
4555 #-> sub CPAN::Index::reload_x ;
4557 my($cl,$wanted,$localname,$force) = @_;
4558 $force |= 2; # means we're dealing with an index here
4559 CPAN::HandleConfig->load; # we should guarantee loading wherever
4560 # we rely on Config XXX
4561 $localname ||= $wanted;
4562 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
4566 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
4569 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
4570 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
4571 qq{day$s. I\'ll use that.});
4574 $force |= 1; # means we're quite serious about it.
4576 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
4579 #-> sub CPAN::Index::rd_authindex ;
4581 my($cl, $index_target) = @_;
4582 return unless defined $index_target;
4583 return if CPAN::_sqlite_running;
4585 $CPAN::Frontend->myprint("Going to read $index_target\n");
4587 tie *FH, 'CPAN::Tarzip', $index_target;
4590 push @lines, split /\012/ while <FH>;
4594 my($userid,$fullname,$email) =
4595 m/alias\s+(\S+)\s+\"([^\"\<]*)\s+\<(.*)\>\"/;
4596 $fullname ||= $email;
4597 if ($userid && $fullname && $email){
4598 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
4599 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
4601 CPAN->debug(sprintf "line[%s]", $_) if $CPAN::DEBUG;
4604 while (($painted/76) < ($i/@lines)) {
4605 $CPAN::Frontend->myprint(".");
4608 return if $CPAN::Signal;
4610 $CPAN::Frontend->myprint("DONE\n");
4614 my($self,$dist) = @_;
4615 $dist = $self->{'id'} unless defined $dist;
4616 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
4620 #-> sub CPAN::Index::rd_modpacks ;
4622 my($self, $index_target) = @_;
4623 return unless defined $index_target;
4624 return if CPAN::_sqlite_running;
4625 $CPAN::Frontend->myprint("Going to read $index_target\n");
4626 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4628 CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
4631 while (my $bytes = $fh->READ(\$chunk,8192)) {
4634 my @lines = split /\012/, $slurp;
4635 CPAN->debug(sprintf "end[%d]", time) if $CPAN::DEBUG;
4638 my($line_count,$last_updated);
4640 my $shift = shift(@lines);
4641 last if $shift =~ /^\s*$/;
4642 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
4643 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
4645 CPAN->debug("line_count[$line_count]last_updated[$last_updated]") if $CPAN::DEBUG;
4646 if (not defined $line_count) {
4648 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Line-Count header.
4649 Please check the validity of the index file by comparing it to more
4650 than one CPAN mirror. I'll continue but problems seem likely to
4654 $CPAN::Frontend->mysleep(5);
4655 } elsif ($line_count != scalar @lines) {
4657 $CPAN::Frontend->mywarn(sprintf qq{Warning: Your %s
4658 contains a Line-Count header of %d but I see %d lines there. Please
4659 check the validity of the index file by comparing it to more than one
4660 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
4661 $index_target, $line_count, scalar(@lines));
4664 if (not defined $last_updated) {
4666 $CPAN::Frontend->mywarn(qq{Warning: Your $index_target does not contain a Last-Updated header.
4667 Please check the validity of the index file by comparing it to more
4668 than one CPAN mirror. I'll continue but problems seem likely to
4672 $CPAN::Frontend->mysleep(5);
4676 ->myprint(sprintf qq{ Database was generated on %s\n},
4678 $DATE_OF_02 = $last_updated;
4681 if ($CPAN::META->has_inst('HTTP::Date')) {
4683 $age -= HTTP::Date::str2time($last_updated);
4685 $CPAN::Frontend->mywarn(" HTTP::Date not available\n");
4686 require Time::Local;
4687 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
4688 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
4689 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
4696 qq{Warning: This index file is %d days old.
4697 Please check the host you chose as your CPAN mirror for staleness.
4698 I'll continue but problems seem likely to happen.\a\n},
4701 } elsif ($age < -1) {
4705 qq{Warning: Your system date is %d days behind this index file!
4707 Timestamp index file: %s
4708 Please fix your system time, problems with the make command expected.\n},
4718 # A necessity since we have metadata_cache: delete what isn't
4720 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
4721 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
4726 # before 1.56 we split into 3 and discarded the rest. From
4727 # 1.57 we assign remaining text to $comment thus allowing to
4728 # influence isa_perl
4729 my($mod,$version,$dist,$comment) = split " ", $_, 4;
4730 my($bundle,$id,$userid);
4732 if ($mod eq 'CPAN' &&
4734 CPAN::Queue->exists('Bundle::CPAN') ||
4735 CPAN::Queue->exists('CPAN')
4739 if ($version > $CPAN::VERSION){
4740 $CPAN::Frontend->mywarn(qq{
4741 New CPAN.pm version (v$version) available.
4742 [Currently running version is v$CPAN::VERSION]
4743 You might want to try
4746 to both upgrade CPAN.pm and run the new version without leaving
4747 the current session.
4750 $CPAN::Frontend->mysleep(2);
4751 $CPAN::Frontend->myprint(qq{\n});
4753 last if $CPAN::Signal;
4754 } elsif ($mod =~ /^Bundle::(.*)/) {
4759 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
4760 # Let's make it a module too, because bundles have so much
4761 # in common with modules.
4763 # Changed in 1.57_63: seems like memory bloat now without
4764 # any value, so commented out
4766 # $CPAN::META->instance('CPAN::Module',$mod);
4770 # instantiate a module object
4771 $id = $CPAN::META->instance('CPAN::Module',$mod);
4775 # Although CPAN prohibits same name with different version the
4776 # indexer may have changed the version for the same distro
4777 # since the last time ("Force Reindexing" feature)
4778 if ($id->cpan_file ne $dist
4780 $id->cpan_version ne $version
4782 $userid = $id->userid || $self->userid($dist);
4784 'CPAN_USERID' => $userid,
4785 'CPAN_VERSION' => $version,
4786 'CPAN_FILE' => $dist,
4790 # instantiate a distribution object
4791 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
4792 # we do not need CONTAINSMODS unless we do something with
4793 # this dist, so we better produce it on demand.
4795 ## my $obj = $CPAN::META->instance(
4796 ## 'CPAN::Distribution' => $dist
4798 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
4800 $CPAN::META->instance(
4801 'CPAN::Distribution' => $dist
4803 'CPAN_USERID' => $userid,
4804 'CPAN_COMMENT' => $comment,
4808 for my $name ($mod,$dist) {
4809 # $self->debug("exists name[$name]") if $CPAN::DEBUG;
4810 $exists{$name} = undef;
4814 while (($painted/76) < ($i/@lines)) {
4815 $CPAN::Frontend->myprint(".");
4818 return if $CPAN::Signal;
4820 $CPAN::Frontend->myprint("DONE\n");
4822 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
4823 for my $o ($CPAN::META->all_objects($class)) {
4824 next if exists $exists{$o->{ID}};
4825 $CPAN::META->delete($class,$o->{ID});
4826 # CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
4833 #-> sub CPAN::Index::rd_modlist ;
4835 my($cl,$index_target) = @_;
4836 return unless defined $index_target;
4837 return if CPAN::_sqlite_running;
4838 $CPAN::Frontend->myprint("Going to read $index_target\n");
4839 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
4843 while (my $bytes = $fh->READ(\$chunk,8192)) {
4846 my @eval2 = split /\012/, $slurp;
4849 my $shift = shift(@eval2);
4850 if ($shift =~ /^Date:\s+(.*)/){
4851 if ($DATE_OF_03 eq $1){
4852 $CPAN::Frontend->myprint("Unchanged.\n");
4857 last if $shift =~ /^\s*$/;
4859 push @eval2, q{CPAN::Modulelist->data;};
4861 my($comp) = Safe->new("CPAN::Safe1");
4862 my($eval2) = join("\n", @eval2);
4863 CPAN->debug(sprintf "length of eval2[%d]", length $eval2) if $CPAN::DEBUG;
4864 my $ret = $comp->reval($eval2);
4865 Carp::confess($@) if $@;
4866 return if $CPAN::Signal;
4868 my $until = keys(%$ret);
4870 CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG;
4872 my $obj = $CPAN::META->instance("CPAN::Module",$_);
4873 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
4874 $obj->set(%{$ret->{$_}});
4876 while (($painted/76) < ($i/$until)) {
4877 $CPAN::Frontend->myprint(".");
4880 return if $CPAN::Signal;
4882 $CPAN::Frontend->myprint("DONE\n");
4885 #-> sub CPAN::Index::write_metadata_cache ;
4886 sub write_metadata_cache {
4888 return unless $CPAN::Config->{'cache_metadata'};
4889 return if CPAN::_sqlite_running;
4890 return unless $CPAN::META->has_usable("Storable");
4892 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
4893 CPAN::Distribution)) {
4894 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
4896 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4897 $cache->{last_time} = $LAST_TIME;
4898 $cache->{DATE_OF_02} = $DATE_OF_02;
4899 $cache->{PROTOCOL} = PROTOCOL;
4900 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
4901 eval { Storable::nstore($cache, $metadata_file) };
4902 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4905 #-> sub CPAN::Index::read_metadata_cache ;
4906 sub read_metadata_cache {
4908 return unless $CPAN::Config->{'cache_metadata'};
4909 return if CPAN::_sqlite_running;
4910 return unless $CPAN::META->has_usable("Storable");
4911 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
4912 return unless -r $metadata_file and -f $metadata_file;
4913 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
4915 eval { $cache = Storable::retrieve($metadata_file) };
4916 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
4917 if (!$cache || !UNIVERSAL::isa($cache, 'HASH')){
4921 if (exists $cache->{PROTOCOL}) {
4922 if (PROTOCOL > $cache->{PROTOCOL}) {
4923 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
4924 "with protocol v%s, requiring v%s\n",
4931 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
4932 "with protocol v1.0\n");
4937 while(my($class,$v) = each %$cache) {
4938 next unless $class =~ /^CPAN::/;
4939 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
4940 while (my($id,$ro) = each %$v) {
4941 $CPAN::META->{readwrite}{$class}{$id} ||=
4942 $class->new(ID=>$id, RO=>$ro);
4947 unless ($clcnt) { # sanity check
4948 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
4951 if ($idcnt < 1000) {
4952 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
4953 "in $metadata_file\n");
4956 $CPAN::META->{PROTOCOL} ||=
4957 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
4958 # does initialize to some protocol
4959 $LAST_TIME = $cache->{last_time};
4960 $DATE_OF_02 = $cache->{DATE_OF_02};
4961 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
4962 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
4966 package CPAN::InfoObj;
4971 exists $self->{RO} and return $self->{RO};
4974 #-> sub CPAN::InfoObj::cpan_userid
4979 return $ro->{CPAN_USERID} || "N/A";
4981 $self->debug("ID[$self->{ID}]");
4982 # N/A for bundles found locally
4987 sub id { shift->{ID}; }
4989 #-> sub CPAN::InfoObj::new ;
4991 my $this = bless {}, shift;
4996 # The set method may only be used by code that reads index data or
4997 # otherwise "objective" data from the outside world. All session
4998 # related material may do anything else with instance variables but
4999 # must not touch the hash under the RO attribute. The reason is that
5000 # the RO hash gets written to Metadata file and is thus persistent.
5002 #-> sub CPAN::InfoObj::safe_chdir ;
5004 my($self,$todir) = @_;
5005 # we die if we cannot chdir and we are debuggable
5006 Carp::confess("safe_chdir called without todir argument")
5007 unless defined $todir and length $todir;
5009 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5013 unless (-x $todir) {
5014 unless (chmod 0755, $todir) {
5015 my $cwd = CPAN::anycwd();
5016 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
5017 "permission to change the permission; cannot ".
5018 "chdir to '$todir'\n");
5019 $CPAN::Frontend->mysleep(5);
5020 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5021 qq{to todir[$todir]: $!});
5025 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
5028 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
5031 my $cwd = CPAN::anycwd();
5032 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
5033 qq{to todir[$todir] (a chmod has been issued): $!});
5038 #-> sub CPAN::InfoObj::set ;
5040 my($self,%att) = @_;
5041 my $class = ref $self;
5043 # This must be ||=, not ||, because only if we write an empty
5044 # reference, only then the set method will write into the readonly
5045 # area. But for Distributions that spring into existence, maybe
5046 # because of a typo, we do not like it that they are written into
5047 # the readonly area and made permanent (at least for a while) and
5048 # that is why we do not "allow" other places to call ->set.
5049 unless ($self->id) {
5050 CPAN->debug("Bug? Empty ID, rejecting");
5053 my $ro = $self->{RO} =
5054 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
5056 while (my($k,$v) = each %att) {
5061 #-> sub CPAN::InfoObj::as_glimpse ;
5065 my $class = ref($self);
5066 $class =~ s/^CPAN:://;
5067 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
5068 push @m, sprintf "%-15s %s\n", $class, $id;
5072 #-> sub CPAN::InfoObj::as_string ;
5076 my $class = ref($self);
5077 $class =~ s/^CPAN:://;
5078 push @m, $class, " id = $self->{ID}\n";
5080 unless ($ro = $self->ro) {
5081 if (substr($self->{ID},-1,1) eq ".") { # directory
5084 $CPAN::Frontend->mydie("Unknown object $self->{ID}");
5087 for (sort keys %$ro) {
5088 # next if m/^(ID|RO)$/;
5090 if ($_ eq "CPAN_USERID") {
5092 $extra .= $self->fullname;
5093 my $email; # old perls!
5094 if ($email = $CPAN::META->instance("CPAN::Author",
5097 $extra .= " <$email>";
5099 $extra .= " <no email>";
5102 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
5103 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
5106 next unless defined $ro->{$_};
5107 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
5109 KEY: for (sort keys %$self) {
5110 next if m/^(ID|RO)$/;
5111 unless (defined $self->{$_}) {
5115 if (ref($self->{$_}) eq "ARRAY") {
5116 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
5117 } elsif (ref($self->{$_}) eq "HASH") {
5119 if (/^CONTAINSMODS$/) {
5120 $value = join(" ",sort keys %{$self->{$_}});
5121 } elsif (/^prereq_pm$/) {
5123 my $v = $self->{$_};
5124 for my $x (sort keys %$v) {
5126 for my $y (sort keys %{$v->{$x}}) {
5127 push @svalue, "$y=>$v->{$x}{$y}";
5129 push @value, "$x\:" . join ",", @svalue if @svalue;
5131 $value = join ";", @value;
5133 $value = $self->{$_};
5141 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
5147 #-> sub CPAN::InfoObj::fullname ;
5150 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
5153 #-> sub CPAN::InfoObj::dump ;
5155 my($self, $what) = @_;
5156 unless ($CPAN::META->has_inst("Data::Dumper")) {
5157 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
5159 local $Data::Dumper::Sortkeys;
5160 $Data::Dumper::Sortkeys = 1;
5161 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
5162 if (length $out > 100000) {
5163 my $fh_pager = FileHandle->new;
5164 local($SIG{PIPE}) = "IGNORE";
5165 my $pager = $CPAN::Config->{'pager'} || "cat";
5166 $fh_pager->open("|$pager")
5167 or die "Could not open pager $pager\: $!";
5168 $fh_pager->print($out);
5171 $CPAN::Frontend->myprint($out);
5175 package CPAN::Author;
5178 #-> sub CPAN::Author::force
5184 #-> sub CPAN::Author::force
5187 delete $self->{force};
5190 #-> sub CPAN::Author::id
5193 my $id = $self->{ID};
5194 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
5198 #-> sub CPAN::Author::as_glimpse ;
5202 my $class = ref($self);
5203 $class =~ s/^CPAN:://;
5204 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
5212 #-> sub CPAN::Author::fullname ;
5214 shift->ro->{FULLNAME};
5218 #-> sub CPAN::Author::email ;
5219 sub email { shift->ro->{EMAIL}; }
5221 #-> sub CPAN::Author::ls ;
5224 my $glob = shift || "";
5225 my $silent = shift || 0;
5228 # adapted from CPAN::Distribution::verifyCHECKSUM ;
5229 my(@csf); # chksumfile
5230 @csf = $self->id =~ /(.)(.)(.*)/;
5231 $csf[1] = join "", @csf[0,1];
5232 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
5234 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
5235 unless (grep {$_->[2] eq $csf[1]} @dl) {
5236 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
5239 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
5240 unless (grep {$_->[2] eq $csf[2]} @dl) {
5241 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
5244 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
5246 if ($CPAN::META->has_inst("Text::Glob")) {
5247 my $rglob = Text::Glob::glob_to_regex($glob);
5248 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
5250 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
5253 $CPAN::Frontend->myprint(join "", map {
5254 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
5255 } sort { $a->[2] cmp $b->[2] } @dl);
5259 # returns an array of arrays, the latter contain (size,mtime,filename)
5260 #-> sub CPAN::Author::dir_listing ;
5263 my $chksumfile = shift;
5264 my $recursive = shift;
5265 my $may_ftp = shift;
5268 File::Spec->catfile($CPAN::Config->{keep_source_where},
5269 "authors", "id", @$chksumfile);
5273 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
5274 # hazard. (Without GPG installed they are not that much better,
5276 $fh = FileHandle->new;
5277 if (open($fh, $lc_want)) {
5278 my $line = <$fh>; close $fh;
5279 unlink($lc_want) unless $line =~ /PGP/;
5283 # connect "force" argument with "index_expire".
5284 my $force = $self->{force};
5285 if (my @stat = stat $lc_want) {
5286 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
5290 $lc_file = CPAN::FTP->localize(
5291 "authors/id/@$chksumfile",
5296 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
5297 $chksumfile->[-1] .= ".gz";
5298 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
5301 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
5302 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
5308 $lc_file = $lc_want;
5309 # we *could* second-guess and if the user has a file: URL,
5310 # then we could look there. But on the other hand, if they do
5311 # have a file: URL, wy did they choose to set
5312 # $CPAN::Config->{show_upload_date} to false?
5315 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
5316 $fh = FileHandle->new;
5318 if (open $fh, $lc_file){
5321 $eval =~ s/\015?\012/\n/g;
5323 my($comp) = Safe->new();
5324 $cksum = $comp->reval($eval);
5326 rename $lc_file, "$lc_file.bad";
5327 Carp::confess($@) if $@;
5329 } elsif ($may_ftp) {
5330 Carp::carp "Could not open '$lc_file' for reading.";
5332 # Maybe should warn: "You may want to set show_upload_date to a true value"
5336 for $f (sort keys %$cksum) {
5337 if (exists $cksum->{$f}{isdir}) {
5339 my(@dir) = @$chksumfile;
5341 push @dir, $f, "CHECKSUMS";
5343 [$_->[0], $_->[1], "$f/$_->[2]"]
5344 } $self->dir_listing(\@dir,1,$may_ftp);
5346 push @result, [ 0, "-", $f ];
5350 ($cksum->{$f}{"size"}||0),
5351 $cksum->{$f}{"mtime"}||"---",
5359 package CPAN::Distribution;
5365 my $ro = $self->ro or return;
5369 # CPAN::Distribution::undelay
5372 delete $self->{later};
5375 # add the A/AN/ stuff
5376 # CPAN::Distribution::normalize
5379 $s = $self->id unless defined $s;
5380 if (substr($s,-1,1) eq ".") {
5381 # using a global because we are sometimes called as static method
5382 if (!$CPAN::META->{LOCK}
5383 && !$CPAN::Have_warned->{"$s is unlocked"}++
5385 $CPAN::Frontend->mywarn("You are visiting the local directory
5387 without lock, take care that concurrent processes do not do likewise.\n");
5388 $CPAN::Frontend->mysleep(1);
5391 $s = "$CPAN::iCwd/.";
5392 } elsif (File::Spec->file_name_is_absolute($s)) {
5393 } elsif (File::Spec->can("rel2abs")) {
5394 $s = File::Spec->rel2abs($s);
5396 $CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec");
5398 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5399 unless ($CPAN::META->exists("CPAN::Distribution", $s)) {
5400 for ($CPAN::META->instance("CPAN::Distribution", $s)) {
5401 $_->{build_dir} = $s;
5402 $_->{archived} = "local_directory";
5403 $_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory");
5409 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
5411 return $s if $s =~ m:^N/A|^Contact Author: ;
5412 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
5413 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
5414 CPAN->debug("s[$s]") if $CPAN::DEBUG;
5419 #-> sub CPAN::Distribution::author ;
5423 if (substr($self->id,-1,1) eq ".") {
5424 $authorid = "LOCAL";
5426 ($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
5428 CPAN::Shell->expand("Author",$authorid);
5431 # tries to get the yaml from CPAN instead of the distro itself:
5432 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
5435 my $meta = $self->pretty_id;
5436 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
5437 my(@ls) = CPAN::Shell->globls($meta);
5438 my $norm = $self->normalize($meta);
5442 File::Spec->catfile(
5443 $CPAN::Config->{keep_source_where},
5448 $self->debug("Doing localize") if $CPAN::DEBUG;
5449 unless ($local_file =
5450 CPAN::FTP->localize("authors/id/$norm",
5452 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
5454 my $yaml = CPAN->_yaml_loadfile($local_file)->[0];
5457 #-> sub CPAN::Distribution::cpan_userid
5460 if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) {
5463 return $self->SUPER::cpan_userid;
5466 #-> sub CPAN::Distribution::pretty_id
5470 return $id unless $id =~ m|^./../|;
5474 # mark as dirty/clean for the sake of recursion detection. $color=1
5475 # means "in use", $color=0 means "not in use anymore". $color=2 means
5476 # we have determined prereqs now and thus insist on passing this
5477 # through (at least) once again.
5479 #-> sub CPAN::Distribution::color_cmd_tmps ;
5480 sub color_cmd_tmps {
5482 my($depth) = shift || 0;
5483 my($color) = shift || 0;
5484 my($ancestors) = shift || [];
5485 # a distribution needs to recurse into its prereq_pms
5487 return if exists $self->{incommandcolor}
5489 && $self->{incommandcolor}==$color;
5490 if ($depth>=$CPAN::MAX_RECURSION){
5491 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5493 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5494 my $prereq_pm = $self->prereq_pm;
5495 if (defined $prereq_pm) {
5496 PREREQ: for my $pre (keys %{$prereq_pm->{requires}||{}},
5497 keys %{$prereq_pm->{build_requires}||{}}) {
5498 next PREREQ if $pre eq "perl";
5500 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
5501 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
5502 $CPAN::Frontend->mysleep(2);
5505 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5509 delete $self->{sponsored_mods};
5511 # as we are at the end of a command, we'll give up this
5512 # reminder of a broken test. Other commands may test this guy
5513 # again. Maybe 'badtestcnt' should be renamed to
5514 # 'make_test_failed_within_command'?
5515 delete $self->{badtestcnt};
5517 $self->{incommandcolor} = $color;
5520 #-> sub CPAN::Distribution::as_string ;
5523 $self->containsmods;
5525 $self->SUPER::as_string(@_);
5528 #-> sub CPAN::Distribution::containsmods ;
5531 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
5532 my $dist_id = $self->{ID};
5533 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
5534 my $mod_file = $mod->cpan_file or next;
5535 my $mod_id = $mod->{ID} or next;
5536 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
5538 if ($CPAN::Signal) {
5539 delete $self->{CONTAINSMODS};
5542 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
5544 keys %{$self->{CONTAINSMODS}||{}};
5547 #-> sub CPAN::Distribution::upload_date ;
5550 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
5551 my(@local_wanted) = split(/\//,$self->id);
5552 my $filename = pop @local_wanted;
5553 push @local_wanted, "CHECKSUMS";
5554 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
5555 return unless $author;
5556 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
5558 my($dirent) = grep { $_->[2] eq $filename } @dl;
5559 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
5560 return unless $dirent->[1];
5561 return $self->{UPLOAD_DATE} = $dirent->[1];
5564 #-> sub CPAN::Distribution::uptodate ;
5568 foreach $c ($self->containsmods) {
5569 my $obj = CPAN::Shell->expandany($c);
5570 unless ($obj->uptodate){
5571 my $id = $self->pretty_id;
5572 $self->debug("$id not uptodate due to $c") if $CPAN::DEBUG;
5579 #-> sub CPAN::Distribution::called_for ;
5582 $self->{CALLED_FOR} = $id if defined $id;
5583 return $self->{CALLED_FOR};
5586 #-> sub CPAN::Distribution::get ;
5589 $self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
5590 if (my $goto = $self->prefs->{goto}) {
5591 $CPAN::Frontend->mywarn
5593 "delegating to '%s' as specified in prefs file '%s' doc %d\n",
5595 $self->{prefs_file},
5596 $self->{prefs_file_doc},
5598 return $self->goto($goto);
5600 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5602 : ($ENV{PERLLIB} || "");
5604 $CPAN::META->set_perl5lib;
5605 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5609 $self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
5610 if ($self->prefs->{disabled}) {
5612 "Disabled via prefs file '%s' doc %d",
5613 $self->{prefs_file},
5614 $self->{prefs_file_doc},
5617 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $why");
5618 # note: not intended to be persistent but at least visible
5619 # during this session
5621 if (exists $self->{build_dir}) {
5622 # this deserves print, not warn:
5623 $CPAN::Frontend->myprint(" Has already been unwrapped into directory ".
5624 "$self->{build_dir}\n"
5629 # although we talk about 'force' we shall not test on
5630 # force directly. New model of force tries to refrain from
5631 # direct checking of force.
5632 exists $self->{unwrapped} and (
5633 UNIVERSAL::can($self->{unwrapped},"failed") ?
5634 $self->{unwrapped}->failed :
5635 $self->{unwrapped} =~ /^NO/
5637 and push @e, "Unwrapping had some problem, won't try again without force";
5640 $CPAN::Frontend->mywarn(join "", map {"$_\n"} @e) and return if @e;
5642 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
5645 # Get the file on local disk
5650 File::Spec->catfile(
5651 $CPAN::Config->{keep_source_where},
5654 split(/\//,$self->id)
5657 $self->debug("Doing localize") if $CPAN::DEBUG;
5658 unless ($local_file =
5659 CPAN::FTP->localize("authors/id/$self->{ID}",
5662 if ($CPAN::Index::DATE_OF_02) {
5663 $note = "Note: Current database in memory was generated ".
5664 "on $CPAN::Index::DATE_OF_02\n";
5666 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
5669 $self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG;
5670 $self->{localfile} = $local_file;
5671 return if $CPAN::Signal;
5676 if ($CPAN::META->has_inst("Digest::SHA")) {
5677 $self->debug("Digest::SHA is installed, verifying");
5678 $self->verifyCHECKSUM;
5680 $self->debug("Digest::SHA is NOT installed");
5682 return if $CPAN::Signal;
5685 # Create a clean room and go there
5687 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
5688 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
5689 $self->safe_chdir($builddir);
5690 $self->debug("Removing tmp-$$") if $CPAN::DEBUG;
5691 File::Path::rmtree("tmp-$$");
5692 unless (mkdir "tmp-$$", 0755) {
5693 $CPAN::Frontend->unrecoverable_error(<<EOF);
5694 Couldn't mkdir '$builddir/tmp-$$': $!
5696 Cannot continue: Please find the reason why I cannot make the
5699 and fix the problem, then retry.
5704 $self->safe_chdir($sub_wd);
5707 $self->safe_chdir("tmp-$$");
5712 my $ct = eval{CPAN::Tarzip->new($local_file)};
5714 $self->{unwrapped} = CPAN::Distrostatus->new("NO");
5715 delete $self->{build_dir};
5718 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
5719 $self->{was_uncompressed}++ unless eval{$ct->gtest()};
5720 $self->untar_me($ct);
5721 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
5722 $self->unzip_me($ct);
5724 $self->{was_uncompressed}++ unless $ct->gtest();
5725 $local_file = $self->handle_singlefile($local_file);
5728 # we are still in the tmp directory!
5729 # Let's check if the package has its own directory.
5730 my $dh = DirHandle->new(File::Spec->curdir)
5731 or Carp::croak("Couldn't opendir .: $!");
5732 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
5735 # XXX here we want in each branch File::Temp to protect all build_dir directories
5736 if (CPAN->has_inst("File::Temp")) {
5740 if (@readdir == 1 && -d $readdir[0]) {
5741 $tdir_base = $readdir[0];
5742 $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]);
5743 my $dh2 = DirHandle->new($from_dir)
5744 or Carp::croak("Couldn't opendir $from_dir: $!");
5745 @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC??
5747 my $userid = $self->cpan_userid;
5748 CPAN->debug("userid[$userid]");
5749 if (!$userid or $userid eq "N/A") {
5752 $tdir_base = $userid;
5753 $from_dir = File::Spec->curdir;
5754 @dirents = @readdir;
5756 $packagedir = File::Temp::tempdir(
5757 "$tdir_base-XXXXXX",
5762 for $f (@dirents) { # is already without "." and ".."
5763 my $from = File::Spec->catdir($from_dir,$f);
5764 my $to = File::Spec->catdir($packagedir,$f);
5765 unless (File::Copy::move($from,$to)) {
5767 $from = File::Spec->rel2abs($from);
5768 Carp::confess("Couldn't move $from to $to: $err");
5771 } else { # older code below, still better than nothing when there is no File::Temp
5773 if (@readdir == 1 && -d $readdir[0]) {
5774 $distdir = $readdir[0];
5775 $packagedir = File::Spec->catdir($builddir,$distdir);
5776 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
5778 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
5780 File::Path::rmtree($packagedir);
5781 unless (File::Copy::move($distdir,$packagedir)) {
5782 $CPAN::Frontend->unrecoverable_error(<<EOF);
5783 Couldn't move '$distdir' to '$packagedir': $!
5785 Cannot continue: Please find the reason why I cannot move
5786 $builddir/tmp-$$/$distdir
5789 and fix the problem, then retry
5793 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
5800 my $userid = $self->cpan_userid;
5801 CPAN->debug("userid[$userid]") if $CPAN::DEBUG;
5802 if (!$userid or $userid eq "N/A") {
5805 my $pragmatic_dir = $userid . '000';
5806 $pragmatic_dir =~ s/\W_//g;
5807 $pragmatic_dir++ while -d "../$pragmatic_dir";
5808 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
5809 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
5810 File::Path::mkpath($packagedir);
5812 for $f (@readdir) { # is already without "." and ".."
5813 my $to = File::Spec->catdir($packagedir,$f);
5814 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
5819 $self->safe_chdir($sub_wd);
5823 $self->{build_dir} = $packagedir;
5824 $self->safe_chdir($builddir);
5825 File::Path::rmtree("tmp-$$");
5827 $self->safe_chdir($packagedir);
5828 $self->_signature_business();
5829 $self->safe_chdir($builddir);
5830 return if $CPAN::Signal;
5833 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
5834 my($mpl_exists) = -f $mpl;
5835 unless ($mpl_exists) {
5836 # NFS has been reported to have racing problems after the
5837 # renaming of a directory in some environments.
5839 $CPAN::Frontend->mysleep(1);
5840 my $mpldh = DirHandle->new($packagedir)
5841 or Carp::croak("Couldn't opendir $packagedir: $!");
5842 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
5845 my $prefer_installer = "eumm"; # eumm|mb
5846 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
5847 if ($mpl_exists) { # they *can* choose
5848 if ($CPAN::META->has_inst("Module::Build")) {
5849 $prefer_installer = CPAN::HandleConfig->prefs_lookup($self,
5850 q{prefer_installer});
5853 $prefer_installer = "mb";
5856 return unless $self->patch;
5857 if (lc($prefer_installer) eq "mb") {
5858 $self->{modulebuild} = 1;
5859 } elsif ($self->{archived} eq "patch") {
5860 # not an edge case, nothing to install for sure
5861 my $why = "A patch file cannot be installed";
5862 $CPAN::Frontend->mywarn("Refusing to handle this file: $why\n");
5863 $self->{writemakefile} = CPAN::Distrostatus->new("NO $why");
5864 } elsif (! $mpl_exists) {
5865 $self->_edge_cases($mpl,$packagedir,$local_file);
5867 if ($self->{build_dir}
5869 $CPAN::Config->{build_dir_reuse}
5871 $self->store_persistent_state;
5877 #-> CPAN::Distribution::store_persistent_state
5878 sub store_persistent_state {
5880 my $dir = $self->{build_dir};
5881 unless (File::Spec->canonpath(File::Basename::dirname($dir))
5882 eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
5883 $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
5884 "will not store persistent state\n");
5887 my $file = sprintf "%s.yml", $dir;
5888 my $yaml_module = CPAN::_yaml_module;
5889 if ($CPAN::META->has_inst($yaml_module)) {
5890 CPAN->_yaml_dumpfile(
5894 perl => CPAN::_perl_fingerprint,
5895 distribution => $self,
5899 $CPAN::Frontend->myprint("Warning (usually harmless): '$yaml_module' not installed, ".
5900 "will not store persistent state\n");
5904 #-> CPAN::Distribution::patch
5906 my($self,$patch) = @_;
5907 my $norm = $self->normalize($patch);
5909 File::Spec->catfile(
5910 $CPAN::Config->{keep_source_where},
5915 $self->debug("Doing localize") if $CPAN::DEBUG;
5916 return CPAN::FTP->localize("authors/id/$norm",
5920 #-> CPAN::Distribution::patch
5923 $self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
5924 my $patches = $self->prefs->{patches};
5926 $self->debug("patches[$patches]") if $CPAN::DEBUG;
5928 return unless @$patches;
5929 $self->safe_chdir($self->{build_dir});
5930 CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
5931 my $patchbin = $CPAN::Config->{patch};
5932 unless ($patchbin && length $patchbin) {
5933 $CPAN::Frontend->mydie("No external patch command configured\n\n".
5934 "Please run 'o conf init /patch/'\n\n");
5936 unless (MM->maybe_command($patchbin)) {
5937 $CPAN::Frontend->mydie("No external patch command available\n\n".
5938 "Please run 'o conf init /patch/'\n\n");
5940 $patchbin = CPAN::HandleConfig->safe_quote($patchbin);
5941 local $ENV{PATCH_GET} = 0; # shall replace -g0 which is not
5942 # supported everywhere (and then,
5943 # not ever necessary there)
5944 my $stdpatchargs = "-N --fuzz=3";
5945 my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
5946 $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
5947 for my $patch (@$patches) {
5948 unless (-f $patch) {
5949 if (my $trydl = $self->try_download($patch)) {
5952 my $fail = "Could not find patch '$patch'";
5953 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5954 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5955 delete $self->{build_dir};
5959 $CPAN::Frontend->myprint(" $patch\n");
5960 my $readfh = CPAN::Tarzip->TIEHANDLE($patch);
5963 my $ppp = $self->_patch_p_parameter($readfh);
5964 if ($ppp eq "applypatch") {
5965 $pcommand = "$CPAN::Config->{applypatch} -verbose";
5967 my $thispatchargs = join " ", $stdpatchargs, $ppp;
5968 $pcommand = "$patchbin $thispatchargs";
5971 $readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again
5972 my $writefh = FileHandle->new;
5973 $CPAN::Frontend->myprint(" $pcommand\n");
5974 unless (open $writefh, "|$pcommand") {
5975 my $fail = "Could not fork '$pcommand'";
5976 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5977 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5978 delete $self->{build_dir};
5981 while (my $x = $readfh->READLINE) {
5984 unless (close $writefh) {
5985 my $fail = "Could not apply patch '$patch'";
5986 $CPAN::Frontend->mywarn("$fail; cannot continue\n");
5987 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail");
5988 delete $self->{build_dir};
5997 sub _patch_p_parameter {
6000 my $cnt_p0files = 0;
6002 while ($_ = $fh->READLINE) {
6004 $CPAN::Config->{applypatch}
6006 /\#\#\#\# ApplyPatch data follows \#\#\#\#/
6010 next unless /^[\*\+]{3}\s(\S+)/;
6013 $cnt_p0files++ if -f $file;
6014 CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]")
6017 return "-p1" unless $cnt_files;
6018 return $cnt_files==$cnt_p0files ? "-p0" : "-p1";
6021 #-> sub CPAN::Distribution::_edge_cases
6022 # with "configure" or "Makefile" or single file scripts
6024 my($self,$mpl,$packagedir,$local_file) = @_;
6025 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
6029 my($configure) = File::Spec->catfile($packagedir,"Configure");
6030 if (-f $configure) {
6031 # do we have anything to do?
6032 $self->{configure} = $configure;
6033 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
6034 $CPAN::Frontend->mywarn(qq{
6035 Package comes with a Makefile and without a Makefile.PL.
6036 We\'ll try to build it with that Makefile then.
6038 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6039 $CPAN::Frontend->mysleep(2);
6041 my $cf = $self->called_for || "unknown";
6046 $cf =~ s|[/\\:]||g; # risk of filesystem damage
6047 $cf = "unknown" unless length($cf);
6048 $CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL.
6049 (The test -f "$mpl" returned false.)
6050 Writing one on our own (setting NAME to $cf)\a\n});
6051 $self->{had_no_makefile_pl}++;
6052 $CPAN::Frontend->mysleep(3);
6054 # Writing our own Makefile.PL
6057 if ($self->{archived} eq "maybe_pl") {
6058 my $fh = FileHandle->new;
6059 my $script_file = File::Spec->catfile($packagedir,$local_file);
6060 $fh->open($script_file)
6061 or Carp::croak("Could not open $script_file: $!");
6063 # name parsen und prereq
6064 my($state) = "poddir";
6065 my($name, $prereq) = ("", "");
6067 if ($state eq "poddir" && /^=head\d\s+(\S+)/) {
6070 } elsif ($1 eq 'PREREQUISITES') {
6073 } elsif ($state =~ m{^(name|prereq)$}) {
6078 } elsif ($state eq "name") {
6083 } elsif ($state eq "prereq") {
6086 } elsif (/^=cut\b/) {
6093 s{.*<}{}; # strip X<...>
6097 $prereq = join " ", split /\s+/, $prereq;
6098 my($PREREQ_PM) = join("\n", map {
6099 s{.*<}{}; # strip X<...>
6101 if (/[\s\'\"]/) { # prose?
6103 s/[^\w:]$//; # period?
6104 " "x28 . "'$_' => 0,";
6106 } split /\s*,\s*/, $prereq);
6109 EXE_FILES => ['$name'],
6115 my $to_file = File::Spec->catfile($packagedir, $name);
6116 rename $script_file, $to_file
6117 or die "Can't rename $script_file to $to_file: $!";
6121 my $fh = FileHandle->new;
6123 or Carp::croak("Could not open >$mpl: $!");
6125 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
6126 # because there was no Makefile.PL supplied.
6127 # Autogenerated on: }.scalar localtime().qq{
6129 use ExtUtils::MakeMaker;
6131 NAME => q[$cf],$script
6138 #-> CPAN::Distribution::_signature_business
6139 sub _signature_business {
6141 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6144 if ($CPAN::META->has_inst("Module::Signature")) {
6145 if (-f "SIGNATURE") {
6146 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6147 my $rv = Module::Signature::verify();
6148 if ($rv != Module::Signature::SIGNATURE_OK() and
6149 $rv != Module::Signature::SIGNATURE_MISSING()) {
6150 $CPAN::Frontend->mywarn(
6151 qq{\nSignature invalid for }.
6152 qq{distribution file. }.
6153 qq{Please investigate.\n\n}
6157 sprintf(qq{I'd recommend removing %s. Its signature
6158 is invalid. Maybe you have configured your 'urllist' with
6159 a bad URL. Please check this array with 'o conf urllist', and
6160 retry. For more information, try opening a subshell with
6168 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
6169 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
6170 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
6172 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
6173 $self->debug("Module::Signature has verified") if $CPAN::DEBUG;
6176 $CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n});
6179 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6184 #-> CPAN::Distribution::untar_me ;
6187 $self->{archived} = "tar";
6189 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6191 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed");
6195 # CPAN::Distribution::unzip_me ;
6198 $self->{archived} = "zip";
6200 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6202 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed");
6207 sub handle_singlefile {
6208 my($self,$local_file) = @_;
6210 if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ){
6211 $self->{archived} = "pm";
6212 } elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) {
6213 $self->{archived} = "patch";
6215 $self->{archived} = "maybe_pl";
6218 my $to = File::Basename::basename($local_file);
6219 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
6220 if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) {
6221 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6223 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed");
6226 if (File::Copy::cp($local_file,".")) {
6227 $self->{unwrapped} = CPAN::Distrostatus->new("YES");
6229 $self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed");
6235 #-> sub CPAN::Distribution::new ;
6237 my($class,%att) = @_;
6239 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
6241 my $this = { %att };
6242 return bless $this, $class;
6245 #-> sub CPAN::Distribution::look ;
6249 if ($^O eq 'MacOS') {
6250 $self->Mac::BuildTools::look;
6254 if ( $CPAN::Config->{'shell'} ) {
6255 $CPAN::Frontend->myprint(qq{
6256 Trying to open a subshell in the build directory...
6259 $CPAN::Frontend->myprint(qq{
6260 Your configuration does not define a value for subshells.
6261 Please define it with "o conf shell <your shell>"
6265 my $dist = $self->id;
6267 unless ($dir = $self->dir) {
6270 unless ($dir ||= $self->dir) {
6271 $CPAN::Frontend->mywarn(qq{
6272 Could not determine which directory to use for looking at $dist.
6276 my $pwd = CPAN::anycwd();
6277 $self->safe_chdir($dir);
6278 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6280 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
6281 $ENV{CPAN_SHELL_LEVEL} += 1;
6282 my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'});
6283 unless (system($shell) == 0) {
6285 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
6288 $self->safe_chdir($pwd);
6291 # CPAN::Distribution::cvs_import ;
6295 my $dir = $self->dir;
6297 my $package = $self->called_for;
6298 my $module = $CPAN::META->instance('CPAN::Module', $package);
6299 my $version = $module->cpan_version;
6301 my $userid = $self->cpan_userid;
6303 my $cvs_dir = (split /\//, $dir)[-1];
6304 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
6306 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
6308 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
6309 if ($cvs_site_perl) {
6310 $cvs_dir = "$cvs_site_perl/$cvs_dir";
6312 my $cvs_log = qq{"imported $package $version sources"};
6313 $version =~ s/\./_/g;
6314 # XXX cvs: undocumented and unclear how it was meant to work
6315 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
6316 "$cvs_dir", $userid, "v$version");
6318 my $pwd = CPAN::anycwd();
6319 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
6321 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
6323 $CPAN::Frontend->myprint(qq{@cmd\n});
6324 system(@cmd) == 0 or
6326 $CPAN::Frontend->mydie("cvs import failed");
6327 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
6330 #-> sub CPAN::Distribution::readme ;
6333 my($dist) = $self->id;
6334 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
6335 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
6338 File::Spec->catfile(
6339 $CPAN::Config->{keep_source_where},
6342 split(/\//,"$sans.readme"),
6344 $self->debug("Doing localize") if $CPAN::DEBUG;
6345 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
6347 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
6349 if ($^O eq 'MacOS') {
6350 Mac::BuildTools::launch_file($local_file);
6354 my $fh_pager = FileHandle->new;
6355 local($SIG{PIPE}) = "IGNORE";
6356 my $pager = $CPAN::Config->{'pager'} || "cat";
6357 $fh_pager->open("|$pager")
6358 or die "Could not open pager $pager\: $!";
6359 my $fh_readme = FileHandle->new;
6360 $fh_readme->open($local_file)
6361 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
6362 $CPAN::Frontend->myprint(qq{
6367 $fh_pager->print(<$fh_readme>);
6371 #-> sub CPAN::Distribution::verifyCHECKSUM ;
6372 sub verifyCHECKSUM {
6376 $self->{CHECKSUM_STATUS} ||= "";
6377 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
6378 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6380 my($lc_want,$lc_file,@local,$basename);
6381 @local = split(/\//,$self->id);
6383 push @local, "CHECKSUMS";
6385 File::Spec->catfile($CPAN::Config->{keep_source_where},
6386 "authors", "id", @local);
6388 if (my $size = -s $lc_want) {
6389 $self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG;
6390 if ($self->CHECKSUM_check_file($lc_want,1)) {
6391 return $self->{CHECKSUM_STATUS} = "OK";
6394 $lc_file = CPAN::FTP->localize("authors/id/@local",
6397 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
6398 $local[-1] .= ".gz";
6399 $lc_file = CPAN::FTP->localize("authors/id/@local",
6402 $lc_file =~ s/\.gz(?!\n)\Z//;
6403 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
6408 if ($self->CHECKSUM_check_file($lc_file)) {
6409 return $self->{CHECKSUM_STATUS} = "OK";
6413 #-> sub CPAN::Distribution::SIG_check_file ;
6414 sub SIG_check_file {
6415 my($self,$chk_file) = @_;
6416 my $rv = eval { Module::Signature::_verify($chk_file) };
6418 if ($rv == Module::Signature::SIGNATURE_OK()) {
6419 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
6420 return $self->{SIG_STATUS} = "OK";
6422 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
6423 qq{distribution file. }.
6424 qq{Please investigate.\n\n}.
6426 $CPAN::META->instance(
6431 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
6432 is invalid. Maybe you have configured your 'urllist' with
6433 a bad URL. Please check this array with 'o conf urllist', and
6436 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6440 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
6442 # sloppy is 1 when we have an old checksums file that maybe is good
6445 sub CHECKSUM_check_file {
6446 my($self,$chk_file,$sloppy) = @_;
6447 my($cksum,$file,$basename);
6450 $self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
6451 my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
6454 if ($CPAN::META->has_inst("Module::Signature")) {
6455 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
6456 $self->SIG_check_file($chk_file);
6458 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
6462 $file = $self->{localfile};
6463 $basename = File::Basename::basename($file);
6464 my $fh = FileHandle->new;
6465 if (open $fh, $chk_file){
6468 $eval =~ s/\015?\012/\n/g;
6470 my($comp) = Safe->new();
6471 $cksum = $comp->reval($eval);
6473 rename $chk_file, "$chk_file.bad";
6474 Carp::confess($@) if $@;
6477 Carp::carp "Could not open $chk_file for reading";
6480 if (! ref $cksum or ref $cksum ne "HASH") {
6481 $CPAN::Frontend->mywarn(qq{
6482 Warning: checksum file '$chk_file' broken.
6484 When trying to read that file I expected to get a hash reference
6485 for further processing, but got garbage instead.
6487 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no");
6488 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6489 $self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken";
6491 } elsif (exists $cksum->{$basename}{sha256}) {
6492 $self->debug("Found checksum for $basename:" .
6493 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
6497 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
6499 $fh = CPAN::Tarzip->TIEHANDLE($file);
6502 my $dg = Digest::SHA->new(256);
6505 while ($fh->READ($ref, 4096) > 0){
6508 my $hexdigest = $dg->hexdigest;
6509 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
6513 $CPAN::Frontend->myprint("Checksum for $file ok\n");
6514 return $self->{CHECKSUM_STATUS} = "OK";
6516 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
6517 qq{distribution file. }.
6518 qq{Please investigate.\n\n}.
6520 $CPAN::META->instance(
6525 my $wrap = qq{I\'d recommend removing $file. Its
6526 checksum is incorrect. Maybe you have configured your 'urllist' with
6527 a bad URL. Please check this array with 'o conf urllist', and
6530 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
6532 # former versions just returned here but this seems a
6533 # serious threat that deserves a die
6535 # $CPAN::Frontend->myprint("\n\n");
6539 # close $fh if fileno($fh);
6542 unless ($self->{CHECKSUM_STATUS}) {
6543 $CPAN::Frontend->mywarn(qq{
6544 Warning: No checksum for $basename in $chk_file.
6546 The cause for this may be that the file is very new and the checksum
6547 has not yet been calculated, but it may also be that something is
6548 going awry right now.
6550 my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes");
6551 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n");
6553 $self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file";
6558 #-> sub CPAN::Distribution::eq_CHECKSUM ;
6560 my($self,$fh,$expect) = @_;
6561 if ($CPAN::META->has_inst("Digest::SHA")) {
6562 my $dg = Digest::SHA->new(256);
6564 while (read($fh, $data, 4096)){
6567 my $hexdigest = $dg->hexdigest;
6568 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
6569 return $hexdigest eq $expect;
6574 #-> sub CPAN::Distribution::force ;
6576 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
6577 # effect by autoinspection, not by inspecting a global variable. One
6578 # of the reason why this was chosen to work that way was the treatment
6579 # of dependencies. They should not automatically inherit the force
6580 # status. But this has the downside that ^C and die() will return to
6581 # the prompt but will not be able to reset the force_update
6582 # attributes. We try to correct for it currently in the read_metadata
6583 # routine, and immediately before we check for a Signal. I hope this
6584 # works out in one of v1.57_53ff
6586 # "Force get forgets previous error conditions"
6588 #-> sub CPAN::Distribution::fforce ;
6590 my($self, $method) = @_;
6591 $self->force($method,1);
6594 #-> sub CPAN::Distribution::force ;
6596 my($self, $method,$fforce) = @_;
6614 "prereq_pm_detected",
6628 my $methodmatch = 0;
6630 PHASE: for my $phase (qw(unknown get make test install)) { # order matters
6631 $methodmatch = 1 if $fforce || $phase eq $method;
6632 next unless $methodmatch;
6633 ATTRIBUTE: for my $att (@{$phase_map{$phase}}) {
6634 if ($phase eq "get") {
6635 if (substr($self->id,-1,1) eq "."
6636 && $att =~ /(unwrapped|build_dir|archived)/ ) {
6637 # cannot be undone for local distros
6640 if ($att eq "build_dir"
6641 && $self->{build_dir}
6642 && $CPAN::META->{is_tested}
6644 delete $CPAN::META->{is_tested}{$self->{build_dir}};
6646 } elsif ($phase eq "test") {
6647 if ($att eq "make_test"
6648 && $self->{make_test}
6649 && $self->{make_test}{COMMANDID}
6650 && $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId
6652 # endless loop too likely
6656 delete $self->{$att};
6657 if ($ldebug || $CPAN::DEBUG) {
6658 # local $CPAN::DEBUG = 16; # Distribution
6659 CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att);
6663 if ($method && $method =~ /make|test|install/) {
6664 $self->{force_update} = 1; # name should probably have been force_install
6668 #-> sub CPAN::Distribution::notest ;
6670 my($self, $method) = @_;
6671 # warn "XDEBUG: set notest for $self $method";
6672 $self->{"notest"}++; # name should probably have been force_install
6675 #-> sub CPAN::Distribution::unnotest ;
6678 # warn "XDEBUG: deleting notest";
6679 delete $self->{'notest'};
6682 #-> sub CPAN::Distribution::unforce ;
6685 delete $self->{force_update};
6688 #-> sub CPAN::Distribution::isa_perl ;
6691 my $file = File::Basename::basename($self->id);
6692 if ($file =~ m{ ^ perl
6701 \.tar[._-](?:gz|bz2)
6705 } elsif ($self->cpan_comment
6707 $self->cpan_comment =~ /isa_perl\(.+?\)/){
6713 #-> sub CPAN::Distribution::perl ;
6718 carp __PACKAGE__ . "::perl was called without parameters.";
6720 return CPAN::HandleConfig->safe_quote($CPAN::Perl);
6724 #-> sub CPAN::Distribution::make ;
6727 if (my $goto = $self->prefs->{goto}) {
6728 return $self->goto($goto);
6730 my $make = $self->{modulebuild} ? "Build" : "make";
6731 # Emergency brake if they said install Pippi and get newest perl
6732 if ($self->isa_perl) {
6734 $self->called_for ne $self->id &&
6735 ! $self->{force_update}
6737 # if we die here, we break bundles
6740 qq{The most recent version "%s" of the module "%s"
6741 is part of the perl-%s distribution. To install that, you need to run
6742 force install %s --or--
6745 $CPAN::META->instance(
6754 $self->{make} = CPAN::Distrostatus->new("NO isa perl");
6755 $CPAN::Frontend->mysleep(1);
6759 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
6761 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
6763 : ($ENV{PERLLIB} || "");
6764 $CPAN::META->set_perl5lib;
6765 local $ENV{MAKEFLAGS}; # protect us from outer make calls
6768 delete $self->{force_update};
6775 if (!$self->{archived} || $self->{archived} eq "NO") {
6776 push @e, "Is neither a tar nor a zip archive.";
6779 if (!$self->{unwrapped}
6781 UNIVERSAL::can($self->{unwrapped},"failed") ?
6782 $self->{unwrapped}->failed :
6783 $self->{unwrapped} =~ /^NO/
6785 push @e, "Had problems unarchiving. Please build manually";
6788 unless ($self->{force_update}) {
6789 exists $self->{signature_verify} and
6791 UNIVERSAL::can($self->{signature_verify},"failed") ?
6792 $self->{signature_verify}->failed :
6793 $self->{signature_verify} =~ /^NO/
6795 and push @e, "Did not pass the signature test.";
6798 if (exists $self->{writemakefile} &&
6800 UNIVERSAL::can($self->{writemakefile},"failed") ?
6801 $self->{writemakefile}->failed :
6802 $self->{writemakefile} =~ /^NO/
6804 # XXX maybe a retry would be in order?
6805 my $err = UNIVERSAL::can($self->{writemakefile},"text") ?
6806 $self->{writemakefile}->text :
6807 $self->{writemakefile};
6809 $err ||= "Had some problem writing Makefile";
6810 $err .= ", won't make";
6814 defined $self->{make} and push @e,
6815 "Has already been made";
6817 if (exists $self->{later} and length($self->{later})) {
6818 if ($self->unsat_prereq) {
6819 push @e, $self->{later};
6820 # RT ticket 18438 raises doubts if the deletion of {later} is valid.
6821 # YAML-0.53 triggered the later hodge-podge here, but my margin notes
6822 # are not sufficient to be sure if we really must/may do the delete
6823 # here. SO I accept the suggested patch for now. If we trigger a bug
6824 # again, I must go into deep contemplation about the {later} flag.
6827 # delete $self->{later};
6831 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
6832 $builddir = $self->dir or
6833 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n");
6834 unless (chdir $builddir) {
6835 push @e, "Couldn't chdir to '$builddir': $!";
6837 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
6840 delete $self->{force_update};
6843 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
6844 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
6846 if ($^O eq 'MacOS') {
6847 Mac::BuildTools::make($self);
6852 while (my($k,$v) = each %ENV) {
6853 next unless defined $v;
6858 if (my $commandline = $self->prefs->{pl}{commandline}) {
6859 $system = $commandline;
6861 } elsif ($self->{'configure'}) {
6862 $system = $self->{'configure'};
6863 } elsif ($self->{modulebuild}) {
6864 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6865 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
6867 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
6869 # This needs a handler that can be turned on or off:
6870 # $switch = "-MExtUtils::MakeMaker ".
6871 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
6873 my $makepl_arg = $self->make_x_arg("pl");
6874 $system = sprintf("%s%s Makefile.PL%s",
6876 $switch ? " $switch" : "",
6877 $makepl_arg ? " $makepl_arg" : "",
6880 if (my $env = $self->prefs->{pl}{env}) {
6881 for my $e (keys %$env) {
6882 $ENV{$e} = $env->{$e};
6885 if (exists $self->{writemakefile}) {
6887 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
6891 if ($CPAN::Config->{inactivity_timeout}) {
6893 if ($Config::Config{d_alarm}
6895 $Config::Config{d_alarm} eq "define"
6899 $CPAN::Frontend->mywarn("Warning: you have configured the config ".
6900 "variable 'inactivity_timeout' to ".
6901 "'$CPAN::Config->{inactivity_timeout}'. But ".
6902 "on this machine the system call 'alarm' ".
6903 "isn't available. This means that we cannot ".
6904 "provide the feature of intercepting long ".
6905 "waiting code and will turn this feature off.\n"
6907 $CPAN::Config->{inactivity_timeout} = 0;
6910 if ($go_via_alarm) {
6912 alarm $CPAN::Config->{inactivity_timeout};
6913 local $SIG{CHLD}; # = sub { wait };
6914 if (defined($pid = fork)) {
6919 # note, this exec isn't necessary if
6920 # inactivity_timeout is 0. On the Mac I'd
6921 # suggest, we set it always to 0.
6925 $CPAN::Frontend->myprint("Cannot fork: $!");
6934 $CPAN::Frontend->myprint($err);
6935 $self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
6940 if (my $expect_model = $self->_prefs_with_expect("pl")) {
6941 $ret = $self->_run_via_expect($system,$expect_model);
6943 && $self->{writemakefile}
6944 && $self->{writemakefile}->failed) {
6949 $ret = system($system);
6952 $self->{writemakefile} = CPAN::Distrostatus
6953 ->new("NO '$system' returned status $ret");
6954 $CPAN::Frontend->mywarn("Warning: No success on command[$system]\n");
6955 $self->store_persistent_state;
6956 $self->store_persistent_state;
6960 if (-f "Makefile" || -f "Build") {
6961 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
6962 delete $self->{make_clean}; # if cleaned before, enable next
6964 $self->{writemakefile} = CPAN::Distrostatus
6965 ->new(qq{NO -- Unknown reason});
6969 delete $self->{force_update};
6972 if (my @prereq = $self->unsat_prereq){
6973 if ($prereq[0][0] eq "perl") {
6974 my $need = "requires perl '$prereq[0][1]'";
6975 my $id = $self->pretty_id;
6976 $CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n");
6977 $self->{make} = CPAN::Distrostatus->new("NO $need");
6978 $self->store_persistent_state;
6981 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
6985 delete $self->{force_update};
6988 if (my $commandline = $self->prefs->{make}{commandline}) {
6989 $system = $commandline;
6992 if ($self->{modulebuild}) {
6993 unless (-f "Build") {
6994 my $cwd = CPAN::anycwd();
6995 $CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'".
6996 " in cwd[$cwd]. Danger, Will Robinson!");
6997 $CPAN::Frontend->mysleep(5);
6999 $system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg};
7001 $system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
7003 $system =~ s/\s+$//;
7004 my $make_arg = $self->make_x_arg("make");
7005 $system = sprintf("%s%s",
7007 $make_arg ? " $make_arg" : "",
7010 if (my $env = $self->prefs->{make}{env}) { # overriding the local
7011 # ENV of PL, not the
7013 # unlikely to be a risk
7014 for my $e (keys %$env) {
7015 $ENV{$e} = $env->{$e};
7018 my $expect_model = $self->_prefs_with_expect("make");
7019 my $want_expect = 0;
7020 if ( $expect_model && @{$expect_model->{talk}} ) {
7021 my $can_expect = $CPAN::META->has_inst("Expect");
7025 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7031 $system_ok = $self->_run_via_expect($system,$expect_model) == 0;
7033 $system_ok = system($system) == 0;
7035 $self->introduce_myself;
7037 $CPAN::Frontend->myprint(" $system -- OK\n");
7038 $self->{make} = CPAN::Distrostatus->new("YES");
7040 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
7041 $self->{make} = CPAN::Distrostatus->new("NO");
7042 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
7044 $self->store_persistent_state;
7047 # CPAN::Distribution::_run_via_expect
7048 sub _run_via_expect {
7049 my($self,$system,$expect_model) = @_;
7050 CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG;
7051 if ($CPAN::META->has_inst("Expect")) {
7052 my $expo = Expect->new; # expo Expect object;
7053 $expo->spawn($system);
7054 $expect_model->{mode} ||= "deterministic";
7055 if ($expect_model->{mode} eq "deterministic") {
7056 return $self->_run_via_expect_deterministic($expo,$expect_model);
7057 } elsif ($expect_model->{mode} eq "anyorder") {
7058 return $self->_run_via_expect_anyorder($expo,$expect_model);
7060 die "Panic: Illegal expect mode: $expect_model->{mode}";
7063 $CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n");
7064 return system($system);
7068 sub _run_via_expect_anyorder {
7069 my($self,$expo,$expect_model) = @_;
7070 my $timeout = $expect_model->{timeout} || 5;
7071 my @expectacopy = @{$expect_model->{talk}}; # we trash it!
7074 my($eof,$ran_into_timeout);
7075 my @match = $expo->expect($timeout,
7080 $ran_into_timeout++;
7087 $but .= $expo->clear_accum;
7090 return $expo->exitstatus();
7091 } elsif ($ran_into_timeout) {
7092 # warn "DEBUG: they are asking a question, but[$but]";
7093 for (my $i = 0; $i <= $#expectacopy; $i+=2) {
7094 my($next,$send) = @expectacopy[$i,$i+1];
7095 my $regex = eval "qr{$next}";
7096 # warn "DEBUG: will compare with regex[$regex].";
7097 if ($but =~ /$regex/) {
7098 # warn "DEBUG: will send send[$send]";
7100 splice @expectacopy, $i, 2; # never allow reusing an QA pair
7104 my $why = "could not answer a question during the dialog";
7105 $CPAN::Frontend->mywarn("Failing: $why\n");
7106 $self->{writemakefile} =
7107 CPAN::Distrostatus->new("NO $why");
7113 sub _run_via_expect_deterministic {
7114 my($self,$expo,$expect_model) = @_;
7115 my $ran_into_timeout;
7116 my $timeout = $expect_model->{timeout} || 15; # currently unsettable
7117 my $expecta = $expect_model->{talk};
7118 EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) {
7119 my($re,$send) = @$expecta[$i,$i+1];
7120 CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG;
7121 my $regex = eval "qr{$re}";
7122 $expo->expect($timeout,
7124 my $but = $expo->clear_accum;
7125 $CPAN::Frontend->mywarn("EOF (maybe harmless)
7126 expected[$regex]\nbut[$but]\n\n");
7130 my $but = $expo->clear_accum;
7131 $CPAN::Frontend->mywarn("TIMEOUT
7132 expected[$regex]\nbut[$but]\n\n");
7133 $ran_into_timeout++;
7136 if ($ran_into_timeout){
7137 # note that the caller expects 0 for success
7138 $self->{writemakefile} =
7139 CPAN::Distrostatus->new("NO timeout during expect dialog");
7145 return $expo->exitstatus();
7148 #-> CPAN::Distribution::_validate_distropref
7149 sub _validate_distropref {
7150 my($self,@args) = @_;
7152 $CPAN::META->has_inst("CPAN::Kwalify")
7154 $CPAN::META->has_inst("Kwalify")
7156 eval {CPAN::Kwalify::_validate("distroprefs",@args);};
7158 $CPAN::Frontend->mywarn($@);
7161 CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
7165 #-> CPAN::Distribution::_find_prefs
7168 my $distroid = $self->pretty_id;
7169 #CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
7170 my $prefs_dir = $CPAN::Config->{prefs_dir};
7171 eval { File::Path::mkpath($prefs_dir); };
7173 $CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
7175 my $yaml_module = CPAN::_yaml_module;
7177 if ($CPAN::META->has_inst($yaml_module)) {
7178 push @extensions, "yml";
7181 if ($CPAN::META->has_inst("Data::Dumper")) {
7182 push @extensions, "dd";
7183 push @fallbacks, "Data::Dumper";
7185 if ($CPAN::META->has_inst("Storable")) {
7186 push @extensions, "st";
7187 push @fallbacks, "Storable";
7191 unless ($self->{have_complained_about_missing_yaml}++) {
7192 $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back ".
7193 "to @fallbacks to read prefs '$prefs_dir'\n");
7196 unless ($self->{have_complained_about_missing_yaml}++) {
7197 $CPAN::Frontend->mywarn("'$yaml_module' not installed, cannot ".
7198 "read prefs '$prefs_dir'\n");
7203 my $dh = DirHandle->new($prefs_dir)
7204 or die Carp::croak("Couldn't open '$prefs_dir': $!");
7205 DIRENT: for (sort $dh->read) {
7206 next if $_ eq "." || $_ eq "..";
7207 my $exte = join "|", @extensions;
7208 next unless /\.($exte)$/;
7210 my $abs = File::Spec->catfile($prefs_dir, $_);
7212 #CPAN->debug(sprintf "abs[%s]", $abs) if $CPAN::DEBUG;
7214 if ($thisexte eq "yml") {
7215 # need no eval because if we have no YAML we do not try to read *.yml
7216 #CPAN->debug(sprintf "before yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7217 @distropref = @{CPAN->_yaml_loadfile($abs)};
7218 #CPAN->debug(sprintf "after yaml load abs[%s]", $abs) if $CPAN::DEBUG;
7219 } elsif ($thisexte eq "dd") {
7222 open FH, "<$abs" or $CPAN::Frontend->mydie("Could not open '$abs': $!");
7228 $CPAN::Frontend->mydie("Error in distroprefs file $_\: $@");
7231 while (${"VAR".$i}) {
7232 push @distropref, ${"VAR".$i};
7235 } elsif ($thisexte eq "st") {
7236 # eval because Storable is never forward compatible
7237 eval { @distropref = @{scalar Storable::retrieve($abs)}; };
7239 $CPAN::Frontend->mywarn("Error reading distroprefs file ".
7240 "$_, skipping\: $@");
7241 $CPAN::Frontend->mysleep(4);
7246 #CPAN->debug(sprintf "#distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7247 ELEMENT: for my $y (0..$#distropref) {
7248 my $distropref = $distropref[$y];
7249 $self->_validate_distropref($distropref,$abs,$y);
7250 my $match = $distropref->{match};
7252 #CPAN->debug("no 'match' in abs[$abs], skipping") if $CPAN::DEBUG;
7256 # do not take the order of C<keys %$match> because
7257 # "module" is by far the slowest
7258 my $saw_valid_subkeys = 0;
7259 for my $sub_attribute (qw(distribution perl perlconfig module)) {
7260 next unless exists $match->{$sub_attribute};
7261 $saw_valid_subkeys++;
7262 my $qr = eval "qr{$distropref->{match}{$sub_attribute}}";
7263 if ($sub_attribute eq "module") {
7265 #CPAN->debug(sprintf "distropref[%d]", scalar @distropref) if $CPAN::DEBUG;
7266 my @modules = $self->containsmods;
7267 #CPAN->debug(sprintf "modules[%s]", join(",",@modules)) if $CPAN::DEBUG;
7268 MODULE: for my $module (@modules) {
7269 $okm ||= $module =~ /$qr/;
7270 last MODULE if $okm;
7273 } elsif ($sub_attribute eq "distribution") {
7274 my $okd = $distroid =~ /$qr/;
7276 } elsif ($sub_attribute eq "perl") {
7277 my $okp = $^X =~ /$qr/;
7279 } elsif ($sub_attribute eq "perlconfig") {
7280 for my $perlconfigkey (keys %{$match->{perlconfig}}) {
7281 my $perlconfigval = $match->{perlconfig}->{$perlconfigkey};
7282 # XXX should probably warn if Config does not exist
7283 my $okpc = $Config::Config{$perlconfigkey} =~ /$perlconfigval/;
7288 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7289 "unknown sub_attribut '$sub_attribute'. ".
7291 "remove, cannot continue.");
7293 last if $ok == 0; # short circuit
7295 unless ($saw_valid_subkeys) {
7296 $CPAN::Frontend->mydie("Nonconforming .$thisexte file '$abs': ".
7297 "missing match/* subattribute. ".
7299 "remove, cannot continue.");
7301 #CPAN->debug(sprintf "ok[%d]", $ok) if $CPAN::DEBUG;
7304 prefs => $distropref,
7306 prefs_file_doc => $y,
7318 # CPAN::Distribution::prefs
7321 if (exists $self->{negative_prefs_cache}
7323 $self->{negative_prefs_cache} != $CPAN::CurrentCommandId
7325 delete $self->{negative_prefs_cache};
7326 delete $self->{prefs};
7328 if (exists $self->{prefs}) {
7329 return $self->{prefs}; # XXX comment out during debugging
7331 if ($CPAN::Config->{prefs_dir}) {
7332 CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
7333 my $prefs = $self->_find_prefs();
7334 $prefs ||= ""; # avoid warning next line
7335 CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
7337 for my $x (qw(prefs prefs_file prefs_file_doc)) {
7338 $self->{$x} = $prefs->{$x};
7342 File::Basename::basename($self->{prefs_file}),
7343 $self->{prefs_file_doc},
7345 my $filler1 = "_" x 22;
7346 my $filler2 = int(66 - length($bs))/2;
7347 $filler2 = 0 if $filler2 < 0;
7348 $filler2 = " " x $filler2;
7349 $CPAN::Frontend->myprint("
7350 $filler1 D i s t r o P r e f s $filler1
7351 $filler2 $bs $filler2
7353 $CPAN::Frontend->mysleep(1);
7354 return $self->{prefs};
7357 $self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
7358 return $self->{prefs} = +{};
7361 # CPAN::Distribution::make_x_arg
7363 my($self, $whixh) = @_;
7365 my $prefs = $self->prefs;
7368 && exists $prefs->{$whixh}
7369 && exists $prefs->{$whixh}{args}
7370 && $prefs->{$whixh}{args}
7372 $make_x_arg = join(" ",
7373 map {CPAN::HandleConfig
7374 ->safe_quote($_)} @{$prefs->{$whixh}{args}},
7377 my $what = sprintf "make%s_arg", $whixh eq "make" ? "" : $whixh;
7378 $make_x_arg ||= $CPAN::Config->{$what};
7382 # CPAN::Distribution::_make_command
7389 CPAN::HandleConfig->prefs_lookup($self,
7391 || $Config::Config{make}
7395 # Old style call, without object. Deprecated
7396 Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
7399 CPAN::HandleConfig->prefs_lookup($self,q{make})
7400 || $CPAN::Config->{make}
7401 || $Config::Config{make}
7406 #-> sub CPAN::Distribution::follow_prereqs ;
7407 sub follow_prereqs {
7409 my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_;
7410 return unless @prereq_tuples;
7411 my @prereq = map { $_->[0] } @prereq_tuples;
7412 my $pretty_id = $self->pretty_id;
7414 b => "build_requires",
7418 my($filler1,$filler2,$filler3,$filler4);
7420 my $unsat = "Unsatisfied dependencies detected during";
7421 my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id);
7423 my $r = int(($w - length($unsat))/2);
7424 my $l = $w - length($unsat) - $r;
7425 $filler1 = "-"x4 . " "x$l;
7426 $filler2 = " "x$r . "-"x4 . "\n";
7429 my $r = int(($w - length($pretty_id))/2);
7430 my $l = $w - length($pretty_id) - $r;
7431 $filler3 = "-"x4 . " "x$l;
7432 $filler4 = " "x$r . "-"x4 . "\n";
7435 myprint("$filler1 $unsat $filler2".
7436 "$filler3 $pretty_id $filler4".
7437 join("", map {" $_->[0] \[$map{$_->[1]}]\n"} @prereq_tuples),
7440 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
7442 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
7443 my $answer = CPAN::Shell::colorable_makemaker_prompt(
7444 "Shall I follow them and prepend them to the queue
7445 of modules we are processing right now?", "yes");
7446 $follow = $answer =~ /^\s*y/i;
7450 myprint(" Ignoring dependencies on modules @prereq\n");
7454 # color them as dirty
7455 for my $p (@prereq) {
7456 # warn "calling color_cmd_tmps(0,1)";
7457 my $any = CPAN::Shell->expandany($p);
7459 $any->color_cmd_tmps(0,2);
7461 $CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$p'\n");
7462 $CPAN::Frontend->mysleep(2);
7465 # queue them and re-queue yourself
7466 CPAN::Queue->jumpqueue([$id,$self->{reqtype}],
7467 reverse @prereq_tuples);
7468 $self->{later} = "Delayed until after prerequisites";
7469 return 1; # signal success to the queuerunner
7473 #-> sub CPAN::Distribution::unsat_prereq ;
7474 # return ([Foo=>1],[Bar=>1.2]) for normal modules
7475 # return ([perl=>5.008]) if we need a newer perl than we are running under
7478 my $prereq_pm = $self->prereq_pm or return;
7480 my %merged = (%{$prereq_pm->{requires}||{}},%{$prereq_pm->{build_requires}||{}});
7481 my @merged = %merged;
7482 CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG;
7483 NEED: while (my($need_module, $need_version) = each %merged) {
7484 my($available_version,$available_file,$nmo);
7485 if ($need_module eq "perl") {
7486 $available_version = $];
7487 $available_file = $^X;
7489 $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
7490 next if $nmo->uptodate;
7491 $available_file = $nmo->available_file;
7493 # if they have not specified a version, we accept any installed one
7494 if (not defined $need_version or
7495 $need_version == 0 or
7496 $need_version eq "undef") {
7497 next if defined $available_file;
7500 $available_version = $nmo->available_version;
7503 # We only want to install prereqs if either they're not installed
7504 # or if the installed version is too old. We cannot omit this
7505 # check, because if 'force' is in effect, nobody else will check.
7506 if (defined $available_file) {
7507 my(@all_requirements) = split /\s*,\s*/, $need_version;
7510 RQ: for my $rq (@all_requirements) {
7511 if ($rq =~ s|>=\s*||) {
7512 } elsif ($rq =~ s|>\s*||) {
7514 if (CPAN::Version->vgt($available_version,$rq)){
7518 } elsif ($rq =~ s|!=\s*||) {
7520 if (CPAN::Version->vcmp($available_version,$rq)){
7526 } elsif ($rq =~ m|<=?\s*|) {
7528 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n");
7532 if (! CPAN::Version->vgt($rq, $available_version)){
7535 CPAN->debug(sprintf("need_module[%s]available_file[%s]".
7536 "available_version[%s]rq[%s]ok[%d]",
7540 CPAN::Version->readable($rq),
7544 next NEED if $ok == @all_requirements;
7547 if ($need_module eq "perl") {
7548 return ["perl", $need_version];
7550 if ($self->{sponsored_mods}{$need_module}++){
7551 # We have already sponsored it and for some reason it's still
7552 # not available. So we do ... what??
7554 # if we push it again, we have a potential infinite loop
7556 # The following "next" was a very problematic construct.
7557 # It helped a lot but broke some day and must be replaced.
7559 # We must be able to deal with modules that come again and
7560 # again as a prereq and have themselves prereqs and the
7561 # queue becomes long but finally we would find the correct
7562 # order. The RecursiveDependency check should trigger a
7563 # die when it's becoming too weird. Unfortunately removing
7564 # this next breaks many other things.
7566 # The bug that brought this up is described in Todo under
7567 # "5.8.9 cannot install Compress::Zlib"
7569 # next; # this is the next that must go away
7571 # The following "next NEED" are fine and the error message
7572 # explains well what is going on. For example when the DBI
7573 # fails and consequently DBD::SQLite fails and now we are
7574 # processing CPAN::SQLite. Then we must have a "next" for
7575 # DBD::SQLite. How can we get it and how can we identify
7576 # all other cases we must identify?
7578 my $do = $nmo->distribution;
7579 next NEED unless $do; # not on CPAN
7580 NOSAYER: for my $nosayer (
7591 &&(UNIVERSAL::can($do->{$nosayer},"failed") ?
7592 $do->{$nosayer}->failed :
7593 $do->{$nosayer} =~ /^NO/)
7595 if ($nosayer eq "make_test"
7597 $do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId
7601 $CPAN::Frontend->mywarn("Warning: Prerequisite ".
7602 "'$need_module => $need_version' ".
7603 "for '$self->{ID}' failed when ".
7604 "processing '$do->{ID}' with ".
7605 "'$nosayer => $do->{$nosayer}'. Continuing, ".
7606 "but chances to succeed are limited.\n"
7612 my $needed_as = exists $prereq_pm->{requires}{$need_module} ? "r" : "b";
7613 push @need, [$need_module,$needed_as];
7615 my @unfolded = map { "[".join(",",@$_)."]" } @need;
7616 CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG;
7620 #-> sub CPAN::Distribution::read_yaml ;
7623 return $self->{yaml_content} if exists $self->{yaml_content};
7624 my $build_dir = $self->{build_dir};
7625 my $yaml = File::Spec->catfile($build_dir,"META.yml");
7626 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
7627 return unless -f $yaml;
7628 eval { $self->{yaml_content} = CPAN->_yaml_loadfile($yaml)->[0]; };
7630 $CPAN::Frontend->mywarn("Could not read ".
7631 "'$yaml'. Falling back to other ".
7632 "methods to determine prerequisites\n");
7633 return $self->{yaml_content} = undef; # if we die, then we
7634 # cannot read YAML's own
7637 # not "authoritative"
7638 if (not exists $self->{yaml_content}{dynamic_config}
7639 or $self->{yaml_content}{dynamic_config}
7641 $self->{yaml_content} = undef;
7643 $self->debug(sprintf "yaml_content[%s]", $self->{yaml_content} || "UNDEF")
7645 return $self->{yaml_content};
7648 #-> sub CPAN::Distribution::prereq_pm ;
7651 $self->{prereq_pm_detected} ||= 0;
7652 CPAN->debug("ID[$self->{ID}]prereq_pm_detected[$self->{prereq_pm_detected}]") if $CPAN::DEBUG;
7653 return $self->{prereq_pm} if $self->{prereq_pm_detected};
7654 return unless $self->{writemakefile} # no need to have succeeded
7655 # but we must have run it
7656 || $self->{modulebuild};
7657 CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]",
7658 $self->{writemakefile}||"",
7659 $self->{modulebuild}||"",
7662 if (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here
7663 $req = $yaml->{requires} || {};
7664 $breq = $yaml->{build_requires} || {};
7665 undef $req unless ref $req eq "HASH" && %$req;
7667 if ($yaml->{generated_by} &&
7668 $yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
7669 my $eummv = do { local $^W = 0; $1+0; };
7670 if ($eummv < 6.2501) {
7671 # thanks to Slaven for digging that out: MM before
7672 # that could be wrong because it could reflect a
7679 while (my($k,$v) = each %{$req||{}}) {
7682 } elsif ($k =~ /[A-Za-z]/ &&
7684 $CPAN::META->exists("Module",$v)
7686 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
7687 "requires hash: $k => $v; I'll take both ".
7688 "key and value as a module name\n");
7689 $CPAN::Frontend->mysleep(1);
7695 $req = $areq if $do_replace;
7698 unless ($req || $breq) {
7699 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7700 my $makefile = File::Spec->catfile($build_dir,"Makefile");
7704 $fh = FileHandle->new("<$makefile\0")) {
7705 CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG;
7708 last if /MakeMaker post_initialize section/;
7710 \s+PREREQ_PM\s+=>\s+(.+)
7713 # warn "Found prereq expr[$p]";
7715 # Regexp modified by A.Speer to remember actual version of file
7716 # PREREQ_PM hash key wants, then add to
7717 while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ){
7718 # In case a prereq is mentioned twice, complain.
7719 if ( defined $req->{$1} ) {
7720 warn "Warning: PREREQ_PM mentions $1 more than once, ".
7721 "last mention wins";
7723 my($m,$n) = ($1,$2);
7724 if ($n =~ /^q\[(.*?)\]$/) {
7733 unless ($req || $breq) {
7734 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
7735 my $buildfile = File::Spec->catfile($build_dir,"Build");
7736 if (-f $buildfile) {
7737 CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG;
7738 my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs");
7739 if (-f $build_prereqs) {
7740 CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG;
7741 my $content = do { local *FH;
7742 open FH, $build_prereqs
7743 or $CPAN::Frontend->mydie("Could not open ".
7744 "'$build_prereqs': $!");
7748 my $bphash = eval $content;
7751 $req = $bphash->{requires} || +{};
7752 $breq = $bphash->{build_requires} || +{};
7758 && ! -f "Makefile.PL"
7759 && ! exists $req->{"Module::Build"}
7760 && ! $CPAN::META->has_inst("Module::Build")) {
7761 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
7762 "undeclared prerequisite.\n".
7763 " Adding it now as such.\n"
7765 $CPAN::Frontend->mysleep(5);
7766 $req->{"Module::Build"} = 0;
7767 delete $self->{writemakefile};
7769 if ($req || $breq) {
7770 $self->{prereq_pm_detected}++;
7771 return $self->{prereq_pm} = { requires => $req, build_requires => $breq };
7775 #-> sub CPAN::Distribution::test ;
7778 if (my $goto = $self->prefs->{goto}) {
7779 return $self->goto($goto);
7783 delete $self->{force_update};
7786 # warn "XDEBUG: checking for notest: $self->{notest} $self";
7787 if ($self->{notest}) {
7788 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
7792 my $make = $self->{modulebuild} ? "Build" : "make";
7794 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
7796 : ($ENV{PERLLIB} || "");
7798 $CPAN::META->set_perl5lib;
7799 local $ENV{MAKEFLAGS}; # protect us from outer make calls
7801 $CPAN::Frontend->myprint("Running $make test\n");
7803 # if (my @prereq = $self->unsat_prereq){
7804 # if ( $CPAN::DEBUG ) {
7805 # require Data::Dumper;
7806 # CPAN->debug(sprintf "unsat_prereq[%s]", Data::Dumper::Dumper(\@prereq));
7808 # unless ($prereq[0][0] eq "perl") {
7809 # return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
7815 unless (exists $self->{make} or exists $self->{later}) {
7817 "Make had some problems, won't test";
7820 exists $self->{make} and
7822 UNIVERSAL::can($self->{make},"failed") ?
7823 $self->{make}->failed :
7824 $self->{make} =~ /^NO/
7825 ) and push @e, "Can't test without successful make";
7827 $self->{badtestcnt} ||= 0;
7828 if ($self->{badtestcnt} > 0) {
7829 require Data::Dumper;
7830 CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG;
7831 push @e, "Won't repeat unsuccessful test during this command";
7834 exists $self->{later} and length($self->{later}) and
7835 push @e, $self->{later};
7837 if (exists $self->{build_dir}) {
7838 if ($CPAN::META->{is_tested}{$self->{build_dir}}
7840 exists $self->{make_test}
7843 UNIVERSAL::can($self->{make_test},"failed") ?
7844 $self->{make_test}->failed :
7845 $self->{make_test} =~ /^NO/
7848 push @e, "Has already been tested successfully";
7851 push @e, "Has no own directory";
7853 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
7854 unless (chdir $self->{build_dir}) {
7855 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
7857 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
7859 $self->debug("Changed directory to $self->{build_dir}")
7862 if ($^O eq 'MacOS') {
7863 Mac::BuildTools::make_test($self);
7867 if ($self->{modulebuild}) {
7868 my $v = CPAN::Shell->expand("Module","Test::Harness")->inst_version;
7869 if (CPAN::Version->vlt($v,2.62)) {
7870 $CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only
7871 '$v', you need at least '2.62'. Please upgrade your Test::Harness.\n});
7872 $self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old");
7878 if (my $commandline = $self->prefs->{test}{commandline}) {
7879 $system = $commandline;
7881 } elsif ($self->{modulebuild}) {
7882 $system = sprintf "%s test", $self->_build_command();
7884 $system = join " ", $self->_make_command(), "test";
7886 my $make_test_arg = $self->make_x_arg("test");
7887 $system = sprintf("%s%s",
7889 $make_test_arg ? " $make_test_arg" : "",
7893 while (my($k,$v) = each %ENV) {
7894 next unless defined $v;
7898 if (my $env = $self->prefs->{test}{env}) {
7899 for my $e (keys %$env) {
7900 $ENV{$e} = $env->{$e};
7903 my $expect_model = $self->_prefs_with_expect("test");
7904 my $want_expect = 0;
7905 if ( $expect_model && @{$expect_model->{talk}} ) {
7906 my $can_expect = $CPAN::META->has_inst("Expect");
7910 $CPAN::Frontend->mywarn("Expect not installed, falling back to ".
7911 "testing without\n");
7914 my $test_report = CPAN::HandleConfig->prefs_lookup($self,
7918 my $can_report = $CPAN::META->has_inst("CPAN::Reporter");
7922 $CPAN::Frontend->mywarn("CPAN::Reporter not installed, falling back to ".
7923 "testing without\n");
7926 my $ready_to_report = $want_report;
7927 if ($ready_to_report
7929 substr($self->id,-1,1) eq "."
7931 $self->author->id eq "LOCAL"
7934 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7935 "for local directories\n");
7936 $ready_to_report = 0;
7938 if ($ready_to_report
7940 $self->prefs->{patches}
7942 @{$self->prefs->{patches}}
7946 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
7947 "when the source has been patched\n");
7948 $ready_to_report = 0;
7951 if ($ready_to_report) {
7952 $CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
7953 "not supported when distroprefs specify ".
7954 "an interactive test\n");
7956 $tests_ok = $self->_run_via_expect($system,$expect_model) == 0;
7957 } elsif ( $ready_to_report ) {
7958 $tests_ok = CPAN::Reporter::test($self, $system);
7960 $tests_ok = system($system) == 0;
7962 $self->introduce_myself;
7967 # local $CPAN::DEBUG = 16; # Distribution
7968 for my $m (keys %{$self->{sponsored_mods}}) {
7969 my $m_obj = CPAN::Shell->expand("Module",$m) or next;
7970 # XXX we need available_version which reflects
7971 # $ENV{PERL5LIB} so that already tested but not yet
7972 # installed modules are counted.
7973 my $available_version = $m_obj->available_version;
7974 my $available_file = $m_obj->available_file;
7975 if ($available_version &&
7976 !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
7978 CPAN->debug("m[$m] good enough available_version[$available_version]")
7980 } elsif ($available_file
7982 !$self->{prereq_pm}{$m}
7984 $self->{prereq_pm}{$m} == 0
7987 # lex Class::Accessor::Chained::Fast which has no $VERSION
7988 CPAN->debug("m[$m] have available_file[$available_file]")
7996 my $which = join ",", @prereq;
7997 my $but = $cnt == 1 ? "one dependency not OK ($which)" :
7998 "$cnt dependencies missing ($which)";
7999 $CPAN::Frontend->mywarn("Tests succeeded but $but\n");
8000 $self->{make_test} = CPAN::Distrostatus->new("NO $but");
8001 $self->store_persistent_state;
8006 $CPAN::Frontend->myprint(" $system -- OK\n");
8007 $self->{make_test} = CPAN::Distrostatus->new("YES");
8008 $CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME});
8009 # probably impossible to need the next line because badtestcnt
8010 # has a lifespan of one command
8011 delete $self->{badtestcnt};
8013 $self->{make_test} = CPAN::Distrostatus->new("NO");
8014 $self->{badtestcnt}++;
8015 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8017 $self->store_persistent_state;
8020 sub _prefs_with_expect {
8021 my($self,$where) = @_;
8022 return unless my $prefs = $self->prefs;
8023 return unless my $where_prefs = $prefs->{$where};
8024 if ($where_prefs->{expect}) {
8026 mode => "deterministic",
8028 talk => $where_prefs->{expect},
8030 } elsif ($where_prefs->{"eexpect"}) {
8031 return $where_prefs->{"eexpect"};
8036 #-> sub CPAN::Distribution::clean ;
8039 my $make = $self->{modulebuild} ? "Build" : "make";
8040 $CPAN::Frontend->myprint("Running $make clean\n");
8041 unless (exists $self->{archived}) {
8042 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
8043 "/untarred, nothing done\n");
8046 unless (exists $self->{build_dir}) {
8047 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
8052 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
8053 push @e, "make clean already called once";
8054 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8056 chdir $self->{build_dir} or
8057 Carp::confess("Couldn't chdir to $self->{build_dir}: $!");
8058 $self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG;
8060 if ($^O eq 'MacOS') {
8061 Mac::BuildTools::make_clean($self);
8066 if ($self->{modulebuild}) {
8067 unless (-f "Build") {
8068 my $cwd = CPAN::anycwd();
8069 $CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}".
8070 " in cwd[$cwd]. Danger, Will Robinson!");
8071 $CPAN::Frontend->mysleep(5);
8073 $system = sprintf "%s clean", $self->_build_command();
8075 $system = join " ", $self->_make_command(), "clean";
8077 my $system_ok = system($system) == 0;
8078 $self->introduce_myself;
8080 $CPAN::Frontend->myprint(" $system -- OK\n");
8084 # Jost Krieger pointed out that this "force" was wrong because
8085 # it has the effect that the next "install" on this distribution
8086 # will untar everything again. Instead we should bring the
8087 # object's state back to where it is after untarring.
8098 $self->{make_clean} = CPAN::Distrostatus->new("YES");
8101 # Hmmm, what to do if make clean failed?
8103 $self->{make_clean} = CPAN::Distrostatus->new("NO");
8104 $CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n});
8106 # 2006-02-27: seems silly to me to force a make now
8107 # $self->force("make"); # so that this directory won't be used again
8110 $self->store_persistent_state;
8113 #-> sub CPAN::Distribution::goto ;
8115 my($self,$goto) = @_;
8116 $goto = $self->normalize($goto);
8118 # inject into the queue
8120 CPAN::Queue->delete($self->id);
8121 CPAN::Queue->jumpqueue([$goto,$self->{reqtype}]);
8123 # and run where we left off
8125 my($method) = (caller(1))[3];
8126 CPAN->instance("CPAN::Distribution",$goto)->$method;
8127 CPAN::Queue->delete_first($goto);
8130 #-> sub CPAN::Distribution::install ;
8133 if (my $goto = $self->prefs->{goto}) {
8134 return $self->goto($goto);
8137 unless ($self->{badtestcnt}) {
8141 delete $self->{force_update};
8144 my $make = $self->{modulebuild} ? "Build" : "make";
8145 $CPAN::Frontend->myprint("Running $make install\n");
8148 unless (exists $self->{make} or exists $self->{later}) {
8150 "Make had some problems, won't install";
8153 exists $self->{make} and
8155 UNIVERSAL::can($self->{make},"failed") ?
8156 $self->{make}->failed :
8157 $self->{make} =~ /^NO/
8159 push @e, "Make had returned bad status, install seems impossible";
8161 if (exists $self->{build_dir}) {
8163 push @e, "Has no own directory";
8166 if (exists $self->{make_test} and
8168 UNIVERSAL::can($self->{make_test},"failed") ?
8169 $self->{make_test}->failed :
8170 $self->{make_test} =~ /^NO/
8172 if ($self->{force_update}) {
8173 $self->{make_test}->text("FAILED but failure ignored because ".
8174 "'force' in effect");
8176 push @e, "make test had returned bad status, ".
8177 "won't install without force"
8180 if (exists $self->{install}) {
8181 if (UNIVERSAL::can($self->{install},"text") ?
8182 $self->{install}->text eq "YES" :
8183 $self->{install} =~ /^YES/
8185 push @e, "Already done";
8187 # comment in Todo on 2006-02-11; maybe retry?
8188 push @e, "Already tried without success";
8192 exists $self->{later} and length($self->{later}) and
8193 push @e, $self->{later};
8195 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
8196 unless (chdir $self->{build_dir}) {
8197 push @e, "Couldn't chdir to '$self->{build_dir}': $!";
8199 $CPAN::Frontend->mywarn(join "", map {" $_\n"} @e) and return if @e;
8201 $self->debug("Changed directory to $self->{build_dir}")
8204 if ($^O eq 'MacOS') {
8205 Mac::BuildTools::make_install($self);
8210 if (my $commandline = $self->prefs->{install}{commandline}) {
8211 $system = $commandline;
8213 } elsif ($self->{modulebuild}) {
8214 my($mbuild_install_build_command) =
8215 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
8216 $CPAN::Config->{mbuild_install_build_command} ?
8217 $CPAN::Config->{mbuild_install_build_command} :
8218 $self->_build_command();
8219 $system = sprintf("%s install %s",
8220 $mbuild_install_build_command,
8221 $CPAN::Config->{mbuild_install_arg},
8224 my($make_install_make_command) =
8225 CPAN::HandleConfig->prefs_lookup($self,
8226 q{make_install_make_command})
8227 || $self->_make_command();
8228 $system = sprintf("%s install %s",
8229 $make_install_make_command,
8230 $CPAN::Config->{make_install_arg},
8234 my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 ";
8235 my $brip = CPAN::HandleConfig->prefs_lookup($self,
8236 q{build_requires_install_policy});
8239 my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
8240 my $want_install = "yes";
8241 if ($reqtype eq "b") {
8242 if ($brip eq "no") {
8243 $want_install = "no";
8244 } elsif ($brip =~ m|^ask/(.+)|) {
8246 $default = "yes" unless $default =~ /^(y|n)/i;
8248 CPAN::Shell::colorable_makemaker_prompt
8249 ("$id is just needed temporarily during building or testing. ".
8250 "Do you want to install it permanently? (Y/n)",
8254 unless ($want_install =~ /^y/i) {
8255 my $is_only = "is only 'build_requires'";
8256 $CPAN::Frontend->mywarn("Not installing because $is_only\n");
8257 $self->{install} = CPAN::Distrostatus->new("NO -- $is_only");
8258 delete $self->{force_update};
8261 my($pipe) = FileHandle->new("$system $stderr |");
8264 print $_; # intentionally NOT use Frontend->myprint because it
8265 # looks irritating when we markup in color what we
8266 # just pass through from an external program
8270 my $close_ok = $? == 0;
8271 $self->introduce_myself;
8273 $CPAN::Frontend->myprint(" $system -- OK\n");
8274 $CPAN::META->is_installed($self->{build_dir});
8275 $self->{install} = CPAN::Distrostatus->new("YES");
8277 $self->{install} = CPAN::Distrostatus->new("NO");
8278 $CPAN::Frontend->mywarn(" $system -- NOT OK\n");
8280 CPAN::HandleConfig->prefs_lookup($self,
8281 q{make_install_make_command});
8283 $makeout =~ /permission/s
8287 || $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
8291 $CPAN::Frontend->myprint(
8293 qq{ You may have to su }.
8294 qq{to root to install the package\n}.
8295 qq{ (Or you may want to run something like\n}.
8296 qq{ o conf make_install_make_command 'sudo make'\n}.
8297 qq{ to raise your permissions.}
8301 delete $self->{force_update};
8303 $self->store_persistent_state;
8306 sub introduce_myself {
8308 $CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id));
8311 #-> sub CPAN::Distribution::dir ;
8316 #-> sub CPAN::Distribution::perldoc ;
8320 my($dist) = $self->id;
8321 my $package = $self->called_for;
8323 $self->_display_url( $CPAN::Defaultdocs . $package );
8326 #-> sub CPAN::Distribution::_check_binary ;
8328 my ($dist,$shell,$binary) = @_;
8331 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
8334 if ($CPAN::META->has_inst("File::Which")) {
8335 return File::Which::which($binary);
8338 $pid = open README, "which $binary|"
8339 or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n});
8345 or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n")
8349 $CPAN::Frontend->myprint(qq{ + $out \n})
8350 if $CPAN::DEBUG && $out;
8355 #-> sub CPAN::Distribution::_display_url ;
8357 my($self,$url) = @_;
8358 my($res,$saved_file,$pid,$out);
8360 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
8363 # should we define it in the config instead?
8364 my $html_converter = "html2text";
8366 my $web_browser = $CPAN::Config->{'lynx'} || undef;
8367 my $web_browser_out = $web_browser
8368 ? CPAN::Distribution->_check_binary($self,$web_browser)
8371 if ($web_browser_out) {
8372 # web browser found, run the action
8373 my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'});
8374 $CPAN::Frontend->myprint(qq{system[$browser $url]})
8376 $CPAN::Frontend->myprint(qq{
8379 with browser $browser
8381 $CPAN::Frontend->mysleep(1);
8382 system("$browser $url");
8383 if ($saved_file) { 1 while unlink($saved_file) }
8385 # web browser not found, let's try text only
8386 my $html_converter_out =
8387 CPAN::Distribution->_check_binary($self,$html_converter);
8388 $html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out);
8390 if ($html_converter_out ) {
8391 # html2text found, run it
8392 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
8393 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
8394 unless defined($saved_file);
8397 $pid = open README, "$html_converter $saved_file |"
8398 or $CPAN::Frontend->mydie(qq{
8399 Could not fork '$html_converter $saved_file': $!});
8401 if ($CPAN::META->has_inst("File::Temp")) {
8402 $fh = File::Temp->new(
8403 template => 'cpan_htmlconvert_XXXX',
8407 $filename = $fh->filename;
8409 $filename = "cpan_htmlconvert_$$.txt";
8410 $fh = FileHandle->new();
8411 open $fh, ">$filename" or die;
8417 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
8418 my $tmpin = $fh->filename;
8419 $CPAN::Frontend->myprint(sprintf(qq{
8421 saved output to %s\n},
8429 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
8430 my $fh_pager = FileHandle->new;
8431 local($SIG{PIPE}) = "IGNORE";
8432 my $pager = $CPAN::Config->{'pager'} || "cat";
8433 $fh_pager->open("|$pager")
8434 or $CPAN::Frontend->mydie(qq{
8435 Could not open pager '$pager': $!});
8436 $CPAN::Frontend->myprint(qq{
8441 $CPAN::Frontend->mysleep(1);
8442 $fh_pager->print(<FH>);
8445 # coldn't find the web browser or html converter
8446 $CPAN::Frontend->myprint(qq{
8447 You need to install lynx or $html_converter to use this feature.});
8452 #-> sub CPAN::Distribution::_getsave_url ;
8454 my($dist, $shell, $url) = @_;
8456 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
8460 if ($CPAN::META->has_inst("File::Temp")) {
8461 $fh = File::Temp->new(
8462 template => "cpan_getsave_url_XXXX",
8466 $filename = $fh->filename;
8468 $fh = FileHandle->new;
8469 $filename = "cpan_getsave_url_$$.html";
8471 my $tmpin = $filename;
8472 if ($CPAN::META->has_usable('LWP')) {
8473 $CPAN::Frontend->myprint("Fetching with LWP:
8477 CPAN::LWP::UserAgent->config;
8478 eval { $Ua = CPAN::LWP::UserAgent->new; };
8480 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
8484 $Ua->proxy('http', $var)
8485 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
8487 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
8490 my $req = HTTP::Request->new(GET => $url);
8491 $req->header('Accept' => 'text/html');
8492 my $res = $Ua->request($req);
8493 if ($res->is_success) {
8494 $CPAN::Frontend->myprint(" + request successful.\n")
8496 print $fh $res->content;
8498 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
8502 $CPAN::Frontend->myprint(sprintf(
8503 "LWP failed with code[%s], message[%s]\n",
8510 $CPAN::Frontend->mywarn(" LWP not available\n");
8515 # sub CPAN::Distribution::_build_command
8516 sub _build_command {
8518 if ($^O eq "MSWin32") { # special code needed at least up to
8519 # Module::Build 0.2611 and 0.2706; a fix
8520 # in M:B has been promised 2006-01-30
8521 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
8522 return "$perl ./Build";
8527 package CPAN::Bundle;
8532 $CPAN::Frontend->myprint($self->as_string);
8537 delete $self->{later};
8538 for my $c ( $self->contains ) {
8539 my $obj = CPAN::Shell->expandany($c) or next;
8544 # mark as dirty/clean
8545 #-> sub CPAN::Bundle::color_cmd_tmps ;
8546 sub color_cmd_tmps {
8548 my($depth) = shift || 0;
8549 my($color) = shift || 0;
8550 my($ancestors) = shift || [];
8551 # a module needs to recurse to its cpan_file, a distribution needs
8552 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
8554 return if exists $self->{incommandcolor}
8556 && $self->{incommandcolor}==$color;
8557 if ($depth>=$CPAN::MAX_RECURSION){
8558 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8560 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8562 for my $c ( $self->contains ) {
8563 my $obj = CPAN::Shell->expandany($c) or next;
8564 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
8565 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8567 # never reached code?
8569 #delete $self->{badtestcnt};
8571 $self->{incommandcolor} = $color;
8574 #-> sub CPAN::Bundle::as_string ;
8578 # following line must be "=", not "||=" because we have a moving target
8579 $self->{INST_VERSION} = $self->inst_version;
8580 return $self->SUPER::as_string;
8583 #-> sub CPAN::Bundle::contains ;
8586 my($inst_file) = $self->inst_file || "";
8587 my($id) = $self->id;
8588 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
8589 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
8592 unless ($inst_file) {
8593 # Try to get at it in the cpan directory
8594 $self->debug("no inst_file") if $CPAN::DEBUG;
8596 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
8597 $cpan_file = $self->cpan_file;
8598 if ($cpan_file eq "N/A") {
8599 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
8600 Maybe stale symlink? Maybe removed during session? Giving up.\n");
8602 my $dist = $CPAN::META->instance('CPAN::Distribution',
8604 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
8606 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
8607 my($todir) = $CPAN::Config->{'cpan_home'};
8608 my(@me,$from,$to,$me);
8609 @me = split /::/, $self->id;
8611 $me = File::Spec->catfile(@me);
8612 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
8613 $to = File::Spec->catfile($todir,$me);
8614 File::Path::mkpath(File::Basename::dirname($to));
8615 File::Copy::copy($from, $to)
8616 or Carp::confess("Couldn't copy $from to $to: $!");
8620 my $fh = FileHandle->new;
8622 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
8624 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
8626 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
8627 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
8628 next unless $in_cont;
8633 push @result, (split " ", $_, 2)[0];
8636 delete $self->{STATUS};
8637 $self->{CONTAINS} = \@result;
8638 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
8640 $CPAN::Frontend->mywarn(qq{
8641 The bundle file "$inst_file" may be a broken
8642 bundlefile. It seems not to contain any bundle definition.
8643 Please check the file and if it is bogus, please delete it.
8644 Sorry for the inconvenience.
8650 #-> sub CPAN::Bundle::find_bundle_file
8651 # $where is in local format, $what is in unix format
8652 sub find_bundle_file {
8653 my($self,$where,$what) = @_;
8654 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
8655 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
8656 ### my $bu = File::Spec->catfile($where,$what);
8657 ### return $bu if -f $bu;
8658 my $manifest = File::Spec->catfile($where,"MANIFEST");
8659 unless (-f $manifest) {
8660 require ExtUtils::Manifest;
8661 my $cwd = CPAN::anycwd();
8662 $self->safe_chdir($where);
8663 ExtUtils::Manifest::mkmanifest();
8664 $self->safe_chdir($cwd);
8666 my $fh = FileHandle->new($manifest)
8667 or Carp::croak("Couldn't open $manifest: $!");
8669 my $bundle_filename = $what;
8670 $bundle_filename =~ s|Bundle.*/||;
8671 my $bundle_unixpath;
8674 my($file) = /(\S+)/;
8675 if ($file =~ m|\Q$what\E$|) {
8676 $bundle_unixpath = $file;
8677 # return File::Spec->catfile($where,$bundle_unixpath); # bad
8680 # retry if she managed to have no Bundle directory
8681 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
8683 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
8684 if $bundle_unixpath;
8685 Carp::croak("Couldn't find a Bundle file in $where");
8688 # needs to work quite differently from Module::inst_file because of
8689 # cpan_home/Bundle/ directory and the possibility that we have
8690 # shadowing effect. As it makes no sense to take the first in @INC for
8691 # Bundles, we parse them all for $VERSION and take the newest.
8693 #-> sub CPAN::Bundle::inst_file ;
8698 @me = split /::/, $self->id;
8701 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
8702 my $bfile = File::Spec->catfile($incdir, @me);
8703 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
8704 next unless -f $bfile;
8705 my $foundv = MM->parse_version($bfile);
8706 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
8707 $self->{INST_FILE} = $bfile;
8708 $self->{INST_VERSION} = $bestv = $foundv;
8714 #-> sub CPAN::Bundle::inst_version ;
8717 $self->inst_file; # finds INST_VERSION as side effect
8718 $self->{INST_VERSION};
8721 #-> sub CPAN::Bundle::rematein ;
8723 my($self,$meth) = @_;
8724 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
8725 my($id) = $self->id;
8726 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
8727 unless $self->inst_file || $self->cpan_file;
8729 for $s ($self->contains) {
8730 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
8731 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
8732 if ($type eq 'CPAN::Distribution') {
8733 $CPAN::Frontend->mywarn(qq{
8734 The Bundle }.$self->id.qq{ contains
8735 explicitly a file '$s'.
8736 Going to $meth that.
8738 $CPAN::Frontend->mysleep(5);
8740 # possibly noisy action:
8741 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
8742 my $obj = $CPAN::META->instance($type,$s);
8743 $obj->{reqtype} = $self->{reqtype};
8748 # If a bundle contains another that contains an xs_file we have here,
8749 # we just don't bother I suppose
8750 #-> sub CPAN::Bundle::xs_file
8755 #-> sub CPAN::Bundle::force ;
8756 sub fforce { shift->rematein('fforce',@_); }
8757 #-> sub CPAN::Bundle::force ;
8758 sub force { shift->rematein('force',@_); }
8759 #-> sub CPAN::Bundle::notest ;
8760 sub notest { shift->rematein('notest',@_); }
8761 #-> sub CPAN::Bundle::get ;
8762 sub get { shift->rematein('get',@_); }
8763 #-> sub CPAN::Bundle::make ;
8764 sub make { shift->rematein('make',@_); }
8765 #-> sub CPAN::Bundle::test ;
8768 # $self->{badtestcnt} ||= 0;
8769 $self->rematein('test',@_);
8771 #-> sub CPAN::Bundle::install ;
8774 $self->rematein('install',@_);
8776 #-> sub CPAN::Bundle::clean ;
8777 sub clean { shift->rematein('clean',@_); }
8779 #-> sub CPAN::Bundle::uptodate ;
8782 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
8784 foreach $c ($self->contains) {
8785 my $obj = CPAN::Shell->expandany($c);
8786 return 0 unless $obj->uptodate;
8791 #-> sub CPAN::Bundle::readme ;
8794 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
8795 No File found for bundle } . $self->id . qq{\n}), return;
8796 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
8797 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
8800 package CPAN::Module;
8804 # sub CPAN::Module::userid
8809 return $ro->{userid} || $ro->{CPAN_USERID};
8811 # sub CPAN::Module::description
8814 my $ro = $self->ro or return "";
8820 CPAN::Shell->expand("Distribution",$self->cpan_file);
8823 # sub CPAN::Module::undelay
8826 delete $self->{later};
8827 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8832 # mark as dirty/clean
8833 #-> sub CPAN::Module::color_cmd_tmps ;
8834 sub color_cmd_tmps {
8836 my($depth) = shift || 0;
8837 my($color) = shift || 0;
8838 my($ancestors) = shift || [];
8839 # a module needs to recurse to its cpan_file
8841 return if exists $self->{incommandcolor}
8843 && $self->{incommandcolor}==$color;
8844 return if $color==0 && !$self->{incommandcolor};
8846 if ( $self->uptodate ) {
8847 $self->{incommandcolor} = $color;
8849 } elsif (my $have_version = $self->available_version) {
8850 # maybe what we have is good enough
8852 my $who_asked_for_me = $ancestors->[-1];
8853 my $obj = CPAN::Shell->expandany($who_asked_for_me);
8855 } elsif ($obj->isa("CPAN::Bundle")) {
8856 # bundles cannot specify a minimum version
8858 } elsif ($obj->isa("CPAN::Distribution")) {
8859 if (my $prereq_pm = $obj->prereq_pm) {
8860 for my $k (keys %$prereq_pm) {
8861 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
8862 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
8863 $self->{incommandcolor} = $color;
8873 $self->{incommandcolor} = $color; # set me before recursion,
8874 # so we can break it
8876 if ($depth>=$CPAN::MAX_RECURSION){
8877 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
8879 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
8881 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
8882 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
8886 # delete $self->{badtestcnt};
8888 $self->{incommandcolor} = $color;
8891 #-> sub CPAN::Module::as_glimpse ;
8895 my $class = ref($self);
8896 $class =~ s/^CPAN:://;
8900 $CPAN::Shell::COLOR_REGISTERED
8902 $CPAN::META->has_inst("Term::ANSIColor")
8906 $color_on = Term::ANSIColor::color("green");
8907 $color_off = Term::ANSIColor::color("reset");
8909 my $uptodateness = " ";
8910 if ($class eq "Bundle") {
8911 } elsif ($self->uptodate) {
8912 $uptodateness = "=";
8913 } elsif ($self->inst_version) {
8914 $uptodateness = "<";
8916 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
8922 ($self->distribution ?
8923 $self->distribution->pretty_id :
8930 #-> sub CPAN::Module::dslip_status
8934 # development status
8935 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
8936 pre-alpha alpha beta released
8939 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
8940 developer comp.lang.perl.*
8943 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
8945 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
8947 object-oriented pragma
8950 @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl
8954 distribution_allowed
8955 restricted_distribution
8957 for my $x (qw(d s l i p)) {
8958 $stat->{$x}{' '} = 'unknown';
8959 $stat->{$x}{'?'} = 'unknown';
8962 return +{} unless $ro && $ro->{statd};
8969 DV => $stat->{D}{$ro->{statd}},
8970 SV => $stat->{S}{$ro->{stats}},
8971 LV => $stat->{L}{$ro->{statl}},
8972 IV => $stat->{I}{$ro->{stati}},
8973 PV => $stat->{P}{$ro->{statp}},
8977 #-> sub CPAN::Module::as_string ;
8981 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
8982 my $class = ref($self);
8983 $class =~ s/^CPAN:://;
8985 push @m, $class, " id = $self->{ID}\n";
8986 my $sprintf = " %-12s %s\n";
8987 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
8988 if $self->description;
8989 my $sprintf2 = " %-12s %s (%s)\n";
8991 $userid = $self->userid;
8994 if ($author = CPAN::Shell->expand('Author',$userid)) {
8997 if ($m = $author->email) {
9004 $author->fullname . $email
9008 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
9009 if $self->cpan_version;
9010 if (my $cpan_file = $self->cpan_file){
9011 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
9012 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
9013 my $upload_date = $dist->upload_date;
9015 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
9019 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
9020 my $dslip = $self->dslip_status;
9024 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
9026 my $local_file = $self->inst_file;
9027 unless ($self->{MANPAGE}) {
9030 $manpage = $self->manpage_headline($local_file);
9032 # If we have already untarred it, we should look there
9033 my $dist = $CPAN::META->instance('CPAN::Distribution',
9035 # warn "dist[$dist]";
9036 # mff=manifest file; mfh=manifest handle
9041 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
9043 $mfh = FileHandle->new($mff)
9045 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
9046 my $lfre = $self->id; # local file RE
9049 my($lfl); # local file file
9051 my(@mflines) = <$mfh>;
9056 while (length($lfre)>5 and !$lfl) {
9057 ($lfl) = grep /$lfre/, @mflines;
9058 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
9061 $lfl =~ s/\s.*//; # remove comments
9062 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
9063 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
9064 # warn "lfl_abs[$lfl_abs]";
9066 $manpage = $self->manpage_headline($lfl_abs);
9070 $self->{MANPAGE} = $manpage if $manpage;
9073 for $item (qw/MANPAGE/) {
9074 push @m, sprintf($sprintf, $item, $self->{$item})
9075 if exists $self->{$item};
9077 for $item (qw/CONTAINS/) {
9078 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
9079 if exists $self->{$item} && @{$self->{$item}};
9081 push @m, sprintf($sprintf, 'INST_FILE',
9082 $local_file || "(not installed)");
9083 push @m, sprintf($sprintf, 'INST_VERSION',
9084 $self->inst_version) if $local_file;
9088 sub manpage_headline {
9089 my($self,$local_file) = @_;
9090 my(@local_file) = $local_file;
9091 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
9092 push @local_file, $local_file;
9094 for $locf (@local_file) {
9095 next unless -f $locf;
9096 my $fh = FileHandle->new($locf)
9097 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
9101 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
9102 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
9119 #-> sub CPAN::Module::cpan_file ;
9120 # Note: also inherited by CPAN::Bundle
9123 # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
9124 unless ($self->ro) {
9125 CPAN::Index->reload;
9128 if ($ro && defined $ro->{CPAN_FILE}){
9129 return $ro->{CPAN_FILE};
9131 my $userid = $self->userid;
9133 if ($CPAN::META->exists("CPAN::Author",$userid)) {
9134 my $author = $CPAN::META->instance("CPAN::Author",
9136 my $fullname = $author->fullname;
9137 my $email = $author->email;
9138 unless (defined $fullname && defined $email) {
9139 return sprintf("Contact Author %s",
9143 return "Contact Author $fullname <$email>";
9145 return "Contact Author $userid (Email address not available)";
9153 #-> sub CPAN::Module::cpan_version ;
9159 # Can happen with modules that are not on CPAN
9162 $ro->{CPAN_VERSION} = 'undef'
9163 unless defined $ro->{CPAN_VERSION};
9164 $ro->{CPAN_VERSION};
9167 #-> sub CPAN::Module::force ;
9170 $self->{force_update} = 1;
9173 #-> sub CPAN::Module::fforce ;
9176 $self->{force_update} = 2;
9181 # warn "XDEBUG: set notest for Module";
9182 $self->{'notest'}++;
9185 #-> sub CPAN::Module::rematein ;
9187 my($self,$meth) = @_;
9188 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
9191 my $cpan_file = $self->cpan_file;
9192 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
9193 $CPAN::Frontend->mywarn(sprintf qq{
9194 The module %s isn\'t available on CPAN.
9196 Either the module has not yet been uploaded to CPAN, or it is
9197 temporary unavailable. Please contact the author to find out
9198 more about the status. Try 'i %s'.
9205 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
9206 $pack->called_for($self->id);
9207 if (exists $self->{force_update}){
9208 if ($self->{force_update} == 2) {
9209 $pack->fforce($meth);
9211 $pack->force($meth);
9214 $pack->notest($meth) if exists $self->{'notest'};
9216 $pack->{reqtype} ||= "";
9217 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
9218 "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
9219 if ($pack->{reqtype}) {
9220 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
9221 $pack->{reqtype} = $self->{reqtype};
9223 exists $pack->{install}
9226 UNIVERSAL::can($pack->{install},"failed") ?
9227 $pack->{install}->failed :
9228 $pack->{install} =~ /^NO/
9231 delete $pack->{install};
9232 $CPAN::Frontend->mywarn
9233 ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
9237 $pack->{reqtype} = $self->{reqtype};
9244 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
9245 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
9246 delete $self->{force_update};
9247 delete $self->{'notest'};
9253 #-> sub CPAN::Module::perldoc ;
9254 sub perldoc { shift->rematein('perldoc') }
9255 #-> sub CPAN::Module::readme ;
9256 sub readme { shift->rematein('readme') }
9257 #-> sub CPAN::Module::look ;
9258 sub look { shift->rematein('look') }
9259 #-> sub CPAN::Module::cvs_import ;
9260 sub cvs_import { shift->rematein('cvs_import') }
9261 #-> sub CPAN::Module::get ;
9262 sub get { shift->rematein('get',@_) }
9263 #-> sub CPAN::Module::make ;
9264 sub make { shift->rematein('make') }
9265 #-> sub CPAN::Module::test ;
9268 # $self->{badtestcnt} ||= 0;
9269 $self->rematein('test',@_);
9271 #-> sub CPAN::Module::uptodate ;
9274 local($_); # protect against a bug in MakeMaker 6.17
9275 my($latest) = $self->cpan_version;
9277 my($inst_file) = $self->inst_file;
9279 if (defined $inst_file) {
9280 $have = $self->inst_version;
9285 ! CPAN::Version->vgt($latest, $have)
9287 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
9288 "latest[$latest] have[$have]") if $CPAN::DEBUG;
9293 #-> sub CPAN::Module::install ;
9299 not exists $self->{force_update}
9301 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
9303 $self->inst_version,
9309 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
9310 $CPAN::Frontend->mywarn(qq{
9311 \n\n\n ***WARNING***
9312 The module $self->{ID} has no active maintainer.\n\n\n
9314 $CPAN::Frontend->mysleep(5);
9316 $self->rematein('install') if $doit;
9318 #-> sub CPAN::Module::clean ;
9319 sub clean { shift->rematein('clean') }
9321 #-> sub CPAN::Module::inst_file ;
9324 $self->_file_in_path([@INC]);
9327 #-> sub CPAN::Module::available_file ;
9328 sub available_file {
9330 my $sep = $Config::Config{path_sep};
9331 my $perllib = $ENV{PERL5LIB};
9332 $perllib = $ENV{PERLLIB} unless defined $perllib;
9333 my @perllib = split(/$sep/,$perllib) if defined $perllib;
9334 $self->_file_in_path([@perllib,@INC]);
9337 #-> sub CPAN::Module::file_in_path ;
9339 my($self,$path) = @_;
9341 @packpath = split /::/, $self->{ID};
9342 $packpath[-1] .= ".pm";
9343 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
9344 unshift @packpath, "Term", "ReadLine"; # historical reasons
9346 foreach $dir (@$path) {
9347 my $pmfile = File::Spec->catfile($dir,@packpath);
9355 #-> sub CPAN::Module::xs_file ;
9359 @packpath = split /::/, $self->{ID};
9360 push @packpath, $packpath[-1];
9361 $packpath[-1] .= "." . $Config::Config{'dlext'};
9362 foreach $dir (@INC) {
9363 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
9371 #-> sub CPAN::Module::inst_version ;
9374 my $parsefile = $self->inst_file or return;
9375 my $have = $self->parse_version($parsefile);
9379 #-> sub CPAN::Module::inst_version ;
9380 sub available_version {
9382 my $parsefile = $self->available_file or return;
9383 my $have = $self->parse_version($parsefile);
9387 #-> sub CPAN::Module::parse_version ;
9389 my($self,$parsefile) = @_;
9390 my $have = MM->parse_version($parsefile);
9391 $have = "undef" unless defined $have && length $have;
9392 $have =~ s/^ //; # since the %vd hack these two lines here are needed
9393 $have =~ s/ $//; # trailing whitespace happens all the time
9395 $have = CPAN::Version->readable($have);
9397 $have =~ s/\s*//g; # stringify to float around floating point issues
9398 $have; # no stringify needed, \s* above matches always
9411 CPAN - query, download and build perl modules from CPAN sites
9417 perl -MCPAN -e shell
9427 cpan> install Acme::Meta # in the shell
9429 CPAN::Shell->install("Acme::Meta"); # in perl
9433 cpan> install NWCLARK/Acme-Meta-0.02.tar.gz # in the shell
9436 install("NWCLARK/Acme-Meta-0.02.tar.gz"); # in perl
9440 $mo = CPAN::Shell->expandany($mod);
9441 $mo = CPAN::Shell->expand("Module",$mod); # same thing
9443 # distribution objects:
9445 $do = CPAN::Shell->expand("Module",$mod)->distribution;
9446 $do = CPAN::Shell->expandany($distro); # same thing
9447 $do = CPAN::Shell->expand("Distribution",
9448 $distro); # same thing
9452 The CPAN module automates or at least simplifies the make and install
9453 of perl modules and extensions. It includes some primitive searching
9454 capabilities and knows how to use Net::FTP or LWP or some external
9455 download clients to fetch the distributions from the net.
9457 These are fetched from one or more of the mirrored CPAN (Comprehensive
9458 Perl Archive Network) sites and unpacked in a dedicated directory.
9460 The CPAN module also supports the concept of named and versioned
9461 I<bundles> of modules. Bundles simplify the handling of sets of
9462 related modules. See Bundles below.
9464 The package contains a session manager and a cache manager. The
9465 session manager keeps track of what has been fetched, built and
9466 installed in the current session. The cache manager keeps track of the
9467 disk space occupied by the make processes and deletes excess space
9468 according to a simple FIFO mechanism.
9470 All methods provided are accessible in a programmer style and in an
9471 interactive shell style.
9473 =head2 CPAN::shell([$prompt, $command]) Starting Interactive Mode
9475 The interactive mode is entered by running
9477 perl -MCPAN -e shell
9483 which puts you into a readline interface. If C<Term::ReadKey> and
9484 either C<Term::ReadLine::Perl> or C<Term::ReadLine::Gnu> are installed
9485 it supports both history and command completion.
9487 Once you are on the command line, type C<h> to get a one page help
9488 screen and the rest should be self-explanatory.
9490 The function call C<shell> takes two optional arguments, one is the
9491 prompt, the second is the default initial command line (the latter
9492 only works if a real ReadLine interface module is installed).
9494 The most common uses of the interactive modes are
9498 =item Searching for authors, bundles, distribution files and modules
9500 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
9501 for each of the four categories and another, C<i> for any of the
9502 mentioned four. Each of the four entities is implemented as a class
9503 with slightly differing methods for displaying an object.
9505 Arguments you pass to these commands are either strings exactly matching
9506 the identification string of an object or regular expressions that are
9507 then matched case-insensitively against various attributes of the
9508 objects. The parser recognizes a regular expression only if you
9509 enclose it between two slashes.
9511 The principle is that the number of found objects influences how an
9512 item is displayed. If the search finds one item, the result is
9513 displayed with the rather verbose method C<as_string>, but if we find
9514 more than one, we display each object with the terse method
9517 =item C<get>, C<make>, C<test>, C<install>, C<clean> modules or distributions
9519 These commands take any number of arguments and investigate what is
9520 necessary to perform the action. If the argument is a distribution
9521 file name (recognized by embedded slashes), it is processed. If it is
9522 a module, CPAN determines the distribution file in which this module
9523 is included and processes that, following any dependencies named in
9524 the module's META.yml or Makefile.PL (this behavior is controlled by
9525 the configuration parameter C<prerequisites_policy>.)
9527 C<get> downloads a distribution file and untars or unzips it, C<make>
9528 builds it, C<test> runs the test suite, and C<install> installs it.
9530 Any C<make> or C<test> are run unconditionally. An
9532 install <distribution_file>
9534 also is run unconditionally. But for
9538 CPAN checks if an install is actually needed for it and prints
9539 I<module up to date> in the case that the distribution file containing
9540 the module doesn't need to be updated.
9542 CPAN also keeps track of what it has done within the current session
9543 and doesn't try to build a package a second time regardless if it
9544 succeeded or not. It does not repeat a test run if the test
9545 has been run successfully before. Same for install runs.
9547 The C<force> pragma may precede another command (currently: C<get>,
9548 C<make>, C<test>, or C<install>) and executes the command from scratch
9549 and tries to continue in case of some errors. See the section below on
9550 the C<force> and the C<fforce> pragma.
9552 The C<notest> pragma may be used to skip the test part in the build
9557 cpan> notest install Tk
9559 A C<clean> command results in a
9563 being executed within the distribution file's working directory.
9565 =item C<readme>, C<perldoc>, C<look> module or distribution
9567 C<readme> displays the README file of the associated distribution.
9568 C<Look> gets and untars (if not yet done) the distribution file,
9569 changes to the appropriate directory and opens a subshell process in
9570 that directory. C<perldoc> displays the pod documentation of the
9571 module in html or plain text format.
9575 =item C<ls> globbing_expression
9577 The first form lists all distribution files in and below an author's
9578 CPAN directory as they are stored in the CHECKUMS files distributed on
9579 CPAN. The listing goes recursive into all subdirectories.
9581 The second form allows to limit or expand the output with shell
9582 globbing as in the following examples:
9588 The last example is very slow and outputs extra progress indicators
9589 that break the alignment of the result.
9591 Note that globbing only lists directories explicitly asked for, for
9592 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
9593 regarded as a bug and may be changed in future versions.
9597 The C<failed> command reports all distributions that failed on one of
9598 C<make>, C<test> or C<install> for some reason in the currently
9599 running shell session.
9601 =item Persistence between sessions
9603 If the C<YAML> or the c<YAML::Syck> module is installed a record of
9604 the internal state of all modules is written to disk after each step.
9605 The files contain a signature of the currently running perl version
9608 If the configurations variable C<build_dir_reuse> is set to a true
9609 value, then CPAN.pm reads the collected YAML files. If the stored
9610 signature matches the currently running perl the stored state is
9611 loaded into memory such that effectively persistence between sessions
9614 =item The C<force> and the C<fforce> pragma
9616 To speed things up in complex installation scenarios, CPAN.pm keeps
9617 track of what it has already done and refuses to do some things a
9618 second time. A C<get>, a C<make>, and an C<install> are not repeated.
9619 A C<test> is only repeated if the previous test was unsuccessful. The
9620 diagnostic message when CPAN.pm refuses to do something a second time
9621 is one of I<Has already been >C<unwrapped|made|tested successfully> or
9622 something similar. Another situation where CPAN refuses to act is an
9623 C<install> if the according C<test> was not successful.
9625 In all these cases, the user can override the goatish behaviour by
9626 prepending the command with the word force, for example:
9629 cpan> force make AUTHOR/Bar-3.14.tar.gz
9630 cpan> force test Baz
9631 cpan> force install Acme::Meta
9633 Each I<forced> command is executed with the according part of its
9636 The C<fforce> pragma is a variant that emulates a C<force get> which
9637 erases the entire memory followed by the action specified, effectively
9638 restarting the whole get/make/test/install procedure from scratch.
9642 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>.
9643 Batch jobs can run without a lockfile and do not disturb each other.
9645 The shell offers to run in I<degraded mode> when another process is
9646 holding the lockfile. This is an experimental feature that is not yet
9647 tested very well. This second shell then does not write the history
9648 file, does not use the metadata file and has a different prompt.
9652 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
9653 in the cpan-shell it is intended that you can press C<^C> anytime and
9654 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
9655 to clean up and leave the shell loop. You can emulate the effect of a
9656 SIGTERM by sending two consecutive SIGINTs, which usually means by
9657 pressing C<^C> twice.
9659 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
9660 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
9661 Build.PL> subprocess.
9667 The commands that are available in the shell interface are methods in
9668 the package CPAN::Shell. If you enter the shell command, all your
9669 input is split by the Text::ParseWords::shellwords() routine which
9670 acts like most shells do. The first word is being interpreted as the
9671 method to be called and the rest of the words are treated as arguments
9672 to this method. Continuation lines are supported if a line ends with a
9677 C<autobundle> writes a bundle file into the
9678 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
9679 a list of all modules that are both available from CPAN and currently
9680 installed within @INC. The name of the bundle file is based on the
9681 current date and a counter.
9685 Note: this feature is still in alpha state and may change in future
9688 This commands provides a statistical overview over recent download
9689 activities. The data for this is collected in the YAML file
9690 C<FTPstats.yml> in your C<cpan_home> directory. If no YAML module is
9691 configured or YAML not installed, then no stats are provided.
9695 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
9696 directory so that you can save your own preferences instead of the
9701 recompile() is a very special command in that it takes no argument and
9702 runs the make/test/install cycle with brute force over all installed
9703 dynamically loadable extensions (aka XS modules) with 'force' in
9704 effect. The primary purpose of this command is to finish a network
9705 installation. Imagine, you have a common source tree for two different
9706 architectures. You decide to do a completely independent fresh
9707 installation. You start on one architecture with the help of a Bundle
9708 file produced earlier. CPAN installs the whole Bundle for you, but
9709 when you try to repeat the job on the second architecture, CPAN
9710 responds with a C<"Foo up to date"> message for all modules. So you
9711 invoke CPAN's recompile on the second architecture and you're done.
9713 Another popular use for C<recompile> is to act as a rescue in case your
9714 perl breaks binary compatibility. If one of the modules that CPAN uses
9715 is in turn depending on binary compatibility (so you cannot run CPAN
9716 commands), then you should try the CPAN::Nox module for recovery.
9718 =head2 report Bundle|Distribution|Module
9720 The C<report> command temporarily turns on the C<test_report> config
9721 variable, then runs the C<force test> command with the given
9722 arguments. The C<force> pragma is used to re-run the tests and repeat
9723 every step that might have failed before.
9725 =head2 upgrade [Module|/Regex/]...
9727 The C<upgrade> command first runs an C<r> command with the given
9728 arguments and then installs the newest versions of all modules that
9729 were listed by that.
9731 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
9733 Although it may be considered internal, the class hierarchy does matter
9734 for both users and programmer. CPAN.pm deals with above mentioned four
9735 classes, and all those classes share a set of methods. A classical
9736 single polymorphism is in effect. A metaclass object registers all
9737 objects of all kinds and indexes them with a string. The strings
9738 referencing objects have a separated namespace (well, not completely
9743 words containing a "/" (slash) Distribution
9744 words starting with Bundle:: Bundle
9745 everything else Module or Author
9747 Modules know their associated Distribution objects. They always refer
9748 to the most recent official release. Developers may mark their releases
9749 as unstable development versions (by inserting an underbar into the
9750 module version number which will also be reflected in the distribution
9751 name when you run 'make dist'), so the really hottest and newest
9752 distribution is not always the default. If a module Foo circulates
9753 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
9754 way to install version 1.23 by saying
9758 This would install the complete distribution file (say
9759 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
9760 like to install version 1.23_90, you need to know where the
9761 distribution file resides on CPAN relative to the authors/id/
9762 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
9763 so you would have to say
9765 install BAR/Foo-1.23_90.tar.gz
9767 The first example will be driven by an object of the class
9768 CPAN::Module, the second by an object of class CPAN::Distribution.
9770 =head2 Integrating local directories
9772 Note: this feature is still in alpha state and may change in future
9775 Distribution objects are normally distributions from the CPAN, but
9776 there is a slightly degenerate case for Distribution objects, too, of
9777 projects held on the local disk. These distribution objects have the
9778 same name as the local directory and end with a dot. A dot by itself
9779 is also allowed for the current directory at the time CPAN.pm was
9780 used. All actions such as C<make>, C<test>, and C<install> are applied
9781 directly to that directory. This gives the command C<cpan .> an
9782 interesting touch: while the normal mantra of installing a CPAN module
9783 without CPAN.pm is one of
9785 perl Makefile.PL perl Build.PL
9786 ( go and get prerequisites )
9788 make test ./Build test
9789 make install ./Build install
9791 the command C<cpan .> does all of this at once. It figures out which
9792 of the two mantras is appropriate, fetches and installs all
9793 prerequisites, cares for them recursively and finally finishes the
9794 installation of the module in the current directory, be it a CPAN
9797 The typical usage case is for private modules or working copies of
9798 projects from remote repositories on the local disk.
9800 =head1 CONFIGURATION
9802 When the CPAN module is used for the first time, a configuration
9803 dialog tries to determine a couple of site specific options. The
9804 result of the dialog is stored in a hash reference C< $CPAN::Config >
9805 in a file CPAN/Config.pm.
9807 The default values defined in the CPAN/Config.pm file can be
9808 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
9809 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
9810 added to the search path of the CPAN module before the use() or
9811 require() statements. The mkmyconfig command writes this file for you.
9813 The C<o conf> command has various bells and whistles:
9817 =item completion support
9819 If you have a ReadLine module installed, you can hit TAB at any point
9820 of the commandline and C<o conf> will offer you completion for the
9821 built-in subcommands and/or config variable names.
9823 =item displaying some help: o conf help
9825 Displays a short help
9827 =item displaying current values: o conf [KEY]
9829 Displays the current value(s) for this config variable. Without KEY
9830 displays all subcommands and config variables.
9836 =item changing of scalar values: o conf KEY VALUE
9838 Sets the config variable KEY to VALUE. The empty string can be
9839 specified as usual in shells, with C<''> or C<"">
9843 o conf wget /usr/bin/wget
9845 =item changing of list values: o conf KEY SHIFT|UNSHIFT|PUSH|POP|SPLICE|LIST
9847 If a config variable name ends with C<list>, it is a list. C<o conf
9848 KEY shift> removes the first element of the list, C<o conf KEY pop>
9849 removes the last element of the list. C<o conf KEYS unshift LIST>
9850 prepends a list of values to the list, C<o conf KEYS push LIST>
9851 appends a list of valued to the list.
9853 Likewise, C<o conf KEY splice LIST> passes the LIST to the according
9856 Finally, any other list of arguments is taken as a new list value for
9857 the KEY variable discarding the previous value.
9861 o conf urllist unshift http://cpan.dev.local/CPAN
9862 o conf urllist splice 3 1
9863 o conf urllist http://cpan1.local http://cpan2.local ftp://ftp.perl.org
9865 =item reverting to saved: o conf defaults
9867 Reverts all config variables to the state in the saved config file.
9869 =item saving the config: o conf commit
9871 Saves all config variables to the current config file (CPAN/Config.pm
9872 or CPAN/MyConfig.pm that was loaded at start).
9876 The configuration dialog can be started any time later again by
9877 issuing the command C< o conf init > in the CPAN shell. A subset of
9878 the configuration dialog can be run by issuing C<o conf init WORD>
9879 where WORD is any valid config variable or a regular expression.
9881 =head2 Config Variables
9883 Currently the following keys in the hash reference $CPAN::Config are
9886 applypatch path to external prg
9887 auto_commit commit all changes to config variables to disk
9888 build_cache size of cache for directories to build modules
9889 build_dir locally accessible directory to build modules
9890 build_dir_reuse boolean if distros in build_dir are persistent
9891 build_requires_install_policy
9892 to install or not to install when a module is
9893 only needed for building. yes|no|ask/yes|ask/no
9894 bzip2 path to external prg
9895 cache_metadata use serializer to cache metadata
9896 commands_quote prefered character to use for quoting external
9897 commands when running them. Defaults to double
9898 quote on Windows, single tick everywhere else;
9899 can be set to space to disable quoting
9900 check_sigs if signatures should be verified
9901 colorize_debug Term::ANSIColor attributes for debugging output
9902 colorize_output boolean if Term::ANSIColor should colorize output
9903 colorize_print Term::ANSIColor attributes for normal output
9904 colorize_warn Term::ANSIColor attributes for warnings
9905 commandnumber_in_prompt
9906 boolean if you want to see current command number
9907 cpan_home local directory reserved for this package
9908 curl path to external prg
9909 dontload_hash DEPRECATED
9910 dontload_list arrayref: modules in the list will not be
9911 loaded by the CPAN::has_inst() routine
9912 ftp path to external prg
9913 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
9914 ftp_proxy proxy host for ftp requests
9916 gpg path to external prg
9917 gzip location of external program gzip
9918 histfile file to maintain history between sessions
9919 histsize maximum number of lines to keep in histfile
9920 http_proxy proxy host for http requests
9921 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
9922 after this many seconds inactivity. Set to 0 to
9924 index_expire after this many days refetch index files
9925 inhibit_startup_message
9926 if true, does not print the startup message
9927 keep_source_where directory in which to keep the source (if we do)
9928 lynx path to external prg
9929 make location of external make program
9930 make_arg arguments that should always be passed to 'make'
9931 make_install_make_command
9932 the make command for running 'make install', for
9934 make_install_arg same as make_arg for 'make install'
9935 makepl_arg arguments passed to 'perl Makefile.PL'
9936 mbuild_arg arguments passed to './Build'
9937 mbuild_install_arg arguments passed to './Build install'
9938 mbuild_install_build_command
9939 command to use instead of './Build' when we are
9940 in the install stage, for example 'sudo ./Build'
9941 mbuildpl_arg arguments passed to 'perl Build.PL'
9942 ncftp path to external prg
9943 ncftpget path to external prg
9944 no_proxy don't proxy to these hosts/domains (comma separated list)
9945 pager location of external program more (or any pager)
9946 password your password if you CPAN server wants one
9947 patch path to external prg
9948 prefer_installer legal values are MB and EUMM: if a module comes
9949 with both a Makefile.PL and a Build.PL, use the
9950 former (EUMM) or the latter (MB); if the module
9951 comes with only one of the two, that one will be
9953 prerequisites_policy
9954 what to do if you are missing module prerequisites
9955 ('follow' automatically, 'ask' me, or 'ignore')
9956 prefs_dir local directory to store per-distro build options
9957 proxy_user username for accessing an authenticating proxy
9958 proxy_pass password for accessing an authenticating proxy
9959 randomize_urllist add some randomness to the sequence of the urllist
9960 scan_cache controls scanning of cache ('atstart' or 'never')
9961 shell your favorite shell
9962 show_upload_date boolean if commands should try to determine upload date
9963 tar location of external program tar
9964 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
9965 (and nonsense for characters outside latin range)
9966 term_ornaments boolean to turn ReadLine ornamenting on/off
9967 test_report email test reports (if CPAN::Reporter is installed)
9968 unzip location of external program unzip
9969 urllist arrayref to nearby CPAN sites (or equivalent locations)
9970 use_sqlite use CPAN::SQLite for metadata storage (fast and lean)
9971 username your username if you CPAN server wants one
9972 wait_list arrayref to a wait server to try (See CPAN::WAIT)
9973 wget path to external prg
9974 yaml_module which module to use to read/write YAML files
9976 You can set and query each of these options interactively in the cpan
9977 shell with the C<o conf> or the C<o conf init> command as specified below.
9981 =item C<o conf E<lt>scalar optionE<gt>>
9983 prints the current value of the I<scalar option>
9985 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
9987 Sets the value of the I<scalar option> to I<value>
9989 =item C<o conf E<lt>list optionE<gt>>
9991 prints the current value of the I<list option> in MakeMaker's
9994 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
9996 shifts or pops the array in the I<list option> variable
9998 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
10000 works like the corresponding perl commands.
10002 =item interactive editing: o conf init [MATCH|LIST]
10004 Runs an interactive configuration dialog for matching variables.
10005 Without argument runs the dialog over all supported config variables.
10006 To specify a MATCH the argument must be enclosed by slashes.
10010 o conf init ftp_passive ftp_proxy
10011 o conf init /color/
10013 Note: this method of setting config variables often provides more
10014 explanation about the functioning of a variable than the manpage.
10018 =head2 CPAN::anycwd($path): Note on config variable getcwd
10020 CPAN.pm changes the current working directory often and needs to
10021 determine its own current working directory. Per default it uses
10022 Cwd::cwd but if this doesn't work on your system for some reason,
10023 alternatives can be configured according to the following table:
10041 Calls the external command cwd.
10045 =head2 Note on the format of the urllist parameter
10047 urllist parameters are URLs according to RFC 1738. We do a little
10048 guessing if your URL is not compliant, but if you have problems with
10049 C<file> URLs, please try the correct format. Either:
10051 file://localhost/whatever/ftp/pub/CPAN/
10055 file:///home/ftp/pub/CPAN/
10057 =head2 The urllist parameter has CD-ROM support
10059 The C<urllist> parameter of the configuration table contains a list of
10060 URLs that are to be used for downloading. If the list contains any
10061 C<file> URLs, CPAN always tries to get files from there first. This
10062 feature is disabled for index files. So the recommendation for the
10063 owner of a CD-ROM with CPAN contents is: include your local, possibly
10064 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
10066 o conf urllist push file://localhost/CDROM/CPAN
10068 CPAN.pm will then fetch the index files from one of the CPAN sites
10069 that come at the beginning of urllist. It will later check for each
10070 module if there is a local copy of the most recent version.
10072 Another peculiarity of urllist is that the site that we could
10073 successfully fetch the last file from automatically gets a preference
10074 token and is tried as the first site for the next request. So if you
10075 add a new site at runtime it may happen that the previously preferred
10076 site will be tried another time. This means that if you want to disallow
10077 a site for the next transfer, it must be explicitly removed from
10080 =head2 Maintaining the urllist parameter
10082 If you have YAML.pm (or some other YAML module configured in
10083 C<yaml_module>) installed, CPAN.pm collects a few statistical data
10084 about recent downloads. You can view the statistics with the C<hosts>
10085 command or inspect them directly by looking into the C<FTPstats.yml>
10086 file in your C<cpan_home> directory.
10088 To get some interesting statistics it is recommended to set the
10089 C<randomize_urllist> parameter that introduces some amount of
10090 randomness into the URL selection.
10092 =head2 The C<requires> and C<build_requires> dependency declarations
10094 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
10095 a distribution are treated differently depending on the config
10096 variable C<build_requires_install_policy>. By setting
10097 C<build_requires_install_policy> to C<no> such a module is not being
10098 installed. It is only built and tested and then kept in the list of
10099 tested but uninstalled modules. As such it is available during the
10100 build of the dependent module by integrating the path to the
10101 C<blib/arch> and C<blib/lib> directories in the environment variable
10102 PERL5LIB. If C<build_requires_install_policy> is set ti C<yes>, then
10103 both modules declared as C<requires> and those declared as
10104 C<build_requires> are treated alike. By setting to C<ask/yes> or
10105 C<ask/no>, CPAN.pm asks the user and sets the default accordingly.
10107 =head2 Configuration for individual distributions (I<Distroprefs>)
10109 (B<Note:> This feature has been introduced in CPAN.pm 1.8854 and is
10110 still considered beta quality)
10112 Distributions on the CPAN usually behave according to what we call the
10113 CPAN mantra. Or since the event of Module::Build we should talk about
10116 perl Makefile.PL perl Build.PL
10118 make test ./Build test
10119 make install ./Build install
10121 But some modules cannot be built with this mantra. They try to get
10122 some extra data from the user via the environment, extra arguments or
10123 interactively thus disturbing the installation of large bundles like
10124 Phalanx100 or modules with many dependencies like Plagger.
10126 The distroprefs system of C<CPAN.pm> addresses this problem by
10127 allowing the user to specify extra informations and recipes in YAML
10134 pass additional arguments to one of the four commands,
10138 set environment variables
10142 instantiate an Expect object that reads from the console, waits for
10143 some regular expressions and enters some answers
10147 temporarily override assorted C<CPAN.pm> configuration variables
10151 disable the installation of an object altogether
10155 See the YAML and Data::Dumper files that come with the C<CPAN.pm>
10156 distribution in the C<distroprefs/> directory for examples.
10160 The YAML files themselves must have the C<.yml> extension, all other
10161 files are ignored (for two exceptions see I<Fallback Data::Dumper and
10162 Storable> below). The containing directory can be specified in
10163 C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
10164 prefs_dir> in the CPAN shell to set and activate the distroprefs
10167 Every YAML file may contain arbitrary documents according to the YAML
10168 specification and every single document is treated as an entity that
10169 can specify the treatment of a single distribution.
10171 The names of the files can be picked freely, C<CPAN.pm> always reads
10172 all files (in alphabetical order) and takes the key C<match> (see
10173 below in I<Language Specs>) as a hashref containing match criteria
10174 that determine if the current distribution matches the YAML document
10177 =head2 Fallback Data::Dumper and Storable
10179 If neither your configured C<yaml_module> nor YAML.pm is installed
10180 CPAN.pm falls back to using Data::Dumper and Storable and looks for
10181 files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
10182 directory. These files are expected to contain one or more hashrefs.
10183 For Data::Dumper generated files, this is expected to be done with by
10184 defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
10187 ysh < somefile.yml > somefile.dd
10189 For Storable files the rule is that they must be constructed such that
10190 C<Storable::retrieve(file)> returns an array reference and the array
10191 elements represent one distropref object each. The conversion from
10192 YAML would look like so:
10194 perl -MYAML=LoadFile -MStorable=nstore -e '
10195 @y=LoadFile(shift);
10196 nstore(\@y, shift)' somefile.yml somefile.st
10198 In bootstrapping situations it is usually sufficient to translate only
10199 a few YAML files to Data::Dumper for the crucial modules like
10200 C<YAML::Syck>, C<YAML.pm> and C<Expect.pm>. If you prefer Storable
10201 over Data::Dumper, remember to pull out a Storable version that writes
10202 an older format than all the other Storable versions that will need to
10207 The following example contains all supported keywords and structures
10208 with the exception of C<eexpect> which can be used instead of
10214 module: "Dancing::Queen"
10215 distribution: "^CHACHACHA/Dancing-"
10216 perl: "/usr/local/cariba-perl/bin/perl"
10218 archname: "freebsd"
10224 - "--somearg=specialcase"
10229 - "Which is your favorite fruit"
10241 commendline: "echo SKIPPING make"
10254 WANT_TO_INSTALL: YES
10257 - "Do you really want to install"
10261 - "ABCDE/Fedcba-3.14-ABCDE-01.patch"
10264 =head2 Language Specs
10266 Every YAML document represents a single hash reference. The valid keys
10267 in this hash are as follows:
10271 =item comment [scalar]
10275 =item cpanconfig [hash]
10277 Temporarily override assorted C<CPAN.pm> configuration variables.
10279 Supported are: C<build_requires_install_policy>, C<check_sigs>,
10280 C<make>, C<make_install_make_command>, C<prefer_installer>,
10281 C<test_report>. Please report as a bug when you need another one
10284 =item disabled [boolean]
10286 Specifies that this distribution shall not be processed at all.
10288 =item goto [string]
10290 The canonical name of a delegate distribution that shall be installed
10291 instead. Useful when a new version, although it tests OK itself,
10292 breaks something else or a developer release or a fork is already
10293 uploaded that is better than the last released version.
10295 =item install [hash]
10297 Processing instructions for the C<make install> or C<./Build install>
10298 phase of the CPAN mantra. See below under I<Processiong Instructions>.
10302 Processing instructions for the C<make> or C<./Build> phase of the
10303 CPAN mantra. See below under I<Processiong Instructions>.
10307 A hashref with one or more of the keys C<distribution>, C<modules>,
10308 C<perl>, and C<perlconfig> that specify if a document is targeted at a
10309 specific CPAN distribution or installation.
10311 The corresponding values are interpreted as regular expressions. The
10312 C<distribution> related one will be matched against the canonical
10313 distribution name, e.g. "AUTHOR/Foo-Bar-3.14.tar.gz".
10315 The C<module> related one will be matched against I<all> modules
10316 contained in the distribution until one module matches.
10318 The C<perl> related one will be matched against C<$^X>.
10320 The value associated with C<perlconfig> is itself a hashref that is
10321 matched against corresponding values in the C<%Config::Config> hash
10322 living in the C< Config.pm > module.
10324 If more than one restriction of C<module>, C<distribution>, and
10325 C<perl> is specified, the results of the separately computed match
10326 values must all match. If this is the case then the hashref
10327 represented by the YAML document is returned as the preference
10328 structure for the current distribution.
10330 =item patches [array]
10332 An array of patches on CPAN or on the local disk to be applied in
10333 order via the external patch program. If the value for the C<-p>
10334 parameter is C<0> or C<1> is determined by reading the patch
10337 Note: if the C<applypatch> program is installed and C<CPAN::Config>
10338 knows about it B<and> a patch is written by the C<makepatch> program,
10339 then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
10340 and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
10345 Processing instructions for the C<perl Makefile.PL> or C<perl
10346 Build.PL> phase of the CPAN mantra. See below under I<Processiong
10351 Processing instructions for the C<make test> or C<./Build test> phase
10352 of the CPAN mantra. See below under I<Processiong Instructions>.
10356 =head2 Processing Instructions
10362 Arguments to be added to the command line
10366 A full commandline that will be executed as it stands by a system
10367 call. During the execution the environment variable PERL will is set
10368 to $^X. If C<commandline> is specified, the content of C<args> is not
10371 =item eexpect [hash]
10373 Extended C<expect>. This is a hash reference with three allowed keys,
10374 C<mode>, C<timeout>, and C<talk>.
10376 C<mode> may have the values C<deterministic> for the case where all
10377 questions come in the order written down and C<anyorder> for the case
10378 where the questions may come in any order. The default mode is
10381 C<timeout> denotes a timeout in seconds. Floating point timeouts are
10382 OK. In the case of a C<mode=deterministic> the timeout denotes the
10383 timeout per question, in the case of C<mode=anyorder> it denotes the
10384 timeout per byte received from the stream or questions.
10386 C<talk> is a reference to an array that contains alternating questions
10387 and answers. Questions are regular expressions and answers are literal
10388 strings. The Expect module will then watch the stream coming from the
10389 execution of the external program (C<perl Makefile.PL>, C<perl
10390 Build.PL>, C<make>, etc.).
10392 In the case of C<mode=deterministic> the CPAN.pm will inject the
10393 according answer as soon as the stream matches the regular expression.
10394 In the case of C<mode=anyorder> the CPAN.pm will answer a question as
10395 soon as the timeout is reached for the next byte in the input stream.
10396 In the latter case it removes the according question/answer pair from
10397 the array, so if you want to answer the question C<Do you really want
10398 to do that> several times, then it must be included in the array at
10399 least as often as you want this answer to be given.
10403 Environment variables to be set during the command
10405 =item expect [array]
10407 C<< expect: <array> >> is a short notation for
10410 mode: deterministic
10416 =head2 Schema verification with C<Kwalify>
10418 If you have the C<Kwalify> module installed (which is part of the
10419 Bundle::CPANxxl), then all your distroprefs files are checked for
10420 syntactical correctness.
10422 =head2 Example Distroprefs Files
10424 C<CPAN.pm> comes with a collection of example YAML files. Note that these
10425 are really just examples and should not be used without care because
10426 they cannot fit everybody's purpose. After all the authors of the
10427 packages that ask questions had a need to ask, so you should watch
10428 their questions and adjust the examples to your environment and your
10429 needs. You have beend warned:-)
10431 =head1 PROGRAMMER'S INTERFACE
10433 If you do not enter the shell, the available shell commands are both
10434 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
10435 functions in the calling package (C<install(...)>). Before calling low-level
10436 commands it makes sense to initialize components of CPAN you need, e.g.:
10438 CPAN::HandleConfig->load;
10439 CPAN::Shell::setup_output;
10440 CPAN::Index->reload;
10442 High-level commands do such initializations automatically.
10444 There's currently only one class that has a stable interface -
10445 CPAN::Shell. All commands that are available in the CPAN shell are
10446 methods of the class CPAN::Shell. Each of the commands that produce
10447 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
10448 the IDs of all modules within the list.
10452 =item expand($type,@things)
10454 The IDs of all objects available within a program are strings that can
10455 be expanded to the corresponding real objects with the
10456 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
10457 list of CPAN::Module objects according to the C<@things> arguments
10458 given. In scalar context it only returns the first element of the
10461 =item expandany(@things)
10463 Like expand, but returns objects of the appropriate type, i.e.
10464 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
10465 CPAN::Distribution objects for distributions. Note: it does not expand
10466 to CPAN::Author objects.
10468 =item Programming Examples
10470 This enables the programmer to do operations that combine
10471 functionalities that are available in the shell.
10473 # install everything that is outdated on my disk:
10474 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
10476 # install my favorite programs if necessary:
10477 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
10478 CPAN::Shell->install($mod);
10481 # list all modules on my disk that have no VERSION number
10482 for $mod (CPAN::Shell->expand("Module","/./")){
10483 next unless $mod->inst_file;
10484 # MakeMaker convention for undefined $VERSION:
10485 next unless $mod->inst_version eq "undef";
10486 print "No VERSION in ", $mod->id, "\n";
10489 # find out which distribution on CPAN contains a module:
10490 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
10492 Or if you want to write a cronjob to watch The CPAN, you could list
10493 all modules that need updating. First a quick and dirty way:
10495 perl -e 'use CPAN; CPAN::Shell->r;'
10497 If you don't want to get any output in the case that all modules are
10498 up to date, you can parse the output of above command for the regular
10499 expression //modules are up to date// and decide to mail the output
10500 only if it doesn't match. Ick?
10502 If you prefer to do it more in a programmer style in one single
10503 process, maybe something like this suits you better:
10505 # list all modules on my disk that have newer versions on CPAN
10506 for $mod (CPAN::Shell->expand("Module","/./")){
10507 next unless $mod->inst_file;
10508 next if $mod->uptodate;
10509 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
10510 $mod->id, $mod->inst_version, $mod->cpan_version;
10513 If that gives you too much output every day, you maybe only want to
10514 watch for three modules. You can write
10516 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
10518 as the first line instead. Or you can combine some of the above
10521 # watch only for a new mod_perl module
10522 $mod = CPAN::Shell->expand("Module","mod_perl");
10523 exit if $mod->uptodate;
10524 # new mod_perl arrived, let me know all update recommendations
10529 =head2 Methods in the other Classes
10533 =item CPAN::Author::as_glimpse()
10535 Returns a one-line description of the author
10537 =item CPAN::Author::as_string()
10539 Returns a multi-line description of the author
10541 =item CPAN::Author::email()
10543 Returns the author's email address
10545 =item CPAN::Author::fullname()
10547 Returns the author's name
10549 =item CPAN::Author::name()
10551 An alias for fullname
10553 =item CPAN::Bundle::as_glimpse()
10555 Returns a one-line description of the bundle
10557 =item CPAN::Bundle::as_string()
10559 Returns a multi-line description of the bundle
10561 =item CPAN::Bundle::clean()
10563 Recursively runs the C<clean> method on all items contained in the bundle.
10565 =item CPAN::Bundle::contains()
10567 Returns a list of objects' IDs contained in a bundle. The associated
10568 objects may be bundles, modules or distributions.
10570 =item CPAN::Bundle::force($method,@args)
10572 Forces CPAN to perform a task that it normally would have refused to
10573 do. Force takes as arguments a method name to be called and any number
10574 of additional arguments that should be passed to the called method.
10575 The internals of the object get the needed changes so that CPAN.pm
10576 does not refuse to take the action. The C<force> is passed recursively
10577 to all contained objects. See also the section above on the C<force>
10578 and the C<fforce> pragma.
10580 =item CPAN::Bundle::get()
10582 Recursively runs the C<get> method on all items contained in the bundle
10584 =item CPAN::Bundle::inst_file()
10586 Returns the highest installed version of the bundle in either @INC or
10587 C<$CPAN::Config->{cpan_home}>. Note that this is different from
10588 CPAN::Module::inst_file.
10590 =item CPAN::Bundle::inst_version()
10592 Like CPAN::Bundle::inst_file, but returns the $VERSION
10594 =item CPAN::Bundle::uptodate()
10596 Returns 1 if the bundle itself and all its members are uptodate.
10598 =item CPAN::Bundle::install()
10600 Recursively runs the C<install> method on all items contained in the bundle
10602 =item CPAN::Bundle::make()
10604 Recursively runs the C<make> method on all items contained in the bundle
10606 =item CPAN::Bundle::readme()
10608 Recursively runs the C<readme> method on all items contained in the bundle
10610 =item CPAN::Bundle::test()
10612 Recursively runs the C<test> method on all items contained in the bundle
10614 =item CPAN::Distribution::as_glimpse()
10616 Returns a one-line description of the distribution
10618 =item CPAN::Distribution::as_string()
10620 Returns a multi-line description of the distribution
10622 =item CPAN::Distribution::author
10624 Returns the CPAN::Author object of the maintainer who uploaded this
10627 =item CPAN::Distribution::clean()
10629 Changes to the directory where the distribution has been unpacked and
10630 runs C<make clean> there.
10632 =item CPAN::Distribution::containsmods()
10634 Returns a list of IDs of modules contained in a distribution file.
10635 Only works for distributions listed in the 02packages.details.txt.gz
10636 file. This typically means that only the most recent version of a
10637 distribution is covered.
10639 =item CPAN::Distribution::cvs_import()
10641 Changes to the directory where the distribution has been unpacked and
10642 runs something like
10644 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
10648 =item CPAN::Distribution::dir()
10650 Returns the directory into which this distribution has been unpacked.
10652 =item CPAN::Distribution::force($method,@args)
10654 Forces CPAN to perform a task that it normally would have refused to
10655 do. Force takes as arguments a method name to be called and any number
10656 of additional arguments that should be passed to the called method.
10657 The internals of the object get the needed changes so that CPAN.pm
10658 does not refuse to take the action. See also the section above on the
10659 C<force> and the C<fforce> pragma.
10661 =item CPAN::Distribution::get()
10663 Downloads the distribution from CPAN and unpacks it. Does nothing if
10664 the distribution has already been downloaded and unpacked within the
10667 =item CPAN::Distribution::install()
10669 Changes to the directory where the distribution has been unpacked and
10670 runs the external command C<make install> there. If C<make> has not
10671 yet been run, it will be run first. A C<make test> will be issued in
10672 any case and if this fails, the install will be canceled. The
10673 cancellation can be avoided by letting C<force> run the C<install> for
10676 This install method has only the power to install the distribution if
10677 there are no dependencies in the way. To install an object and all of
10678 its dependencies, use CPAN::Shell->install.
10680 Note that install() gives no meaningful return value. See uptodate().
10682 =item CPAN::Distribution::install_tested()
10684 Install all the distributions that have been tested sucessfully but
10685 not yet installed. See also C<is_tested>.
10687 =item CPAN::Distribution::isa_perl()
10689 Returns 1 if this distribution file seems to be a perl distribution.
10690 Normally this is derived from the file name only, but the index from
10691 CPAN can contain a hint to achieve a return value of true for other
10694 =item CPAN::Distribution::is_tested()
10696 List all the distributions that have been tested sucessfully but not
10697 yet installed. See also C<install_tested>.
10699 =item CPAN::Distribution::look()
10701 Changes to the directory where the distribution has been unpacked and
10702 opens a subshell there. Exiting the subshell returns.
10704 =item CPAN::Distribution::make()
10706 First runs the C<get> method to make sure the distribution is
10707 downloaded and unpacked. Changes to the directory where the
10708 distribution has been unpacked and runs the external commands C<perl
10709 Makefile.PL> or C<perl Build.PL> and C<make> there.
10711 =item CPAN::Distribution::perldoc()
10713 Downloads the pod documentation of the file associated with a
10714 distribution (in html format) and runs it through the external
10715 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
10716 isn't available, it converts it to plain text with external
10717 command html2text and runs it through the pager specified
10718 in C<$CPAN::Config->{pager}>
10720 =item CPAN::Distribution::prefs()
10722 Returns the hash reference from the first matching YAML file that the
10723 user has deposited in the C<prefs_dir/> directory. The first
10724 succeeding match wins. The files in the C<prefs_dir/> are processed
10725 alphabetically and the canonical distroname (e.g.
10726 AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
10727 stored in the $root->{match}{distribution} attribute value.
10728 Additionally all module names contained in a distribution are matched
10729 agains the regular expressions in the $root->{match}{module} attribute
10730 value. The two match values are ANDed together. Each of the two
10731 attributes are optional.
10733 =item CPAN::Distribution::prereq_pm()
10735 Returns the hash reference that has been announced by a distribution
10736 as the the C<requires> and C<build_requires> elements. These can be
10737 declared either by the C<META.yml> (if authoritative) or can be
10738 deposited after the run of C<Build.PL> in the file C<./_build/prereqs>
10739 or after the run of C<Makfile.PL> written as the C<PREREQ_PM> hash in
10740 a comment in the produced C<Makefile>. I<Note>: this method only works
10741 after an attempt has been made to C<make> the distribution. Returns
10744 =item CPAN::Distribution::readme()
10746 Downloads the README file associated with a distribution and runs it
10747 through the pager specified in C<$CPAN::Config->{pager}>.
10749 =item CPAN::Distribution::read_yaml()
10751 Returns the content of the META.yml of this distro as a hashref. Note:
10752 works only after an attempt has been made to C<make> the distribution.
10753 Returns undef otherwise. Also returns undef if the content of META.yml
10754 is not authoritative. (The rules about what exactly makes the content
10755 authoritative are still in flux.)
10757 =item CPAN::Distribution::test()
10759 Changes to the directory where the distribution has been unpacked and
10760 runs C<make test> there.
10762 =item CPAN::Distribution::uptodate()
10764 Returns 1 if all the modules contained in the distribution are
10765 uptodate. Relies on containsmods.
10767 =item CPAN::Index::force_reload()
10769 Forces a reload of all indices.
10771 =item CPAN::Index::reload()
10773 Reloads all indices if they have not been read for more than
10774 C<$CPAN::Config->{index_expire}> days.
10776 =item CPAN::InfoObj::dump()
10778 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
10779 inherit this method. It prints the data structure associated with an
10780 object. Useful for debugging. Note: the data structure is considered
10781 internal and thus subject to change without notice.
10783 =item CPAN::Module::as_glimpse()
10785 Returns a one-line description of the module in four columns: The
10786 first column contains the word C<Module>, the second column consists
10787 of one character: an equals sign if this module is already installed
10788 and uptodate, a less-than sign if this module is installed but can be
10789 upgraded, and a space if the module is not installed. The third column
10790 is the name of the module and the fourth column gives maintainer or
10791 distribution information.
10793 =item CPAN::Module::as_string()
10795 Returns a multi-line description of the module
10797 =item CPAN::Module::clean()
10799 Runs a clean on the distribution associated with this module.
10801 =item CPAN::Module::cpan_file()
10803 Returns the filename on CPAN that is associated with the module.
10805 =item CPAN::Module::cpan_version()
10807 Returns the latest version of this module available on CPAN.
10809 =item CPAN::Module::cvs_import()
10811 Runs a cvs_import on the distribution associated with this module.
10813 =item CPAN::Module::description()
10815 Returns a 44 character description of this module. Only available for
10816 modules listed in The Module List (CPAN/modules/00modlist.long.html
10817 or 00modlist.long.txt.gz)
10819 =item CPAN::Module::distribution()
10821 Returns the CPAN::Distribution object that contains the current
10822 version of this module.
10824 =item CPAN::Module::dslip_status()
10826 Returns a hash reference. The keys of the hash are the letters C<D>,
10827 C<S>, C<L>, C<I>, and <P>, for development status, support level,
10828 language, interface and public licence respectively. The data for the
10829 DSLIP status are collected by pause.perl.org when authors register
10830 their namespaces. The values of the 5 hash elements are one-character
10831 words whose meaning is described in the table below. There are also 5
10832 hash elements C<DV>, C<SV>, C<LV>, C<IV>, and <PV> that carry a more
10833 verbose value of the 5 status variables.
10835 Where the 'DSLIP' characters have the following meanings:
10837 D - Development Stage (Note: *NO IMPLIED TIMESCALES*):
10838 i - Idea, listed to gain consensus or as a placeholder
10839 c - under construction but pre-alpha (not yet released)
10840 a/b - Alpha/Beta testing
10842 M - Mature (no rigorous definition)
10843 S - Standard, supplied with Perl 5
10848 u - Usenet newsgroup comp.lang.perl.modules
10849 n - None known, try comp.lang.perl.modules
10850 a - abandoned; volunteers welcome to take over maintainance
10853 p - Perl-only, no compiler needed, should be platform independent
10854 c - C and perl, a C compiler will be needed
10855 h - Hybrid, written in perl with optional C code, no compiler needed
10856 + - C++ and perl, a C++ compiler will be needed
10857 o - perl and another language other than C or C++
10859 I - Interface Style
10860 f - plain Functions, no references used
10861 h - hybrid, object and function interfaces available
10862 n - no interface at all (huh?)
10863 r - some use of unblessed References or ties
10864 O - Object oriented using blessed references and/or inheritance
10867 p - Standard-Perl: user may choose between GPL and Artistic
10868 g - GPL: GNU General Public License
10869 l - LGPL: "GNU Lesser General Public License" (previously known as
10870 "GNU Library General Public License")
10871 b - BSD: The BSD License
10872 a - Artistic license alone
10873 o - open source: appoved by www.opensource.org
10874 d - allows distribution without restrictions
10875 r - restricted distribtion
10876 n - no license at all
10878 =item CPAN::Module::force($method,@args)
10880 Forces CPAN to perform a task that it normally would have refused to
10881 do. Force takes as arguments a method name to be called and any number
10882 of additional arguments that should be passed to the called method.
10883 The internals of the object get the needed changes so that CPAN.pm
10884 does not refuse to take the action. See also the section above on the
10885 C<force> and the C<fforce> pragma.
10887 =item CPAN::Module::get()
10889 Runs a get on the distribution associated with this module.
10891 =item CPAN::Module::inst_file()
10893 Returns the filename of the module found in @INC. The first file found
10894 is reported just like perl itself stops searching @INC when it finds a
10897 =item CPAN::Module::available_file()
10899 Returns the filename of the module found in PERL5LIB or @INC. The
10900 first file found is reported. The advantage of this method over
10901 C<inst_file> is that modules that have been tested but not yet
10902 installed are included because PERL5LIB keeps track of tested modules.
10904 =item CPAN::Module::inst_version()
10906 Returns the version number of the installed module in readable format.
10908 =item CPAN::Module::available_version()
10910 Returns the version number of the available module in readable format.
10912 =item CPAN::Module::install()
10914 Runs an C<install> on the distribution associated with this module.
10916 =item CPAN::Module::look()
10918 Changes to the directory where the distribution associated with this
10919 module has been unpacked and opens a subshell there. Exiting the
10922 =item CPAN::Module::make()
10924 Runs a C<make> on the distribution associated with this module.
10926 =item CPAN::Module::manpage_headline()
10928 If module is installed, peeks into the module's manpage, reads the
10929 headline and returns it. Moreover, if the module has been downloaded
10930 within this session, does the equivalent on the downloaded module even
10931 if it is not installed.
10933 =item CPAN::Module::perldoc()
10935 Runs a C<perldoc> on this module.
10937 =item CPAN::Module::readme()
10939 Runs a C<readme> on the distribution associated with this module.
10941 =item CPAN::Module::test()
10943 Runs a C<test> on the distribution associated with this module.
10945 =item CPAN::Module::uptodate()
10947 Returns 1 if the module is installed and up-to-date.
10949 =item CPAN::Module::userid()
10951 Returns the author's ID of the module.
10955 =head2 Cache Manager
10957 Currently the cache manager only keeps track of the build directory
10958 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
10959 deletes complete directories below C<build_dir> as soon as the size of
10960 all directories there gets bigger than $CPAN::Config->{build_cache}
10961 (in MB). The contents of this cache may be used for later
10962 re-installations that you intend to do manually, but will never be
10963 trusted by CPAN itself. This is due to the fact that the user might
10964 use these directories for building modules on different architectures.
10966 There is another directory ($CPAN::Config->{keep_source_where}) where
10967 the original distribution files are kept. This directory is not
10968 covered by the cache manager and must be controlled by the user. If
10969 you choose to have the same directory as build_dir and as
10970 keep_source_where directory, then your sources will be deleted with
10971 the same fifo mechanism.
10975 A bundle is just a perl module in the namespace Bundle:: that does not
10976 define any functions or methods. It usually only contains documentation.
10978 It starts like a perl module with a package declaration and a $VERSION
10979 variable. After that the pod section looks like any other pod with the
10980 only difference being that I<one special pod section> exists starting with
10985 In this pod section each line obeys the format
10987 Module_Name [Version_String] [- optional text]
10989 The only required part is the first field, the name of a module
10990 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
10991 of the line is optional. The comment part is delimited by a dash just
10992 as in the man page header.
10994 The distribution of a bundle should follow the same convention as
10995 other distributions.
10997 Bundles are treated specially in the CPAN package. If you say 'install
10998 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
10999 the modules in the CONTENTS section of the pod. You can install your
11000 own Bundles locally by placing a conformant Bundle file somewhere into
11001 your @INC path. The autobundle() command which is available in the
11002 shell interface does that for you by including all currently installed
11003 modules in a snapshot bundle file.
11005 =head1 PREREQUISITES
11007 If you have a local mirror of CPAN and can access all files with
11008 "file:" URLs, then you only need a perl better than perl5.003 to run
11009 this module. Otherwise Net::FTP is strongly recommended. LWP may be
11010 required for non-UNIX systems or if your nearest CPAN site is
11011 associated with a URL that is not C<ftp:>.
11013 If you have neither Net::FTP nor LWP, there is a fallback mechanism
11014 implemented for an external ftp command or for an external lynx
11019 =head2 Finding packages and VERSION
11021 This module presumes that all packages on CPAN
11027 declare their $VERSION variable in an easy to parse manner. This
11028 prerequisite can hardly be relaxed because it consumes far too much
11029 memory to load all packages into the running program just to determine
11030 the $VERSION variable. Currently all programs that are dealing with
11031 version use something like this
11033 perl -MExtUtils::MakeMaker -le \
11034 'print MM->parse_version(shift)' filename
11036 If you are author of a package and wonder if your $VERSION can be
11037 parsed, please try the above method.
11041 come as compressed or gzipped tarfiles or as zip files and contain a
11042 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
11043 without much enthusiasm).
11049 The debugging of this module is a bit complex, because we have
11050 interferences of the software producing the indices on CPAN, of the
11051 mirroring process on CPAN, of packaging, of configuration, of
11052 synchronicity, and of bugs within CPAN.pm.
11054 For debugging the code of CPAN.pm itself in interactive mode some more
11055 or less useful debugging aid can be turned on for most packages within
11056 CPAN.pm with one of
11060 =item o debug package...
11062 sets debug mode for packages.
11064 =item o debug -package...
11066 unsets debug mode for packages.
11070 turns debugging on for all packages.
11072 =item o debug number
11076 which sets the debugging packages directly. Note that C<o debug 0>
11077 turns debugging off.
11079 What seems quite a successful strategy is the combination of C<reload
11080 cpan> and the debugging switches. Add a new debug statement while
11081 running in the shell and then issue a C<reload cpan> and see the new
11082 debugging messages immediately without losing the current context.
11084 C<o debug> without an argument lists the valid package names and the
11085 current set of packages in debugging mode. C<o debug> has built-in
11086 completion support.
11088 For debugging of CPAN data there is the C<dump> command which takes
11089 the same arguments as make/test/install and outputs each object's
11090 Data::Dumper dump. If an argument looks like a perl variable and
11091 contains one of C<$>, C<@> or C<%>, it is eval()ed and fed to
11092 Data::Dumper directly.
11094 =head2 Floppy, Zip, Offline Mode
11096 CPAN.pm works nicely without network too. If you maintain machines
11097 that are not networked at all, you should consider working with file:
11098 URLs. Of course, you have to collect your modules somewhere first. So
11099 you might use CPAN.pm to put together all you need on a networked
11100 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
11101 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
11102 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
11103 with this floppy. See also below the paragraph about CD-ROM support.
11105 =head2 Basic Utilities for Programmers
11109 =item has_inst($module)
11111 Returns true if the module is installed. Used to load all modules into
11112 the running CPAN.pm which are considered optional. The config variable
11113 C<dontload_list> can be used to intercept the C<has_inst()> call such
11114 that an optional module is not loaded despite being available. For
11115 example the following command will prevent that C<YAML.pm> is being
11118 cpan> o conf dontload_list push YAML
11120 See the source for details.
11122 =item has_usable($module)
11124 Returns true if the module is installed and is in a usable state. Only
11125 useful for a handful of modules that are used internally. See the
11126 source for details.
11128 =item instance($module)
11130 The constructor for all the singletons used to represent modules,
11131 distributions, authors and bundles. If the object already exists, this
11132 method returns the object, otherwise it calls the constructor.
11138 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
11139 install foreign, unmasked, unsigned code on your machine. We compare
11140 to a checksum that comes from the net just as the distribution file
11141 itself. But we try to make it easy to add security on demand:
11143 =head2 Cryptographically signed modules
11145 Since release 1.77 CPAN.pm has been able to verify cryptographically
11146 signed module distributions using Module::Signature. The CPAN modules
11147 can be signed by their authors, thus giving more security. The simple
11148 unsigned MD5 checksums that were used before by CPAN protect mainly
11149 against accidental file corruption.
11151 You will need to have Module::Signature installed, which in turn
11152 requires that you have at least one of Crypt::OpenPGP module or the
11153 command-line F<gpg> tool installed.
11155 You will also need to be able to connect over the Internet to the public
11156 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
11158 The configuration parameter check_sigs is there to turn signature
11159 checking on or off.
11163 Most functions in package CPAN are exported per default. The reason
11164 for this is that the primary use is intended for the cpan shell or for
11169 When the CPAN shell enters a subshell via the look command, it sets
11170 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
11173 When CPAN runs, it sets the environment variable PERL5_CPAN_IS_RUNNING.
11175 When the config variable ftp_passive is set, all downloads will be run
11176 with the environment variable FTP_PASSIVE set to this value. This is
11177 in general a good idea as it influences both Net::FTP and LWP based
11178 connections. The same effect can be achieved by starting the cpan
11179 shell with this environment variable set. For Net::FTP alone, one can
11180 also always set passive mode by running libnetcfg.
11182 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
11184 Populating a freshly installed perl with my favorite modules is pretty
11185 easy if you maintain a private bundle definition file. To get a useful
11186 blueprint of a bundle definition file, the command autobundle can be used
11187 on the CPAN shell command line. This command writes a bundle definition
11188 file for all modules that are installed for the currently running perl
11189 interpreter. It's recommended to run this command only once and from then
11190 on maintain the file manually under a private name, say
11191 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
11193 cpan> install Bundle::my_bundle
11195 then answer a few questions and then go out for a coffee.
11197 Maintaining a bundle definition file means keeping track of two
11198 things: dependencies and interactivity. CPAN.pm sometimes fails on
11199 calculating dependencies because not all modules define all MakeMaker
11200 attributes correctly, so a bundle definition file should specify
11201 prerequisites as early as possible. On the other hand, it's a bit
11202 annoying that many distributions need some interactive configuring. So
11203 what I try to accomplish in my private bundle file is to have the
11204 packages that need to be configured early in the file and the gentle
11205 ones later, so I can go out after a few minutes and leave CPAN.pm
11208 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
11210 Thanks to Graham Barr for contributing the following paragraphs about
11211 the interaction between perl, and various firewall configurations. For
11212 further information on firewalls, it is recommended to consult the
11213 documentation that comes with the ncftp program. If you are unable to
11214 go through the firewall with a simple Perl setup, it is very likely
11215 that you can configure ncftp so that it works for your firewall.
11217 =head2 Three basic types of firewalls
11219 Firewalls can be categorized into three basic types.
11223 =item http firewall
11225 This is where the firewall machine runs a web server and to access the
11226 outside world you must do it via the web server. If you set environment
11227 variables like http_proxy or ftp_proxy to a values beginning with http://
11228 or in your web browser you have to set proxy information then you know
11229 you are running an http firewall.
11231 To access servers outside these types of firewalls with perl (even for
11232 ftp) you will need to use LWP.
11236 This where the firewall machine runs an ftp server. This kind of
11237 firewall will only let you access ftp servers outside the firewall.
11238 This is usually done by connecting to the firewall with ftp, then
11239 entering a username like "user@outside.host.com"
11241 To access servers outside these type of firewalls with perl you
11242 will need to use Net::FTP.
11244 =item One way visibility
11246 I say one way visibility as these firewalls try to make themselves look
11247 invisible to the users inside the firewall. An FTP data connection is
11248 normally created by sending the remote server your IP address and then
11249 listening for the connection. But the remote server will not be able to
11250 connect to you because of the firewall. So for these types of firewall
11251 FTP connections need to be done in a passive mode.
11253 There are two that I can think off.
11259 If you are using a SOCKS firewall you will need to compile perl and link
11260 it with the SOCKS library, this is what is normally called a 'socksified'
11261 perl. With this executable you will be able to connect to servers outside
11262 the firewall as if it is not there.
11264 =item IP Masquerade
11266 This is the firewall implemented in the Linux kernel, it allows you to
11267 hide a complete network behind one IP address. With this firewall no
11268 special compiling is needed as you can access hosts directly.
11270 For accessing ftp servers behind such firewalls you usually need to
11271 set the environment variable C<FTP_PASSIVE> or the config variable
11272 ftp_passive to a true value.
11278 =head2 Configuring lynx or ncftp for going through a firewall
11280 If you can go through your firewall with e.g. lynx, presumably with a
11283 /usr/local/bin/lynx -pscott:tiger
11285 then you would configure CPAN.pm with the command
11287 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
11289 That's all. Similarly for ncftp or ftp, you would configure something
11292 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
11294 Your mileage may vary...
11302 I installed a new version of module X but CPAN keeps saying,
11303 I have the old version installed
11305 Most probably you B<do> have the old version installed. This can
11306 happen if a module installs itself into a different directory in the
11307 @INC path than it was previously installed. This is not really a
11308 CPAN.pm problem, you would have the same problem when installing the
11309 module manually. The easiest way to prevent this behaviour is to add
11310 the argument C<UNINST=1> to the C<make install> call, and that is why
11311 many people add this argument permanently by configuring
11313 o conf make_install_arg UNINST=1
11317 So why is UNINST=1 not the default?
11319 Because there are people who have their precise expectations about who
11320 may install where in the @INC path and who uses which @INC array. In
11321 fine tuned environments C<UNINST=1> can cause damage.
11325 I want to clean up my mess, and install a new perl along with
11326 all modules I have. How do I go about it?
11328 Run the autobundle command for your old perl and optionally rename the
11329 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
11330 with the Configure option prefix, e.g.
11332 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
11334 Install the bundle file you produced in the first step with something like
11336 cpan> install Bundle::mybundle
11342 When I install bundles or multiple modules with one command
11343 there is too much output to keep track of.
11345 You may want to configure something like
11347 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
11348 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
11350 so that STDOUT is captured in a file for later inspection.
11355 I am not root, how can I install a module in a personal directory?
11357 First of all, you will want to use your own configuration, not the one
11358 that your root user installed. If you do not have permission to write
11359 in the cpan directory that root has configured, you will be asked if
11360 you want to create your own config. Answering "yes" will bring you into
11361 CPAN's configuration stage, using the system config for all defaults except
11362 things that have to do with CPAN's work directory, saving your choices to
11363 your MyConfig.pm file.
11365 You can also manually initiate this process with the following command:
11367 % perl -MCPAN -e 'mkmyconfig'
11373 from the CPAN shell.
11375 You will most probably also want to configure something like this:
11377 o conf makepl_arg "LIB=~/myperl/lib \
11378 INSTALLMAN1DIR=~/myperl/man/man1 \
11379 INSTALLMAN3DIR=~/myperl/man/man3 \
11380 INSTALLSCRIPT=~/myperl/bin \
11381 INSTALLBIN=~/myperl/bin"
11383 and then (oh joy) the equivalent command for Module::Build.
11385 You can make this setting permanent like all C<o conf> settings with
11386 C<o conf commit> or by setting C<auto_commit> beforehand.
11388 You will have to add ~/myperl/man to the MANPATH environment variable
11389 and also tell your perl programs to look into ~/myperl/lib, e.g. by
11392 use lib "$ENV{HOME}/myperl/lib";
11394 or setting the PERL5LIB environment variable.
11396 While we're speaking about $ENV{HOME}, it might be worth mentioning,
11397 that for Windows we use the File::HomeDir module that provides an
11398 equivalent to the concept of the home directory on Unix.
11400 Another thing you should bear in mind is that the UNINST parameter can
11401 be dnagerous when you are installing into a private area because you
11402 might accidentally remove modules that other people depend on that are
11403 not using the private area.
11407 How to get a package, unwrap it, and make a change before building it?
11409 Have a look at the C<look> (!) command.
11413 I installed a Bundle and had a couple of fails. When I
11414 retried, everything resolved nicely. Can this be fixed to work
11417 The reason for this is that CPAN does not know the dependencies of all
11418 modules when it starts out. To decide about the additional items to
11419 install, it just uses data found in the META.yml file or the generated
11420 Makefile. An undetected missing piece breaks the process. But it may
11421 well be that your Bundle installs some prerequisite later than some
11422 depending item and thus your second try is able to resolve everything.
11423 Please note, CPAN.pm does not know the dependency tree in advance and
11424 cannot sort the queue of things to install in a topologically correct
11425 order. It resolves perfectly well IF all modules declare the
11426 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
11427 the C<requires> stanza of Module::Build. For bundles which fail and
11428 you need to install often, it is recommended to sort the Bundle
11429 definition file manually.
11433 In our intranet we have many modules for internal use. How
11434 can I integrate these modules with CPAN.pm but without uploading
11435 the modules to CPAN?
11437 Have a look at the CPAN::Site module.
11441 When I run CPAN's shell, I get an error message about things in my
11442 /etc/inputrc (or ~/.inputrc) file.
11444 These are readline issues and can only be fixed by studying readline
11445 configuration on your architecture and adjusting the referenced file
11446 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
11447 and edit them. Quite often harmless changes like uppercasing or
11448 lowercasing some arguments solves the problem.
11452 Some authors have strange characters in their names.
11454 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
11455 expecting ISO-8859-1 charset, a converter can be activated by setting
11456 term_is_latin to a true value in your config file. One way of doing so
11459 cpan> o conf term_is_latin 1
11461 If other charset support is needed, please file a bugreport against
11462 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
11463 the support or maybe UTF-8 terminals become widely available.
11467 When an install fails for some reason and then I correct the error
11468 condition and retry, CPAN.pm refuses to install the module, saying
11469 C<Already tried without success>.
11471 Use the force pragma like so
11473 force install Foo::Bar
11479 and then 'make install' directly in the subshell.
11483 How do I install a "DEVELOPER RELEASE" of a module?
11485 By default, CPAN will install the latest non-developer release of a
11486 module. If you want to install a dev release, you have to specify the
11487 partial path starting with the author id to the tarball you wish to
11490 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
11492 Note that you can use the C<ls> command to get this path listed.
11496 How do I install a module and all its dependencies from the commandline,
11497 without being prompted for anything, despite my CPAN configuration
11500 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
11501 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
11502 asked any questions at all (assuming the modules you are installing are
11503 nice about obeying that variable as well):
11505 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
11509 How do I create a Module::Build based Build.PL derived from an
11510 ExtUtils::MakeMaker focused Makefile.PL?
11512 http://search.cpan.org/search?query=Module::Build::Convert
11514 http://accognoscere.org/papers/perl-module-build-convert/module-build-convert.html
11518 What's the best CPAN site for me?
11520 The urllist config parameter is yours. You can add and remove sites at
11521 will. You should find out which sites have the best uptodateness,
11522 bandwidth, reliability, etc. and are topologically close to you. Some
11523 people prefer fast downloads, others uptodateness, others reliability.
11524 You decide which to try in which order.
11526 Henk P. Penning maintains a site that collects data about CPAN sites:
11528 http://www.cs.uu.nl/people/henkp/mirmon/cpan.html
11532 =head1 COMPATIBILITY
11534 =head2 OLD PERL VERSIONS
11536 CPAN.pm is regularly tested to run under 5.004, 5.005, and assorted
11537 newer versions. It is getting more and more difficult to get the
11538 minimal prerequisites working on older perls. It is close to
11539 impossible to get the whole Bundle::CPAN working there. If you're in
11540 the position to have only these old versions, be advised that CPAN is
11541 designed to work fine without the Bundle::CPAN installed.
11543 To get things going, note that GBARR/Scalar-List-Utils-1.18.tar.gz is
11544 compatible with ancient perls and that File::Temp is listed as a
11545 prerequisite but CPAN has reasonable workarounds if it is missing.
11549 This module and its competitor, the CPANPLUS module, are both much
11550 cooler than the other. CPAN.pm is older. CPANPLUS was designed to be
11551 more modular but it was never tried to make it compatible with CPAN.pm.
11553 =head1 SECURITY ADVICE
11555 This software enables you to upgrade software on your computer and so
11556 is inherently dangerous because the newly installed software may
11557 contain bugs and may alter the way your computer works or even make it
11558 unusable. Please consider backing up your data before every upgrade.
11562 Please report bugs via http://rt.cpan.org/
11564 Before submitting a bug, please make sure that the traditional method
11565 of building a Perl module package from a shell by following the
11566 installation instructions of that package still works in your
11571 Andreas Koenig C<< <andk@cpan.org> >>
11575 This program is free software; you can redistribute it and/or
11576 modify it under the same terms as Perl itself.
11578 See L<http://www.perl.com/perl/misc/Artistic.html>
11580 =head1 TRANSLATIONS
11582 Kawai,Takanori provides a Japanese translation of this manpage at
11583 http://homepage3.nifty.com/hippo2000/perltips/CPAN.htm
11587 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)