3 $VERSION = eval $VERSION;
6 use CPAN::HandleConfig;
15 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
16 use File::Basename ();
24 use Sys::Hostname qw(hostname);
25 use Text::ParseWords ();
27 no lib "."; # we need to run chdir all over and we would get at wrong
30 require Mac::BuildTools if $^O eq 'MacOS';
32 END { $CPAN::End++; &cleanup; }
35 $CPAN::Frontend ||= "CPAN::Shell";
36 $CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN";
37 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
38 $CPAN::Perl ||= CPAN::find_perl();
39 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
40 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
46 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
47 $Signal $Suppress_readline $Frontend
48 $Defaultsite $Have_warned $Defaultdocs $Defaultrecent
51 @CPAN::ISA = qw(CPAN::Debug Exporter);
54 autobundle bundle expand force notest get cvs_import
55 install make readme recompile shell test clean
59 sub soft_chdir_with_alternatives ($);
61 #-> sub CPAN::AUTOLOAD ;
66 @EXPORT{@EXPORT} = '';
67 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
68 if (exists $EXPORT{$l}){
71 $CPAN::Frontend->mywarn(qq{Unknown CPAN command "$AUTOLOAD". }.
80 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
81 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
83 my $oprompt = shift || CPAN::Prompt->new;
84 my $prompt = $oprompt;
85 my $commandline = shift || "";
86 $CPAN::CurrentCommandId ||= 1;
89 unless ($Suppress_readline) {
90 require Term::ReadLine;
93 $term->ReadLine eq "Term::ReadLine::Stub"
95 $term = Term::ReadLine->new('CPAN Monitor');
97 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
98 my $attribs = $term->Attribs;
99 $attribs->{attempted_completion_function} = sub {
100 &CPAN::Complete::gnu_cpl;
103 $readline::rl_completion_function =
104 $readline::rl_completion_function = 'CPAN::Complete::cpl';
106 if (my $histfile = $CPAN::Config->{'histfile'}) {{
107 unless ($term->can("AddHistory")) {
108 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
111 my($fh) = FileHandle->new;
112 open $fh, "<$histfile" or last;
116 $term->AddHistory($_);
120 # $term->OUT is autoflushed anyway
121 my $odef = select STDERR;
128 # no strict; # I do not recall why no strict was here (2000-09-03)
130 my @cwd = (CPAN::anycwd(),File::Spec->tmpdir(),File::Spec->rootdir());
131 my $try_detect_readline;
132 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
133 my $rl_avail = $Suppress_readline ? "suppressed" :
134 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
135 "available (try 'install Bundle::CPAN')";
137 $CPAN::Frontend->myprint(
139 cpan shell -- CPAN exploration and modules installation (v%s)
146 unless $CPAN::Config->{'inhibit_startup_message'} ;
147 my($continuation) = "";
148 SHELLCOMMAND: while () {
149 if ($Suppress_readline) {
151 last SHELLCOMMAND unless defined ($_ = <> );
154 last SHELLCOMMAND unless
155 defined ($_ = $term->readline($prompt, $commandline));
157 $_ = "$continuation$_" if $continuation;
159 next SHELLCOMMAND if /^$/;
160 $_ = 'h' if /^\s*\?/;
161 if (/^(?:q(?:uit)?|bye|exit)$/i) {
172 use vars qw($import_done);
173 CPAN->import(':DEFAULT') unless $import_done++;
174 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
181 if ($] < 5.00322) { # parsewords had a bug until recently
184 eval { @line = Text::ParseWords::shellwords($_) };
185 warn($@), next SHELLCOMMAND if $@;
186 warn("Text::Parsewords could not parse the line [$_]"),
187 next SHELLCOMMAND unless @line;
189 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
190 my $command = shift @line;
191 eval { CPAN::Shell->$command(@line) };
193 if ($command =~ /^(make|test|install|force|notest)$/) {
194 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
196 soft_chdir_with_alternatives(\@cwd);
197 $CPAN::Frontend->myprint("\n");
199 $CPAN::CurrentCommandId++;
203 $commandline = ""; # I do want to be able to pass a default to
204 # shell, but on the second command I see no
207 CPAN::Queue->nullify_queue;
208 if ($try_detect_readline) {
209 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
211 $CPAN::META->has_inst("Term::ReadLine::Perl")
213 delete $INC{"Term/ReadLine.pm"};
215 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
216 require Term::ReadLine;
217 $CPAN::Frontend->myprint("\n$redef subroutines in ".
218 "Term::ReadLine redefined\n");
224 soft_chdir_with_alternatives(\@cwd);
227 sub soft_chdir_with_alternatives ($) {
229 while (not chdir $cwd->[0]) {
231 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
232 Trying to chdir to "$cwd->[1]" instead.
236 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
240 package CPAN::CacheMgr;
242 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
247 use vars qw($Ua $Thesite $Themethod);
248 @CPAN::FTP::ISA = qw(CPAN::Debug);
250 package CPAN::LWP::UserAgent;
252 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
253 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
255 package CPAN::Complete;
257 @CPAN::Complete::ISA = qw(CPAN::Debug);
258 @CPAN::Complete::COMMANDS = sort qw(
259 ! a b d h i m o q r u
278 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
279 @CPAN::Index::ISA = qw(CPAN::Debug);
282 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
285 package CPAN::InfoObj;
287 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
289 package CPAN::Author;
291 @CPAN::Author::ISA = qw(CPAN::InfoObj);
293 package CPAN::Distribution;
295 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
297 package CPAN::Bundle;
299 @CPAN::Bundle::ISA = qw(CPAN::Module);
301 package CPAN::Module;
303 @CPAN::Module::ISA = qw(CPAN::InfoObj);
305 package CPAN::Exception::RecursiveDependency;
307 use overload '""' => "as_string";
314 for my $dep (@$deps) {
316 last if $seen{$dep}++;
318 bless { deps => \@deps }, $class;
323 "\nRecursive dependency detected:\n " .
324 join("\n => ", @{$self->{deps}}) .
325 ".\nCannot continue.\n";
328 package CPAN::Prompt; use overload '""' => "as_string";
329 our $prompt = "cpan> ";
330 $CPAN::CurrentCommandId ||= 0;
331 sub as_randomly_capitalized_string {
333 substr($prompt,$_,1)=rand()<0.5 ?
334 uc(substr($prompt,$_,1)) :
335 lc(substr($prompt,$_,1)) for 0..3;
342 if ($CPAN::Config->{commandnumber_in_prompt}) {
343 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
349 package CPAN::Distrostatus;
350 use overload '""' => "as_string",
353 my($class,$arg) = @_;
356 FAILED => substr($arg,0,2) eq "NO",
357 COMMANDID => $CPAN::CurrentCommandId,
360 sub commandid { shift->{COMMANDID} }
361 sub failed { shift->{FAILED} }
365 $self->{TEXT} = $set;
371 if (0) { # called from rematein during install?
380 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
381 @CPAN::Shell::ISA = qw(CPAN::Debug);
382 $COLOR_REGISTERED ||= 0;
383 $PRINT_ORNAMENTING ||= 0;
385 #-> sub CPAN::Shell::AUTOLOAD ;
387 my($autoload) = $AUTOLOAD;
388 my $class = shift(@_);
389 # warn "autoload[$autoload] class[$class]";
390 $autoload =~ s/.*:://;
391 if ($autoload =~ /^w/) {
392 if ($CPAN::META->has_inst('CPAN::WAIT')) {
393 CPAN::WAIT->$autoload(@_);
395 $CPAN::Frontend->mywarn(qq{
396 Commands starting with "w" require CPAN::WAIT to be installed.
397 Please consider installing CPAN::WAIT to use the fulltext index.
398 For this you just need to type
403 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload'. }.
412 # One use of the queue is to determine if we should or shouldn't
413 # announce the availability of a new CPAN module
415 # Now we try to use it for dependency tracking. For that to happen
416 # we need to draw a dependency tree and do the leaves first. This can
417 # easily be reached by running CPAN.pm recursively, but we don't want
418 # to waste memory and run into deep recursion. So what we can do is
421 # CPAN::Queue is the package where the queue is maintained. Dependencies
422 # often have high priority and must be brought to the head of the queue,
423 # possibly by jumping the queue if they are already there. My first code
424 # attempt tried to be extremely correct. Whenever a module needed
425 # immediate treatment, I either unshifted it to the front of the queue,
426 # or, if it was already in the queue, I spliced and let it bypass the
427 # others. This became a too correct model that made it impossible to put
428 # an item more than once into the queue. Why would you need that? Well,
429 # you need temporary duplicates as the manager of the queue is a loop
432 # (1) looks at the first item in the queue without shifting it off
434 # (2) cares for the item
436 # (3) removes the item from the queue, *even if its agenda failed and
437 # even if the item isn't the first in the queue anymore* (that way
438 # protecting against never ending queues)
440 # So if an item has prerequisites, the installation fails now, but we
441 # want to retry later. That's easy if we have it twice in the queue.
443 # I also expect insane dependency situations where an item gets more
444 # than two lives in the queue. Simplest example is triggered by 'install
445 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
446 # get in the way. I wanted the queue manager to be a dumb servant, not
447 # one that knows everything.
449 # Who would I tell in this model that the user wants to be asked before
450 # processing? I can't attach that information to the module object,
451 # because not modules are installed but distributions. So I'd have to
452 # tell the distribution object that it should ask the user before
453 # processing. Where would the question be triggered then? Most probably
454 # in CPAN::Distribution::rematein.
455 # Hope that makes sense, my head is a bit off:-) -- AK
462 my $self = bless { qmod => $s }, $class;
467 # CPAN::Queue::first ;
473 # CPAN::Queue::delete_first ;
475 my($class,$what) = @_;
477 for my $i (0..$#All) {
478 if ( $All[$i]->{qmod} eq $what ) {
485 # CPAN::Queue::jumpqueue ;
489 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
490 join(",",map {$_->{qmod}} @All),
493 WHAT: for my $what (reverse @what) {
495 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
496 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
497 if ($All[$i]->{qmod} eq $what){
499 if ($jumped > 100) { # one's OK if e.g. just
500 # processing now; more are OK if
501 # user typed it several times
502 $CPAN::Frontend->mywarn(
503 qq{Object [$what] queued more than 100 times, ignoring}
509 my $obj = bless { qmod => $what }, $class;
512 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
513 join(",",map {$_->{qmod}} @All),
518 # CPAN::Queue::exists ;
520 my($self,$what) = @_;
521 my @all = map { $_->{qmod} } @All;
522 my $exists = grep { $_->{qmod} eq $what } @All;
523 # warn "in exists what[$what] all[@all] exists[$exists]";
527 # CPAN::Queue::delete ;
530 @All = grep { $_->{qmod} ne $mod } @All;
533 # CPAN::Queue::nullify_queue ;
543 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
545 # from here on only subs.
546 ################################################################################
548 #-> sub CPAN::all_objects ;
550 my($mgr,$class) = @_;
551 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
552 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
554 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
556 *all = \&all_objects;
558 # Called by shell, not in batch mode. In batch mode I see no risk in
559 # having many processes updating something as installations are
560 # continually checked at runtime. In shell mode I suspect it is
561 # unintentional to open more than one shell at a time
563 #-> sub CPAN::checklock ;
566 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
567 if (-f $lockfile && -M _ > 0) {
568 my $fh = FileHandle->new($lockfile) or
569 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
570 my $otherpid = <$fh>;
571 my $otherhost = <$fh>;
573 if (defined $otherpid && $otherpid) {
576 if (defined $otherhost && $otherhost) {
579 my $thishost = hostname();
580 if (defined $otherhost && defined $thishost &&
581 $otherhost ne '' && $thishost ne '' &&
582 $otherhost ne $thishost) {
583 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
584 "reports other host $otherhost and other ".
585 "process $otherpid.\n".
586 "Cannot proceed.\n"));
588 elsif (defined $otherpid && $otherpid) {
589 return if $$ == $otherpid; # should never happen
590 $CPAN::Frontend->mywarn(
592 There seems to be running another CPAN process (pid $otherpid). Contacting...
594 if (kill 0, $otherpid) {
595 $CPAN::Frontend->mydie(qq{Other job is running.
596 You may want to kill it and delete the lockfile, maybe. On UNIX try:
600 } elsif (-w $lockfile) {
602 ExtUtils::MakeMaker::prompt
603 (qq{Other job not responding. Shall I overwrite }.
604 qq{the lockfile '$lockfile'? (Y/n)},"y");
605 $CPAN::Frontend->myexit("Ok, bye\n")
606 unless $ans =~ /^y/i;
609 qq{Lockfile '$lockfile' not writeable by you. }.
610 qq{Cannot proceed.\n}.
612 qq{ rm '$lockfile'\n}.
613 qq{ and then rerun us.\n}
617 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
618 "reports other process with ID ".
619 "$otherpid. Cannot proceed.\n"));
622 my $dotcpan = $CPAN::Config->{cpan_home};
623 eval { File::Path::mkpath($dotcpan);};
625 # A special case at least for Jarkko.
630 $symlinkcpan = readlink $dotcpan;
631 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
632 eval { File::Path::mkpath($symlinkcpan); };
636 $CPAN::Frontend->mywarn(qq{
637 Working directory $symlinkcpan created.
641 unless (-d $dotcpan) {
643 Your configuration suggests "$dotcpan" as your
644 CPAN.pm working directory. I could not create this directory due
645 to this error: $firsterror\n};
647 As "$dotcpan" is a symlink to "$symlinkcpan",
648 I tried to create that, but I failed with this error: $seconderror
651 Please make sure the directory exists and is writable.
653 $CPAN::Frontend->mydie($diemess);
657 unless ($fh = FileHandle->new(">$lockfile")) {
658 if ($! =~ /Permission/) {
659 my $incc = $INC{'CPAN/Config.pm'};
660 my $myincc = File::Spec->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
661 $CPAN::Frontend->myprint(qq{
663 Your configuration suggests that CPAN.pm should use a working
665 $CPAN::Config->{cpan_home}
666 Unfortunately we could not create the lock file
668 due to permission problems.
670 Please make sure that the configuration variable
671 \$CPAN::Config->{cpan_home}
672 points to a directory where you can write a .lock file. You can set
673 this variable in either
680 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
682 $fh->print($$, "\n");
683 $fh->print(hostname(), "\n");
684 $self->{LOCK} = $lockfile;
688 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
693 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
694 print "Caught SIGINT\n";
698 # From: Larry Wall <larry@wall.org>
699 # Subject: Re: deprecating SIGDIE
700 # To: perl5-porters@perl.org
701 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
703 # The original intent of __DIE__ was only to allow you to substitute one
704 # kind of death for another on an application-wide basis without respect
705 # to whether you were in an eval or not. As a global backstop, it should
706 # not be used any more lightly (or any more heavily :-) than class
707 # UNIVERSAL. Any attempt to build a general exception model on it should
708 # be politely squashed. Any bug that causes every eval {} to have to be
709 # modified should be not so politely squashed.
711 # Those are my current opinions. It is also my optinion that polite
712 # arguments degenerate to personal arguments far too frequently, and that
713 # when they do, it's because both people wanted it to, or at least didn't
714 # sufficiently want it not to.
718 # global backstop to cleanup if we should really die
719 $SIG{__DIE__} = \&cleanup;
720 $self->debug("Signal handler set.") if $CPAN::DEBUG;
723 #-> sub CPAN::DESTROY ;
725 &cleanup; # need an eval?
728 #-> sub CPAN::anycwd ;
731 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
736 sub cwd {Cwd::cwd();}
738 #-> sub CPAN::getcwd ;
739 sub getcwd {Cwd::getcwd();}
741 #-> sub CPAN::find_perl ;
743 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
744 my $pwd = $CPAN::iCwd = CPAN::anycwd();
745 my $candidate = File::Spec->catfile($pwd,$^X);
746 $perl ||= $candidate if MM->maybe_command($candidate);
749 my ($component,$perl_name);
750 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
751 PATH_COMPONENT: foreach $component (File::Spec->path(),
752 $Config::Config{'binexp'}) {
753 next unless defined($component) && $component;
754 my($abs) = File::Spec->catfile($component,$perl_name);
755 if (MM->maybe_command($abs)) {
767 #-> sub CPAN::exists ;
769 my($mgr,$class,$id) = @_;
770 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
772 ### Carp::croak "exists called without class argument" unless $class;
774 $id =~ s/:+/::/g if $class eq "CPAN::Module";
775 exists $META->{readonly}{$class}{$id} or
776 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
779 #-> sub CPAN::delete ;
781 my($mgr,$class,$id) = @_;
782 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
783 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
786 #-> sub CPAN::has_usable
787 # has_inst is sometimes too optimistic, we should replace it with this
788 # has_usable whenever a case is given
790 my($self,$mod,$message) = @_;
791 return 1 if $HAS_USABLE->{$mod};
792 my $has_inst = $self->has_inst($mod,$message);
793 return unless $has_inst;
796 LWP => [ # we frequently had "Can't locate object
797 # method "new" via package "LWP::UserAgent" at
798 # (eval 69) line 2006
800 sub {require LWP::UserAgent},
801 sub {require HTTP::Request},
802 sub {require URI::URL},
805 sub {require Net::FTP},
806 sub {require Net::Config},
809 if ($usable->{$mod}) {
810 for my $c (0..$#{$usable->{$mod}}) {
811 my $code = $usable->{$mod}[$c];
812 my $ret = eval { &$code() };
814 warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
819 return $HAS_USABLE->{$mod} = 1;
822 #-> sub CPAN::has_inst
824 my($self,$mod,$message) = @_;
825 Carp::croak("CPAN->has_inst() called without an argument")
827 if (defined $message && $message eq "no"
829 exists $CPAN::META->{dontload_hash}{$mod} # unsafe meta access, ok
831 exists $CPAN::Config->{dontload_hash}{$mod}
833 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
841 # checking %INC is wrong, because $INC{LWP} may be true
842 # although $INC{"URI/URL.pm"} may have failed. But as
843 # I really want to say "bla loaded OK", I have to somehow
845 ### warn "$file in %INC"; #debug
847 } elsif (eval { require $file }) {
848 # eval is good: if we haven't yet read the database it's
849 # perfect and if we have installed the module in the meantime,
850 # it tries again. The second require is only a NOOP returning
851 # 1 if we had success, otherwise it's retrying
853 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
854 if ($mod eq "CPAN::WAIT") {
855 push @CPAN::Shell::ISA, 'CPAN::WAIT';
858 } elsif ($mod eq "Net::FTP") {
859 $CPAN::Frontend->mywarn(qq{
860 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
862 install Bundle::libnet
864 }) unless $Have_warned->{"Net::FTP"}++;
866 } elsif ($mod eq "Digest::SHA"){
867 $CPAN::Frontend->myprint(qq{
868 CPAN: checksum security checks disabled because Digest::SHA not installed.
869 Please consider installing the Digest::SHA module.
873 } elsif ($mod eq "Module::Signature"){
874 unless ($Have_warned->{"Module::Signature"}++) {
875 # No point in complaining unless the user can
876 # reasonably install and use it.
877 if (eval { require Crypt::OpenPGP; 1 } ||
878 defined $CPAN::Config->{'gpg'}) {
879 $CPAN::Frontend->myprint(qq{
880 CPAN: Module::Signature security checks disabled because Module::Signature
881 not installed. Please consider installing the Module::Signature module.
882 You may also need to be able to connect over the Internet to the public
883 keyservers like pgp.mit.edu (port 11371).
890 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
895 #-> sub CPAN::instance ;
897 my($mgr,$class,$id) = @_;
900 # unsafe meta access, ok?
901 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
902 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
910 #-> sub CPAN::cleanup ;
912 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
913 local $SIG{__DIE__} = '';
918 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
920 $subroutine eq '(eval)';
922 return if $ineval && !$CPAN::End;
923 return unless defined $META->{LOCK};
924 return unless -f $META->{LOCK};
926 unlink $META->{LOCK};
928 # Carp::cluck("DEBUGGING");
929 $CPAN::Frontend->mywarn("Lockfile removed.\n");
932 #-> sub CPAN::savehist
935 my($histfile,$histsize);
936 unless ($histfile = $CPAN::Config->{'histfile'}){
937 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
940 $histsize = $CPAN::Config->{'histsize'} || 100;
942 unless ($CPAN::term->can("GetHistory")) {
943 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
949 my @h = $CPAN::term->GetHistory;
950 splice @h, 0, @h-$histsize if @h>$histsize;
951 my($fh) = FileHandle->new;
952 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
953 local $\ = local $, = "\n";
959 my($self,$what) = @_;
960 $self->{is_tested}{$what} = 1;
964 my($self,$what) = @_;
965 delete $self->{is_tested}{$what};
970 $self->{is_tested} ||= {};
971 return unless %{$self->{is_tested}};
972 my $env = $ENV{PERL5LIB};
973 $env = $ENV{PERLLIB} unless defined $env;
975 push @env, $env if defined $env and length $env;
976 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
977 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
978 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
981 package CPAN::CacheMgr;
984 #-> sub CPAN::CacheMgr::as_string ;
986 eval { require Data::Dumper };
988 return shift->SUPER::as_string;
990 return Data::Dumper::Dumper(shift);
994 #-> sub CPAN::CacheMgr::cachesize ;
999 #-> sub CPAN::CacheMgr::tidyup ;
1002 return unless -d $self->{ID};
1003 while ($self->{DU} > $self->{'MAX'} ) {
1004 my($toremove) = shift @{$self->{FIFO}};
1005 $CPAN::Frontend->myprint(sprintf(
1006 "Deleting from cache".
1007 ": $toremove (%.1f>%.1f MB)\n",
1008 $self->{DU}, $self->{'MAX'})
1010 return if $CPAN::Signal;
1011 $self->force_clean_cache($toremove);
1012 return if $CPAN::Signal;
1016 #-> sub CPAN::CacheMgr::dir ;
1021 #-> sub CPAN::CacheMgr::entries ;
1023 my($self,$dir) = @_;
1024 return unless defined $dir;
1025 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1026 $dir ||= $self->{ID};
1027 my($cwd) = CPAN::anycwd();
1028 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1029 my $dh = DirHandle->new(File::Spec->curdir)
1030 or Carp::croak("Couldn't opendir $dir: $!");
1033 next if $_ eq "." || $_ eq "..";
1035 push @entries, File::Spec->catfile($dir,$_);
1037 push @entries, File::Spec->catdir($dir,$_);
1039 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1042 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1043 sort { -M $b <=> -M $a} @entries;
1046 #-> sub CPAN::CacheMgr::disk_usage ;
1048 my($self,$dir) = @_;
1049 return if exists $self->{SIZE}{$dir};
1050 return if $CPAN::Signal;
1054 unless (chmod 0755, $dir) {
1055 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1056 "permission to change the permission; cannot ".
1057 "estimate disk usage of '$dir'\n");
1058 $CPAN::Frontend->mysleep(5);
1063 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1064 $CPAN::Frontend->mysleep(2);
1069 $File::Find::prune++ if $CPAN::Signal;
1071 if ($^O eq 'MacOS') {
1073 my $cat = Mac::Files::FSpGetCatInfo($_);
1074 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1078 unless (chmod 0755, $_) {
1079 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1080 "the permission to change the permission; ".
1081 "can only partially estimate disk usage ".
1094 return if $CPAN::Signal;
1095 $self->{SIZE}{$dir} = $Du/1024/1024;
1096 push @{$self->{FIFO}}, $dir;
1097 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1098 $self->{DU} += $Du/1024/1024;
1102 #-> sub CPAN::CacheMgr::force_clean_cache ;
1103 sub force_clean_cache {
1104 my($self,$dir) = @_;
1105 return unless -e $dir;
1106 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1108 File::Path::rmtree($dir);
1109 $self->{DU} -= $self->{SIZE}{$dir};
1110 delete $self->{SIZE}{$dir};
1113 #-> sub CPAN::CacheMgr::new ;
1120 ID => $CPAN::Config->{'build_dir'},
1121 MAX => $CPAN::Config->{'build_cache'},
1122 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1125 File::Path::mkpath($self->{ID});
1126 my $dh = DirHandle->new($self->{ID});
1127 bless $self, $class;
1130 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1132 CPAN->debug($debug) if $CPAN::DEBUG;
1136 #-> sub CPAN::CacheMgr::scan_cache ;
1139 return if $self->{SCAN} eq 'never';
1140 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1141 unless $self->{SCAN} eq 'atstart';
1142 $CPAN::Frontend->myprint(
1143 sprintf("Scanning cache %s for sizes\n",
1146 for $e ($self->entries($self->{ID})) {
1147 next if $e eq ".." || $e eq ".";
1148 $self->disk_usage($e);
1149 return if $CPAN::Signal;
1154 package CPAN::Shell;
1157 #-> sub CPAN::Shell::h ;
1159 my($class,$about) = @_;
1160 if (defined $about) {
1161 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1163 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1164 $CPAN::Frontend->myprint(qq{
1165 Display Information $filler (ver $CPAN::VERSION)
1166 command argument description
1167 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1168 i WORD or /REGEXP/ about any of the above
1169 r NONE report updatable modules
1170 ls AUTHOR or GLOB about files in the author's directory
1171 (with WORD being a module, bundle or author name or a distribution
1172 name of the form AUTHOR/DISTRIBUTION)
1174 Download, Test, Make, Install...
1175 get download clean make clean
1176 make make (implies get) look open subshell in dist directory
1177 test make test (implies make) readme display these README files
1178 install make install (implies test) perldoc display POD documentation
1181 force COMMAND unconditionally do command
1182 notest COMMAND skip testing
1185 h,? display this menu ! perl-code eval a perl command
1186 o conf [opt] set and query options q quit the cpan shell
1187 reload cpan load CPAN.pm again reload index load newer indices
1188 autobundle Snapshot recent latest CPAN uploads});
1194 #-> sub CPAN::Shell::a ;
1196 my($self,@arg) = @_;
1197 # authors are always UPPERCASE
1199 $_ = uc $_ unless /=/;
1201 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1205 my($self,$pragmas,$s) = @_;
1206 # ls is really very different, but we had it once as an ordinary
1207 # command in the Shell (upto rev. 321) and we could not handle
1209 my(@accept,@preexpand);
1210 if ($s =~ /[\*\?\/]/) {
1211 if ($CPAN::META->has_inst("Text::Glob")) {
1212 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1213 my $rau = Text::Glob::glob_to_regex(uc $au);
1214 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1216 push @preexpand, map { $_->id . "/" . $pathglob }
1217 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1219 my $rau = Text::Glob::glob_to_regex(uc $s);
1220 push @preexpand, map { $_->id }
1221 CPAN::Shell->expand_by_method('CPAN::Author',
1226 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1229 push @preexpand, uc $s;
1232 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1233 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1238 my $silent = @accept>1;
1239 my $last_alpha = "";
1240 for my $a (@accept){
1241 my($author,$pathglob);
1242 if ($a =~ m|(.*?)/(.*)|) {
1245 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1247 $a2) or die "No author found for $a2";
1249 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1251 $a) or die "No author found for $a";
1254 my $alpha = substr $author->id, 0, 1;
1256 if ($alpha eq $last_alpha) {
1260 $last_alpha = $alpha;
1262 $CPAN::Frontend->myprint($ad);
1264 for my $pragma (@$pragmas) {
1265 if ($author->can($pragma)) {
1269 $author->ls($pathglob,$silent); # silent if more than one author
1270 for my $pragma (@$pragmas) {
1271 my $meth = "un$pragma";
1272 if ($author->can($meth)) {
1279 #-> sub CPAN::Shell::local_bundles ;
1281 my($self,@which) = @_;
1282 my($incdir,$bdir,$dh);
1283 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1284 my @bbase = "Bundle";
1285 while (my $bbase = shift @bbase) {
1286 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1287 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1288 if ($dh = DirHandle->new($bdir)) { # may fail
1290 for $entry ($dh->read) {
1291 next if $entry =~ /^\./;
1292 if (-d File::Spec->catdir($bdir,$entry)){
1293 push @bbase, "$bbase\::$entry";
1295 next unless $entry =~ s/\.pm(?!\n)\Z//;
1296 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1304 #-> sub CPAN::Shell::b ;
1306 my($self,@which) = @_;
1307 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1308 $self->local_bundles;
1309 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1312 #-> sub CPAN::Shell::d ;
1313 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1315 #-> sub CPAN::Shell::m ;
1316 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1318 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1321 #-> sub CPAN::Shell::i ;
1325 @args = '/./' unless @args;
1327 for my $type (qw/Bundle Distribution Module/) {
1328 push @result, $self->expand($type,@args);
1330 # Authors are always uppercase.
1331 push @result, $self->expand("Author", map { uc $_ } @args);
1333 my $result = @result == 1 ?
1334 $result[0]->as_string :
1336 "No objects found of any type for argument @args\n" :
1338 (map {$_->as_glimpse} @result),
1339 scalar @result, " items found\n",
1341 $CPAN::Frontend->myprint($result);
1344 #-> sub CPAN::Shell::o ;
1346 # CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf'
1347 # should have been called set and 'o debug' maybe 'set debug'
1349 my($self,$o_type,@o_what) = @_;
1352 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1353 if ($o_type eq 'conf') {
1354 shift @o_what if @o_what && $o_what[0] eq 'help';
1355 if (!@o_what) { # print all things, "o conf"
1357 $CPAN::Frontend->myprint("CPAN::Config options");
1358 if (exists $INC{'CPAN/Config.pm'}) {
1359 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1361 if (exists $INC{'CPAN/MyConfig.pm'}) {
1362 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1364 $CPAN::Frontend->myprint(":\n");
1365 for $k (sort keys %CPAN::HandleConfig::can) {
1366 $v = $CPAN::HandleConfig::can{$k};
1367 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1369 $CPAN::Frontend->myprint("\n");
1370 for $k (sort keys %$CPAN::Config) {
1371 CPAN::HandleConfig->prettyprint($k);
1373 $CPAN::Frontend->myprint("\n");
1374 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1375 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1378 } elsif ($o_type eq 'debug') {
1380 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1383 my($what) = shift @o_what;
1384 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1385 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1388 if ( exists $CPAN::DEBUG{$what} ) {
1389 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1390 } elsif ($what =~ /^\d/) {
1391 $CPAN::DEBUG = $what;
1392 } elsif (lc $what eq 'all') {
1394 for (values %CPAN::DEBUG) {
1397 $CPAN::DEBUG = $max;
1400 for (keys %CPAN::DEBUG) {
1401 next unless lc($_) eq lc($what);
1402 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1405 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1410 my $raw = "Valid options for debug are ".
1411 join(", ",sort(keys %CPAN::DEBUG), 'all').
1412 qq{ or a number. Completion works on the options. }.
1413 qq{Case is ignored.};
1415 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1416 $CPAN::Frontend->myprint("\n\n");
1419 $CPAN::Frontend->myprint("Options set for debugging:\n");
1421 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1422 $v = $CPAN::DEBUG{$k};
1423 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1424 if $v & $CPAN::DEBUG;
1427 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1430 $CPAN::Frontend->myprint(qq{
1432 conf set or get configuration variables
1433 debug set or get debugging options
1438 sub paintdots_onreload {
1441 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1445 # $CPAN::Frontend->myprint(".($subr)");
1446 $CPAN::Frontend->myprint(".");
1453 #-> sub CPAN::Shell::reload ;
1455 my($self,$command,@arg) = @_;
1457 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1458 if ($command =~ /cpan/i) {
1460 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1462 MFILE: for my $f (qw(CPAN.pm CPAN/HandleConfig.pm CPAN/FirstTime.pm CPAN/Tarzip.pm
1463 CPAN/Debug.pm CPAN/Version.pm)) {
1464 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1465 $self->reload_this($f) or $failed++;
1467 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1468 $failed++ unless $redef;
1470 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1473 } elsif ($command =~ /index/) {
1474 CPAN::Index->force_reload;
1476 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1477 index re-reads the index files\n});
1483 return 1 unless $INC{$f};
1484 my $pwd = CPAN::anycwd();
1485 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1488 for my $inc (@INC) {
1489 $read = File::Spec->catfile($inc,split /\//, $f);
1496 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1499 my $fh = FileHandle->new($read) or
1500 $CPAN::Frontend->mydie("Could not open $read: $!");
1504 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1514 #-> sub CPAN::Shell::_binary_extensions ;
1515 sub _binary_extensions {
1516 my($self) = shift @_;
1517 my(@result,$module,%seen,%need,$headerdone);
1518 for $module ($self->expand('Module','/./')) {
1519 my $file = $module->cpan_file;
1520 next if $file eq "N/A";
1521 next if $file =~ /^Contact Author/;
1522 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1523 next if $dist->isa_perl;
1524 next unless $module->xs_file;
1526 $CPAN::Frontend->myprint(".");
1527 push @result, $module;
1529 # print join " | ", @result;
1530 $CPAN::Frontend->myprint("\n");
1534 #-> sub CPAN::Shell::recompile ;
1536 my($self) = shift @_;
1537 my($module,@module,$cpan_file,%dist);
1538 @module = $self->_binary_extensions();
1539 for $module (@module){ # we force now and compile later, so we
1541 $cpan_file = $module->cpan_file;
1542 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1544 $dist{$cpan_file}++;
1546 for $cpan_file (sort keys %dist) {
1547 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1548 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1550 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1551 # stop a package from recompiling,
1552 # e.g. IO-1.12 when we have perl5.003_10
1556 #-> sub CPAN::Shell::_u_r_common ;
1558 my($self) = shift @_;
1559 my($what) = shift @_;
1560 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1561 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1562 $what && $what =~ /^[aru]$/;
1564 @args = '/./' unless @args;
1565 my(@result,$module,%seen,%need,$headerdone,
1566 $version_undefs,$version_zeroes);
1567 $version_undefs = $version_zeroes = 0;
1568 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1569 my @expand = $self->expand('Module',@args);
1570 my $expand = scalar @expand;
1571 if (0) { # Looks like noise to me, was very useful for debugging
1572 # for metadata cache
1573 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1575 MODULE: for $module (@expand) {
1576 my $file = $module->cpan_file;
1577 next MODULE unless defined $file; # ??
1578 $file =~ s|^./../||;
1579 my($latest) = $module->cpan_version;
1580 my($inst_file) = $module->inst_file;
1582 return if $CPAN::Signal;
1585 $have = $module->inst_version;
1586 } elsif ($what eq "r") {
1587 $have = $module->inst_version;
1589 if ($have eq "undef"){
1591 } elsif ($have == 0){
1594 next MODULE unless CPAN::Version->vgt($latest, $have);
1595 # to be pedantic we should probably say:
1596 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1597 # to catch the case where CPAN has a version 0 and we have a version undef
1598 } elsif ($what eq "u") {
1604 } elsif ($what eq "r") {
1606 } elsif ($what eq "u") {
1610 return if $CPAN::Signal; # this is sometimes lengthy
1613 push @result, sprintf "%s %s\n", $module->id, $have;
1614 } elsif ($what eq "r") {
1615 push @result, $module->id;
1616 next MODULE if $seen{$file}++;
1617 } elsif ($what eq "u") {
1618 push @result, $module->id;
1619 next MODULE if $seen{$file}++;
1620 next MODULE if $file =~ /^Contact/;
1622 unless ($headerdone++){
1623 $CPAN::Frontend->myprint("\n");
1624 $CPAN::Frontend->myprint(sprintf(
1627 "Package namespace",
1639 $CPAN::META->has_inst("Term::ANSIColor")
1641 $module->description
1643 $color_on = Term::ANSIColor::color("green");
1644 $color_off = Term::ANSIColor::color("reset");
1646 $CPAN::Frontend->myprint(sprintf $sprintf,
1653 $need{$module->id}++;
1657 $CPAN::Frontend->myprint("No modules found for @args\n");
1658 } elsif ($what eq "r") {
1659 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1663 if ($version_zeroes) {
1664 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1665 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1666 qq{a version number of 0\n});
1668 if ($version_undefs) {
1669 my $s_has = $version_undefs > 1 ? "s have" : " has";
1670 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1671 qq{parseable version number\n});
1677 #-> sub CPAN::Shell::r ;
1679 shift->_u_r_common("r",@_);
1682 #-> sub CPAN::Shell::u ;
1684 shift->_u_r_common("u",@_);
1687 #-> sub CPAN::Shell::failed ;
1689 my($self,$only_id,$silent) = @_;
1691 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1693 for my $nosayer (qw(signature_verify make make_test install)) {
1694 next unless exists $d->{$nosayer};
1695 next unless $d->{$nosayer}->failed;
1699 next DIST unless $failed;
1700 next DIST if $only_id && $only_id != $d->{$failed}->commandid;
1704 # " %-45s: %s %s\n",
1706 $d->{$failed}->commandid,
1709 $d->{$failed}->text,
1712 my $scope = $only_id ? "command" : "session";
1714 my $print = join "",
1715 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1716 sort { $a->[0] <=> $b->[0] } @failed;
1717 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1718 } elsif (!$only_id || !$silent) {
1719 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1723 # XXX intentionally undocumented because completely bogus, unportable,
1726 #-> sub CPAN::Shell::status ;
1729 require Devel::Size;
1730 my $ps = FileHandle->new;
1731 open $ps, "/proc/$$/status";
1734 next unless /VmSize:\s+(\d+)/;
1738 $CPAN::Frontend->mywarn(sprintf(
1739 "%-27s %6d\n%-27s %6d\n",
1743 Devel::Size::total_size($CPAN::META)/1024,
1745 for my $k (sort keys %$CPAN::META) {
1746 next unless substr($k,0,4) eq "read";
1747 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
1748 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
1749 warn sprintf " %-25s %6d %6d\n",
1751 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
1752 scalar keys %{$CPAN::META->{$k}{$k2}};
1757 #-> sub CPAN::Shell::autobundle ;
1760 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1761 my(@bundle) = $self->_u_r_common("a",@_);
1762 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1763 File::Path::mkpath($todir);
1764 unless (-d $todir) {
1765 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1768 my($y,$m,$d) = (localtime)[5,4,3];
1772 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1773 my($to) = File::Spec->catfile($todir,"$me.pm");
1775 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1776 $to = File::Spec->catfile($todir,"$me.pm");
1778 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1780 "package Bundle::$me;\n\n",
1781 "\$VERSION = '0.01';\n\n",
1785 "Bundle::$me - Snapshot of installation on ",
1786 $Config::Config{'myhostname'},
1789 "\n\n=head1 SYNOPSIS\n\n",
1790 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1791 "=head1 CONTENTS\n\n",
1792 join("\n", @bundle),
1793 "\n\n=head1 CONFIGURATION\n\n",
1795 "\n\n=head1 AUTHOR\n\n",
1796 "This Bundle has been generated automatically ",
1797 "by the autobundle routine in CPAN.pm.\n",
1800 $CPAN::Frontend->myprint("\nWrote bundle file
1804 #-> sub CPAN::Shell::expandany ;
1807 CPAN->debug("s[$s]") if $CPAN::DEBUG;
1808 if ($s =~ m|/|) { # looks like a file
1809 $s = CPAN::Distribution->normalize($s);
1810 return $CPAN::META->instance('CPAN::Distribution',$s);
1811 # Distributions spring into existence, not expand
1812 } elsif ($s =~ m|^Bundle::|) {
1813 $self->local_bundles; # scanning so late for bundles seems
1814 # both attractive and crumpy: always
1815 # current state but easy to forget
1817 return $self->expand('Bundle',$s);
1819 return $self->expand('Module',$s)
1820 if $CPAN::META->exists('CPAN::Module',$s);
1825 #-> sub CPAN::Shell::expand ;
1828 my($type,@args) = @_;
1829 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
1830 my $class = "CPAN::$type";
1831 my $methods = ['id'];
1832 for my $meth (qw(name)) {
1833 next if $] < 5.00303; # no "can"
1834 next unless $class->can($meth);
1835 push @$methods, $meth;
1837 $self->expand_by_method($class,$methods,@args);
1840 sub expand_by_method {
1842 my($class,$methods,@args) = @_;
1845 my($regex,$command);
1846 if ($arg =~ m|^/(.*)/$|) {
1848 } elsif ($arg =~ m/=/) {
1852 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
1854 defined $regex ? $regex : "UNDEFINED",
1855 defined $command ? $command : "UNDEFINED",
1857 if (defined $regex) {
1859 $CPAN::META->all_objects($class)
1862 # BUG, we got an empty object somewhere
1863 require Data::Dumper;
1864 CPAN->debug(sprintf(
1865 "Bug in CPAN: Empty id on obj[%s][%s]",
1867 Data::Dumper::Dumper($obj)
1871 for my $method (@$methods) {
1872 if ($obj->$method() =~ /$regex/i) {
1878 } elsif ($command) {
1879 die "equal sign in command disabled (immature interface), ".
1881 ! \$CPAN::Shell::ADVANCED_QUERY=1
1882 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
1883 that may go away anytime.\n"
1884 unless $ADVANCED_QUERY;
1885 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
1886 my($matchcrit) = $criterion =~ m/^~(.+)/;
1890 $CPAN::META->all_objects($class)
1892 my $lhs = $self->$method() or next; # () for 5.00503
1894 push @m, $self if $lhs =~ m/$matchcrit/;
1896 push @m, $self if $lhs eq $criterion;
1901 if ( $class eq 'CPAN::Bundle' ) {
1902 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1903 } elsif ($class eq "CPAN::Distribution") {
1904 $xarg = CPAN::Distribution->normalize($arg);
1908 if ($CPAN::META->exists($class,$xarg)) {
1909 $obj = $CPAN::META->instance($class,$xarg);
1910 } elsif ($CPAN::META->exists($class,$arg)) {
1911 $obj = $CPAN::META->instance($class,$arg);
1918 @m = sort {$a->id cmp $b->id} @m;
1919 if ( $CPAN::DEBUG ) {
1920 my $wantarray = wantarray;
1921 my $join_m = join ",", map {$_->id} @m;
1922 $self->debug("wantarray[$wantarray]join_m[$join_m]");
1924 return wantarray ? @m : $m[0];
1927 #-> sub CPAN::Shell::format_result ;
1930 my($type,@args) = @_;
1931 @args = '/./' unless @args;
1932 my(@result) = $self->expand($type,@args);
1933 my $result = @result == 1 ?
1934 $result[0]->as_string :
1936 "No objects of type $type found for argument @args\n" :
1938 (map {$_->as_glimpse} @result),
1939 scalar @result, " items found\n",
1944 #-> sub CPAN::Shell::report_fh ;
1946 my $installation_report_fh;
1947 my $previously_noticed = 0;
1950 return $installation_report_fh if $installation_report_fh;
1951 $installation_report_fh = File::Temp->new(
1952 template => 'cpan_install_XXXX',
1956 unless ( $installation_report_fh ) {
1957 warn("Couldn't open installation report file; " .
1958 "no report file will be generated."
1959 ) unless $previously_noticed++;
1965 # The only reason for this method is currently to have a reliable
1966 # debugging utility that reveals which output is going through which
1967 # channel. No, I don't like the colors ;-)
1969 #-> sub CPAN::Shell::print_ornameted ;
1970 sub print_ornamented {
1971 my($self,$what,$ornament) = @_;
1973 return unless defined $what;
1975 local $| = 1; # Flush immediately
1976 if ( $CPAN::Be_Silent ) {
1977 print {report_fh()} $what;
1981 if ($CPAN::Config->{term_is_latin}){
1984 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
1986 if ($PRINT_ORNAMENTING) {
1987 unless (defined &color) {
1988 if ($CPAN::META->has_inst("Term::ANSIColor")) {
1989 import Term::ANSIColor "color";
1991 *color = sub { return "" };
1995 for $line (split /\n/, $what) {
1996 $longest = length($line) if length($line) > $longest;
1998 my $sprintf = "%-" . $longest . "s";
2000 $what =~ s/(.*\n?)//m;
2003 my($nl) = chomp $line ? "\n" : "";
2004 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
2005 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
2009 # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
2015 my($self,$what) = @_;
2017 $self->print_ornamented($what, 'bold blue on_yellow');
2021 my($self,$what) = @_;
2022 $self->myprint($what);
2027 my($self,$what) = @_;
2028 $self->print_ornamented($what, 'bold red on_yellow');
2032 my($self,$what) = @_;
2033 $self->print_ornamented($what, 'bold red on_white');
2034 Carp::confess "died";
2038 my($self,$what) = @_;
2039 $self->print_ornamented($what, 'bold red on_white');
2043 # use this only for unrecoverable errors!
2044 sub unrecoverable_error {
2045 my($self,$what) = @_;
2046 my @lines = split /\n/, $what;
2048 for my $l (@lines) {
2049 $longest = length $l if length $l > $longest;
2051 $longest = 62 if $longest > 62;
2052 for my $l (@lines) {
2058 if (length $l < 66) {
2059 $l = pack "A66 A*", $l, "<==";
2063 unshift @lines, "\n";
2064 $self->mydie(join "", @lines);
2069 my($self, $sleep) = @_;
2074 return if -t STDOUT;
2075 my $odef = select STDERR;
2082 #-> sub CPAN::Shell::rematein ;
2083 # RE-adme||MA-ke||TE-st||IN-stall
2086 my($meth,@some) = @_;
2088 while($meth =~ /^(force|notest)$/) {
2089 push @pragma, $meth;
2090 $meth = shift @some or
2091 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2095 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2097 # Here is the place to set "test_count" on all involved parties to
2098 # 0. We then can pass this counter on to the involved
2099 # distributions and those can refuse to test if test_count > X. In
2100 # the first stab at it we could use a 1 for "X".
2102 # But when do I reset the distributions to start with 0 again?
2103 # Jost suggested to have a random or cycling interaction ID that
2104 # we pass through. But the ID is something that is just left lying
2105 # around in addition to the counter, so I'd prefer to set the
2106 # counter to 0 now, and repeat at the end of the loop. But what
2107 # about dependencies? They appear later and are not reset, they
2108 # enter the queue but not its copy. How do they get a sensible
2111 # construct the queue
2113 STHING: foreach $s (@some) {
2116 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2118 } elsif ($s =~ m|^/|) { # looks like a regexp
2119 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2123 } elsif ($meth eq "ls") {
2124 $self->handle_ls(\@pragma,$s);
2127 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2128 $obj = CPAN::Shell->expandany($s);
2131 $obj->color_cmd_tmps(0,1);
2132 CPAN::Queue->new($obj->id);
2134 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2135 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2136 if ($meth =~ /^(dump|ls)$/) {
2139 $CPAN::Frontend->myprint(
2141 "Don't be silly, you can't $meth ",
2149 ->myprint(qq{Warning: Cannot $meth $s, }.
2150 qq{don\'t know what it is.
2155 to find objects with matching identifiers.
2161 # queuerunner (please be warned: when I started to change the
2162 # queue to hold objects instead of names, I made one or two
2163 # mistakes and never found which. I reverted back instead)
2164 while ($s = CPAN::Queue->first) {
2167 $obj = $s; # I do not believe, we would survive if this happened
2169 $obj = CPAN::Shell->expandany($s);
2171 for my $pragma (@pragma) {
2174 ($] < 5.00303 || $obj->can($pragma))){
2175 ### compatibility with 5.003
2176 $obj->$pragma($meth); # the pragma "force" in
2177 # "CPAN::Distribution" must know
2178 # what we are intending
2181 if ($]>=5.00303 && $obj->can('called_for')) {
2182 $obj->called_for($s);
2185 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string\[}.
2191 CPAN::Queue->delete($s);
2193 CPAN->debug("failed");
2197 CPAN::Queue->delete_first($s);
2199 for my $obj (@qcopy) {
2200 $obj->color_cmd_tmps(0,0);
2201 delete $obj->{incommandcolor};
2205 #-> sub CPAN::Shell::recent ;
2209 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2214 # set up the dispatching methods
2216 for my $command (qw(
2231 *$command = sub { shift->rematein($command, @_); };
2235 package CPAN::LWP::UserAgent;
2239 return if $SETUPDONE;
2240 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2241 require LWP::UserAgent;
2242 @ISA = qw(Exporter LWP::UserAgent);
2245 $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
2249 sub get_basic_credentials {
2250 my($self, $realm, $uri, $proxy) = @_;
2251 return unless $proxy;
2252 if ($USER && $PASSWD) {
2253 } elsif (defined $CPAN::Config->{proxy_user} &&
2254 defined $CPAN::Config->{proxy_pass}) {
2255 $USER = $CPAN::Config->{proxy_user};
2256 $PASSWD = $CPAN::Config->{proxy_pass};
2258 require ExtUtils::MakeMaker;
2259 ExtUtils::MakeMaker->import(qw(prompt));
2260 $USER = prompt("Proxy authentication needed!
2261 (Note: to permanently configure username and password run
2262 o conf proxy_user your_username
2263 o conf proxy_pass your_password
2265 if ($CPAN::META->has_inst("Term::ReadKey")) {
2266 Term::ReadKey::ReadMode("noecho");
2268 $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n");
2270 $PASSWD = prompt("Password:");
2271 if ($CPAN::META->has_inst("Term::ReadKey")) {
2272 Term::ReadKey::ReadMode("restore");
2274 $CPAN::Frontend->myprint("\n\n");
2276 return($USER,$PASSWD);
2279 # mirror(): Its purpose is to deal with proxy authentication. When we
2280 # call SUPER::mirror, we relly call the mirror method in
2281 # LWP::UserAgent. LWP::UserAgent will then call
2282 # $self->get_basic_credentials or some equivalent and this will be
2283 # $self->dispatched to our own get_basic_credentials method.
2285 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2287 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2288 # although we have gone through our get_basic_credentials, the proxy
2289 # server refuses to connect. This could be a case where the username or
2290 # password has changed in the meantime, so I'm trying once again without
2291 # $USER and $PASSWD to give the get_basic_credentials routine another
2292 # chance to set $USER and $PASSWD.
2294 # mirror(): Its purpose is to deal with proxy authentication. When we
2295 # call SUPER::mirror, we relly call the mirror method in
2296 # LWP::UserAgent. LWP::UserAgent will then call
2297 # $self->get_basic_credentials or some equivalent and this will be
2298 # $self->dispatched to our own get_basic_credentials method.
2300 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2302 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2303 # although we have gone through our get_basic_credentials, the proxy
2304 # server refuses to connect. This could be a case where the username or
2305 # password has changed in the meantime, so I'm trying once again without
2306 # $USER and $PASSWD to give the get_basic_credentials routine another
2307 # chance to set $USER and $PASSWD.
2310 my($self,$url,$aslocal) = @_;
2311 my $result = $self->SUPER::mirror($url,$aslocal);
2312 if ($result->code == 407) {
2315 $result = $self->SUPER::mirror($url,$aslocal);
2323 #-> sub CPAN::FTP::ftp_get ;
2325 my($class,$host,$dir,$file,$target) = @_;
2327 qq[Going to fetch file [$file] from dir [$dir]
2328 on host [$host] as local [$target]\n]
2330 my $ftp = Net::FTP->new($host);
2332 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2335 return 0 unless defined $ftp;
2336 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2337 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2338 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2339 my $msg = $ftp->message;
2340 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2343 unless ( $ftp->cwd($dir) ){
2344 my $msg = $ftp->message;
2345 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2349 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2350 unless ( $ftp->get($file,$target) ){
2351 my $msg = $ftp->message;
2352 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2355 $ftp->quit; # it's ok if this fails
2359 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2361 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2362 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2364 # > *** 1562,1567 ****
2365 # > --- 1562,1580 ----
2366 # > return 1 if substr($url,0,4) eq "file";
2367 # > return 1 unless $url =~ m|://([^/]+)|;
2369 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2371 # > + $proxy =~ m|://([^/:]+)|;
2373 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2374 # > + if ($noproxy) {
2375 # > + if ($host !~ /$noproxy$/) {
2376 # > + $host = $proxy;
2379 # > + $host = $proxy;
2382 # > require Net::Ping;
2383 # > return 1 unless $Net::Ping::VERSION >= 2;
2387 #-> sub CPAN::FTP::localize ;
2389 my($self,$file,$aslocal,$force) = @_;
2391 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2392 unless defined $aslocal;
2393 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2396 if ($^O eq 'MacOS') {
2397 # Comment by AK on 2000-09-03: Uniq short filenames would be
2398 # available in CHECKSUMS file
2399 my($name, $path) = File::Basename::fileparse($aslocal, '');
2400 if (length($name) > 31) {
2411 my $size = 31 - length($suf);
2412 while (length($name) > $size) {
2416 $aslocal = File::Spec->catfile($path, $name);
2420 if (-f $aslocal && -r _ && !($force & 1)){
2424 # empty file from a previous unsuccessful attempt to download it
2426 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I could not remove.");
2431 rename $aslocal, "$aslocal.bak";
2435 my($aslocal_dir) = File::Basename::dirname($aslocal);
2436 File::Path::mkpath($aslocal_dir);
2437 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2438 qq{directory "$aslocal_dir".
2439 I\'ll continue, but if you encounter problems, they may be due
2440 to insufficient permissions.\n}) unless -w $aslocal_dir;
2442 # Inheritance is not easier to manage than a few if/else branches
2443 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2445 CPAN::LWP::UserAgent->config;
2446 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2448 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2452 $Ua->proxy('ftp', $var)
2453 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2454 $Ua->proxy('http', $var)
2455 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2458 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2460 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2461 # > use ones that require basic autorization.
2463 # > Example of when I use it manually in my own stuff:
2465 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2466 # > $req->proxy_authorization_basic("username","password");
2467 # > $res = $ua->request($req);
2471 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2475 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2476 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2479 # Try the list of urls for each single object. We keep a record
2480 # where we did get a file from
2481 my(@reordered,$last);
2482 $CPAN::Config->{urllist} ||= [];
2483 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2484 warn "Malformed urllist; ignoring. Configuration file corrupt?\n";
2486 $last = $#{$CPAN::Config->{urllist}};
2487 if ($force & 2) { # local cpans probably out of date, don't reorder
2488 @reordered = (0..$last);
2492 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2494 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2505 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2507 @levels = qw/easy hard hardest/;
2509 @levels = qw/easy/ if $^O eq 'MacOS';
2511 for $levelno (0..$#levels) {
2512 my $level = $levels[$levelno];
2513 my $method = "host$level";
2514 my @host_seq = $level eq "easy" ?
2515 @reordered : 0..$last; # reordered has CDROM up front
2516 @host_seq = (0) unless @host_seq;
2517 my $ret = $self->$method(\@host_seq,$file,$aslocal);
2519 $Themethod = $level;
2521 # utime $now, $now, $aslocal; # too bad, if we do that, we
2522 # might alter a local mirror
2523 $self->debug("level[$level]") if $CPAN::DEBUG;
2527 last if $CPAN::Signal; # need to cleanup
2530 unless ($CPAN::Signal) {
2533 qq{Please check, if the URLs I found in your configuration file \(}.
2534 join(", ", @{$CPAN::Config->{urllist}}).
2535 qq{\) are valid. The urllist can be edited.},
2536 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2537 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2539 $CPAN::Frontend->myprint("Could not fetch $file\n");
2542 rename "$aslocal.bak", $aslocal;
2543 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2544 $self->ls($aslocal));
2551 my($self,$host_seq,$file,$aslocal) = @_;
2553 HOSTEASY: for $i (@$host_seq) {
2554 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2555 $url .= "/" unless substr($url,-1) eq "/";
2557 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2558 if ($url =~ /^file:/) {
2560 if ($CPAN::META->has_inst('URI::URL')) {
2561 my $u = URI::URL->new($url);
2563 } else { # works only on Unix, is poorly constructed, but
2564 # hopefully better than nothing.
2565 # RFC 1738 says fileurl BNF is
2566 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2567 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2569 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2570 $l =~ s|^file:||; # assume they
2573 $l =~ s|^/||s unless -f $l; # e.g. /P:
2574 $self->debug("without URI::URL we try local file $l") if $CPAN::DEBUG;
2576 if ( -f $l && -r _) {
2580 # Maybe mirror has compressed it?
2582 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2583 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2590 if ($CPAN::META->has_usable('LWP')) {
2591 $CPAN::Frontend->myprint("Fetching with LWP:
2595 CPAN::LWP::UserAgent->config;
2596 eval { $Ua = CPAN::LWP::UserAgent->new; };
2598 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2601 my $res = $Ua->mirror($url, $aslocal);
2602 if ($res->is_success) {
2605 utime $now, $now, $aslocal; # download time is more
2606 # important than upload time
2608 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2609 my $gzurl = "$url.gz";
2610 $CPAN::Frontend->myprint("Fetching with LWP:
2613 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2614 if ($res->is_success &&
2615 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
2621 $CPAN::Frontend->myprint(sprintf(
2622 "LWP failed with code[%s] message[%s]\n",
2626 # Alan Burlison informed me that in firewall environments
2627 # Net::FTP can still succeed where LWP fails. So we do not
2628 # skip Net::FTP anymore when LWP is available.
2631 $CPAN::Frontend->myprint("LWP not available\n");
2633 return if $CPAN::Signal;
2634 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2635 # that's the nice and easy way thanks to Graham
2636 my($host,$dir,$getfile) = ($1,$2,$3);
2637 if ($CPAN::META->has_usable('Net::FTP')) {
2639 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2642 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2643 "aslocal[$aslocal]") if $CPAN::DEBUG;
2644 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2648 if ($aslocal !~ /\.gz(?!\n)\Z/) {
2649 my $gz = "$aslocal.gz";
2650 $CPAN::Frontend->myprint("Fetching with Net::FTP
2653 if (CPAN::FTP->ftp_get($host,
2657 CPAN::Tarzip->new($gz)->gunzip($aslocal)
2666 return if $CPAN::Signal;
2671 my($self,$host_seq,$file,$aslocal) = @_;
2673 # Came back if Net::FTP couldn't establish connection (or
2674 # failed otherwise) Maybe they are behind a firewall, but they
2675 # gave us a socksified (or other) ftp program...
2678 my($devnull) = $CPAN::Config->{devnull} || "";
2680 my($aslocal_dir) = File::Basename::dirname($aslocal);
2681 File::Path::mkpath($aslocal_dir);
2682 HOSTHARD: for $i (@$host_seq) {
2683 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2684 $url .= "/" unless substr($url,-1) eq "/";
2686 my($proto,$host,$dir,$getfile);
2688 # Courtesy Mark Conty mark_conty@cargill.com change from
2689 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2691 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2692 # proto not yet used
2693 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2695 next HOSTHARD; # who said, we could ftp anything except ftp?
2697 next HOSTHARD if $proto eq "file"; # file URLs would have had
2698 # success above. Likely a bogus URL
2700 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2702 # Try the most capable first and leave ncftp* for last as it only
2704 for my $f (qw(curl wget lynx ncftpget ncftp)) {
2705 my $funkyftp = $CPAN::Config->{$f};
2706 next unless defined $funkyftp;
2707 next if $funkyftp =~ /^\s*$/;
2709 my($asl_ungz, $asl_gz);
2710 ($asl_ungz = $aslocal) =~ s/\.gz//;
2711 $asl_gz = "$asl_ungz.gz";
2713 my($src_switch) = "";
2715 my($stdout_redir) = " > $asl_ungz";
2717 $src_switch = " -source";
2718 } elsif ($f eq "ncftp"){
2719 $src_switch = " -c";
2720 } elsif ($f eq "wget"){
2721 $src_switch = " -O $asl_ungz";
2723 } elsif ($f eq 'curl'){
2724 $src_switch = ' -L';
2727 if ($f eq "ncftpget"){
2728 $chdir = "cd $aslocal_dir && ";
2731 $CPAN::Frontend->myprint(
2733 Trying with "$funkyftp$src_switch" to get
2737 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
2738 $self->debug("system[$system]") if $CPAN::DEBUG;
2740 if (($wstatus = system($system)) == 0
2743 -s $asl_ungz # lynx returns 0 when it fails somewhere
2749 } elsif ($asl_ungz ne $aslocal) {
2750 # test gzip integrity
2751 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
2752 # e.g. foo.tar is gzipped --> foo.tar.gz
2753 rename $asl_ungz, $aslocal;
2755 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
2760 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2762 -f $asl_ungz && -s _ == 0;
2763 my $gz = "$aslocal.gz";
2764 my $gzurl = "$url.gz";
2765 $CPAN::Frontend->myprint(
2767 Trying with "$funkyftp$src_switch" to get
2770 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
2771 $self->debug("system[$system]") if $CPAN::DEBUG;
2773 if (($wstatus = system($system)) == 0
2777 # test gzip integrity
2778 my $ct = CPAN::Tarzip->new($asl_gz);
2780 $ct->gunzip($aslocal);
2782 # somebody uncompressed file for us?
2783 rename $asl_ungz, $aslocal;
2788 unlink $asl_gz if -f $asl_gz;
2791 my $estatus = $wstatus >> 8;
2792 my $size = -f $aslocal ?
2793 ", left\n$aslocal with size ".-s _ :
2794 "\nWarning: expected file [$aslocal] doesn't exist";
2795 $CPAN::Frontend->myprint(qq{
2796 System call "$system"
2797 returned status $estatus (wstat $wstatus)$size
2800 return if $CPAN::Signal;
2801 } # transfer programs
2806 my($self,$host_seq,$file,$aslocal) = @_;
2809 my($aslocal_dir) = File::Basename::dirname($aslocal);
2810 File::Path::mkpath($aslocal_dir);
2811 my $ftpbin = $CPAN::Config->{ftp};
2812 HOSTHARDEST: for $i (@$host_seq) {
2813 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
2814 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2817 my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
2818 $url .= "/" unless substr($url,-1) eq "/";
2820 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2821 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2824 my($host,$dir,$getfile) = ($1,$2,$3);
2826 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2827 $ctime,$blksize,$blocks) = stat($aslocal);
2828 $timestamp = $mtime ||= 0;
2829 my($netrc) = CPAN::FTP::netrc->new;
2830 my($netrcfile) = $netrc->netrc;
2831 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2832 my $targetfile = File::Basename::basename($aslocal);
2838 map("cd $_", split /\//, $dir), # RFC 1738
2840 "get $getfile $targetfile",
2844 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2845 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2846 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2848 $netrc->contains($host))) if $CPAN::DEBUG;
2849 if ($netrc->protected) {
2850 $CPAN::Frontend->myprint(qq{
2851 Trying with external ftp to get
2853 As this requires some features that are not thoroughly tested, we\'re
2854 not sure, that we get it right....
2858 $self->talk_ftp("$ftpbin$verbose $host",
2860 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2861 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2863 if ($mtime > $timestamp) {
2864 $CPAN::Frontend->myprint("GOT $aslocal\n");
2868 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2870 return if $CPAN::Signal;
2872 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2873 qq{correctly protected.\n});
2876 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
2877 nor does it have a default entry\n");
2880 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
2881 # then and login manually to host, using e-mail as
2883 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
2887 "user anonymous $Config::Config{'cf_email'}"
2889 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
2890 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2891 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2893 if ($mtime > $timestamp) {
2894 $CPAN::Frontend->myprint("GOT $aslocal\n");
2898 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
2900 return if $CPAN::Signal;
2901 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
2907 my($self,$command,@dialog) = @_;
2908 my $fh = FileHandle->new;
2909 $fh->open("|$command") or die "Couldn't open ftp: $!";
2910 foreach (@dialog) { $fh->print("$_\n") }
2911 $fh->close; # Wait for process to complete
2913 my $estatus = $wstatus >> 8;
2914 $CPAN::Frontend->myprint(qq{
2915 Subprocess "|$command"
2916 returned status $estatus (wstat $wstatus)
2920 # find2perl needs modularization, too, all the following is stolen
2924 my($self,$name) = @_;
2925 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
2926 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
2928 my($perms,%user,%group);
2932 $blocks = int(($blocks + 1) / 2);
2935 $blocks = int(($sizemm + 1023) / 1024);
2938 if (-f _) { $perms = '-'; }
2939 elsif (-d _) { $perms = 'd'; }
2940 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
2941 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
2942 elsif (-p _) { $perms = 'p'; }
2943 elsif (-S _) { $perms = 's'; }
2944 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
2946 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
2947 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2948 my $tmpmode = $mode;
2949 my $tmp = $rwx[$tmpmode & 7];
2951 $tmp = $rwx[$tmpmode & 7] . $tmp;
2953 $tmp = $rwx[$tmpmode & 7] . $tmp;
2954 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
2955 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
2956 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
2959 my $user = $user{$uid} || $uid; # too lazy to implement lookup
2960 my $group = $group{$gid} || $gid;
2962 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
2964 my($moname) = $moname[$mon];
2965 if (-M _ > 365.25 / 2) {
2966 $timeyear = $year + 1900;
2969 $timeyear = sprintf("%02d:%02d", $hour, $min);
2972 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
2986 package CPAN::FTP::netrc;
2991 my $file = File::Spec->catfile($ENV{HOME},".netrc");
2993 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2994 $atime,$mtime,$ctime,$blksize,$blocks)
2999 my($fh,@machines,$hasdefault);
3001 $fh = FileHandle->new or die "Could not create a filehandle";
3003 if($fh->open($file)){
3004 $protected = ($mode & 077) == 0;
3006 NETRC: while (<$fh>) {
3007 my(@tokens) = split " ", $_;
3008 TOKEN: while (@tokens) {
3009 my($t) = shift @tokens;
3010 if ($t eq "default"){
3014 last TOKEN if $t eq "macdef";
3015 if ($t eq "machine") {
3016 push @machines, shift @tokens;
3021 $file = $hasdefault = $protected = "";
3025 'mach' => [@machines],
3027 'hasdefault' => $hasdefault,
3028 'protected' => $protected,
3032 # CPAN::FTP::hasdefault;
3033 sub hasdefault { shift->{'hasdefault'} }
3034 sub netrc { shift->{'netrc'} }
3035 sub protected { shift->{'protected'} }
3037 my($self,$mach) = @_;
3038 for ( @{$self->{'mach'}} ) {
3039 return 1 if $_ eq $mach;
3044 package CPAN::Complete;
3048 my($text, $line, $start, $end) = @_;
3049 my(@perlret) = cpl($text, $line, $start);
3050 # find longest common match. Can anybody show me how to peruse
3051 # T::R::Gnu to have this done automatically? Seems expensive.
3052 return () unless @perlret;
3053 my($newtext) = $text;
3054 for (my $i = length($text)+1;;$i++) {
3055 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3056 my $try = substr($perlret[0],0,$i);
3057 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3058 # warn "try[$try]tries[@tries]";
3059 if (@tries == @perlret) {
3065 ($newtext,@perlret);
3068 #-> sub CPAN::Complete::cpl ;
3070 my($word,$line,$pos) = @_;
3074 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3076 if ($line =~ s/^(force\s*)//) {
3081 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3082 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3084 } elsif ($line =~ /^(a|ls)\s/) {
3085 @return = cplx('CPAN::Author',uc($word));
3086 } elsif ($line =~ /^b\s/) {
3087 CPAN::Shell->local_bundles;
3088 @return = cplx('CPAN::Bundle',$word);
3089 } elsif ($line =~ /^d\s/) {
3090 @return = cplx('CPAN::Distribution',$word);
3091 } elsif ($line =~ m/^(
3092 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3094 if ($word =~ /^Bundle::/) {
3095 CPAN::Shell->local_bundles;
3097 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3098 } elsif ($line =~ /^i\s/) {
3099 @return = cpl_any($word);
3100 } elsif ($line =~ /^reload\s/) {
3101 @return = cpl_reload($word,$line,$pos);
3102 } elsif ($line =~ /^o\s/) {
3103 @return = cpl_option($word,$line,$pos);
3104 } elsif ($line =~ m/^\S+\s/ ) {
3105 # fallback for future commands and what we have forgotten above
3106 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3113 #-> sub CPAN::Complete::cplx ;
3115 my($class, $word) = @_;
3116 # I believed for many years that this was sorted, today I
3117 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3118 # make it sorted again. Maybe sort was dropped when GNU-readline
3119 # support came in? The RCS file is difficult to read on that:-(
3120 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3123 #-> sub CPAN::Complete::cpl_any ;
3127 cplx('CPAN::Author',$word),
3128 cplx('CPAN::Bundle',$word),
3129 cplx('CPAN::Distribution',$word),
3130 cplx('CPAN::Module',$word),
3134 #-> sub CPAN::Complete::cpl_reload ;
3136 my($word,$line,$pos) = @_;
3138 my(@words) = split " ", $line;
3139 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3140 my(@ok) = qw(cpan index);
3141 return @ok if @words == 1;
3142 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3145 #-> sub CPAN::Complete::cpl_option ;
3147 my($word,$line,$pos) = @_;
3149 my(@words) = split " ", $line;
3150 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3151 my(@ok) = qw(conf debug);
3152 return @ok if @words == 1;
3153 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3155 } elsif ($words[1] eq 'index') {
3157 } elsif ($words[1] eq 'conf') {
3158 return CPAN::HandleConfig::cpl(@_);
3159 } elsif ($words[1] eq 'debug') {
3160 return sort grep /^\Q$word\E/i,
3161 sort keys %CPAN::DEBUG, 'all';
3165 package CPAN::Index;
3168 #-> sub CPAN::Index::force_reload ;
3171 $CPAN::Index::LAST_TIME = 0;
3175 #-> sub CPAN::Index::reload ;
3177 my($cl,$force) = @_;
3180 # XXX check if a newer one is available. (We currently read it
3181 # from time to time)
3182 for ($CPAN::Config->{index_expire}) {
3183 $_ = 0.001 unless $_ && $_ > 0.001;
3185 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3186 # debug here when CPAN doesn't seem to read the Metadata
3188 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3190 unless ($CPAN::META->{PROTOCOL}) {
3191 $cl->read_metadata_cache;
3192 $CPAN::META->{PROTOCOL} ||= "1.0";
3194 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3195 # warn "Setting last_time to 0";
3196 $LAST_TIME = 0; # No warning necessary
3198 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3201 # IFF we are developing, it helps to wipe out the memory
3202 # between reloads, otherwise it is not what a user expects.
3203 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3204 $CPAN::META = CPAN->new;
3208 local $LAST_TIME = $time;
3209 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3211 my $needshort = $^O eq "dos";
3213 $cl->rd_authindex($cl
3215 "authors/01mailrc.txt.gz",
3217 File::Spec->catfile('authors', '01mailrc.gz') :
3218 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3221 $debug = "timing reading 01[".($t2 - $time)."]";
3223 return if $CPAN::Signal; # this is sometimes lengthy
3224 $cl->rd_modpacks($cl
3226 "modules/02packages.details.txt.gz",
3228 File::Spec->catfile('modules', '02packag.gz') :
3229 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3232 $debug .= "02[".($t2 - $time)."]";
3234 return if $CPAN::Signal; # this is sometimes lengthy
3237 "modules/03modlist.data.gz",
3239 File::Spec->catfile('modules', '03mlist.gz') :
3240 File::Spec->catfile('modules', '03modlist.data.gz'),
3242 $cl->write_metadata_cache;
3244 $debug .= "03[".($t2 - $time)."]";
3246 CPAN->debug($debug) if $CPAN::DEBUG;
3249 $CPAN::META->{PROTOCOL} = PROTOCOL;
3252 #-> sub CPAN::Index::reload_x ;
3254 my($cl,$wanted,$localname,$force) = @_;
3255 $force |= 2; # means we're dealing with an index here
3256 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3258 $localname ||= $wanted;
3259 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3263 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3266 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3267 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3268 qq{day$s. I\'ll use that.});
3271 $force |= 1; # means we're quite serious about it.
3273 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3276 #-> sub CPAN::Index::rd_authindex ;
3278 my($cl, $index_target) = @_;
3280 return unless defined $index_target;
3281 $CPAN::Frontend->myprint("Going to read $index_target\n");
3283 tie *FH, 'CPAN::Tarzip', $index_target;
3286 push @lines, split /\012/ while <FH>;
3288 my($userid,$fullname,$email) =
3289 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3290 next unless $userid && $fullname && $email;
3292 # instantiate an author object
3293 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3294 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3295 return if $CPAN::Signal;
3300 my($self,$dist) = @_;
3301 $dist = $self->{'id'} unless defined $dist;
3302 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3306 #-> sub CPAN::Index::rd_modpacks ;
3308 my($self, $index_target) = @_;
3310 return unless defined $index_target;
3311 $CPAN::Frontend->myprint("Going to read $index_target\n");
3312 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3315 while ($_ = $fh->READLINE) {
3317 my @ls = map {"$_\n"} split /\n/, $_;
3318 unshift @ls, "\n" x length($1) if /^(\n+)/;
3322 my($line_count,$last_updated);
3324 my $shift = shift(@lines);
3325 last if $shift =~ /^\s*$/;
3326 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3327 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3329 if (not defined $line_count) {
3331 warn qq{Warning: Your $index_target does not contain a Line-Count header.
3332 Please check the validity of the index file by comparing it to more
3333 than one CPAN mirror. I'll continue but problems seem likely to
3338 } elsif ($line_count != scalar @lines) {
3340 warn sprintf qq{Warning: Your %s
3341 contains a Line-Count header of %d but I see %d lines there. Please
3342 check the validity of the index file by comparing it to more than one
3343 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3344 $index_target, $line_count, scalar(@lines);
3347 if (not defined $last_updated) {
3349 warn qq{Warning: Your $index_target does not contain a Last-Updated header.
3350 Please check the validity of the index file by comparing it to more
3351 than one CPAN mirror. I'll continue but problems seem likely to
3359 ->myprint(sprintf qq{ Database was generated on %s\n},
3361 $DATE_OF_02 = $last_updated;
3364 if ($CPAN::META->has_inst('HTTP::Date')) {
3366 $age -= HTTP::Date::str2time($last_updated);
3368 $CPAN::Frontend->myprint(" HTTP::Date not available\n");
3369 require Time::Local;
3370 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3371 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3372 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3379 qq{Warning: This index file is %d days old.
3380 Please check the host you chose as your CPAN mirror for staleness.
3381 I'll continue but problems seem likely to happen.\a\n},
3384 } elsif ($age < -1) {
3388 qq{Warning: Your system date is %d days behind this index file!
3390 Timestamp index file: %s
3391 Please fix your system time, problems with the make command expected.\n},
3401 # A necessity since we have metadata_cache: delete what isn't
3403 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3404 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3408 # before 1.56 we split into 3 and discarded the rest. From
3409 # 1.57 we assign remaining text to $comment thus allowing to
3410 # influence isa_perl
3411 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3412 my($bundle,$id,$userid);
3414 if ($mod eq 'CPAN' &&
3416 CPAN::Queue->exists('Bundle::CPAN') ||
3417 CPAN::Queue->exists('CPAN')
3421 if ($version > $CPAN::VERSION){
3422 $CPAN::Frontend->myprint(qq{
3423 There's a new CPAN.pm version (v$version) available!
3424 [Current version is v$CPAN::VERSION]
3425 You might want to try
3426 install Bundle::CPAN
3428 without quitting the current session. It should be a seamless upgrade
3429 while we are running...
3432 $CPAN::Frontend->myprint(qq{\n});
3434 last if $CPAN::Signal;
3435 } elsif ($mod =~ /^Bundle::(.*)/) {
3440 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3441 # Let's make it a module too, because bundles have so much
3442 # in common with modules.
3444 # Changed in 1.57_63: seems like memory bloat now without
3445 # any value, so commented out
3447 # $CPAN::META->instance('CPAN::Module',$mod);
3451 # instantiate a module object
3452 $id = $CPAN::META->instance('CPAN::Module',$mod);
3456 # Although CPAN prohibits same name with different version the
3457 # indexer may have changed the version for the same distro
3458 # since the last time ("Force Reindexing" feature)
3459 if ($id->cpan_file ne $dist
3461 $id->cpan_version ne $version
3463 $userid = $id->userid || $self->userid($dist);
3465 'CPAN_USERID' => $userid,
3466 'CPAN_VERSION' => $version,
3467 'CPAN_FILE' => $dist,
3471 # instantiate a distribution object
3472 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3473 # we do not need CONTAINSMODS unless we do something with
3474 # this dist, so we better produce it on demand.
3476 ## my $obj = $CPAN::META->instance(
3477 ## 'CPAN::Distribution' => $dist
3479 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3481 $CPAN::META->instance(
3482 'CPAN::Distribution' => $dist
3484 'CPAN_USERID' => $userid,
3485 'CPAN_COMMENT' => $comment,
3489 for my $name ($mod,$dist) {
3490 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3491 $exists{$name} = undef;
3494 return if $CPAN::Signal;
3498 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3499 for my $o ($CPAN::META->all_objects($class)) {
3500 next if exists $exists{$o->{ID}};
3501 $CPAN::META->delete($class,$o->{ID});
3502 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3509 #-> sub CPAN::Index::rd_modlist ;
3511 my($cl,$index_target) = @_;
3512 return unless defined $index_target;
3513 $CPAN::Frontend->myprint("Going to read $index_target\n");
3514 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3518 while ($_ = $fh->READLINE) {
3520 my @ls = map {"$_\n"} split /\n/, $_;
3521 unshift @ls, "\n" x length($1) if /^(\n+)/;
3525 my $shift = shift(@eval);
3526 if ($shift =~ /^Date:\s+(.*)/){
3527 return if $DATE_OF_03 eq $1;
3530 last if $shift =~ /^\s*$/;
3533 push @eval, q{CPAN::Modulelist->data;};
3535 my($comp) = Safe->new("CPAN::Safe1");
3536 my($eval) = join("", @eval);
3537 my $ret = $comp->reval($eval);
3538 Carp::confess($@) if $@;
3539 return if $CPAN::Signal;
3541 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3542 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3543 $obj->set(%{$ret->{$_}});
3544 return if $CPAN::Signal;
3548 #-> sub CPAN::Index::write_metadata_cache ;
3549 sub write_metadata_cache {
3551 return unless $CPAN::Config->{'cache_metadata'};
3552 return unless $CPAN::META->has_usable("Storable");
3554 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3555 CPAN::Distribution)) {
3556 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3558 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3559 $cache->{last_time} = $LAST_TIME;
3560 $cache->{DATE_OF_02} = $DATE_OF_02;
3561 $cache->{PROTOCOL} = PROTOCOL;
3562 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
3563 eval { Storable::nstore($cache, $metadata_file) };
3564 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3567 #-> sub CPAN::Index::read_metadata_cache ;
3568 sub read_metadata_cache {
3570 return unless $CPAN::Config->{'cache_metadata'};
3571 return unless $CPAN::META->has_usable("Storable");
3572 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3573 return unless -r $metadata_file and -f $metadata_file;
3574 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
3576 eval { $cache = Storable::retrieve($metadata_file) };
3577 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3578 if (!$cache || ref $cache ne 'HASH'){
3582 if (exists $cache->{PROTOCOL}) {
3583 if (PROTOCOL > $cache->{PROTOCOL}) {
3584 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
3585 "with protocol v%s, requiring v%s\n",
3592 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
3593 "with protocol v1.0\n");
3598 while(my($class,$v) = each %$cache) {
3599 next unless $class =~ /^CPAN::/;
3600 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
3601 while (my($id,$ro) = each %$v) {
3602 $CPAN::META->{readwrite}{$class}{$id} ||=
3603 $class->new(ID=>$id, RO=>$ro);
3608 unless ($clcnt) { # sanity check
3609 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
3612 if ($idcnt < 1000) {
3613 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
3614 "in $metadata_file\n");
3617 $CPAN::META->{PROTOCOL} ||=
3618 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
3619 # does initialize to some protocol
3620 $LAST_TIME = $cache->{last_time};
3621 $DATE_OF_02 = $cache->{DATE_OF_02};
3622 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
3623 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
3627 package CPAN::InfoObj;
3632 exists $self->{RO} and return $self->{RO};
3637 my $ro = $self->ro or return;
3638 return $ro->{CPAN_USERID};
3641 sub id { shift->{ID}; }
3643 #-> sub CPAN::InfoObj::new ;
3645 my $this = bless {}, shift;
3650 # The set method may only be used by code that reads index data or
3651 # otherwise "objective" data from the outside world. All session
3652 # related material may do anything else with instance variables but
3653 # must not touch the hash under the RO attribute. The reason is that
3654 # the RO hash gets written to Metadata file and is thus persistent.
3656 #-> sub CPAN::InfoObj::set ;
3658 my($self,%att) = @_;
3659 my $class = ref $self;
3661 # This must be ||=, not ||, because only if we write an empty
3662 # reference, only then the set method will write into the readonly
3663 # area. But for Distributions that spring into existence, maybe
3664 # because of a typo, we do not like it that they are written into
3665 # the readonly area and made permanent (at least for a while) and
3666 # that is why we do not "allow" other places to call ->set.
3667 unless ($self->id) {
3668 CPAN->debug("Bug? Empty ID, rejecting");
3671 my $ro = $self->{RO} =
3672 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
3674 while (my($k,$v) = each %att) {
3679 #-> sub CPAN::InfoObj::as_glimpse ;
3683 my $class = ref($self);
3684 $class =~ s/^CPAN:://;
3685 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
3689 #-> sub CPAN::InfoObj::as_string ;
3693 my $class = ref($self);
3694 $class =~ s/^CPAN:://;
3695 push @m, $class, " id = $self->{ID}\n";
3697 for (sort keys %$ro) {
3698 # next if m/^(ID|RO)$/;
3700 if ($_ eq "CPAN_USERID") {
3701 $extra .= " (".$self->author;
3702 my $email; # old perls!
3703 if ($email = $CPAN::META->instance("CPAN::Author",
3706 $extra .= " <$email>";
3708 $extra .= " <no email>";
3711 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
3712 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
3715 next unless defined $ro->{$_};
3716 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
3718 for (sort keys %$self) {
3719 next if m/^(ID|RO)$/;
3720 if (ref($self->{$_}) eq "ARRAY") {
3721 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
3722 } elsif (ref($self->{$_}) eq "HASH") {
3726 join(" ",keys %{$self->{$_}}),
3729 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
3735 #-> sub CPAN::InfoObj::author ;
3738 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
3741 #-> sub CPAN::InfoObj::dump ;
3744 require Data::Dumper;
3745 print Data::Dumper::Dumper($self);
3748 package CPAN::Author;
3751 #-> sub CPAN::Author::force
3757 #-> sub CPAN::Author::force
3760 delete $self->{force};
3763 #-> sub CPAN::Author::id
3766 my $id = $self->{ID};
3767 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
3771 #-> sub CPAN::Author::as_glimpse ;
3775 my $class = ref($self);
3776 $class =~ s/^CPAN:://;
3777 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
3785 #-> sub CPAN::Author::fullname ;
3787 shift->ro->{FULLNAME};
3791 #-> sub CPAN::Author::email ;
3792 sub email { shift->ro->{EMAIL}; }
3794 #-> sub CPAN::Author::ls ;
3797 my $glob = shift || "";
3798 my $silent = shift || 0;
3801 # adapted from CPAN::Distribution::verifyCHECKSUM ;
3802 my(@csf); # chksumfile
3803 @csf = $self->id =~ /(.)(.)(.*)/;
3804 $csf[1] = join "", @csf[0,1];
3805 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
3807 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
3808 unless (grep {$_->[2] eq $csf[1]} @dl) {
3809 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
3812 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
3813 unless (grep {$_->[2] eq $csf[2]} @dl) {
3814 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
3817 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
3819 my $rglob = Text::Glob::glob_to_regex($glob);
3820 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
3822 $CPAN::Frontend->myprint(join "", map {
3823 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
3824 } sort { $a->[2] cmp $b->[2] } @dl);
3827 # returns an array of arrays, the latter contain (size,mtime,filename)
3828 #-> sub CPAN::Author::dir_listing ;
3831 my $chksumfile = shift;
3832 my $recursive = shift;
3833 my $may_ftp = shift;
3835 File::Spec->catfile($CPAN::Config->{keep_source_where},
3836 "authors", "id", @$chksumfile);
3840 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
3841 # hazard. (Without GPG installed they are not that much better,
3843 $fh = FileHandle->new;
3844 if (open($fh, $lc_want)) {
3845 my $line = <$fh>; close $fh;
3846 unlink($lc_want) unless $line =~ /PGP/;
3850 # connect "force" argument with "index_expire".
3851 my $force = $self->{force};
3852 if (my @stat = stat $lc_want) {
3853 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
3857 $lc_file = CPAN::FTP->localize(
3858 "authors/id/@$chksumfile",
3863 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
3864 $chksumfile->[-1] .= ".gz";
3865 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
3868 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
3869 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
3875 $lc_file = $lc_want;
3876 # we *could* second-guess and if the user has a file: URL,
3877 # then we could look there. But on the other hand, if they do
3878 # have a file: URL, wy did they choose to set
3879 # $CPAN::Config->{show_upload_date} to false?
3882 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
3883 $fh = FileHandle->new;
3885 if (open $fh, $lc_file){
3888 $eval =~ s/\015?\012/\n/g;
3890 my($comp) = Safe->new();
3891 $cksum = $comp->reval($eval);
3893 rename $lc_file, "$lc_file.bad";
3894 Carp::confess($@) if $@;
3896 } elsif ($may_ftp) {
3897 Carp::carp "Could not open $lc_file for reading.";
3899 # Maybe should warn: "You may want to set show_upload_date to a true value"
3903 for $f (sort keys %$cksum) {
3904 if (exists $cksum->{$f}{isdir}) {
3906 my(@dir) = @$chksumfile;
3908 push @dir, $f, "CHECKSUMS";
3910 [$_->[0], $_->[1], "$f/$_->[2]"]
3911 } $self->dir_listing(\@dir,1,$may_ftp);
3913 push @result, [ 0, "-", $f ];
3917 ($cksum->{$f}{"size"}||0),
3918 $cksum->{$f}{"mtime"}||"---",
3926 package CPAN::Distribution;
3932 my $ro = $self->ro or return;
3936 # CPAN::Distribution::undelay
3939 delete $self->{later};
3942 # add the A/AN/ stuff
3943 # CPAN::Distribution::normalize
3946 $s = $self->id unless defined $s;
3950 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
3952 return $s if $s =~ m:^N/A|^Contact Author: ;
3953 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
3954 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
3955 CPAN->debug("s[$s]") if $CPAN::DEBUG;
3963 return $id unless $id =~ m|^./../|;
3967 # mark as dirty/clean
3968 #-> sub CPAN::Distribution::color_cmd_tmps ;
3969 sub color_cmd_tmps {
3971 my($depth) = shift || 0;
3972 my($color) = shift || 0;
3973 my($ancestors) = shift || [];
3974 # a distribution needs to recurse into its prereq_pms
3976 return if exists $self->{incommandcolor}
3977 && $self->{incommandcolor}==$color;
3979 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
3981 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
3982 my $prereq_pm = $self->prereq_pm;
3983 if (defined $prereq_pm) {
3984 for my $pre (keys %$prereq_pm) {
3985 my $premo = CPAN::Shell->expand("Module",$pre);
3986 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
3990 delete $self->{sponsored_mods};
3991 delete $self->{badtestcnt};
3993 $self->{incommandcolor} = $color;
3996 #-> sub CPAN::Distribution::as_string ;
3999 $self->containsmods;
4001 $self->SUPER::as_string(@_);
4004 #-> sub CPAN::Distribution::containsmods ;
4007 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4008 my $dist_id = $self->{ID};
4009 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4010 my $mod_file = $mod->cpan_file or next;
4011 my $mod_id = $mod->{ID} or next;
4012 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4014 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4016 keys %{$self->{CONTAINSMODS}};
4019 #-> sub CPAN::Distribution::upload_date ;
4022 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4023 my(@local_wanted) = split(/\//,$self->id);
4024 my $filename = pop @local_wanted;
4025 push @local_wanted, "CHECKSUMS";
4026 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4027 return unless $author;
4028 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4030 my($dirent) = grep { $_->[2] eq $filename } @dl;
4031 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4032 return unless $dirent->[1];
4033 return $self->{UPLOAD_DATE} = $dirent->[1];
4036 #-> sub CPAN::Distribution::uptodate ;
4040 foreach $c ($self->containsmods) {
4041 my $obj = CPAN::Shell->expandany($c);
4042 return 0 unless $obj->uptodate;
4047 #-> sub CPAN::Distribution::called_for ;
4050 $self->{CALLED_FOR} = $id if defined $id;
4051 return $self->{CALLED_FOR};
4054 #-> sub CPAN::Distribution::safe_chdir ;
4056 my($self,$todir) = @_;
4057 # we die if we cannot chdir and we are debuggable
4058 Carp::confess("safe_chdir called without todir argument")
4059 unless defined $todir and length $todir;
4061 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4065 unless (-x $todir) {
4066 unless (chmod 0755, $todir) {
4067 my $cwd = CPAN::anycwd();
4068 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4069 "permission to change the permission; cannot ".
4070 "chdir to '$todir'\n");
4071 $CPAN::Frontend->mysleep(5);
4072 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4073 qq{to todir[$todir]: $!});
4077 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4080 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4083 my $cwd = CPAN::anycwd();
4084 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4085 qq{to todir[$todir] (a chmod has been issued): $!});
4090 #-> sub CPAN::Distribution::get ;
4095 exists $self->{'build_dir'} and push @e,
4096 "Is already unwrapped into directory $self->{'build_dir'}";
4097 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4099 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4102 # Get the file on local disk
4107 File::Spec->catfile(
4108 $CPAN::Config->{keep_source_where},
4111 split(/\//,$self->id)
4114 $self->debug("Doing localize") if $CPAN::DEBUG;
4115 unless ($local_file =
4116 CPAN::FTP->localize("authors/id/$self->{ID}",
4119 if ($CPAN::Index::DATE_OF_02) {
4120 $note = "Note: Current database in memory was generated ".
4121 "on $CPAN::Index::DATE_OF_02\n";
4123 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4125 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4126 $self->{localfile} = $local_file;
4127 return if $CPAN::Signal;
4132 if ($CPAN::META->has_inst("Digest::SHA")) {
4133 $self->debug("Digest::SHA is installed, verifying");
4134 $self->verifyCHECKSUM;
4136 $self->debug("Digest::SHA is NOT installed");
4138 return if $CPAN::Signal;
4141 # Create a clean room and go there
4143 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4144 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4145 $self->safe_chdir($builddir);
4146 $self->debug("Removing tmp") if $CPAN::DEBUG;
4147 File::Path::rmtree("tmp");
4148 unless (mkdir "tmp", 0755) {
4149 $CPAN::Frontend->unrecoverable_error(<<EOF);
4150 Couldn't mkdir '$builddir/tmp': $!
4152 Cannot continue: Please find the reason why I cannot make the
4155 and fix the problem, then retry.
4160 $self->safe_chdir($sub_wd);
4163 $self->safe_chdir("tmp");
4168 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4169 my $ct = CPAN::Tarzip->new($local_file);
4170 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4171 $self->{was_uncompressed}++ unless $ct->gtest();
4172 $self->untar_me($ct);
4173 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4174 $self->unzip_me($ct);
4175 } elsif ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/) {
4176 $self->{was_uncompressed}++ unless $ct->gtest();
4177 $self->debug("calling pm2dir for local_file[$local_file]") if $CPAN::DEBUG;
4178 $self->pm2dir_me($local_file);
4180 $self->{archived} = "NO";
4181 $self->safe_chdir($sub_wd);
4185 # we are still in the tmp directory!
4186 # Let's check if the package has its own directory.
4187 my $dh = DirHandle->new(File::Spec->curdir)
4188 or Carp::croak("Couldn't opendir .: $!");
4189 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4191 my ($distdir,$packagedir);
4192 if (@readdir == 1 && -d $readdir[0]) {
4193 $distdir = $readdir[0];
4194 $packagedir = File::Spec->catdir($builddir,$distdir);
4195 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4197 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4199 File::Path::rmtree($packagedir);
4200 unless (File::Copy::move($distdir,$packagedir)) {
4201 $CPAN::Frontend->unrecoverable_error(<<EOF);
4202 Couldn't move '$distdir' to '$packagedir': $!
4204 Cannot continue: Please find the reason why I cannot move
4205 $builddir/tmp/$distdir
4208 and fix the problem, then retry
4212 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4219 my $userid = $self->cpan_userid;
4221 CPAN->debug("no userid? self[$self]");
4224 my $pragmatic_dir = $userid . '000';
4225 $pragmatic_dir =~ s/\W_//g;
4226 $pragmatic_dir++ while -d "../$pragmatic_dir";
4227 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4228 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4229 File::Path::mkpath($packagedir);
4231 for $f (@readdir) { # is already without "." and ".."
4232 my $to = File::Spec->catdir($packagedir,$f);
4233 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4237 $self->safe_chdir($sub_wd);
4241 $self->{'build_dir'} = $packagedir;
4242 $self->safe_chdir($builddir);
4243 File::Path::rmtree("tmp");
4245 $self->safe_chdir($packagedir);
4246 if ($CPAN::META->has_inst("Module::Signature")) {
4247 if (-f "SIGNATURE") {
4248 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4249 my $rv = Module::Signature::verify();
4250 if ($rv != Module::Signature::SIGNATURE_OK() and
4251 $rv != Module::Signature::SIGNATURE_MISSING()) {
4252 $CPAN::Frontend->myprint(
4253 qq{\nSignature invalid for }.
4254 qq{distribution file. }.
4255 qq{Please investigate.\n\n}.
4257 $CPAN::META->instance(
4264 sprintf(qq{I'd recommend removing %s. Its signature
4265 is invalid. Maybe you have configured your 'urllist' with
4266 a bad URL. Please check this array with 'o conf urllist', and
4267 retry. For more information, try opening a subshell with
4275 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4276 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4277 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4279 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4282 $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
4285 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4287 $self->safe_chdir($builddir);
4288 return if $CPAN::Signal;
4291 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4292 my($mpl_exists) = -f $mpl;
4293 unless ($mpl_exists) {
4294 # NFS has been reported to have racing problems after the
4295 # renaming of a directory in some environments.
4298 my $mpldh = DirHandle->new($packagedir)
4299 or Carp::croak("Couldn't opendir $packagedir: $!");
4300 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4303 my $prefer_installer = "eumm"; # eumm|mb
4304 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4305 if ($mpl_exists) { # they *can* choose
4306 if ($CPAN::META->has_inst("Module::Build")) {
4307 $prefer_installer = $CPAN::Config->{prefer_installer};
4310 $prefer_installer = "mb";
4313 if (lc($prefer_installer) eq "mb") {
4314 $self->{modulebuild} = 1;
4315 } elsif (! $mpl_exists) {
4316 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4320 my($configure) = File::Spec->catfile($packagedir,"Configure");
4321 if (-f $configure) {
4322 # do we have anything to do?
4323 $self->{'configure'} = $configure;
4324 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4325 $CPAN::Frontend->myprint(qq{
4326 Package comes with a Makefile and without a Makefile.PL.
4327 We\'ll try to build it with that Makefile then.
4329 $self->{writemakefile} = "YES";
4332 my $cf = $self->called_for || "unknown";
4337 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4338 $cf = "unknown" unless length($cf);
4339 $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
4340 (The test -f "$mpl" returned false.)
4341 Writing one on our own (setting NAME to $cf)\a\n});
4342 $self->{had_no_makefile_pl}++;
4345 # Writing our own Makefile.PL
4347 my $fh = FileHandle->new;
4349 or Carp::croak("Could not open >$mpl: $!");
4351 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4352 # because there was no Makefile.PL supplied.
4353 # Autogenerated on: }.scalar localtime().qq{
4355 use ExtUtils::MakeMaker;
4356 WriteMakefile(NAME => q[$cf]);
4366 # CPAN::Distribution::untar_me ;
4369 $self->{archived} = "tar";
4371 $self->{unwrapped} = "YES";
4373 $self->{unwrapped} = "NO";
4377 # CPAN::Distribution::unzip_me ;
4380 $self->{archived} = "zip";
4382 $self->{unwrapped} = "YES";
4384 $self->{unwrapped} = "NO";
4390 my($self,$local_file) = @_;
4391 $self->{archived} = "pm";
4392 my $to = File::Basename::basename($local_file);
4393 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4394 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4395 $self->{unwrapped} = "YES";
4397 $self->{unwrapped} = "NO";
4400 File::Copy::cp($local_file,".");
4401 $self->{unwrapped} = "YES";
4405 #-> sub CPAN::Distribution::new ;
4407 my($class,%att) = @_;
4409 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
4411 my $this = { %att };
4412 return bless $this, $class;
4415 #-> sub CPAN::Distribution::look ;
4419 if ($^O eq 'MacOS') {
4420 $self->Mac::BuildTools::look;
4424 if ( $CPAN::Config->{'shell'} ) {
4425 $CPAN::Frontend->myprint(qq{
4426 Trying to open a subshell in the build directory...
4429 $CPAN::Frontend->myprint(qq{
4430 Your configuration does not define a value for subshells.
4431 Please define it with "o conf shell <your shell>"
4435 my $dist = $self->id;
4437 unless ($dir = $self->dir) {
4440 unless ($dir ||= $self->dir) {
4441 $CPAN::Frontend->mywarn(qq{
4442 Could not determine which directory to use for looking at $dist.
4446 my $pwd = CPAN::anycwd();
4447 $self->safe_chdir($dir);
4448 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4450 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
4451 $ENV{CPAN_SHELL_LEVEL} += 1;
4452 unless (system($CPAN::Config->{'shell'}) == 0) {
4454 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
4457 $self->safe_chdir($pwd);
4460 # CPAN::Distribution::cvs_import ;
4464 my $dir = $self->dir;
4466 my $package = $self->called_for;
4467 my $module = $CPAN::META->instance('CPAN::Module', $package);
4468 my $version = $module->cpan_version;
4470 my $userid = $self->cpan_userid;
4472 my $cvs_dir = (split /\//, $dir)[-1];
4473 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
4475 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
4477 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
4478 if ($cvs_site_perl) {
4479 $cvs_dir = "$cvs_site_perl/$cvs_dir";
4481 my $cvs_log = qq{"imported $package $version sources"};
4482 $version =~ s/\./_/g;
4483 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
4484 "$cvs_dir", $userid, "v$version");
4486 my $pwd = CPAN::anycwd();
4487 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
4489 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4491 $CPAN::Frontend->myprint(qq{@cmd\n});
4492 system(@cmd) == 0 or
4493 $CPAN::Frontend->mydie("cvs import failed");
4494 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
4497 #-> sub CPAN::Distribution::readme ;
4500 my($dist) = $self->id;
4501 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
4502 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
4505 File::Spec->catfile(
4506 $CPAN::Config->{keep_source_where},
4509 split(/\//,"$sans.readme"),
4511 $self->debug("Doing localize") if $CPAN::DEBUG;
4512 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
4514 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
4516 if ($^O eq 'MacOS') {
4517 Mac::BuildTools::launch_file($local_file);
4521 my $fh_pager = FileHandle->new;
4522 local($SIG{PIPE}) = "IGNORE";
4523 $fh_pager->open("|$CPAN::Config->{'pager'}")
4524 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
4525 my $fh_readme = FileHandle->new;
4526 $fh_readme->open($local_file)
4527 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
4528 $CPAN::Frontend->myprint(qq{
4531 with pager "$CPAN::Config->{'pager'}"
4534 $fh_pager->print(<$fh_readme>);
4538 #-> sub CPAN::Distribution::verifyCHECKSUM ;
4539 sub verifyCHECKSUM {
4543 $self->{CHECKSUM_STATUS} ||= "";
4544 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
4545 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4547 my($lc_want,$lc_file,@local,$basename);
4548 @local = split(/\//,$self->id);
4550 push @local, "CHECKSUMS";
4552 File::Spec->catfile($CPAN::Config->{keep_source_where},
4553 "authors", "id", @local);
4558 $self->CHECKSUM_check_file($lc_want)
4560 return $self->{CHECKSUM_STATUS} = "OK";
4562 $lc_file = CPAN::FTP->localize("authors/id/@local",
4565 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4566 $local[-1] .= ".gz";
4567 $lc_file = CPAN::FTP->localize("authors/id/@local",
4570 $lc_file =~ s/\.gz(?!\n)\Z//;
4571 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4576 $self->CHECKSUM_check_file($lc_file);
4579 sub SIG_check_file {
4580 my($self,$chk_file) = @_;
4581 my $rv = eval { Module::Signature::_verify($chk_file) };
4583 if ($rv == Module::Signature::SIGNATURE_OK()) {
4584 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
4585 return $self->{SIG_STATUS} = "OK";
4587 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
4588 qq{distribution file. }.
4589 qq{Please investigate.\n\n}.
4591 $CPAN::META->instance(
4596 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
4597 is invalid. Maybe you have configured your 'urllist' with
4598 a bad URL. Please check this array with 'o conf urllist', and
4601 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4605 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
4606 sub CHECKSUM_check_file {
4607 my($self,$chk_file) = @_;
4608 my($cksum,$file,$basename);
4610 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
4611 $self->debug("Module::Signature is installed, verifying");
4612 $self->SIG_check_file($chk_file);
4614 $self->debug("Module::Signature is NOT installed");
4617 $file = $self->{localfile};
4618 $basename = File::Basename::basename($file);
4619 my $fh = FileHandle->new;
4620 if (open $fh, $chk_file){
4623 $eval =~ s/\015?\012/\n/g;
4625 my($comp) = Safe->new();
4626 $cksum = $comp->reval($eval);
4628 rename $chk_file, "$chk_file.bad";
4629 Carp::confess($@) if $@;
4632 Carp::carp "Could not open $chk_file for reading";
4635 if (exists $cksum->{$basename}{sha256}) {
4636 $self->debug("Found checksum for $basename:" .
4637 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
4641 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
4643 $fh = CPAN::Tarzip->TIEHANDLE($file);
4646 my $dg = Digest::SHA->new(256);
4649 while ($fh->READ($ref, 4096) > 0){
4652 my $hexdigest = $dg->hexdigest;
4653 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
4657 $CPAN::Frontend->myprint("Checksum for $file ok\n");
4658 return $self->{CHECKSUM_STATUS} = "OK";
4660 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
4661 qq{distribution file. }.
4662 qq{Please investigate.\n\n}.
4664 $CPAN::META->instance(
4669 my $wrap = qq{I\'d recommend removing $file. Its
4670 checksum is incorrect. Maybe you have configured your 'urllist' with
4671 a bad URL. Please check this array with 'o conf urllist', and
4674 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4676 # former versions just returned here but this seems a
4677 # serious threat that deserves a die
4679 # $CPAN::Frontend->myprint("\n\n");
4683 # close $fh if fileno($fh);
4685 $self->{CHECKSUM_STATUS} ||= "";
4686 if ($self->{CHECKSUM_STATUS} eq "NIL") {
4687 $CPAN::Frontend->mywarn(qq{
4688 Warning: No checksum for $basename in $chk_file.
4690 The cause for this may be that the file is very new and the checksum
4691 has not yet been calculated, but it may also be that something is
4692 going awry right now.
4694 my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
4695 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
4697 $self->{CHECKSUM_STATUS} = "NIL";
4702 #-> sub CPAN::Distribution::eq_CHECKSUM ;
4704 my($self,$fh,$expect) = @_;
4705 my $dg = Digest::SHA->new(256);
4707 while (read($fh, $data, 4096)){
4710 my $hexdigest = $dg->hexdigest;
4711 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
4712 $hexdigest eq $expect;
4715 #-> sub CPAN::Distribution::force ;
4717 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
4718 # effect by autoinspection, not by inspecting a global variable. One
4719 # of the reason why this was chosen to work that way was the treatment
4720 # of dependencies. They should not automatically inherit the force
4721 # status. But this has the downside that ^C and die() will return to
4722 # the prompt but will not be able to reset the force_update
4723 # attributes. We try to correct for it currently in the read_metadata
4724 # routine, and immediately before we check for a Signal. I hope this
4725 # works out in one of v1.57_53ff
4728 my($self, $method) = @_;
4730 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
4733 delete $self->{$att};
4735 if ($method && $method =~ /make|test|install/) {
4736 $self->{"force_update"}++; # name should probably have been force_install
4741 my($self, $method) = @_;
4742 # warn "XDEBUG: set notest for $self $method";
4743 $self->{"notest"}++; # name should probably have been force_install
4748 # warn "XDEBUG: deleting notest";
4749 delete $self->{'notest'};
4752 #-> sub CPAN::Distribution::unforce ;
4755 delete $self->{'force_update'};
4758 #-> sub CPAN::Distribution::isa_perl ;
4761 my $file = File::Basename::basename($self->id);
4762 if ($file =~ m{ ^ perl
4775 } elsif ($self->cpan_comment
4777 $self->cpan_comment =~ /isa_perl\(.+?\)/){
4783 #-> sub CPAN::Distribution::perl ;
4789 #-> sub CPAN::Distribution::make ;
4792 my $make = $self->{modulebuild} ? "Build" : "make";
4793 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
4794 # Emergency brake if they said install Pippi and get newest perl
4795 if ($self->isa_perl) {
4797 $self->called_for ne $self->id &&
4798 ! $self->{force_update}
4800 # if we die here, we break bundles
4801 $CPAN::Frontend->mywarn(sprintf qq{
4802 The most recent version "%s" of the module "%s"
4803 comes with the current version of perl (%s).
4804 I\'ll build that only if you ask for something like
4809 $CPAN::META->instance(
4823 !$self->{archived} || $self->{archived} eq "NO" and push @e,
4824 "Is neither a tar nor a zip archive.";
4826 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
4827 "Had problems unarchiving. Please build manually";
4829 unless ($self->{force_update}) {
4830 exists $self->{signature_verify} and $self->{signature_verify}->failed
4831 and push @e, "Did not pass the signature test.";
4834 exists $self->{writemakefile} &&
4835 $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e,
4836 $1 || "Had some problem writing Makefile";
4838 defined $self->{'make'} and push @e,
4839 "Has already been processed within this session";
4841 if (exists $self->{later} and length($self->{later})) {
4842 if ($self->unsat_prereq) {
4843 push @e, $self->{later};
4845 delete $self->{later};
4849 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4851 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
4852 my $builddir = $self->dir or
4853 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory");
4854 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
4855 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
4857 if ($^O eq 'MacOS') {
4858 Mac::BuildTools::make($self);
4863 if ($self->{'configure'}) {
4864 $system = $self->{'configure'};
4865 } elsif ($self->{modulebuild}) {
4866 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
4867 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
4869 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
4871 # This needs a handler that can be turned on or off:
4872 # $switch = "-MExtUtils::MakeMaker ".
4873 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
4875 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
4877 unless (exists $self->{writemakefile}) {
4878 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
4881 if ($CPAN::Config->{inactivity_timeout}) {
4883 alarm $CPAN::Config->{inactivity_timeout};
4884 local $SIG{CHLD}; # = sub { wait };
4885 if (defined($pid = fork)) {
4890 # note, this exec isn't necessary if
4891 # inactivity_timeout is 0. On the Mac I'd
4892 # suggest, we set it always to 0.
4896 $CPAN::Frontend->myprint("Cannot fork: $!");
4904 $CPAN::Frontend->myprint($@);
4905 $self->{writemakefile} = "NO $@";
4910 $ret = system($system);
4912 $self->{writemakefile} = "NO '$system' returned status $ret";
4916 if (-f "Makefile" || -f "Build") {
4917 $self->{writemakefile} = "YES";
4918 delete $self->{make_clean}; # if cleaned before, enable next
4920 $self->{writemakefile} =
4921 qq{NO -- Unknown reason.};
4922 # It's probably worth it to record the reason, so let's retry
4924 # my $fh = IO::File->new("$system |"); # STDERR? STDIN?
4925 # $self->{writemakefile} .= <$fh>;
4929 delete $self->{force_update};
4932 if (my @prereq = $self->unsat_prereq){
4933 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
4935 if ($self->{modulebuild}) {
4936 $system = "./Build $CPAN::Config->{mbuild_arg}";
4938 $system = join " ", _make_command(), $CPAN::Config->{make_arg};
4940 if (system($system) == 0) {
4941 $CPAN::Frontend->myprint(" $system -- OK\n");
4942 $self->{'make'} = CPAN::Distrostatus->new("YES");
4944 $self->{writemakefile} ||= "YES";
4945 $self->{'make'} = CPAN::Distrostatus->new("NO");
4946 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
4951 return $CPAN::Config->{'make'} || $Config::Config{make} || 'make';
4954 #-> sub CPAN::Distribution::follow_prereqs ;
4955 sub follow_prereqs {
4957 my(@prereq) = grep {$_ ne "perl"} @_;
4958 return unless @prereq;
4960 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
4961 "during [$id] -----\n");
4963 for my $p (@prereq) {
4964 $CPAN::Frontend->myprint(" $p\n");
4967 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
4969 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
4970 require ExtUtils::MakeMaker;
4971 my $answer = ExtUtils::MakeMaker::prompt(
4972 "Shall I follow them and prepend them to the queue
4973 of modules we are processing right now?", "yes");
4974 $follow = $answer =~ /^\s*y/i;
4978 myprint(" Ignoring dependencies on modules @prereq\n");
4981 # color them as dirty
4982 for my $p (@prereq) {
4983 # warn "calling color_cmd_tmps(0,1)";
4984 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
4986 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
4987 $self->{later} = "Delayed until after prerequisites";
4988 return 1; # signal success to the queuerunner
4992 #-> sub CPAN::Distribution::unsat_prereq ;
4995 my $prereq_pm = $self->prereq_pm or return;
4997 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
4998 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
4999 # we were too demanding:
5000 next if $nmo->uptodate;
5002 # if they have not specified a version, we accept any installed one
5003 if (not defined $need_version or
5004 $need_version eq "0" or
5005 $need_version eq "undef") {
5006 next if defined $nmo->inst_file;
5009 # We only want to install prereqs if either they're not installed
5010 # or if the installed version is too old. We cannot omit this
5011 # check, because if 'force' is in effect, nobody else will check.
5012 if (defined $nmo->inst_file) {
5013 my(@all_requirements) = split /\s*,\s*/, $need_version;
5016 RQ: for my $rq (@all_requirements) {
5017 if ($rq =~ s|>=\s*||) {
5018 } elsif ($rq =~ s|>\s*||) {
5020 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5024 } elsif ($rq =~ s|!=\s*||) {
5026 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5032 } elsif ($rq =~ m|<=?\s*|) {
5034 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5038 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5041 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5045 CPAN::Version->readable($rq),
5049 next NEED if $ok == @all_requirements;
5052 if ($self->{sponsored_mods}{$need_module}++){
5053 # We have already sponsored it and for some reason it's still
5054 # not available. So we do nothing. Or what should we do?
5055 # if we push it again, we have a potential infinite loop
5058 push @need, $need_module;
5063 #-> sub CPAN::Distribution::read_yaml ;
5066 return $self->{yaml_content} if exists $self->{yaml_content};
5067 my $build_dir = $self->{build_dir};
5068 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5069 return unless -f $yaml;
5070 if ($CPAN::META->has_inst("YAML")) {
5071 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5073 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5077 return $self->{yaml_content};
5080 #-> sub CPAN::Distribution::prereq_pm ;
5083 return $self->{prereq_pm} if
5084 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5085 return unless $self->{writemakefile} # no need to have succeeded
5086 # but we must have run it
5087 || $self->{modulebuild};
5089 if (my $yaml = $self->read_yaml) {
5090 $req = $yaml->{requires};
5091 undef $req unless ref $req eq "HASH" && %$req;
5093 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5094 my $eummv = do { local $^W = 0; $1+0; };
5095 if ($eummv < 6.2501) {
5096 # thanks to Slaven for digging that out: MM before
5097 # that could be wrong because it could reflect a
5104 while (my($k,$v) = each %{$req||{}}) {
5107 } elsif ($k =~ /[A-Za-z]/ &&
5109 $CPAN::META->exists("Module",$v)
5111 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5112 "requires hash: $k => $v; I'll take both ".
5113 "key and value as a module name\n");
5120 $req = $areq if $do_replace;
5123 delete $req->{perl};
5127 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5128 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5132 $fh = FileHandle->new("<$makefile\0")) {
5135 last if /MakeMaker post_initialize section/;
5137 \s+PREREQ_PM\s+=>\s+(.+)
5140 # warn "Found prereq expr[$p]";
5142 # Regexp modified by A.Speer to remember actual version of file
5143 # PREREQ_PM hash key wants, then add to
5144 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5145 # In case a prereq is mentioned twice, complain.
5146 if ( defined $req->{$1} ) {
5147 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5148 "last mention wins";
5154 } elsif (-f "Build") {
5155 if ($CPAN::META->has_inst("Module::Build")) {
5156 $req = Module::Build->current->requires();
5160 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5161 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5162 "undeclared prerequisite.\n".
5163 " Adding it now as a prerequisite.\n"
5165 $CPAN::Frontend->mysleep(5);
5166 $req->{"Module::Build"} = 0;
5167 delete $self->{writemakefile};
5169 $self->{prereq_pm_detected}++;
5170 return $self->{prereq_pm} = $req;
5173 #-> sub CPAN::Distribution::test ;
5178 delete $self->{force_update};
5181 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5182 if ($self->{notest}) {
5183 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5187 my $make = $self->{modulebuild} ? "Build" : "make";
5188 $CPAN::Frontend->myprint("Running $make test\n");
5189 if (my @prereq = $self->unsat_prereq){
5190 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5194 exists $self->{make} or exists $self->{later} or push @e,
5195 "Make had some problems, maybe interrupted? Won't test";
5197 exists $self->{'make'} and
5198 $self->{'make'}->failed and
5199 push @e, "Can't test without successful make";
5201 exists $self->{build_dir} or push @e, "Has no own directory";
5202 $self->{badtestcnt} ||= 0;
5203 $self->{badtestcnt} > 0 and
5204 push @e, "Won't repeat unsuccessful test during this command";
5206 exists $self->{later} and length($self->{later}) and
5207 push @e, $self->{later};
5209 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5211 chdir $self->{'build_dir'} or
5212 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5213 $self->debug("Changed directory to $self->{'build_dir'}")
5216 if ($^O eq 'MacOS') {
5217 Mac::BuildTools::make_test($self);
5221 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5223 : ($ENV{PERLLIB} || "");
5225 $CPAN::META->set_perl5lib;
5227 if ($self->{modulebuild}) {
5228 $system = "./Build test";
5230 $system = join " ", _make_command(), "test";
5232 if (system($system) == 0) {
5233 $CPAN::Frontend->myprint(" $system -- OK\n");
5234 $CPAN::META->is_tested($self->{'build_dir'});
5235 $self->{make_test} = CPAN::Distrostatus->new("YES");
5237 $self->{make_test} = CPAN::Distrostatus->new("NO");
5238 $self->{badtestcnt}++;
5239 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5243 #-> sub CPAN::Distribution::clean ;
5246 my $make = $self->{modulebuild} ? "Build" : "make";
5247 $CPAN::Frontend->myprint("Running $make clean\n");
5248 unless (exists $self->{build_dir}) {
5249 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5254 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5255 push @e, "make clean already called once";
5256 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5258 chdir $self->{'build_dir'} or
5259 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5260 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5262 if ($^O eq 'MacOS') {
5263 Mac::BuildTools::make_clean($self);
5268 if ($self->{modulebuild}) {
5269 $system = "./Build clean";
5271 $system = join " ", _make_command(), "clean";
5273 if (system($system) == 0) {
5274 $CPAN::Frontend->myprint(" $system -- OK\n");
5278 # Jost Krieger pointed out that this "force" was wrong because
5279 # it has the effect that the next "install" on this distribution
5280 # will untar everything again. Instead we should bring the
5281 # object's state back to where it is after untarring.
5292 $self->{make_clean} = "YES";
5295 # Hmmm, what to do if make clean failed?
5297 $CPAN::Frontend->myprint(qq{ $system -- NOT OK
5299 make clean did not succeed, marking directory as unusable for further work.
5301 $self->force("make"); # so that this directory won't be used again
5306 #-> sub CPAN::Distribution::install ;
5311 delete $self->{force_update};
5314 my $make = $self->{modulebuild} ? "Build" : "make";
5315 $CPAN::Frontend->myprint("Running $make install\n");
5318 exists $self->{build_dir} or push @e, "Has no own directory";
5320 exists $self->{make} or exists $self->{later} or push @e,
5321 "Make had some problems, maybe interrupted? Won't install";
5323 exists $self->{'make'} and
5324 $self->{'make'}->failed and
5325 push @e, "make had returned bad status, install seems impossible";
5327 if (exists $self->{make_test} and
5328 $self->{make_test}->failed){
5329 if ($self->{force_update}) {
5330 $self->{make_test}->text("FAILED but failure ignored because ".
5331 "'force' in effect");
5333 push @e, "make test had returned bad status, ".
5334 "won't install without force"
5337 exists $self->{'install'} and push @e,
5338 $self->{'install'}->text eq "YES" ?
5339 "Already done" : "Already tried without success";
5341 exists $self->{later} and length($self->{later}) and
5342 push @e, $self->{later};
5344 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5346 chdir $self->{'build_dir'} or
5347 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5348 $self->debug("Changed directory to $self->{'build_dir'}")
5351 if ($^O eq 'MacOS') {
5352 Mac::BuildTools::make_install($self);
5357 if ($self->{modulebuild}) {
5358 my($mbuild_install_build_command) = $CPAN::Config->{'mbuild_install_build_command'} ||
5361 $mbuild_install_build_command,
5363 $CPAN::Config->{mbuild_install_arg},
5366 my($make_install_make_command) = $CPAN::Config->{'make_install_make_command'} ||
5369 $make_install_make_command,
5371 $CPAN::Config->{make_install_arg},
5375 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
5376 my($pipe) = FileHandle->new("$system $stderr |");
5379 $CPAN::Frontend->myprint($_);
5384 $CPAN::Frontend->myprint(" $system -- OK\n");
5385 $CPAN::META->is_installed($self->{'build_dir'});
5386 return $self->{'install'} = CPAN::Distrostatus->new("YES");
5388 $self->{'install'} = CPAN::Distrostatus->new("NO");
5389 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5391 $makeout =~ /permission/s
5394 ! $CPAN::Config->{make_install_make_command}
5395 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
5398 $CPAN::Frontend->myprint(
5400 qq{ You may have to su }.
5401 qq{to root to install the package\n}.
5402 qq{ (Or you may want to run something like\n}.
5403 qq{ o conf make_install_make_command 'sudo make'\n}.
5404 qq{ to raise your permissions.}
5408 delete $self->{force_update};
5411 #-> sub CPAN::Distribution::dir ;
5413 shift->{'build_dir'};
5416 #-> sub CPAN::Distribution::perldoc ;
5420 my($dist) = $self->id;
5421 my $package = $self->called_for;
5423 $self->_display_url( $CPAN::Defaultdocs . $package );
5426 #-> sub CPAN::Distribution::_check_binary ;
5428 my ($dist,$shell,$binary) = @_;
5429 my ($pid,$readme,$out);
5431 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
5434 $pid = open $readme, "which $binary|"
5435 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
5439 close $readme or die "Could not run 'which $binary': $!";
5441 $CPAN::Frontend->myprint(qq{ + $out \n})
5442 if $CPAN::DEBUG && $out;
5447 #-> sub CPAN::Distribution::_display_url ;
5449 my($self,$url) = @_;
5450 my($res,$saved_file,$pid,$readme,$out);
5452 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
5455 # should we define it in the config instead?
5456 my $html_converter = "html2text";
5458 my $web_browser = $CPAN::Config->{'lynx'} || undef;
5459 my $web_browser_out = $web_browser
5460 ? CPAN::Distribution->_check_binary($self,$web_browser)
5463 my ($tmpout,$tmperr);
5464 if (not $web_browser_out) {
5465 # web browser not found, let's try text only
5466 my $html_converter_out =
5467 CPAN::Distribution->_check_binary($self,$html_converter);
5469 if ($html_converter_out ) {
5470 # html2text found, run it
5471 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
5472 $CPAN::Frontend->myprint(qq{ERROR: problems while getting $url, $!\n})
5473 unless defined($saved_file);
5475 $pid = open $readme, "$html_converter $saved_file |"
5476 or $CPAN::Frontend->mydie(qq{
5477 Could not fork '$html_converter $saved_file': $!});
5478 my $fh = File::Temp->new(
5479 template => 'cpan_htmlconvert_XXXX',
5487 or $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
5488 my $tmpin = $fh->filename;
5489 $CPAN::Frontend->myprint(sprintf(qq{
5491 saved output to %s\n},
5496 close $fh; undef $fh;
5498 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
5499 my $fh_pager = FileHandle->new;
5500 local($SIG{PIPE}) = "IGNORE";
5501 $fh_pager->open("|$CPAN::Config->{'pager'}")
5502 or $CPAN::Frontend->mydie(qq{
5503 Could not open pager $CPAN::Config->{'pager'}: $!});
5504 $CPAN::Frontend->myprint(qq{
5507 with pager "$CPAN::Config->{'pager'}"
5510 $fh_pager->print(<$fh>);
5513 # coldn't find the web browser or html converter
5514 $CPAN::Frontend->myprint(qq{
5515 You need to install lynx or $html_converter to use this feature.});
5518 # web browser found, run the action
5519 my $browser = $CPAN::Config->{'lynx'};
5520 $CPAN::Frontend->myprint(qq{system[$browser $url]})
5522 $CPAN::Frontend->myprint(qq{
5525 with browser $browser
5528 system("$browser $url");
5529 if ($saved_file) { 1 while unlink($saved_file) }
5533 #-> sub CPAN::Distribution::_getsave_url ;
5535 my($dist, $shell, $url) = @_;
5537 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
5540 my $fh = File::Temp->new(
5541 template => "cpan_getsave_url_XXXX",
5545 my $tmpin = $fh->filename;
5546 if ($CPAN::META->has_usable('LWP')) {
5547 $CPAN::Frontend->myprint("Fetching with LWP:
5551 CPAN::LWP::UserAgent->config;
5552 eval { $Ua = CPAN::LWP::UserAgent->new; };
5554 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
5558 $Ua->proxy('http', $var)
5559 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
5561 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
5564 my $req = HTTP::Request->new(GET => $url);
5565 $req->header('Accept' => 'text/html');
5566 my $res = $Ua->request($req);
5567 if ($res->is_success) {
5568 $CPAN::Frontend->myprint(" + request successful.\n")
5570 print $fh $res->content;
5572 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
5576 $CPAN::Frontend->myprint(sprintf(
5577 "LWP failed with code[%s], message[%s]\n",
5584 $CPAN::Frontend->myprint("LWP not available\n");
5589 package CPAN::Bundle;
5594 $CPAN::Frontend->myprint($self->as_string);
5599 delete $self->{later};
5600 for my $c ( $self->contains ) {
5601 my $obj = CPAN::Shell->expandany($c) or next;
5606 # mark as dirty/clean
5607 #-> sub CPAN::Bundle::color_cmd_tmps ;
5608 sub color_cmd_tmps {
5610 my($depth) = shift || 0;
5611 my($color) = shift || 0;
5612 my($ancestors) = shift || [];
5613 # a module needs to recurse to its cpan_file, a distribution needs
5614 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
5616 return if exists $self->{incommandcolor}
5617 && $self->{incommandcolor}==$color;
5619 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5621 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5623 for my $c ( $self->contains ) {
5624 my $obj = CPAN::Shell->expandany($c) or next;
5625 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
5626 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5629 delete $self->{badtestcnt};
5631 $self->{incommandcolor} = $color;
5634 #-> sub CPAN::Bundle::as_string ;
5638 # following line must be "=", not "||=" because we have a moving target
5639 $self->{INST_VERSION} = $self->inst_version;
5640 return $self->SUPER::as_string;
5643 #-> sub CPAN::Bundle::contains ;
5646 my($inst_file) = $self->inst_file || "";
5647 my($id) = $self->id;
5648 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
5649 unless ($inst_file) {
5650 # Try to get at it in the cpan directory
5651 $self->debug("no inst_file") if $CPAN::DEBUG;
5653 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
5654 $cpan_file = $self->cpan_file;
5655 if ($cpan_file eq "N/A") {
5656 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
5657 Maybe stale symlink? Maybe removed during session? Giving up.\n");
5659 my $dist = $CPAN::META->instance('CPAN::Distribution',
5662 $self->debug($dist->as_string) if $CPAN::DEBUG;
5663 my($todir) = $CPAN::Config->{'cpan_home'};
5664 my(@me,$from,$to,$me);
5665 @me = split /::/, $self->id;
5667 $me = File::Spec->catfile(@me);
5668 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
5669 $to = File::Spec->catfile($todir,$me);
5670 File::Path::mkpath(File::Basename::dirname($to));
5671 File::Copy::copy($from, $to)
5672 or Carp::confess("Couldn't copy $from to $to: $!");
5676 my $fh = FileHandle->new;
5678 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
5680 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
5682 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
5683 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
5684 next unless $in_cont;
5689 push @result, (split " ", $_, 2)[0];
5692 delete $self->{STATUS};
5693 $self->{CONTAINS} = \@result;
5694 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
5696 $CPAN::Frontend->mywarn(qq{
5697 The bundle file "$inst_file" may be a broken
5698 bundlefile. It seems not to contain any bundle definition.
5699 Please check the file and if it is bogus, please delete it.
5700 Sorry for the inconvenience.
5706 #-> sub CPAN::Bundle::find_bundle_file
5707 sub find_bundle_file {
5708 my($self,$where,$what) = @_;
5709 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
5710 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
5711 ### my $bu = File::Spec->catfile($where,$what);
5712 ### return $bu if -f $bu;
5713 my $manifest = File::Spec->catfile($where,"MANIFEST");
5714 unless (-f $manifest) {
5715 require ExtUtils::Manifest;
5716 my $cwd = CPAN::anycwd();
5717 chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
5718 ExtUtils::Manifest::mkmanifest();
5719 chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
5721 my $fh = FileHandle->new($manifest)
5722 or Carp::croak("Couldn't open $manifest: $!");
5725 if ($^O eq 'MacOS') {
5728 $what2 =~ s/:Bundle://;
5731 $what2 =~ s|Bundle[/\\]||;
5736 my($file) = /(\S+)/;
5737 if ($file =~ m|\Q$what\E$|) {
5739 # return File::Spec->catfile($where,$bu); # bad
5742 # retry if she managed to
5743 # have no Bundle directory
5744 $bu = $file if $file =~ m|\Q$what2\E$|;
5746 $bu =~ tr|/|:| if $^O eq 'MacOS';
5747 return File::Spec->catfile($where, $bu) if $bu;
5748 Carp::croak("Couldn't find a Bundle file in $where");
5751 # needs to work quite differently from Module::inst_file because of
5752 # cpan_home/Bundle/ directory and the possibility that we have
5753 # shadowing effect. As it makes no sense to take the first in @INC for
5754 # Bundles, we parse them all for $VERSION and take the newest.
5756 #-> sub CPAN::Bundle::inst_file ;
5761 @me = split /::/, $self->id;
5764 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
5765 my $bfile = File::Spec->catfile($incdir, @me);
5766 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
5767 next unless -f $bfile;
5768 my $foundv = MM->parse_version($bfile);
5769 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
5770 $self->{INST_FILE} = $bfile;
5771 $self->{INST_VERSION} = $bestv = $foundv;
5777 #-> sub CPAN::Bundle::inst_version ;
5780 $self->inst_file; # finds INST_VERSION as side effect
5781 $self->{INST_VERSION};
5784 #-> sub CPAN::Bundle::rematein ;
5786 my($self,$meth) = @_;
5787 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
5788 my($id) = $self->id;
5789 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
5790 unless $self->inst_file || $self->cpan_file;
5792 for $s ($self->contains) {
5793 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
5794 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
5795 if ($type eq 'CPAN::Distribution') {
5796 $CPAN::Frontend->mywarn(qq{
5797 The Bundle }.$self->id.qq{ contains
5798 explicitly a file $s.
5802 # possibly noisy action:
5803 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
5804 my $obj = $CPAN::META->instance($type,$s);
5806 if ($obj->isa('CPAN::Bundle')
5808 exists $obj->{install_failed}
5810 ref($obj->{install_failed}) eq "HASH"
5812 for (keys %{$obj->{install_failed}}) {
5813 $self->{install_failed}{$_} = undef; # propagate faiure up
5816 $fail{$s} = 1; # the bundle itself may have succeeded but
5821 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
5822 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
5824 delete $self->{install_failed}{$s};
5831 # recap with less noise
5832 if ( $meth eq "install" ) {
5835 my $raw = sprintf(qq{Bundle summary:
5836 The following items in bundle %s had installation problems:},
5839 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
5840 $CPAN::Frontend->myprint("\n");
5843 for $s ($self->contains) {
5845 $paragraph .= "$s ";
5846 $self->{install_failed}{$s} = undef;
5847 $reported{$s} = undef;
5850 my $report_propagated;
5851 for $s (sort keys %{$self->{install_failed}}) {
5852 next if exists $reported{$s};
5853 $paragraph .= "and the following items had problems
5854 during recursive bundle calls: " unless $report_propagated++;
5855 $paragraph .= "$s ";
5857 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
5858 $CPAN::Frontend->myprint("\n");
5860 $self->{'install'} = 'YES';
5865 #sub CPAN::Bundle::xs_file
5867 # If a bundle contains another that contains an xs_file we have
5868 # here, we just don't bother I suppose
5872 #-> sub CPAN::Bundle::force ;
5873 sub force { shift->rematein('force',@_); }
5874 #-> sub CPAN::Bundle::notest ;
5875 sub notest { shift->rematein('notest',@_); }
5876 #-> sub CPAN::Bundle::get ;
5877 sub get { shift->rematein('get',@_); }
5878 #-> sub CPAN::Bundle::make ;
5879 sub make { shift->rematein('make',@_); }
5880 #-> sub CPAN::Bundle::test ;
5883 $self->{badtestcnt} ||= 0;
5884 $self->rematein('test',@_);
5886 #-> sub CPAN::Bundle::install ;
5889 $self->rematein('install',@_);
5891 #-> sub CPAN::Bundle::clean ;
5892 sub clean { shift->rematein('clean',@_); }
5894 #-> sub CPAN::Bundle::uptodate ;
5897 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
5899 foreach $c ($self->contains) {
5900 my $obj = CPAN::Shell->expandany($c);
5901 return 0 unless $obj->uptodate;
5906 #-> sub CPAN::Bundle::readme ;
5909 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
5910 No File found for bundle } . $self->id . qq{\n}), return;
5911 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
5912 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
5915 package CPAN::Module;
5919 # sub CPAN::Module::userid
5924 return $ro->{userid} || $ro->{CPAN_USERID};
5926 # sub CPAN::Module::description
5929 my $ro = $self->ro or return "";
5935 CPAN::Shell->expand("Distribution",$self->cpan_file);
5938 # sub CPAN::Module::undelay
5941 delete $self->{later};
5942 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
5947 # mark as dirty/clean
5948 #-> sub CPAN::Module::color_cmd_tmps ;
5949 sub color_cmd_tmps {
5951 my($depth) = shift || 0;
5952 my($color) = shift || 0;
5953 my($ancestors) = shift || [];
5954 # a module needs to recurse to its cpan_file
5956 return if exists $self->{incommandcolor}
5957 && $self->{incommandcolor}==$color;
5958 return if $depth>=1 && $self->uptodate;
5960 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5962 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5964 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
5965 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5968 delete $self->{badtestcnt};
5970 $self->{incommandcolor} = $color;
5973 #-> sub CPAN::Module::as_glimpse ;
5977 my $class = ref($self);
5978 $class =~ s/^CPAN:://;
5982 $CPAN::Shell::COLOR_REGISTERED
5984 $CPAN::META->has_inst("Term::ANSIColor")
5988 $color_on = Term::ANSIColor::color("green");
5989 $color_off = Term::ANSIColor::color("reset");
5991 push @m, sprintf("%-8s %s%-22s%s (%s)\n",
5996 $self->distribution->pretty_id,
6001 #-> sub CPAN::Module::as_string ;
6005 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6006 my $class = ref($self);
6007 $class =~ s/^CPAN:://;
6009 push @m, $class, " id = $self->{ID}\n";
6010 my $sprintf = " %-12s %s\n";
6011 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6012 if $self->description;
6013 my $sprintf2 = " %-12s %s (%s)\n";
6015 $userid = $self->userid;
6018 if ($author = CPAN::Shell->expand('Author',$userid)) {
6021 if ($m = $author->email) {
6028 $author->fullname . $email
6032 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6033 if $self->cpan_version;
6034 if (my $cpan_file = $self->cpan_file){
6035 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6036 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6037 my $upload_date = $dist->upload_date;
6039 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6043 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
6044 my(%statd,%stats,%statl,%stati);
6045 @statd{qw,? i c a b R M S,} = qw,unknown idea
6046 pre-alpha alpha beta released mature standard,;
6047 @stats{qw,? m d u n a,} = qw,unknown mailing-list
6048 developer comp.lang.perl.* none abandoned,;
6049 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
6050 @stati{qw,? f r O h,} = qw,unknown functions
6051 references+ties object-oriented hybrid,;
6052 $statd{' '} = 'unknown';
6053 $stats{' '} = 'unknown';
6054 $statl{' '} = 'unknown';
6055 $stati{' '} = 'unknown';
6064 $statd{$ro->{statd}},
6065 $stats{$ro->{stats}},
6066 $statl{$ro->{statl}},
6067 $stati{$ro->{stati}}
6068 ) if $ro && $ro->{statd};
6069 my $local_file = $self->inst_file;
6070 unless ($self->{MANPAGE}) {
6072 $self->{MANPAGE} = $self->manpage_headline($local_file);
6074 # If we have already untarred it, we should look there
6075 my $dist = $CPAN::META->instance('CPAN::Distribution',
6077 # warn "dist[$dist]";
6078 # mff=manifest file; mfh=manifest handle
6083 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6085 $mfh = FileHandle->new($mff)
6087 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6088 my $lfre = $self->id; # local file RE
6091 my($lfl); # local file file
6093 my(@mflines) = <$mfh>;
6098 while (length($lfre)>5 and !$lfl) {
6099 ($lfl) = grep /$lfre/, @mflines;
6100 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6103 $lfl =~ s/\s.*//; # remove comments
6104 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6105 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6106 # warn "lfl_abs[$lfl_abs]";
6108 $self->{MANPAGE} = $self->manpage_headline($lfl_abs);
6114 for $item (qw/MANPAGE/) {
6115 push @m, sprintf($sprintf, $item, $self->{$item})
6116 if exists $self->{$item};
6118 for $item (qw/CONTAINS/) {
6119 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6120 if exists $self->{$item} && @{$self->{$item}};
6122 push @m, sprintf($sprintf, 'INST_FILE',
6123 $local_file || "(not installed)");
6124 push @m, sprintf($sprintf, 'INST_VERSION',
6125 $self->inst_version) if $local_file;
6129 sub manpage_headline {
6130 my($self,$local_file) = @_;
6131 my(@local_file) = $local_file;
6132 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6133 push @local_file, $local_file;
6135 for $locf (@local_file) {
6136 next unless -f $locf;
6137 my $fh = FileHandle->new($locf)
6138 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6142 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6143 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6160 #-> sub CPAN::Module::cpan_file ;
6161 # Note: also inherited by CPAN::Bundle
6164 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6165 unless ($self->ro) {
6166 CPAN::Index->reload;
6169 if ($ro && defined $ro->{CPAN_FILE}){
6170 return $ro->{CPAN_FILE};
6172 my $userid = $self->userid;
6174 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6175 my $author = $CPAN::META->instance("CPAN::Author",
6177 my $fullname = $author->fullname;
6178 my $email = $author->email;
6179 unless (defined $fullname && defined $email) {
6180 return sprintf("Contact Author %s",
6184 return "Contact Author $fullname <$email>";
6186 return "Contact Author $userid (Email address not available)";
6194 #-> sub CPAN::Module::cpan_version ;
6200 # Can happen with modules that are not on CPAN
6203 $ro->{CPAN_VERSION} = 'undef'
6204 unless defined $ro->{CPAN_VERSION};
6205 $ro->{CPAN_VERSION};
6208 #-> sub CPAN::Module::force ;
6211 $self->{'force_update'}++;
6216 # warn "XDEBUG: set notest for Module";
6217 $self->{'notest'}++;
6220 #-> sub CPAN::Module::rematein ;
6222 my($self,$meth) = @_;
6223 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
6226 my $cpan_file = $self->cpan_file;
6227 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
6228 $CPAN::Frontend->mywarn(sprintf qq{
6229 The module %s isn\'t available on CPAN.
6231 Either the module has not yet been uploaded to CPAN, or it is
6232 temporary unavailable. Please contact the author to find out
6233 more about the status. Try 'i %s'.
6240 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
6241 $pack->called_for($self->id);
6242 $pack->force($meth) if exists $self->{'force_update'};
6243 $pack->notest($meth) if exists $self->{'notest'};
6248 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
6249 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
6250 delete $self->{'force_update'};
6251 delete $self->{'notest'};
6257 #-> sub CPAN::Module::perldoc ;
6258 sub perldoc { shift->rematein('perldoc') }
6259 #-> sub CPAN::Module::readme ;
6260 sub readme { shift->rematein('readme') }
6261 #-> sub CPAN::Module::look ;
6262 sub look { shift->rematein('look') }
6263 #-> sub CPAN::Module::cvs_import ;
6264 sub cvs_import { shift->rematein('cvs_import') }
6265 #-> sub CPAN::Module::get ;
6266 sub get { shift->rematein('get',@_) }
6267 #-> sub CPAN::Module::make ;
6268 sub make { shift->rematein('make') }
6269 #-> sub CPAN::Module::test ;
6272 $self->{badtestcnt} ||= 0;
6273 $self->rematein('test',@_);
6275 #-> sub CPAN::Module::uptodate ;
6278 my($latest) = $self->cpan_version;
6280 my($inst_file) = $self->inst_file;
6282 if (defined $inst_file) {
6283 $have = $self->inst_version;
6288 ! CPAN::Version->vgt($latest, $have)
6290 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
6291 "latest[$latest] have[$have]") if $CPAN::DEBUG;
6296 #-> sub CPAN::Module::install ;
6302 not exists $self->{'force_update'}
6304 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
6306 $self->inst_version,
6312 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
6313 $CPAN::Frontend->mywarn(qq{
6314 \n\n\n ***WARNING***
6315 The module $self->{ID} has no active maintainer.\n\n\n
6319 $self->rematein('install') if $doit;
6321 #-> sub CPAN::Module::clean ;
6322 sub clean { shift->rematein('clean') }
6324 #-> sub CPAN::Module::inst_file ;
6328 @packpath = split /::/, $self->{ID};
6329 $packpath[-1] .= ".pm";
6330 foreach $dir (@INC) {
6331 my $pmfile = File::Spec->catfile($dir,@packpath);
6339 #-> sub CPAN::Module::xs_file ;
6343 @packpath = split /::/, $self->{ID};
6344 push @packpath, $packpath[-1];
6345 $packpath[-1] .= "." . $Config::Config{'dlext'};
6346 foreach $dir (@INC) {
6347 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
6355 #-> sub CPAN::Module::inst_version ;
6358 my $parsefile = $self->inst_file or return;
6359 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
6362 # there was a bug in 5.6.0 that let lots of unini warnings out of
6363 # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove
6364 # the following workaround after 5.6.1 is out.
6365 local($SIG{__WARN__}) = sub { my $w = shift;
6366 return if $w =~ /uninitialized/i;
6370 $have = MM->parse_version($parsefile) || "undef";
6371 $have =~ s/^ //; # since the %vd hack these two lines here are needed
6372 $have =~ s/ $//; # trailing whitespace happens all the time
6374 # My thoughts about why %vd processing should happen here
6376 # Alt1 maintain it as string with leading v:
6377 # read index files do nothing
6378 # compare it use utility for compare
6379 # print it do nothing
6381 # Alt2 maintain it as what it is
6382 # read index files convert
6383 # compare it use utility because there's still a ">" vs "gt" issue
6384 # print it use CPAN::Version for print
6386 # Seems cleaner to hold it in memory as a string starting with a "v"
6388 # If the author of this module made a mistake and wrote a quoted
6389 # "v1.13" instead of v1.13, we simply leave it at that with the
6390 # effect that *we* will treat it like a v-tring while the rest of
6391 # perl won't. Seems sensible when we consider that any action we
6392 # could take now would just add complexity.
6394 $have = CPAN::Version->readable($have);
6396 $have =~ s/\s*//g; # stringify to float around floating point issues
6397 $have; # no stringify needed, \s* above matches always
6409 CPAN - query, download and build perl modules from CPAN sites
6415 perl -MCPAN -e shell;
6423 $mod = "Acme::Meta";
6425 CPAN::Shell->install($mod); # same thing
6426 CPAN::Shell->expandany($mod)->install; # same thing
6427 CPAN::Shell->expand("Module",$mod)->install; # same thing
6428 CPAN::Shell->expand("Module",$mod)
6429 ->distribution->install; # same thing
6433 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
6434 install $distro; # same thing
6435 CPAN::Shell->install($distro); # same thing
6436 CPAN::Shell->expandany($distro)->install; # same thing
6437 CPAN::Shell->expand("Module",$distro)->install; # same thing
6441 This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
6442 of a modern rewrite from ground up with greater extensibility and more
6443 features but no full compatibility. If you're new to CPAN.pm, you
6444 probably should investigate if CPANPLUS is the better choice for you.
6445 If you're already used to CPAN.pm you're welcome to continue using it,
6446 if you accept that its development is mostly (though not completely)
6451 The CPAN module is designed to automate the make and install of perl
6452 modules and extensions. It includes some primitive searching
6453 capabilities and knows how to use Net::FTP or LWP (or some external
6454 download clients) to fetch the raw data from the net.
6456 Modules are fetched from one or more of the mirrored CPAN
6457 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
6460 The CPAN module also supports the concept of named and versioned
6461 I<bundles> of modules. Bundles simplify the handling of sets of
6462 related modules. See Bundles below.
6464 The package contains a session manager and a cache manager. There is
6465 no status retained between sessions. The session manager keeps track
6466 of what has been fetched, built and installed in the current
6467 session. The cache manager keeps track of the disk space occupied by
6468 the make processes and deletes excess space according to a simple FIFO
6471 All methods provided are accessible in a programmer style and in an
6472 interactive shell style.
6474 =head2 Interactive Mode
6476 The interactive mode is entered by running
6478 perl -MCPAN -e shell
6480 which puts you into a readline interface. You will have the most fun if
6481 you install Term::ReadKey and Term::ReadLine to enjoy both history and
6484 Once you are on the command line, type 'h' and the rest should be
6487 The function call C<shell> takes two optional arguments, one is the
6488 prompt, the second is the default initial command line (the latter
6489 only works if a real ReadLine interface module is installed).
6491 The most common uses of the interactive modes are
6495 =item Searching for authors, bundles, distribution files and modules
6497 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
6498 for each of the four categories and another, C<i> for any of the
6499 mentioned four. Each of the four entities is implemented as a class
6500 with slightly differing methods for displaying an object.
6502 Arguments you pass to these commands are either strings exactly matching
6503 the identification string of an object or regular expressions that are
6504 then matched case-insensitively against various attributes of the
6505 objects. The parser recognizes a regular expression only if you
6506 enclose it between two slashes.
6508 The principle is that the number of found objects influences how an
6509 item is displayed. If the search finds one item, the result is
6510 displayed with the rather verbose method C<as_string>, but if we find
6511 more than one, we display each object with the terse method
6514 =item make, test, install, clean modules or distributions
6516 These commands take any number of arguments and investigate what is
6517 necessary to perform the action. If the argument is a distribution
6518 file name (recognized by embedded slashes), it is processed. If it is
6519 a module, CPAN determines the distribution file in which this module
6520 is included and processes that, following any dependencies named in
6521 the module's META.yml or Makefile.PL (this behavior is controlled by
6522 the configuration parameter C<prerequisites_policy>.)
6524 Any C<make> or C<test> are run unconditionally. An
6526 install <distribution_file>
6528 also is run unconditionally. But for
6532 CPAN checks if an install is actually needed for it and prints
6533 I<module up to date> in the case that the distribution file containing
6534 the module doesn't need to be updated.
6536 CPAN also keeps track of what it has done within the current session
6537 and doesn't try to build a package a second time regardless if it
6538 succeeded or not. The C<force> pragma may precede another command
6539 (currently: C<make>, C<test>, or C<install>) and executes the
6540 command from scratch and tries to continue in case of some errors.
6544 cpan> install OpenGL
6545 OpenGL is up to date.
6546 cpan> force install OpenGL
6549 OpenGL-0.4/COPYRIGHT
6552 The C<notest> pragma may be set to skip the test part in the build
6557 cpan> notest install Tk
6559 A C<clean> command results in a
6563 being executed within the distribution file's working directory.
6565 =item get, readme, perldoc, look module or distribution
6567 C<get> downloads a distribution file without further action. C<readme>
6568 displays the README file of the associated distribution. C<Look> gets
6569 and untars (if not yet done) the distribution file, changes to the
6570 appropriate directory and opens a subshell process in that directory.
6571 C<perldoc> displays the pod documentation of the module in html or
6576 =item ls globbing_expresion
6578 The first form lists all distribution files in and below an author's
6579 CPAN directory as they are stored in the CHECKUMS files distrbute on
6582 The second form allows to limit or expand the output with shell
6583 globbing as in the following examples:
6589 The last example is very slow and outputs extra progress indicators
6590 that break the alignment of the result.
6594 The C<failed> command reports all distributions that failed on one of
6595 C<make>, C<test> or C<install> for some reason in the currently
6596 running shell session.
6600 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
6601 (but the directory can be configured via the C<cpan_home> config
6602 variable). The shell is a bit picky if you try to start another CPAN
6603 session. It dies immediately if there is a lockfile and the lock seems
6604 to belong to a running process. In case you want to run a second shell
6605 session, it is probably safest to maintain another directory, say
6606 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
6607 contains the configuration options. Then you can start the second
6610 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
6614 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
6615 in the cpan-shell it is intended that you can press C<^C> anytime and
6616 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
6617 to clean up and leave the shell loop. You can emulate the effect of a
6618 SIGTERM by sending two consecutive SIGINTs, which usually means by
6619 pressing C<^C> twice.
6621 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
6622 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
6623 Build.PL> subprocess.
6629 The commands that are available in the shell interface are methods in
6630 the package CPAN::Shell. If you enter the shell command, all your
6631 input is split by the Text::ParseWords::shellwords() routine which
6632 acts like most shells do. The first word is being interpreted as the
6633 method to be called and the rest of the words are treated as arguments
6634 to this method. Continuation lines are supported if a line ends with a
6639 C<autobundle> writes a bundle file into the
6640 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
6641 a list of all modules that are both available from CPAN and currently
6642 installed within @INC. The name of the bundle file is based on the
6643 current date and a counter.
6647 recompile() is a very special command in that it takes no argument and
6648 runs the make/test/install cycle with brute force over all installed
6649 dynamically loadable extensions (aka XS modules) with 'force' in
6650 effect. The primary purpose of this command is to finish a network
6651 installation. Imagine, you have a common source tree for two different
6652 architectures. You decide to do a completely independent fresh
6653 installation. You start on one architecture with the help of a Bundle
6654 file produced earlier. CPAN installs the whole Bundle for you, but
6655 when you try to repeat the job on the second architecture, CPAN
6656 responds with a C<"Foo up to date"> message for all modules. So you
6657 invoke CPAN's recompile on the second architecture and you're done.
6659 Another popular use for C<recompile> is to act as a rescue in case your
6660 perl breaks binary compatibility. If one of the modules that CPAN uses
6661 is in turn depending on binary compatibility (so you cannot run CPAN
6662 commands), then you should try the CPAN::Nox module for recovery.
6664 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
6666 Although it may be considered internal, the class hierarchy does matter
6667 for both users and programmer. CPAN.pm deals with above mentioned four
6668 classes, and all those classes share a set of methods. A classical
6669 single polymorphism is in effect. A metaclass object registers all
6670 objects of all kinds and indexes them with a string. The strings
6671 referencing objects have a separated namespace (well, not completely
6676 words containing a "/" (slash) Distribution
6677 words starting with Bundle:: Bundle
6678 everything else Module or Author
6680 Modules know their associated Distribution objects. They always refer
6681 to the most recent official release. Developers may mark their releases
6682 as unstable development versions (by inserting an underbar into the
6683 module version number which will also be reflected in the distribution
6684 name when you run 'make dist'), so the really hottest and newest
6685 distribution is not always the default. If a module Foo circulates
6686 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
6687 way to install version 1.23 by saying
6691 This would install the complete distribution file (say
6692 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
6693 like to install version 1.23_90, you need to know where the
6694 distribution file resides on CPAN relative to the authors/id/
6695 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
6696 so you would have to say
6698 install BAR/Foo-1.23_90.tar.gz
6700 The first example will be driven by an object of the class
6701 CPAN::Module, the second by an object of class CPAN::Distribution.
6703 =head2 Programmer's interface
6705 If you do not enter the shell, the available shell commands are both
6706 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
6707 functions in the calling package (C<install(...)>).
6709 There's currently only one class that has a stable interface -
6710 CPAN::Shell. All commands that are available in the CPAN shell are
6711 methods of the class CPAN::Shell. Each of the commands that produce
6712 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
6713 the IDs of all modules within the list.
6717 =item expand($type,@things)
6719 The IDs of all objects available within a program are strings that can
6720 be expanded to the corresponding real objects with the
6721 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
6722 list of CPAN::Module objects according to the C<@things> arguments
6723 given. In scalar context it only returns the first element of the
6726 =item expandany(@things)
6728 Like expand, but returns objects of the appropriate type, i.e.
6729 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
6730 CPAN::Distribution objects fro distributions.
6732 =item Programming Examples
6734 This enables the programmer to do operations that combine
6735 functionalities that are available in the shell.
6737 # install everything that is outdated on my disk:
6738 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
6740 # install my favorite programs if necessary:
6741 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
6742 my $obj = CPAN::Shell->expand('Module',$mod);
6746 # list all modules on my disk that have no VERSION number
6747 for $mod (CPAN::Shell->expand("Module","/./")){
6748 next unless $mod->inst_file;
6749 # MakeMaker convention for undefined $VERSION:
6750 next unless $mod->inst_version eq "undef";
6751 print "No VERSION in ", $mod->id, "\n";
6754 # find out which distribution on CPAN contains a module:
6755 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
6757 Or if you want to write a cronjob to watch The CPAN, you could list
6758 all modules that need updating. First a quick and dirty way:
6760 perl -e 'use CPAN; CPAN::Shell->r;'
6762 If you don't want to get any output in the case that all modules are
6763 up to date, you can parse the output of above command for the regular
6764 expression //modules are up to date// and decide to mail the output
6765 only if it doesn't match. Ick?
6767 If you prefer to do it more in a programmer style in one single
6768 process, maybe something like this suits you better:
6770 # list all modules on my disk that have newer versions on CPAN
6771 for $mod (CPAN::Shell->expand("Module","/./")){
6772 next unless $mod->inst_file;
6773 next if $mod->uptodate;
6774 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
6775 $mod->id, $mod->inst_version, $mod->cpan_version;
6778 If that gives you too much output every day, you maybe only want to
6779 watch for three modules. You can write
6781 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
6783 as the first line instead. Or you can combine some of the above
6786 # watch only for a new mod_perl module
6787 $mod = CPAN::Shell->expand("Module","mod_perl");
6788 exit if $mod->uptodate;
6789 # new mod_perl arrived, let me know all update recommendations
6794 =head2 Methods in the other Classes
6796 The programming interface for the classes CPAN::Module,
6797 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
6798 beta and partially even alpha. In the following paragraphs only those
6799 methods are documented that have proven useful over a longer time and
6800 thus are unlikely to change.
6804 =item CPAN::Author::as_glimpse()
6806 Returns a one-line description of the author
6808 =item CPAN::Author::as_string()
6810 Returns a multi-line description of the author
6812 =item CPAN::Author::email()
6814 Returns the author's email address
6816 =item CPAN::Author::fullname()
6818 Returns the author's name
6820 =item CPAN::Author::name()
6822 An alias for fullname
6824 =item CPAN::Bundle::as_glimpse()
6826 Returns a one-line description of the bundle
6828 =item CPAN::Bundle::as_string()
6830 Returns a multi-line description of the bundle
6832 =item CPAN::Bundle::clean()
6834 Recursively runs the C<clean> method on all items contained in the bundle.
6836 =item CPAN::Bundle::contains()
6838 Returns a list of objects' IDs contained in a bundle. The associated
6839 objects may be bundles, modules or distributions.
6841 =item CPAN::Bundle::force($method,@args)
6843 Forces CPAN to perform a task that normally would have failed. Force
6844 takes as arguments a method name to be called and any number of
6845 additional arguments that should be passed to the called method. The
6846 internals of the object get the needed changes so that CPAN.pm does
6847 not refuse to take the action. The C<force> is passed recursively to
6848 all contained objects.
6850 =item CPAN::Bundle::get()
6852 Recursively runs the C<get> method on all items contained in the bundle
6854 =item CPAN::Bundle::inst_file()
6856 Returns the highest installed version of the bundle in either @INC or
6857 C<$CPAN::Config->{cpan_home}>. Note that this is different from
6858 CPAN::Module::inst_file.
6860 =item CPAN::Bundle::inst_version()
6862 Like CPAN::Bundle::inst_file, but returns the $VERSION
6864 =item CPAN::Bundle::uptodate()
6866 Returns 1 if the bundle itself and all its members are uptodate.
6868 =item CPAN::Bundle::install()
6870 Recursively runs the C<install> method on all items contained in the bundle
6872 =item CPAN::Bundle::make()
6874 Recursively runs the C<make> method on all items contained in the bundle
6876 =item CPAN::Bundle::readme()
6878 Recursively runs the C<readme> method on all items contained in the bundle
6880 =item CPAN::Bundle::test()
6882 Recursively runs the C<test> method on all items contained in the bundle
6884 =item CPAN::Distribution::as_glimpse()
6886 Returns a one-line description of the distribution
6888 =item CPAN::Distribution::as_string()
6890 Returns a multi-line description of the distribution
6892 =item CPAN::Distribution::clean()
6894 Changes to the directory where the distribution has been unpacked and
6895 runs C<make clean> there.
6897 =item CPAN::Distribution::containsmods()
6899 Returns a list of IDs of modules contained in a distribution file.
6900 Only works for distributions listed in the 02packages.details.txt.gz
6901 file. This typically means that only the most recent version of a
6902 distribution is covered.
6904 =item CPAN::Distribution::cvs_import()
6906 Changes to the directory where the distribution has been unpacked and
6909 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
6913 =item CPAN::Distribution::dir()
6915 Returns the directory into which this distribution has been unpacked.
6917 =item CPAN::Distribution::force($method,@args)
6919 Forces CPAN to perform a task that normally would have failed. Force
6920 takes as arguments a method name to be called and any number of
6921 additional arguments that should be passed to the called method. The
6922 internals of the object get the needed changes so that CPAN.pm does
6923 not refuse to take the action.
6925 =item CPAN::Distribution::get()
6927 Downloads the distribution from CPAN and unpacks it. Does nothing if
6928 the distribution has already been downloaded and unpacked within the
6931 =item CPAN::Distribution::install()
6933 Changes to the directory where the distribution has been unpacked and
6934 runs the external command C<make install> there. If C<make> has not
6935 yet been run, it will be run first. A C<make test> will be issued in
6936 any case and if this fails, the install will be canceled. The
6937 cancellation can be avoided by letting C<force> run the C<install> for
6940 =item CPAN::Distribution::isa_perl()
6942 Returns 1 if this distribution file seems to be a perl distribution.
6943 Normally this is derived from the file name only, but the index from
6944 CPAN can contain a hint to achieve a return value of true for other
6947 =item CPAN::Distribution::look()
6949 Changes to the directory where the distribution has been unpacked and
6950 opens a subshell there. Exiting the subshell returns.
6952 =item CPAN::Distribution::make()
6954 First runs the C<get> method to make sure the distribution is
6955 downloaded and unpacked. Changes to the directory where the
6956 distribution has been unpacked and runs the external commands C<perl
6957 Makefile.PL> or C<perl Build.PL> and C<make> there.
6959 =item CPAN::Distribution::prereq_pm()
6961 Returns the hash reference that has been announced by a distribution
6962 as the C<requires> element of the META.yml or the C<PREREQ_PM> hash in
6963 the C<Makefile.PL>. Note: works only after an attempt has been made to
6964 C<make> the distribution. Returns undef otherwise.
6966 =item CPAN::Distribution::readme()
6968 Downloads the README file associated with a distribution and runs it
6969 through the pager specified in C<$CPAN::Config->{pager}>.
6971 =item CPAN::Distribution::perldoc()
6973 Downloads the pod documentation of the file associated with a
6974 distribution (in html format) and runs it through the external
6975 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
6976 isn't available, it converts it to plain text with external
6977 command html2text and runs it through the pager specified
6978 in C<$CPAN::Config->{pager}>
6980 =item CPAN::Distribution::test()
6982 Changes to the directory where the distribution has been unpacked and
6983 runs C<make test> there.
6985 =item CPAN::Distribution::uptodate()
6987 Returns 1 if all the modules contained in the distribution are
6988 uptodate. Relies on containsmods.
6990 =item CPAN::Index::force_reload()
6992 Forces a reload of all indices.
6994 =item CPAN::Index::reload()
6996 Reloads all indices if they have not been read for more than
6997 C<$CPAN::Config->{index_expire}> days.
6999 =item CPAN::InfoObj::dump()
7001 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7002 inherit this method. It prints the data structure associated with an
7003 object. Useful for debugging. Note: the data structure is considered
7004 internal and thus subject to change without notice.
7006 =item CPAN::Module::as_glimpse()
7008 Returns a one-line description of the module
7010 =item CPAN::Module::as_string()
7012 Returns a multi-line description of the module
7014 =item CPAN::Module::clean()
7016 Runs a clean on the distribution associated with this module.
7018 =item CPAN::Module::cpan_file()
7020 Returns the filename on CPAN that is associated with the module.
7022 =item CPAN::Module::cpan_version()
7024 Returns the latest version of this module available on CPAN.
7026 =item CPAN::Module::cvs_import()
7028 Runs a cvs_import on the distribution associated with this module.
7030 =item CPAN::Module::description()
7032 Returns a 44 character description of this module. Only available for
7033 modules listed in The Module List (CPAN/modules/00modlist.long.html
7034 or 00modlist.long.txt.gz)
7036 =item CPAN::Module::force($method,@args)
7038 Forces CPAN to perform a task that normally would have failed. Force
7039 takes as arguments a method name to be called and any number of
7040 additional arguments that should be passed to the called method. The
7041 internals of the object get the needed changes so that CPAN.pm does
7042 not refuse to take the action.
7044 =item CPAN::Module::get()
7046 Runs a get on the distribution associated with this module.
7048 =item CPAN::Module::inst_file()
7050 Returns the filename of the module found in @INC. The first file found
7051 is reported just like perl itself stops searching @INC when it finds a
7054 =item CPAN::Module::inst_version()
7056 Returns the version number of the module in readable format.
7058 =item CPAN::Module::install()
7060 Runs an C<install> on the distribution associated with this module.
7062 =item CPAN::Module::look()
7064 Changes to the directory where the distribution associated with this
7065 module has been unpacked and opens a subshell there. Exiting the
7068 =item CPAN::Module::make()
7070 Runs a C<make> on the distribution associated with this module.
7072 =item CPAN::Module::manpage_headline()
7074 If module is installed, peeks into the module's manpage, reads the
7075 headline and returns it. Moreover, if the module has been downloaded
7076 within this session, does the equivalent on the downloaded module even
7077 if it is not installed.
7079 =item CPAN::Module::readme()
7081 Runs a C<readme> on the distribution associated with this module.
7083 =item CPAN::Module::perldoc()
7085 Runs a C<perldoc> on this module.
7087 =item CPAN::Module::test()
7089 Runs a C<test> on the distribution associated with this module.
7091 =item CPAN::Module::uptodate()
7093 Returns 1 if the module is installed and up-to-date.
7095 =item CPAN::Module::userid()
7097 Returns the author's ID of the module.
7101 =head2 Cache Manager
7103 Currently the cache manager only keeps track of the build directory
7104 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
7105 deletes complete directories below C<build_dir> as soon as the size of
7106 all directories there gets bigger than $CPAN::Config->{build_cache}
7107 (in MB). The contents of this cache may be used for later
7108 re-installations that you intend to do manually, but will never be
7109 trusted by CPAN itself. This is due to the fact that the user might
7110 use these directories for building modules on different architectures.
7112 There is another directory ($CPAN::Config->{keep_source_where}) where
7113 the original distribution files are kept. This directory is not
7114 covered by the cache manager and must be controlled by the user. If
7115 you choose to have the same directory as build_dir and as
7116 keep_source_where directory, then your sources will be deleted with
7117 the same fifo mechanism.
7121 A bundle is just a perl module in the namespace Bundle:: that does not
7122 define any functions or methods. It usually only contains documentation.
7124 It starts like a perl module with a package declaration and a $VERSION
7125 variable. After that the pod section looks like any other pod with the
7126 only difference being that I<one special pod section> exists starting with
7131 In this pod section each line obeys the format
7133 Module_Name [Version_String] [- optional text]
7135 The only required part is the first field, the name of a module
7136 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
7137 of the line is optional. The comment part is delimited by a dash just
7138 as in the man page header.
7140 The distribution of a bundle should follow the same convention as
7141 other distributions.
7143 Bundles are treated specially in the CPAN package. If you say 'install
7144 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
7145 the modules in the CONTENTS section of the pod. You can install your
7146 own Bundles locally by placing a conformant Bundle file somewhere into
7147 your @INC path. The autobundle() command which is available in the
7148 shell interface does that for you by including all currently installed
7149 modules in a snapshot bundle file.
7151 =head2 Prerequisites
7153 If you have a local mirror of CPAN and can access all files with
7154 "file:" URLs, then you only need a perl better than perl5.003 to run
7155 this module. Otherwise Net::FTP is strongly recommended. LWP may be
7156 required for non-UNIX systems or if your nearest CPAN site is
7157 associated with a URL that is not C<ftp:>.
7159 If you have neither Net::FTP nor LWP, there is a fallback mechanism
7160 implemented for an external ftp command or for an external lynx
7163 =head2 Finding packages and VERSION
7165 This module presumes that all packages on CPAN
7171 declare their $VERSION variable in an easy to parse manner. This
7172 prerequisite can hardly be relaxed because it consumes far too much
7173 memory to load all packages into the running program just to determine
7174 the $VERSION variable. Currently all programs that are dealing with
7175 version use something like this
7177 perl -MExtUtils::MakeMaker -le \
7178 'print MM->parse_version(shift)' filename
7180 If you are author of a package and wonder if your $VERSION can be
7181 parsed, please try the above method.
7185 come as compressed or gzipped tarfiles or as zip files and contain a
7186 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
7187 without much enthusiasm).
7193 The debugging of this module is a bit complex, because we have
7194 interferences of the software producing the indices on CPAN, of the
7195 mirroring process on CPAN, of packaging, of configuration, of
7196 synchronicity, and of bugs within CPAN.pm.
7198 For code debugging in interactive mode you can try "o debug" which
7199 will list options for debugging the various parts of the code. You
7200 should know that "o debug" has built-in completion support.
7202 For data debugging there is the C<dump> command which takes the same
7203 arguments as make/test/install and outputs the object's Data::Dumper
7206 =head2 Floppy, Zip, Offline Mode
7208 CPAN.pm works nicely without network too. If you maintain machines
7209 that are not networked at all, you should consider working with file:
7210 URLs. Of course, you have to collect your modules somewhere first. So
7211 you might use CPAN.pm to put together all you need on a networked
7212 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
7213 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
7214 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
7215 with this floppy. See also below the paragraph about CD-ROM support.
7217 =head1 CONFIGURATION
7219 When the CPAN module is used for the first time, a configuration
7220 dialog tries to determine a couple of site specific options. The
7221 result of the dialog is stored in a hash reference C< $CPAN::Config >
7222 in a file CPAN/Config.pm.
7224 The default values defined in the CPAN/Config.pm file can be
7225 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
7226 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
7227 added to the search path of the CPAN module before the use() or
7228 require() statements.
7230 The configuration dialog can be started any time later again by
7231 issuing the command C< o conf init > in the CPAN shell.
7233 Currently the following keys in the hash reference $CPAN::Config are
7236 build_cache size of cache for directories to build modules
7237 build_dir locally accessible directory to build modules
7238 index_expire after this many days refetch index files
7239 cache_metadata use serializer to cache metadata
7240 cpan_home local directory reserved for this package
7241 dontload_hash anonymous hash: modules in the keys will not be
7242 loaded by the CPAN::has_inst() routine
7243 gzip location of external program gzip
7244 histfile file to maintain history between sessions
7245 histsize maximum number of lines to keep in histfile
7246 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
7247 after this many seconds inactivity. Set to 0 to
7249 inhibit_startup_message
7250 if true, does not print the startup message
7251 keep_source_where directory in which to keep the source (if we do)
7252 make location of external make program
7253 make_arg arguments that should always be passed to 'make'
7254 make_install_make_command
7255 the make command for running 'make install', for
7257 make_install_arg same as make_arg for 'make install'
7258 makepl_arg arguments passed to 'perl Makefile.PL'
7259 mbuild_arg arguments passed to './Build'
7260 mbuild_install_arg arguments passed to './Build install'
7261 mbuild_install_build_command
7262 command to use instead of './Build' when we are
7263 in the install stage, for example 'sudo ./Build'
7264 mbuildpl_arg arguments passed to 'perl Build.PL'
7265 pager location of external program more (or any pager)
7266 prefer_installer legal values are MB and EUMM: if a module
7267 comes with both a Makefile.PL and a Build.PL, use
7268 the former (EUMM) or the latter (MB)
7269 prerequisites_policy
7270 what to do if you are missing module prerequisites
7271 ('follow' automatically, 'ask' me, or 'ignore')
7272 proxy_user username for accessing an authenticating proxy
7273 proxy_pass password for accessing an authenticating proxy
7274 scan_cache controls scanning of cache ('atstart' or 'never')
7275 tar location of external program tar
7276 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
7277 (and nonsense for characters outside latin range)
7278 unzip location of external program unzip
7279 urllist arrayref to nearby CPAN sites (or equivalent locations)
7280 wait_list arrayref to a wait server to try (See CPAN::WAIT)
7281 ftp_proxy, } the three usual variables for configuring
7282 http_proxy, } proxy requests. Both as CPAN::Config variables
7283 no_proxy } and as environment variables configurable.
7285 You can set and query each of these options interactively in the cpan
7286 shell with the command set defined within the C<o conf> command:
7290 =item C<o conf E<lt>scalar optionE<gt>>
7292 prints the current value of the I<scalar option>
7294 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
7296 Sets the value of the I<scalar option> to I<value>
7298 =item C<o conf E<lt>list optionE<gt>>
7300 prints the current value of the I<list option> in MakeMaker's
7303 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
7305 shifts or pops the array in the I<list option> variable
7307 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
7309 works like the corresponding perl commands.
7313 =head2 Note on urllist parameter's format
7315 urllist parameters are URLs according to RFC 1738. We do a little
7316 guessing if your URL is not compliant, but if you have problems with
7317 file URLs, please try the correct format. Either:
7319 file://localhost/whatever/ftp/pub/CPAN/
7323 file:///home/ftp/pub/CPAN/
7325 =head2 urllist parameter has CD-ROM support
7327 The C<urllist> parameter of the configuration table contains a list of
7328 URLs that are to be used for downloading. If the list contains any
7329 C<file> URLs, CPAN always tries to get files from there first. This
7330 feature is disabled for index files. So the recommendation for the
7331 owner of a CD-ROM with CPAN contents is: include your local, possibly
7332 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
7334 o conf urllist push file://localhost/CDROM/CPAN
7336 CPAN.pm will then fetch the index files from one of the CPAN sites
7337 that come at the beginning of urllist. It will later check for each
7338 module if there is a local copy of the most recent version.
7340 Another peculiarity of urllist is that the site that we could
7341 successfully fetch the last file from automatically gets a preference
7342 token and is tried as the first site for the next request. So if you
7343 add a new site at runtime it may happen that the previously preferred
7344 site will be tried another time. This means that if you want to disallow
7345 a site for the next transfer, it must be explicitly removed from
7350 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
7351 install foreign, unmasked, unsigned code on your machine. We compare
7352 to a checksum that comes from the net just as the distribution file
7353 itself. But we try to make it easy to add security on demand:
7355 =head2 Cryptographically signed modules
7357 Since release 1.77 CPAN.pm has been able to verify cryptographically
7358 signed module distributions using Module::Signature. The CPAN modules
7359 can be signed by their authors, thus giving more security. The simple
7360 unsigned MD5 checksums that were used before by CPAN protect mainly
7361 against accidental file corruption.
7363 You will need to have Module::Signature installed, which in turn
7364 requires that you have at least one of Crypt::OpenPGP module or the
7365 command-line F<gpg> tool installed.
7367 You will also need to be able to connect over the Internet to the public
7368 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
7372 Most functions in package CPAN are exported per default. The reason
7373 for this is that the primary use is intended for the cpan shell or for
7378 When the CPAN shell enters a subshell via the look command, it sets
7379 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
7382 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
7384 Populating a freshly installed perl with my favorite modules is pretty
7385 easy if you maintain a private bundle definition file. To get a useful
7386 blueprint of a bundle definition file, the command autobundle can be used
7387 on the CPAN shell command line. This command writes a bundle definition
7388 file for all modules that are installed for the currently running perl
7389 interpreter. It's recommended to run this command only once and from then
7390 on maintain the file manually under a private name, say
7391 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
7393 cpan> install Bundle::my_bundle
7395 then answer a few questions and then go out for a coffee.
7397 Maintaining a bundle definition file means keeping track of two
7398 things: dependencies and interactivity. CPAN.pm sometimes fails on
7399 calculating dependencies because not all modules define all MakeMaker
7400 attributes correctly, so a bundle definition file should specify
7401 prerequisites as early as possible. On the other hand, it's a bit
7402 annoying that many distributions need some interactive configuring. So
7403 what I try to accomplish in my private bundle file is to have the
7404 packages that need to be configured early in the file and the gentle
7405 ones later, so I can go out after a few minutes and leave CPAN.pm
7408 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
7410 Thanks to Graham Barr for contributing the following paragraphs about
7411 the interaction between perl, and various firewall configurations. For
7412 further information on firewalls, it is recommended to consult the
7413 documentation that comes with the ncftp program. If you are unable to
7414 go through the firewall with a simple Perl setup, it is very likely
7415 that you can configure ncftp so that it works for your firewall.
7417 =head2 Three basic types of firewalls
7419 Firewalls can be categorized into three basic types.
7425 This is where the firewall machine runs a web server and to access the
7426 outside world you must do it via the web server. If you set environment
7427 variables like http_proxy or ftp_proxy to a values beginning with http://
7428 or in your web browser you have to set proxy information then you know
7429 you are running an http firewall.
7431 To access servers outside these types of firewalls with perl (even for
7432 ftp) you will need to use LWP.
7436 This where the firewall machine runs an ftp server. This kind of
7437 firewall will only let you access ftp servers outside the firewall.
7438 This is usually done by connecting to the firewall with ftp, then
7439 entering a username like "user@outside.host.com"
7441 To access servers outside these type of firewalls with perl you
7442 will need to use Net::FTP.
7444 =item One way visibility
7446 I say one way visibility as these firewalls try to make themselves look
7447 invisible to the users inside the firewall. An FTP data connection is
7448 normally created by sending the remote server your IP address and then
7449 listening for the connection. But the remote server will not be able to
7450 connect to you because of the firewall. So for these types of firewall
7451 FTP connections need to be done in a passive mode.
7453 There are two that I can think off.
7459 If you are using a SOCKS firewall you will need to compile perl and link
7460 it with the SOCKS library, this is what is normally called a 'socksified'
7461 perl. With this executable you will be able to connect to servers outside
7462 the firewall as if it is not there.
7466 This is the firewall implemented in the Linux kernel, it allows you to
7467 hide a complete network behind one IP address. With this firewall no
7468 special compiling is needed as you can access hosts directly.
7470 For accessing ftp servers behind such firewalls you may need to set
7471 the environment variable C<FTP_PASSIVE> to a true value, e.g.
7473 env FTP_PASSIVE=1 perl -MCPAN -eshell
7477 perl -MCPAN -e '$ENV{FTP_PASSIVE} = 1; shell'
7484 =head2 Configuring lynx or ncftp for going through a firewall
7486 If you can go through your firewall with e.g. lynx, presumably with a
7489 /usr/local/bin/lynx -pscott:tiger
7491 then you would configure CPAN.pm with the command
7493 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
7495 That's all. Similarly for ncftp or ftp, you would configure something
7498 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
7500 Your mileage may vary...
7508 I installed a new version of module X but CPAN keeps saying,
7509 I have the old version installed
7511 Most probably you B<do> have the old version installed. This can
7512 happen if a module installs itself into a different directory in the
7513 @INC path than it was previously installed. This is not really a
7514 CPAN.pm problem, you would have the same problem when installing the
7515 module manually. The easiest way to prevent this behaviour is to add
7516 the argument C<UNINST=1> to the C<make install> call, and that is why
7517 many people add this argument permanently by configuring
7519 o conf make_install_arg UNINST=1
7523 So why is UNINST=1 not the default?
7525 Because there are people who have their precise expectations about who
7526 may install where in the @INC path and who uses which @INC array. In
7527 fine tuned environments C<UNINST=1> can cause damage.
7531 I want to clean up my mess, and install a new perl along with
7532 all modules I have. How do I go about it?
7534 Run the autobundle command for your old perl and optionally rename the
7535 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
7536 with the Configure option prefix, e.g.
7538 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
7540 Install the bundle file you produced in the first step with something like
7542 cpan> install Bundle::mybundle
7548 When I install bundles or multiple modules with one command
7549 there is too much output to keep track of.
7551 You may want to configure something like
7553 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
7554 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
7556 so that STDOUT is captured in a file for later inspection.
7561 I am not root, how can I install a module in a personal directory?
7563 First of all, you will want to use your own configuration, not the one
7564 that your root user installed. The following command sequence is a
7567 % mkdir -p $HOME/.cpan/CPAN
7568 % echo '$CPAN::Config={ };' > $HOME/.cpan/CPAN/MyConfig.pm
7570 [...answer all questions...]
7572 You will most probably like something like this:
7574 o conf makepl_arg "LIB=~/myperl/lib \
7575 INSTALLMAN1DIR=~/myperl/man/man1 \
7576 INSTALLMAN3DIR=~/myperl/man/man3"
7578 You can make this setting permanent like all C<o conf> settings with
7581 You will have to add ~/myperl/man to the MANPATH environment variable
7582 and also tell your perl programs to look into ~/myperl/lib, e.g. by
7585 use lib "$ENV{HOME}/myperl/lib";
7587 or setting the PERL5LIB environment variable.
7589 Another thing you should bear in mind is that the UNINST parameter
7590 should never be set if you are not root.
7594 How to get a package, unwrap it, and make a change before building it?
7596 look Sybase::Sybperl
7600 I installed a Bundle and had a couple of fails. When I
7601 retried, everything resolved nicely. Can this be fixed to work
7604 The reason for this is that CPAN does not know the dependencies of all
7605 modules when it starts out. To decide about the additional items to
7606 install, it just uses data found in the generated Makefile. An
7607 undetected missing piece breaks the process. But it may well be that
7608 your Bundle installs some prerequisite later than some depending item
7609 and thus your second try is able to resolve everything. Please note,
7610 CPAN.pm does not know the dependency tree in advance and cannot sort
7611 the queue of things to install in a topologically correct order. It
7612 resolves perfectly well IFF all modules declare the prerequisites
7613 correctly with the PREREQ_PM attribute to MakeMaker. For bundles which
7614 fail and you need to install often, it is recommended to sort the Bundle
7615 definition file manually. It is planned to improve the metadata
7616 situation for dependencies on CPAN in general, but this will still
7621 In our intranet we have many modules for internal use. How
7622 can I integrate these modules with CPAN.pm but without uploading
7623 the modules to CPAN?
7625 Have a look at the CPAN::Site module.
7629 When I run CPAN's shell, I get error msg about line 1 to 4,
7630 setting meta input/output via the /etc/inputrc file.
7632 Some versions of readline are picky about capitalization in the
7633 /etc/inputrc file and specifically RedHat 6.2 comes with a
7634 /etc/inputrc that contains the word C<on> in lowercase. Change the
7635 occurrences of C<on> to C<On> and the bug should disappear.
7639 Some authors have strange characters in their names.
7641 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
7642 expecting ISO-8859-1 charset, a converter can be activated by setting
7643 term_is_latin to a true value in your config file. One way of doing so
7646 cpan> ! $CPAN::Config->{term_is_latin}=1
7648 Extended support for converters will be made available as soon as perl
7649 becomes stable with regard to charset issues.
7653 When an install fails for some reason and then I correct the error
7654 condition and retry, CPAN.pm refuses to install the module, saying
7655 C<Already tried without success>.
7657 Use the force pragma like so
7659 force install Foo::Bar
7661 This does a bit more than really needed because it untars the
7662 distribution again and runs make and test and only then install.
7664 Or, if you find this is too fast and you would prefer to do smaller
7669 first and then continue as always. C<Force get> I<forgets> previous
7676 and then 'make install' directly in the subshell.
7678 Or you leave the CPAN shell and start it again.
7680 For the really curious, by accessing internals directly, you I<could>
7682 ! delete CPAN::Shell->expand("Distribution", \
7683 CPAN::Shell->expand("Module","Foo::Bar") \
7684 ->cpan_file)->{install}
7686 but this is neither guaranteed to work in the future nor is it a
7693 If a Makefile.PL requires special customization of libraries, prompts
7694 the user for special input, etc. then you may find CPAN is not able to
7695 build the distribution. In that case it is recommended to attempt the
7696 traditional method of building a Perl module package from a shell, for
7697 example by using the 'look' command to open a subshell in the
7698 distribution's own directory.
7702 Andreas Koenig C<< <andk@cpan.org> >>
7706 Kawai,Takanori provides a Japanese translation of this manpage at
7707 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
7711 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)
7718 # cperl-indent-level: 4