1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $VERSION = eval $VERSION;
7 use CPAN::HandleConfig;
16 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
17 use File::Basename ();
25 use Sys::Hostname qw(hostname);
26 use Text::ParseWords ();
28 no lib "."; # we need to run chdir all over and we would get at wrong
31 require Mac::BuildTools if $^O eq 'MacOS';
33 END { $CPAN::End++; &cleanup; }
36 $CPAN::Frontend ||= "CPAN::Shell";
37 @CPAN::Defaultsites = ("http://www.perl.org/CPAN/","ftp://ftp.perl.org/pub/CPAN/")
38 unless @CPAN::Defaultsites;
39 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
40 $CPAN::Perl ||= CPAN::find_perl();
41 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
42 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
48 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
49 $Signal $Suppress_readline $Frontend
50 @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
53 @CPAN::ISA = qw(CPAN::Debug Exporter);
55 # note that these functions live in CPAN::Shell and get executed via
56 # AUTOLOAD when called directly
77 sub soft_chdir_with_alternatives ($);
79 #-> sub CPAN::AUTOLOAD ;
84 @EXPORT{@EXPORT} = '';
85 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
86 if (exists $EXPORT{$l}){
89 $CPAN::Frontend->mywarn(qq{Unknown CPAN command "$AUTOLOAD". }.
98 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
99 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
101 my $oprompt = shift || CPAN::Prompt->new;
102 my $prompt = $oprompt;
103 my $commandline = shift || "";
104 $CPAN::CurrentCommandId ||= 1;
107 unless ($Suppress_readline) {
108 require Term::ReadLine;
111 $term->ReadLine eq "Term::ReadLine::Stub"
113 $term = Term::ReadLine->new('CPAN Monitor');
115 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
116 my $attribs = $term->Attribs;
117 $attribs->{attempted_completion_function} = sub {
118 &CPAN::Complete::gnu_cpl;
121 $readline::rl_completion_function =
122 $readline::rl_completion_function = 'CPAN::Complete::cpl';
124 if (my $histfile = $CPAN::Config->{'histfile'}) {{
125 unless ($term->can("AddHistory")) {
126 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
129 my($fh) = FileHandle->new;
130 open $fh, "<$histfile" or last;
134 $term->AddHistory($_);
138 # $term->OUT is autoflushed anyway
139 my $odef = select STDERR;
146 # no strict; # I do not recall why no strict was here (2000-09-03)
148 my @cwd = (CPAN::anycwd(),File::Spec->tmpdir(),File::Spec->rootdir());
149 my $try_detect_readline;
150 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
151 my $rl_avail = $Suppress_readline ? "suppressed" :
152 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
153 "available (try 'install Bundle::CPAN')";
155 $CPAN::Frontend->myprint(
157 cpan shell -- CPAN exploration and modules installation (v%s)
164 unless $CPAN::Config->{'inhibit_startup_message'} ;
165 my($continuation) = "";
166 SHELLCOMMAND: while () {
167 if ($Suppress_readline) {
169 last SHELLCOMMAND unless defined ($_ = <> );
172 last SHELLCOMMAND unless
173 defined ($_ = $term->readline($prompt, $commandline));
175 $_ = "$continuation$_" if $continuation;
177 next SHELLCOMMAND if /^$/;
178 $_ = 'h' if /^\s*\?/;
179 if (/^(?:q(?:uit)?|bye|exit)$/i) {
190 use vars qw($import_done);
191 CPAN->import(':DEFAULT') unless $import_done++;
192 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
199 if ($] < 5.00322) { # parsewords had a bug until recently
202 eval { @line = Text::ParseWords::shellwords($_) };
203 warn($@), next SHELLCOMMAND if $@;
204 warn("Text::Parsewords could not parse the line [$_]"),
205 next SHELLCOMMAND unless @line;
207 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
208 my $command = shift @line;
209 eval { CPAN::Shell->$command(@line) };
211 if ($command =~ /^(make|test|install|force|notest)$/) {
212 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
214 soft_chdir_with_alternatives(\@cwd);
215 $CPAN::Frontend->myprint("\n");
217 $CPAN::CurrentCommandId++;
221 $commandline = ""; # I do want to be able to pass a default to
222 # shell, but on the second command I see no
225 CPAN::Queue->nullify_queue;
226 if ($try_detect_readline) {
227 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
229 $CPAN::META->has_inst("Term::ReadLine::Perl")
231 delete $INC{"Term/ReadLine.pm"};
233 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
234 require Term::ReadLine;
235 $CPAN::Frontend->myprint("\n$redef subroutines in ".
236 "Term::ReadLine redefined\n");
242 soft_chdir_with_alternatives(\@cwd);
245 sub soft_chdir_with_alternatives ($) {
247 while (not chdir $cwd->[0]) {
249 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
250 Trying to chdir to "$cwd->[1]" instead.
254 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
259 package CPAN::CacheMgr;
261 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
266 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
267 @CPAN::FTP::ISA = qw(CPAN::Debug);
269 package CPAN::LWP::UserAgent;
271 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
272 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
274 package CPAN::Complete;
276 @CPAN::Complete::ISA = qw(CPAN::Debug);
277 @CPAN::Complete::COMMANDS = sort qw(
278 ! a b d h i m o q r u
300 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
301 @CPAN::Index::ISA = qw(CPAN::Debug);
304 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
307 package CPAN::InfoObj;
309 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
311 package CPAN::Author;
313 @CPAN::Author::ISA = qw(CPAN::InfoObj);
315 package CPAN::Distribution;
317 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
319 package CPAN::Bundle;
321 @CPAN::Bundle::ISA = qw(CPAN::Module);
323 package CPAN::Module;
325 @CPAN::Module::ISA = qw(CPAN::InfoObj);
327 package CPAN::Exception::RecursiveDependency;
329 use overload '""' => "as_string";
336 for my $dep (@$deps) {
338 last if $seen{$dep}++;
340 bless { deps => \@deps }, $class;
345 "\nRecursive dependency detected:\n " .
346 join("\n => ", @{$self->{deps}}) .
347 ".\nCannot continue.\n";
350 package CPAN::Prompt; use overload '""' => "as_string";
351 our $prompt = "cpan> ";
352 $CPAN::CurrentCommandId ||= 0;
353 sub as_randomly_capitalized_string {
355 substr($prompt,$_,1)=rand()<0.5 ?
356 uc(substr($prompt,$_,1)) :
357 lc(substr($prompt,$_,1)) for 0..3;
364 if ($CPAN::Config->{commandnumber_in_prompt}) {
365 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
371 package CPAN::Distrostatus;
372 use overload '""' => "as_string",
375 my($class,$arg) = @_;
378 FAILED => substr($arg,0,2) eq "NO",
379 COMMANDID => $CPAN::CurrentCommandId,
382 sub commandid { shift->{COMMANDID} }
383 sub failed { shift->{FAILED} }
387 $self->{TEXT} = $set;
393 if (0) { # called from rematein during install?
402 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
403 @CPAN::Shell::ISA = qw(CPAN::Debug);
404 $COLOR_REGISTERED ||= 0;
405 $PRINT_ORNAMENTING ||= 0;
407 #-> sub CPAN::Shell::AUTOLOAD ;
409 my($autoload) = $AUTOLOAD;
410 my $class = shift(@_);
411 # warn "autoload[$autoload] class[$class]";
412 $autoload =~ s/.*:://;
413 if ($autoload =~ /^w/) {
414 if ($CPAN::META->has_inst('CPAN::WAIT')) {
415 CPAN::WAIT->$autoload(@_);
417 $CPAN::Frontend->mywarn(qq{
418 Commands starting with "w" require CPAN::WAIT to be installed.
419 Please consider installing CPAN::WAIT to use the fulltext index.
420 For this you just need to type
425 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload'. }.
434 # One use of the queue is to determine if we should or shouldn't
435 # announce the availability of a new CPAN module
437 # Now we try to use it for dependency tracking. For that to happen
438 # we need to draw a dependency tree and do the leaves first. This can
439 # easily be reached by running CPAN.pm recursively, but we don't want
440 # to waste memory and run into deep recursion. So what we can do is
443 # CPAN::Queue is the package where the queue is maintained. Dependencies
444 # often have high priority and must be brought to the head of the queue,
445 # possibly by jumping the queue if they are already there. My first code
446 # attempt tried to be extremely correct. Whenever a module needed
447 # immediate treatment, I either unshifted it to the front of the queue,
448 # or, if it was already in the queue, I spliced and let it bypass the
449 # others. This became a too correct model that made it impossible to put
450 # an item more than once into the queue. Why would you need that? Well,
451 # you need temporary duplicates as the manager of the queue is a loop
454 # (1) looks at the first item in the queue without shifting it off
456 # (2) cares for the item
458 # (3) removes the item from the queue, *even if its agenda failed and
459 # even if the item isn't the first in the queue anymore* (that way
460 # protecting against never ending queues)
462 # So if an item has prerequisites, the installation fails now, but we
463 # want to retry later. That's easy if we have it twice in the queue.
465 # I also expect insane dependency situations where an item gets more
466 # than two lives in the queue. Simplest example is triggered by 'install
467 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
468 # get in the way. I wanted the queue manager to be a dumb servant, not
469 # one that knows everything.
471 # Who would I tell in this model that the user wants to be asked before
472 # processing? I can't attach that information to the module object,
473 # because not modules are installed but distributions. So I'd have to
474 # tell the distribution object that it should ask the user before
475 # processing. Where would the question be triggered then? Most probably
476 # in CPAN::Distribution::rematein.
477 # Hope that makes sense, my head is a bit off:-) -- AK
484 my $self = bless { qmod => $s }, $class;
489 # CPAN::Queue::first ;
495 # CPAN::Queue::delete_first ;
497 my($class,$what) = @_;
499 for my $i (0..$#All) {
500 if ( $All[$i]->{qmod} eq $what ) {
507 # CPAN::Queue::jumpqueue ;
511 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
512 join(",",map {$_->{qmod}} @All),
515 WHAT: for my $what (reverse @what) {
517 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
518 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
519 if ($All[$i]->{qmod} eq $what){
521 if ($jumped > 100) { # one's OK if e.g. just
522 # processing now; more are OK if
523 # user typed it several times
524 $CPAN::Frontend->mywarn(
525 qq{Object [$what] queued more than 100 times, ignoring}
531 my $obj = bless { qmod => $what }, $class;
534 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
535 join(",",map {$_->{qmod}} @All),
540 # CPAN::Queue::exists ;
542 my($self,$what) = @_;
543 my @all = map { $_->{qmod} } @All;
544 my $exists = grep { $_->{qmod} eq $what } @All;
545 # warn "in exists what[$what] all[@all] exists[$exists]";
549 # CPAN::Queue::delete ;
552 @All = grep { $_->{qmod} ne $mod } @All;
555 # CPAN::Queue::nullify_queue ;
565 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
567 # from here on only subs.
568 ################################################################################
570 #-> sub CPAN::all_objects ;
572 my($mgr,$class) = @_;
573 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
574 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
576 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
578 *all = \&all_objects;
580 # Called by shell, not in batch mode. In batch mode I see no risk in
581 # having many processes updating something as installations are
582 # continually checked at runtime. In shell mode I suspect it is
583 # unintentional to open more than one shell at a time
585 #-> sub CPAN::checklock ;
588 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
589 if (-f $lockfile && -M _ > 0) {
590 my $fh = FileHandle->new($lockfile) or
591 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
592 my $otherpid = <$fh>;
593 my $otherhost = <$fh>;
595 if (defined $otherpid && $otherpid) {
598 if (defined $otherhost && $otherhost) {
601 my $thishost = hostname();
602 if (defined $otherhost && defined $thishost &&
603 $otherhost ne '' && $thishost ne '' &&
604 $otherhost ne $thishost) {
605 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
606 "reports other host $otherhost and other ".
607 "process $otherpid.\n".
608 "Cannot proceed.\n"));
610 elsif (defined $otherpid && $otherpid) {
611 return if $$ == $otherpid; # should never happen
612 $CPAN::Frontend->mywarn(
614 There seems to be running another CPAN process (pid $otherpid). Contacting...
616 if (kill 0, $otherpid) {
617 $CPAN::Frontend->mydie(qq{Other job is running.
618 You may want to kill it and delete the lockfile, maybe. On UNIX try:
622 } elsif (-w $lockfile) {
624 ExtUtils::MakeMaker::prompt
625 (qq{Other job not responding. Shall I overwrite }.
626 qq{the lockfile '$lockfile'? (Y/n)},"y");
627 $CPAN::Frontend->myexit("Ok, bye\n")
628 unless $ans =~ /^y/i;
631 qq{Lockfile '$lockfile' not writeable by you. }.
632 qq{Cannot proceed.\n}.
634 qq{ rm '$lockfile'\n}.
635 qq{ and then rerun us.\n}
639 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
640 "reports other process with ID ".
641 "$otherpid. Cannot proceed.\n"));
644 my $dotcpan = $CPAN::Config->{cpan_home};
645 eval { File::Path::mkpath($dotcpan);};
647 # A special case at least for Jarkko.
652 $symlinkcpan = readlink $dotcpan;
653 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
654 eval { File::Path::mkpath($symlinkcpan); };
658 $CPAN::Frontend->mywarn(qq{
659 Working directory $symlinkcpan created.
663 unless (-d $dotcpan) {
665 Your configuration suggests "$dotcpan" as your
666 CPAN.pm working directory. I could not create this directory due
667 to this error: $firsterror\n};
669 As "$dotcpan" is a symlink to "$symlinkcpan",
670 I tried to create that, but I failed with this error: $seconderror
673 Please make sure the directory exists and is writable.
675 $CPAN::Frontend->mydie($diemess);
677 } # $@ after eval mkpath $dotcpan
679 unless ($fh = FileHandle->new(">$lockfile")) {
680 if ($! =~ /Permission/) {
681 my $incc = $INC{'CPAN/Config.pm'};
682 my $myincc = File::Spec->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
683 $CPAN::Frontend->myprint(qq{
685 Your configuration suggests that CPAN.pm should use a working
687 $CPAN::Config->{cpan_home}
688 Unfortunately we could not create the lock file
690 due to permission problems.
692 Please make sure that the configuration variable
693 \$CPAN::Config->{cpan_home}
694 points to a directory where you can write a .lock file. You can set
695 this variable in either
700 if(!$INC{'CPAN/MyConfig.pm'}) {
701 $CPAN::Frontend->myprint("You don't seem to have a user ".
702 "configuration (MyConfig.pm) yet.\n");
703 my $new = ExtUtils::MakeMaker::prompt("Do you want to create a ".
704 "user configuration now? (Y/n)",
707 CPAN::Shell->mkmyconfig();
712 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
714 $fh->print($$, "\n");
715 $fh->print(hostname(), "\n");
716 $self->{LOCK} = $lockfile;
720 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
725 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
726 print "Caught SIGINT\n";
730 # From: Larry Wall <larry@wall.org>
731 # Subject: Re: deprecating SIGDIE
732 # To: perl5-porters@perl.org
733 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
735 # The original intent of __DIE__ was only to allow you to substitute one
736 # kind of death for another on an application-wide basis without respect
737 # to whether you were in an eval or not. As a global backstop, it should
738 # not be used any more lightly (or any more heavily :-) than class
739 # UNIVERSAL. Any attempt to build a general exception model on it should
740 # be politely squashed. Any bug that causes every eval {} to have to be
741 # modified should be not so politely squashed.
743 # Those are my current opinions. It is also my optinion that polite
744 # arguments degenerate to personal arguments far too frequently, and that
745 # when they do, it's because both people wanted it to, or at least didn't
746 # sufficiently want it not to.
750 # global backstop to cleanup if we should really die
751 $SIG{__DIE__} = \&cleanup;
752 $self->debug("Signal handler set.") if $CPAN::DEBUG;
755 #-> sub CPAN::DESTROY ;
757 &cleanup; # need an eval?
760 #-> sub CPAN::anycwd ;
763 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
768 sub cwd {Cwd::cwd();}
770 #-> sub CPAN::getcwd ;
771 sub getcwd {Cwd::getcwd();}
773 #-> sub CPAN::fastcwd ;
774 sub fastcwd {Cwd::fastcwd();}
776 #-> sub CPAN::backtickcwd ;
777 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
779 #-> sub CPAN::find_perl ;
781 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
782 my $pwd = $CPAN::iCwd = CPAN::anycwd();
783 my $candidate = File::Spec->catfile($pwd,$^X);
784 $perl ||= $candidate if MM->maybe_command($candidate);
787 my ($component,$perl_name);
788 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
789 PATH_COMPONENT: foreach $component (File::Spec->path(),
790 $Config::Config{'binexp'}) {
791 next unless defined($component) && $component;
792 my($abs) = File::Spec->catfile($component,$perl_name);
793 if (MM->maybe_command($abs)) {
805 #-> sub CPAN::exists ;
807 my($mgr,$class,$id) = @_;
808 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
810 ### Carp::croak "exists called without class argument" unless $class;
812 $id =~ s/:+/::/g if $class eq "CPAN::Module";
813 exists $META->{readonly}{$class}{$id} or
814 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
817 #-> sub CPAN::delete ;
819 my($mgr,$class,$id) = @_;
820 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
821 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
824 #-> sub CPAN::has_usable
825 # has_inst is sometimes too optimistic, we should replace it with this
826 # has_usable whenever a case is given
828 my($self,$mod,$message) = @_;
829 return 1 if $HAS_USABLE->{$mod};
830 my $has_inst = $self->has_inst($mod,$message);
831 return unless $has_inst;
834 LWP => [ # we frequently had "Can't locate object
835 # method "new" via package "LWP::UserAgent" at
836 # (eval 69) line 2006
838 sub {require LWP::UserAgent},
839 sub {require HTTP::Request},
840 sub {require URI::URL},
843 sub {require Net::FTP},
844 sub {require Net::Config},
847 if ($usable->{$mod}) {
848 for my $c (0..$#{$usable->{$mod}}) {
849 my $code = $usable->{$mod}[$c];
850 my $ret = eval { &$code() };
852 warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
857 return $HAS_USABLE->{$mod} = 1;
860 #-> sub CPAN::has_inst
862 my($self,$mod,$message) = @_;
863 Carp::croak("CPAN->has_inst() called without an argument")
865 if (defined $message && $message eq "no"
867 exists $CPAN::META->{dontload_hash}{$mod} # unsafe meta access, ok
869 exists $CPAN::Config->{dontload_hash}{$mod}
871 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
879 # checking %INC is wrong, because $INC{LWP} may be true
880 # although $INC{"URI/URL.pm"} may have failed. But as
881 # I really want to say "bla loaded OK", I have to somehow
883 ### warn "$file in %INC"; #debug
885 } elsif (eval { require $file }) {
886 # eval is good: if we haven't yet read the database it's
887 # perfect and if we have installed the module in the meantime,
888 # it tries again. The second require is only a NOOP returning
889 # 1 if we had success, otherwise it's retrying
891 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
892 if ($mod eq "CPAN::WAIT") {
893 push @CPAN::Shell::ISA, 'CPAN::WAIT';
896 } elsif ($mod eq "Net::FTP") {
897 $CPAN::Frontend->mywarn(qq{
898 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
900 install Bundle::libnet
902 }) unless $Have_warned->{"Net::FTP"}++;
904 } elsif ($mod eq "Digest::SHA"){
905 $CPAN::Frontend->myprint(qq{
906 CPAN: checksum security checks disabled because Digest::SHA not installed.
907 Please consider installing the Digest::SHA module.
911 } elsif ($mod eq "Module::Signature"){
912 unless ($Have_warned->{"Module::Signature"}++) {
913 # No point in complaining unless the user can
914 # reasonably install and use it.
915 if (eval { require Crypt::OpenPGP; 1 } ||
916 defined $CPAN::Config->{'gpg'}) {
917 $CPAN::Frontend->myprint(qq{
918 CPAN: Module::Signature security checks disabled because Module::Signature
919 not installed. Please consider installing the Module::Signature module.
920 You may also need to be able to connect over the Internet to the public
921 keyservers like pgp.mit.edu (port 11371).
928 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
933 #-> sub CPAN::instance ;
935 my($mgr,$class,$id) = @_;
938 # unsafe meta access, ok?
939 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
940 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
948 #-> sub CPAN::cleanup ;
950 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
951 local $SIG{__DIE__} = '';
956 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
958 $subroutine eq '(eval)';
960 return if $ineval && !$CPAN::End;
961 return unless defined $META->{LOCK};
962 return unless -f $META->{LOCK};
964 unlink $META->{LOCK};
966 # Carp::cluck("DEBUGGING");
967 $CPAN::Frontend->mywarn("Lockfile removed.\n");
970 #-> sub CPAN::savehist
973 my($histfile,$histsize);
974 unless ($histfile = $CPAN::Config->{'histfile'}){
975 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
978 $histsize = $CPAN::Config->{'histsize'} || 100;
980 unless ($CPAN::term->can("GetHistory")) {
981 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
987 my @h = $CPAN::term->GetHistory;
988 splice @h, 0, @h-$histsize if @h>$histsize;
989 my($fh) = FileHandle->new;
990 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
991 local $\ = local $, = "\n";
997 my($self,$what) = @_;
998 $self->{is_tested}{$what} = 1;
1002 my($self,$what) = @_;
1003 delete $self->{is_tested}{$what};
1008 $self->{is_tested} ||= {};
1009 return unless %{$self->{is_tested}};
1010 my $env = $ENV{PERL5LIB};
1011 $env = $ENV{PERLLIB} unless defined $env;
1013 push @env, $env if defined $env and length $env;
1014 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1015 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1016 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1019 package CPAN::CacheMgr;
1022 #-> sub CPAN::CacheMgr::as_string ;
1024 eval { require Data::Dumper };
1026 return shift->SUPER::as_string;
1028 return Data::Dumper::Dumper(shift);
1032 #-> sub CPAN::CacheMgr::cachesize ;
1037 #-> sub CPAN::CacheMgr::tidyup ;
1040 return unless -d $self->{ID};
1041 while ($self->{DU} > $self->{'MAX'} ) {
1042 my($toremove) = shift @{$self->{FIFO}};
1043 $CPAN::Frontend->myprint(sprintf(
1044 "Deleting from cache".
1045 ": $toremove (%.1f>%.1f MB)\n",
1046 $self->{DU}, $self->{'MAX'})
1048 return if $CPAN::Signal;
1049 $self->force_clean_cache($toremove);
1050 return if $CPAN::Signal;
1054 #-> sub CPAN::CacheMgr::dir ;
1059 #-> sub CPAN::CacheMgr::entries ;
1061 my($self,$dir) = @_;
1062 return unless defined $dir;
1063 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1064 $dir ||= $self->{ID};
1065 my($cwd) = CPAN::anycwd();
1066 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1067 my $dh = DirHandle->new(File::Spec->curdir)
1068 or Carp::croak("Couldn't opendir $dir: $!");
1071 next if $_ eq "." || $_ eq "..";
1073 push @entries, File::Spec->catfile($dir,$_);
1075 push @entries, File::Spec->catdir($dir,$_);
1077 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1080 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1081 sort { -M $b <=> -M $a} @entries;
1084 #-> sub CPAN::CacheMgr::disk_usage ;
1086 my($self,$dir) = @_;
1087 return if exists $self->{SIZE}{$dir};
1088 return if $CPAN::Signal;
1092 unless (chmod 0755, $dir) {
1093 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1094 "permission to change the permission; cannot ".
1095 "estimate disk usage of '$dir'\n");
1096 $CPAN::Frontend->mysleep(5);
1101 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1102 $CPAN::Frontend->mysleep(2);
1107 $File::Find::prune++ if $CPAN::Signal;
1109 if ($^O eq 'MacOS') {
1111 my $cat = Mac::Files::FSpGetCatInfo($_);
1112 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1116 unless (chmod 0755, $_) {
1117 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1118 "the permission to change the permission; ".
1119 "can only partially estimate disk usage ".
1132 return if $CPAN::Signal;
1133 $self->{SIZE}{$dir} = $Du/1024/1024;
1134 push @{$self->{FIFO}}, $dir;
1135 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1136 $self->{DU} += $Du/1024/1024;
1140 #-> sub CPAN::CacheMgr::force_clean_cache ;
1141 sub force_clean_cache {
1142 my($self,$dir) = @_;
1143 return unless -e $dir;
1144 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1146 File::Path::rmtree($dir);
1147 $self->{DU} -= $self->{SIZE}{$dir};
1148 delete $self->{SIZE}{$dir};
1151 #-> sub CPAN::CacheMgr::new ;
1158 ID => $CPAN::Config->{'build_dir'},
1159 MAX => $CPAN::Config->{'build_cache'},
1160 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1163 File::Path::mkpath($self->{ID});
1164 my $dh = DirHandle->new($self->{ID});
1165 bless $self, $class;
1168 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1170 CPAN->debug($debug) if $CPAN::DEBUG;
1174 #-> sub CPAN::CacheMgr::scan_cache ;
1177 return if $self->{SCAN} eq 'never';
1178 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1179 unless $self->{SCAN} eq 'atstart';
1180 $CPAN::Frontend->myprint(
1181 sprintf("Scanning cache %s for sizes\n",
1184 for $e ($self->entries($self->{ID})) {
1185 next if $e eq ".." || $e eq ".";
1186 $self->disk_usage($e);
1187 return if $CPAN::Signal;
1192 package CPAN::Shell;
1195 #-> sub CPAN::Shell::h ;
1197 my($class,$about) = @_;
1198 if (defined $about) {
1199 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1201 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1202 $CPAN::Frontend->myprint(qq{
1203 Display Information $filler (ver $CPAN::VERSION)
1204 command argument description
1205 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1206 i WORD or /REGEXP/ about any of the above
1207 r NONE report updatable modules
1208 ls AUTHOR or GLOB about files in the author's directory
1209 (with WORD being a module, bundle or author name or a distribution
1210 name of the form AUTHOR/DISTRIBUTION)
1212 Download, Test, Make, Install...
1213 get download clean make clean
1214 make make (implies get) look open subshell in dist directory
1215 test make test (implies make) readme display these README files
1216 install make install (implies test) perldoc display POD documentation
1219 force COMMAND unconditionally do command
1220 notest COMMAND skip testing
1223 h,? display this menu ! perl-code eval a perl command
1224 o conf [opt] set and query options q quit the cpan shell
1225 reload cpan load CPAN.pm again reload index load newer indices
1226 autobundle Snapshot recent latest CPAN uploads});
1232 #-> sub CPAN::Shell::a ;
1234 my($self,@arg) = @_;
1235 # authors are always UPPERCASE
1237 $_ = uc $_ unless /=/;
1239 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1242 #-> sub CPAN::Shell::globls ;
1244 my($self,$s,$pragmas) = @_;
1245 # ls is really very different, but we had it once as an ordinary
1246 # command in the Shell (upto rev. 321) and we could not handle
1248 my(@accept,@preexpand);
1249 if ($s =~ /[\*\?\/]/) {
1250 if ($CPAN::META->has_inst("Text::Glob")) {
1251 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1252 my $rau = Text::Glob::glob_to_regex(uc $au);
1253 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1255 push @preexpand, map { $_->id . "/" . $pathglob }
1256 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1258 my $rau = Text::Glob::glob_to_regex(uc $s);
1259 push @preexpand, map { $_->id }
1260 CPAN::Shell->expand_by_method('CPAN::Author',
1265 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1268 push @preexpand, uc $s;
1271 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1272 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1277 my $silent = @accept>1;
1278 my $last_alpha = "";
1280 for my $a (@accept){
1281 my($author,$pathglob);
1282 if ($a =~ m|(.*?)/(.*)|) {
1285 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1287 $a2) or die "No author found for $a2";
1289 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1291 $a) or die "No author found for $a";
1294 my $alpha = substr $author->id, 0, 1;
1296 if ($alpha eq $last_alpha) {
1300 $last_alpha = $alpha;
1302 $CPAN::Frontend->myprint($ad);
1304 for my $pragma (@$pragmas) {
1305 if ($author->can($pragma)) {
1309 push @results, $author->ls($pathglob,$silent); # silent if
1312 for my $pragma (@$pragmas) {
1313 my $meth = "un$pragma";
1314 if ($author->can($meth)) {
1322 #-> sub CPAN::Shell::local_bundles ;
1324 my($self,@which) = @_;
1325 my($incdir,$bdir,$dh);
1326 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1327 my @bbase = "Bundle";
1328 while (my $bbase = shift @bbase) {
1329 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1330 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1331 if ($dh = DirHandle->new($bdir)) { # may fail
1333 for $entry ($dh->read) {
1334 next if $entry =~ /^\./;
1335 if (-d File::Spec->catdir($bdir,$entry)){
1336 push @bbase, "$bbase\::$entry";
1338 next unless $entry =~ s/\.pm(?!\n)\Z//;
1339 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1347 #-> sub CPAN::Shell::b ;
1349 my($self,@which) = @_;
1350 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1351 $self->local_bundles;
1352 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1355 #-> sub CPAN::Shell::d ;
1356 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1358 #-> sub CPAN::Shell::m ;
1359 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1361 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1364 #-> sub CPAN::Shell::i ;
1368 @args = '/./' unless @args;
1370 for my $type (qw/Bundle Distribution Module/) {
1371 push @result, $self->expand($type,@args);
1373 # Authors are always uppercase.
1374 push @result, $self->expand("Author", map { uc $_ } @args);
1376 my $result = @result == 1 ?
1377 $result[0]->as_string :
1379 "No objects found of any type for argument @args\n" :
1381 (map {$_->as_glimpse} @result),
1382 scalar @result, " items found\n",
1384 $CPAN::Frontend->myprint($result);
1387 #-> sub CPAN::Shell::o ;
1389 # CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf'
1390 # should have been called set and 'o debug' maybe 'set debug'
1392 my($self,$o_type,@o_what) = @_;
1395 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1396 if ($o_type eq 'conf') {
1397 shift @o_what if @o_what && $o_what[0] eq 'help';
1398 if (!@o_what) { # print all things, "o conf"
1400 $CPAN::Frontend->myprint("CPAN::Config options");
1401 if (exists $INC{'CPAN/Config.pm'}) {
1402 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1404 if (exists $INC{'CPAN/MyConfig.pm'}) {
1405 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1407 $CPAN::Frontend->myprint(":\n");
1408 for $k (sort keys %CPAN::HandleConfig::can) {
1409 $v = $CPAN::HandleConfig::can{$k};
1410 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1412 $CPAN::Frontend->myprint("\n");
1413 for $k (sort keys %$CPAN::Config) {
1414 CPAN::HandleConfig->prettyprint($k);
1416 $CPAN::Frontend->myprint("\n");
1417 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1418 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1421 } elsif ($o_type eq 'debug') {
1423 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1426 my($what) = shift @o_what;
1427 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1428 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1431 if ( exists $CPAN::DEBUG{$what} ) {
1432 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1433 } elsif ($what =~ /^\d/) {
1434 $CPAN::DEBUG = $what;
1435 } elsif (lc $what eq 'all') {
1437 for (values %CPAN::DEBUG) {
1440 $CPAN::DEBUG = $max;
1443 for (keys %CPAN::DEBUG) {
1444 next unless lc($_) eq lc($what);
1445 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1448 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1453 my $raw = "Valid options for debug are ".
1454 join(", ",sort(keys %CPAN::DEBUG), 'all').
1455 qq{ or a number. Completion works on the options. }.
1456 qq{Case is ignored.};
1458 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1459 $CPAN::Frontend->myprint("\n\n");
1462 $CPAN::Frontend->myprint("Options set for debugging:\n");
1464 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1465 $v = $CPAN::DEBUG{$k};
1466 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1467 if $v & $CPAN::DEBUG;
1470 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1473 $CPAN::Frontend->myprint(qq{
1475 conf set or get configuration variables
1476 debug set or get debugging options
1481 sub paintdots_onreload {
1484 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1488 # $CPAN::Frontend->myprint(".($subr)");
1489 $CPAN::Frontend->myprint(".");
1496 #-> sub CPAN::Shell::reload ;
1498 my($self,$command,@arg) = @_;
1500 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1501 if ($command =~ /cpan/i) {
1503 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1505 MFILE: for my $f (qw(CPAN.pm CPAN/HandleConfig.pm CPAN/FirstTime.pm CPAN/Tarzip.pm
1506 CPAN/Debug.pm CPAN/Version.pm)) {
1507 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1508 $self->reload_this($f) or $failed++;
1510 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1511 $failed++ unless $redef;
1513 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1516 } elsif ($command =~ /index/) {
1517 CPAN::Index->force_reload;
1519 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1520 index re-reads the index files\n});
1526 return 1 unless $INC{$f};
1527 my $pwd = CPAN::anycwd();
1528 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1531 for my $inc (@INC) {
1532 $read = File::Spec->catfile($inc,split /\//, $f);
1539 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1542 my $fh = FileHandle->new($read) or
1543 $CPAN::Frontend->mydie("Could not open $read: $!");
1547 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1557 #-> sub CPAN::Shell::mkmyconfig ;
1559 my($self, $cpanpm, %args) = @_;
1560 require CPAN::FirstTime;
1561 $cpanpm = $INC{'CPAN/MyConfig.pm'} || "$ENV{HOME}/.cpan/CPAN/MyConfig.pm";
1562 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1563 if(!$INC{'CPAN/Config.pm'}) {
1564 eval { require CPAN::Config; };
1566 $CPAN::Config ||= {};
1571 keep_source_where => undef,
1574 CPAN::FirstTime::init($cpanpm, %args);
1577 #-> sub CPAN::Shell::_binary_extensions ;
1578 sub _binary_extensions {
1579 my($self) = shift @_;
1580 my(@result,$module,%seen,%need,$headerdone);
1581 for $module ($self->expand('Module','/./')) {
1582 my $file = $module->cpan_file;
1583 next if $file eq "N/A";
1584 next if $file =~ /^Contact Author/;
1585 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1586 next if $dist->isa_perl;
1587 next unless $module->xs_file;
1589 $CPAN::Frontend->myprint(".");
1590 push @result, $module;
1592 # print join " | ", @result;
1593 $CPAN::Frontend->myprint("\n");
1597 #-> sub CPAN::Shell::recompile ;
1599 my($self) = shift @_;
1600 my($module,@module,$cpan_file,%dist);
1601 @module = $self->_binary_extensions();
1602 for $module (@module){ # we force now and compile later, so we
1604 $cpan_file = $module->cpan_file;
1605 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1607 $dist{$cpan_file}++;
1609 for $cpan_file (sort keys %dist) {
1610 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1611 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1613 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1614 # stop a package from recompiling,
1615 # e.g. IO-1.12 when we have perl5.003_10
1619 #-> sub CPAN::Shell::_u_r_common ;
1621 my($self) = shift @_;
1622 my($what) = shift @_;
1623 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1624 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1625 $what && $what =~ /^[aru]$/;
1627 @args = '/./' unless @args;
1628 my(@result,$module,%seen,%need,$headerdone,
1629 $version_undefs,$version_zeroes);
1630 $version_undefs = $version_zeroes = 0;
1631 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1632 my @expand = $self->expand('Module',@args);
1633 my $expand = scalar @expand;
1634 if (0) { # Looks like noise to me, was very useful for debugging
1635 # for metadata cache
1636 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1638 MODULE: for $module (@expand) {
1639 my $file = $module->cpan_file;
1640 next MODULE unless defined $file; # ??
1641 $file =~ s|^./../||;
1642 my($latest) = $module->cpan_version;
1643 my($inst_file) = $module->inst_file;
1645 return if $CPAN::Signal;
1648 $have = $module->inst_version;
1649 } elsif ($what eq "r") {
1650 $have = $module->inst_version;
1652 if ($have eq "undef"){
1654 } elsif ($have == 0){
1657 next MODULE unless CPAN::Version->vgt($latest, $have);
1658 # to be pedantic we should probably say:
1659 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1660 # to catch the case where CPAN has a version 0 and we have a version undef
1661 } elsif ($what eq "u") {
1667 } elsif ($what eq "r") {
1669 } elsif ($what eq "u") {
1673 return if $CPAN::Signal; # this is sometimes lengthy
1676 push @result, sprintf "%s %s\n", $module->id, $have;
1677 } elsif ($what eq "r") {
1678 push @result, $module->id;
1679 next MODULE if $seen{$file}++;
1680 } elsif ($what eq "u") {
1681 push @result, $module->id;
1682 next MODULE if $seen{$file}++;
1683 next MODULE if $file =~ /^Contact/;
1685 unless ($headerdone++){
1686 $CPAN::Frontend->myprint("\n");
1687 $CPAN::Frontend->myprint(sprintf(
1690 "Package namespace",
1702 $CPAN::META->has_inst("Term::ANSIColor")
1704 $module->description
1706 $color_on = Term::ANSIColor::color("green");
1707 $color_off = Term::ANSIColor::color("reset");
1709 $CPAN::Frontend->myprint(sprintf $sprintf,
1716 $need{$module->id}++;
1720 $CPAN::Frontend->myprint("No modules found for @args\n");
1721 } elsif ($what eq "r") {
1722 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1726 if ($version_zeroes) {
1727 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1728 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1729 qq{a version number of 0\n});
1731 if ($version_undefs) {
1732 my $s_has = $version_undefs > 1 ? "s have" : " has";
1733 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1734 qq{parseable version number\n});
1740 #-> sub CPAN::Shell::r ;
1742 shift->_u_r_common("r",@_);
1745 #-> sub CPAN::Shell::u ;
1747 shift->_u_r_common("u",@_);
1750 #-> sub CPAN::Shell::failed ;
1752 my($self,$only_id,$silent) = @_;
1754 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1756 for my $nosayer (qw(signature_verify make make_test install)) {
1757 next unless exists $d->{$nosayer};
1759 $d->{$nosayer}->can("failed") ?
1760 $d->{$nosayer}->failed :
1761 $d->{$nosayer} =~ /^NO/
1766 next DIST unless $failed;
1767 next DIST if $only_id && $only_id != (
1768 $d->{$failed}->can("commandid")
1770 $d->{$failed}->commandid
1772 $CPAN::CurrentCommandId
1777 # " %-45s: %s %s\n",
1780 $d->{$failed}->can("failed") ?
1782 $d->{$failed}->commandid,
1785 $d->{$failed}->text,
1795 my $scope = $only_id ? "command" : "session";
1797 my $print = join "",
1798 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1799 sort { $a->[0] <=> $b->[0] } @failed;
1800 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1801 } elsif (!$only_id || !$silent) {
1802 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1806 # XXX intentionally undocumented because completely bogus, unportable,
1809 #-> sub CPAN::Shell::status ;
1812 require Devel::Size;
1813 my $ps = FileHandle->new;
1814 open $ps, "/proc/$$/status";
1817 next unless /VmSize:\s+(\d+)/;
1821 $CPAN::Frontend->mywarn(sprintf(
1822 "%-27s %6d\n%-27s %6d\n",
1826 Devel::Size::total_size($CPAN::META)/1024,
1828 for my $k (sort keys %$CPAN::META) {
1829 next unless substr($k,0,4) eq "read";
1830 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
1831 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
1832 warn sprintf " %-25s %6d %6d\n",
1834 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
1835 scalar keys %{$CPAN::META->{$k}{$k2}};
1840 #-> sub CPAN::Shell::autobundle ;
1843 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1844 my(@bundle) = $self->_u_r_common("a",@_);
1845 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1846 File::Path::mkpath($todir);
1847 unless (-d $todir) {
1848 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1851 my($y,$m,$d) = (localtime)[5,4,3];
1855 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1856 my($to) = File::Spec->catfile($todir,"$me.pm");
1858 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1859 $to = File::Spec->catfile($todir,"$me.pm");
1861 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1863 "package Bundle::$me;\n\n",
1864 "\$VERSION = '0.01';\n\n",
1868 "Bundle::$me - Snapshot of installation on ",
1869 $Config::Config{'myhostname'},
1872 "\n\n=head1 SYNOPSIS\n\n",
1873 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1874 "=head1 CONTENTS\n\n",
1875 join("\n", @bundle),
1876 "\n\n=head1 CONFIGURATION\n\n",
1878 "\n\n=head1 AUTHOR\n\n",
1879 "This Bundle has been generated automatically ",
1880 "by the autobundle routine in CPAN.pm.\n",
1883 $CPAN::Frontend->myprint("\nWrote bundle file
1887 #-> sub CPAN::Shell::expandany ;
1890 CPAN->debug("s[$s]") if $CPAN::DEBUG;
1891 if ($s =~ m|/|) { # looks like a file
1892 $s = CPAN::Distribution->normalize($s);
1893 return $CPAN::META->instance('CPAN::Distribution',$s);
1894 # Distributions spring into existence, not expand
1895 } elsif ($s =~ m|^Bundle::|) {
1896 $self->local_bundles; # scanning so late for bundles seems
1897 # both attractive and crumpy: always
1898 # current state but easy to forget
1900 return $self->expand('Bundle',$s);
1902 return $self->expand('Module',$s)
1903 if $CPAN::META->exists('CPAN::Module',$s);
1908 #-> sub CPAN::Shell::expand ;
1911 my($type,@args) = @_;
1912 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
1913 my $class = "CPAN::$type";
1914 my $methods = ['id'];
1915 for my $meth (qw(name)) {
1916 next if $] < 5.00303; # no "can"
1917 next unless $class->can($meth);
1918 push @$methods, $meth;
1920 $self->expand_by_method($class,$methods,@args);
1923 sub expand_by_method {
1925 my($class,$methods,@args) = @_;
1928 my($regex,$command);
1929 if ($arg =~ m|^/(.*)/$|) {
1931 } elsif ($arg =~ m/=/) {
1935 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
1937 defined $regex ? $regex : "UNDEFINED",
1938 defined $command ? $command : "UNDEFINED",
1940 if (defined $regex) {
1942 $CPAN::META->all_objects($class)
1945 # BUG, we got an empty object somewhere
1946 require Data::Dumper;
1947 CPAN->debug(sprintf(
1948 "Bug in CPAN: Empty id on obj[%s][%s]",
1950 Data::Dumper::Dumper($obj)
1954 for my $method (@$methods) {
1955 if ($obj->$method() =~ /$regex/i) {
1961 } elsif ($command) {
1962 die "equal sign in command disabled (immature interface), ".
1964 ! \$CPAN::Shell::ADVANCED_QUERY=1
1965 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
1966 that may go away anytime.\n"
1967 unless $ADVANCED_QUERY;
1968 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
1969 my($matchcrit) = $criterion =~ m/^~(.+)/;
1973 $CPAN::META->all_objects($class)
1975 my $lhs = $self->$method() or next; # () for 5.00503
1977 push @m, $self if $lhs =~ m/$matchcrit/;
1979 push @m, $self if $lhs eq $criterion;
1984 if ( $class eq 'CPAN::Bundle' ) {
1985 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1986 } elsif ($class eq "CPAN::Distribution") {
1987 $xarg = CPAN::Distribution->normalize($arg);
1991 if ($CPAN::META->exists($class,$xarg)) {
1992 $obj = $CPAN::META->instance($class,$xarg);
1993 } elsif ($CPAN::META->exists($class,$arg)) {
1994 $obj = $CPAN::META->instance($class,$arg);
2001 @m = sort {$a->id cmp $b->id} @m;
2002 if ( $CPAN::DEBUG ) {
2003 my $wantarray = wantarray;
2004 my $join_m = join ",", map {$_->id} @m;
2005 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2007 return wantarray ? @m : $m[0];
2010 #-> sub CPAN::Shell::format_result ;
2013 my($type,@args) = @_;
2014 @args = '/./' unless @args;
2015 my(@result) = $self->expand($type,@args);
2016 my $result = @result == 1 ?
2017 $result[0]->as_string :
2019 "No objects of type $type found for argument @args\n" :
2021 (map {$_->as_glimpse} @result),
2022 scalar @result, " items found\n",
2027 #-> sub CPAN::Shell::report_fh ;
2029 my $installation_report_fh;
2030 my $previously_noticed = 0;
2033 return $installation_report_fh if $installation_report_fh;
2034 $installation_report_fh = File::Temp->new(
2035 template => 'cpan_install_XXXX',
2039 unless ( $installation_report_fh ) {
2040 warn("Couldn't open installation report file; " .
2041 "no report file will be generated."
2042 ) unless $previously_noticed++;
2048 # The only reason for this method is currently to have a reliable
2049 # debugging utility that reveals which output is going through which
2050 # channel. No, I don't like the colors ;-)
2052 #-> sub CPAN::Shell::print_ornameted ;
2053 sub print_ornamented {
2054 my($self,$what,$ornament) = @_;
2056 return unless defined $what;
2058 local $| = 1; # Flush immediately
2059 if ( $CPAN::Be_Silent ) {
2060 print {report_fh()} $what;
2064 if ($CPAN::Config->{term_is_latin}){
2067 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2069 if ($PRINT_ORNAMENTING) {
2070 unless (defined &color) {
2071 if ($CPAN::META->has_inst("Term::ANSIColor")) {
2072 import Term::ANSIColor "color";
2074 *color = sub { return "" };
2078 for $line (split /\n/, $what) {
2079 $longest = length($line) if length($line) > $longest;
2081 my $sprintf = "%-" . $longest . "s";
2083 $what =~ s/(.*\n?)//m;
2086 my($nl) = chomp $line ? "\n" : "";
2087 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
2088 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
2092 # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
2098 my($self,$what) = @_;
2100 $self->print_ornamented($what, 'bold blue on_yellow');
2104 my($self,$what) = @_;
2105 $self->myprint($what);
2110 my($self,$what) = @_;
2111 $self->print_ornamented($what, 'bold red on_yellow');
2115 my($self,$what) = @_;
2116 $self->print_ornamented($what, 'bold red on_white');
2117 Carp::confess "died";
2121 my($self,$what) = @_;
2122 $self->print_ornamented($what, 'bold red on_white');
2126 # use this only for unrecoverable errors!
2127 sub unrecoverable_error {
2128 my($self,$what) = @_;
2129 my @lines = split /\n/, $what;
2131 for my $l (@lines) {
2132 $longest = length $l if length $l > $longest;
2134 $longest = 62 if $longest > 62;
2135 for my $l (@lines) {
2141 if (length $l < 66) {
2142 $l = pack "A66 A*", $l, "<==";
2146 unshift @lines, "\n";
2147 $self->mydie(join "", @lines);
2152 my($self, $sleep) = @_;
2157 return if -t STDOUT;
2158 my $odef = select STDERR;
2165 #-> sub CPAN::Shell::rematein ;
2166 # RE-adme||MA-ke||TE-st||IN-stall
2169 my($meth,@some) = @_;
2171 while($meth =~ /^(force|notest)$/) {
2172 push @pragma, $meth;
2173 $meth = shift @some or
2174 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2178 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2180 # Here is the place to set "test_count" on all involved parties to
2181 # 0. We then can pass this counter on to the involved
2182 # distributions and those can refuse to test if test_count > X. In
2183 # the first stab at it we could use a 1 for "X".
2185 # But when do I reset the distributions to start with 0 again?
2186 # Jost suggested to have a random or cycling interaction ID that
2187 # we pass through. But the ID is something that is just left lying
2188 # around in addition to the counter, so I'd prefer to set the
2189 # counter to 0 now, and repeat at the end of the loop. But what
2190 # about dependencies? They appear later and are not reset, they
2191 # enter the queue but not its copy. How do they get a sensible
2194 # construct the queue
2196 STHING: foreach $s (@some) {
2199 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2201 } elsif ($s =~ m|^/|) { # looks like a regexp
2202 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2206 } elsif ($meth eq "ls") {
2207 $self->globls($s,\@pragma);
2210 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2211 $obj = CPAN::Shell->expandany($s);
2214 $obj->color_cmd_tmps(0,1);
2215 CPAN::Queue->new($obj->id);
2217 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2218 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2219 if ($meth =~ /^(dump|ls)$/) {
2222 $CPAN::Frontend->myprint(
2224 "Don't be silly, you can't $meth ",
2232 ->myprint(qq{Warning: Cannot $meth $s, }.
2233 qq{don\'t know what it is.
2238 to find objects with matching identifiers.
2244 # queuerunner (please be warned: when I started to change the
2245 # queue to hold objects instead of names, I made one or two
2246 # mistakes and never found which. I reverted back instead)
2247 while ($s = CPAN::Queue->first) {
2250 $obj = $s; # I do not believe, we would survive if this happened
2252 $obj = CPAN::Shell->expandany($s);
2254 for my $pragma (@pragma) {
2257 ($] < 5.00303 || $obj->can($pragma))){
2258 ### compatibility with 5.003
2259 $obj->$pragma($meth); # the pragma "force" in
2260 # "CPAN::Distribution" must know
2261 # what we are intending
2264 if ($]>=5.00303 && $obj->can('called_for')) {
2265 $obj->called_for($s);
2268 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string\[}.
2274 CPAN::Queue->delete($s);
2276 CPAN->debug("failed");
2280 CPAN::Queue->delete_first($s);
2282 for my $obj (@qcopy) {
2283 $obj->color_cmd_tmps(0,0);
2284 delete $obj->{incommandcolor};
2288 #-> sub CPAN::Shell::recent ;
2292 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2297 # set up the dispatching methods
2299 for my $command (qw(
2314 *$command = sub { shift->rematein($command, @_); };
2318 package CPAN::LWP::UserAgent;
2322 return if $SETUPDONE;
2323 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2324 require LWP::UserAgent;
2325 @ISA = qw(Exporter LWP::UserAgent);
2328 $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
2332 sub get_basic_credentials {
2333 my($self, $realm, $uri, $proxy) = @_;
2334 return unless $proxy;
2335 if ($USER && $PASSWD) {
2336 } elsif (defined $CPAN::Config->{proxy_user} &&
2337 defined $CPAN::Config->{proxy_pass}) {
2338 $USER = $CPAN::Config->{proxy_user};
2339 $PASSWD = $CPAN::Config->{proxy_pass};
2341 require ExtUtils::MakeMaker;
2342 ExtUtils::MakeMaker->import(qw(prompt));
2343 $USER = prompt("Proxy authentication needed!
2344 (Note: to permanently configure username and password run
2345 o conf proxy_user your_username
2346 o conf proxy_pass your_password
2348 if ($CPAN::META->has_inst("Term::ReadKey")) {
2349 Term::ReadKey::ReadMode("noecho");
2351 $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n");
2353 $PASSWD = prompt("Password:");
2354 if ($CPAN::META->has_inst("Term::ReadKey")) {
2355 Term::ReadKey::ReadMode("restore");
2357 $CPAN::Frontend->myprint("\n\n");
2359 return($USER,$PASSWD);
2362 # mirror(): Its purpose is to deal with proxy authentication. When we
2363 # call SUPER::mirror, we relly call the mirror method in
2364 # LWP::UserAgent. LWP::UserAgent will then call
2365 # $self->get_basic_credentials or some equivalent and this will be
2366 # $self->dispatched to our own get_basic_credentials method.
2368 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2370 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2371 # although we have gone through our get_basic_credentials, the proxy
2372 # server refuses to connect. This could be a case where the username or
2373 # password has changed in the meantime, so I'm trying once again without
2374 # $USER and $PASSWD to give the get_basic_credentials routine another
2375 # chance to set $USER and $PASSWD.
2377 # mirror(): Its purpose is to deal with proxy authentication. When we
2378 # call SUPER::mirror, we relly call the mirror method in
2379 # LWP::UserAgent. LWP::UserAgent will then call
2380 # $self->get_basic_credentials or some equivalent and this will be
2381 # $self->dispatched to our own get_basic_credentials method.
2383 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2385 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2386 # although we have gone through our get_basic_credentials, the proxy
2387 # server refuses to connect. This could be a case where the username or
2388 # password has changed in the meantime, so I'm trying once again without
2389 # $USER and $PASSWD to give the get_basic_credentials routine another
2390 # chance to set $USER and $PASSWD.
2393 my($self,$url,$aslocal) = @_;
2394 my $result = $self->SUPER::mirror($url,$aslocal);
2395 if ($result->code == 407) {
2398 $result = $self->SUPER::mirror($url,$aslocal);
2406 #-> sub CPAN::FTP::ftp_get ;
2408 my($class,$host,$dir,$file,$target) = @_;
2410 qq[Going to fetch file [$file] from dir [$dir]
2411 on host [$host] as local [$target]\n]
2413 my $ftp = Net::FTP->new($host);
2415 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2418 return 0 unless defined $ftp;
2419 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2420 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2421 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2422 my $msg = $ftp->message;
2423 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2426 unless ( $ftp->cwd($dir) ){
2427 my $msg = $ftp->message;
2428 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2432 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2433 unless ( $ftp->get($file,$target) ){
2434 my $msg = $ftp->message;
2435 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2438 $ftp->quit; # it's ok if this fails
2442 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2444 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2445 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2447 # > *** 1562,1567 ****
2448 # > --- 1562,1580 ----
2449 # > return 1 if substr($url,0,4) eq "file";
2450 # > return 1 unless $url =~ m|://([^/]+)|;
2452 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2454 # > + $proxy =~ m|://([^/:]+)|;
2456 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2457 # > + if ($noproxy) {
2458 # > + if ($host !~ /$noproxy$/) {
2459 # > + $host = $proxy;
2462 # > + $host = $proxy;
2465 # > require Net::Ping;
2466 # > return 1 unless $Net::Ping::VERSION >= 2;
2470 #-> sub CPAN::FTP::localize ;
2472 my($self,$file,$aslocal,$force) = @_;
2474 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2475 unless defined $aslocal;
2476 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2479 if ($^O eq 'MacOS') {
2480 # Comment by AK on 2000-09-03: Uniq short filenames would be
2481 # available in CHECKSUMS file
2482 my($name, $path) = File::Basename::fileparse($aslocal, '');
2483 if (length($name) > 31) {
2494 my $size = 31 - length($suf);
2495 while (length($name) > $size) {
2499 $aslocal = File::Spec->catfile($path, $name);
2503 if (-f $aslocal && -r _ && !($force & 1)){
2507 # empty file from a previous unsuccessful attempt to download it
2509 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I could not remove.");
2514 rename $aslocal, "$aslocal.bak";
2518 my($aslocal_dir) = File::Basename::dirname($aslocal);
2519 File::Path::mkpath($aslocal_dir);
2520 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2521 qq{directory "$aslocal_dir".
2522 I\'ll continue, but if you encounter problems, they may be due
2523 to insufficient permissions.\n}) unless -w $aslocal_dir;
2525 # Inheritance is not easier to manage than a few if/else branches
2526 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2528 CPAN::LWP::UserAgent->config;
2529 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2531 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2535 $Ua->proxy('ftp', $var)
2536 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2537 $Ua->proxy('http', $var)
2538 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2541 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2543 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2544 # > use ones that require basic autorization.
2546 # > Example of when I use it manually in my own stuff:
2548 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2549 # > $req->proxy_authorization_basic("username","password");
2550 # > $res = $ua->request($req);
2554 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2558 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2559 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2562 # Try the list of urls for each single object. We keep a record
2563 # where we did get a file from
2564 my(@reordered,$last);
2565 $CPAN::Config->{urllist} ||= [];
2566 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2567 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2568 $CPAN::Config->{urllist} = [];
2570 $last = $#{$CPAN::Config->{urllist}};
2571 if ($force & 2) { # local cpans probably out of date, don't reorder
2572 @reordered = (0..$last);
2576 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2578 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2580 defined($ThesiteURL)
2582 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2584 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2589 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2591 @levels = qw/easy hard hardest/;
2593 @levels = qw/easy/ if $^O eq 'MacOS';
2595 local $ENV{FTP_PASSIVE} = $CPAN::Config->{ftp_passive} if exists $CPAN::Config->{ftp_passive};
2596 for $levelno (0..$#levels) {
2597 my $level = $levels[$levelno];
2598 my $method = "host$level";
2599 my @host_seq = $level eq "easy" ?
2600 @reordered : 0..$last; # reordered has CDROM up front
2601 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2602 for my $u (@urllist) {
2603 $u .= "/" unless substr($u,-1) eq "/";
2605 for my $u (@CPAN::Defaultsites) {
2606 push @urllist, $u unless grep { $_ eq $u } @urllist;
2608 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2609 my $ret = $self->$method(\@urllist,$file,$aslocal);
2611 $Themethod = $level;
2613 # utime $now, $now, $aslocal; # too bad, if we do that, we
2614 # might alter a local mirror
2615 $self->debug("level[$level]") if $CPAN::DEBUG;
2619 last if $CPAN::Signal; # need to cleanup
2622 unless ($CPAN::Signal) {
2625 qq{Please check, if the URLs I found in your configuration file \(}.
2626 join(", ", @{$CPAN::Config->{urllist}}).
2627 qq{\) are valid. The urllist can be edited.},
2628 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2629 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2631 $CPAN::Frontend->myprint("Could not fetch $file\n");
2634 rename "$aslocal.bak", $aslocal;
2635 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2636 $self->ls($aslocal));
2642 # package CPAN::FTP;
2644 my($self,$host_seq,$file,$aslocal) = @_;
2646 HOSTEASY: for $ro_url (@$host_seq) {
2647 my $url .= "$ro_url$file";
2648 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2649 if ($url =~ /^file:/) {
2651 if ($CPAN::META->has_inst('URI::URL')) {
2652 my $u = URI::URL->new($url);
2654 } else { # works only on Unix, is poorly constructed, but
2655 # hopefully better than nothing.
2656 # RFC 1738 says fileurl BNF is
2657 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2658 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2660 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2661 $l =~ s|^file:||; # assume they
2664 $l =~ s|^/||s unless -f $l; # e.g. /P:
2665 $self->debug("without URI::URL we try local file $l") if $CPAN::DEBUG;
2667 if ( -f $l && -r _) {
2668 $ThesiteURL = $ro_url;
2671 # Maybe mirror has compressed it?
2673 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2674 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2676 $ThesiteURL = $ro_url;
2681 if ($CPAN::META->has_usable('LWP')) {
2682 $CPAN::Frontend->myprint("Fetching with LWP:
2686 CPAN::LWP::UserAgent->config;
2687 eval { $Ua = CPAN::LWP::UserAgent->new; };
2689 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2692 my $res = $Ua->mirror($url, $aslocal);
2693 if ($res->is_success) {
2694 $ThesiteURL = $ro_url;
2696 utime $now, $now, $aslocal; # download time is more
2697 # important than upload time
2699 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2700 my $gzurl = "$url.gz";
2701 $CPAN::Frontend->myprint("Fetching with LWP:
2704 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2705 if ($res->is_success &&
2706 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
2708 $ThesiteURL = $ro_url;
2712 $CPAN::Frontend->myprint(sprintf(
2713 "LWP failed with code[%s] message[%s]\n",
2717 # Alan Burlison informed me that in firewall environments
2718 # Net::FTP can still succeed where LWP fails. So we do not
2719 # skip Net::FTP anymore when LWP is available.
2722 $CPAN::Frontend->myprint("LWP not available\n");
2724 return if $CPAN::Signal;
2725 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2726 # that's the nice and easy way thanks to Graham
2727 my($host,$dir,$getfile) = ($1,$2,$3);
2728 if ($CPAN::META->has_usable('Net::FTP')) {
2730 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2733 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2734 "aslocal[$aslocal]") if $CPAN::DEBUG;
2735 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2736 $ThesiteURL = $ro_url;
2739 if ($aslocal !~ /\.gz(?!\n)\Z/) {
2740 my $gz = "$aslocal.gz";
2741 $CPAN::Frontend->myprint("Fetching with Net::FTP
2744 if (CPAN::FTP->ftp_get($host,
2748 CPAN::Tarzip->new($gz)->gunzip($aslocal)
2750 $ThesiteURL = $ro_url;
2757 return if $CPAN::Signal;
2761 # package CPAN::FTP;
2763 my($self,$host_seq,$file,$aslocal) = @_;
2765 # Came back if Net::FTP couldn't establish connection (or
2766 # failed otherwise) Maybe they are behind a firewall, but they
2767 # gave us a socksified (or other) ftp program...
2770 my($devnull) = $CPAN::Config->{devnull} || "";
2772 my($aslocal_dir) = File::Basename::dirname($aslocal);
2773 File::Path::mkpath($aslocal_dir);
2774 HOSTHARD: for $ro_url (@$host_seq) {
2775 my $url = "$ro_url$file";
2776 my($proto,$host,$dir,$getfile);
2778 # Courtesy Mark Conty mark_conty@cargill.com change from
2779 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2781 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2782 # proto not yet used
2783 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2785 next HOSTHARD; # who said, we could ftp anything except ftp?
2787 next HOSTHARD if $proto eq "file"; # file URLs would have had
2788 # success above. Likely a bogus URL
2790 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2792 # Try the most capable first and leave ncftp* for last as it only
2794 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
2795 my $funkyftp = $CPAN::Config->{$f};
2796 next unless defined $funkyftp;
2797 next if $funkyftp =~ /^\s*$/;
2799 my($asl_ungz, $asl_gz);
2800 ($asl_ungz = $aslocal) =~ s/\.gz//;
2801 $asl_gz = "$asl_ungz.gz";
2803 my($src_switch) = "";
2805 my($stdout_redir) = " > $asl_ungz";
2807 $src_switch = " -source";
2808 } elsif ($f eq "ncftp"){
2809 $src_switch = " -c";
2810 } elsif ($f eq "wget"){
2811 $src_switch = " -O $asl_ungz";
2813 } elsif ($f eq 'curl'){
2814 $src_switch = ' -L -f -s -S --netrc-optional';
2817 if ($f eq "ncftpget"){
2818 $chdir = "cd $aslocal_dir && ";
2821 $CPAN::Frontend->myprint(
2823 Trying with "$funkyftp$src_switch" to get
2827 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
2828 $self->debug("system[$system]") if $CPAN::DEBUG;
2829 my($wstatus) = system($system);
2831 # lynx returns 0 when it fails somewhere
2833 my $content = do { open my $fh, $asl_ungz or die; local $/; <$fh> };
2834 if ($content =~ /^<.*<title>[45]/si) {
2835 $CPAN::Frontend->myprint(qq{
2836 No success, the file that lynx has has downloaded looks like an error message:
2839 $CPAN::Frontend->mysleep(1);
2843 $CPAN::Frontend->myprint(qq{
2844 No success, the file that lynx has has downloaded is an empty file.
2849 if ($wstatus == 0) {
2852 } elsif ($asl_ungz ne $aslocal) {
2853 # test gzip integrity
2854 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
2855 # e.g. foo.tar is gzipped --> foo.tar.gz
2856 rename $asl_ungz, $aslocal;
2858 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
2861 $ThesiteURL = $ro_url;
2863 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2865 -f $asl_ungz && -s _ == 0;
2866 my $gz = "$aslocal.gz";
2867 my $gzurl = "$url.gz";
2868 $CPAN::Frontend->myprint(
2870 Trying with "$funkyftp$src_switch" to get
2873 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
2874 $self->debug("system[$system]") if $CPAN::DEBUG;
2876 if (($wstatus = system($system)) == 0
2880 # test gzip integrity
2881 my $ct = CPAN::Tarzip->new($asl_gz);
2883 $ct->gunzip($aslocal);
2885 # somebody uncompressed file for us?
2886 rename $asl_ungz, $aslocal;
2888 $ThesiteURL = $ro_url;
2891 unlink $asl_gz if -f $asl_gz;
2894 my $estatus = $wstatus >> 8;
2895 my $size = -f $aslocal ?
2896 ", left\n$aslocal with size ".-s _ :
2897 "\nWarning: expected file [$aslocal] doesn't exist";
2898 $CPAN::Frontend->myprint(qq{
2899 System call "$system"
2900 returned status $estatus (wstat $wstatus)$size
2903 return if $CPAN::Signal;
2904 } # transfer programs
2908 # package CPAN::FTP;
2910 my($self,$host_seq,$file,$aslocal) = @_;
2913 my($aslocal_dir) = File::Basename::dirname($aslocal);
2914 File::Path::mkpath($aslocal_dir);
2915 my $ftpbin = $CPAN::Config->{ftp};
2916 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
2917 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2920 $CPAN::Frontend->myprint(qq{
2921 As a last ressort we now switch to the external ftp command '$ftpbin'
2924 Doing so often leads to problems that are hard to diagnose, even endless
2925 loops may be encountered.
2927 If you're victim of such problems, please consider unsetting the ftp
2928 config variable with
2934 $CPAN::Frontend->mysleep(4);
2935 HOSTHARDEST: for $ro_url (@$host_seq) {
2936 my $url = "$ro_url$file";
2937 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2938 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2941 my($host,$dir,$getfile) = ($1,$2,$3);
2943 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2944 $ctime,$blksize,$blocks) = stat($aslocal);
2945 $timestamp = $mtime ||= 0;
2946 my($netrc) = CPAN::FTP::netrc->new;
2947 my($netrcfile) = $netrc->netrc;
2948 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2949 my $targetfile = File::Basename::basename($aslocal);
2955 map("cd $_", split /\//, $dir), # RFC 1738
2957 "get $getfile $targetfile",
2961 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2962 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2963 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2965 $netrc->contains($host))) if $CPAN::DEBUG;
2966 if ($netrc->protected) {
2967 my $dialog = join "", map { " $_\n" } @dialog;
2969 if ($netrc->contains($host)) {
2970 $netrc_explain = "Relying that your .netrc entry for '$host' ".
2971 "manages the login";
2973 $netrc_explain = "Relying that your default .netrc entry ".
2974 "manages the login";
2976 $CPAN::Frontend->myprint(qq{
2977 Trying with external ftp to get
2980 Going to send the dialog
2984 $self->talk_ftp("$ftpbin$verbose $host",
2986 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2987 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2989 if ($mtime > $timestamp) {
2990 $CPAN::Frontend->myprint("GOT $aslocal\n");
2991 $ThesiteURL = $ro_url;
2994 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2996 return if $CPAN::Signal;
2998 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2999 qq{correctly protected.\n});
3002 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3003 nor does it have a default entry\n");
3006 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3007 # then and login manually to host, using e-mail as
3009 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3013 "user anonymous $Config::Config{'cf_email'}"
3015 my $dialog = join "", map { " $_\n" } @dialog;
3016 $CPAN::Frontend->myprint(qq{
3017 Trying with external ftp to get
3019 Going to send the dialog
3023 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3024 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3025 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3027 if ($mtime > $timestamp) {
3028 $CPAN::Frontend->myprint("GOT $aslocal\n");
3029 $ThesiteURL = $ro_url;
3032 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3034 return if $CPAN::Signal;
3035 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
3040 # package CPAN::FTP;
3042 my($self,$command,@dialog) = @_;
3043 my $fh = FileHandle->new;
3044 $fh->open("|$command") or die "Couldn't open ftp: $!";
3045 foreach (@dialog) { $fh->print("$_\n") }
3046 $fh->close; # Wait for process to complete
3048 my $estatus = $wstatus >> 8;
3049 $CPAN::Frontend->myprint(qq{
3050 Subprocess "|$command"
3051 returned status $estatus (wstat $wstatus)
3055 # find2perl needs modularization, too, all the following is stolen
3059 my($self,$name) = @_;
3060 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3061 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3063 my($perms,%user,%group);
3067 $blocks = int(($blocks + 1) / 2);
3070 $blocks = int(($sizemm + 1023) / 1024);
3073 if (-f _) { $perms = '-'; }
3074 elsif (-d _) { $perms = 'd'; }
3075 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3076 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3077 elsif (-p _) { $perms = 'p'; }
3078 elsif (-S _) { $perms = 's'; }
3079 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3081 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3082 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3083 my $tmpmode = $mode;
3084 my $tmp = $rwx[$tmpmode & 7];
3086 $tmp = $rwx[$tmpmode & 7] . $tmp;
3088 $tmp = $rwx[$tmpmode & 7] . $tmp;
3089 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3090 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3091 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3094 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3095 my $group = $group{$gid} || $gid;
3097 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3099 my($moname) = $moname[$mon];
3100 if (-M _ > 365.25 / 2) {
3101 $timeyear = $year + 1900;
3104 $timeyear = sprintf("%02d:%02d", $hour, $min);
3107 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3121 package CPAN::FTP::netrc;
3124 # package CPAN::FTP::netrc;
3127 my $file = File::Spec->catfile($ENV{HOME},".netrc");
3129 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3130 $atime,$mtime,$ctime,$blksize,$blocks)
3135 my($fh,@machines,$hasdefault);
3137 $fh = FileHandle->new or die "Could not create a filehandle";
3139 if($fh->open($file)){
3140 $protected = ($mode & 077) == 0;
3142 NETRC: while (<$fh>) {
3143 my(@tokens) = split " ", $_;
3144 TOKEN: while (@tokens) {
3145 my($t) = shift @tokens;
3146 if ($t eq "default"){
3150 last TOKEN if $t eq "macdef";
3151 if ($t eq "machine") {
3152 push @machines, shift @tokens;
3157 $file = $hasdefault = $protected = "";
3161 'mach' => [@machines],
3163 'hasdefault' => $hasdefault,
3164 'protected' => $protected,
3168 # CPAN::FTP::netrc::hasdefault;
3169 sub hasdefault { shift->{'hasdefault'} }
3170 sub netrc { shift->{'netrc'} }
3171 sub protected { shift->{'protected'} }
3173 my($self,$mach) = @_;
3174 for ( @{$self->{'mach'}} ) {
3175 return 1 if $_ eq $mach;
3180 package CPAN::Complete;
3184 my($text, $line, $start, $end) = @_;
3185 my(@perlret) = cpl($text, $line, $start);
3186 # find longest common match. Can anybody show me how to peruse
3187 # T::R::Gnu to have this done automatically? Seems expensive.
3188 return () unless @perlret;
3189 my($newtext) = $text;
3190 for (my $i = length($text)+1;;$i++) {
3191 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3192 my $try = substr($perlret[0],0,$i);
3193 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3194 # warn "try[$try]tries[@tries]";
3195 if (@tries == @perlret) {
3201 ($newtext,@perlret);
3204 #-> sub CPAN::Complete::cpl ;
3206 my($word,$line,$pos) = @_;
3210 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3212 if ($line =~ s/^(force\s*)//) {
3217 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3218 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3220 } elsif ($line =~ /^(a|ls)\s/) {
3221 @return = cplx('CPAN::Author',uc($word));
3222 } elsif ($line =~ /^b\s/) {
3223 CPAN::Shell->local_bundles;
3224 @return = cplx('CPAN::Bundle',$word);
3225 } elsif ($line =~ /^d\s/) {
3226 @return = cplx('CPAN::Distribution',$word);
3227 } elsif ($line =~ m/^(
3228 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3230 if ($word =~ /^Bundle::/) {
3231 CPAN::Shell->local_bundles;
3233 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3234 } elsif ($line =~ /^i\s/) {
3235 @return = cpl_any($word);
3236 } elsif ($line =~ /^reload\s/) {
3237 @return = cpl_reload($word,$line,$pos);
3238 } elsif ($line =~ /^o\s/) {
3239 @return = cpl_option($word,$line,$pos);
3240 } elsif ($line =~ m/^\S+\s/ ) {
3241 # fallback for future commands and what we have forgotten above
3242 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3249 #-> sub CPAN::Complete::cplx ;
3251 my($class, $word) = @_;
3252 # I believed for many years that this was sorted, today I
3253 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3254 # make it sorted again. Maybe sort was dropped when GNU-readline
3255 # support came in? The RCS file is difficult to read on that:-(
3256 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3259 #-> sub CPAN::Complete::cpl_any ;
3263 cplx('CPAN::Author',$word),
3264 cplx('CPAN::Bundle',$word),
3265 cplx('CPAN::Distribution',$word),
3266 cplx('CPAN::Module',$word),
3270 #-> sub CPAN::Complete::cpl_reload ;
3272 my($word,$line,$pos) = @_;
3274 my(@words) = split " ", $line;
3275 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3276 my(@ok) = qw(cpan index);
3277 return @ok if @words == 1;
3278 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3281 #-> sub CPAN::Complete::cpl_option ;
3283 my($word,$line,$pos) = @_;
3285 my(@words) = split " ", $line;
3286 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3287 my(@ok) = qw(conf debug);
3288 return @ok if @words == 1;
3289 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3291 } elsif ($words[1] eq 'index') {
3293 } elsif ($words[1] eq 'conf') {
3294 return CPAN::HandleConfig::cpl(@_);
3295 } elsif ($words[1] eq 'debug') {
3296 return sort grep /^\Q$word\E/i,
3297 sort keys %CPAN::DEBUG, 'all';
3301 package CPAN::Index;
3304 #-> sub CPAN::Index::force_reload ;
3307 $CPAN::Index::LAST_TIME = 0;
3311 #-> sub CPAN::Index::reload ;
3313 my($cl,$force) = @_;
3316 # XXX check if a newer one is available. (We currently read it
3317 # from time to time)
3318 for ($CPAN::Config->{index_expire}) {
3319 $_ = 0.001 unless $_ && $_ > 0.001;
3321 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3322 # debug here when CPAN doesn't seem to read the Metadata
3324 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3326 unless ($CPAN::META->{PROTOCOL}) {
3327 $cl->read_metadata_cache;
3328 $CPAN::META->{PROTOCOL} ||= "1.0";
3330 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3331 # warn "Setting last_time to 0";
3332 $LAST_TIME = 0; # No warning necessary
3334 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3337 # IFF we are developing, it helps to wipe out the memory
3338 # between reloads, otherwise it is not what a user expects.
3339 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3340 $CPAN::META = CPAN->new;
3344 local $LAST_TIME = $time;
3345 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3347 my $needshort = $^O eq "dos";
3349 $cl->rd_authindex($cl
3351 "authors/01mailrc.txt.gz",
3353 File::Spec->catfile('authors', '01mailrc.gz') :
3354 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3357 $debug = "timing reading 01[".($t2 - $time)."]";
3359 return if $CPAN::Signal; # this is sometimes lengthy
3360 $cl->rd_modpacks($cl
3362 "modules/02packages.details.txt.gz",
3364 File::Spec->catfile('modules', '02packag.gz') :
3365 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3368 $debug .= "02[".($t2 - $time)."]";
3370 return if $CPAN::Signal; # this is sometimes lengthy
3373 "modules/03modlist.data.gz",
3375 File::Spec->catfile('modules', '03mlist.gz') :
3376 File::Spec->catfile('modules', '03modlist.data.gz'),
3378 $cl->write_metadata_cache;
3380 $debug .= "03[".($t2 - $time)."]";
3382 CPAN->debug($debug) if $CPAN::DEBUG;
3385 $CPAN::META->{PROTOCOL} = PROTOCOL;
3388 #-> sub CPAN::Index::reload_x ;
3390 my($cl,$wanted,$localname,$force) = @_;
3391 $force |= 2; # means we're dealing with an index here
3392 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3394 $localname ||= $wanted;
3395 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3399 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3402 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3403 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3404 qq{day$s. I\'ll use that.});
3407 $force |= 1; # means we're quite serious about it.
3409 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3412 #-> sub CPAN::Index::rd_authindex ;
3414 my($cl, $index_target) = @_;
3416 return unless defined $index_target;
3417 $CPAN::Frontend->myprint("Going to read $index_target\n");
3419 tie *FH, 'CPAN::Tarzip', $index_target;
3422 push @lines, split /\012/ while <FH>;
3424 my($userid,$fullname,$email) =
3425 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3426 next unless $userid && $fullname && $email;
3428 # instantiate an author object
3429 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3430 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3431 return if $CPAN::Signal;
3436 my($self,$dist) = @_;
3437 $dist = $self->{'id'} unless defined $dist;
3438 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3442 #-> sub CPAN::Index::rd_modpacks ;
3444 my($self, $index_target) = @_;
3446 return unless defined $index_target;
3447 $CPAN::Frontend->myprint("Going to read $index_target\n");
3448 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3451 while ($_ = $fh->READLINE) {
3453 my @ls = map {"$_\n"} split /\n/, $_;
3454 unshift @ls, "\n" x length($1) if /^(\n+)/;
3458 my($line_count,$last_updated);
3460 my $shift = shift(@lines);
3461 last if $shift =~ /^\s*$/;
3462 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3463 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3465 if (not defined $line_count) {
3467 warn qq{Warning: Your $index_target does not contain a Line-Count header.
3468 Please check the validity of the index file by comparing it to more
3469 than one CPAN mirror. I'll continue but problems seem likely to
3474 } elsif ($line_count != scalar @lines) {
3476 warn sprintf qq{Warning: Your %s
3477 contains a Line-Count header of %d but I see %d lines there. Please
3478 check the validity of the index file by comparing it to more than one
3479 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3480 $index_target, $line_count, scalar(@lines);
3483 if (not defined $last_updated) {
3485 warn qq{Warning: Your $index_target does not contain a Last-Updated header.
3486 Please check the validity of the index file by comparing it to more
3487 than one CPAN mirror. I'll continue but problems seem likely to
3495 ->myprint(sprintf qq{ Database was generated on %s\n},
3497 $DATE_OF_02 = $last_updated;
3500 if ($CPAN::META->has_inst('HTTP::Date')) {
3502 $age -= HTTP::Date::str2time($last_updated);
3504 $CPAN::Frontend->myprint(" HTTP::Date not available\n");
3505 require Time::Local;
3506 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3507 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3508 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3515 qq{Warning: This index file is %d days old.
3516 Please check the host you chose as your CPAN mirror for staleness.
3517 I'll continue but problems seem likely to happen.\a\n},
3520 } elsif ($age < -1) {
3524 qq{Warning: Your system date is %d days behind this index file!
3526 Timestamp index file: %s
3527 Please fix your system time, problems with the make command expected.\n},
3537 # A necessity since we have metadata_cache: delete what isn't
3539 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3540 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3544 # before 1.56 we split into 3 and discarded the rest. From
3545 # 1.57 we assign remaining text to $comment thus allowing to
3546 # influence isa_perl
3547 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3548 my($bundle,$id,$userid);
3550 if ($mod eq 'CPAN' &&
3552 CPAN::Queue->exists('Bundle::CPAN') ||
3553 CPAN::Queue->exists('CPAN')
3557 if ($version > $CPAN::VERSION){
3558 $CPAN::Frontend->myprint(qq{
3559 There's a new CPAN.pm version (v$version) available!
3560 [Current version is v$CPAN::VERSION]
3561 You might want to try
3562 install Bundle::CPAN
3564 without quitting the current session. It should be a seamless upgrade
3565 while we are running...
3568 $CPAN::Frontend->myprint(qq{\n});
3570 last if $CPAN::Signal;
3571 } elsif ($mod =~ /^Bundle::(.*)/) {
3576 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3577 # Let's make it a module too, because bundles have so much
3578 # in common with modules.
3580 # Changed in 1.57_63: seems like memory bloat now without
3581 # any value, so commented out
3583 # $CPAN::META->instance('CPAN::Module',$mod);
3587 # instantiate a module object
3588 $id = $CPAN::META->instance('CPAN::Module',$mod);
3592 # Although CPAN prohibits same name with different version the
3593 # indexer may have changed the version for the same distro
3594 # since the last time ("Force Reindexing" feature)
3595 if ($id->cpan_file ne $dist
3597 $id->cpan_version ne $version
3599 $userid = $id->userid || $self->userid($dist);
3601 'CPAN_USERID' => $userid,
3602 'CPAN_VERSION' => $version,
3603 'CPAN_FILE' => $dist,
3607 # instantiate a distribution object
3608 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3609 # we do not need CONTAINSMODS unless we do something with
3610 # this dist, so we better produce it on demand.
3612 ## my $obj = $CPAN::META->instance(
3613 ## 'CPAN::Distribution' => $dist
3615 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3617 $CPAN::META->instance(
3618 'CPAN::Distribution' => $dist
3620 'CPAN_USERID' => $userid,
3621 'CPAN_COMMENT' => $comment,
3625 for my $name ($mod,$dist) {
3626 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3627 $exists{$name} = undef;
3630 return if $CPAN::Signal;
3634 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3635 for my $o ($CPAN::META->all_objects($class)) {
3636 next if exists $exists{$o->{ID}};
3637 $CPAN::META->delete($class,$o->{ID});
3638 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3645 #-> sub CPAN::Index::rd_modlist ;
3647 my($cl,$index_target) = @_;
3648 return unless defined $index_target;
3649 $CPAN::Frontend->myprint("Going to read $index_target\n");
3650 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3654 while ($_ = $fh->READLINE) {
3656 my @ls = map {"$_\n"} split /\n/, $_;
3657 unshift @ls, "\n" x length($1) if /^(\n+)/;
3661 my $shift = shift(@eval);
3662 if ($shift =~ /^Date:\s+(.*)/){
3663 return if $DATE_OF_03 eq $1;
3666 last if $shift =~ /^\s*$/;
3669 push @eval, q{CPAN::Modulelist->data;};
3671 my($comp) = Safe->new("CPAN::Safe1");
3672 my($eval) = join("", @eval);
3673 my $ret = $comp->reval($eval);
3674 Carp::confess($@) if $@;
3675 return if $CPAN::Signal;
3677 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3678 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3679 $obj->set(%{$ret->{$_}});
3680 return if $CPAN::Signal;
3684 #-> sub CPAN::Index::write_metadata_cache ;
3685 sub write_metadata_cache {
3687 return unless $CPAN::Config->{'cache_metadata'};
3688 return unless $CPAN::META->has_usable("Storable");
3690 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3691 CPAN::Distribution)) {
3692 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3694 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3695 $cache->{last_time} = $LAST_TIME;
3696 $cache->{DATE_OF_02} = $DATE_OF_02;
3697 $cache->{PROTOCOL} = PROTOCOL;
3698 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
3699 eval { Storable::nstore($cache, $metadata_file) };
3700 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3703 #-> sub CPAN::Index::read_metadata_cache ;
3704 sub read_metadata_cache {
3706 return unless $CPAN::Config->{'cache_metadata'};
3707 return unless $CPAN::META->has_usable("Storable");
3708 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3709 return unless -r $metadata_file and -f $metadata_file;
3710 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
3712 eval { $cache = Storable::retrieve($metadata_file) };
3713 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3714 if (!$cache || ref $cache ne 'HASH'){
3718 if (exists $cache->{PROTOCOL}) {
3719 if (PROTOCOL > $cache->{PROTOCOL}) {
3720 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
3721 "with protocol v%s, requiring v%s\n",
3728 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
3729 "with protocol v1.0\n");
3734 while(my($class,$v) = each %$cache) {
3735 next unless $class =~ /^CPAN::/;
3736 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
3737 while (my($id,$ro) = each %$v) {
3738 $CPAN::META->{readwrite}{$class}{$id} ||=
3739 $class->new(ID=>$id, RO=>$ro);
3744 unless ($clcnt) { # sanity check
3745 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
3748 if ($idcnt < 1000) {
3749 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
3750 "in $metadata_file\n");
3753 $CPAN::META->{PROTOCOL} ||=
3754 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
3755 # does initialize to some protocol
3756 $LAST_TIME = $cache->{last_time};
3757 $DATE_OF_02 = $cache->{DATE_OF_02};
3758 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
3759 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
3763 package CPAN::InfoObj;
3768 exists $self->{RO} and return $self->{RO};
3773 my $ro = $self->ro or return;
3774 return $ro->{CPAN_USERID};
3777 sub id { shift->{ID}; }
3779 #-> sub CPAN::InfoObj::new ;
3781 my $this = bless {}, shift;
3786 # The set method may only be used by code that reads index data or
3787 # otherwise "objective" data from the outside world. All session
3788 # related material may do anything else with instance variables but
3789 # must not touch the hash under the RO attribute. The reason is that
3790 # the RO hash gets written to Metadata file and is thus persistent.
3792 #-> sub CPAN::InfoObj::set ;
3794 my($self,%att) = @_;
3795 my $class = ref $self;
3797 # This must be ||=, not ||, because only if we write an empty
3798 # reference, only then the set method will write into the readonly
3799 # area. But for Distributions that spring into existence, maybe
3800 # because of a typo, we do not like it that they are written into
3801 # the readonly area and made permanent (at least for a while) and
3802 # that is why we do not "allow" other places to call ->set.
3803 unless ($self->id) {
3804 CPAN->debug("Bug? Empty ID, rejecting");
3807 my $ro = $self->{RO} =
3808 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
3810 while (my($k,$v) = each %att) {
3815 #-> sub CPAN::InfoObj::as_glimpse ;
3819 my $class = ref($self);
3820 $class =~ s/^CPAN:://;
3821 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
3825 #-> sub CPAN::InfoObj::as_string ;
3829 my $class = ref($self);
3830 $class =~ s/^CPAN:://;
3831 push @m, $class, " id = $self->{ID}\n";
3833 for (sort keys %$ro) {
3834 # next if m/^(ID|RO)$/;
3836 if ($_ eq "CPAN_USERID") {
3837 $extra .= " (".$self->author;
3838 my $email; # old perls!
3839 if ($email = $CPAN::META->instance("CPAN::Author",
3842 $extra .= " <$email>";
3844 $extra .= " <no email>";
3847 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
3848 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
3851 next unless defined $ro->{$_};
3852 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
3854 for (sort keys %$self) {
3855 next if m/^(ID|RO)$/;
3856 if (ref($self->{$_}) eq "ARRAY") {
3857 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
3858 } elsif (ref($self->{$_}) eq "HASH") {
3862 join(" ",keys %{$self->{$_}}),
3865 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
3871 #-> sub CPAN::InfoObj::author ;
3874 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
3877 #-> sub CPAN::InfoObj::dump ;
3880 require Data::Dumper;
3881 print Data::Dumper::Dumper($self);
3884 package CPAN::Author;
3887 #-> sub CPAN::Author::force
3893 #-> sub CPAN::Author::force
3896 delete $self->{force};
3899 #-> sub CPAN::Author::id
3902 my $id = $self->{ID};
3903 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
3907 #-> sub CPAN::Author::as_glimpse ;
3911 my $class = ref($self);
3912 $class =~ s/^CPAN:://;
3913 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
3921 #-> sub CPAN::Author::fullname ;
3923 shift->ro->{FULLNAME};
3927 #-> sub CPAN::Author::email ;
3928 sub email { shift->ro->{EMAIL}; }
3930 #-> sub CPAN::Author::ls ;
3933 my $glob = shift || "";
3934 my $silent = shift || 0;
3937 # adapted from CPAN::Distribution::verifyCHECKSUM ;
3938 my(@csf); # chksumfile
3939 @csf = $self->id =~ /(.)(.)(.*)/;
3940 $csf[1] = join "", @csf[0,1];
3941 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
3943 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
3944 unless (grep {$_->[2] eq $csf[1]} @dl) {
3945 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
3948 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
3949 unless (grep {$_->[2] eq $csf[2]} @dl) {
3950 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
3953 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
3955 my $rglob = Text::Glob::glob_to_regex($glob);
3956 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
3958 $CPAN::Frontend->myprint(join "", map {
3959 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
3960 } sort { $a->[2] cmp $b->[2] } @dl);
3964 # returns an array of arrays, the latter contain (size,mtime,filename)
3965 #-> sub CPAN::Author::dir_listing ;
3968 my $chksumfile = shift;
3969 my $recursive = shift;
3970 my $may_ftp = shift;
3972 File::Spec->catfile($CPAN::Config->{keep_source_where},
3973 "authors", "id", @$chksumfile);
3977 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
3978 # hazard. (Without GPG installed they are not that much better,
3980 $fh = FileHandle->new;
3981 if (open($fh, $lc_want)) {
3982 my $line = <$fh>; close $fh;
3983 unlink($lc_want) unless $line =~ /PGP/;
3987 # connect "force" argument with "index_expire".
3988 my $force = $self->{force};
3989 if (my @stat = stat $lc_want) {
3990 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
3994 $lc_file = CPAN::FTP->localize(
3995 "authors/id/@$chksumfile",
4000 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4001 $chksumfile->[-1] .= ".gz";
4002 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4005 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4006 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4012 $lc_file = $lc_want;
4013 # we *could* second-guess and if the user has a file: URL,
4014 # then we could look there. But on the other hand, if they do
4015 # have a file: URL, wy did they choose to set
4016 # $CPAN::Config->{show_upload_date} to false?
4019 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4020 $fh = FileHandle->new;
4022 if (open $fh, $lc_file){
4025 $eval =~ s/\015?\012/\n/g;
4027 my($comp) = Safe->new();
4028 $cksum = $comp->reval($eval);
4030 rename $lc_file, "$lc_file.bad";
4031 Carp::confess($@) if $@;
4033 } elsif ($may_ftp) {
4034 Carp::carp "Could not open $lc_file for reading.";
4036 # Maybe should warn: "You may want to set show_upload_date to a true value"
4040 for $f (sort keys %$cksum) {
4041 if (exists $cksum->{$f}{isdir}) {
4043 my(@dir) = @$chksumfile;
4045 push @dir, $f, "CHECKSUMS";
4047 [$_->[0], $_->[1], "$f/$_->[2]"]
4048 } $self->dir_listing(\@dir,1,$may_ftp);
4050 push @result, [ 0, "-", $f ];
4054 ($cksum->{$f}{"size"}||0),
4055 $cksum->{$f}{"mtime"}||"---",
4063 package CPAN::Distribution;
4069 my $ro = $self->ro or return;
4073 # CPAN::Distribution::undelay
4076 delete $self->{later};
4079 # add the A/AN/ stuff
4080 # CPAN::Distribution::normalize
4083 $s = $self->id unless defined $s;
4087 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4089 return $s if $s =~ m:^N/A|^Contact Author: ;
4090 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4091 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4092 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4100 return $id unless $id =~ m|^./../|;
4104 # mark as dirty/clean
4105 #-> sub CPAN::Distribution::color_cmd_tmps ;
4106 sub color_cmd_tmps {
4108 my($depth) = shift || 0;
4109 my($color) = shift || 0;
4110 my($ancestors) = shift || [];
4111 # a distribution needs to recurse into its prereq_pms
4113 return if exists $self->{incommandcolor}
4114 && $self->{incommandcolor}==$color;
4116 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4118 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4119 my $prereq_pm = $self->prereq_pm;
4120 if (defined $prereq_pm) {
4121 PREREQ: for my $pre (keys %$prereq_pm) {
4123 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4124 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4125 $CPAN::Frontend->mysleep(2);
4128 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4132 delete $self->{sponsored_mods};
4133 delete $self->{badtestcnt};
4135 $self->{incommandcolor} = $color;
4138 #-> sub CPAN::Distribution::as_string ;
4141 $self->containsmods;
4143 $self->SUPER::as_string(@_);
4146 #-> sub CPAN::Distribution::containsmods ;
4149 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4150 my $dist_id = $self->{ID};
4151 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4152 my $mod_file = $mod->cpan_file or next;
4153 my $mod_id = $mod->{ID} or next;
4154 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4156 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4158 keys %{$self->{CONTAINSMODS}};
4161 #-> sub CPAN::Distribution::upload_date ;
4164 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4165 my(@local_wanted) = split(/\//,$self->id);
4166 my $filename = pop @local_wanted;
4167 push @local_wanted, "CHECKSUMS";
4168 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4169 return unless $author;
4170 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4172 my($dirent) = grep { $_->[2] eq $filename } @dl;
4173 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4174 return unless $dirent->[1];
4175 return $self->{UPLOAD_DATE} = $dirent->[1];
4178 #-> sub CPAN::Distribution::uptodate ;
4182 foreach $c ($self->containsmods) {
4183 my $obj = CPAN::Shell->expandany($c);
4184 return 0 unless $obj->uptodate;
4189 #-> sub CPAN::Distribution::called_for ;
4192 $self->{CALLED_FOR} = $id if defined $id;
4193 return $self->{CALLED_FOR};
4196 #-> sub CPAN::Distribution::safe_chdir ;
4198 my($self,$todir) = @_;
4199 # we die if we cannot chdir and we are debuggable
4200 Carp::confess("safe_chdir called without todir argument")
4201 unless defined $todir and length $todir;
4203 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4207 unless (-x $todir) {
4208 unless (chmod 0755, $todir) {
4209 my $cwd = CPAN::anycwd();
4210 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4211 "permission to change the permission; cannot ".
4212 "chdir to '$todir'\n");
4213 $CPAN::Frontend->mysleep(5);
4214 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4215 qq{to todir[$todir]: $!});
4219 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4222 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4225 my $cwd = CPAN::anycwd();
4226 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4227 qq{to todir[$todir] (a chmod has been issued): $!});
4232 #-> sub CPAN::Distribution::get ;
4237 exists $self->{'build_dir'} and push @e,
4238 "Is already unwrapped into directory $self->{'build_dir'}";
4239 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4241 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4244 # Get the file on local disk
4249 File::Spec->catfile(
4250 $CPAN::Config->{keep_source_where},
4253 split(/\//,$self->id)
4256 $self->debug("Doing localize") if $CPAN::DEBUG;
4257 unless ($local_file =
4258 CPAN::FTP->localize("authors/id/$self->{ID}",
4261 if ($CPAN::Index::DATE_OF_02) {
4262 $note = "Note: Current database in memory was generated ".
4263 "on $CPAN::Index::DATE_OF_02\n";
4265 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4267 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4268 $self->{localfile} = $local_file;
4269 return if $CPAN::Signal;
4274 if ($CPAN::META->has_inst("Digest::SHA")) {
4275 $self->debug("Digest::SHA is installed, verifying");
4276 $self->verifyCHECKSUM;
4278 $self->debug("Digest::SHA is NOT installed");
4280 return if $CPAN::Signal;
4283 # Create a clean room and go there
4285 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4286 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4287 $self->safe_chdir($builddir);
4288 $self->debug("Removing tmp") if $CPAN::DEBUG;
4289 File::Path::rmtree("tmp");
4290 unless (mkdir "tmp", 0755) {
4291 $CPAN::Frontend->unrecoverable_error(<<EOF);
4292 Couldn't mkdir '$builddir/tmp': $!
4294 Cannot continue: Please find the reason why I cannot make the
4297 and fix the problem, then retry.
4302 $self->safe_chdir($sub_wd);
4305 $self->safe_chdir("tmp");
4310 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4311 my $ct = CPAN::Tarzip->new($local_file);
4312 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4313 $self->{was_uncompressed}++ unless $ct->gtest();
4314 $self->untar_me($ct);
4315 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4316 $self->unzip_me($ct);
4317 } elsif ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/) {
4318 $self->{was_uncompressed}++ unless $ct->gtest();
4319 $self->debug("calling pm2dir for local_file[$local_file]") if $CPAN::DEBUG;
4320 $self->pm2dir_me($local_file);
4322 $self->{archived} = "NO";
4323 $self->safe_chdir($sub_wd);
4327 # we are still in the tmp directory!
4328 # Let's check if the package has its own directory.
4329 my $dh = DirHandle->new(File::Spec->curdir)
4330 or Carp::croak("Couldn't opendir .: $!");
4331 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4333 my ($distdir,$packagedir);
4334 if (@readdir == 1 && -d $readdir[0]) {
4335 $distdir = $readdir[0];
4336 $packagedir = File::Spec->catdir($builddir,$distdir);
4337 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4339 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4341 File::Path::rmtree($packagedir);
4342 unless (File::Copy::move($distdir,$packagedir)) {
4343 $CPAN::Frontend->unrecoverable_error(<<EOF);
4344 Couldn't move '$distdir' to '$packagedir': $!
4346 Cannot continue: Please find the reason why I cannot move
4347 $builddir/tmp/$distdir
4350 and fix the problem, then retry
4354 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4361 my $userid = $self->cpan_userid;
4363 CPAN->debug("no userid? self[$self]");
4366 my $pragmatic_dir = $userid . '000';
4367 $pragmatic_dir =~ s/\W_//g;
4368 $pragmatic_dir++ while -d "../$pragmatic_dir";
4369 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4370 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4371 File::Path::mkpath($packagedir);
4373 for $f (@readdir) { # is already without "." and ".."
4374 my $to = File::Spec->catdir($packagedir,$f);
4375 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4379 $self->safe_chdir($sub_wd);
4383 $self->{'build_dir'} = $packagedir;
4384 $self->safe_chdir($builddir);
4385 File::Path::rmtree("tmp");
4387 $self->safe_chdir($packagedir);
4388 if ($CPAN::META->has_inst("Module::Signature")) {
4389 if (-f "SIGNATURE") {
4390 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4391 my $rv = Module::Signature::verify();
4392 if ($rv != Module::Signature::SIGNATURE_OK() and
4393 $rv != Module::Signature::SIGNATURE_MISSING()) {
4394 $CPAN::Frontend->myprint(
4395 qq{\nSignature invalid for }.
4396 qq{distribution file. }.
4397 qq{Please investigate.\n\n}.
4399 $CPAN::META->instance(
4406 sprintf(qq{I'd recommend removing %s. Its signature
4407 is invalid. Maybe you have configured your 'urllist' with
4408 a bad URL. Please check this array with 'o conf urllist', and
4409 retry. For more information, try opening a subshell with
4417 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4418 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4419 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4421 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4424 $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
4427 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4429 $self->safe_chdir($builddir);
4430 return if $CPAN::Signal;
4433 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4434 my($mpl_exists) = -f $mpl;
4435 unless ($mpl_exists) {
4436 # NFS has been reported to have racing problems after the
4437 # renaming of a directory in some environments.
4440 my $mpldh = DirHandle->new($packagedir)
4441 or Carp::croak("Couldn't opendir $packagedir: $!");
4442 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4445 my $prefer_installer = "eumm"; # eumm|mb
4446 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4447 if ($mpl_exists) { # they *can* choose
4448 if ($CPAN::META->has_inst("Module::Build")) {
4449 $prefer_installer = $CPAN::Config->{prefer_installer};
4452 $prefer_installer = "mb";
4455 if (lc($prefer_installer) eq "mb") {
4456 $self->{modulebuild} = 1;
4457 } elsif (! $mpl_exists) {
4458 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4462 my($configure) = File::Spec->catfile($packagedir,"Configure");
4463 if (-f $configure) {
4464 # do we have anything to do?
4465 $self->{'configure'} = $configure;
4466 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4467 $CPAN::Frontend->myprint(qq{
4468 Package comes with a Makefile and without a Makefile.PL.
4469 We\'ll try to build it with that Makefile then.
4471 $self->{writemakefile} = "YES";
4474 my $cf = $self->called_for || "unknown";
4479 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4480 $cf = "unknown" unless length($cf);
4481 $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
4482 (The test -f "$mpl" returned false.)
4483 Writing one on our own (setting NAME to $cf)\a\n});
4484 $self->{had_no_makefile_pl}++;
4487 # Writing our own Makefile.PL
4489 my $fh = FileHandle->new;
4491 or Carp::croak("Could not open >$mpl: $!");
4493 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4494 # because there was no Makefile.PL supplied.
4495 # Autogenerated on: }.scalar localtime().qq{
4497 use ExtUtils::MakeMaker;
4498 WriteMakefile(NAME => q[$cf]);
4508 # CPAN::Distribution::untar_me ;
4511 $self->{archived} = "tar";
4513 $self->{unwrapped} = "YES";
4515 $self->{unwrapped} = "NO";
4519 # CPAN::Distribution::unzip_me ;
4522 $self->{archived} = "zip";
4524 $self->{unwrapped} = "YES";
4526 $self->{unwrapped} = "NO";
4532 my($self,$local_file) = @_;
4533 $self->{archived} = "pm";
4534 my $to = File::Basename::basename($local_file);
4535 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4536 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4537 $self->{unwrapped} = "YES";
4539 $self->{unwrapped} = "NO";
4542 File::Copy::cp($local_file,".");
4543 $self->{unwrapped} = "YES";
4547 #-> sub CPAN::Distribution::new ;
4549 my($class,%att) = @_;
4551 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
4553 my $this = { %att };
4554 return bless $this, $class;
4557 #-> sub CPAN::Distribution::look ;
4561 if ($^O eq 'MacOS') {
4562 $self->Mac::BuildTools::look;
4566 if ( $CPAN::Config->{'shell'} ) {
4567 $CPAN::Frontend->myprint(qq{
4568 Trying to open a subshell in the build directory...
4571 $CPAN::Frontend->myprint(qq{
4572 Your configuration does not define a value for subshells.
4573 Please define it with "o conf shell <your shell>"
4577 my $dist = $self->id;
4579 unless ($dir = $self->dir) {
4582 unless ($dir ||= $self->dir) {
4583 $CPAN::Frontend->mywarn(qq{
4584 Could not determine which directory to use for looking at $dist.
4588 my $pwd = CPAN::anycwd();
4589 $self->safe_chdir($dir);
4590 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4592 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
4593 $ENV{CPAN_SHELL_LEVEL} += 1;
4594 unless (system($CPAN::Config->{'shell'}) == 0) {
4596 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
4599 $self->safe_chdir($pwd);
4602 # CPAN::Distribution::cvs_import ;
4606 my $dir = $self->dir;
4608 my $package = $self->called_for;
4609 my $module = $CPAN::META->instance('CPAN::Module', $package);
4610 my $version = $module->cpan_version;
4612 my $userid = $self->cpan_userid;
4614 my $cvs_dir = (split /\//, $dir)[-1];
4615 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
4617 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
4619 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
4620 if ($cvs_site_perl) {
4621 $cvs_dir = "$cvs_site_perl/$cvs_dir";
4623 my $cvs_log = qq{"imported $package $version sources"};
4624 $version =~ s/\./_/g;
4625 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
4626 "$cvs_dir", $userid, "v$version");
4628 my $pwd = CPAN::anycwd();
4629 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
4631 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4633 $CPAN::Frontend->myprint(qq{@cmd\n});
4634 system(@cmd) == 0 or
4635 $CPAN::Frontend->mydie("cvs import failed");
4636 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
4639 #-> sub CPAN::Distribution::readme ;
4642 my($dist) = $self->id;
4643 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
4644 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
4647 File::Spec->catfile(
4648 $CPAN::Config->{keep_source_where},
4651 split(/\//,"$sans.readme"),
4653 $self->debug("Doing localize") if $CPAN::DEBUG;
4654 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
4656 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
4658 if ($^O eq 'MacOS') {
4659 Mac::BuildTools::launch_file($local_file);
4663 my $fh_pager = FileHandle->new;
4664 local($SIG{PIPE}) = "IGNORE";
4665 $fh_pager->open("|$CPAN::Config->{'pager'}")
4666 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
4667 my $fh_readme = FileHandle->new;
4668 $fh_readme->open($local_file)
4669 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
4670 $CPAN::Frontend->myprint(qq{
4673 with pager "$CPAN::Config->{'pager'}"
4676 $fh_pager->print(<$fh_readme>);
4680 #-> sub CPAN::Distribution::verifyCHECKSUM ;
4681 sub verifyCHECKSUM {
4685 $self->{CHECKSUM_STATUS} ||= "";
4686 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
4687 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4689 my($lc_want,$lc_file,@local,$basename);
4690 @local = split(/\//,$self->id);
4692 push @local, "CHECKSUMS";
4694 File::Spec->catfile($CPAN::Config->{keep_source_where},
4695 "authors", "id", @local);
4700 $self->CHECKSUM_check_file($lc_want)
4702 return $self->{CHECKSUM_STATUS} = "OK";
4704 $lc_file = CPAN::FTP->localize("authors/id/@local",
4707 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4708 $local[-1] .= ".gz";
4709 $lc_file = CPAN::FTP->localize("authors/id/@local",
4712 $lc_file =~ s/\.gz(?!\n)\Z//;
4713 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4718 $self->CHECKSUM_check_file($lc_file);
4721 sub SIG_check_file {
4722 my($self,$chk_file) = @_;
4723 my $rv = eval { Module::Signature::_verify($chk_file) };
4725 if ($rv == Module::Signature::SIGNATURE_OK()) {
4726 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
4727 return $self->{SIG_STATUS} = "OK";
4729 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
4730 qq{distribution file. }.
4731 qq{Please investigate.\n\n}.
4733 $CPAN::META->instance(
4738 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
4739 is invalid. Maybe you have configured your 'urllist' with
4740 a bad URL. Please check this array with 'o conf urllist', and
4743 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4747 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
4748 sub CHECKSUM_check_file {
4749 my($self,$chk_file) = @_;
4750 my($cksum,$file,$basename);
4752 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
4753 $self->debug("Module::Signature is installed, verifying");
4754 $self->SIG_check_file($chk_file);
4756 $self->debug("Module::Signature is NOT installed");
4759 $file = $self->{localfile};
4760 $basename = File::Basename::basename($file);
4761 my $fh = FileHandle->new;
4762 if (open $fh, $chk_file){
4765 $eval =~ s/\015?\012/\n/g;
4767 my($comp) = Safe->new();
4768 $cksum = $comp->reval($eval);
4770 rename $chk_file, "$chk_file.bad";
4771 Carp::confess($@) if $@;
4774 Carp::carp "Could not open $chk_file for reading";
4777 if (! ref $cksum or ref $cksum ne "HASH") {
4778 $CPAN::Frontend->mywarn(qq{
4779 Warning: checksum file '$chk_file' broken.
4781 When trying to read that file I expected to get a hash reference
4782 for further processing, but got garbage instead.
4784 my $answer = ExtUtils::MakeMaker::prompt("Proceed nonetheless?", "no");
4785 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
4786 $self->{CHECKSUM_STATUS} = "NIL -- chk_file broken";
4788 } elsif (exists $cksum->{$basename}{sha256}) {
4789 $self->debug("Found checksum for $basename:" .
4790 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
4794 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
4796 $fh = CPAN::Tarzip->TIEHANDLE($file);
4799 my $dg = Digest::SHA->new(256);
4802 while ($fh->READ($ref, 4096) > 0){
4805 my $hexdigest = $dg->hexdigest;
4806 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
4810 $CPAN::Frontend->myprint("Checksum for $file ok\n");
4811 return $self->{CHECKSUM_STATUS} = "OK";
4813 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
4814 qq{distribution file. }.
4815 qq{Please investigate.\n\n}.
4817 $CPAN::META->instance(
4822 my $wrap = qq{I\'d recommend removing $file. Its
4823 checksum is incorrect. Maybe you have configured your 'urllist' with
4824 a bad URL. Please check this array with 'o conf urllist', and
4827 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4829 # former versions just returned here but this seems a
4830 # serious threat that deserves a die
4832 # $CPAN::Frontend->myprint("\n\n");
4836 # close $fh if fileno($fh);
4838 $self->{CHECKSUM_STATUS} ||= "";
4839 if ($self->{CHECKSUM_STATUS} eq "NIL") {
4840 $CPAN::Frontend->mywarn(qq{
4841 Warning: No checksum for $basename in $chk_file.
4843 The cause for this may be that the file is very new and the checksum
4844 has not yet been calculated, but it may also be that something is
4845 going awry right now.
4847 my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
4848 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
4850 $self->{CHECKSUM_STATUS} = "NIL -- distro not in chk_file";
4855 #-> sub CPAN::Distribution::eq_CHECKSUM ;
4857 my($self,$fh,$expect) = @_;
4858 my $dg = Digest::SHA->new(256);
4860 while (read($fh, $data, 4096)){
4863 my $hexdigest = $dg->hexdigest;
4864 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
4865 $hexdigest eq $expect;
4868 #-> sub CPAN::Distribution::force ;
4870 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
4871 # effect by autoinspection, not by inspecting a global variable. One
4872 # of the reason why this was chosen to work that way was the treatment
4873 # of dependencies. They should not automatically inherit the force
4874 # status. But this has the downside that ^C and die() will return to
4875 # the prompt but will not be able to reset the force_update
4876 # attributes. We try to correct for it currently in the read_metadata
4877 # routine, and immediately before we check for a Signal. I hope this
4878 # works out in one of v1.57_53ff
4881 my($self, $method) = @_;
4883 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
4884 writemakefile modulebuild
4886 delete $self->{$att};
4888 if ($method && $method =~ /make|test|install/) {
4889 $self->{"force_update"}++; # name should probably have been force_install
4894 my($self, $method) = @_;
4895 # warn "XDEBUG: set notest for $self $method";
4896 $self->{"notest"}++; # name should probably have been force_install
4901 # warn "XDEBUG: deleting notest";
4902 delete $self->{'notest'};
4905 #-> sub CPAN::Distribution::unforce ;
4908 delete $self->{'force_update'};
4911 #-> sub CPAN::Distribution::isa_perl ;
4914 my $file = File::Basename::basename($self->id);
4915 if ($file =~ m{ ^ perl
4928 } elsif ($self->cpan_comment
4930 $self->cpan_comment =~ /isa_perl\(.+?\)/){
4936 #-> sub CPAN::Distribution::perl ;
4942 #-> sub CPAN::Distribution::make ;
4945 my $make = $self->{modulebuild} ? "Build" : "make";
4946 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
4947 # Emergency brake if they said install Pippi and get newest perl
4948 if ($self->isa_perl) {
4950 $self->called_for ne $self->id &&
4951 ! $self->{force_update}
4953 # if we die here, we break bundles
4954 $CPAN::Frontend->mywarn(sprintf qq{
4955 The most recent version "%s" of the module "%s"
4956 comes with the current version of perl (%s).
4957 I\'ll build that only if you ask for something like
4962 $CPAN::META->instance(
4976 !$self->{archived} || $self->{archived} eq "NO" and push @e,
4977 "Is neither a tar nor a zip archive.";
4979 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
4980 "Had problems unarchiving. Please build manually";
4982 unless ($self->{force_update}) {
4983 exists $self->{signature_verify} and (
4984 $self->{signature_verify}->can("failed") ?
4985 $self->{signature_verify}->failed :
4986 $self->{signature_verify} =~ /^NO/
4988 and push @e, "Did not pass the signature test.";
4991 exists $self->{writemakefile} &&
4992 $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e,
4993 $1 || "Had some problem writing Makefile";
4995 defined $self->{'make'} and push @e,
4996 "Has already been processed within this session";
4998 if (exists $self->{later} and length($self->{later})) {
4999 if ($self->unsat_prereq) {
5000 push @e, $self->{later};
5002 delete $self->{later};
5006 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5008 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5009 my $builddir = $self->dir or
5010 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory");
5011 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5012 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5014 if ($^O eq 'MacOS') {
5015 Mac::BuildTools::make($self);
5020 if ($self->{'configure'}) {
5021 $system = $self->{'configure'};
5022 } elsif ($self->{modulebuild}) {
5023 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5024 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5026 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5028 # This needs a handler that can be turned on or off:
5029 # $switch = "-MExtUtils::MakeMaker ".
5030 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5032 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
5034 unless (exists $self->{writemakefile}) {
5035 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5038 if ($CPAN::Config->{inactivity_timeout}) {
5040 alarm $CPAN::Config->{inactivity_timeout};
5041 local $SIG{CHLD}; # = sub { wait };
5042 if (defined($pid = fork)) {
5047 # note, this exec isn't necessary if
5048 # inactivity_timeout is 0. On the Mac I'd
5049 # suggest, we set it always to 0.
5053 $CPAN::Frontend->myprint("Cannot fork: $!");
5061 $CPAN::Frontend->myprint($@);
5062 $self->{writemakefile} = "NO $@";
5067 $ret = system($system);
5069 $self->{writemakefile} = "NO '$system' returned status $ret";
5073 if (-f "Makefile" || -f "Build") {
5074 $self->{writemakefile} = "YES";
5075 delete $self->{make_clean}; # if cleaned before, enable next
5077 $self->{writemakefile} =
5078 qq{NO -- Unknown reason.};
5079 # It's probably worth it to record the reason, so let's retry
5081 # my $fh = IO::File->new("$system |"); # STDERR? STDIN?
5082 # $self->{writemakefile} .= <$fh>;
5086 delete $self->{force_update};
5089 if (my @prereq = $self->unsat_prereq){
5090 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5092 if ($self->{modulebuild}) {
5093 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5095 $system = join " ", _make_command(), $CPAN::Config->{make_arg};
5097 if (system($system) == 0) {
5098 $CPAN::Frontend->myprint(" $system -- OK\n");
5099 $self->{'make'} = CPAN::Distrostatus->new("YES");
5101 $self->{writemakefile} ||= "YES";
5102 $self->{'make'} = CPAN::Distrostatus->new("NO");
5103 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5108 return $CPAN::Config->{'make'} || $Config::Config{make} || 'make';
5111 #-> sub CPAN::Distribution::follow_prereqs ;
5112 sub follow_prereqs {
5114 my(@prereq) = grep {$_ ne "perl"} @_;
5115 return unless @prereq;
5117 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
5118 "during [$id] -----\n");
5120 for my $p (@prereq) {
5121 $CPAN::Frontend->myprint(" $p\n");
5124 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5126 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5127 require ExtUtils::MakeMaker;
5128 my $answer = ExtUtils::MakeMaker::prompt(
5129 "Shall I follow them and prepend them to the queue
5130 of modules we are processing right now?", "yes");
5131 $follow = $answer =~ /^\s*y/i;
5135 myprint(" Ignoring dependencies on modules @prereq\n");
5138 # color them as dirty
5139 for my $p (@prereq) {
5140 # warn "calling color_cmd_tmps(0,1)";
5141 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5143 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
5144 $self->{later} = "Delayed until after prerequisites";
5145 return 1; # signal success to the queuerunner
5149 #-> sub CPAN::Distribution::unsat_prereq ;
5152 my $prereq_pm = $self->prereq_pm or return;
5154 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
5155 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5156 # we were too demanding:
5157 next if $nmo->uptodate;
5159 # if they have not specified a version, we accept any installed one
5160 if (not defined $need_version or
5161 $need_version eq "0" or
5162 $need_version eq "undef") {
5163 next if defined $nmo->inst_file;
5166 # We only want to install prereqs if either they're not installed
5167 # or if the installed version is too old. We cannot omit this
5168 # check, because if 'force' is in effect, nobody else will check.
5169 if (defined $nmo->inst_file) {
5170 my(@all_requirements) = split /\s*,\s*/, $need_version;
5173 RQ: for my $rq (@all_requirements) {
5174 if ($rq =~ s|>=\s*||) {
5175 } elsif ($rq =~ s|>\s*||) {
5177 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5181 } elsif ($rq =~ s|!=\s*||) {
5183 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5189 } elsif ($rq =~ m|<=?\s*|) {
5191 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5195 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5198 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5202 CPAN::Version->readable($rq),
5206 next NEED if $ok == @all_requirements;
5209 if ($self->{sponsored_mods}{$need_module}++){
5210 # We have already sponsored it and for some reason it's still
5211 # not available. So we do nothing. Or what should we do?
5212 # if we push it again, we have a potential infinite loop
5215 push @need, $need_module;
5220 #-> sub CPAN::Distribution::read_yaml ;
5223 return $self->{yaml_content} if exists $self->{yaml_content};
5224 my $build_dir = $self->{build_dir};
5225 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5226 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
5227 return unless -f $yaml;
5228 if ($CPAN::META->has_inst("YAML")) {
5229 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5231 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5235 $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG;
5236 return $self->{yaml_content};
5239 #-> sub CPAN::Distribution::prereq_pm ;
5242 return $self->{prereq_pm} if
5243 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5244 return unless $self->{writemakefile} # no need to have succeeded
5245 # but we must have run it
5246 || $self->{modulebuild};
5248 if (my $yaml = $self->read_yaml) {
5249 $req = $yaml->{requires};
5250 undef $req unless ref $req eq "HASH" && %$req;
5252 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5253 my $eummv = do { local $^W = 0; $1+0; };
5254 if ($eummv < 6.2501) {
5255 # thanks to Slaven for digging that out: MM before
5256 # that could be wrong because it could reflect a
5263 while (my($k,$v) = each %{$req||{}}) {
5266 } elsif ($k =~ /[A-Za-z]/ &&
5268 $CPAN::META->exists("Module",$v)
5270 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5271 "requires hash: $k => $v; I'll take both ".
5272 "key and value as a module name\n");
5279 $req = $areq if $do_replace;
5281 if ($yaml->{build_requires}
5282 && ref $yaml->{build_requires}
5283 && ref $yaml->{build_requires} eq "HASH") {
5284 while (my($k,$v) = each %{$yaml->{build_requires}}) {
5286 # merging of two "requires"-type values--what should we do?
5293 delete $req->{perl};
5297 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5298 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5302 $fh = FileHandle->new("<$makefile\0")) {
5305 last if /MakeMaker post_initialize section/;
5307 \s+PREREQ_PM\s+=>\s+(.+)
5310 # warn "Found prereq expr[$p]";
5312 # Regexp modified by A.Speer to remember actual version of file
5313 # PREREQ_PM hash key wants, then add to
5314 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5315 # In case a prereq is mentioned twice, complain.
5316 if ( defined $req->{$1} ) {
5317 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5318 "last mention wins";
5324 } elsif (-f "Build") {
5325 if ($CPAN::META->has_inst("Module::Build")) {
5326 my $requires = Module::Build->current->requires();
5327 my $brequires = Module::Build->current->build_requires();
5328 $req = { %$requires, %$brequires };
5332 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5333 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5334 "undeclared prerequisite.\n".
5335 " Adding it now as a prerequisite.\n"
5337 $CPAN::Frontend->mysleep(5);
5338 $req->{"Module::Build"} = 0;
5339 delete $self->{writemakefile};
5341 $self->{prereq_pm_detected}++;
5342 return $self->{prereq_pm} = $req;
5345 #-> sub CPAN::Distribution::test ;
5350 delete $self->{force_update};
5353 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5354 if ($self->{notest}) {
5355 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5359 my $make = $self->{modulebuild} ? "Build" : "make";
5360 $CPAN::Frontend->myprint("Running $make test\n");
5361 if (my @prereq = $self->unsat_prereq){
5362 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5366 exists $self->{make} or exists $self->{later} or push @e,
5367 "Make had some problems, maybe interrupted? Won't test";
5369 exists $self->{make} and
5371 $self->{make}->can("failed") ?
5372 $self->{make}->failed :
5373 $self->{make} =~ /^NO/
5374 ) and push @e, "Can't test without successful make";
5376 exists $self->{build_dir} or push @e, "Has no own directory";
5377 $self->{badtestcnt} ||= 0;
5378 $self->{badtestcnt} > 0 and
5379 push @e, "Won't repeat unsuccessful test during this command";
5381 exists $self->{later} and length($self->{later}) and
5382 push @e, $self->{later};
5384 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5386 chdir $self->{'build_dir'} or
5387 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5388 $self->debug("Changed directory to $self->{'build_dir'}")
5391 if ($^O eq 'MacOS') {
5392 Mac::BuildTools::make_test($self);
5396 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5398 : ($ENV{PERLLIB} || "");
5400 $CPAN::META->set_perl5lib;
5402 if ($self->{modulebuild}) {
5403 $system = sprintf "%s test", $self->_build_command();
5405 $system = join " ", _make_command(), "test";
5407 if (system($system) == 0) {
5408 $CPAN::Frontend->myprint(" $system -- OK\n");
5409 $CPAN::META->is_tested($self->{'build_dir'});
5410 $self->{make_test} = CPAN::Distrostatus->new("YES");
5412 $self->{make_test} = CPAN::Distrostatus->new("NO");
5413 $self->{badtestcnt}++;
5414 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5418 #-> sub CPAN::Distribution::clean ;
5421 my $make = $self->{modulebuild} ? "Build" : "make";
5422 $CPAN::Frontend->myprint("Running $make clean\n");
5423 unless (exists $self->{build_dir}) {
5424 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5429 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5430 push @e, "make clean already called once";
5431 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5433 chdir $self->{'build_dir'} or
5434 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5435 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5437 if ($^O eq 'MacOS') {
5438 Mac::BuildTools::make_clean($self);
5443 if ($self->{modulebuild}) {
5444 $system = sprintf "%s clean", $self->_build_command();
5446 $system = join " ", _make_command(), "clean";
5448 if (system($system) == 0) {
5449 $CPAN::Frontend->myprint(" $system -- OK\n");
5453 # Jost Krieger pointed out that this "force" was wrong because
5454 # it has the effect that the next "install" on this distribution
5455 # will untar everything again. Instead we should bring the
5456 # object's state back to where it is after untarring.
5467 $self->{make_clean} = "YES";
5470 # Hmmm, what to do if make clean failed?
5472 $CPAN::Frontend->myprint(qq{ $system -- NOT OK
5474 make clean did not succeed, marking directory as unusable for further work.
5476 $self->force("make"); # so that this directory won't be used again
5481 #-> sub CPAN::Distribution::install ;
5486 delete $self->{force_update};
5489 my $make = $self->{modulebuild} ? "Build" : "make";
5490 $CPAN::Frontend->myprint("Running $make install\n");
5493 exists $self->{build_dir} or push @e, "Has no own directory";
5495 exists $self->{make} or exists $self->{later} or push @e,
5496 "Make had some problems, maybe interrupted? Won't install";
5498 exists $self->{make} and
5500 $self->{make}->can("failed") ?
5501 $self->{make}->failed :
5502 $self->{make} =~ /^NO/
5504 push @e, "make had returned bad status, install seems impossible";
5506 if (exists $self->{make_test} and
5508 $self->{make_test}->can("failed") ?
5509 $self->{make_test}->failed :
5510 $self->{make_test} =~ /^NO/
5512 if ($self->{force_update}) {
5513 $self->{make_test}->text("FAILED but failure ignored because ".
5514 "'force' in effect");
5516 push @e, "make test had returned bad status, ".
5517 "won't install without force"
5520 exists $self->{'install'} and push @e,
5521 $self->{'install'}->text eq "YES" ?
5522 "Already done" : "Already tried without success";
5524 exists $self->{later} and length($self->{later}) and
5525 push @e, $self->{later};
5527 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5529 chdir $self->{'build_dir'} or
5530 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5531 $self->debug("Changed directory to $self->{'build_dir'}")
5534 if ($^O eq 'MacOS') {
5535 Mac::BuildTools::make_install($self);
5540 if ($self->{modulebuild}) {
5541 my($mbuild_install_build_command) =
5542 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
5543 $CPAN::Config->{mbuild_install_build_command} ?
5544 $CPAN::Config->{mbuild_install_build_command} :
5545 $self->_build_command();
5546 $system = sprintf("%s install %s",
5547 $mbuild_install_build_command,
5548 $CPAN::Config->{mbuild_install_arg},
5551 my($make_install_make_command) = $CPAN::Config->{'make_install_make_command'} ||
5553 $system = sprintf("%s install %s",
5554 $make_install_make_command,
5555 $CPAN::Config->{make_install_arg},
5559 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
5560 my($pipe) = FileHandle->new("$system $stderr |");
5563 $CPAN::Frontend->myprint($_);
5568 $CPAN::Frontend->myprint(" $system -- OK\n");
5569 $CPAN::META->is_installed($self->{build_dir});
5570 return $self->{install} = CPAN::Distrostatus->new("YES");
5572 $self->{install} = CPAN::Distrostatus->new("NO");
5573 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5575 $makeout =~ /permission/s
5578 ! $CPAN::Config->{make_install_make_command}
5579 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
5582 $CPAN::Frontend->myprint(
5584 qq{ You may have to su }.
5585 qq{to root to install the package\n}.
5586 qq{ (Or you may want to run something like\n}.
5587 qq{ o conf make_install_make_command 'sudo make'\n}.
5588 qq{ to raise your permissions.}
5592 delete $self->{force_update};
5595 #-> sub CPAN::Distribution::dir ;
5597 shift->{'build_dir'};
5600 #-> sub CPAN::Distribution::perldoc ;
5604 my($dist) = $self->id;
5605 my $package = $self->called_for;
5607 $self->_display_url( $CPAN::Defaultdocs . $package );
5610 #-> sub CPAN::Distribution::_check_binary ;
5612 my ($dist,$shell,$binary) = @_;
5613 my ($pid,$readme,$out);
5615 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
5618 $pid = open $readme, "which $binary|"
5619 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
5623 close $readme or die "Could not run 'which $binary': $!";
5625 $CPAN::Frontend->myprint(qq{ + $out \n})
5626 if $CPAN::DEBUG && $out;
5631 #-> sub CPAN::Distribution::_display_url ;
5633 my($self,$url) = @_;
5634 my($res,$saved_file,$pid,$readme,$out);
5636 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
5639 # should we define it in the config instead?
5640 my $html_converter = "html2text";
5642 my $web_browser = $CPAN::Config->{'lynx'} || undef;
5643 my $web_browser_out = $web_browser
5644 ? CPAN::Distribution->_check_binary($self,$web_browser)
5647 my ($tmpout,$tmperr);
5648 if (not $web_browser_out) {
5649 # web browser not found, let's try text only
5650 my $html_converter_out =
5651 CPAN::Distribution->_check_binary($self,$html_converter);
5653 if ($html_converter_out ) {
5654 # html2text found, run it
5655 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
5656 $CPAN::Frontend->myprint(qq{ERROR: problems while getting $url, $!\n})
5657 unless defined($saved_file);
5659 $pid = open $readme, "$html_converter $saved_file |"
5660 or $CPAN::Frontend->mydie(qq{
5661 Could not fork '$html_converter $saved_file': $!});
5662 my $fh = File::Temp->new(
5663 template => 'cpan_htmlconvert_XXXX',
5671 or $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
5672 my $tmpin = $fh->filename;
5673 $CPAN::Frontend->myprint(sprintf(qq{
5675 saved output to %s\n},
5680 close $fh; undef $fh;
5682 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
5683 my $fh_pager = FileHandle->new;
5684 local($SIG{PIPE}) = "IGNORE";
5685 $fh_pager->open("|$CPAN::Config->{'pager'}")
5686 or $CPAN::Frontend->mydie(qq{
5687 Could not open pager $CPAN::Config->{'pager'}: $!});
5688 $CPAN::Frontend->myprint(qq{
5691 with pager "$CPAN::Config->{'pager'}"
5694 $fh_pager->print(<$fh>);
5697 # coldn't find the web browser or html converter
5698 $CPAN::Frontend->myprint(qq{
5699 You need to install lynx or $html_converter to use this feature.});
5702 # web browser found, run the action
5703 my $browser = $CPAN::Config->{'lynx'};
5704 $CPAN::Frontend->myprint(qq{system[$browser $url]})
5706 $CPAN::Frontend->myprint(qq{
5709 with browser $browser
5712 system("$browser $url");
5713 if ($saved_file) { 1 while unlink($saved_file) }
5717 #-> sub CPAN::Distribution::_getsave_url ;
5719 my($dist, $shell, $url) = @_;
5721 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
5724 my $fh = File::Temp->new(
5725 template => "cpan_getsave_url_XXXX",
5729 my $tmpin = $fh->filename;
5730 if ($CPAN::META->has_usable('LWP')) {
5731 $CPAN::Frontend->myprint("Fetching with LWP:
5735 CPAN::LWP::UserAgent->config;
5736 eval { $Ua = CPAN::LWP::UserAgent->new; };
5738 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
5742 $Ua->proxy('http', $var)
5743 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
5745 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
5748 my $req = HTTP::Request->new(GET => $url);
5749 $req->header('Accept' => 'text/html');
5750 my $res = $Ua->request($req);
5751 if ($res->is_success) {
5752 $CPAN::Frontend->myprint(" + request successful.\n")
5754 print $fh $res->content;
5756 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
5760 $CPAN::Frontend->myprint(sprintf(
5761 "LWP failed with code[%s], message[%s]\n",
5768 $CPAN::Frontend->myprint("LWP not available\n");
5773 # sub CPAN::Distribution::_build_command
5774 sub _build_command {
5776 if ($^O eq "MSWin32") { # special code needed at least up to
5777 # Module::Build 0.2611 and 0.2706; a fix
5778 # in M:B has been promised 2006-01-30
5779 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
5780 return "$perl ./Build";
5785 package CPAN::Bundle;
5790 $CPAN::Frontend->myprint($self->as_string);
5795 delete $self->{later};
5796 for my $c ( $self->contains ) {
5797 my $obj = CPAN::Shell->expandany($c) or next;
5802 # mark as dirty/clean
5803 #-> sub CPAN::Bundle::color_cmd_tmps ;
5804 sub color_cmd_tmps {
5806 my($depth) = shift || 0;
5807 my($color) = shift || 0;
5808 my($ancestors) = shift || [];
5809 # a module needs to recurse to its cpan_file, a distribution needs
5810 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
5812 return if exists $self->{incommandcolor}
5813 && $self->{incommandcolor}==$color;
5815 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5817 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5819 for my $c ( $self->contains ) {
5820 my $obj = CPAN::Shell->expandany($c) or next;
5821 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
5822 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5825 delete $self->{badtestcnt};
5827 $self->{incommandcolor} = $color;
5830 #-> sub CPAN::Bundle::as_string ;
5834 # following line must be "=", not "||=" because we have a moving target
5835 $self->{INST_VERSION} = $self->inst_version;
5836 return $self->SUPER::as_string;
5839 #-> sub CPAN::Bundle::contains ;
5842 my($inst_file) = $self->inst_file || "";
5843 my($id) = $self->id;
5844 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
5845 unless ($inst_file) {
5846 # Try to get at it in the cpan directory
5847 $self->debug("no inst_file") if $CPAN::DEBUG;
5849 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
5850 $cpan_file = $self->cpan_file;
5851 if ($cpan_file eq "N/A") {
5852 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
5853 Maybe stale symlink? Maybe removed during session? Giving up.\n");
5855 my $dist = $CPAN::META->instance('CPAN::Distribution',
5858 $self->debug($dist->as_string) if $CPAN::DEBUG;
5859 my($todir) = $CPAN::Config->{'cpan_home'};
5860 my(@me,$from,$to,$me);
5861 @me = split /::/, $self->id;
5863 $me = File::Spec->catfile(@me);
5864 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
5865 $to = File::Spec->catfile($todir,$me);
5866 File::Path::mkpath(File::Basename::dirname($to));
5867 File::Copy::copy($from, $to)
5868 or Carp::confess("Couldn't copy $from to $to: $!");
5872 my $fh = FileHandle->new;
5874 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
5876 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
5878 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
5879 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
5880 next unless $in_cont;
5885 push @result, (split " ", $_, 2)[0];
5888 delete $self->{STATUS};
5889 $self->{CONTAINS} = \@result;
5890 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
5892 $CPAN::Frontend->mywarn(qq{
5893 The bundle file "$inst_file" may be a broken
5894 bundlefile. It seems not to contain any bundle definition.
5895 Please check the file and if it is bogus, please delete it.
5896 Sorry for the inconvenience.
5902 #-> sub CPAN::Bundle::find_bundle_file
5903 sub find_bundle_file {
5904 my($self,$where,$what) = @_;
5905 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
5906 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
5907 ### my $bu = File::Spec->catfile($where,$what);
5908 ### return $bu if -f $bu;
5909 my $manifest = File::Spec->catfile($where,"MANIFEST");
5910 unless (-f $manifest) {
5911 require ExtUtils::Manifest;
5912 my $cwd = CPAN::anycwd();
5913 chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
5914 ExtUtils::Manifest::mkmanifest();
5915 chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
5917 my $fh = FileHandle->new($manifest)
5918 or Carp::croak("Couldn't open $manifest: $!");
5921 if ($^O eq 'MacOS') {
5924 $what2 =~ s/:Bundle://;
5927 $what2 =~ s|Bundle[/\\]||;
5932 my($file) = /(\S+)/;
5933 if ($file =~ m|\Q$what\E$|) {
5935 # return File::Spec->catfile($where,$bu); # bad
5938 # retry if she managed to
5939 # have no Bundle directory
5940 $bu = $file if $file =~ m|\Q$what2\E$|;
5942 $bu =~ tr|/|:| if $^O eq 'MacOS';
5943 return File::Spec->catfile($where, $bu) if $bu;
5944 Carp::croak("Couldn't find a Bundle file in $where");
5947 # needs to work quite differently from Module::inst_file because of
5948 # cpan_home/Bundle/ directory and the possibility that we have
5949 # shadowing effect. As it makes no sense to take the first in @INC for
5950 # Bundles, we parse them all for $VERSION and take the newest.
5952 #-> sub CPAN::Bundle::inst_file ;
5957 @me = split /::/, $self->id;
5960 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
5961 my $bfile = File::Spec->catfile($incdir, @me);
5962 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
5963 next unless -f $bfile;
5964 my $foundv = MM->parse_version($bfile);
5965 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
5966 $self->{INST_FILE} = $bfile;
5967 $self->{INST_VERSION} = $bestv = $foundv;
5973 #-> sub CPAN::Bundle::inst_version ;
5976 $self->inst_file; # finds INST_VERSION as side effect
5977 $self->{INST_VERSION};
5980 #-> sub CPAN::Bundle::rematein ;
5982 my($self,$meth) = @_;
5983 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
5984 my($id) = $self->id;
5985 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
5986 unless $self->inst_file || $self->cpan_file;
5988 for $s ($self->contains) {
5989 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
5990 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
5991 if ($type eq 'CPAN::Distribution') {
5992 $CPAN::Frontend->mywarn(qq{
5993 The Bundle }.$self->id.qq{ contains
5994 explicitly a file $s.
5998 # possibly noisy action:
5999 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
6000 my $obj = $CPAN::META->instance($type,$s);
6002 if ($obj->isa('CPAN::Bundle')
6004 exists $obj->{install_failed}
6006 ref($obj->{install_failed}) eq "HASH"
6008 for (keys %{$obj->{install_failed}}) {
6009 $self->{install_failed}{$_} = undef; # propagate faiure up
6012 $fail{$s} = 1; # the bundle itself may have succeeded but
6017 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
6018 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
6020 delete $self->{install_failed}{$s};
6027 # recap with less noise
6028 if ( $meth eq "install" ) {
6031 my $raw = sprintf(qq{Bundle summary:
6032 The following items in bundle %s had installation problems:},
6035 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
6036 $CPAN::Frontend->myprint("\n");
6039 for $s ($self->contains) {
6041 $paragraph .= "$s ";
6042 $self->{install_failed}{$s} = undef;
6043 $reported{$s} = undef;
6046 my $report_propagated;
6047 for $s (sort keys %{$self->{install_failed}}) {
6048 next if exists $reported{$s};
6049 $paragraph .= "and the following items had problems
6050 during recursive bundle calls: " unless $report_propagated++;
6051 $paragraph .= "$s ";
6053 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
6054 $CPAN::Frontend->myprint("\n");
6056 $self->{'install'} = 'YES';
6061 #sub CPAN::Bundle::xs_file
6063 # If a bundle contains another that contains an xs_file we have
6064 # here, we just don't bother I suppose
6068 #-> sub CPAN::Bundle::force ;
6069 sub force { shift->rematein('force',@_); }
6070 #-> sub CPAN::Bundle::notest ;
6071 sub notest { shift->rematein('notest',@_); }
6072 #-> sub CPAN::Bundle::get ;
6073 sub get { shift->rematein('get',@_); }
6074 #-> sub CPAN::Bundle::make ;
6075 sub make { shift->rematein('make',@_); }
6076 #-> sub CPAN::Bundle::test ;
6079 $self->{badtestcnt} ||= 0;
6080 $self->rematein('test',@_);
6082 #-> sub CPAN::Bundle::install ;
6085 $self->rematein('install',@_);
6087 #-> sub CPAN::Bundle::clean ;
6088 sub clean { shift->rematein('clean',@_); }
6090 #-> sub CPAN::Bundle::uptodate ;
6093 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
6095 foreach $c ($self->contains) {
6096 my $obj = CPAN::Shell->expandany($c);
6097 return 0 unless $obj->uptodate;
6102 #-> sub CPAN::Bundle::readme ;
6105 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
6106 No File found for bundle } . $self->id . qq{\n}), return;
6107 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
6108 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
6111 package CPAN::Module;
6115 # sub CPAN::Module::userid
6120 return $ro->{userid} || $ro->{CPAN_USERID};
6122 # sub CPAN::Module::description
6125 my $ro = $self->ro or return "";
6131 CPAN::Shell->expand("Distribution",$self->cpan_file);
6134 # sub CPAN::Module::undelay
6137 delete $self->{later};
6138 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6143 # mark as dirty/clean
6144 #-> sub CPAN::Module::color_cmd_tmps ;
6145 sub color_cmd_tmps {
6147 my($depth) = shift || 0;
6148 my($color) = shift || 0;
6149 my($ancestors) = shift || [];
6150 # a module needs to recurse to its cpan_file
6152 return if exists $self->{incommandcolor}
6153 && $self->{incommandcolor}==$color;
6154 return if $depth>=1 && $self->uptodate;
6156 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6158 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6160 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6161 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6164 delete $self->{badtestcnt};
6166 $self->{incommandcolor} = $color;
6169 #-> sub CPAN::Module::as_glimpse ;
6173 my $class = ref($self);
6174 $class =~ s/^CPAN:://;
6178 $CPAN::Shell::COLOR_REGISTERED
6180 $CPAN::META->has_inst("Term::ANSIColor")
6184 $color_on = Term::ANSIColor::color("green");
6185 $color_off = Term::ANSIColor::color("reset");
6187 push @m, sprintf("%-8s %s%-22s%s (%s)\n",
6192 $self->distribution ? $self->distribution->pretty_id : $self->id,
6197 #-> sub CPAN::Module::as_string ;
6201 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6202 my $class = ref($self);
6203 $class =~ s/^CPAN:://;
6205 push @m, $class, " id = $self->{ID}\n";
6206 my $sprintf = " %-12s %s\n";
6207 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6208 if $self->description;
6209 my $sprintf2 = " %-12s %s (%s)\n";
6211 $userid = $self->userid;
6214 if ($author = CPAN::Shell->expand('Author',$userid)) {
6217 if ($m = $author->email) {
6224 $author->fullname . $email
6228 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6229 if $self->cpan_version;
6230 if (my $cpan_file = $self->cpan_file){
6231 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6232 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6233 my $upload_date = $dist->upload_date;
6235 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6239 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
6240 my(%statd,%stats,%statl,%stati);
6241 @statd{qw,? i c a b R M S,} = qw,unknown idea
6242 pre-alpha alpha beta released mature standard,;
6243 @stats{qw,? m d u n a,} = qw,unknown mailing-list
6244 developer comp.lang.perl.* none abandoned,;
6245 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
6246 @stati{qw,? f r O h,} = qw,unknown functions
6247 references+ties object-oriented hybrid,;
6248 $statd{' '} = 'unknown';
6249 $stats{' '} = 'unknown';
6250 $statl{' '} = 'unknown';
6251 $stati{' '} = 'unknown';
6260 $statd{$ro->{statd}},
6261 $stats{$ro->{stats}},
6262 $statl{$ro->{statl}},
6263 $stati{$ro->{stati}}
6264 ) if $ro && $ro->{statd};
6265 my $local_file = $self->inst_file;
6266 unless ($self->{MANPAGE}) {
6268 $self->{MANPAGE} = $self->manpage_headline($local_file);
6270 # If we have already untarred it, we should look there
6271 my $dist = $CPAN::META->instance('CPAN::Distribution',
6273 # warn "dist[$dist]";
6274 # mff=manifest file; mfh=manifest handle
6279 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6281 $mfh = FileHandle->new($mff)
6283 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6284 my $lfre = $self->id; # local file RE
6287 my($lfl); # local file file
6289 my(@mflines) = <$mfh>;
6294 while (length($lfre)>5 and !$lfl) {
6295 ($lfl) = grep /$lfre/, @mflines;
6296 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6299 $lfl =~ s/\s.*//; # remove comments
6300 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6301 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6302 # warn "lfl_abs[$lfl_abs]";
6304 $self->{MANPAGE} = $self->manpage_headline($lfl_abs);
6310 for $item (qw/MANPAGE/) {
6311 push @m, sprintf($sprintf, $item, $self->{$item})
6312 if exists $self->{$item};
6314 for $item (qw/CONTAINS/) {
6315 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6316 if exists $self->{$item} && @{$self->{$item}};
6318 push @m, sprintf($sprintf, 'INST_FILE',
6319 $local_file || "(not installed)");
6320 push @m, sprintf($sprintf, 'INST_VERSION',
6321 $self->inst_version) if $local_file;
6325 sub manpage_headline {
6326 my($self,$local_file) = @_;
6327 my(@local_file) = $local_file;
6328 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6329 push @local_file, $local_file;
6331 for $locf (@local_file) {
6332 next unless -f $locf;
6333 my $fh = FileHandle->new($locf)
6334 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6338 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6339 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6356 #-> sub CPAN::Module::cpan_file ;
6357 # Note: also inherited by CPAN::Bundle
6360 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6361 unless ($self->ro) {
6362 CPAN::Index->reload;
6365 if ($ro && defined $ro->{CPAN_FILE}){
6366 return $ro->{CPAN_FILE};
6368 my $userid = $self->userid;
6370 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6371 my $author = $CPAN::META->instance("CPAN::Author",
6373 my $fullname = $author->fullname;
6374 my $email = $author->email;
6375 unless (defined $fullname && defined $email) {
6376 return sprintf("Contact Author %s",
6380 return "Contact Author $fullname <$email>";
6382 return "Contact Author $userid (Email address not available)";
6390 #-> sub CPAN::Module::cpan_version ;
6396 # Can happen with modules that are not on CPAN
6399 $ro->{CPAN_VERSION} = 'undef'
6400 unless defined $ro->{CPAN_VERSION};
6401 $ro->{CPAN_VERSION};
6404 #-> sub CPAN::Module::force ;
6407 $self->{'force_update'}++;
6412 # warn "XDEBUG: set notest for Module";
6413 $self->{'notest'}++;
6416 #-> sub CPAN::Module::rematein ;
6418 my($self,$meth) = @_;
6419 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
6422 my $cpan_file = $self->cpan_file;
6423 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
6424 $CPAN::Frontend->mywarn(sprintf qq{
6425 The module %s isn\'t available on CPAN.
6427 Either the module has not yet been uploaded to CPAN, or it is
6428 temporary unavailable. Please contact the author to find out
6429 more about the status. Try 'i %s'.
6436 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
6437 $pack->called_for($self->id);
6438 $pack->force($meth) if exists $self->{'force_update'};
6439 $pack->notest($meth) if exists $self->{'notest'};
6444 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
6445 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
6446 delete $self->{'force_update'};
6447 delete $self->{'notest'};
6453 #-> sub CPAN::Module::perldoc ;
6454 sub perldoc { shift->rematein('perldoc') }
6455 #-> sub CPAN::Module::readme ;
6456 sub readme { shift->rematein('readme') }
6457 #-> sub CPAN::Module::look ;
6458 sub look { shift->rematein('look') }
6459 #-> sub CPAN::Module::cvs_import ;
6460 sub cvs_import { shift->rematein('cvs_import') }
6461 #-> sub CPAN::Module::get ;
6462 sub get { shift->rematein('get',@_) }
6463 #-> sub CPAN::Module::make ;
6464 sub make { shift->rematein('make') }
6465 #-> sub CPAN::Module::test ;
6468 $self->{badtestcnt} ||= 0;
6469 $self->rematein('test',@_);
6471 #-> sub CPAN::Module::uptodate ;
6474 my($latest) = $self->cpan_version;
6476 my($inst_file) = $self->inst_file;
6478 if (defined $inst_file) {
6479 $have = $self->inst_version;
6484 ! CPAN::Version->vgt($latest, $have)
6486 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
6487 "latest[$latest] have[$have]") if $CPAN::DEBUG;
6492 #-> sub CPAN::Module::install ;
6498 not exists $self->{'force_update'}
6500 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
6502 $self->inst_version,
6508 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
6509 $CPAN::Frontend->mywarn(qq{
6510 \n\n\n ***WARNING***
6511 The module $self->{ID} has no active maintainer.\n\n\n
6515 $self->rematein('install') if $doit;
6517 #-> sub CPAN::Module::clean ;
6518 sub clean { shift->rematein('clean') }
6520 #-> sub CPAN::Module::inst_file ;
6524 @packpath = split /::/, $self->{ID};
6525 $packpath[-1] .= ".pm";
6526 foreach $dir (@INC) {
6527 my $pmfile = File::Spec->catfile($dir,@packpath);
6535 #-> sub CPAN::Module::xs_file ;
6539 @packpath = split /::/, $self->{ID};
6540 push @packpath, $packpath[-1];
6541 $packpath[-1] .= "." . $Config::Config{'dlext'};
6542 foreach $dir (@INC) {
6543 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
6551 #-> sub CPAN::Module::inst_version ;
6554 my $parsefile = $self->inst_file or return;
6555 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
6558 # there was a bug in 5.6.0 that let lots of unini warnings out of
6559 # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove
6560 # the following workaround after 5.6.1 is out.
6561 local($SIG{__WARN__}) = sub { my $w = shift;
6562 return if $w =~ /uninitialized/i;
6566 $have = MM->parse_version($parsefile) || "undef";
6567 $have =~ s/^ //; # since the %vd hack these two lines here are needed
6568 $have =~ s/ $//; # trailing whitespace happens all the time
6570 # My thoughts about why %vd processing should happen here
6572 # Alt1 maintain it as string with leading v:
6573 # read index files do nothing
6574 # compare it use utility for compare
6575 # print it do nothing
6577 # Alt2 maintain it as what it is
6578 # read index files convert
6579 # compare it use utility because there's still a ">" vs "gt" issue
6580 # print it use CPAN::Version for print
6582 # Seems cleaner to hold it in memory as a string starting with a "v"
6584 # If the author of this module made a mistake and wrote a quoted
6585 # "v1.13" instead of v1.13, we simply leave it at that with the
6586 # effect that *we* will treat it like a v-tring while the rest of
6587 # perl won't. Seems sensible when we consider that any action we
6588 # could take now would just add complexity.
6590 $have = CPAN::Version->readable($have);
6592 $have =~ s/\s*//g; # stringify to float around floating point issues
6593 $have; # no stringify needed, \s* above matches always
6605 CPAN - query, download and build perl modules from CPAN sites
6611 perl -MCPAN -e shell;
6619 $mod = "Acme::Meta";
6621 CPAN::Shell->install($mod); # same thing
6622 CPAN::Shell->expandany($mod)->install; # same thing
6623 CPAN::Shell->expand("Module",$mod)->install; # same thing
6624 CPAN::Shell->expand("Module",$mod)
6625 ->distribution->install; # same thing
6629 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
6630 install $distro; # same thing
6631 CPAN::Shell->install($distro); # same thing
6632 CPAN::Shell->expandany($distro)->install; # same thing
6633 CPAN::Shell->expand("Module",$distro)->install; # same thing
6637 This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
6638 of a modern rewrite from ground up with greater extensibility and more
6639 features but no full compatibility. If you're new to CPAN.pm, you
6640 probably should investigate if CPANPLUS is the better choice for you.
6641 If you're already used to CPAN.pm you're welcome to continue using it,
6642 if you accept that its development is mostly (though not completely)
6647 The CPAN module is designed to automate the make and install of perl
6648 modules and extensions. It includes some primitive searching
6649 capabilities and knows how to use Net::FTP or LWP (or some external
6650 download clients) to fetch the raw data from the net.
6652 Modules are fetched from one or more of the mirrored CPAN
6653 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
6656 The CPAN module also supports the concept of named and versioned
6657 I<bundles> of modules. Bundles simplify the handling of sets of
6658 related modules. See Bundles below.
6660 The package contains a session manager and a cache manager. There is
6661 no status retained between sessions. The session manager keeps track
6662 of what has been fetched, built and installed in the current
6663 session. The cache manager keeps track of the disk space occupied by
6664 the make processes and deletes excess space according to a simple FIFO
6667 All methods provided are accessible in a programmer style and in an
6668 interactive shell style.
6670 =head2 Interactive Mode
6672 The interactive mode is entered by running
6674 perl -MCPAN -e shell
6676 which puts you into a readline interface. You will have the most fun if
6677 you install Term::ReadKey and Term::ReadLine to enjoy both history and
6680 Once you are on the command line, type 'h' and the rest should be
6683 The function call C<shell> takes two optional arguments, one is the
6684 prompt, the second is the default initial command line (the latter
6685 only works if a real ReadLine interface module is installed).
6687 The most common uses of the interactive modes are
6691 =item Searching for authors, bundles, distribution files and modules
6693 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
6694 for each of the four categories and another, C<i> for any of the
6695 mentioned four. Each of the four entities is implemented as a class
6696 with slightly differing methods for displaying an object.
6698 Arguments you pass to these commands are either strings exactly matching
6699 the identification string of an object or regular expressions that are
6700 then matched case-insensitively against various attributes of the
6701 objects. The parser recognizes a regular expression only if you
6702 enclose it between two slashes.
6704 The principle is that the number of found objects influences how an
6705 item is displayed. If the search finds one item, the result is
6706 displayed with the rather verbose method C<as_string>, but if we find
6707 more than one, we display each object with the terse method
6710 =item make, test, install, clean modules or distributions
6712 These commands take any number of arguments and investigate what is
6713 necessary to perform the action. If the argument is a distribution
6714 file name (recognized by embedded slashes), it is processed. If it is
6715 a module, CPAN determines the distribution file in which this module
6716 is included and processes that, following any dependencies named in
6717 the module's META.yml or Makefile.PL (this behavior is controlled by
6718 the configuration parameter C<prerequisites_policy>.)
6720 Any C<make> or C<test> are run unconditionally. An
6722 install <distribution_file>
6724 also is run unconditionally. But for
6728 CPAN checks if an install is actually needed for it and prints
6729 I<module up to date> in the case that the distribution file containing
6730 the module doesn't need to be updated.
6732 CPAN also keeps track of what it has done within the current session
6733 and doesn't try to build a package a second time regardless if it
6734 succeeded or not. The C<force> pragma may precede another command
6735 (currently: C<make>, C<test>, or C<install>) and executes the
6736 command from scratch and tries to continue in case of some errors.
6740 cpan> install OpenGL
6741 OpenGL is up to date.
6742 cpan> force install OpenGL
6745 OpenGL-0.4/COPYRIGHT
6748 The C<notest> pragma may be set to skip the test part in the build
6753 cpan> notest install Tk
6755 A C<clean> command results in a
6759 being executed within the distribution file's working directory.
6761 =item get, readme, perldoc, look module or distribution
6763 C<get> downloads a distribution file without further action. C<readme>
6764 displays the README file of the associated distribution. C<Look> gets
6765 and untars (if not yet done) the distribution file, changes to the
6766 appropriate directory and opens a subshell process in that directory.
6767 C<perldoc> displays the pod documentation of the module in html or
6772 =item ls globbing_expression
6774 The first form lists all distribution files in and below an author's
6775 CPAN directory as they are stored in the CHECKUMS files distributed on
6776 CPAN. The listing goes recursive into all subdirectories.
6778 The second form allows to limit or expand the output with shell
6779 globbing as in the following examples:
6785 The last example is very slow and outputs extra progress indicators
6786 that break the alignment of the result.
6788 Note that globbing only lists directories explicitly asked for, for
6789 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
6790 regarded as a bug and may be changed in future versions.
6794 The C<failed> command reports all distributions that failed on one of
6795 C<make>, C<test> or C<install> for some reason in the currently
6796 running shell session.
6800 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
6801 (but the directory can be configured via the C<cpan_home> config
6802 variable). The shell is a bit picky if you try to start another CPAN
6803 session. It dies immediately if there is a lockfile and the lock seems
6804 to belong to a running process. In case you want to run a second shell
6805 session, it is probably safest to maintain another directory, say
6806 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
6807 contains the configuration options. Then you can start the second
6810 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
6814 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
6815 in the cpan-shell it is intended that you can press C<^C> anytime and
6816 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
6817 to clean up and leave the shell loop. You can emulate the effect of a
6818 SIGTERM by sending two consecutive SIGINTs, which usually means by
6819 pressing C<^C> twice.
6821 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
6822 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
6823 Build.PL> subprocess.
6829 The commands that are available in the shell interface are methods in
6830 the package CPAN::Shell. If you enter the shell command, all your
6831 input is split by the Text::ParseWords::shellwords() routine which
6832 acts like most shells do. The first word is being interpreted as the
6833 method to be called and the rest of the words are treated as arguments
6834 to this method. Continuation lines are supported if a line ends with a
6839 C<autobundle> writes a bundle file into the
6840 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
6841 a list of all modules that are both available from CPAN and currently
6842 installed within @INC. The name of the bundle file is based on the
6843 current date and a counter.
6847 recompile() is a very special command in that it takes no argument and
6848 runs the make/test/install cycle with brute force over all installed
6849 dynamically loadable extensions (aka XS modules) with 'force' in
6850 effect. The primary purpose of this command is to finish a network
6851 installation. Imagine, you have a common source tree for two different
6852 architectures. You decide to do a completely independent fresh
6853 installation. You start on one architecture with the help of a Bundle
6854 file produced earlier. CPAN installs the whole Bundle for you, but
6855 when you try to repeat the job on the second architecture, CPAN
6856 responds with a C<"Foo up to date"> message for all modules. So you
6857 invoke CPAN's recompile on the second architecture and you're done.
6859 Another popular use for C<recompile> is to act as a rescue in case your
6860 perl breaks binary compatibility. If one of the modules that CPAN uses
6861 is in turn depending on binary compatibility (so you cannot run CPAN
6862 commands), then you should try the CPAN::Nox module for recovery.
6866 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
6867 directory so that you can save your own preferences instead of the
6870 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
6872 Although it may be considered internal, the class hierarchy does matter
6873 for both users and programmer. CPAN.pm deals with above mentioned four
6874 classes, and all those classes share a set of methods. A classical
6875 single polymorphism is in effect. A metaclass object registers all
6876 objects of all kinds and indexes them with a string. The strings
6877 referencing objects have a separated namespace (well, not completely
6882 words containing a "/" (slash) Distribution
6883 words starting with Bundle:: Bundle
6884 everything else Module or Author
6886 Modules know their associated Distribution objects. They always refer
6887 to the most recent official release. Developers may mark their releases
6888 as unstable development versions (by inserting an underbar into the
6889 module version number which will also be reflected in the distribution
6890 name when you run 'make dist'), so the really hottest and newest
6891 distribution is not always the default. If a module Foo circulates
6892 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
6893 way to install version 1.23 by saying
6897 This would install the complete distribution file (say
6898 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
6899 like to install version 1.23_90, you need to know where the
6900 distribution file resides on CPAN relative to the authors/id/
6901 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
6902 so you would have to say
6904 install BAR/Foo-1.23_90.tar.gz
6906 The first example will be driven by an object of the class
6907 CPAN::Module, the second by an object of class CPAN::Distribution.
6909 =head2 Programmer's interface
6911 If you do not enter the shell, the available shell commands are both
6912 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
6913 functions in the calling package (C<install(...)>).
6915 There's currently only one class that has a stable interface -
6916 CPAN::Shell. All commands that are available in the CPAN shell are
6917 methods of the class CPAN::Shell. Each of the commands that produce
6918 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
6919 the IDs of all modules within the list.
6923 =item expand($type,@things)
6925 The IDs of all objects available within a program are strings that can
6926 be expanded to the corresponding real objects with the
6927 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
6928 list of CPAN::Module objects according to the C<@things> arguments
6929 given. In scalar context it only returns the first element of the
6932 =item expandany(@things)
6934 Like expand, but returns objects of the appropriate type, i.e.
6935 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
6936 CPAN::Distribution objects for distributions. Note: it does not expand
6937 to CPAN::Author objects.
6939 =item Programming Examples
6941 This enables the programmer to do operations that combine
6942 functionalities that are available in the shell.
6944 # install everything that is outdated on my disk:
6945 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
6947 # install my favorite programs if necessary:
6948 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
6949 my $obj = CPAN::Shell->expand('Module',$mod);
6953 # list all modules on my disk that have no VERSION number
6954 for $mod (CPAN::Shell->expand("Module","/./")){
6955 next unless $mod->inst_file;
6956 # MakeMaker convention for undefined $VERSION:
6957 next unless $mod->inst_version eq "undef";
6958 print "No VERSION in ", $mod->id, "\n";
6961 # find out which distribution on CPAN contains a module:
6962 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
6964 Or if you want to write a cronjob to watch The CPAN, you could list
6965 all modules that need updating. First a quick and dirty way:
6967 perl -e 'use CPAN; CPAN::Shell->r;'
6969 If you don't want to get any output in the case that all modules are
6970 up to date, you can parse the output of above command for the regular
6971 expression //modules are up to date// and decide to mail the output
6972 only if it doesn't match. Ick?
6974 If you prefer to do it more in a programmer style in one single
6975 process, maybe something like this suits you better:
6977 # list all modules on my disk that have newer versions on CPAN
6978 for $mod (CPAN::Shell->expand("Module","/./")){
6979 next unless $mod->inst_file;
6980 next if $mod->uptodate;
6981 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
6982 $mod->id, $mod->inst_version, $mod->cpan_version;
6985 If that gives you too much output every day, you maybe only want to
6986 watch for three modules. You can write
6988 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
6990 as the first line instead. Or you can combine some of the above
6993 # watch only for a new mod_perl module
6994 $mod = CPAN::Shell->expand("Module","mod_perl");
6995 exit if $mod->uptodate;
6996 # new mod_perl arrived, let me know all update recommendations
7001 =head2 Methods in the other Classes
7003 The programming interface for the classes CPAN::Module,
7004 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
7005 beta and partially even alpha. In the following paragraphs only those
7006 methods are documented that have proven useful over a longer time and
7007 thus are unlikely to change.
7011 =item CPAN::Author::as_glimpse()
7013 Returns a one-line description of the author
7015 =item CPAN::Author::as_string()
7017 Returns a multi-line description of the author
7019 =item CPAN::Author::email()
7021 Returns the author's email address
7023 =item CPAN::Author::fullname()
7025 Returns the author's name
7027 =item CPAN::Author::name()
7029 An alias for fullname
7031 =item CPAN::Bundle::as_glimpse()
7033 Returns a one-line description of the bundle
7035 =item CPAN::Bundle::as_string()
7037 Returns a multi-line description of the bundle
7039 =item CPAN::Bundle::clean()
7041 Recursively runs the C<clean> method on all items contained in the bundle.
7043 =item CPAN::Bundle::contains()
7045 Returns a list of objects' IDs contained in a bundle. The associated
7046 objects may be bundles, modules or distributions.
7048 =item CPAN::Bundle::force($method,@args)
7050 Forces CPAN to perform a task that normally would have failed. Force
7051 takes as arguments a method name to be called and any number of
7052 additional arguments that should be passed to the called method. The
7053 internals of the object get the needed changes so that CPAN.pm does
7054 not refuse to take the action. The C<force> is passed recursively to
7055 all contained objects.
7057 =item CPAN::Bundle::get()
7059 Recursively runs the C<get> method on all items contained in the bundle
7061 =item CPAN::Bundle::inst_file()
7063 Returns the highest installed version of the bundle in either @INC or
7064 C<$CPAN::Config->{cpan_home}>. Note that this is different from
7065 CPAN::Module::inst_file.
7067 =item CPAN::Bundle::inst_version()
7069 Like CPAN::Bundle::inst_file, but returns the $VERSION
7071 =item CPAN::Bundle::uptodate()
7073 Returns 1 if the bundle itself and all its members are uptodate.
7075 =item CPAN::Bundle::install()
7077 Recursively runs the C<install> method on all items contained in the bundle
7079 =item CPAN::Bundle::make()
7081 Recursively runs the C<make> method on all items contained in the bundle
7083 =item CPAN::Bundle::readme()
7085 Recursively runs the C<readme> method on all items contained in the bundle
7087 =item CPAN::Bundle::test()
7089 Recursively runs the C<test> method on all items contained in the bundle
7091 =item CPAN::Distribution::as_glimpse()
7093 Returns a one-line description of the distribution
7095 =item CPAN::Distribution::as_string()
7097 Returns a multi-line description of the distribution
7099 =item CPAN::Distribution::clean()
7101 Changes to the directory where the distribution has been unpacked and
7102 runs C<make clean> there.
7104 =item CPAN::Distribution::containsmods()
7106 Returns a list of IDs of modules contained in a distribution file.
7107 Only works for distributions listed in the 02packages.details.txt.gz
7108 file. This typically means that only the most recent version of a
7109 distribution is covered.
7111 =item CPAN::Distribution::cvs_import()
7113 Changes to the directory where the distribution has been unpacked and
7116 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
7120 =item CPAN::Distribution::dir()
7122 Returns the directory into which this distribution has been unpacked.
7124 =item CPAN::Distribution::force($method,@args)
7126 Forces CPAN to perform a task that normally would have failed. Force
7127 takes as arguments a method name to be called and any number of
7128 additional arguments that should be passed to the called method. The
7129 internals of the object get the needed changes so that CPAN.pm does
7130 not refuse to take the action.
7132 =item CPAN::Distribution::get()
7134 Downloads the distribution from CPAN and unpacks it. Does nothing if
7135 the distribution has already been downloaded and unpacked within the
7138 =item CPAN::Distribution::install()
7140 Changes to the directory where the distribution has been unpacked and
7141 runs the external command C<make install> there. If C<make> has not
7142 yet been run, it will be run first. A C<make test> will be issued in
7143 any case and if this fails, the install will be canceled. The
7144 cancellation can be avoided by letting C<force> run the C<install> for
7147 =item CPAN::Distribution::isa_perl()
7149 Returns 1 if this distribution file seems to be a perl distribution.
7150 Normally this is derived from the file name only, but the index from
7151 CPAN can contain a hint to achieve a return value of true for other
7154 =item CPAN::Distribution::look()
7156 Changes to the directory where the distribution has been unpacked and
7157 opens a subshell there. Exiting the subshell returns.
7159 =item CPAN::Distribution::make()
7161 First runs the C<get> method to make sure the distribution is
7162 downloaded and unpacked. Changes to the directory where the
7163 distribution has been unpacked and runs the external commands C<perl
7164 Makefile.PL> or C<perl Build.PL> and C<make> there.
7166 =item CPAN::Distribution::prereq_pm()
7168 Returns the hash reference that has been announced by a distribution
7169 as the C<requires> element of the META.yml or the C<PREREQ_PM> hash in
7170 the C<Makefile.PL>. Note: works only after an attempt has been made to
7171 C<make> the distribution. Returns undef otherwise.
7173 =item CPAN::Distribution::readme()
7175 Downloads the README file associated with a distribution and runs it
7176 through the pager specified in C<$CPAN::Config->{pager}>.
7178 =item CPAN::Distribution::perldoc()
7180 Downloads the pod documentation of the file associated with a
7181 distribution (in html format) and runs it through the external
7182 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
7183 isn't available, it converts it to plain text with external
7184 command html2text and runs it through the pager specified
7185 in C<$CPAN::Config->{pager}>
7187 =item CPAN::Distribution::test()
7189 Changes to the directory where the distribution has been unpacked and
7190 runs C<make test> there.
7192 =item CPAN::Distribution::uptodate()
7194 Returns 1 if all the modules contained in the distribution are
7195 uptodate. Relies on containsmods.
7197 =item CPAN::Index::force_reload()
7199 Forces a reload of all indices.
7201 =item CPAN::Index::reload()
7203 Reloads all indices if they have not been read for more than
7204 C<$CPAN::Config->{index_expire}> days.
7206 =item CPAN::InfoObj::dump()
7208 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7209 inherit this method. It prints the data structure associated with an
7210 object. Useful for debugging. Note: the data structure is considered
7211 internal and thus subject to change without notice.
7213 =item CPAN::Module::as_glimpse()
7215 Returns a one-line description of the module
7217 =item CPAN::Module::as_string()
7219 Returns a multi-line description of the module
7221 =item CPAN::Module::clean()
7223 Runs a clean on the distribution associated with this module.
7225 =item CPAN::Module::cpan_file()
7227 Returns the filename on CPAN that is associated with the module.
7229 =item CPAN::Module::cpan_version()
7231 Returns the latest version of this module available on CPAN.
7233 =item CPAN::Module::cvs_import()
7235 Runs a cvs_import on the distribution associated with this module.
7237 =item CPAN::Module::description()
7239 Returns a 44 character description of this module. Only available for
7240 modules listed in The Module List (CPAN/modules/00modlist.long.html
7241 or 00modlist.long.txt.gz)
7243 =item CPAN::Module::force($method,@args)
7245 Forces CPAN to perform a task that normally would have failed. Force
7246 takes as arguments a method name to be called and any number of
7247 additional arguments that should be passed to the called method. The
7248 internals of the object get the needed changes so that CPAN.pm does
7249 not refuse to take the action.
7251 =item CPAN::Module::get()
7253 Runs a get on the distribution associated with this module.
7255 =item CPAN::Module::inst_file()
7257 Returns the filename of the module found in @INC. The first file found
7258 is reported just like perl itself stops searching @INC when it finds a
7261 =item CPAN::Module::inst_version()
7263 Returns the version number of the module in readable format.
7265 =item CPAN::Module::install()
7267 Runs an C<install> on the distribution associated with this module.
7269 =item CPAN::Module::look()
7271 Changes to the directory where the distribution associated with this
7272 module has been unpacked and opens a subshell there. Exiting the
7275 =item CPAN::Module::make()
7277 Runs a C<make> on the distribution associated with this module.
7279 =item CPAN::Module::manpage_headline()
7281 If module is installed, peeks into the module's manpage, reads the
7282 headline and returns it. Moreover, if the module has been downloaded
7283 within this session, does the equivalent on the downloaded module even
7284 if it is not installed.
7286 =item CPAN::Module::readme()
7288 Runs a C<readme> on the distribution associated with this module.
7290 =item CPAN::Module::perldoc()
7292 Runs a C<perldoc> on this module.
7294 =item CPAN::Module::test()
7296 Runs a C<test> on the distribution associated with this module.
7298 =item CPAN::Module::uptodate()
7300 Returns 1 if the module is installed and up-to-date.
7302 =item CPAN::Module::userid()
7304 Returns the author's ID of the module.
7308 =head2 Cache Manager
7310 Currently the cache manager only keeps track of the build directory
7311 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
7312 deletes complete directories below C<build_dir> as soon as the size of
7313 all directories there gets bigger than $CPAN::Config->{build_cache}
7314 (in MB). The contents of this cache may be used for later
7315 re-installations that you intend to do manually, but will never be
7316 trusted by CPAN itself. This is due to the fact that the user might
7317 use these directories for building modules on different architectures.
7319 There is another directory ($CPAN::Config->{keep_source_where}) where
7320 the original distribution files are kept. This directory is not
7321 covered by the cache manager and must be controlled by the user. If
7322 you choose to have the same directory as build_dir and as
7323 keep_source_where directory, then your sources will be deleted with
7324 the same fifo mechanism.
7328 A bundle is just a perl module in the namespace Bundle:: that does not
7329 define any functions or methods. It usually only contains documentation.
7331 It starts like a perl module with a package declaration and a $VERSION
7332 variable. After that the pod section looks like any other pod with the
7333 only difference being that I<one special pod section> exists starting with
7338 In this pod section each line obeys the format
7340 Module_Name [Version_String] [- optional text]
7342 The only required part is the first field, the name of a module
7343 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
7344 of the line is optional. The comment part is delimited by a dash just
7345 as in the man page header.
7347 The distribution of a bundle should follow the same convention as
7348 other distributions.
7350 Bundles are treated specially in the CPAN package. If you say 'install
7351 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
7352 the modules in the CONTENTS section of the pod. You can install your
7353 own Bundles locally by placing a conformant Bundle file somewhere into
7354 your @INC path. The autobundle() command which is available in the
7355 shell interface does that for you by including all currently installed
7356 modules in a snapshot bundle file.
7358 =head2 Prerequisites
7360 If you have a local mirror of CPAN and can access all files with
7361 "file:" URLs, then you only need a perl better than perl5.003 to run
7362 this module. Otherwise Net::FTP is strongly recommended. LWP may be
7363 required for non-UNIX systems or if your nearest CPAN site is
7364 associated with a URL that is not C<ftp:>.
7366 If you have neither Net::FTP nor LWP, there is a fallback mechanism
7367 implemented for an external ftp command or for an external lynx
7370 =head2 Finding packages and VERSION
7372 This module presumes that all packages on CPAN
7378 declare their $VERSION variable in an easy to parse manner. This
7379 prerequisite can hardly be relaxed because it consumes far too much
7380 memory to load all packages into the running program just to determine
7381 the $VERSION variable. Currently all programs that are dealing with
7382 version use something like this
7384 perl -MExtUtils::MakeMaker -le \
7385 'print MM->parse_version(shift)' filename
7387 If you are author of a package and wonder if your $VERSION can be
7388 parsed, please try the above method.
7392 come as compressed or gzipped tarfiles or as zip files and contain a
7393 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
7394 without much enthusiasm).
7400 The debugging of this module is a bit complex, because we have
7401 interferences of the software producing the indices on CPAN, of the
7402 mirroring process on CPAN, of packaging, of configuration, of
7403 synchronicity, and of bugs within CPAN.pm.
7405 For code debugging in interactive mode you can try "o debug" which
7406 will list options for debugging the various parts of the code. You
7407 should know that "o debug" has built-in completion support.
7409 For data debugging there is the C<dump> command which takes the same
7410 arguments as make/test/install and outputs the object's Data::Dumper
7413 =head2 Floppy, Zip, Offline Mode
7415 CPAN.pm works nicely without network too. If you maintain machines
7416 that are not networked at all, you should consider working with file:
7417 URLs. Of course, you have to collect your modules somewhere first. So
7418 you might use CPAN.pm to put together all you need on a networked
7419 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
7420 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
7421 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
7422 with this floppy. See also below the paragraph about CD-ROM support.
7424 =head1 CONFIGURATION
7426 When the CPAN module is used for the first time, a configuration
7427 dialog tries to determine a couple of site specific options. The
7428 result of the dialog is stored in a hash reference C< $CPAN::Config >
7429 in a file CPAN/Config.pm.
7431 The default values defined in the CPAN/Config.pm file can be
7432 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
7433 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
7434 added to the search path of the CPAN module before the use() or
7435 require() statements.
7437 The configuration dialog can be started any time later again by
7438 issuing the command C< o conf init > in the CPAN shell.
7440 Currently the following keys in the hash reference $CPAN::Config are
7443 build_cache size of cache for directories to build modules
7444 build_dir locally accessible directory to build modules
7445 cache_metadata use serializer to cache metadata
7446 cpan_home local directory reserved for this package
7447 dontload_hash anonymous hash: modules in the keys will not be
7448 loaded by the CPAN::has_inst() routine
7450 gzip location of external program gzip
7451 histfile file to maintain history between sessions
7452 histsize maximum number of lines to keep in histfile
7453 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
7454 after this many seconds inactivity. Set to 0 to
7456 index_expire after this many days refetch index files
7457 inhibit_startup_message
7458 if true, does not print the startup message
7459 keep_source_where directory in which to keep the source (if we do)
7460 make location of external make program
7461 make_arg arguments that should always be passed to 'make'
7462 make_install_make_command
7463 the make command for running 'make install', for
7465 make_install_arg same as make_arg for 'make install'
7466 makepl_arg arguments passed to 'perl Makefile.PL'
7467 mbuild_arg arguments passed to './Build'
7468 mbuild_install_arg arguments passed to './Build install'
7469 mbuild_install_build_command
7470 command to use instead of './Build' when we are
7471 in the install stage, for example 'sudo ./Build'
7472 mbuildpl_arg arguments passed to 'perl Build.PL'
7473 pager location of external program more (or any pager)
7474 prefer_installer legal values are MB and EUMM: if a module
7475 comes with both a Makefile.PL and a Build.PL, use
7476 the former (EUMM) or the latter (MB)
7477 prerequisites_policy
7478 what to do if you are missing module prerequisites
7479 ('follow' automatically, 'ask' me, or 'ignore')
7480 proxy_user username for accessing an authenticating proxy
7481 proxy_pass password for accessing an authenticating proxy
7482 scan_cache controls scanning of cache ('atstart' or 'never')
7483 tar location of external program tar
7484 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
7485 (and nonsense for characters outside latin range)
7486 unzip location of external program unzip
7487 urllist arrayref to nearby CPAN sites (or equivalent locations)
7488 wait_list arrayref to a wait server to try (See CPAN::WAIT)
7489 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
7490 ftp_proxy, } the three usual variables for configuring
7491 http_proxy, } proxy requests. Both as CPAN::Config variables
7492 no_proxy } and as environment variables configurable.
7494 You can set and query each of these options interactively in the cpan
7495 shell with the command set defined within the C<o conf> command:
7499 =item C<o conf E<lt>scalar optionE<gt>>
7501 prints the current value of the I<scalar option>
7503 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
7505 Sets the value of the I<scalar option> to I<value>
7507 =item C<o conf E<lt>list optionE<gt>>
7509 prints the current value of the I<list option> in MakeMaker's
7512 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
7514 shifts or pops the array in the I<list option> variable
7516 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
7518 works like the corresponding perl commands.
7522 =head2 Not on config variable getcwd
7524 CPAN.pm changes the current working directory often and needs to
7525 determine its own current working directory. Per default it uses
7526 Cwd::cwd but if this doesn't work on your system for some reason,
7527 alternatives can be configured according to the following table:
7531 fastcwd Cwd::fastcwd
7532 backtickcwd external command cwd
7534 =head2 Note on urllist parameter's format
7536 urllist parameters are URLs according to RFC 1738. We do a little
7537 guessing if your URL is not compliant, but if you have problems with
7538 file URLs, please try the correct format. Either:
7540 file://localhost/whatever/ftp/pub/CPAN/
7544 file:///home/ftp/pub/CPAN/
7546 =head2 urllist parameter has CD-ROM support
7548 The C<urllist> parameter of the configuration table contains a list of
7549 URLs that are to be used for downloading. If the list contains any
7550 C<file> URLs, CPAN always tries to get files from there first. This
7551 feature is disabled for index files. So the recommendation for the
7552 owner of a CD-ROM with CPAN contents is: include your local, possibly
7553 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
7555 o conf urllist push file://localhost/CDROM/CPAN
7557 CPAN.pm will then fetch the index files from one of the CPAN sites
7558 that come at the beginning of urllist. It will later check for each
7559 module if there is a local copy of the most recent version.
7561 Another peculiarity of urllist is that the site that we could
7562 successfully fetch the last file from automatically gets a preference
7563 token and is tried as the first site for the next request. So if you
7564 add a new site at runtime it may happen that the previously preferred
7565 site will be tried another time. This means that if you want to disallow
7566 a site for the next transfer, it must be explicitly removed from
7571 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
7572 install foreign, unmasked, unsigned code on your machine. We compare
7573 to a checksum that comes from the net just as the distribution file
7574 itself. But we try to make it easy to add security on demand:
7576 =head2 Cryptographically signed modules
7578 Since release 1.77 CPAN.pm has been able to verify cryptographically
7579 signed module distributions using Module::Signature. The CPAN modules
7580 can be signed by their authors, thus giving more security. The simple
7581 unsigned MD5 checksums that were used before by CPAN protect mainly
7582 against accidental file corruption.
7584 You will need to have Module::Signature installed, which in turn
7585 requires that you have at least one of Crypt::OpenPGP module or the
7586 command-line F<gpg> tool installed.
7588 You will also need to be able to connect over the Internet to the public
7589 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
7593 Most functions in package CPAN are exported per default. The reason
7594 for this is that the primary use is intended for the cpan shell or for
7599 When the CPAN shell enters a subshell via the look command, it sets
7600 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
7603 When the config variable ftp_passive is set, all downloads will be run
7604 with the environment variable FTP_PASSIVE set to this value. This is
7605 in general a good idea. The same effect can be achieved by starting
7606 the cpan shell with the environment variable. If Net::FTP is
7607 installed, then it can also be configured to always set passive mode
7610 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
7612 Populating a freshly installed perl with my favorite modules is pretty
7613 easy if you maintain a private bundle definition file. To get a useful
7614 blueprint of a bundle definition file, the command autobundle can be used
7615 on the CPAN shell command line. This command writes a bundle definition
7616 file for all modules that are installed for the currently running perl
7617 interpreter. It's recommended to run this command only once and from then
7618 on maintain the file manually under a private name, say
7619 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
7621 cpan> install Bundle::my_bundle
7623 then answer a few questions and then go out for a coffee.
7625 Maintaining a bundle definition file means keeping track of two
7626 things: dependencies and interactivity. CPAN.pm sometimes fails on
7627 calculating dependencies because not all modules define all MakeMaker
7628 attributes correctly, so a bundle definition file should specify
7629 prerequisites as early as possible. On the other hand, it's a bit
7630 annoying that many distributions need some interactive configuring. So
7631 what I try to accomplish in my private bundle file is to have the
7632 packages that need to be configured early in the file and the gentle
7633 ones later, so I can go out after a few minutes and leave CPAN.pm
7636 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
7638 Thanks to Graham Barr for contributing the following paragraphs about
7639 the interaction between perl, and various firewall configurations. For
7640 further information on firewalls, it is recommended to consult the
7641 documentation that comes with the ncftp program. If you are unable to
7642 go through the firewall with a simple Perl setup, it is very likely
7643 that you can configure ncftp so that it works for your firewall.
7645 =head2 Three basic types of firewalls
7647 Firewalls can be categorized into three basic types.
7653 This is where the firewall machine runs a web server and to access the
7654 outside world you must do it via the web server. If you set environment
7655 variables like http_proxy or ftp_proxy to a values beginning with http://
7656 or in your web browser you have to set proxy information then you know
7657 you are running an http firewall.
7659 To access servers outside these types of firewalls with perl (even for
7660 ftp) you will need to use LWP.
7664 This where the firewall machine runs an ftp server. This kind of
7665 firewall will only let you access ftp servers outside the firewall.
7666 This is usually done by connecting to the firewall with ftp, then
7667 entering a username like "user@outside.host.com"
7669 To access servers outside these type of firewalls with perl you
7670 will need to use Net::FTP.
7672 =item One way visibility
7674 I say one way visibility as these firewalls try to make themselves look
7675 invisible to the users inside the firewall. An FTP data connection is
7676 normally created by sending the remote server your IP address and then
7677 listening for the connection. But the remote server will not be able to
7678 connect to you because of the firewall. So for these types of firewall
7679 FTP connections need to be done in a passive mode.
7681 There are two that I can think off.
7687 If you are using a SOCKS firewall you will need to compile perl and link
7688 it with the SOCKS library, this is what is normally called a 'socksified'
7689 perl. With this executable you will be able to connect to servers outside
7690 the firewall as if it is not there.
7694 This is the firewall implemented in the Linux kernel, it allows you to
7695 hide a complete network behind one IP address. With this firewall no
7696 special compiling is needed as you can access hosts directly.
7698 For accessing ftp servers behind such firewalls you may need to set
7699 the environment variable C<FTP_PASSIVE> to a true value, e.g.
7701 env FTP_PASSIVE=1 perl -MCPAN -eshell
7705 perl -MCPAN -e '$ENV{FTP_PASSIVE} = 1; shell'
7712 =head2 Configuring lynx or ncftp for going through a firewall
7714 If you can go through your firewall with e.g. lynx, presumably with a
7717 /usr/local/bin/lynx -pscott:tiger
7719 then you would configure CPAN.pm with the command
7721 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
7723 That's all. Similarly for ncftp or ftp, you would configure something
7726 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
7728 Your mileage may vary...
7736 I installed a new version of module X but CPAN keeps saying,
7737 I have the old version installed
7739 Most probably you B<do> have the old version installed. This can
7740 happen if a module installs itself into a different directory in the
7741 @INC path than it was previously installed. This is not really a
7742 CPAN.pm problem, you would have the same problem when installing the
7743 module manually. The easiest way to prevent this behaviour is to add
7744 the argument C<UNINST=1> to the C<make install> call, and that is why
7745 many people add this argument permanently by configuring
7747 o conf make_install_arg UNINST=1
7751 So why is UNINST=1 not the default?
7753 Because there are people who have their precise expectations about who
7754 may install where in the @INC path and who uses which @INC array. In
7755 fine tuned environments C<UNINST=1> can cause damage.
7759 I want to clean up my mess, and install a new perl along with
7760 all modules I have. How do I go about it?
7762 Run the autobundle command for your old perl and optionally rename the
7763 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
7764 with the Configure option prefix, e.g.
7766 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
7768 Install the bundle file you produced in the first step with something like
7770 cpan> install Bundle::mybundle
7776 When I install bundles or multiple modules with one command
7777 there is too much output to keep track of.
7779 You may want to configure something like
7781 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
7782 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
7784 so that STDOUT is captured in a file for later inspection.
7789 I am not root, how can I install a module in a personal directory?
7791 First of all, you will want to use your own configuration, not the one
7792 that your root user installed. If you do not have permission to write
7793 in the cpan directory that root has configured, you will be asked if
7794 you want to create your own config. Answering "yes" will bring you into
7795 CPAN's configuration stage, using the system config for all defaults except
7796 things that have to do with CPAN's work directory, saving your choices to
7797 your MyConfig.pm file.
7799 You can also manually initiate this process with the following command:
7801 % perl -MCPAN -e 'mkmyconfig'
7807 from the CPAN shell.
7809 You will most probably also want to configure something like this:
7811 o conf makepl_arg "LIB=~/myperl/lib \
7812 INSTALLMAN1DIR=~/myperl/man/man1 \
7813 INSTALLMAN3DIR=~/myperl/man/man3"
7815 You can make this setting permanent like all C<o conf> settings with
7818 You will have to add ~/myperl/man to the MANPATH environment variable
7819 and also tell your perl programs to look into ~/myperl/lib, e.g. by
7822 use lib "$ENV{HOME}/myperl/lib";
7824 or setting the PERL5LIB environment variable.
7826 Another thing you should bear in mind is that the UNINST parameter
7827 should never be set if you are not root.
7831 How to get a package, unwrap it, and make a change before building it?
7833 look Sybase::Sybperl
7837 I installed a Bundle and had a couple of fails. When I
7838 retried, everything resolved nicely. Can this be fixed to work
7841 The reason for this is that CPAN does not know the dependencies of all
7842 modules when it starts out. To decide about the additional items to
7843 install, it just uses data found in the META.yml file or the generated
7844 Makefile. An undetected missing piece breaks the process. But it may
7845 well be that your Bundle installs some prerequisite later than some
7846 depending item and thus your second try is able to resolve everything.
7847 Please note, CPAN.pm does not know the dependency tree in advance and
7848 cannot sort the queue of things to install in a topologically correct
7849 order. It resolves perfectly well IF all modules declare the
7850 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
7851 the C<requires> stanza of Module::Build. For bundles which fail and
7852 you need to install often, it is recommended to sort the Bundle
7853 definition file manually.
7857 In our intranet we have many modules for internal use. How
7858 can I integrate these modules with CPAN.pm but without uploading
7859 the modules to CPAN?
7861 Have a look at the CPAN::Site module.
7865 When I run CPAN's shell, I get an error message about things in my
7866 /etc/inputrc (or ~/.inputrc) file.
7868 These are readline issues and can only be fixed by studying readline
7869 configuration on your architecture and adjusting the referenced file
7870 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
7871 and edit them. Quite often harmless changes like uppercasing or
7872 lowercasing some arguments solves the problem.
7876 Some authors have strange characters in their names.
7878 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
7879 expecting ISO-8859-1 charset, a converter can be activated by setting
7880 term_is_latin to a true value in your config file. One way of doing so
7883 cpan> o conf term_is_latin 1
7885 If other charset support is needed, please file a bugreport against
7886 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
7887 the support or maybe UTF-8 terminals become widely available.
7891 When an install fails for some reason and then I correct the error
7892 condition and retry, CPAN.pm refuses to install the module, saying
7893 C<Already tried without success>.
7895 Use the force pragma like so
7897 force install Foo::Bar
7899 This does a bit more than really needed because it untars the
7900 distribution again and runs make and test and only then install.
7902 Or, if you find this is too fast and you would prefer to do smaller
7907 first and then continue as always. C<Force get> I<forgets> previous
7914 and then 'make install' directly in the subshell.
7916 Or you leave the CPAN shell and start it again.
7918 For the really curious, by accessing internals directly, you I<could>
7920 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
7922 but this is neither guaranteed to work in the future nor is it a
7927 How do I install a "DEVELOPER RELEASE" of a module?
7929 By default, CPAN will install the latest non-developer release of a module.
7930 If you want to install a dev release, you have to specify a partial path to
7931 the tarball you wish to install, like so:
7933 cpan> install KWILLIAMS/Module-Build-0.27_06.tar.gz
7937 How do I install a module and all it's dependancies from the commandline,
7938 without being prompted for anything, despite my CPAN configuration
7941 CPAN uses ExtUtils::MakeMaker's prompt() function to ask it's questions, so
7942 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
7943 asked any questions at all (assuming the modules you are installing are
7944 nice about obeying that variable as well):
7946 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
7952 If a Makefile.PL requires special customization of libraries, prompts
7953 the user for special input, etc. then you may find CPAN is not able to
7954 build the distribution. In that case it is recommended to attempt the
7955 traditional method of building a Perl module package from a shell, for
7956 example by using the 'look' command to open a subshell in the
7957 distribution's own directory.
7961 Andreas Koenig C<< <andk@cpan.org> >>
7965 Kawai,Takanori provides a Japanese translation of this manpage at
7966 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
7970 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)