1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
4 $VERSION = eval $VERSION;
7 use CPAN::HandleConfig;
16 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
17 use File::Basename ();
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::Defaultsites = ("http://www.perl.org/CPAN/","ftp://ftp.perl.org/pub/CPAN/")
37 unless @CPAN::Defaultsites;
38 # $CPAN::iCwd (i for initial) is going to be initialized during find_perl
39 $CPAN::Perl ||= CPAN::find_perl();
40 $CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
41 $CPAN::Defaultrecent ||= "http://search.cpan.org/recent";
47 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term
48 $Signal $Suppress_readline $Frontend
49 @Defaultsites $Have_warned $Defaultdocs $Defaultrecent
52 @CPAN::ISA = qw(CPAN::Debug Exporter);
54 # note that these functions live in CPAN::Shell and get executed via
55 # AUTOLOAD when called directly
76 sub soft_chdir_with_alternatives ($);
78 #-> sub CPAN::AUTOLOAD ;
83 @EXPORT{@EXPORT} = '';
84 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
85 if (exists $EXPORT{$l}){
88 $CPAN::Frontend->mywarn(qq{Unknown CPAN command "$AUTOLOAD". }.
97 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
98 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
100 my $oprompt = shift || CPAN::Prompt->new;
101 my $prompt = $oprompt;
102 my $commandline = shift || "";
103 $CPAN::CurrentCommandId ||= 1;
106 unless ($Suppress_readline) {
107 require Term::ReadLine;
110 $term->ReadLine eq "Term::ReadLine::Stub"
112 $term = Term::ReadLine->new('CPAN Monitor');
114 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
115 my $attribs = $term->Attribs;
116 $attribs->{attempted_completion_function} = sub {
117 &CPAN::Complete::gnu_cpl;
120 $readline::rl_completion_function =
121 $readline::rl_completion_function = 'CPAN::Complete::cpl';
123 if (my $histfile = $CPAN::Config->{'histfile'}) {{
124 unless ($term->can("AddHistory")) {
125 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
128 my($fh) = FileHandle->new;
129 open $fh, "<$histfile" or last;
133 $term->AddHistory($_);
137 # $term->OUT is autoflushed anyway
138 my $odef = select STDERR;
145 # no strict; # I do not recall why no strict was here (2000-09-03)
149 File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
150 File::Spec->rootdir(),
152 my $try_detect_readline;
153 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
154 my $rl_avail = $Suppress_readline ? "suppressed" :
155 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
156 "available (try 'install Bundle::CPAN')";
158 $CPAN::Frontend->myprint(
160 cpan shell -- CPAN exploration and modules installation (v%s)
167 unless $CPAN::Config->{'inhibit_startup_message'} ;
168 my($continuation) = "";
169 SHELLCOMMAND: while () {
170 if ($Suppress_readline) {
172 last SHELLCOMMAND unless defined ($_ = <> );
175 last SHELLCOMMAND unless
176 defined ($_ = $term->readline($prompt, $commandline));
178 $_ = "$continuation$_" if $continuation;
180 next SHELLCOMMAND if /^$/;
181 $_ = 'h' if /^\s*\?/;
182 if (/^(?:q(?:uit)?|bye|exit)$/i) {
193 use vars qw($import_done);
194 CPAN->import(':DEFAULT') unless $import_done++;
195 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
202 if ($] < 5.00322) { # parsewords had a bug until recently
205 eval { @line = Text::ParseWords::shellwords($_) };
206 warn($@), next SHELLCOMMAND if $@;
207 warn("Text::Parsewords could not parse the line [$_]"),
208 next SHELLCOMMAND unless @line;
210 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
211 my $command = shift @line;
212 eval { CPAN::Shell->$command(@line) };
214 if ($command =~ /^(make|test|install|force|notest)$/) {
215 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
217 soft_chdir_with_alternatives(\@cwd);
218 $CPAN::Frontend->myprint("\n");
220 $CPAN::CurrentCommandId++;
224 $commandline = ""; # I do want to be able to pass a default to
225 # shell, but on the second command I see no
228 CPAN::Queue->nullify_queue;
229 if ($try_detect_readline) {
230 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
232 $CPAN::META->has_inst("Term::ReadLine::Perl")
234 delete $INC{"Term/ReadLine.pm"};
236 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
237 require Term::ReadLine;
238 $CPAN::Frontend->myprint("\n$redef subroutines in ".
239 "Term::ReadLine redefined\n");
245 soft_chdir_with_alternatives(\@cwd);
248 sub soft_chdir_with_alternatives ($) {
250 while (not chdir $cwd->[0]) {
252 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
253 Trying to chdir to "$cwd->[1]" instead.
257 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
262 package CPAN::CacheMgr;
264 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
269 use vars qw($Ua $Thesite $ThesiteURL $Themethod);
270 @CPAN::FTP::ISA = qw(CPAN::Debug);
272 package CPAN::LWP::UserAgent;
274 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
275 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
277 package CPAN::Complete;
279 @CPAN::Complete::ISA = qw(CPAN::Debug);
280 @CPAN::Complete::COMMANDS = sort qw(
281 ! a b d h i m o q r u
303 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
304 @CPAN::Index::ISA = qw(CPAN::Debug);
307 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
310 package CPAN::InfoObj;
312 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
314 package CPAN::Author;
316 @CPAN::Author::ISA = qw(CPAN::InfoObj);
318 package CPAN::Distribution;
320 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
322 package CPAN::Bundle;
324 @CPAN::Bundle::ISA = qw(CPAN::Module);
326 package CPAN::Module;
328 @CPAN::Module::ISA = qw(CPAN::InfoObj);
330 package CPAN::Exception::RecursiveDependency;
332 use overload '""' => "as_string";
339 for my $dep (@$deps) {
341 last if $seen{$dep}++;
343 bless { deps => \@deps }, $class;
348 "\nRecursive dependency detected:\n " .
349 join("\n => ", @{$self->{deps}}) .
350 ".\nCannot continue.\n";
353 package CPAN::Prompt; use overload '""' => "as_string";
354 use vars qw($prompt);
356 $CPAN::CurrentCommandId ||= 0;
357 sub as_randomly_capitalized_string {
359 substr($prompt,$_,1)=rand()<0.5 ?
360 uc(substr($prompt,$_,1)) :
361 lc(substr($prompt,$_,1)) for 0..3;
368 if ($CPAN::Config->{commandnumber_in_prompt}) {
369 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
375 package CPAN::Distrostatus;
376 use overload '""' => "as_string",
379 my($class,$arg) = @_;
382 FAILED => substr($arg,0,2) eq "NO",
383 COMMANDID => $CPAN::CurrentCommandId,
386 sub commandid { shift->{COMMANDID} }
387 sub failed { shift->{FAILED} }
391 $self->{TEXT} = $set;
402 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
403 @CPAN::Shell::ISA = qw(CPAN::Debug);
404 $COLOR_REGISTERED ||= 0;
405 $PRINT_ORNAMENTING ||= 0;
407 #-> sub CPAN::Shell::AUTOLOAD ;
409 my($autoload) = $AUTOLOAD;
410 my $class = shift(@_);
411 # warn "autoload[$autoload] class[$class]";
412 $autoload =~ s/.*:://;
413 if ($autoload =~ /^w/) {
414 if ($CPAN::META->has_inst('CPAN::WAIT')) {
415 CPAN::WAIT->$autoload(@_);
417 $CPAN::Frontend->mywarn(qq{
418 Commands starting with "w" require CPAN::WAIT to be installed.
419 Please consider installing CPAN::WAIT to use the fulltext index.
420 For this you just need to type
425 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload'. }.
434 # One use of the queue is to determine if we should or shouldn't
435 # announce the availability of a new CPAN module
437 # Now we try to use it for dependency tracking. For that to happen
438 # we need to draw a dependency tree and do the leaves first. This can
439 # easily be reached by running CPAN.pm recursively, but we don't want
440 # to waste memory and run into deep recursion. So what we can do is
443 # CPAN::Queue is the package where the queue is maintained. Dependencies
444 # often have high priority and must be brought to the head of the queue,
445 # possibly by jumping the queue if they are already there. My first code
446 # attempt tried to be extremely correct. Whenever a module needed
447 # immediate treatment, I either unshifted it to the front of the queue,
448 # or, if it was already in the queue, I spliced and let it bypass the
449 # others. This became a too correct model that made it impossible to put
450 # an item more than once into the queue. Why would you need that? Well,
451 # you need temporary duplicates as the manager of the queue is a loop
454 # (1) looks at the first item in the queue without shifting it off
456 # (2) cares for the item
458 # (3) removes the item from the queue, *even if its agenda failed and
459 # even if the item isn't the first in the queue anymore* (that way
460 # protecting against never ending queues)
462 # So if an item has prerequisites, the installation fails now, but we
463 # want to retry later. That's easy if we have it twice in the queue.
465 # I also expect insane dependency situations where an item gets more
466 # than two lives in the queue. Simplest example is triggered by 'install
467 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
468 # get in the way. I wanted the queue manager to be a dumb servant, not
469 # one that knows everything.
471 # Who would I tell in this model that the user wants to be asked before
472 # processing? I can't attach that information to the module object,
473 # because not modules are installed but distributions. So I'd have to
474 # tell the distribution object that it should ask the user before
475 # processing. Where would the question be triggered then? Most probably
476 # in CPAN::Distribution::rematein.
477 # Hope that makes sense, my head is a bit off:-) -- AK
484 my $self = bless { qmod => $s }, $class;
489 # CPAN::Queue::first ;
495 # CPAN::Queue::delete_first ;
497 my($class,$what) = @_;
499 for my $i (0..$#All) {
500 if ( $All[$i]->{qmod} eq $what ) {
507 # CPAN::Queue::jumpqueue ;
511 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
512 join(",",map {$_->{qmod}} @All),
515 WHAT: for my $what (reverse @what) {
517 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
518 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
519 if ($All[$i]->{qmod} eq $what){
521 if ($jumped > 100) { # one's OK if e.g. just
522 # processing now; more are OK if
523 # user typed it several times
524 $CPAN::Frontend->mywarn(
525 qq{Object [$what] queued more than 100 times, ignoring}
531 my $obj = bless { qmod => $what }, $class;
534 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
535 join(",",map {$_->{qmod}} @All),
540 # CPAN::Queue::exists ;
542 my($self,$what) = @_;
543 my @all = map { $_->{qmod} } @All;
544 my $exists = grep { $_->{qmod} eq $what } @All;
545 # warn "in exists what[$what] all[@all] exists[$exists]";
549 # CPAN::Queue::delete ;
552 @All = grep { $_->{qmod} ne $mod } @All;
555 # CPAN::Queue::nullify_queue ;
565 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
567 # from here on only subs.
568 ################################################################################
570 #-> sub CPAN::all_objects ;
572 my($mgr,$class) = @_;
573 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
574 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
576 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
578 *all = \&all_objects;
580 # Called by shell, not in batch mode. In batch mode I see no risk in
581 # having many processes updating something as installations are
582 # continually checked at runtime. In shell mode I suspect it is
583 # unintentional to open more than one shell at a time
585 #-> sub CPAN::checklock ;
588 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
589 if (-f $lockfile && -M _ > 0) {
590 my $fh = FileHandle->new($lockfile) or
591 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
592 my $otherpid = <$fh>;
593 my $otherhost = <$fh>;
595 if (defined $otherpid && $otherpid) {
598 if (defined $otherhost && $otherhost) {
601 my $thishost = hostname();
602 if (defined $otherhost && defined $thishost &&
603 $otherhost ne '' && $thishost ne '' &&
604 $otherhost ne $thishost) {
605 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
606 "reports other host $otherhost and other ".
607 "process $otherpid.\n".
608 "Cannot proceed.\n"));
610 elsif (defined $otherpid && $otherpid) {
611 return if $$ == $otherpid; # should never happen
612 $CPAN::Frontend->mywarn(
614 There seems to be running another CPAN process (pid $otherpid). Contacting...
616 if (kill 0, $otherpid) {
617 $CPAN::Frontend->mydie(qq{Other job is running.
618 You may want to kill it and delete the lockfile, maybe. On UNIX try:
622 } elsif (-w $lockfile) {
624 ExtUtils::MakeMaker::prompt
625 (qq{Other job not responding. Shall I overwrite }.
626 qq{the lockfile '$lockfile'? (Y/n)},"y");
627 $CPAN::Frontend->myexit("Ok, bye\n")
628 unless $ans =~ /^y/i;
631 qq{Lockfile '$lockfile' not writeable by you. }.
632 qq{Cannot proceed.\n}.
634 qq{ rm '$lockfile'\n}.
635 qq{ and then rerun us.\n}
639 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
640 "reports other process with ID ".
641 "$otherpid. Cannot proceed.\n"));
644 my $dotcpan = $CPAN::Config->{cpan_home};
645 eval { File::Path::mkpath($dotcpan);};
647 # A special case at least for Jarkko.
652 $symlinkcpan = readlink $dotcpan;
653 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
654 eval { File::Path::mkpath($symlinkcpan); };
658 $CPAN::Frontend->mywarn(qq{
659 Working directory $symlinkcpan created.
663 unless (-d $dotcpan) {
665 Your configuration suggests "$dotcpan" as your
666 CPAN.pm working directory. I could not create this directory due
667 to this error: $firsterror\n};
669 As "$dotcpan" is a symlink to "$symlinkcpan",
670 I tried to create that, but I failed with this error: $seconderror
673 Please make sure the directory exists and is writable.
675 $CPAN::Frontend->mydie($diemess);
677 } # $@ after eval mkpath $dotcpan
679 unless ($fh = FileHandle->new(">$lockfile")) {
680 if ($! =~ /Permission/) {
681 my $incc = $INC{'CPAN/Config.pm'};
682 my $myincc = File::Spec->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
683 $CPAN::Frontend->myprint(qq{
685 Your configuration suggests that CPAN.pm should use a working
687 $CPAN::Config->{cpan_home}
688 Unfortunately we could not create the lock file
690 due to permission problems.
692 Please make sure that the configuration variable
693 \$CPAN::Config->{cpan_home}
694 points to a directory where you can write a .lock file. You can set
695 this variable in either
700 if(!$INC{'CPAN/MyConfig.pm'}) {
701 $CPAN::Frontend->myprint("You don't seem to have a user ".
702 "configuration (MyConfig.pm) yet.\n");
703 my $new = ExtUtils::MakeMaker::prompt("Do you want to create a ".
704 "user configuration now? (Y/n)",
707 CPAN::Shell->mkmyconfig();
712 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
714 $fh->print($$, "\n");
715 $fh->print(hostname(), "\n");
716 $self->{LOCK} = $lockfile;
720 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
725 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
726 print "Caught SIGINT\n";
730 # From: Larry Wall <larry@wall.org>
731 # Subject: Re: deprecating SIGDIE
732 # To: perl5-porters@perl.org
733 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
735 # The original intent of __DIE__ was only to allow you to substitute one
736 # kind of death for another on an application-wide basis without respect
737 # to whether you were in an eval or not. As a global backstop, it should
738 # not be used any more lightly (or any more heavily :-) than class
739 # UNIVERSAL. Any attempt to build a general exception model on it should
740 # be politely squashed. Any bug that causes every eval {} to have to be
741 # modified should be not so politely squashed.
743 # Those are my current opinions. It is also my optinion that polite
744 # arguments degenerate to personal arguments far too frequently, and that
745 # when they do, it's because both people wanted it to, or at least didn't
746 # sufficiently want it not to.
750 # global backstop to cleanup if we should really die
751 $SIG{__DIE__} = \&cleanup;
752 $self->debug("Signal handler set.") if $CPAN::DEBUG;
755 #-> sub CPAN::DESTROY ;
757 &cleanup; # need an eval?
760 #-> sub CPAN::anycwd ;
763 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
768 sub cwd {Cwd::cwd();}
770 #-> sub CPAN::getcwd ;
771 sub getcwd {Cwd::getcwd();}
773 #-> sub CPAN::fastcwd ;
774 sub fastcwd {Cwd::fastcwd();}
776 #-> sub CPAN::backtickcwd ;
777 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
779 #-> sub CPAN::find_perl ;
781 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
782 my $pwd = $CPAN::iCwd = CPAN::anycwd();
783 my $candidate = File::Spec->catfile($pwd,$^X);
784 $perl ||= $candidate if MM->maybe_command($candidate);
787 my ($component,$perl_name);
788 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
789 PATH_COMPONENT: foreach $component (File::Spec->path(),
790 $Config::Config{'binexp'}) {
791 next unless defined($component) && $component;
792 my($abs) = File::Spec->catfile($component,$perl_name);
793 if (MM->maybe_command($abs)) {
805 #-> sub CPAN::exists ;
807 my($mgr,$class,$id) = @_;
808 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
810 ### Carp::croak "exists called without class argument" unless $class;
812 $id =~ s/:+/::/g if $class eq "CPAN::Module";
813 exists $META->{readonly}{$class}{$id} or
814 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
817 #-> sub CPAN::delete ;
819 my($mgr,$class,$id) = @_;
820 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
821 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
824 #-> sub CPAN::has_usable
825 # has_inst is sometimes too optimistic, we should replace it with this
826 # has_usable whenever a case is given
828 my($self,$mod,$message) = @_;
829 return 1 if $HAS_USABLE->{$mod};
830 my $has_inst = $self->has_inst($mod,$message);
831 return unless $has_inst;
834 LWP => [ # we frequently had "Can't locate object
835 # method "new" via package "LWP::UserAgent" at
836 # (eval 69) line 2006
838 sub {require LWP::UserAgent},
839 sub {require HTTP::Request},
840 sub {require URI::URL},
843 sub {require Net::FTP},
844 sub {require Net::Config},
847 if ($usable->{$mod}) {
848 for my $c (0..$#{$usable->{$mod}}) {
849 my $code = $usable->{$mod}[$c];
850 my $ret = eval { &$code() };
852 warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
857 return $HAS_USABLE->{$mod} = 1;
860 #-> sub CPAN::has_inst
862 my($self,$mod,$message) = @_;
863 Carp::croak("CPAN->has_inst() called without an argument")
865 my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
866 keys %{$CPAN::Config->{dontload_hash}||{}},
867 @{$CPAN::Config->{dontload_list}||[]};
868 if (defined $message && $message eq "no" # afair only used by Nox
872 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
880 # checking %INC is wrong, because $INC{LWP} may be true
881 # although $INC{"URI/URL.pm"} may have failed. But as
882 # I really want to say "bla loaded OK", I have to somehow
884 ### warn "$file in %INC"; #debug
886 } elsif (eval { require $file }) {
887 # eval is good: if we haven't yet read the database it's
888 # perfect and if we have installed the module in the meantime,
889 # it tries again. The second require is only a NOOP returning
890 # 1 if we had success, otherwise it's retrying
892 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
893 if ($mod eq "CPAN::WAIT") {
894 push @CPAN::Shell::ISA, 'CPAN::WAIT';
897 } elsif ($mod eq "Net::FTP") {
898 $CPAN::Frontend->mywarn(qq{
899 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
901 install Bundle::libnet
903 }) unless $Have_warned->{"Net::FTP"}++;
905 } elsif ($mod eq "Digest::SHA"){
906 if ($Have_warned->{"Digest::SHA"}++) {
907 $CPAN::Frontend->myprint(qq{CPAN: checksum security checks disabled}.
908 qq{because Digest::SHA not installed.\n});
910 $CPAN::Frontend->myprint(qq{
911 CPAN: checksum security checks disabled because Digest::SHA not installed.
912 Please consider installing the Digest::SHA module.
917 } elsif ($mod eq "Module::Signature"){
918 unless ($Have_warned->{"Module::Signature"}++) {
919 # No point in complaining unless the user can
920 # reasonably install and use it.
921 if (eval { require Crypt::OpenPGP; 1 } ||
922 defined $CPAN::Config->{'gpg'}) {
923 $CPAN::Frontend->myprint(qq{
924 CPAN: Module::Signature security checks disabled because Module::Signature
925 not installed. Please consider installing the Module::Signature module.
926 You may also need to be able to connect over the Internet to the public
927 keyservers like pgp.mit.edu (port 11371).
934 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
939 #-> sub CPAN::instance ;
941 my($mgr,$class,$id) = @_;
944 # unsafe meta access, ok?
945 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
946 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
954 #-> sub CPAN::cleanup ;
956 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
957 local $SIG{__DIE__} = '';
962 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
964 $subroutine eq '(eval)';
966 return if $ineval && !$CPAN::End;
967 return unless defined $META->{LOCK};
968 return unless -f $META->{LOCK};
970 unlink $META->{LOCK};
972 # Carp::cluck("DEBUGGING");
973 $CPAN::Frontend->mywarn("Lockfile removed.\n");
976 #-> sub CPAN::savehist
979 my($histfile,$histsize);
980 unless ($histfile = $CPAN::Config->{'histfile'}){
981 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
984 $histsize = $CPAN::Config->{'histsize'} || 100;
986 unless ($CPAN::term->can("GetHistory")) {
987 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
993 my @h = $CPAN::term->GetHistory;
994 splice @h, 0, @h-$histsize if @h>$histsize;
995 my($fh) = FileHandle->new;
996 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
997 local $\ = local $, = "\n";
1003 my($self,$what) = @_;
1004 $self->{is_tested}{$what} = 1;
1008 my($self,$what) = @_;
1009 delete $self->{is_tested}{$what};
1014 $self->{is_tested} ||= {};
1015 return unless %{$self->{is_tested}};
1016 my $env = $ENV{PERL5LIB};
1017 $env = $ENV{PERLLIB} unless defined $env;
1019 push @env, $env if defined $env and length $env;
1020 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
1021 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
1022 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
1025 package CPAN::CacheMgr;
1028 #-> sub CPAN::CacheMgr::as_string ;
1030 eval { require Data::Dumper };
1032 return shift->SUPER::as_string;
1034 return Data::Dumper::Dumper(shift);
1038 #-> sub CPAN::CacheMgr::cachesize ;
1043 #-> sub CPAN::CacheMgr::tidyup ;
1046 return unless -d $self->{ID};
1047 while ($self->{DU} > $self->{'MAX'} ) {
1048 my($toremove) = shift @{$self->{FIFO}};
1049 $CPAN::Frontend->myprint(sprintf(
1050 "Deleting from cache".
1051 ": $toremove (%.1f>%.1f MB)\n",
1052 $self->{DU}, $self->{'MAX'})
1054 return if $CPAN::Signal;
1055 $self->force_clean_cache($toremove);
1056 return if $CPAN::Signal;
1060 #-> sub CPAN::CacheMgr::dir ;
1065 #-> sub CPAN::CacheMgr::entries ;
1067 my($self,$dir) = @_;
1068 return unless defined $dir;
1069 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1070 $dir ||= $self->{ID};
1071 my($cwd) = CPAN::anycwd();
1072 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1073 my $dh = DirHandle->new(File::Spec->curdir)
1074 or Carp::croak("Couldn't opendir $dir: $!");
1077 next if $_ eq "." || $_ eq "..";
1079 push @entries, File::Spec->catfile($dir,$_);
1081 push @entries, File::Spec->catdir($dir,$_);
1083 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1086 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1087 sort { -M $b <=> -M $a} @entries;
1090 #-> sub CPAN::CacheMgr::disk_usage ;
1092 my($self,$dir) = @_;
1093 return if exists $self->{SIZE}{$dir};
1094 return if $CPAN::Signal;
1098 unless (chmod 0755, $dir) {
1099 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1100 "permission to change the permission; cannot ".
1101 "estimate disk usage of '$dir'\n");
1102 $CPAN::Frontend->mysleep(5);
1107 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1108 $CPAN::Frontend->mysleep(2);
1113 $File::Find::prune++ if $CPAN::Signal;
1115 if ($^O eq 'MacOS') {
1117 my $cat = Mac::Files::FSpGetCatInfo($_);
1118 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1122 unless (chmod 0755, $_) {
1123 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1124 "the permission to change the permission; ".
1125 "can only partially estimate disk usage ".
1138 return if $CPAN::Signal;
1139 $self->{SIZE}{$dir} = $Du/1024/1024;
1140 push @{$self->{FIFO}}, $dir;
1141 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1142 $self->{DU} += $Du/1024/1024;
1146 #-> sub CPAN::CacheMgr::force_clean_cache ;
1147 sub force_clean_cache {
1148 my($self,$dir) = @_;
1149 return unless -e $dir;
1150 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1152 File::Path::rmtree($dir);
1153 $self->{DU} -= $self->{SIZE}{$dir};
1154 delete $self->{SIZE}{$dir};
1157 #-> sub CPAN::CacheMgr::new ;
1164 ID => $CPAN::Config->{'build_dir'},
1165 MAX => $CPAN::Config->{'build_cache'},
1166 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1169 File::Path::mkpath($self->{ID});
1170 my $dh = DirHandle->new($self->{ID});
1171 bless $self, $class;
1174 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1176 CPAN->debug($debug) if $CPAN::DEBUG;
1180 #-> sub CPAN::CacheMgr::scan_cache ;
1183 return if $self->{SCAN} eq 'never';
1184 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1185 unless $self->{SCAN} eq 'atstart';
1186 $CPAN::Frontend->myprint(
1187 sprintf("Scanning cache %s for sizes\n",
1190 for $e ($self->entries($self->{ID})) {
1191 next if $e eq ".." || $e eq ".";
1192 $self->disk_usage($e);
1193 return if $CPAN::Signal;
1198 package CPAN::Shell;
1201 #-> sub CPAN::Shell::h ;
1203 my($class,$about) = @_;
1204 if (defined $about) {
1205 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1207 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1208 $CPAN::Frontend->myprint(qq{
1209 Display Information $filler (ver $CPAN::VERSION)
1210 command argument description
1211 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1212 i WORD or /REGEXP/ about any of the above
1213 r NONE report updatable modules
1214 ls AUTHOR or GLOB about files in the author's directory
1215 (with WORD being a module, bundle or author name or a distribution
1216 name of the form AUTHOR/DISTRIBUTION)
1218 Download, Test, Make, Install...
1219 get download clean make clean
1220 make make (implies get) look open subshell in dist directory
1221 test make test (implies make) readme display these README files
1222 install make install (implies test) perldoc display POD documentation
1225 force COMMAND unconditionally do command
1226 notest COMMAND skip testing
1229 h,? display this menu ! perl-code eval a perl command
1230 o conf [opt] set and query options q quit the cpan shell
1231 reload cpan load CPAN.pm again reload index load newer indices
1232 autobundle Snapshot recent latest CPAN uploads});
1238 #-> sub CPAN::Shell::a ;
1240 my($self,@arg) = @_;
1241 # authors are always UPPERCASE
1243 $_ = uc $_ unless /=/;
1245 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1248 #-> sub CPAN::Shell::globls ;
1250 my($self,$s,$pragmas) = @_;
1251 # ls is really very different, but we had it once as an ordinary
1252 # command in the Shell (upto rev. 321) and we could not handle
1254 my(@accept,@preexpand);
1255 if ($s =~ /[\*\?\/]/) {
1256 if ($CPAN::META->has_inst("Text::Glob")) {
1257 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1258 my $rau = Text::Glob::glob_to_regex(uc $au);
1259 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1261 push @preexpand, map { $_->id . "/" . $pathglob }
1262 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1264 my $rau = Text::Glob::glob_to_regex(uc $s);
1265 push @preexpand, map { $_->id }
1266 CPAN::Shell->expand_by_method('CPAN::Author',
1271 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1274 push @preexpand, uc $s;
1277 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1278 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1283 my $silent = @accept>1;
1284 my $last_alpha = "";
1286 for my $a (@accept){
1287 my($author,$pathglob);
1288 if ($a =~ m|(.*?)/(.*)|) {
1291 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1293 $a2) or die "No author found for $a2";
1295 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1297 $a) or die "No author found for $a";
1300 my $alpha = substr $author->id, 0, 1;
1302 if ($alpha eq $last_alpha) {
1306 $last_alpha = $alpha;
1308 $CPAN::Frontend->myprint($ad);
1310 for my $pragma (@$pragmas) {
1311 if ($author->can($pragma)) {
1315 push @results, $author->ls($pathglob,$silent); # silent if
1318 for my $pragma (@$pragmas) {
1319 my $meth = "un$pragma";
1320 if ($author->can($meth)) {
1328 #-> sub CPAN::Shell::local_bundles ;
1330 my($self,@which) = @_;
1331 my($incdir,$bdir,$dh);
1332 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1333 my @bbase = "Bundle";
1334 while (my $bbase = shift @bbase) {
1335 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1336 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1337 if ($dh = DirHandle->new($bdir)) { # may fail
1339 for $entry ($dh->read) {
1340 next if $entry =~ /^\./;
1341 if (-d File::Spec->catdir($bdir,$entry)){
1342 push @bbase, "$bbase\::$entry";
1344 next unless $entry =~ s/\.pm(?!\n)\Z//;
1345 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1353 #-> sub CPAN::Shell::b ;
1355 my($self,@which) = @_;
1356 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1357 $self->local_bundles;
1358 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1361 #-> sub CPAN::Shell::d ;
1362 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1364 #-> sub CPAN::Shell::m ;
1365 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1367 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1370 #-> sub CPAN::Shell::i ;
1374 @args = '/./' unless @args;
1376 for my $type (qw/Bundle Distribution Module/) {
1377 push @result, $self->expand($type,@args);
1379 # Authors are always uppercase.
1380 push @result, $self->expand("Author", map { uc $_ } @args);
1382 my $result = @result == 1 ?
1383 $result[0]->as_string :
1385 "No objects found of any type for argument @args\n" :
1387 (map {$_->as_glimpse} @result),
1388 scalar @result, " items found\n",
1390 $CPAN::Frontend->myprint($result);
1393 #-> sub CPAN::Shell::o ;
1395 # CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf'
1396 # should have been called set and 'o debug' maybe 'set debug'
1398 my($self,$o_type,@o_what) = @_;
1401 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1402 if ($o_type eq 'conf') {
1403 if (!@o_what) { # print all things, "o conf"
1405 $CPAN::Frontend->myprint("CPAN::Config options");
1406 if (exists $INC{'CPAN/Config.pm'}) {
1407 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1409 if (exists $INC{'CPAN/MyConfig.pm'}) {
1410 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1412 $CPAN::Frontend->myprint(":\n");
1413 for $k (sort keys %CPAN::HandleConfig::can) {
1414 $v = $CPAN::HandleConfig::can{$k};
1415 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1417 $CPAN::Frontend->myprint("\n");
1418 for $k (sort keys %$CPAN::Config) {
1419 CPAN::HandleConfig->prettyprint($k);
1421 $CPAN::Frontend->myprint("\n");
1422 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1423 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1426 } elsif ($o_type eq 'debug') {
1428 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1431 my($what) = shift @o_what;
1432 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1433 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1436 if ( exists $CPAN::DEBUG{$what} ) {
1437 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1438 } elsif ($what =~ /^\d/) {
1439 $CPAN::DEBUG = $what;
1440 } elsif (lc $what eq 'all') {
1442 for (values %CPAN::DEBUG) {
1445 $CPAN::DEBUG = $max;
1448 for (keys %CPAN::DEBUG) {
1449 next unless lc($_) eq lc($what);
1450 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1453 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1458 my $raw = "Valid options for debug are ".
1459 join(", ",sort(keys %CPAN::DEBUG), 'all').
1460 qq{ or a number. Completion works on the options. }.
1461 qq{Case is ignored.};
1463 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1464 $CPAN::Frontend->myprint("\n\n");
1467 $CPAN::Frontend->myprint("Options set for debugging:\n");
1469 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1470 $v = $CPAN::DEBUG{$k};
1471 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1472 if $v & $CPAN::DEBUG;
1475 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1478 $CPAN::Frontend->myprint(qq{
1480 conf set or get configuration variables
1481 debug set or get debugging options
1486 sub paintdots_onreload {
1489 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1493 # $CPAN::Frontend->myprint(".($subr)");
1494 $CPAN::Frontend->myprint(".");
1501 #-> sub CPAN::Shell::reload ;
1503 my($self,$command,@arg) = @_;
1505 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1506 if ($command =~ /cpan/i) {
1508 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1510 MFILE: for my $f (qw(CPAN.pm CPAN/HandleConfig.pm CPAN/FirstTime.pm CPAN/Tarzip.pm
1511 CPAN/Debug.pm CPAN/Version.pm)) {
1512 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1513 $self->reload_this($f) or $failed++;
1515 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1516 $failed++ unless $redef;
1518 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1521 } elsif ($command =~ /index/) {
1522 CPAN::Index->force_reload;
1524 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1525 index re-reads the index files\n});
1531 return 1 unless $INC{$f};
1532 my $pwd = CPAN::anycwd();
1533 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1536 for my $inc (@INC) {
1537 $read = File::Spec->catfile($inc,split /\//, $f);
1544 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1547 my $fh = FileHandle->new($read) or
1548 $CPAN::Frontend->mydie("Could not open $read: $!");
1552 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1562 #-> sub CPAN::Shell::mkmyconfig ;
1564 my($self, $cpanpm, %args) = @_;
1565 require CPAN::FirstTime;
1566 $cpanpm = $INC{'CPAN/MyConfig.pm'} || "$ENV{HOME}/.cpan/CPAN/MyConfig.pm";
1567 File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
1568 if(!$INC{'CPAN/Config.pm'}) {
1569 eval { require CPAN::Config; };
1571 $CPAN::Config ||= {};
1576 keep_source_where => undef,
1579 CPAN::FirstTime::init($cpanpm, %args);
1582 #-> sub CPAN::Shell::_binary_extensions ;
1583 sub _binary_extensions {
1584 my($self) = shift @_;
1585 my(@result,$module,%seen,%need,$headerdone);
1586 for $module ($self->expand('Module','/./')) {
1587 my $file = $module->cpan_file;
1588 next if $file eq "N/A";
1589 next if $file =~ /^Contact Author/;
1590 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1591 next if $dist->isa_perl;
1592 next unless $module->xs_file;
1594 $CPAN::Frontend->myprint(".");
1595 push @result, $module;
1597 # print join " | ", @result;
1598 $CPAN::Frontend->myprint("\n");
1602 #-> sub CPAN::Shell::recompile ;
1604 my($self) = shift @_;
1605 my($module,@module,$cpan_file,%dist);
1606 @module = $self->_binary_extensions();
1607 for $module (@module){ # we force now and compile later, so we
1609 $cpan_file = $module->cpan_file;
1610 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1612 $dist{$cpan_file}++;
1614 for $cpan_file (sort keys %dist) {
1615 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1616 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1618 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1619 # stop a package from recompiling,
1620 # e.g. IO-1.12 when we have perl5.003_10
1624 #-> sub CPAN::Shell::_u_r_common ;
1626 my($self) = shift @_;
1627 my($what) = shift @_;
1628 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1629 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1630 $what && $what =~ /^[aru]$/;
1632 @args = '/./' unless @args;
1633 my(@result,$module,%seen,%need,$headerdone,
1634 $version_undefs,$version_zeroes);
1635 $version_undefs = $version_zeroes = 0;
1636 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1637 my @expand = $self->expand('Module',@args);
1638 my $expand = scalar @expand;
1639 if (0) { # Looks like noise to me, was very useful for debugging
1640 # for metadata cache
1641 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1643 MODULE: for $module (@expand) {
1644 my $file = $module->cpan_file;
1645 next MODULE unless defined $file; # ??
1646 $file =~ s|^./../||;
1647 my($latest) = $module->cpan_version;
1648 my($inst_file) = $module->inst_file;
1650 return if $CPAN::Signal;
1653 $have = $module->inst_version;
1654 } elsif ($what eq "r") {
1655 $have = $module->inst_version;
1657 if ($have eq "undef"){
1659 } elsif ($have == 0){
1662 next MODULE unless CPAN::Version->vgt($latest, $have);
1663 # to be pedantic we should probably say:
1664 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1665 # to catch the case where CPAN has a version 0 and we have a version undef
1666 } elsif ($what eq "u") {
1672 } elsif ($what eq "r") {
1674 } elsif ($what eq "u") {
1678 return if $CPAN::Signal; # this is sometimes lengthy
1681 push @result, sprintf "%s %s\n", $module->id, $have;
1682 } elsif ($what eq "r") {
1683 push @result, $module->id;
1684 next MODULE if $seen{$file}++;
1685 } elsif ($what eq "u") {
1686 push @result, $module->id;
1687 next MODULE if $seen{$file}++;
1688 next MODULE if $file =~ /^Contact/;
1690 unless ($headerdone++){
1691 $CPAN::Frontend->myprint("\n");
1692 $CPAN::Frontend->myprint(sprintf(
1695 "Package namespace",
1707 $CPAN::META->has_inst("Term::ANSIColor")
1709 $module->description
1711 $color_on = Term::ANSIColor::color("green");
1712 $color_off = Term::ANSIColor::color("reset");
1714 $CPAN::Frontend->myprint(sprintf $sprintf,
1721 $need{$module->id}++;
1725 $CPAN::Frontend->myprint("No modules found for @args\n");
1726 } elsif ($what eq "r") {
1727 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1731 if ($version_zeroes) {
1732 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1733 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1734 qq{a version number of 0\n});
1736 if ($version_undefs) {
1737 my $s_has = $version_undefs > 1 ? "s have" : " has";
1738 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1739 qq{parseable version number\n});
1745 #-> sub CPAN::Shell::r ;
1747 shift->_u_r_common("r",@_);
1750 #-> sub CPAN::Shell::u ;
1752 shift->_u_r_common("u",@_);
1755 #-> sub CPAN::Shell::failed ;
1757 my($self,$only_id,$silent) = @_;
1759 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1768 next unless exists $d->{$nosayer};
1770 $d->{$nosayer}->can("failed") ?
1771 $d->{$nosayer}->failed :
1772 $d->{$nosayer} =~ /^NO/
1777 next DIST unless $failed;
1778 next DIST if $only_id && $only_id != (
1779 $d->{$failed}->can("commandid")
1781 $d->{$failed}->commandid
1783 $CPAN::CurrentCommandId
1788 # " %-45s: %s %s\n",
1791 $d->{$failed}->can("failed") ?
1793 $d->{$failed}->commandid,
1796 $d->{$failed}->text,
1806 my $scope = $only_id ? "command" : "session";
1808 my $print = join "",
1809 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1810 sort { $a->[0] <=> $b->[0] } @failed;
1811 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1812 } elsif (!$only_id || !$silent) {
1813 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1817 # XXX intentionally undocumented because completely bogus, unportable,
1820 #-> sub CPAN::Shell::status ;
1823 require Devel::Size;
1824 my $ps = FileHandle->new;
1825 open $ps, "/proc/$$/status";
1828 next unless /VmSize:\s+(\d+)/;
1832 $CPAN::Frontend->mywarn(sprintf(
1833 "%-27s %6d\n%-27s %6d\n",
1837 Devel::Size::total_size($CPAN::META)/1024,
1839 for my $k (sort keys %$CPAN::META) {
1840 next unless substr($k,0,4) eq "read";
1841 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
1842 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
1843 warn sprintf " %-25s %6d %6d\n",
1845 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
1846 scalar keys %{$CPAN::META->{$k}{$k2}};
1851 #-> sub CPAN::Shell::autobundle ;
1854 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1855 my(@bundle) = $self->_u_r_common("a",@_);
1856 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1857 File::Path::mkpath($todir);
1858 unless (-d $todir) {
1859 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1862 my($y,$m,$d) = (localtime)[5,4,3];
1866 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1867 my($to) = File::Spec->catfile($todir,"$me.pm");
1869 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1870 $to = File::Spec->catfile($todir,"$me.pm");
1872 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1874 "package Bundle::$me;\n\n",
1875 "\$VERSION = '0.01';\n\n",
1879 "Bundle::$me - Snapshot of installation on ",
1880 $Config::Config{'myhostname'},
1883 "\n\n=head1 SYNOPSIS\n\n",
1884 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1885 "=head1 CONTENTS\n\n",
1886 join("\n", @bundle),
1887 "\n\n=head1 CONFIGURATION\n\n",
1889 "\n\n=head1 AUTHOR\n\n",
1890 "This Bundle has been generated automatically ",
1891 "by the autobundle routine in CPAN.pm.\n",
1894 $CPAN::Frontend->myprint("\nWrote bundle file
1898 #-> sub CPAN::Shell::expandany ;
1901 CPAN->debug("s[$s]") if $CPAN::DEBUG;
1902 if ($s =~ m|/|) { # looks like a file
1903 $s = CPAN::Distribution->normalize($s);
1904 return $CPAN::META->instance('CPAN::Distribution',$s);
1905 # Distributions spring into existence, not expand
1906 } elsif ($s =~ m|^Bundle::|) {
1907 $self->local_bundles; # scanning so late for bundles seems
1908 # both attractive and crumpy: always
1909 # current state but easy to forget
1911 return $self->expand('Bundle',$s);
1913 return $self->expand('Module',$s)
1914 if $CPAN::META->exists('CPAN::Module',$s);
1919 #-> sub CPAN::Shell::expand ;
1922 my($type,@args) = @_;
1923 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
1924 my $class = "CPAN::$type";
1925 my $methods = ['id'];
1926 for my $meth (qw(name)) {
1927 next if $] < 5.00303; # no "can"
1928 next unless $class->can($meth);
1929 push @$methods, $meth;
1931 $self->expand_by_method($class,$methods,@args);
1934 sub expand_by_method {
1936 my($class,$methods,@args) = @_;
1939 my($regex,$command);
1940 if ($arg =~ m|^/(.*)/$|) {
1942 } elsif ($arg =~ m/=/) {
1946 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
1948 defined $regex ? $regex : "UNDEFINED",
1949 defined $command ? $command : "UNDEFINED",
1951 if (defined $regex) {
1953 $CPAN::META->all_objects($class)
1956 # BUG, we got an empty object somewhere
1957 require Data::Dumper;
1958 CPAN->debug(sprintf(
1959 "Bug in CPAN: Empty id on obj[%s][%s]",
1961 Data::Dumper::Dumper($obj)
1965 for my $method (@$methods) {
1966 if ($obj->$method() =~ /$regex/i) {
1972 } elsif ($command) {
1973 die "equal sign in command disabled (immature interface), ".
1975 ! \$CPAN::Shell::ADVANCED_QUERY=1
1976 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
1977 that may go away anytime.\n"
1978 unless $ADVANCED_QUERY;
1979 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
1980 my($matchcrit) = $criterion =~ m/^~(.+)/;
1984 $CPAN::META->all_objects($class)
1986 my $lhs = $self->$method() or next; # () for 5.00503
1988 push @m, $self if $lhs =~ m/$matchcrit/;
1990 push @m, $self if $lhs eq $criterion;
1995 if ( $class eq 'CPAN::Bundle' ) {
1996 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1997 } elsif ($class eq "CPAN::Distribution") {
1998 $xarg = CPAN::Distribution->normalize($arg);
2002 if ($CPAN::META->exists($class,$xarg)) {
2003 $obj = $CPAN::META->instance($class,$xarg);
2004 } elsif ($CPAN::META->exists($class,$arg)) {
2005 $obj = $CPAN::META->instance($class,$arg);
2012 @m = sort {$a->id cmp $b->id} @m;
2013 if ( $CPAN::DEBUG ) {
2014 my $wantarray = wantarray;
2015 my $join_m = join ",", map {$_->id} @m;
2016 $self->debug("wantarray[$wantarray]join_m[$join_m]");
2018 return wantarray ? @m : $m[0];
2021 #-> sub CPAN::Shell::format_result ;
2024 my($type,@args) = @_;
2025 @args = '/./' unless @args;
2026 my(@result) = $self->expand($type,@args);
2027 my $result = @result == 1 ?
2028 $result[0]->as_string :
2030 "No objects of type $type found for argument @args\n" :
2032 (map {$_->as_glimpse} @result),
2033 scalar @result, " items found\n",
2038 #-> sub CPAN::Shell::report_fh ;
2040 my $installation_report_fh;
2041 my $previously_noticed = 0;
2044 return $installation_report_fh if $installation_report_fh;
2045 if ($CPAN::META->has_inst("File::Temp")) {
2046 $installation_report_fh
2048 template => 'cpan_install_XXXX',
2053 unless ( $installation_report_fh ) {
2054 warn("Couldn't open installation report file; " .
2055 "no report file will be generated."
2056 ) unless $previously_noticed++;
2062 # The only reason for this method is currently to have a reliable
2063 # debugging utility that reveals which output is going through which
2064 # channel. No, I don't like the colors ;-)
2066 #-> sub CPAN::Shell::print_ornameted ;
2067 sub print_ornamented {
2068 my($self,$what,$ornament) = @_;
2070 return unless defined $what;
2072 local $| = 1; # Flush immediately
2073 if ( $CPAN::Be_Silent ) {
2074 print {report_fh()} $what;
2078 if ($CPAN::Config->{term_is_latin}){
2081 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
2083 if ($PRINT_ORNAMENTING) {
2084 unless (defined &color) {
2085 if ($CPAN::META->has_inst("Term::ANSIColor")) {
2086 import Term::ANSIColor "color";
2088 *color = sub { return "" };
2092 for $line (split /\n/, $what) {
2093 $longest = length($line) if length($line) > $longest;
2095 my $sprintf = "%-" . $longest . "s";
2097 $what =~ s/(.*\n?)//m;
2100 my($nl) = chomp $line ? "\n" : "";
2101 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
2102 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
2106 # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
2112 my($self,$what) = @_;
2114 $self->print_ornamented($what, 'bold blue on_yellow');
2118 my($self,$what) = @_;
2119 $self->myprint($what);
2124 my($self,$what) = @_;
2125 $self->print_ornamented($what, 'bold red on_yellow');
2129 # my($self,$what) = @_;
2130 # $self->print_ornamented($what, 'bold red on_white');
2131 # Carp::confess "died";
2135 my($self,$what) = @_;
2136 $self->print_ornamented($what, 'bold red on_white');
2140 # use this only for unrecoverable errors!
2141 sub unrecoverable_error {
2142 my($self,$what) = @_;
2143 my @lines = split /\n/, $what;
2145 for my $l (@lines) {
2146 $longest = length $l if length $l > $longest;
2148 $longest = 62 if $longest > 62;
2149 for my $l (@lines) {
2155 if (length $l < 66) {
2156 $l = pack "A66 A*", $l, "<==";
2160 unshift @lines, "\n";
2161 $self->mydie(join "", @lines);
2166 my($self, $sleep) = @_;
2171 return if -t STDOUT;
2172 my $odef = select STDERR;
2179 #-> sub CPAN::Shell::rematein ;
2180 # RE-adme||MA-ke||TE-st||IN-stall
2183 my($meth,@some) = @_;
2185 while($meth =~ /^(force|notest)$/) {
2186 push @pragma, $meth;
2187 $meth = shift @some or
2188 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2192 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2194 # Here is the place to set "test_count" on all involved parties to
2195 # 0. We then can pass this counter on to the involved
2196 # distributions and those can refuse to test if test_count > X. In
2197 # the first stab at it we could use a 1 for "X".
2199 # But when do I reset the distributions to start with 0 again?
2200 # Jost suggested to have a random or cycling interaction ID that
2201 # we pass through. But the ID is something that is just left lying
2202 # around in addition to the counter, so I'd prefer to set the
2203 # counter to 0 now, and repeat at the end of the loop. But what
2204 # about dependencies? They appear later and are not reset, they
2205 # enter the queue but not its copy. How do they get a sensible
2208 # construct the queue
2210 STHING: foreach $s (@some) {
2213 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2215 } elsif ($s =~ m|^/|) { # looks like a regexp
2216 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2220 } elsif ($meth eq "ls") {
2221 $self->globls($s,\@pragma);
2224 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2225 $obj = CPAN::Shell->expandany($s);
2228 $obj->color_cmd_tmps(0,1);
2229 CPAN::Queue->new($obj->id);
2231 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2232 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2233 if ($meth =~ /^(dump|ls)$/) {
2236 $CPAN::Frontend->myprint(
2238 "Don't be silly, you can't $meth ",
2246 ->myprint(qq{Warning: Cannot $meth $s, }.
2247 qq{don\'t know what it is.
2252 to find objects with matching identifiers.
2258 # queuerunner (please be warned: when I started to change the
2259 # queue to hold objects instead of names, I made one or two
2260 # mistakes and never found which. I reverted back instead)
2261 while ($s = CPAN::Queue->first) {
2264 $obj = $s; # I do not believe, we would survive if this happened
2266 $obj = CPAN::Shell->expandany($s);
2268 for my $pragma (@pragma) {
2271 ($] < 5.00303 || $obj->can($pragma))){
2272 ### compatibility with 5.003
2273 $obj->$pragma($meth); # the pragma "force" in
2274 # "CPAN::Distribution" must know
2275 # what we are intending
2278 if ($]>=5.00303 && $obj->can('called_for')) {
2279 $obj->called_for($s);
2282 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string\[}.
2288 CPAN::Queue->delete($s);
2290 CPAN->debug("failed");
2294 CPAN::Queue->delete_first($s);
2296 for my $obj (@qcopy) {
2297 $obj->color_cmd_tmps(0,0);
2298 delete $obj->{incommandcolor};
2302 #-> sub CPAN::Shell::recent ;
2306 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2311 # set up the dispatching methods
2313 for my $command (qw(
2328 *$command = sub { shift->rematein($command, @_); };
2332 package CPAN::LWP::UserAgent;
2336 return if $SETUPDONE;
2337 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2338 require LWP::UserAgent;
2339 @ISA = qw(Exporter LWP::UserAgent);
2342 $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
2346 sub get_basic_credentials {
2347 my($self, $realm, $uri, $proxy) = @_;
2348 return unless $proxy;
2349 if ($USER && $PASSWD) {
2350 } elsif (defined $CPAN::Config->{proxy_user} &&
2351 defined $CPAN::Config->{proxy_pass}) {
2352 $USER = $CPAN::Config->{proxy_user};
2353 $PASSWD = $CPAN::Config->{proxy_pass};
2355 require ExtUtils::MakeMaker;
2356 ExtUtils::MakeMaker->import(qw(prompt));
2357 $USER = prompt("Proxy authentication needed!
2358 (Note: to permanently configure username and password run
2359 o conf proxy_user your_username
2360 o conf proxy_pass your_password
2362 if ($CPAN::META->has_inst("Term::ReadKey")) {
2363 Term::ReadKey::ReadMode("noecho");
2365 $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n");
2367 $PASSWD = prompt("Password:");
2368 if ($CPAN::META->has_inst("Term::ReadKey")) {
2369 Term::ReadKey::ReadMode("restore");
2371 $CPAN::Frontend->myprint("\n\n");
2373 return($USER,$PASSWD);
2376 # mirror(): Its purpose is to deal with proxy authentication. When we
2377 # call SUPER::mirror, we relly call the mirror method in
2378 # LWP::UserAgent. LWP::UserAgent will then call
2379 # $self->get_basic_credentials or some equivalent and this will be
2380 # $self->dispatched to our own get_basic_credentials method.
2382 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2384 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2385 # although we have gone through our get_basic_credentials, the proxy
2386 # server refuses to connect. This could be a case where the username or
2387 # password has changed in the meantime, so I'm trying once again without
2388 # $USER and $PASSWD to give the get_basic_credentials routine another
2389 # chance to set $USER and $PASSWD.
2391 # mirror(): Its purpose is to deal with proxy authentication. When we
2392 # call SUPER::mirror, we relly call the mirror method in
2393 # LWP::UserAgent. LWP::UserAgent will then call
2394 # $self->get_basic_credentials or some equivalent and this will be
2395 # $self->dispatched to our own get_basic_credentials method.
2397 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2399 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2400 # although we have gone through our get_basic_credentials, the proxy
2401 # server refuses to connect. This could be a case where the username or
2402 # password has changed in the meantime, so I'm trying once again without
2403 # $USER and $PASSWD to give the get_basic_credentials routine another
2404 # chance to set $USER and $PASSWD.
2407 my($self,$url,$aslocal) = @_;
2408 my $result = $self->SUPER::mirror($url,$aslocal);
2409 if ($result->code == 407) {
2412 $result = $self->SUPER::mirror($url,$aslocal);
2420 #-> sub CPAN::FTP::ftp_get ;
2422 my($class,$host,$dir,$file,$target) = @_;
2424 qq[Going to fetch file [$file] from dir [$dir]
2425 on host [$host] as local [$target]\n]
2427 my $ftp = Net::FTP->new($host);
2429 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2432 return 0 unless defined $ftp;
2433 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2434 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2435 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2436 my $msg = $ftp->message;
2437 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2440 unless ( $ftp->cwd($dir) ){
2441 my $msg = $ftp->message;
2442 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2446 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2447 unless ( $ftp->get($file,$target) ){
2448 my $msg = $ftp->message;
2449 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2452 $ftp->quit; # it's ok if this fails
2456 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2458 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2459 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2461 # > *** 1562,1567 ****
2462 # > --- 1562,1580 ----
2463 # > return 1 if substr($url,0,4) eq "file";
2464 # > return 1 unless $url =~ m|://([^/]+)|;
2466 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2468 # > + $proxy =~ m|://([^/:]+)|;
2470 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2471 # > + if ($noproxy) {
2472 # > + if ($host !~ /$noproxy$/) {
2473 # > + $host = $proxy;
2476 # > + $host = $proxy;
2479 # > require Net::Ping;
2480 # > return 1 unless $Net::Ping::VERSION >= 2;
2484 #-> sub CPAN::FTP::localize ;
2486 my($self,$file,$aslocal,$force) = @_;
2488 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2489 unless defined $aslocal;
2490 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2493 if ($^O eq 'MacOS') {
2494 # Comment by AK on 2000-09-03: Uniq short filenames would be
2495 # available in CHECKSUMS file
2496 my($name, $path) = File::Basename::fileparse($aslocal, '');
2497 if (length($name) > 31) {
2508 my $size = 31 - length($suf);
2509 while (length($name) > $size) {
2513 $aslocal = File::Spec->catfile($path, $name);
2517 if (-f $aslocal && -r _ && !($force & 1)){
2521 # empty file from a previous unsuccessful attempt to download it
2523 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I could not remove.");
2528 rename $aslocal, "$aslocal.bak";
2532 my($aslocal_dir) = File::Basename::dirname($aslocal);
2533 File::Path::mkpath($aslocal_dir);
2534 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2535 qq{directory "$aslocal_dir".
2536 I\'ll continue, but if you encounter problems, they may be due
2537 to insufficient permissions.\n}) unless -w $aslocal_dir;
2539 # Inheritance is not easier to manage than a few if/else branches
2540 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2542 CPAN::LWP::UserAgent->config;
2543 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2545 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2549 $Ua->proxy('ftp', $var)
2550 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2551 $Ua->proxy('http', $var)
2552 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2555 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2557 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2558 # > use ones that require basic autorization.
2560 # > Example of when I use it manually in my own stuff:
2562 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2563 # > $req->proxy_authorization_basic("username","password");
2564 # > $res = $ua->request($req);
2568 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2572 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2573 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2576 # Try the list of urls for each single object. We keep a record
2577 # where we did get a file from
2578 my(@reordered,$last);
2579 $CPAN::Config->{urllist} ||= [];
2580 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2581 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2582 $CPAN::Config->{urllist} = [];
2584 $last = $#{$CPAN::Config->{urllist}};
2585 if ($force & 2) { # local cpans probably out of date, don't reorder
2586 @reordered = (0..$last);
2590 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2592 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2594 defined($ThesiteURL)
2596 ($CPAN::Config->{urllist}[$b] eq $ThesiteURL)
2598 ($CPAN::Config->{urllist}[$a] eq $ThesiteURL)
2603 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2605 @levels = qw/easy hard hardest/;
2607 @levels = qw/easy/ if $^O eq 'MacOS';
2609 local $ENV{FTP_PASSIVE} =
2610 exists $CPAN::Config->{ftp_passive} ?
2611 $CPAN::Config->{ftp_passive} : 1;
2612 for $levelno (0..$#levels) {
2613 my $level = $levels[$levelno];
2614 my $method = "host$level";
2615 my @host_seq = $level eq "easy" ?
2616 @reordered : 0..$last; # reordered has CDROM up front
2617 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2618 for my $u (@urllist) {
2619 $u .= "/" unless substr($u,-1) eq "/";
2621 for my $u (@CPAN::Defaultsites) {
2622 push @urllist, $u unless grep { $_ eq $u } @urllist;
2624 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2625 my $ret = $self->$method(\@urllist,$file,$aslocal);
2627 $Themethod = $level;
2629 # utime $now, $now, $aslocal; # too bad, if we do that, we
2630 # might alter a local mirror
2631 $self->debug("level[$level]") if $CPAN::DEBUG;
2635 last if $CPAN::Signal; # need to cleanup
2638 unless ($CPAN::Signal) {
2641 qq{Please check, if the URLs I found in your configuration file \(}.
2642 join(", ", @{$CPAN::Config->{urllist}}).
2643 qq{\) are valid. The urllist can be edited.},
2644 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2645 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2647 $CPAN::Frontend->myprint("Could not fetch $file\n");
2650 rename "$aslocal.bak", $aslocal;
2651 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2652 $self->ls($aslocal));
2658 # package CPAN::FTP;
2660 my($self,$host_seq,$file,$aslocal) = @_;
2662 HOSTEASY: for $ro_url (@$host_seq) {
2663 my $url .= "$ro_url$file";
2664 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2665 if ($url =~ /^file:/) {
2667 if ($CPAN::META->has_inst('URI::URL')) {
2668 my $u = URI::URL->new($url);
2670 } else { # works only on Unix, is poorly constructed, but
2671 # hopefully better than nothing.
2672 # RFC 1738 says fileurl BNF is
2673 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2674 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2676 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2677 $l =~ s|^file:||; # assume they
2681 if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
2683 $self->debug("local file[$l]") if $CPAN::DEBUG;
2684 if ( -f $l && -r _) {
2685 $ThesiteURL = $ro_url;
2688 if ($l =~ /(.+)\.gz$/) {
2690 if ( -f $ungz && -r _) {
2691 $ThesiteURL = $ro_url;
2695 # Maybe mirror has compressed it?
2697 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2698 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2700 $ThesiteURL = $ro_url;
2705 if ($CPAN::META->has_usable('LWP')) {
2706 $CPAN::Frontend->myprint("Fetching with LWP:
2710 CPAN::LWP::UserAgent->config;
2711 eval { $Ua = CPAN::LWP::UserAgent->new; };
2713 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2716 my $res = $Ua->mirror($url, $aslocal);
2717 if ($res->is_success) {
2718 $ThesiteURL = $ro_url;
2720 utime $now, $now, $aslocal; # download time is more
2721 # important than upload time
2723 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2724 my $gzurl = "$url.gz";
2725 $CPAN::Frontend->myprint("Fetching with LWP:
2728 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2729 if ($res->is_success &&
2730 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
2732 $ThesiteURL = $ro_url;
2736 $CPAN::Frontend->myprint(sprintf(
2737 "LWP failed with code[%s] message[%s]\n",
2741 # Alan Burlison informed me that in firewall environments
2742 # Net::FTP can still succeed where LWP fails. So we do not
2743 # skip Net::FTP anymore when LWP is available.
2746 $CPAN::Frontend->myprint("LWP not available\n");
2748 return if $CPAN::Signal;
2749 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2750 # that's the nice and easy way thanks to Graham
2751 my($host,$dir,$getfile) = ($1,$2,$3);
2752 if ($CPAN::META->has_usable('Net::FTP')) {
2754 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2757 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2758 "aslocal[$aslocal]") if $CPAN::DEBUG;
2759 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2760 $ThesiteURL = $ro_url;
2763 if ($aslocal !~ /\.gz(?!\n)\Z/) {
2764 my $gz = "$aslocal.gz";
2765 $CPAN::Frontend->myprint("Fetching with Net::FTP
2768 if (CPAN::FTP->ftp_get($host,
2772 CPAN::Tarzip->new($gz)->gunzip($aslocal)
2774 $ThesiteURL = $ro_url;
2781 return if $CPAN::Signal;
2785 # package CPAN::FTP;
2787 my($self,$host_seq,$file,$aslocal) = @_;
2789 # Came back if Net::FTP couldn't establish connection (or
2790 # failed otherwise) Maybe they are behind a firewall, but they
2791 # gave us a socksified (or other) ftp program...
2794 my($devnull) = $CPAN::Config->{devnull} || "";
2796 my($aslocal_dir) = File::Basename::dirname($aslocal);
2797 File::Path::mkpath($aslocal_dir);
2798 HOSTHARD: for $ro_url (@$host_seq) {
2799 my $url = "$ro_url$file";
2800 my($proto,$host,$dir,$getfile);
2802 # Courtesy Mark Conty mark_conty@cargill.com change from
2803 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2805 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2806 # proto not yet used
2807 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2809 next HOSTHARD; # who said, we could ftp anything except ftp?
2811 next HOSTHARD if $proto eq "file"; # file URLs would have had
2812 # success above. Likely a bogus URL
2814 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2816 # Try the most capable first and leave ncftp* for last as it only
2818 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
2819 my $funkyftp = $CPAN::Config->{$f};
2820 next unless defined $funkyftp;
2821 next if $funkyftp =~ /^\s*$/;
2823 my($asl_ungz, $asl_gz);
2824 ($asl_ungz = $aslocal) =~ s/\.gz//;
2825 $asl_gz = "$asl_ungz.gz";
2827 my($src_switch) = "";
2829 my($stdout_redir) = " > $asl_ungz";
2831 $src_switch = " -source";
2832 } elsif ($f eq "ncftp"){
2833 $src_switch = " -c";
2834 } elsif ($f eq "wget"){
2835 $src_switch = " -O $asl_ungz";
2837 } elsif ($f eq 'curl'){
2838 $src_switch = ' -L -f -s -S --netrc-optional';
2841 if ($f eq "ncftpget"){
2842 $chdir = "cd $aslocal_dir && ";
2845 $CPAN::Frontend->myprint(
2847 Trying with "$funkyftp$src_switch" to get
2851 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
2852 $self->debug("system[$system]") if $CPAN::DEBUG;
2853 my($wstatus) = system($system);
2855 # lynx returns 0 when it fails somewhere
2857 my $content = do { local *FH; open FH, $asl_ungz or die; local $/; <FH> };
2858 if ($content =~ /^<.*<title>[45]/si) {
2859 $CPAN::Frontend->myprint(qq{
2860 No success, the file that lynx has has downloaded looks like an error message:
2863 $CPAN::Frontend->mysleep(1);
2867 $CPAN::Frontend->myprint(qq{
2868 No success, the file that lynx has has downloaded is an empty file.
2873 if ($wstatus == 0) {
2876 } elsif ($asl_ungz ne $aslocal) {
2877 # test gzip integrity
2878 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
2879 # e.g. foo.tar is gzipped --> foo.tar.gz
2880 rename $asl_ungz, $aslocal;
2882 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
2885 $ThesiteURL = $ro_url;
2887 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2889 -f $asl_ungz && -s _ == 0;
2890 my $gz = "$aslocal.gz";
2891 my $gzurl = "$url.gz";
2892 $CPAN::Frontend->myprint(
2894 Trying with "$funkyftp$src_switch" to get
2897 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
2898 $self->debug("system[$system]") if $CPAN::DEBUG;
2900 if (($wstatus = system($system)) == 0
2904 # test gzip integrity
2905 my $ct = CPAN::Tarzip->new($asl_gz);
2907 $ct->gunzip($aslocal);
2909 # somebody uncompressed file for us?
2910 rename $asl_ungz, $aslocal;
2912 $ThesiteURL = $ro_url;
2915 unlink $asl_gz if -f $asl_gz;
2918 my $estatus = $wstatus >> 8;
2919 my $size = -f $aslocal ?
2920 ", left\n$aslocal with size ".-s _ :
2921 "\nWarning: expected file [$aslocal] doesn't exist";
2922 $CPAN::Frontend->myprint(qq{
2923 System call "$system"
2924 returned status $estatus (wstat $wstatus)$size
2927 return if $CPAN::Signal;
2928 } # transfer programs
2932 # package CPAN::FTP;
2934 my($self,$host_seq,$file,$aslocal) = @_;
2937 my($aslocal_dir) = File::Basename::dirname($aslocal);
2938 File::Path::mkpath($aslocal_dir);
2939 my $ftpbin = $CPAN::Config->{ftp};
2940 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
2941 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2944 $CPAN::Frontend->myprint(qq{
2945 As a last ressort we now switch to the external ftp command '$ftpbin'
2948 Doing so often leads to problems that are hard to diagnose, even endless
2949 loops may be encountered.
2951 If you're victim of such problems, please consider unsetting the ftp
2952 config variable with
2958 $CPAN::Frontend->mysleep(4);
2959 HOSTHARDEST: for $ro_url (@$host_seq) {
2960 my $url = "$ro_url$file";
2961 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2962 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2965 my($host,$dir,$getfile) = ($1,$2,$3);
2967 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2968 $ctime,$blksize,$blocks) = stat($aslocal);
2969 $timestamp = $mtime ||= 0;
2970 my($netrc) = CPAN::FTP::netrc->new;
2971 my($netrcfile) = $netrc->netrc;
2972 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2973 my $targetfile = File::Basename::basename($aslocal);
2979 map("cd $_", split /\//, $dir), # RFC 1738
2981 "get $getfile $targetfile",
2985 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2986 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2987 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2989 $netrc->contains($host))) if $CPAN::DEBUG;
2990 if ($netrc->protected) {
2991 my $dialog = join "", map { " $_\n" } @dialog;
2993 if ($netrc->contains($host)) {
2994 $netrc_explain = "Relying that your .netrc entry for '$host' ".
2995 "manages the login";
2997 $netrc_explain = "Relying that your default .netrc entry ".
2998 "manages the login";
3000 $CPAN::Frontend->myprint(qq{
3001 Trying with external ftp to get
3004 Going to send the dialog
3008 $self->talk_ftp("$ftpbin$verbose $host",
3010 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3011 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3013 if ($mtime > $timestamp) {
3014 $CPAN::Frontend->myprint("GOT $aslocal\n");
3015 $ThesiteURL = $ro_url;
3018 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
3020 return if $CPAN::Signal;
3022 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
3023 qq{correctly protected.\n});
3026 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
3027 nor does it have a default entry\n");
3030 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
3031 # then and login manually to host, using e-mail as
3033 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
3037 "user anonymous $Config::Config{'cf_email'}"
3039 my $dialog = join "", map { " $_\n" } @dialog;
3040 $CPAN::Frontend->myprint(qq{
3041 Trying with external ftp to get
3043 Going to send the dialog
3047 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
3048 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3049 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
3051 if ($mtime > $timestamp) {
3052 $CPAN::Frontend->myprint("GOT $aslocal\n");
3053 $ThesiteURL = $ro_url;
3056 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
3058 return if $CPAN::Signal;
3059 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
3064 # package CPAN::FTP;
3066 my($self,$command,@dialog) = @_;
3067 my $fh = FileHandle->new;
3068 $fh->open("|$command") or die "Couldn't open ftp: $!";
3069 foreach (@dialog) { $fh->print("$_\n") }
3070 $fh->close; # Wait for process to complete
3072 my $estatus = $wstatus >> 8;
3073 $CPAN::Frontend->myprint(qq{
3074 Subprocess "|$command"
3075 returned status $estatus (wstat $wstatus)
3079 # find2perl needs modularization, too, all the following is stolen
3083 my($self,$name) = @_;
3084 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
3085 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
3087 my($perms,%user,%group);
3091 $blocks = int(($blocks + 1) / 2);
3094 $blocks = int(($sizemm + 1023) / 1024);
3097 if (-f _) { $perms = '-'; }
3098 elsif (-d _) { $perms = 'd'; }
3099 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
3100 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
3101 elsif (-p _) { $perms = 'p'; }
3102 elsif (-S _) { $perms = 's'; }
3103 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
3105 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
3106 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
3107 my $tmpmode = $mode;
3108 my $tmp = $rwx[$tmpmode & 7];
3110 $tmp = $rwx[$tmpmode & 7] . $tmp;
3112 $tmp = $rwx[$tmpmode & 7] . $tmp;
3113 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3114 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3115 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3118 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3119 my $group = $group{$gid} || $gid;
3121 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3123 my($moname) = $moname[$mon];
3124 if (-M _ > 365.25 / 2) {
3125 $timeyear = $year + 1900;
3128 $timeyear = sprintf("%02d:%02d", $hour, $min);
3131 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3145 package CPAN::FTP::netrc;
3148 # package CPAN::FTP::netrc;
3151 my $file = File::Spec->catfile($ENV{HOME},".netrc");
3153 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3154 $atime,$mtime,$ctime,$blksize,$blocks)
3159 my($fh,@machines,$hasdefault);
3161 $fh = FileHandle->new or die "Could not create a filehandle";
3163 if($fh->open($file)){
3164 $protected = ($mode & 077) == 0;
3166 NETRC: while (<$fh>) {
3167 my(@tokens) = split " ", $_;
3168 TOKEN: while (@tokens) {
3169 my($t) = shift @tokens;
3170 if ($t eq "default"){
3174 last TOKEN if $t eq "macdef";
3175 if ($t eq "machine") {
3176 push @machines, shift @tokens;
3181 $file = $hasdefault = $protected = "";
3185 'mach' => [@machines],
3187 'hasdefault' => $hasdefault,
3188 'protected' => $protected,
3192 # CPAN::FTP::netrc::hasdefault;
3193 sub hasdefault { shift->{'hasdefault'} }
3194 sub netrc { shift->{'netrc'} }
3195 sub protected { shift->{'protected'} }
3197 my($self,$mach) = @_;
3198 for ( @{$self->{'mach'}} ) {
3199 return 1 if $_ eq $mach;
3204 package CPAN::Complete;
3208 my($text, $line, $start, $end) = @_;
3209 my(@perlret) = cpl($text, $line, $start);
3210 # find longest common match. Can anybody show me how to peruse
3211 # T::R::Gnu to have this done automatically? Seems expensive.
3212 return () unless @perlret;
3213 my($newtext) = $text;
3214 for (my $i = length($text)+1;;$i++) {
3215 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3216 my $try = substr($perlret[0],0,$i);
3217 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3218 # warn "try[$try]tries[@tries]";
3219 if (@tries == @perlret) {
3225 ($newtext,@perlret);
3228 #-> sub CPAN::Complete::cpl ;
3230 my($word,$line,$pos) = @_;
3234 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3236 if ($line =~ s/^(force\s*)//) {
3241 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3242 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3244 } elsif ($line =~ /^(a|ls)\s/) {
3245 @return = cplx('CPAN::Author',uc($word));
3246 } elsif ($line =~ /^b\s/) {
3247 CPAN::Shell->local_bundles;
3248 @return = cplx('CPAN::Bundle',$word);
3249 } elsif ($line =~ /^d\s/) {
3250 @return = cplx('CPAN::Distribution',$word);
3251 } elsif ($line =~ m/^(
3252 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3254 if ($word =~ /^Bundle::/) {
3255 CPAN::Shell->local_bundles;
3257 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3258 } elsif ($line =~ /^i\s/) {
3259 @return = cpl_any($word);
3260 } elsif ($line =~ /^reload\s/) {
3261 @return = cpl_reload($word,$line,$pos);
3262 } elsif ($line =~ /^o\s/) {
3263 @return = cpl_option($word,$line,$pos);
3264 } elsif ($line =~ m/^\S+\s/ ) {
3265 # fallback for future commands and what we have forgotten above
3266 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3273 #-> sub CPAN::Complete::cplx ;
3275 my($class, $word) = @_;
3276 # I believed for many years that this was sorted, today I
3277 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3278 # make it sorted again. Maybe sort was dropped when GNU-readline
3279 # support came in? The RCS file is difficult to read on that:-(
3280 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3283 #-> sub CPAN::Complete::cpl_any ;
3287 cplx('CPAN::Author',$word),
3288 cplx('CPAN::Bundle',$word),
3289 cplx('CPAN::Distribution',$word),
3290 cplx('CPAN::Module',$word),
3294 #-> sub CPAN::Complete::cpl_reload ;
3296 my($word,$line,$pos) = @_;
3298 my(@words) = split " ", $line;
3299 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3300 my(@ok) = qw(cpan index);
3301 return @ok if @words == 1;
3302 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3305 #-> sub CPAN::Complete::cpl_option ;
3307 my($word,$line,$pos) = @_;
3309 my(@words) = split " ", $line;
3310 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3311 my(@ok) = qw(conf debug);
3312 return @ok if @words == 1;
3313 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3315 } elsif ($words[1] eq 'index') {
3317 } elsif ($words[1] eq 'conf') {
3318 return CPAN::HandleConfig::cpl(@_);
3319 } elsif ($words[1] eq 'debug') {
3320 return sort grep /^\Q$word\E/i,
3321 sort keys %CPAN::DEBUG, 'all';
3325 package CPAN::Index;
3328 #-> sub CPAN::Index::force_reload ;
3331 $CPAN::Index::LAST_TIME = 0;
3335 #-> sub CPAN::Index::reload ;
3337 my($cl,$force) = @_;
3340 # XXX check if a newer one is available. (We currently read it
3341 # from time to time)
3342 for ($CPAN::Config->{index_expire}) {
3343 $_ = 0.001 unless $_ && $_ > 0.001;
3345 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3346 # debug here when CPAN doesn't seem to read the Metadata
3348 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3350 unless ($CPAN::META->{PROTOCOL}) {
3351 $cl->read_metadata_cache;
3352 $CPAN::META->{PROTOCOL} ||= "1.0";
3354 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3355 # warn "Setting last_time to 0";
3356 $LAST_TIME = 0; # No warning necessary
3358 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3361 # IFF we are developing, it helps to wipe out the memory
3362 # between reloads, otherwise it is not what a user expects.
3363 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3364 $CPAN::META = CPAN->new;
3368 local $LAST_TIME = $time;
3369 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3371 my $needshort = $^O eq "dos";
3373 $cl->rd_authindex($cl
3375 "authors/01mailrc.txt.gz",
3377 File::Spec->catfile('authors', '01mailrc.gz') :
3378 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3381 $debug = "timing reading 01[".($t2 - $time)."]";
3383 return if $CPAN::Signal; # this is sometimes lengthy
3384 $cl->rd_modpacks($cl
3386 "modules/02packages.details.txt.gz",
3388 File::Spec->catfile('modules', '02packag.gz') :
3389 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3392 $debug .= "02[".($t2 - $time)."]";
3394 return if $CPAN::Signal; # this is sometimes lengthy
3397 "modules/03modlist.data.gz",
3399 File::Spec->catfile('modules', '03mlist.gz') :
3400 File::Spec->catfile('modules', '03modlist.data.gz'),
3402 $cl->write_metadata_cache;
3404 $debug .= "03[".($t2 - $time)."]";
3406 CPAN->debug($debug) if $CPAN::DEBUG;
3409 $CPAN::META->{PROTOCOL} = PROTOCOL;
3412 #-> sub CPAN::Index::reload_x ;
3414 my($cl,$wanted,$localname,$force) = @_;
3415 $force |= 2; # means we're dealing with an index here
3416 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3418 $localname ||= $wanted;
3419 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3423 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3426 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3427 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3428 qq{day$s. I\'ll use that.});
3431 $force |= 1; # means we're quite serious about it.
3433 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3436 #-> sub CPAN::Index::rd_authindex ;
3438 my($cl, $index_target) = @_;
3440 return unless defined $index_target;
3441 $CPAN::Frontend->myprint("Going to read $index_target\n");
3443 tie *FH, 'CPAN::Tarzip', $index_target;
3446 push @lines, split /\012/ while <FH>;
3448 my($userid,$fullname,$email) =
3449 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3450 next unless $userid && $fullname && $email;
3452 # instantiate an author object
3453 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3454 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3455 return if $CPAN::Signal;
3460 my($self,$dist) = @_;
3461 $dist = $self->{'id'} unless defined $dist;
3462 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3466 #-> sub CPAN::Index::rd_modpacks ;
3468 my($self, $index_target) = @_;
3470 return unless defined $index_target;
3471 $CPAN::Frontend->myprint("Going to read $index_target\n");
3472 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3475 while ($_ = $fh->READLINE) {
3477 my @ls = map {"$_\n"} split /\n/, $_;
3478 unshift @ls, "\n" x length($1) if /^(\n+)/;
3482 my($line_count,$last_updated);
3484 my $shift = shift(@lines);
3485 last if $shift =~ /^\s*$/;
3486 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3487 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3489 if (not defined $line_count) {
3491 warn qq{Warning: Your $index_target does not contain a Line-Count header.
3492 Please check the validity of the index file by comparing it to more
3493 than one CPAN mirror. I'll continue but problems seem likely to
3498 } elsif ($line_count != scalar @lines) {
3500 warn sprintf qq{Warning: Your %s
3501 contains a Line-Count header of %d but I see %d lines there. Please
3502 check the validity of the index file by comparing it to more than one
3503 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3504 $index_target, $line_count, scalar(@lines);
3507 if (not defined $last_updated) {
3509 warn qq{Warning: Your $index_target does not contain a Last-Updated header.
3510 Please check the validity of the index file by comparing it to more
3511 than one CPAN mirror. I'll continue but problems seem likely to
3519 ->myprint(sprintf qq{ Database was generated on %s\n},
3521 $DATE_OF_02 = $last_updated;
3524 if ($CPAN::META->has_inst('HTTP::Date')) {
3526 $age -= HTTP::Date::str2time($last_updated);
3528 $CPAN::Frontend->myprint(" HTTP::Date not available\n");
3529 require Time::Local;
3530 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3531 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3532 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3539 qq{Warning: This index file is %d days old.
3540 Please check the host you chose as your CPAN mirror for staleness.
3541 I'll continue but problems seem likely to happen.\a\n},
3544 } elsif ($age < -1) {
3548 qq{Warning: Your system date is %d days behind this index file!
3550 Timestamp index file: %s
3551 Please fix your system time, problems with the make command expected.\n},
3561 # A necessity since we have metadata_cache: delete what isn't
3563 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3564 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3568 # before 1.56 we split into 3 and discarded the rest. From
3569 # 1.57 we assign remaining text to $comment thus allowing to
3570 # influence isa_perl
3571 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3572 my($bundle,$id,$userid);
3574 if ($mod eq 'CPAN' &&
3576 CPAN::Queue->exists('Bundle::CPAN') ||
3577 CPAN::Queue->exists('CPAN')
3581 if ($version > $CPAN::VERSION){
3582 $CPAN::Frontend->myprint(qq{
3583 There's a new CPAN.pm version (v$version) available!
3584 [Current version is v$CPAN::VERSION]
3585 You might want to try
3586 install Bundle::CPAN
3588 without quitting the current session. It should be a seamless upgrade
3589 while we are running...
3592 $CPAN::Frontend->myprint(qq{\n});
3594 last if $CPAN::Signal;
3595 } elsif ($mod =~ /^Bundle::(.*)/) {
3600 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3601 # Let's make it a module too, because bundles have so much
3602 # in common with modules.
3604 # Changed in 1.57_63: seems like memory bloat now without
3605 # any value, so commented out
3607 # $CPAN::META->instance('CPAN::Module',$mod);
3611 # instantiate a module object
3612 $id = $CPAN::META->instance('CPAN::Module',$mod);
3616 # Although CPAN prohibits same name with different version the
3617 # indexer may have changed the version for the same distro
3618 # since the last time ("Force Reindexing" feature)
3619 if ($id->cpan_file ne $dist
3621 $id->cpan_version ne $version
3623 $userid = $id->userid || $self->userid($dist);
3625 'CPAN_USERID' => $userid,
3626 'CPAN_VERSION' => $version,
3627 'CPAN_FILE' => $dist,
3631 # instantiate a distribution object
3632 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3633 # we do not need CONTAINSMODS unless we do something with
3634 # this dist, so we better produce it on demand.
3636 ## my $obj = $CPAN::META->instance(
3637 ## 'CPAN::Distribution' => $dist
3639 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3641 $CPAN::META->instance(
3642 'CPAN::Distribution' => $dist
3644 'CPAN_USERID' => $userid,
3645 'CPAN_COMMENT' => $comment,
3649 for my $name ($mod,$dist) {
3650 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3651 $exists{$name} = undef;
3654 return if $CPAN::Signal;
3658 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3659 for my $o ($CPAN::META->all_objects($class)) {
3660 next if exists $exists{$o->{ID}};
3661 $CPAN::META->delete($class,$o->{ID});
3662 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3669 #-> sub CPAN::Index::rd_modlist ;
3671 my($cl,$index_target) = @_;
3672 return unless defined $index_target;
3673 $CPAN::Frontend->myprint("Going to read $index_target\n");
3674 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3678 while ($_ = $fh->READLINE) {
3680 my @ls = map {"$_\n"} split /\n/, $_;
3681 unshift @ls, "\n" x length($1) if /^(\n+)/;
3685 my $shift = shift(@eval);
3686 if ($shift =~ /^Date:\s+(.*)/){
3687 return if $DATE_OF_03 eq $1;
3690 last if $shift =~ /^\s*$/;
3693 push @eval, q{CPAN::Modulelist->data;};
3695 my($comp) = Safe->new("CPAN::Safe1");
3696 my($eval) = join("", @eval);
3697 my $ret = $comp->reval($eval);
3698 Carp::confess($@) if $@;
3699 return if $CPAN::Signal;
3701 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3702 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3703 $obj->set(%{$ret->{$_}});
3704 return if $CPAN::Signal;
3708 #-> sub CPAN::Index::write_metadata_cache ;
3709 sub write_metadata_cache {
3711 return unless $CPAN::Config->{'cache_metadata'};
3712 return unless $CPAN::META->has_usable("Storable");
3714 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3715 CPAN::Distribution)) {
3716 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3718 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3719 $cache->{last_time} = $LAST_TIME;
3720 $cache->{DATE_OF_02} = $DATE_OF_02;
3721 $cache->{PROTOCOL} = PROTOCOL;
3722 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
3723 eval { Storable::nstore($cache, $metadata_file) };
3724 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3727 #-> sub CPAN::Index::read_metadata_cache ;
3728 sub read_metadata_cache {
3730 return unless $CPAN::Config->{'cache_metadata'};
3731 return unless $CPAN::META->has_usable("Storable");
3732 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3733 return unless -r $metadata_file and -f $metadata_file;
3734 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
3736 eval { $cache = Storable::retrieve($metadata_file) };
3737 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3738 if (!$cache || ref $cache ne 'HASH'){
3742 if (exists $cache->{PROTOCOL}) {
3743 if (PROTOCOL > $cache->{PROTOCOL}) {
3744 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
3745 "with protocol v%s, requiring v%s\n",
3752 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
3753 "with protocol v1.0\n");
3758 while(my($class,$v) = each %$cache) {
3759 next unless $class =~ /^CPAN::/;
3760 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
3761 while (my($id,$ro) = each %$v) {
3762 $CPAN::META->{readwrite}{$class}{$id} ||=
3763 $class->new(ID=>$id, RO=>$ro);
3768 unless ($clcnt) { # sanity check
3769 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
3772 if ($idcnt < 1000) {
3773 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
3774 "in $metadata_file\n");
3777 $CPAN::META->{PROTOCOL} ||=
3778 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
3779 # does initialize to some protocol
3780 $LAST_TIME = $cache->{last_time};
3781 $DATE_OF_02 = $cache->{DATE_OF_02};
3782 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
3783 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
3787 package CPAN::InfoObj;
3792 exists $self->{RO} and return $self->{RO};
3797 my $ro = $self->ro or return;
3798 return $ro->{CPAN_USERID};
3801 sub id { shift->{ID}; }
3803 #-> sub CPAN::InfoObj::new ;
3805 my $this = bless {}, shift;
3810 # The set method may only be used by code that reads index data or
3811 # otherwise "objective" data from the outside world. All session
3812 # related material may do anything else with instance variables but
3813 # must not touch the hash under the RO attribute. The reason is that
3814 # the RO hash gets written to Metadata file and is thus persistent.
3816 #-> sub CPAN::InfoObj::set ;
3818 my($self,%att) = @_;
3819 my $class = ref $self;
3821 # This must be ||=, not ||, because only if we write an empty
3822 # reference, only then the set method will write into the readonly
3823 # area. But for Distributions that spring into existence, maybe
3824 # because of a typo, we do not like it that they are written into
3825 # the readonly area and made permanent (at least for a while) and
3826 # that is why we do not "allow" other places to call ->set.
3827 unless ($self->id) {
3828 CPAN->debug("Bug? Empty ID, rejecting");
3831 my $ro = $self->{RO} =
3832 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
3834 while (my($k,$v) = each %att) {
3839 #-> sub CPAN::InfoObj::as_glimpse ;
3843 my $class = ref($self);
3844 $class =~ s/^CPAN:://;
3845 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
3849 #-> sub CPAN::InfoObj::as_string ;
3853 my $class = ref($self);
3854 $class =~ s/^CPAN:://;
3855 push @m, $class, " id = $self->{ID}\n";
3857 unless ($ro = $self->ro) {
3858 $CPAN::Frontend->mydie("Unknown distribution $self->{ID}");
3860 for (sort keys %$ro) {
3861 # next if m/^(ID|RO)$/;
3863 if ($_ eq "CPAN_USERID") {
3865 $extra .= $self->fullname;
3866 my $email; # old perls!
3867 if ($email = $CPAN::META->instance("CPAN::Author",
3870 $extra .= " <$email>";
3872 $extra .= " <no email>";
3875 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
3876 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
3879 next unless defined $ro->{$_};
3880 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
3882 for (sort keys %$self) {
3883 next if m/^(ID|RO)$/;
3884 if (ref($self->{$_}) eq "ARRAY") {
3885 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
3886 } elsif (ref($self->{$_}) eq "HASH") {
3890 join(" ",sort keys %{$self->{$_}}),
3893 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
3899 #-> sub CPAN::InfoObj::fullname ;
3902 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
3905 #-> sub CPAN::InfoObj::dump ;
3908 require Data::Dumper;
3909 local $Data::Dumper::Sortkeys;
3910 $Data::Dumper::Sortkeys = 1;
3911 print Data::Dumper::Dumper($self);
3914 package CPAN::Author;
3917 #-> sub CPAN::Author::force
3923 #-> sub CPAN::Author::force
3926 delete $self->{force};
3929 #-> sub CPAN::Author::id
3932 my $id = $self->{ID};
3933 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
3937 #-> sub CPAN::Author::as_glimpse ;
3941 my $class = ref($self);
3942 $class =~ s/^CPAN:://;
3943 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
3951 #-> sub CPAN::Author::fullname ;
3953 shift->ro->{FULLNAME};
3957 #-> sub CPAN::Author::email ;
3958 sub email { shift->ro->{EMAIL}; }
3960 #-> sub CPAN::Author::ls ;
3963 my $glob = shift || "";
3964 my $silent = shift || 0;
3967 # adapted from CPAN::Distribution::verifyCHECKSUM ;
3968 my(@csf); # chksumfile
3969 @csf = $self->id =~ /(.)(.)(.*)/;
3970 $csf[1] = join "", @csf[0,1];
3971 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
3973 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
3974 unless (grep {$_->[2] eq $csf[1]} @dl) {
3975 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
3978 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
3979 unless (grep {$_->[2] eq $csf[2]} @dl) {
3980 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
3983 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
3985 if ($CPAN::META->has_inst("Text::Glob")) {
3986 my $rglob = Text::Glob::glob_to_regex($glob);
3987 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
3989 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
3992 $CPAN::Frontend->myprint(join "", map {
3993 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
3994 } sort { $a->[2] cmp $b->[2] } @dl);
3998 # returns an array of arrays, the latter contain (size,mtime,filename)
3999 #-> sub CPAN::Author::dir_listing ;
4002 my $chksumfile = shift;
4003 my $recursive = shift;
4004 my $may_ftp = shift;
4006 File::Spec->catfile($CPAN::Config->{keep_source_where},
4007 "authors", "id", @$chksumfile);
4011 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
4012 # hazard. (Without GPG installed they are not that much better,
4014 $fh = FileHandle->new;
4015 if (open($fh, $lc_want)) {
4016 my $line = <$fh>; close $fh;
4017 unlink($lc_want) unless $line =~ /PGP/;
4021 # connect "force" argument with "index_expire".
4022 my $force = $self->{force};
4023 if (my @stat = stat $lc_want) {
4024 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
4028 $lc_file = CPAN::FTP->localize(
4029 "authors/id/@$chksumfile",
4034 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4035 $chksumfile->[-1] .= ".gz";
4036 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
4039 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
4040 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4046 $lc_file = $lc_want;
4047 # we *could* second-guess and if the user has a file: URL,
4048 # then we could look there. But on the other hand, if they do
4049 # have a file: URL, wy did they choose to set
4050 # $CPAN::Config->{show_upload_date} to false?
4053 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
4054 $fh = FileHandle->new;
4056 if (open $fh, $lc_file){
4059 $eval =~ s/\015?\012/\n/g;
4061 my($comp) = Safe->new();
4062 $cksum = $comp->reval($eval);
4064 rename $lc_file, "$lc_file.bad";
4065 Carp::confess($@) if $@;
4067 } elsif ($may_ftp) {
4068 Carp::carp "Could not open $lc_file for reading.";
4070 # Maybe should warn: "You may want to set show_upload_date to a true value"
4074 for $f (sort keys %$cksum) {
4075 if (exists $cksum->{$f}{isdir}) {
4077 my(@dir) = @$chksumfile;
4079 push @dir, $f, "CHECKSUMS";
4081 [$_->[0], $_->[1], "$f/$_->[2]"]
4082 } $self->dir_listing(\@dir,1,$may_ftp);
4084 push @result, [ 0, "-", $f ];
4088 ($cksum->{$f}{"size"}||0),
4089 $cksum->{$f}{"mtime"}||"---",
4097 package CPAN::Distribution;
4103 my $ro = $self->ro or return;
4107 # CPAN::Distribution::undelay
4110 delete $self->{later};
4113 # add the A/AN/ stuff
4114 # CPAN::Distribution::normalize
4117 $s = $self->id unless defined $s;
4121 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4123 return $s if $s =~ m:^N/A|^Contact Author: ;
4124 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4125 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4126 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4131 #-> sub CPAN::Distribution::author ;
4134 my($authorid) = $self->pretty_id =~ /^([\w\-]+)/;
4135 CPAN::Shell->expand("Author",$authorid);
4138 # tries to get the yaml from CPAN instead of the distro itself:
4139 # EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels
4142 my $meta = $self->pretty_id;
4143 $meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/;
4144 my(@ls) = CPAN::Shell->globls($meta);
4145 my $norm = $self->normalize($meta);
4149 File::Spec->catfile(
4150 $CPAN::Config->{keep_source_where},
4155 $self->debug("Doing localize") if $CPAN::DEBUG;
4156 unless ($local_file =
4157 CPAN::FTP->localize("authors/id/$norm",
4159 $CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n");
4161 if ($CPAN::META->has_inst("YAML")) {
4162 my $yaml = YAML::LoadFile($local_file);
4165 $CPAN::Frontend->mydie("Yaml not installed, cannot parse '$local_file'\n");
4172 return $id unless $id =~ m|^./../|;
4176 # mark as dirty/clean
4177 #-> sub CPAN::Distribution::color_cmd_tmps ;
4178 sub color_cmd_tmps {
4180 my($depth) = shift || 0;
4181 my($color) = shift || 0;
4182 my($ancestors) = shift || [];
4183 # a distribution needs to recurse into its prereq_pms
4185 return if exists $self->{incommandcolor}
4186 && $self->{incommandcolor}==$color;
4188 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4190 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4191 my $prereq_pm = $self->prereq_pm;
4192 if (defined $prereq_pm) {
4193 PREREQ: for my $pre (keys %$prereq_pm) {
4195 unless ($premo = CPAN::Shell->expand("Module",$pre)) {
4196 $CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n");
4197 $CPAN::Frontend->mysleep(2);
4200 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4204 delete $self->{sponsored_mods};
4205 delete $self->{badtestcnt};
4207 $self->{incommandcolor} = $color;
4210 #-> sub CPAN::Distribution::as_string ;
4213 $self->containsmods;
4215 $self->SUPER::as_string(@_);
4218 #-> sub CPAN::Distribution::containsmods ;
4221 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4222 my $dist_id = $self->{ID};
4223 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4224 my $mod_file = $mod->cpan_file or next;
4225 my $mod_id = $mod->{ID} or next;
4226 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4228 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4230 keys %{$self->{CONTAINSMODS}};
4233 #-> sub CPAN::Distribution::upload_date ;
4236 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4237 my(@local_wanted) = split(/\//,$self->id);
4238 my $filename = pop @local_wanted;
4239 push @local_wanted, "CHECKSUMS";
4240 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4241 return unless $author;
4242 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4244 my($dirent) = grep { $_->[2] eq $filename } @dl;
4245 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4246 return unless $dirent->[1];
4247 return $self->{UPLOAD_DATE} = $dirent->[1];
4250 #-> sub CPAN::Distribution::uptodate ;
4254 foreach $c ($self->containsmods) {
4255 my $obj = CPAN::Shell->expandany($c);
4256 return 0 unless $obj->uptodate;
4261 #-> sub CPAN::Distribution::called_for ;
4264 $self->{CALLED_FOR} = $id if defined $id;
4265 return $self->{CALLED_FOR};
4268 #-> sub CPAN::Distribution::safe_chdir ;
4270 my($self,$todir) = @_;
4271 # we die if we cannot chdir and we are debuggable
4272 Carp::confess("safe_chdir called without todir argument")
4273 unless defined $todir and length $todir;
4275 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4279 unless (-x $todir) {
4280 unless (chmod 0755, $todir) {
4281 my $cwd = CPAN::anycwd();
4282 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4283 "permission to change the permission; cannot ".
4284 "chdir to '$todir'\n");
4285 $CPAN::Frontend->mysleep(5);
4286 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4287 qq{to todir[$todir]: $!});
4291 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4294 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4297 my $cwd = CPAN::anycwd();
4298 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4299 qq{to todir[$todir] (a chmod has been issued): $!});
4304 #-> sub CPAN::Distribution::get ;
4309 exists $self->{'build_dir'} and push @e,
4310 "Is already unwrapped into directory $self->{'build_dir'}";
4311 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4313 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4316 # Get the file on local disk
4321 File::Spec->catfile(
4322 $CPAN::Config->{keep_source_where},
4325 split(/\//,$self->id)
4328 $self->debug("Doing localize") if $CPAN::DEBUG;
4329 unless ($local_file =
4330 CPAN::FTP->localize("authors/id/$self->{ID}",
4333 if ($CPAN::Index::DATE_OF_02) {
4334 $note = "Note: Current database in memory was generated ".
4335 "on $CPAN::Index::DATE_OF_02\n";
4337 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4339 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4340 $self->{localfile} = $local_file;
4341 return if $CPAN::Signal;
4346 if ($CPAN::META->has_inst("Digest::SHA")) {
4347 $self->debug("Digest::SHA is installed, verifying");
4348 $self->verifyCHECKSUM;
4350 $self->debug("Digest::SHA is NOT installed");
4352 return if $CPAN::Signal;
4355 # Create a clean room and go there
4357 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4358 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4359 $self->safe_chdir($builddir);
4360 $self->debug("Removing tmp") if $CPAN::DEBUG;
4361 File::Path::rmtree("tmp");
4362 unless (mkdir "tmp", 0755) {
4363 $CPAN::Frontend->unrecoverable_error(<<EOF);
4364 Couldn't mkdir '$builddir/tmp': $!
4366 Cannot continue: Please find the reason why I cannot make the
4369 and fix the problem, then retry.
4374 $self->safe_chdir($sub_wd);
4377 $self->safe_chdir("tmp");
4382 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4383 my $ct = CPAN::Tarzip->new($local_file);
4384 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4385 $self->{was_uncompressed}++ unless $ct->gtest();
4386 $self->untar_me($ct);
4387 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4388 $self->unzip_me($ct);
4389 } elsif ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/) {
4390 $self->{was_uncompressed}++ unless $ct->gtest();
4391 $self->debug("calling pm2dir for local_file[$local_file]") if $CPAN::DEBUG;
4392 $self->pm2dir_me($local_file);
4394 $self->{archived} = "NO";
4395 $self->safe_chdir($sub_wd);
4399 # we are still in the tmp directory!
4400 # Let's check if the package has its own directory.
4401 my $dh = DirHandle->new(File::Spec->curdir)
4402 or Carp::croak("Couldn't opendir .: $!");
4403 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4405 my ($distdir,$packagedir);
4406 if (@readdir == 1 && -d $readdir[0]) {
4407 $distdir = $readdir[0];
4408 $packagedir = File::Spec->catdir($builddir,$distdir);
4409 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4411 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4413 File::Path::rmtree($packagedir);
4414 unless (File::Copy::move($distdir,$packagedir)) {
4415 $CPAN::Frontend->unrecoverable_error(<<EOF);
4416 Couldn't move '$distdir' to '$packagedir': $!
4418 Cannot continue: Please find the reason why I cannot move
4419 $builddir/tmp/$distdir
4422 and fix the problem, then retry
4426 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4433 my $userid = $self->cpan_userid;
4435 CPAN->debug("no userid? self[$self]");
4438 my $pragmatic_dir = $userid . '000';
4439 $pragmatic_dir =~ s/\W_//g;
4440 $pragmatic_dir++ while -d "../$pragmatic_dir";
4441 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4442 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4443 File::Path::mkpath($packagedir);
4445 for $f (@readdir) { # is already without "." and ".."
4446 my $to = File::Spec->catdir($packagedir,$f);
4447 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4451 $self->safe_chdir($sub_wd);
4455 $self->{'build_dir'} = $packagedir;
4456 $self->safe_chdir($builddir);
4457 File::Path::rmtree("tmp");
4459 $self->safe_chdir($packagedir);
4460 if ($CPAN::META->has_inst("Module::Signature")) {
4461 if (-f "SIGNATURE") {
4462 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4463 my $rv = Module::Signature::verify();
4464 if ($rv != Module::Signature::SIGNATURE_OK() and
4465 $rv != Module::Signature::SIGNATURE_MISSING()) {
4466 $CPAN::Frontend->myprint(
4467 qq{\nSignature invalid for }.
4468 qq{distribution file. }.
4469 qq{Please investigate.\n\n}.
4471 $CPAN::META->instance(
4478 sprintf(qq{I'd recommend removing %s. Its signature
4479 is invalid. Maybe you have configured your 'urllist' with
4480 a bad URL. Please check this array with 'o conf urllist', and
4481 retry. For more information, try opening a subshell with
4489 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4490 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4491 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4493 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4496 $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
4499 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4501 $self->safe_chdir($builddir);
4502 return if $CPAN::Signal;
4505 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4506 my($mpl_exists) = -f $mpl;
4507 unless ($mpl_exists) {
4508 # NFS has been reported to have racing problems after the
4509 # renaming of a directory in some environments.
4512 my $mpldh = DirHandle->new($packagedir)
4513 or Carp::croak("Couldn't opendir $packagedir: $!");
4514 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4517 my $prefer_installer = "eumm"; # eumm|mb
4518 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4519 if ($mpl_exists) { # they *can* choose
4520 if ($CPAN::META->has_inst("Module::Build")) {
4521 $prefer_installer = $CPAN::Config->{prefer_installer};
4524 $prefer_installer = "mb";
4527 if (lc($prefer_installer) eq "mb") {
4528 $self->{modulebuild} = 1;
4529 } elsif (! $mpl_exists) {
4530 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4534 my($configure) = File::Spec->catfile($packagedir,"Configure");
4535 if (-f $configure) {
4536 # do we have anything to do?
4537 $self->{'configure'} = $configure;
4538 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4539 $CPAN::Frontend->myprint(qq{
4540 Package comes with a Makefile and without a Makefile.PL.
4541 We\'ll try to build it with that Makefile then.
4543 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
4546 my $cf = $self->called_for || "unknown";
4551 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4552 $cf = "unknown" unless length($cf);
4553 $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
4554 (The test -f "$mpl" returned false.)
4555 Writing one on our own (setting NAME to $cf)\a\n});
4556 $self->{had_no_makefile_pl}++;
4559 # Writing our own Makefile.PL
4561 my $fh = FileHandle->new;
4563 or Carp::croak("Could not open >$mpl: $!");
4565 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4566 # because there was no Makefile.PL supplied.
4567 # Autogenerated on: }.scalar localtime().qq{
4569 use ExtUtils::MakeMaker;
4570 WriteMakefile(NAME => q[$cf]);
4580 # CPAN::Distribution::untar_me ;
4583 $self->{archived} = "tar";
4585 $self->{unwrapped} = "YES";
4587 $self->{unwrapped} = "NO";
4591 # CPAN::Distribution::unzip_me ;
4594 $self->{archived} = "zip";
4596 $self->{unwrapped} = "YES";
4598 $self->{unwrapped} = "NO";
4604 my($self,$local_file) = @_;
4605 $self->{archived} = "pm";
4606 my $to = File::Basename::basename($local_file);
4607 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4608 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4609 $self->{unwrapped} = "YES";
4611 $self->{unwrapped} = "NO";
4614 File::Copy::cp($local_file,".");
4615 $self->{unwrapped} = "YES";
4619 #-> sub CPAN::Distribution::new ;
4621 my($class,%att) = @_;
4623 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
4625 my $this = { %att };
4626 return bless $this, $class;
4629 #-> sub CPAN::Distribution::look ;
4633 if ($^O eq 'MacOS') {
4634 $self->Mac::BuildTools::look;
4638 if ( $CPAN::Config->{'shell'} ) {
4639 $CPAN::Frontend->myprint(qq{
4640 Trying to open a subshell in the build directory...
4643 $CPAN::Frontend->myprint(qq{
4644 Your configuration does not define a value for subshells.
4645 Please define it with "o conf shell <your shell>"
4649 my $dist = $self->id;
4651 unless ($dir = $self->dir) {
4654 unless ($dir ||= $self->dir) {
4655 $CPAN::Frontend->mywarn(qq{
4656 Could not determine which directory to use for looking at $dist.
4660 my $pwd = CPAN::anycwd();
4661 $self->safe_chdir($dir);
4662 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4664 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
4665 $ENV{CPAN_SHELL_LEVEL} += 1;
4666 unless (system($CPAN::Config->{'shell'}) == 0) {
4668 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
4671 $self->safe_chdir($pwd);
4674 # CPAN::Distribution::cvs_import ;
4678 my $dir = $self->dir;
4680 my $package = $self->called_for;
4681 my $module = $CPAN::META->instance('CPAN::Module', $package);
4682 my $version = $module->cpan_version;
4684 my $userid = $self->cpan_userid;
4686 my $cvs_dir = (split /\//, $dir)[-1];
4687 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
4689 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
4691 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
4692 if ($cvs_site_perl) {
4693 $cvs_dir = "$cvs_site_perl/$cvs_dir";
4695 my $cvs_log = qq{"imported $package $version sources"};
4696 $version =~ s/\./_/g;
4697 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
4698 "$cvs_dir", $userid, "v$version");
4700 my $pwd = CPAN::anycwd();
4701 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
4703 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4705 $CPAN::Frontend->myprint(qq{@cmd\n});
4706 system(@cmd) == 0 or
4707 $CPAN::Frontend->mydie("cvs import failed");
4708 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
4711 #-> sub CPAN::Distribution::readme ;
4714 my($dist) = $self->id;
4715 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
4716 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
4719 File::Spec->catfile(
4720 $CPAN::Config->{keep_source_where},
4723 split(/\//,"$sans.readme"),
4725 $self->debug("Doing localize") if $CPAN::DEBUG;
4726 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
4728 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
4730 if ($^O eq 'MacOS') {
4731 Mac::BuildTools::launch_file($local_file);
4735 my $fh_pager = FileHandle->new;
4736 local($SIG{PIPE}) = "IGNORE";
4737 $fh_pager->open("|$CPAN::Config->{'pager'}")
4738 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
4739 my $fh_readme = FileHandle->new;
4740 $fh_readme->open($local_file)
4741 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
4742 $CPAN::Frontend->myprint(qq{
4745 with pager "$CPAN::Config->{'pager'}"
4748 $fh_pager->print(<$fh_readme>);
4752 #-> sub CPAN::Distribution::verifyCHECKSUM ;
4753 sub verifyCHECKSUM {
4757 $self->{CHECKSUM_STATUS} ||= "";
4758 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
4759 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4761 my($lc_want,$lc_file,@local,$basename);
4762 @local = split(/\//,$self->id);
4764 push @local, "CHECKSUMS";
4766 File::Spec->catfile($CPAN::Config->{keep_source_where},
4767 "authors", "id", @local);
4772 $self->CHECKSUM_check_file($lc_want)
4774 return $self->{CHECKSUM_STATUS} = "OK";
4776 $lc_file = CPAN::FTP->localize("authors/id/@local",
4779 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4780 $local[-1] .= ".gz";
4781 $lc_file = CPAN::FTP->localize("authors/id/@local",
4784 $lc_file =~ s/\.gz(?!\n)\Z//;
4785 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4790 $self->CHECKSUM_check_file($lc_file);
4793 #-> sub CPAN::Distribution::SIG_check_file ;
4794 sub SIG_check_file {
4795 my($self,$chk_file) = @_;
4796 my $rv = eval { Module::Signature::_verify($chk_file) };
4798 if ($rv == Module::Signature::SIGNATURE_OK()) {
4799 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
4800 return $self->{SIG_STATUS} = "OK";
4802 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
4803 qq{distribution file. }.
4804 qq{Please investigate.\n\n}.
4806 $CPAN::META->instance(
4811 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
4812 is invalid. Maybe you have configured your 'urllist' with
4813 a bad URL. Please check this array with 'o conf urllist', and
4816 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4820 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
4821 sub CHECKSUM_check_file {
4822 my($self,$chk_file) = @_;
4823 my($cksum,$file,$basename);
4825 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
4826 $self->debug("Module::Signature is installed, verifying");
4827 $self->SIG_check_file($chk_file);
4829 $self->debug("Module::Signature is NOT installed");
4832 $file = $self->{localfile};
4833 $basename = File::Basename::basename($file);
4834 my $fh = FileHandle->new;
4835 if (open $fh, $chk_file){
4838 $eval =~ s/\015?\012/\n/g;
4840 my($comp) = Safe->new();
4841 $cksum = $comp->reval($eval);
4843 rename $chk_file, "$chk_file.bad";
4844 Carp::confess($@) if $@;
4847 Carp::carp "Could not open $chk_file for reading";
4850 if (! ref $cksum or ref $cksum ne "HASH") {
4851 $CPAN::Frontend->mywarn(qq{
4852 Warning: checksum file '$chk_file' broken.
4854 When trying to read that file I expected to get a hash reference
4855 for further processing, but got garbage instead.
4857 my $answer = ExtUtils::MakeMaker::prompt("Proceed nonetheless?", "no");
4858 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
4859 $self->{CHECKSUM_STATUS} = "NIL -- chk_file broken";
4861 } elsif (exists $cksum->{$basename}{sha256}) {
4862 $self->debug("Found checksum for $basename:" .
4863 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
4867 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
4869 $fh = CPAN::Tarzip->TIEHANDLE($file);
4872 my $dg = Digest::SHA->new(256);
4875 while ($fh->READ($ref, 4096) > 0){
4878 my $hexdigest = $dg->hexdigest;
4879 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
4883 $CPAN::Frontend->myprint("Checksum for $file ok\n");
4884 return $self->{CHECKSUM_STATUS} = "OK";
4886 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
4887 qq{distribution file. }.
4888 qq{Please investigate.\n\n}.
4890 $CPAN::META->instance(
4895 my $wrap = qq{I\'d recommend removing $file. Its
4896 checksum is incorrect. Maybe you have configured your 'urllist' with
4897 a bad URL. Please check this array with 'o conf urllist', and
4900 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4902 # former versions just returned here but this seems a
4903 # serious threat that deserves a die
4905 # $CPAN::Frontend->myprint("\n\n");
4909 # close $fh if fileno($fh);
4911 $self->{CHECKSUM_STATUS} ||= "";
4912 if ($self->{CHECKSUM_STATUS} eq "NIL") {
4913 $CPAN::Frontend->mywarn(qq{
4914 Warning: No checksum for $basename in $chk_file.
4916 The cause for this may be that the file is very new and the checksum
4917 has not yet been calculated, but it may also be that something is
4918 going awry right now.
4920 my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
4921 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
4923 $self->{CHECKSUM_STATUS} = "NIL -- distro not in chk_file";
4928 #-> sub CPAN::Distribution::eq_CHECKSUM ;
4930 my($self,$fh,$expect) = @_;
4931 my $dg = Digest::SHA->new(256);
4933 while (read($fh, $data, 4096)){
4936 my $hexdigest = $dg->hexdigest;
4937 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
4938 $hexdigest eq $expect;
4941 #-> sub CPAN::Distribution::force ;
4943 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
4944 # effect by autoinspection, not by inspecting a global variable. One
4945 # of the reason why this was chosen to work that way was the treatment
4946 # of dependencies. They should not automatically inherit the force
4947 # status. But this has the downside that ^C and die() will return to
4948 # the prompt but will not be able to reset the force_update
4949 # attributes. We try to correct for it currently in the read_metadata
4950 # routine, and immediately before we check for a Signal. I hope this
4951 # works out in one of v1.57_53ff
4953 # "Force get forgets previous error conditions"
4955 #-> sub CPAN::Distribution::force ;
4957 my($self, $method) = @_;
4959 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
4960 writemakefile modulebuild make_test
4962 delete $self->{$att};
4964 if ($method && $method =~ /make|test|install/) {
4965 $self->{"force_update"}++; # name should probably have been force_install
4970 my($self, $method) = @_;
4971 # warn "XDEBUG: set notest for $self $method";
4972 $self->{"notest"}++; # name should probably have been force_install
4977 # warn "XDEBUG: deleting notest";
4978 delete $self->{'notest'};
4981 #-> sub CPAN::Distribution::unforce ;
4984 delete $self->{'force_update'};
4987 #-> sub CPAN::Distribution::isa_perl ;
4990 my $file = File::Basename::basename($self->id);
4991 if ($file =~ m{ ^ perl
5004 } elsif ($self->cpan_comment
5006 $self->cpan_comment =~ /isa_perl\(.+?\)/){
5012 #-> sub CPAN::Distribution::perl ;
5018 #-> sub CPAN::Distribution::make ;
5021 my $make = $self->{modulebuild} ? "Build" : "make";
5022 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
5023 # Emergency brake if they said install Pippi and get newest perl
5024 if ($self->isa_perl) {
5026 $self->called_for ne $self->id &&
5027 ! $self->{force_update}
5029 # if we die here, we break bundles
5030 $CPAN::Frontend->mywarn(sprintf qq{
5031 The most recent version "%s" of the module "%s"
5032 comes with the current version of perl (%s).
5033 I\'ll build that only if you ask for something like
5038 $CPAN::META->instance(
5051 delete $self->{force_update};
5056 !$self->{archived} || $self->{archived} eq "NO" and push @e,
5057 "Is neither a tar nor a zip archive.";
5059 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
5060 "Had problems unarchiving. Please build manually";
5062 unless ($self->{force_update}) {
5063 exists $self->{signature_verify} and (
5064 $self->{signature_verify}->can("failed") ?
5065 $self->{signature_verify}->failed :
5066 $self->{signature_verify} =~ /^NO/
5068 and push @e, "Did not pass the signature test.";
5071 if (exists $self->{writemakefile} &&
5073 $self->{writemakefile}->can("failed") ?
5074 $self->{writemakefile}->failed :
5075 $self->{writemakefile} =~ /^NO/
5077 # XXX maybe a retry would be in order?
5078 my $err = $self->{writemakefile}->can("text") ?
5079 $self->{writemakefile}->text :
5080 $self->{writemakefile};
5082 $err ||= "Had some problem writing Makefile";
5083 $err .= ", won't make";
5087 defined $self->{'make'} and push @e,
5088 "Has already been processed within this session";
5090 if (exists $self->{later} and length($self->{later})) {
5091 if ($self->unsat_prereq) {
5092 push @e, $self->{later};
5094 delete $self->{later};
5098 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5101 delete $self->{force_update};
5104 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
5105 my $builddir = $self->dir or
5106 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory");
5107 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
5108 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
5110 if ($^O eq 'MacOS') {
5111 Mac::BuildTools::make($self);
5116 if ($self->{'configure'}) {
5117 $system = $self->{'configure'};
5118 } elsif ($self->{modulebuild}) {
5119 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5120 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
5122 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
5124 # This needs a handler that can be turned on or off:
5125 # $switch = "-MExtUtils::MakeMaker ".
5126 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
5128 $system = sprintf("%s%s Makefile.PL%s",
5130 $switch ? " $switch" : "",
5131 $CPAN::Config->{makepl_arg} ? " $CPAN::Config->{makepl_arg}" : "",
5134 unless (exists $self->{writemakefile}) {
5135 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
5138 if ($CPAN::Config->{inactivity_timeout}) {
5140 alarm $CPAN::Config->{inactivity_timeout};
5141 local $SIG{CHLD}; # = sub { wait };
5142 if (defined($pid = fork)) {
5147 # note, this exec isn't necessary if
5148 # inactivity_timeout is 0. On the Mac I'd
5149 # suggest, we set it always to 0.
5153 $CPAN::Frontend->myprint("Cannot fork: $!");
5161 $CPAN::Frontend->myprint($@);
5162 $self->{writemakefile} = CPAN::Distrostatus->new("NO $@");
5167 $ret = system($system);
5169 $self->{writemakefile} = CPAN::Distrostatus
5170 ->new("NO '$system' returned status $ret");
5174 if (-f "Makefile" || -f "Build") {
5175 $self->{writemakefile} = CPAN::Distrostatus->new("YES");
5176 delete $self->{make_clean}; # if cleaned before, enable next
5178 $self->{writemakefile} = CPAN::Distrostatus
5179 ->new(qq{NO -- Unknown reason.});
5183 delete $self->{force_update};
5186 if (my @prereq = $self->unsat_prereq){
5187 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5189 if ($self->{modulebuild}) {
5190 $system = sprintf "%s %s", $self->_build_command(), $CPAN::Config->{mbuild_arg};
5192 $system = join " ", _make_command(), $CPAN::Config->{make_arg};
5194 if (system($system) == 0) {
5195 $CPAN::Frontend->myprint(" $system -- OK\n");
5196 $self->{'make'} = CPAN::Distrostatus->new("YES");
5198 $self->{writemakefile} ||= CPAN::Distrostatus->new("YES");
5199 $self->{'make'} = CPAN::Distrostatus->new("NO");
5200 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5205 return $CPAN::Config->{'make'} || $Config::Config{make} || 'make';
5208 #-> sub CPAN::Distribution::follow_prereqs ;
5209 sub follow_prereqs {
5211 my(@prereq) = grep {$_ ne "perl"} @_;
5212 return unless @prereq;
5214 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
5215 "during [$id] -----\n");
5217 for my $p (@prereq) {
5218 $CPAN::Frontend->myprint(" $p\n");
5221 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5223 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5224 require ExtUtils::MakeMaker;
5225 my $answer = ExtUtils::MakeMaker::prompt(
5226 "Shall I follow them and prepend them to the queue
5227 of modules we are processing right now?", "yes");
5228 $follow = $answer =~ /^\s*y/i;
5232 myprint(" Ignoring dependencies on modules @prereq\n");
5235 # color them as dirty
5236 for my $p (@prereq) {
5237 # warn "calling color_cmd_tmps(0,1)";
5238 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5240 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
5241 $self->{later} = "Delayed until after prerequisites";
5242 return 1; # signal success to the queuerunner
5246 #-> sub CPAN::Distribution::unsat_prereq ;
5249 my $prereq_pm = $self->prereq_pm or return;
5251 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
5252 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5253 # we were too demanding:
5254 next if $nmo->uptodate;
5256 # if they have not specified a version, we accept any installed one
5257 if (not defined $need_version or
5258 $need_version eq "0" or
5259 $need_version eq "undef") {
5260 next if defined $nmo->inst_file;
5263 # We only want to install prereqs if either they're not installed
5264 # or if the installed version is too old. We cannot omit this
5265 # check, because if 'force' is in effect, nobody else will check.
5266 if (defined $nmo->inst_file) {
5267 my(@all_requirements) = split /\s*,\s*/, $need_version;
5270 RQ: for my $rq (@all_requirements) {
5271 if ($rq =~ s|>=\s*||) {
5272 } elsif ($rq =~ s|>\s*||) {
5274 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5278 } elsif ($rq =~ s|!=\s*||) {
5280 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5286 } elsif ($rq =~ m|<=?\s*|) {
5288 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5292 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5295 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5299 CPAN::Version->readable($rq),
5303 next NEED if $ok == @all_requirements;
5306 if ($self->{sponsored_mods}{$need_module}++){
5307 # We have already sponsored it and for some reason it's still
5308 # not available. So we do nothing. Or what should we do?
5309 # if we push it again, we have a potential infinite loop
5312 push @need, $need_module;
5317 #-> sub CPAN::Distribution::read_yaml ;
5320 return $self->{yaml_content} if exists $self->{yaml_content};
5321 my $build_dir = $self->{build_dir};
5322 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5323 $self->debug("yaml[$yaml]") if $CPAN::DEBUG;
5324 return unless -f $yaml;
5325 if ($CPAN::META->has_inst("YAML")) {
5326 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5328 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5332 $self->debug("yaml_content[$self->{yaml_content}]") if $CPAN::DEBUG;
5333 return $self->{yaml_content};
5336 #-> sub CPAN::Distribution::prereq_pm ;
5339 return $self->{prereq_pm} if
5340 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5341 return unless $self->{writemakefile} # no need to have succeeded
5342 # but we must have run it
5343 || $self->{modulebuild};
5345 if (my $yaml = $self->read_yaml) {
5346 $req = $yaml->{requires};
5347 undef $req unless ref $req eq "HASH" && %$req;
5349 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5350 my $eummv = do { local $^W = 0; $1+0; };
5351 if ($eummv < 6.2501) {
5352 # thanks to Slaven for digging that out: MM before
5353 # that could be wrong because it could reflect a
5360 while (my($k,$v) = each %{$req||{}}) {
5363 } elsif ($k =~ /[A-Za-z]/ &&
5365 $CPAN::META->exists("Module",$v)
5367 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5368 "requires hash: $k => $v; I'll take both ".
5369 "key and value as a module name\n");
5376 $req = $areq if $do_replace;
5378 if ($yaml->{build_requires}
5379 && ref $yaml->{build_requires}
5380 && ref $yaml->{build_requires} eq "HASH") {
5381 while (my($k,$v) = each %{$yaml->{build_requires}}) {
5383 # merging of two "requires"-type values--what should we do?
5390 delete $req->{perl};
5394 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5395 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5399 $fh = FileHandle->new("<$makefile\0")) {
5402 last if /MakeMaker post_initialize section/;
5404 \s+PREREQ_PM\s+=>\s+(.+)
5407 # warn "Found prereq expr[$p]";
5409 # Regexp modified by A.Speer to remember actual version of file
5410 # PREREQ_PM hash key wants, then add to
5411 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5412 # In case a prereq is mentioned twice, complain.
5413 if ( defined $req->{$1} ) {
5414 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5415 "last mention wins";
5421 } elsif (-f "Build") {
5422 if ($CPAN::META->has_inst("Module::Build")) {
5423 my $requires = Module::Build->current->requires();
5424 my $brequires = Module::Build->current->build_requires();
5425 $req = { %$requires, %$brequires };
5429 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5430 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5431 "undeclared prerequisite.\n".
5432 " Adding it now as a prerequisite.\n"
5434 $CPAN::Frontend->mysleep(5);
5435 $req->{"Module::Build"} = 0;
5436 delete $self->{writemakefile};
5438 $self->{prereq_pm_detected}++;
5439 return $self->{prereq_pm} = $req;
5442 #-> sub CPAN::Distribution::test ;
5447 delete $self->{force_update};
5450 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5451 if ($self->{notest}) {
5452 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5456 my $make = $self->{modulebuild} ? "Build" : "make";
5457 $CPAN::Frontend->myprint("Running $make test\n");
5458 if (my @prereq = $self->unsat_prereq){
5459 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5463 unless (exists $self->{make} or exists $self->{later}) {
5465 "Make had some problems, won't test";
5468 exists $self->{make} and
5470 $self->{make}->can("failed") ?
5471 $self->{make}->failed :
5472 $self->{make} =~ /^NO/
5473 ) and push @e, "Can't test without successful make";
5475 exists $self->{build_dir} or push @e, "Has no own directory";
5476 $self->{badtestcnt} ||= 0;
5477 $self->{badtestcnt} > 0 and
5478 push @e, "Won't repeat unsuccessful test during this command";
5480 exists $self->{later} and length($self->{later}) and
5481 push @e, $self->{later};
5483 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5485 chdir $self->{'build_dir'} or
5486 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5487 $self->debug("Changed directory to $self->{'build_dir'}")
5490 if ($^O eq 'MacOS') {
5491 Mac::BuildTools::make_test($self);
5495 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5497 : ($ENV{PERLLIB} || "");
5499 $CPAN::META->set_perl5lib;
5500 local $ENV{MAKEFLAGS}; # protect us from outer make calls
5503 if ($self->{modulebuild}) {
5504 $system = sprintf "%s test", $self->_build_command();
5506 $system = join " ", _make_command(), "test";
5508 if (system($system) == 0) {
5509 $CPAN::Frontend->myprint(" $system -- OK\n");
5510 $CPAN::META->is_tested($self->{'build_dir'});
5511 $self->{make_test} = CPAN::Distrostatus->new("YES");
5513 $self->{make_test} = CPAN::Distrostatus->new("NO");
5514 $self->{badtestcnt}++;
5515 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5519 #-> sub CPAN::Distribution::clean ;
5522 my $make = $self->{modulebuild} ? "Build" : "make";
5523 $CPAN::Frontend->myprint("Running $make clean\n");
5524 unless (exists $self->{archived}) {
5525 $CPAN::Frontend->mywarn("Distribution seems to have never been unzipped".
5526 "/untarred, nothing done\n");
5529 unless (exists $self->{build_dir}) {
5530 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5535 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5536 push @e, "make clean already called once";
5537 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5539 chdir $self->{'build_dir'} or
5540 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5541 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5543 if ($^O eq 'MacOS') {
5544 Mac::BuildTools::make_clean($self);
5549 if ($self->{modulebuild}) {
5550 $system = sprintf "%s clean", $self->_build_command();
5552 $system = join " ", _make_command(), "clean";
5554 if (system($system) == 0) {
5555 $CPAN::Frontend->myprint(" $system -- OK\n");
5559 # Jost Krieger pointed out that this "force" was wrong because
5560 # it has the effect that the next "install" on this distribution
5561 # will untar everything again. Instead we should bring the
5562 # object's state back to where it is after untarring.
5573 $self->{make_clean} = "YES";
5576 # Hmmm, what to do if make clean failed?
5578 $CPAN::Frontend->myprint(qq{ $system -- NOT OK
5580 make clean did not succeed, marking directory as unusable for further work.
5582 $self->force("make"); # so that this directory won't be used again
5587 #-> sub CPAN::Distribution::install ;
5592 delete $self->{force_update};
5595 my $make = $self->{modulebuild} ? "Build" : "make";
5596 $CPAN::Frontend->myprint("Running $make install\n");
5599 exists $self->{build_dir} or push @e, "Has no own directory";
5601 unless (exists $self->{make} or exists $self->{later}) {
5603 "Make had some problems, won't install";
5606 exists $self->{make} and
5608 $self->{make}->can("failed") ?
5609 $self->{make}->failed :
5610 $self->{make} =~ /^NO/
5612 push @e, "make had returned bad status, install seems impossible";
5614 if (exists $self->{make_test} and
5616 $self->{make_test}->can("failed") ?
5617 $self->{make_test}->failed :
5618 $self->{make_test} =~ /^NO/
5620 if ($self->{force_update}) {
5621 $self->{make_test}->text("FAILED but failure ignored because ".
5622 "'force' in effect");
5624 push @e, "make test had returned bad status, ".
5625 "won't install without force"
5628 if (exists $self->{'install'}) {
5629 if ($self->{'install'}->can("text") ?
5630 $self->{'install'}->text eq "YES" :
5631 $self->{'install'} =~ /^YES/
5633 push @e, "Already done";
5635 # comment in Todo on 2006-02-11; maybe retry?
5636 push @e, "Already tried without success";
5640 exists $self->{later} and length($self->{later}) and
5641 push @e, $self->{later};
5643 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5645 chdir $self->{'build_dir'} or
5646 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5647 $self->debug("Changed directory to $self->{'build_dir'}")
5650 if ($^O eq 'MacOS') {
5651 Mac::BuildTools::make_install($self);
5656 if ($self->{modulebuild}) {
5657 my($mbuild_install_build_command) =
5658 exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
5659 $CPAN::Config->{mbuild_install_build_command} ?
5660 $CPAN::Config->{mbuild_install_build_command} :
5661 $self->_build_command();
5662 $system = sprintf("%s install %s",
5663 $mbuild_install_build_command,
5664 $CPAN::Config->{mbuild_install_arg},
5667 my($make_install_make_command) = $CPAN::Config->{'make_install_make_command'} ||
5669 $system = sprintf("%s install %s",
5670 $make_install_make_command,
5671 $CPAN::Config->{make_install_arg},
5675 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
5676 my($pipe) = FileHandle->new("$system $stderr |");
5679 $CPAN::Frontend->myprint($_);
5684 $CPAN::Frontend->myprint(" $system -- OK\n");
5685 $CPAN::META->is_installed($self->{build_dir});
5686 return $self->{install} = CPAN::Distrostatus->new("YES");
5688 $self->{install} = CPAN::Distrostatus->new("NO");
5689 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5691 $makeout =~ /permission/s
5694 ! $CPAN::Config->{make_install_make_command}
5695 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
5698 $CPAN::Frontend->myprint(
5700 qq{ You may have to su }.
5701 qq{to root to install the package\n}.
5702 qq{ (Or you may want to run something like\n}.
5703 qq{ o conf make_install_make_command 'sudo make'\n}.
5704 qq{ to raise your permissions.}
5708 delete $self->{force_update};
5711 #-> sub CPAN::Distribution::dir ;
5713 shift->{'build_dir'};
5716 #-> sub CPAN::Distribution::perldoc ;
5720 my($dist) = $self->id;
5721 my $package = $self->called_for;
5723 $self->_display_url( $CPAN::Defaultdocs . $package );
5726 #-> sub CPAN::Distribution::_check_binary ;
5728 my ($dist,$shell,$binary) = @_;
5731 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
5735 $pid = open README, "which $binary|"
5736 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
5740 close README or die "Could not run 'which $binary': $!";
5742 $CPAN::Frontend->myprint(qq{ + $out \n})
5743 if $CPAN::DEBUG && $out;
5748 #-> sub CPAN::Distribution::_display_url ;
5750 my($self,$url) = @_;
5751 my($res,$saved_file,$pid,$out);
5753 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
5756 # should we define it in the config instead?
5757 my $html_converter = "html2text";
5759 my $web_browser = $CPAN::Config->{'lynx'} || undef;
5760 my $web_browser_out = $web_browser
5761 ? CPAN::Distribution->_check_binary($self,$web_browser)
5764 if ($web_browser_out) {
5765 # web browser found, run the action
5766 my $browser = $CPAN::Config->{'lynx'};
5767 $CPAN::Frontend->myprint(qq{system[$browser $url]})
5769 $CPAN::Frontend->myprint(qq{
5772 with browser $browser
5775 system("$browser $url");
5776 if ($saved_file) { 1 while unlink($saved_file) }
5778 # web browser not found, let's try text only
5779 my $html_converter_out =
5780 CPAN::Distribution->_check_binary($self,$html_converter);
5782 if ($html_converter_out ) {
5783 # html2text found, run it
5784 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
5785 $CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n})
5786 unless defined($saved_file);
5789 $pid = open README, "$html_converter $saved_file |"
5790 or $CPAN::Frontend->mydie(qq{
5791 Could not fork '$html_converter $saved_file': $!});
5793 if ($CPAN::META->has_inst("File::Temp")) {
5794 $fh = File::Temp->new(
5795 template => 'cpan_htmlconvert_XXXX',
5799 $filename = $fh->filename;
5801 $filename = "cpan_htmlconvert_$$.txt";
5802 $fh = FileHandle->new();
5803 open $fh, ">$filename" or die;
5809 $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
5810 my $tmpin = $fh->filename;
5811 $CPAN::Frontend->myprint(sprintf(qq{
5813 saved output to %s\n},
5821 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
5822 my $fh_pager = FileHandle->new;
5823 local($SIG{PIPE}) = "IGNORE";
5824 $fh_pager->open("|$CPAN::Config->{'pager'}")
5825 or $CPAN::Frontend->mydie(qq{
5826 Could not open pager $CPAN::Config->{'pager'}: $!});
5827 $CPAN::Frontend->myprint(qq{
5830 with pager "$CPAN::Config->{'pager'}"
5833 $fh_pager->print(<FH>);
5836 # coldn't find the web browser or html converter
5837 $CPAN::Frontend->myprint(qq{
5838 You need to install lynx or $html_converter to use this feature.});
5843 #-> sub CPAN::Distribution::_getsave_url ;
5845 my($dist, $shell, $url) = @_;
5847 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
5851 if ($CPAN::META->has_inst("File::Temp")) {
5852 $fh = File::Temp->new(
5853 template => "cpan_getsave_url_XXXX",
5857 $filename = $fh->filename;
5859 $fh = FileHandle->new;
5860 $filename = "cpan_getsave_url_$$.html";
5862 my $tmpin = $filename;
5863 if ($CPAN::META->has_usable('LWP')) {
5864 $CPAN::Frontend->myprint("Fetching with LWP:
5868 CPAN::LWP::UserAgent->config;
5869 eval { $Ua = CPAN::LWP::UserAgent->new; };
5871 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
5875 $Ua->proxy('http', $var)
5876 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
5878 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
5881 my $req = HTTP::Request->new(GET => $url);
5882 $req->header('Accept' => 'text/html');
5883 my $res = $Ua->request($req);
5884 if ($res->is_success) {
5885 $CPAN::Frontend->myprint(" + request successful.\n")
5887 print $fh $res->content;
5889 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
5893 $CPAN::Frontend->myprint(sprintf(
5894 "LWP failed with code[%s], message[%s]\n",
5901 $CPAN::Frontend->myprint("LWP not available\n");
5906 # sub CPAN::Distribution::_build_command
5907 sub _build_command {
5909 if ($^O eq "MSWin32") { # special code needed at least up to
5910 # Module::Build 0.2611 and 0.2706; a fix
5911 # in M:B has been promised 2006-01-30
5912 my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n");
5913 return "$perl ./Build";
5918 package CPAN::Bundle;
5923 $CPAN::Frontend->myprint($self->as_string);
5928 delete $self->{later};
5929 for my $c ( $self->contains ) {
5930 my $obj = CPAN::Shell->expandany($c) or next;
5935 # mark as dirty/clean
5936 #-> sub CPAN::Bundle::color_cmd_tmps ;
5937 sub color_cmd_tmps {
5939 my($depth) = shift || 0;
5940 my($color) = shift || 0;
5941 my($ancestors) = shift || [];
5942 # a module needs to recurse to its cpan_file, a distribution needs
5943 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
5945 return if exists $self->{incommandcolor}
5946 && $self->{incommandcolor}==$color;
5948 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5950 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5952 for my $c ( $self->contains ) {
5953 my $obj = CPAN::Shell->expandany($c) or next;
5954 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
5955 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5958 delete $self->{badtestcnt};
5960 $self->{incommandcolor} = $color;
5963 #-> sub CPAN::Bundle::as_string ;
5967 # following line must be "=", not "||=" because we have a moving target
5968 $self->{INST_VERSION} = $self->inst_version;
5969 return $self->SUPER::as_string;
5972 #-> sub CPAN::Bundle::contains ;
5975 my($inst_file) = $self->inst_file || "";
5976 my($id) = $self->id;
5977 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
5978 unless ($inst_file) {
5979 # Try to get at it in the cpan directory
5980 $self->debug("no inst_file") if $CPAN::DEBUG;
5982 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
5983 $cpan_file = $self->cpan_file;
5984 if ($cpan_file eq "N/A") {
5985 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
5986 Maybe stale symlink? Maybe removed during session? Giving up.\n");
5988 my $dist = $CPAN::META->instance('CPAN::Distribution',
5991 $self->debug($dist->as_string) if $CPAN::DEBUG;
5992 my($todir) = $CPAN::Config->{'cpan_home'};
5993 my(@me,$from,$to,$me);
5994 @me = split /::/, $self->id;
5996 $me = File::Spec->catfile(@me);
5997 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
5998 $to = File::Spec->catfile($todir,$me);
5999 File::Path::mkpath(File::Basename::dirname($to));
6000 File::Copy::copy($from, $to)
6001 or Carp::confess("Couldn't copy $from to $to: $!");
6005 my $fh = FileHandle->new;
6007 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
6009 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
6011 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
6012 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
6013 next unless $in_cont;
6018 push @result, (split " ", $_, 2)[0];
6021 delete $self->{STATUS};
6022 $self->{CONTAINS} = \@result;
6023 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
6025 $CPAN::Frontend->mywarn(qq{
6026 The bundle file "$inst_file" may be a broken
6027 bundlefile. It seems not to contain any bundle definition.
6028 Please check the file and if it is bogus, please delete it.
6029 Sorry for the inconvenience.
6035 #-> sub CPAN::Bundle::find_bundle_file
6036 sub find_bundle_file {
6037 my($self,$where,$what) = @_;
6038 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
6039 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
6040 ### my $bu = File::Spec->catfile($where,$what);
6041 ### return $bu if -f $bu;
6042 my $manifest = File::Spec->catfile($where,"MANIFEST");
6043 unless (-f $manifest) {
6044 require ExtUtils::Manifest;
6045 my $cwd = CPAN::anycwd();
6046 chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
6047 ExtUtils::Manifest::mkmanifest();
6048 chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
6050 my $fh = FileHandle->new($manifest)
6051 or Carp::croak("Couldn't open $manifest: $!");
6054 if ($^O eq 'MacOS') {
6057 $what2 =~ s/:Bundle://;
6060 $what2 =~ s|Bundle[/\\]||;
6065 my($file) = /(\S+)/;
6066 if ($file =~ m|\Q$what\E$|) {
6068 # return File::Spec->catfile($where,$bu); # bad
6071 # retry if she managed to
6072 # have no Bundle directory
6073 $bu = $file if $file =~ m|\Q$what2\E$|;
6075 $bu =~ tr|/|:| if $^O eq 'MacOS';
6076 return File::Spec->catfile($where, $bu) if $bu;
6077 Carp::croak("Couldn't find a Bundle file in $where");
6080 # needs to work quite differently from Module::inst_file because of
6081 # cpan_home/Bundle/ directory and the possibility that we have
6082 # shadowing effect. As it makes no sense to take the first in @INC for
6083 # Bundles, we parse them all for $VERSION and take the newest.
6085 #-> sub CPAN::Bundle::inst_file ;
6090 @me = split /::/, $self->id;
6093 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
6094 my $bfile = File::Spec->catfile($incdir, @me);
6095 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
6096 next unless -f $bfile;
6097 my $foundv = MM->parse_version($bfile);
6098 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
6099 $self->{INST_FILE} = $bfile;
6100 $self->{INST_VERSION} = $bestv = $foundv;
6106 #-> sub CPAN::Bundle::inst_version ;
6109 $self->inst_file; # finds INST_VERSION as side effect
6110 $self->{INST_VERSION};
6113 #-> sub CPAN::Bundle::rematein ;
6115 my($self,$meth) = @_;
6116 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
6117 my($id) = $self->id;
6118 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
6119 unless $self->inst_file || $self->cpan_file;
6121 for $s ($self->contains) {
6122 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
6123 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
6124 if ($type eq 'CPAN::Distribution') {
6125 $CPAN::Frontend->mywarn(qq{
6126 The Bundle }.$self->id.qq{ contains
6127 explicitly a file $s.
6131 # possibly noisy action:
6132 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
6133 my $obj = $CPAN::META->instance($type,$s);
6135 if ($obj->isa('CPAN::Bundle')
6137 exists $obj->{install_failed}
6139 ref($obj->{install_failed}) eq "HASH"
6141 for (keys %{$obj->{install_failed}}) {
6142 $self->{install_failed}{$_} = undef; # propagate faiure up
6145 $fail{$s} = 1; # the bundle itself may have succeeded but
6150 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
6151 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
6153 delete $self->{install_failed}{$s};
6160 # recap with less noise
6161 if ( $meth eq "install" ) {
6164 my $raw = sprintf(qq{Bundle summary:
6165 The following items in bundle %s had installation problems:},
6168 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
6169 $CPAN::Frontend->myprint("\n");
6172 for $s ($self->contains) {
6174 $paragraph .= "$s ";
6175 $self->{install_failed}{$s} = undef;
6176 $reported{$s} = undef;
6179 my $report_propagated;
6180 for $s (sort keys %{$self->{install_failed}}) {
6181 next if exists $reported{$s};
6182 $paragraph .= "and the following items had problems
6183 during recursive bundle calls: " unless $report_propagated++;
6184 $paragraph .= "$s ";
6186 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
6187 $CPAN::Frontend->myprint("\n");
6189 $self->{'install'} = 'YES';
6194 #sub CPAN::Bundle::xs_file
6196 # If a bundle contains another that contains an xs_file we have
6197 # here, we just don't bother I suppose
6201 #-> sub CPAN::Bundle::force ;
6202 sub force { shift->rematein('force',@_); }
6203 #-> sub CPAN::Bundle::notest ;
6204 sub notest { shift->rematein('notest',@_); }
6205 #-> sub CPAN::Bundle::get ;
6206 sub get { shift->rematein('get',@_); }
6207 #-> sub CPAN::Bundle::make ;
6208 sub make { shift->rematein('make',@_); }
6209 #-> sub CPAN::Bundle::test ;
6212 $self->{badtestcnt} ||= 0;
6213 $self->rematein('test',@_);
6215 #-> sub CPAN::Bundle::install ;
6218 $self->rematein('install',@_);
6220 #-> sub CPAN::Bundle::clean ;
6221 sub clean { shift->rematein('clean',@_); }
6223 #-> sub CPAN::Bundle::uptodate ;
6226 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
6228 foreach $c ($self->contains) {
6229 my $obj = CPAN::Shell->expandany($c);
6230 return 0 unless $obj->uptodate;
6235 #-> sub CPAN::Bundle::readme ;
6238 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
6239 No File found for bundle } . $self->id . qq{\n}), return;
6240 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
6241 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
6244 package CPAN::Module;
6248 # sub CPAN::Module::userid
6253 return $ro->{userid} || $ro->{CPAN_USERID};
6255 # sub CPAN::Module::description
6258 my $ro = $self->ro or return "";
6264 CPAN::Shell->expand("Distribution",$self->cpan_file);
6267 # sub CPAN::Module::undelay
6270 delete $self->{later};
6271 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6276 # mark as dirty/clean
6277 #-> sub CPAN::Module::color_cmd_tmps ;
6278 sub color_cmd_tmps {
6280 my($depth) = shift || 0;
6281 my($color) = shift || 0;
6282 my($ancestors) = shift || [];
6283 # a module needs to recurse to its cpan_file
6285 return if exists $self->{incommandcolor}
6286 && $self->{incommandcolor}==$color;
6287 return if $depth>=1 && $self->uptodate;
6289 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6291 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6293 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6294 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6297 delete $self->{badtestcnt};
6299 $self->{incommandcolor} = $color;
6302 #-> sub CPAN::Module::as_glimpse ;
6306 my $class = ref($self);
6307 $class =~ s/^CPAN:://;
6311 $CPAN::Shell::COLOR_REGISTERED
6313 $CPAN::META->has_inst("Term::ANSIColor")
6317 $color_on = Term::ANSIColor::color("green");
6318 $color_off = Term::ANSIColor::color("reset");
6320 push @m, sprintf("%-8s %s%-22s%s (%s)\n",
6325 $self->distribution ? $self->distribution->pretty_id : $self->id,
6330 #-> sub CPAN::Module::as_string ;
6334 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6335 my $class = ref($self);
6336 $class =~ s/^CPAN:://;
6338 push @m, $class, " id = $self->{ID}\n";
6339 my $sprintf = " %-12s %s\n";
6340 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6341 if $self->description;
6342 my $sprintf2 = " %-12s %s (%s)\n";
6344 $userid = $self->userid;
6347 if ($author = CPAN::Shell->expand('Author',$userid)) {
6350 if ($m = $author->email) {
6357 $author->fullname . $email
6361 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6362 if $self->cpan_version;
6363 if (my $cpan_file = $self->cpan_file){
6364 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6365 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6366 my $upload_date = $dist->upload_date;
6368 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6372 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
6373 my(%statd,%stats,%statl,%stati);
6374 @statd{qw,? i c a b R M S,} = qw,unknown idea
6375 pre-alpha alpha beta released mature standard,;
6376 @stats{qw,? m d u n a,} = qw,unknown mailing-list
6377 developer comp.lang.perl.* none abandoned,;
6378 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
6379 @stati{qw,? f r O h,} = qw,unknown functions
6380 references+ties object-oriented hybrid,;
6381 $statd{' '} = 'unknown';
6382 $stats{' '} = 'unknown';
6383 $statl{' '} = 'unknown';
6384 $stati{' '} = 'unknown';
6393 $statd{$ro->{statd}},
6394 $stats{$ro->{stats}},
6395 $statl{$ro->{statl}},
6396 $stati{$ro->{stati}}
6397 ) if $ro && $ro->{statd};
6398 my $local_file = $self->inst_file;
6399 unless ($self->{MANPAGE}) {
6401 $self->{MANPAGE} = $self->manpage_headline($local_file);
6403 # If we have already untarred it, we should look there
6404 my $dist = $CPAN::META->instance('CPAN::Distribution',
6406 # warn "dist[$dist]";
6407 # mff=manifest file; mfh=manifest handle
6412 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6414 $mfh = FileHandle->new($mff)
6416 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6417 my $lfre = $self->id; # local file RE
6420 my($lfl); # local file file
6422 my(@mflines) = <$mfh>;
6427 while (length($lfre)>5 and !$lfl) {
6428 ($lfl) = grep /$lfre/, @mflines;
6429 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6432 $lfl =~ s/\s.*//; # remove comments
6433 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6434 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6435 # warn "lfl_abs[$lfl_abs]";
6437 $self->{MANPAGE} = $self->manpage_headline($lfl_abs);
6443 for $item (qw/MANPAGE/) {
6444 push @m, sprintf($sprintf, $item, $self->{$item})
6445 if exists $self->{$item};
6447 for $item (qw/CONTAINS/) {
6448 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6449 if exists $self->{$item} && @{$self->{$item}};
6451 push @m, sprintf($sprintf, 'INST_FILE',
6452 $local_file || "(not installed)");
6453 push @m, sprintf($sprintf, 'INST_VERSION',
6454 $self->inst_version) if $local_file;
6458 sub manpage_headline {
6459 my($self,$local_file) = @_;
6460 my(@local_file) = $local_file;
6461 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6462 push @local_file, $local_file;
6464 for $locf (@local_file) {
6465 next unless -f $locf;
6466 my $fh = FileHandle->new($locf)
6467 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6471 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6472 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6489 #-> sub CPAN::Module::cpan_file ;
6490 # Note: also inherited by CPAN::Bundle
6493 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6494 unless ($self->ro) {
6495 CPAN::Index->reload;
6498 if ($ro && defined $ro->{CPAN_FILE}){
6499 return $ro->{CPAN_FILE};
6501 my $userid = $self->userid;
6503 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6504 my $author = $CPAN::META->instance("CPAN::Author",
6506 my $fullname = $author->fullname;
6507 my $email = $author->email;
6508 unless (defined $fullname && defined $email) {
6509 return sprintf("Contact Author %s",
6513 return "Contact Author $fullname <$email>";
6515 return "Contact Author $userid (Email address not available)";
6523 #-> sub CPAN::Module::cpan_version ;
6529 # Can happen with modules that are not on CPAN
6532 $ro->{CPAN_VERSION} = 'undef'
6533 unless defined $ro->{CPAN_VERSION};
6534 $ro->{CPAN_VERSION};
6537 #-> sub CPAN::Module::force ;
6540 $self->{'force_update'}++;
6545 # warn "XDEBUG: set notest for Module";
6546 $self->{'notest'}++;
6549 #-> sub CPAN::Module::rematein ;
6551 my($self,$meth) = @_;
6552 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
6555 my $cpan_file = $self->cpan_file;
6556 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
6557 $CPAN::Frontend->mywarn(sprintf qq{
6558 The module %s isn\'t available on CPAN.
6560 Either the module has not yet been uploaded to CPAN, or it is
6561 temporary unavailable. Please contact the author to find out
6562 more about the status. Try 'i %s'.
6569 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
6570 $pack->called_for($self->id);
6571 $pack->force($meth) if exists $self->{'force_update'};
6572 $pack->notest($meth) if exists $self->{'notest'};
6577 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
6578 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
6579 delete $self->{'force_update'};
6580 delete $self->{'notest'};
6586 #-> sub CPAN::Module::perldoc ;
6587 sub perldoc { shift->rematein('perldoc') }
6588 #-> sub CPAN::Module::readme ;
6589 sub readme { shift->rematein('readme') }
6590 #-> sub CPAN::Module::look ;
6591 sub look { shift->rematein('look') }
6592 #-> sub CPAN::Module::cvs_import ;
6593 sub cvs_import { shift->rematein('cvs_import') }
6594 #-> sub CPAN::Module::get ;
6595 sub get { shift->rematein('get',@_) }
6596 #-> sub CPAN::Module::make ;
6597 sub make { shift->rematein('make') }
6598 #-> sub CPAN::Module::test ;
6601 $self->{badtestcnt} ||= 0;
6602 $self->rematein('test',@_);
6604 #-> sub CPAN::Module::uptodate ;
6607 my($latest) = $self->cpan_version;
6609 my($inst_file) = $self->inst_file;
6611 if (defined $inst_file) {
6612 $have = $self->inst_version;
6617 ! CPAN::Version->vgt($latest, $have)
6619 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
6620 "latest[$latest] have[$have]") if $CPAN::DEBUG;
6625 #-> sub CPAN::Module::install ;
6631 not exists $self->{'force_update'}
6633 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
6635 $self->inst_version,
6641 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
6642 $CPAN::Frontend->mywarn(qq{
6643 \n\n\n ***WARNING***
6644 The module $self->{ID} has no active maintainer.\n\n\n
6648 $self->rematein('install') if $doit;
6650 #-> sub CPAN::Module::clean ;
6651 sub clean { shift->rematein('clean') }
6653 #-> sub CPAN::Module::inst_file ;
6657 @packpath = split /::/, $self->{ID};
6658 $packpath[-1] .= ".pm";
6659 foreach $dir (@INC) {
6660 my $pmfile = File::Spec->catfile($dir,@packpath);
6668 #-> sub CPAN::Module::xs_file ;
6672 @packpath = split /::/, $self->{ID};
6673 push @packpath, $packpath[-1];
6674 $packpath[-1] .= "." . $Config::Config{'dlext'};
6675 foreach $dir (@INC) {
6676 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
6684 #-> sub CPAN::Module::inst_version ;
6687 my $parsefile = $self->inst_file or return;
6688 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
6691 $have = MM->parse_version($parsefile) || "undef";
6692 $have =~ s/^ //; # since the %vd hack these two lines here are needed
6693 $have =~ s/ $//; # trailing whitespace happens all the time
6695 # My thoughts about why %vd processing should happen here
6697 # Alt1 maintain it as string with leading v:
6698 # read index files do nothing
6699 # compare it use utility for compare
6700 # print it do nothing
6702 # Alt2 maintain it as what it is
6703 # read index files convert
6704 # compare it use utility because there's still a ">" vs "gt" issue
6705 # print it use CPAN::Version for print
6707 # Seems cleaner to hold it in memory as a string starting with a "v"
6709 # If the author of this module made a mistake and wrote a quoted
6710 # "v1.13" instead of v1.13, we simply leave it at that with the
6711 # effect that *we* will treat it like a v-tring while the rest of
6712 # perl won't. Seems sensible when we consider that any action we
6713 # could take now would just add complexity.
6715 $have = CPAN::Version->readable($have);
6717 $have =~ s/\s*//g; # stringify to float around floating point issues
6718 $have; # no stringify needed, \s* above matches always
6730 CPAN - query, download and build perl modules from CPAN sites
6736 perl -MCPAN -e shell;
6744 $mod = "Acme::Meta";
6746 CPAN::Shell->install($mod); # same thing
6747 CPAN::Shell->expandany($mod)->install; # same thing
6748 CPAN::Shell->expand("Module",$mod)->install; # same thing
6749 CPAN::Shell->expand("Module",$mod)
6750 ->distribution->install; # same thing
6754 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
6755 install $distro; # same thing
6756 CPAN::Shell->install($distro); # same thing
6757 CPAN::Shell->expandany($distro)->install; # same thing
6758 CPAN::Shell->expand("Module",$distro)->install; # same thing
6762 This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
6763 of a modern rewrite from ground up with greater extensibility and more
6764 features but no full compatibility. If you're new to CPAN.pm, you
6765 probably should investigate if CPANPLUS is the better choice for you.
6766 If you're already used to CPAN.pm you're welcome to continue using it,
6767 if you accept that its development is mostly (though not completely)
6772 The CPAN module is designed to automate the make and install of perl
6773 modules and extensions. It includes some primitive searching
6774 capabilities and knows how to use Net::FTP or LWP (or some external
6775 download clients) to fetch the raw data from the net.
6777 Modules are fetched from one or more of the mirrored CPAN
6778 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
6781 The CPAN module also supports the concept of named and versioned
6782 I<bundles> of modules. Bundles simplify the handling of sets of
6783 related modules. See Bundles below.
6785 The package contains a session manager and a cache manager. There is
6786 no status retained between sessions. The session manager keeps track
6787 of what has been fetched, built and installed in the current
6788 session. The cache manager keeps track of the disk space occupied by
6789 the make processes and deletes excess space according to a simple FIFO
6792 All methods provided are accessible in a programmer style and in an
6793 interactive shell style.
6795 =head2 Interactive Mode
6797 The interactive mode is entered by running
6799 perl -MCPAN -e shell
6801 which puts you into a readline interface. You will have the most fun if
6802 you install Term::ReadKey and Term::ReadLine to enjoy both history and
6805 Once you are on the command line, type 'h' and the rest should be
6808 The function call C<shell> takes two optional arguments, one is the
6809 prompt, the second is the default initial command line (the latter
6810 only works if a real ReadLine interface module is installed).
6812 The most common uses of the interactive modes are
6816 =item Searching for authors, bundles, distribution files and modules
6818 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
6819 for each of the four categories and another, C<i> for any of the
6820 mentioned four. Each of the four entities is implemented as a class
6821 with slightly differing methods for displaying an object.
6823 Arguments you pass to these commands are either strings exactly matching
6824 the identification string of an object or regular expressions that are
6825 then matched case-insensitively against various attributes of the
6826 objects. The parser recognizes a regular expression only if you
6827 enclose it between two slashes.
6829 The principle is that the number of found objects influences how an
6830 item is displayed. If the search finds one item, the result is
6831 displayed with the rather verbose method C<as_string>, but if we find
6832 more than one, we display each object with the terse method
6835 =item make, test, install, clean modules or distributions
6837 These commands take any number of arguments and investigate what is
6838 necessary to perform the action. If the argument is a distribution
6839 file name (recognized by embedded slashes), it is processed. If it is
6840 a module, CPAN determines the distribution file in which this module
6841 is included and processes that, following any dependencies named in
6842 the module's META.yml or Makefile.PL (this behavior is controlled by
6843 the configuration parameter C<prerequisites_policy>.)
6845 Any C<make> or C<test> are run unconditionally. An
6847 install <distribution_file>
6849 also is run unconditionally. But for
6853 CPAN checks if an install is actually needed for it and prints
6854 I<module up to date> in the case that the distribution file containing
6855 the module doesn't need to be updated.
6857 CPAN also keeps track of what it has done within the current session
6858 and doesn't try to build a package a second time regardless if it
6859 succeeded or not. The C<force> pragma may precede another command
6860 (currently: C<make>, C<test>, or C<install>) and executes the
6861 command from scratch and tries to continue in case of some errors.
6865 cpan> install OpenGL
6866 OpenGL is up to date.
6867 cpan> force install OpenGL
6870 OpenGL-0.4/COPYRIGHT
6873 The C<notest> pragma may be set to skip the test part in the build
6878 cpan> notest install Tk
6880 A C<clean> command results in a
6884 being executed within the distribution file's working directory.
6886 =item get, readme, perldoc, look module or distribution
6888 C<get> downloads a distribution file without further action. C<readme>
6889 displays the README file of the associated distribution. C<Look> gets
6890 and untars (if not yet done) the distribution file, changes to the
6891 appropriate directory and opens a subshell process in that directory.
6892 C<perldoc> displays the pod documentation of the module in html or
6897 =item ls globbing_expression
6899 The first form lists all distribution files in and below an author's
6900 CPAN directory as they are stored in the CHECKUMS files distributed on
6901 CPAN. The listing goes recursive into all subdirectories.
6903 The second form allows to limit or expand the output with shell
6904 globbing as in the following examples:
6910 The last example is very slow and outputs extra progress indicators
6911 that break the alignment of the result.
6913 Note that globbing only lists directories explicitly asked for, for
6914 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
6915 regarded as a bug and may be changed in future versions.
6919 The C<failed> command reports all distributions that failed on one of
6920 C<make>, C<test> or C<install> for some reason in the currently
6921 running shell session.
6925 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
6926 (but the directory can be configured via the C<cpan_home> config
6927 variable). The shell is a bit picky if you try to start another CPAN
6928 session. It dies immediately if there is a lockfile and the lock seems
6929 to belong to a running process. In case you want to run a second shell
6930 session, it is probably safest to maintain another directory, say
6931 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
6932 contains the configuration options. Then you can start the second
6935 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
6939 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
6940 in the cpan-shell it is intended that you can press C<^C> anytime and
6941 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
6942 to clean up and leave the shell loop. You can emulate the effect of a
6943 SIGTERM by sending two consecutive SIGINTs, which usually means by
6944 pressing C<^C> twice.
6946 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
6947 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
6948 Build.PL> subprocess.
6954 The commands that are available in the shell interface are methods in
6955 the package CPAN::Shell. If you enter the shell command, all your
6956 input is split by the Text::ParseWords::shellwords() routine which
6957 acts like most shells do. The first word is being interpreted as the
6958 method to be called and the rest of the words are treated as arguments
6959 to this method. Continuation lines are supported if a line ends with a
6964 C<autobundle> writes a bundle file into the
6965 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
6966 a list of all modules that are both available from CPAN and currently
6967 installed within @INC. The name of the bundle file is based on the
6968 current date and a counter.
6972 recompile() is a very special command in that it takes no argument and
6973 runs the make/test/install cycle with brute force over all installed
6974 dynamically loadable extensions (aka XS modules) with 'force' in
6975 effect. The primary purpose of this command is to finish a network
6976 installation. Imagine, you have a common source tree for two different
6977 architectures. You decide to do a completely independent fresh
6978 installation. You start on one architecture with the help of a Bundle
6979 file produced earlier. CPAN installs the whole Bundle for you, but
6980 when you try to repeat the job on the second architecture, CPAN
6981 responds with a C<"Foo up to date"> message for all modules. So you
6982 invoke CPAN's recompile on the second architecture and you're done.
6984 Another popular use for C<recompile> is to act as a rescue in case your
6985 perl breaks binary compatibility. If one of the modules that CPAN uses
6986 is in turn depending on binary compatibility (so you cannot run CPAN
6987 commands), then you should try the CPAN::Nox module for recovery.
6991 mkmyconfig() writes your own CPAN::MyConfig file into your ~/.cpan/
6992 directory so that you can save your own preferences instead of the
6995 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
6997 Although it may be considered internal, the class hierarchy does matter
6998 for both users and programmer. CPAN.pm deals with above mentioned four
6999 classes, and all those classes share a set of methods. A classical
7000 single polymorphism is in effect. A metaclass object registers all
7001 objects of all kinds and indexes them with a string. The strings
7002 referencing objects have a separated namespace (well, not completely
7007 words containing a "/" (slash) Distribution
7008 words starting with Bundle:: Bundle
7009 everything else Module or Author
7011 Modules know their associated Distribution objects. They always refer
7012 to the most recent official release. Developers may mark their releases
7013 as unstable development versions (by inserting an underbar into the
7014 module version number which will also be reflected in the distribution
7015 name when you run 'make dist'), so the really hottest and newest
7016 distribution is not always the default. If a module Foo circulates
7017 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
7018 way to install version 1.23 by saying
7022 This would install the complete distribution file (say
7023 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
7024 like to install version 1.23_90, you need to know where the
7025 distribution file resides on CPAN relative to the authors/id/
7026 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
7027 so you would have to say
7029 install BAR/Foo-1.23_90.tar.gz
7031 The first example will be driven by an object of the class
7032 CPAN::Module, the second by an object of class CPAN::Distribution.
7034 =head2 Programmer's interface
7036 If you do not enter the shell, the available shell commands are both
7037 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
7038 functions in the calling package (C<install(...)>).
7040 There's currently only one class that has a stable interface -
7041 CPAN::Shell. All commands that are available in the CPAN shell are
7042 methods of the class CPAN::Shell. Each of the commands that produce
7043 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
7044 the IDs of all modules within the list.
7048 =item expand($type,@things)
7050 The IDs of all objects available within a program are strings that can
7051 be expanded to the corresponding real objects with the
7052 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
7053 list of CPAN::Module objects according to the C<@things> arguments
7054 given. In scalar context it only returns the first element of the
7057 =item expandany(@things)
7059 Like expand, but returns objects of the appropriate type, i.e.
7060 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
7061 CPAN::Distribution objects for distributions. Note: it does not expand
7062 to CPAN::Author objects.
7064 =item Programming Examples
7066 This enables the programmer to do operations that combine
7067 functionalities that are available in the shell.
7069 # install everything that is outdated on my disk:
7070 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
7072 # install my favorite programs if necessary:
7073 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
7074 my $obj = CPAN::Shell->expand('Module',$mod);
7078 # list all modules on my disk that have no VERSION number
7079 for $mod (CPAN::Shell->expand("Module","/./")){
7080 next unless $mod->inst_file;
7081 # MakeMaker convention for undefined $VERSION:
7082 next unless $mod->inst_version eq "undef";
7083 print "No VERSION in ", $mod->id, "\n";
7086 # find out which distribution on CPAN contains a module:
7087 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
7089 Or if you want to write a cronjob to watch The CPAN, you could list
7090 all modules that need updating. First a quick and dirty way:
7092 perl -e 'use CPAN; CPAN::Shell->r;'
7094 If you don't want to get any output in the case that all modules are
7095 up to date, you can parse the output of above command for the regular
7096 expression //modules are up to date// and decide to mail the output
7097 only if it doesn't match. Ick?
7099 If you prefer to do it more in a programmer style in one single
7100 process, maybe something like this suits you better:
7102 # list all modules on my disk that have newer versions on CPAN
7103 for $mod (CPAN::Shell->expand("Module","/./")){
7104 next unless $mod->inst_file;
7105 next if $mod->uptodate;
7106 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
7107 $mod->id, $mod->inst_version, $mod->cpan_version;
7110 If that gives you too much output every day, you maybe only want to
7111 watch for three modules. You can write
7113 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
7115 as the first line instead. Or you can combine some of the above
7118 # watch only for a new mod_perl module
7119 $mod = CPAN::Shell->expand("Module","mod_perl");
7120 exit if $mod->uptodate;
7121 # new mod_perl arrived, let me know all update recommendations
7126 =head2 Methods in the other Classes
7128 The programming interface for the classes CPAN::Module,
7129 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
7130 beta and partially even alpha. In the following paragraphs only those
7131 methods are documented that have proven useful over a longer time and
7132 thus are unlikely to change.
7136 =item CPAN::Author::as_glimpse()
7138 Returns a one-line description of the author
7140 =item CPAN::Author::as_string()
7142 Returns a multi-line description of the author
7144 =item CPAN::Author::email()
7146 Returns the author's email address
7148 =item CPAN::Author::fullname()
7150 Returns the author's name
7152 =item CPAN::Author::name()
7154 An alias for fullname
7156 =item CPAN::Bundle::as_glimpse()
7158 Returns a one-line description of the bundle
7160 =item CPAN::Bundle::as_string()
7162 Returns a multi-line description of the bundle
7164 =item CPAN::Bundle::clean()
7166 Recursively runs the C<clean> method on all items contained in the bundle.
7168 =item CPAN::Bundle::contains()
7170 Returns a list of objects' IDs contained in a bundle. The associated
7171 objects may be bundles, modules or distributions.
7173 =item CPAN::Bundle::force($method,@args)
7175 Forces CPAN to perform a task that normally would have failed. Force
7176 takes as arguments a method name to be called and any number of
7177 additional arguments that should be passed to the called method. The
7178 internals of the object get the needed changes so that CPAN.pm does
7179 not refuse to take the action. The C<force> is passed recursively to
7180 all contained objects.
7182 =item CPAN::Bundle::get()
7184 Recursively runs the C<get> method on all items contained in the bundle
7186 =item CPAN::Bundle::inst_file()
7188 Returns the highest installed version of the bundle in either @INC or
7189 C<$CPAN::Config->{cpan_home}>. Note that this is different from
7190 CPAN::Module::inst_file.
7192 =item CPAN::Bundle::inst_version()
7194 Like CPAN::Bundle::inst_file, but returns the $VERSION
7196 =item CPAN::Bundle::uptodate()
7198 Returns 1 if the bundle itself and all its members are uptodate.
7200 =item CPAN::Bundle::install()
7202 Recursively runs the C<install> method on all items contained in the bundle
7204 =item CPAN::Bundle::make()
7206 Recursively runs the C<make> method on all items contained in the bundle
7208 =item CPAN::Bundle::readme()
7210 Recursively runs the C<readme> method on all items contained in the bundle
7212 =item CPAN::Bundle::test()
7214 Recursively runs the C<test> method on all items contained in the bundle
7216 =item CPAN::Distribution::as_glimpse()
7218 Returns a one-line description of the distribution
7220 =item CPAN::Distribution::as_string()
7222 Returns a multi-line description of the distribution
7224 =item CPAN::Distribution::author
7226 Returns the CPAN::Author object of the maintainer who uploaded this
7229 =item CPAN::Distribution::clean()
7231 Changes to the directory where the distribution has been unpacked and
7232 runs C<make clean> there.
7234 =item CPAN::Distribution::containsmods()
7236 Returns a list of IDs of modules contained in a distribution file.
7237 Only works for distributions listed in the 02packages.details.txt.gz
7238 file. This typically means that only the most recent version of a
7239 distribution is covered.
7241 =item CPAN::Distribution::cvs_import()
7243 Changes to the directory where the distribution has been unpacked and
7246 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
7250 =item CPAN::Distribution::dir()
7252 Returns the directory into which this distribution has been unpacked.
7254 =item CPAN::Distribution::force($method,@args)
7256 Forces CPAN to perform a task that normally would have failed. Force
7257 takes as arguments a method name to be called and any number of
7258 additional arguments that should be passed to the called method. The
7259 internals of the object get the needed changes so that CPAN.pm does
7260 not refuse to take the action.
7262 =item CPAN::Distribution::get()
7264 Downloads the distribution from CPAN and unpacks it. Does nothing if
7265 the distribution has already been downloaded and unpacked within the
7268 =item CPAN::Distribution::install()
7270 Changes to the directory where the distribution has been unpacked and
7271 runs the external command C<make install> there. If C<make> has not
7272 yet been run, it will be run first. A C<make test> will be issued in
7273 any case and if this fails, the install will be canceled. The
7274 cancellation can be avoided by letting C<force> run the C<install> for
7277 =item CPAN::Distribution::isa_perl()
7279 Returns 1 if this distribution file seems to be a perl distribution.
7280 Normally this is derived from the file name only, but the index from
7281 CPAN can contain a hint to achieve a return value of true for other
7284 =item CPAN::Distribution::look()
7286 Changes to the directory where the distribution has been unpacked and
7287 opens a subshell there. Exiting the subshell returns.
7289 =item CPAN::Distribution::make()
7291 First runs the C<get> method to make sure the distribution is
7292 downloaded and unpacked. Changes to the directory where the
7293 distribution has been unpacked and runs the external commands C<perl
7294 Makefile.PL> or C<perl Build.PL> and C<make> there.
7296 =item CPAN::Distribution::perldoc()
7298 Downloads the pod documentation of the file associated with a
7299 distribution (in html format) and runs it through the external
7300 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
7301 isn't available, it converts it to plain text with external
7302 command html2text and runs it through the pager specified
7303 in C<$CPAN::Config->{pager}>
7305 =item CPAN::Distribution::prereq_pm()
7307 Returns the hash reference that has been announced by a distribution
7308 as the merge of the C<requires> element and the C<build_requires>
7309 element of the META.yml or the C<PREREQ_PM> hash in the
7310 C<Makefile.PL>. Note: works only after an attempt has been made to
7311 C<make> the distribution. Returns undef otherwise.
7313 =item CPAN::Distribution::readme()
7315 Downloads the README file associated with a distribution and runs it
7316 through the pager specified in C<$CPAN::Config->{pager}>.
7318 =item CPAN::Distribution::read_yaml()
7320 Returns the content of the META.yml of this distro as a hashref. Note:
7321 works only after an attempt has been made to C<make> the distribution.
7322 Returns undef otherwise.
7324 =item CPAN::Distribution::test()
7326 Changes to the directory where the distribution has been unpacked and
7327 runs C<make test> there.
7329 =item CPAN::Distribution::uptodate()
7331 Returns 1 if all the modules contained in the distribution are
7332 uptodate. Relies on containsmods.
7334 =item CPAN::Index::force_reload()
7336 Forces a reload of all indices.
7338 =item CPAN::Index::reload()
7340 Reloads all indices if they have not been read for more than
7341 C<$CPAN::Config->{index_expire}> days.
7343 =item CPAN::InfoObj::dump()
7345 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7346 inherit this method. It prints the data structure associated with an
7347 object. Useful for debugging. Note: the data structure is considered
7348 internal and thus subject to change without notice.
7350 =item CPAN::Module::as_glimpse()
7352 Returns a one-line description of the module
7354 =item CPAN::Module::as_string()
7356 Returns a multi-line description of the module
7358 =item CPAN::Module::clean()
7360 Runs a clean on the distribution associated with this module.
7362 =item CPAN::Module::cpan_file()
7364 Returns the filename on CPAN that is associated with the module.
7366 =item CPAN::Module::cpan_version()
7368 Returns the latest version of this module available on CPAN.
7370 =item CPAN::Module::cvs_import()
7372 Runs a cvs_import on the distribution associated with this module.
7374 =item CPAN::Module::description()
7376 Returns a 44 character description of this module. Only available for
7377 modules listed in The Module List (CPAN/modules/00modlist.long.html
7378 or 00modlist.long.txt.gz)
7380 =item CPAN::Module::distribution()
7382 Returns the CPAN::Distribution object that contains the current
7383 version of this module.
7385 =item CPAN::Module::force($method,@args)
7387 Forces CPAN to perform a task that normally would have failed. Force
7388 takes as arguments a method name to be called and any number of
7389 additional arguments that should be passed to the called method. The
7390 internals of the object get the needed changes so that CPAN.pm does
7391 not refuse to take the action.
7393 =item CPAN::Module::get()
7395 Runs a get on the distribution associated with this module.
7397 =item CPAN::Module::inst_file()
7399 Returns the filename of the module found in @INC. The first file found
7400 is reported just like perl itself stops searching @INC when it finds a
7403 =item CPAN::Module::inst_version()
7405 Returns the version number of the module in readable format.
7407 =item CPAN::Module::install()
7409 Runs an C<install> on the distribution associated with this module.
7411 =item CPAN::Module::look()
7413 Changes to the directory where the distribution associated with this
7414 module has been unpacked and opens a subshell there. Exiting the
7417 =item CPAN::Module::make()
7419 Runs a C<make> on the distribution associated with this module.
7421 =item CPAN::Module::manpage_headline()
7423 If module is installed, peeks into the module's manpage, reads the
7424 headline and returns it. Moreover, if the module has been downloaded
7425 within this session, does the equivalent on the downloaded module even
7426 if it is not installed.
7428 =item CPAN::Module::perldoc()
7430 Runs a C<perldoc> on this module.
7432 =item CPAN::Module::readme()
7434 Runs a C<readme> on the distribution associated with this module.
7436 =item CPAN::Module::test()
7438 Runs a C<test> on the distribution associated with this module.
7440 =item CPAN::Module::uptodate()
7442 Returns 1 if the module is installed and up-to-date.
7444 =item CPAN::Module::userid()
7446 Returns the author's ID of the module.
7450 =head2 Cache Manager
7452 Currently the cache manager only keeps track of the build directory
7453 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
7454 deletes complete directories below C<build_dir> as soon as the size of
7455 all directories there gets bigger than $CPAN::Config->{build_cache}
7456 (in MB). The contents of this cache may be used for later
7457 re-installations that you intend to do manually, but will never be
7458 trusted by CPAN itself. This is due to the fact that the user might
7459 use these directories for building modules on different architectures.
7461 There is another directory ($CPAN::Config->{keep_source_where}) where
7462 the original distribution files are kept. This directory is not
7463 covered by the cache manager and must be controlled by the user. If
7464 you choose to have the same directory as build_dir and as
7465 keep_source_where directory, then your sources will be deleted with
7466 the same fifo mechanism.
7470 A bundle is just a perl module in the namespace Bundle:: that does not
7471 define any functions or methods. It usually only contains documentation.
7473 It starts like a perl module with a package declaration and a $VERSION
7474 variable. After that the pod section looks like any other pod with the
7475 only difference being that I<one special pod section> exists starting with
7480 In this pod section each line obeys the format
7482 Module_Name [Version_String] [- optional text]
7484 The only required part is the first field, the name of a module
7485 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
7486 of the line is optional. The comment part is delimited by a dash just
7487 as in the man page header.
7489 The distribution of a bundle should follow the same convention as
7490 other distributions.
7492 Bundles are treated specially in the CPAN package. If you say 'install
7493 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
7494 the modules in the CONTENTS section of the pod. You can install your
7495 own Bundles locally by placing a conformant Bundle file somewhere into
7496 your @INC path. The autobundle() command which is available in the
7497 shell interface does that for you by including all currently installed
7498 modules in a snapshot bundle file.
7500 =head2 Prerequisites
7502 If you have a local mirror of CPAN and can access all files with
7503 "file:" URLs, then you only need a perl better than perl5.003 to run
7504 this module. Otherwise Net::FTP is strongly recommended. LWP may be
7505 required for non-UNIX systems or if your nearest CPAN site is
7506 associated with a URL that is not C<ftp:>.
7508 If you have neither Net::FTP nor LWP, there is a fallback mechanism
7509 implemented for an external ftp command or for an external lynx
7512 =head2 Finding packages and VERSION
7514 This module presumes that all packages on CPAN
7520 declare their $VERSION variable in an easy to parse manner. This
7521 prerequisite can hardly be relaxed because it consumes far too much
7522 memory to load all packages into the running program just to determine
7523 the $VERSION variable. Currently all programs that are dealing with
7524 version use something like this
7526 perl -MExtUtils::MakeMaker -le \
7527 'print MM->parse_version(shift)' filename
7529 If you are author of a package and wonder if your $VERSION can be
7530 parsed, please try the above method.
7534 come as compressed or gzipped tarfiles or as zip files and contain a
7535 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
7536 without much enthusiasm).
7542 The debugging of this module is a bit complex, because we have
7543 interferences of the software producing the indices on CPAN, of the
7544 mirroring process on CPAN, of packaging, of configuration, of
7545 synchronicity, and of bugs within CPAN.pm.
7547 For code debugging in interactive mode you can try "o debug" which
7548 will list options for debugging the various parts of the code. You
7549 should know that "o debug" has built-in completion support.
7551 For data debugging there is the C<dump> command which takes the same
7552 arguments as make/test/install and outputs the object's Data::Dumper
7555 =head2 Floppy, Zip, Offline Mode
7557 CPAN.pm works nicely without network too. If you maintain machines
7558 that are not networked at all, you should consider working with file:
7559 URLs. Of course, you have to collect your modules somewhere first. So
7560 you might use CPAN.pm to put together all you need on a networked
7561 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
7562 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
7563 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
7564 with this floppy. See also below the paragraph about CD-ROM support.
7566 =head1 CONFIGURATION
7568 When the CPAN module is used for the first time, a configuration
7569 dialog tries to determine a couple of site specific options. The
7570 result of the dialog is stored in a hash reference C< $CPAN::Config >
7571 in a file CPAN/Config.pm.
7573 The default values defined in the CPAN/Config.pm file can be
7574 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
7575 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
7576 added to the search path of the CPAN module before the use() or
7577 require() statements.
7579 The configuration dialog can be started any time later again by
7580 issuing the command C< o conf init > in the CPAN shell.
7582 Currently the following keys in the hash reference $CPAN::Config are
7585 build_cache size of cache for directories to build modules
7586 build_dir locally accessible directory to build modules
7587 cache_metadata use serializer to cache metadata
7588 cpan_home local directory reserved for this package
7589 dontload_list arrayref: modules in the list will not be
7590 loaded by the CPAN::has_inst() routine
7592 gzip location of external program gzip
7593 histfile file to maintain history between sessions
7594 histsize maximum number of lines to keep in histfile
7595 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
7596 after this many seconds inactivity. Set to 0 to
7598 index_expire after this many days refetch index files
7599 inhibit_startup_message
7600 if true, does not print the startup message
7601 keep_source_where directory in which to keep the source (if we do)
7602 make location of external make program
7603 make_arg arguments that should always be passed to 'make'
7604 make_install_make_command
7605 the make command for running 'make install', for
7607 make_install_arg same as make_arg for 'make install'
7608 makepl_arg arguments passed to 'perl Makefile.PL'
7609 mbuild_arg arguments passed to './Build'
7610 mbuild_install_arg arguments passed to './Build install'
7611 mbuild_install_build_command
7612 command to use instead of './Build' when we are
7613 in the install stage, for example 'sudo ./Build'
7614 mbuildpl_arg arguments passed to 'perl Build.PL'
7615 pager location of external program more (or any pager)
7616 prefer_installer legal values are MB and EUMM: if a module comes
7617 with both a Makefile.PL and a Build.PL, use the
7618 former (EUMM) or the latter (MB); if the module
7619 comes with only one of the two, that one will be
7621 prerequisites_policy
7622 what to do if you are missing module prerequisites
7623 ('follow' automatically, 'ask' me, or 'ignore')
7624 proxy_user username for accessing an authenticating proxy
7625 proxy_pass password for accessing an authenticating proxy
7626 scan_cache controls scanning of cache ('atstart' or 'never')
7627 tar location of external program tar
7628 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
7629 (and nonsense for characters outside latin range)
7630 unzip location of external program unzip
7631 urllist arrayref to nearby CPAN sites (or equivalent locations)
7632 wait_list arrayref to a wait server to try (See CPAN::WAIT)
7633 ftp_passive if set, the envariable FTP_PASSIVE is set for downloads
7634 ftp_proxy, } the three usual variables for configuring
7635 http_proxy, } proxy requests. Both as CPAN::Config variables
7636 no_proxy } and as environment variables configurable.
7638 You can set and query each of these options interactively in the cpan
7639 shell with the command set defined within the C<o conf> command:
7643 =item C<o conf E<lt>scalar optionE<gt>>
7645 prints the current value of the I<scalar option>
7647 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
7649 Sets the value of the I<scalar option> to I<value>
7651 =item C<o conf E<lt>list optionE<gt>>
7653 prints the current value of the I<list option> in MakeMaker's
7656 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
7658 shifts or pops the array in the I<list option> variable
7660 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
7662 works like the corresponding perl commands.
7666 =head2 Not on config variable getcwd
7668 CPAN.pm changes the current working directory often and needs to
7669 determine its own current working directory. Per default it uses
7670 Cwd::cwd but if this doesn't work on your system for some reason,
7671 alternatives can be configured according to the following table:
7675 fastcwd Cwd::fastcwd
7676 backtickcwd external command cwd
7678 =head2 Note on urllist parameter's format
7680 urllist parameters are URLs according to RFC 1738. We do a little
7681 guessing if your URL is not compliant, but if you have problems with
7682 file URLs, please try the correct format. Either:
7684 file://localhost/whatever/ftp/pub/CPAN/
7688 file:///home/ftp/pub/CPAN/
7690 =head2 urllist parameter has CD-ROM support
7692 The C<urllist> parameter of the configuration table contains a list of
7693 URLs that are to be used for downloading. If the list contains any
7694 C<file> URLs, CPAN always tries to get files from there first. This
7695 feature is disabled for index files. So the recommendation for the
7696 owner of a CD-ROM with CPAN contents is: include your local, possibly
7697 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
7699 o conf urllist push file://localhost/CDROM/CPAN
7701 CPAN.pm will then fetch the index files from one of the CPAN sites
7702 that come at the beginning of urllist. It will later check for each
7703 module if there is a local copy of the most recent version.
7705 Another peculiarity of urllist is that the site that we could
7706 successfully fetch the last file from automatically gets a preference
7707 token and is tried as the first site for the next request. So if you
7708 add a new site at runtime it may happen that the previously preferred
7709 site will be tried another time. This means that if you want to disallow
7710 a site for the next transfer, it must be explicitly removed from
7715 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
7716 install foreign, unmasked, unsigned code on your machine. We compare
7717 to a checksum that comes from the net just as the distribution file
7718 itself. But we try to make it easy to add security on demand:
7720 =head2 Cryptographically signed modules
7722 Since release 1.77 CPAN.pm has been able to verify cryptographically
7723 signed module distributions using Module::Signature. The CPAN modules
7724 can be signed by their authors, thus giving more security. The simple
7725 unsigned MD5 checksums that were used before by CPAN protect mainly
7726 against accidental file corruption.
7728 You will need to have Module::Signature installed, which in turn
7729 requires that you have at least one of Crypt::OpenPGP module or the
7730 command-line F<gpg> tool installed.
7732 You will also need to be able to connect over the Internet to the public
7733 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
7737 Most functions in package CPAN are exported per default. The reason
7738 for this is that the primary use is intended for the cpan shell or for
7743 When the CPAN shell enters a subshell via the look command, it sets
7744 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
7747 When the config variable ftp_passive is set, all downloads will be run
7748 with the environment variable FTP_PASSIVE set to this value. This is
7749 in general a good idea as it influences both Net::FTP and LWP based
7750 connections. The same effect can be achieved by starting the cpan
7751 shell with this environment variable set. For Net::FTP alone, one can
7752 also always set passive mode by running libnetcfg.
7754 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
7756 Populating a freshly installed perl with my favorite modules is pretty
7757 easy if you maintain a private bundle definition file. To get a useful
7758 blueprint of a bundle definition file, the command autobundle can be used
7759 on the CPAN shell command line. This command writes a bundle definition
7760 file for all modules that are installed for the currently running perl
7761 interpreter. It's recommended to run this command only once and from then
7762 on maintain the file manually under a private name, say
7763 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
7765 cpan> install Bundle::my_bundle
7767 then answer a few questions and then go out for a coffee.
7769 Maintaining a bundle definition file means keeping track of two
7770 things: dependencies and interactivity. CPAN.pm sometimes fails on
7771 calculating dependencies because not all modules define all MakeMaker
7772 attributes correctly, so a bundle definition file should specify
7773 prerequisites as early as possible. On the other hand, it's a bit
7774 annoying that many distributions need some interactive configuring. So
7775 what I try to accomplish in my private bundle file is to have the
7776 packages that need to be configured early in the file and the gentle
7777 ones later, so I can go out after a few minutes and leave CPAN.pm
7780 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
7782 Thanks to Graham Barr for contributing the following paragraphs about
7783 the interaction between perl, and various firewall configurations. For
7784 further information on firewalls, it is recommended to consult the
7785 documentation that comes with the ncftp program. If you are unable to
7786 go through the firewall with a simple Perl setup, it is very likely
7787 that you can configure ncftp so that it works for your firewall.
7789 =head2 Three basic types of firewalls
7791 Firewalls can be categorized into three basic types.
7797 This is where the firewall machine runs a web server and to access the
7798 outside world you must do it via the web server. If you set environment
7799 variables like http_proxy or ftp_proxy to a values beginning with http://
7800 or in your web browser you have to set proxy information then you know
7801 you are running an http firewall.
7803 To access servers outside these types of firewalls with perl (even for
7804 ftp) you will need to use LWP.
7808 This where the firewall machine runs an ftp server. This kind of
7809 firewall will only let you access ftp servers outside the firewall.
7810 This is usually done by connecting to the firewall with ftp, then
7811 entering a username like "user@outside.host.com"
7813 To access servers outside these type of firewalls with perl you
7814 will need to use Net::FTP.
7816 =item One way visibility
7818 I say one way visibility as these firewalls try to make themselves look
7819 invisible to the users inside the firewall. An FTP data connection is
7820 normally created by sending the remote server your IP address and then
7821 listening for the connection. But the remote server will not be able to
7822 connect to you because of the firewall. So for these types of firewall
7823 FTP connections need to be done in a passive mode.
7825 There are two that I can think off.
7831 If you are using a SOCKS firewall you will need to compile perl and link
7832 it with the SOCKS library, this is what is normally called a 'socksified'
7833 perl. With this executable you will be able to connect to servers outside
7834 the firewall as if it is not there.
7838 This is the firewall implemented in the Linux kernel, it allows you to
7839 hide a complete network behind one IP address. With this firewall no
7840 special compiling is needed as you can access hosts directly.
7842 For accessing ftp servers behind such firewalls you usually need to
7843 set the environment variable C<FTP_PASSIVE> or the config variable
7844 ftp_passive to a true value.
7850 =head2 Configuring lynx or ncftp for going through a firewall
7852 If you can go through your firewall with e.g. lynx, presumably with a
7855 /usr/local/bin/lynx -pscott:tiger
7857 then you would configure CPAN.pm with the command
7859 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
7861 That's all. Similarly for ncftp or ftp, you would configure something
7864 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
7866 Your mileage may vary...
7874 I installed a new version of module X but CPAN keeps saying,
7875 I have the old version installed
7877 Most probably you B<do> have the old version installed. This can
7878 happen if a module installs itself into a different directory in the
7879 @INC path than it was previously installed. This is not really a
7880 CPAN.pm problem, you would have the same problem when installing the
7881 module manually. The easiest way to prevent this behaviour is to add
7882 the argument C<UNINST=1> to the C<make install> call, and that is why
7883 many people add this argument permanently by configuring
7885 o conf make_install_arg UNINST=1
7889 So why is UNINST=1 not the default?
7891 Because there are people who have their precise expectations about who
7892 may install where in the @INC path and who uses which @INC array. In
7893 fine tuned environments C<UNINST=1> can cause damage.
7897 I want to clean up my mess, and install a new perl along with
7898 all modules I have. How do I go about it?
7900 Run the autobundle command for your old perl and optionally rename the
7901 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
7902 with the Configure option prefix, e.g.
7904 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
7906 Install the bundle file you produced in the first step with something like
7908 cpan> install Bundle::mybundle
7914 When I install bundles or multiple modules with one command
7915 there is too much output to keep track of.
7917 You may want to configure something like
7919 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
7920 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
7922 so that STDOUT is captured in a file for later inspection.
7927 I am not root, how can I install a module in a personal directory?
7929 First of all, you will want to use your own configuration, not the one
7930 that your root user installed. If you do not have permission to write
7931 in the cpan directory that root has configured, you will be asked if
7932 you want to create your own config. Answering "yes" will bring you into
7933 CPAN's configuration stage, using the system config for all defaults except
7934 things that have to do with CPAN's work directory, saving your choices to
7935 your MyConfig.pm file.
7937 You can also manually initiate this process with the following command:
7939 % perl -MCPAN -e 'mkmyconfig'
7945 from the CPAN shell.
7947 You will most probably also want to configure something like this:
7949 o conf makepl_arg "LIB=~/myperl/lib \
7950 INSTALLMAN1DIR=~/myperl/man/man1 \
7951 INSTALLMAN3DIR=~/myperl/man/man3"
7953 You can make this setting permanent like all C<o conf> settings with
7956 You will have to add ~/myperl/man to the MANPATH environment variable
7957 and also tell your perl programs to look into ~/myperl/lib, e.g. by
7960 use lib "$ENV{HOME}/myperl/lib";
7962 or setting the PERL5LIB environment variable.
7964 Another thing you should bear in mind is that the UNINST parameter can
7965 be dnagerous when you are installing into a private area because you
7966 might accidentally remove modules that other people depend on that are
7967 not using the private area.
7971 How to get a package, unwrap it, and make a change before building it?
7973 look Sybase::Sybperl
7977 I installed a Bundle and had a couple of fails. When I
7978 retried, everything resolved nicely. Can this be fixed to work
7981 The reason for this is that CPAN does not know the dependencies of all
7982 modules when it starts out. To decide about the additional items to
7983 install, it just uses data found in the META.yml file or the generated
7984 Makefile. An undetected missing piece breaks the process. But it may
7985 well be that your Bundle installs some prerequisite later than some
7986 depending item and thus your second try is able to resolve everything.
7987 Please note, CPAN.pm does not know the dependency tree in advance and
7988 cannot sort the queue of things to install in a topologically correct
7989 order. It resolves perfectly well IF all modules declare the
7990 prerequisites correctly with the PREREQ_PM attribute to MakeMaker or
7991 the C<requires> stanza of Module::Build. For bundles which fail and
7992 you need to install often, it is recommended to sort the Bundle
7993 definition file manually.
7997 In our intranet we have many modules for internal use. How
7998 can I integrate these modules with CPAN.pm but without uploading
7999 the modules to CPAN?
8001 Have a look at the CPAN::Site module.
8005 When I run CPAN's shell, I get an error message about things in my
8006 /etc/inputrc (or ~/.inputrc) file.
8008 These are readline issues and can only be fixed by studying readline
8009 configuration on your architecture and adjusting the referenced file
8010 accordingly. Please make a backup of the /etc/inputrc or ~/.inputrc
8011 and edit them. Quite often harmless changes like uppercasing or
8012 lowercasing some arguments solves the problem.
8016 Some authors have strange characters in their names.
8018 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
8019 expecting ISO-8859-1 charset, a converter can be activated by setting
8020 term_is_latin to a true value in your config file. One way of doing so
8023 cpan> o conf term_is_latin 1
8025 If other charset support is needed, please file a bugreport against
8026 CPAN.pm at rt.cpan.org and describe your needs. Maybe we can extend
8027 the support or maybe UTF-8 terminals become widely available.
8031 When an install fails for some reason and then I correct the error
8032 condition and retry, CPAN.pm refuses to install the module, saying
8033 C<Already tried without success>.
8035 Use the force pragma like so
8037 force install Foo::Bar
8039 This does a bit more than really needed because it untars the
8040 distribution again and runs make and test and only then install.
8042 Or, if you find this is too fast and you would prefer to do smaller
8047 first and then continue as always. C<Force get> I<forgets> previous
8054 and then 'make install' directly in the subshell.
8056 Or you leave the CPAN shell and start it again.
8058 For the really curious, by accessing internals directly, you I<could>
8060 !delete CPAN::Shell->expandany("Foo::Bar")->distribution->{install}
8062 but this is neither guaranteed to work in the future nor is it a
8067 How do I install a "DEVELOPER RELEASE" of a module?
8069 By default, CPAN will install the latest non-developer release of a module.
8070 If you want to install a dev release, you have to specify a partial path to
8071 the tarball you wish to install, like so:
8073 cpan> install KWILLIAMS/Module-Build-0.27_07.tar.gz
8077 How do I install a module and all its dependencies from the commandline,
8078 without being prompted for anything, despite my CPAN configuration
8081 CPAN uses ExtUtils::MakeMaker's prompt() function to ask its questions, so
8082 if you set the PERL_MM_USE_DEFAULT environment variable, you shouldn't be
8083 asked any questions at all (assuming the modules you are installing are
8084 nice about obeying that variable as well):
8086 % PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install My::Module'
8092 Please report bugs via http://rt.cpan.org/
8094 Before submitting a bug, please make sure that the traditional method
8095 of building a Perl module package from a shell by following the
8096 installation instructions of that package still works in your
8101 Andreas Koenig C<< <andk@cpan.org> >>
8105 Kawai,Takanori provides a Japanese translation of this manpage at
8106 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
8110 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)