3 $VERSION = eval $VERSION;
6 use CPAN::HandleConfig;
15 use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
16 use File::Basename ();
24 use Sys::Hostname qw(hostname);
25 use Text::ParseWords ();
27 no lib "."; # we need to run chdir all over and we would get at wrong
30 require Mac::BuildTools if $^O eq 'MacOS';
32 END { $CPAN::End++; &cleanup; }
35 $CPAN::Frontend ||= "CPAN::Shell";
36 @CPAN::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);
55 autobundle bundle expand force notest get cvs_import
56 install make readme recompile shell test clean
60 sub soft_chdir_with_alternatives ($);
62 #-> sub CPAN::AUTOLOAD ;
67 @EXPORT{@EXPORT} = '';
68 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
69 if (exists $EXPORT{$l}){
72 $CPAN::Frontend->mywarn(qq{Unknown CPAN command "$AUTOLOAD". }.
81 $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
82 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
84 my $oprompt = shift || CPAN::Prompt->new;
85 my $prompt = $oprompt;
86 my $commandline = shift || "";
87 $CPAN::CurrentCommandId ||= 1;
90 unless ($Suppress_readline) {
91 require Term::ReadLine;
94 $term->ReadLine eq "Term::ReadLine::Stub"
96 $term = Term::ReadLine->new('CPAN Monitor');
98 if ($term->ReadLine eq "Term::ReadLine::Gnu") {
99 my $attribs = $term->Attribs;
100 $attribs->{attempted_completion_function} = sub {
101 &CPAN::Complete::gnu_cpl;
104 $readline::rl_completion_function =
105 $readline::rl_completion_function = 'CPAN::Complete::cpl';
107 if (my $histfile = $CPAN::Config->{'histfile'}) {{
108 unless ($term->can("AddHistory")) {
109 $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
112 my($fh) = FileHandle->new;
113 open $fh, "<$histfile" or last;
117 $term->AddHistory($_);
121 # $term->OUT is autoflushed anyway
122 my $odef = select STDERR;
129 # no strict; # I do not recall why no strict was here (2000-09-03)
131 my @cwd = (CPAN::anycwd(),File::Spec->tmpdir(),File::Spec->rootdir());
132 my $try_detect_readline;
133 $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
134 my $rl_avail = $Suppress_readline ? "suppressed" :
135 ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
136 "available (try 'install Bundle::CPAN')";
138 $CPAN::Frontend->myprint(
140 cpan shell -- CPAN exploration and modules installation (v%s)
147 unless $CPAN::Config->{'inhibit_startup_message'} ;
148 my($continuation) = "";
149 SHELLCOMMAND: while () {
150 if ($Suppress_readline) {
152 last SHELLCOMMAND unless defined ($_ = <> );
155 last SHELLCOMMAND unless
156 defined ($_ = $term->readline($prompt, $commandline));
158 $_ = "$continuation$_" if $continuation;
160 next SHELLCOMMAND if /^$/;
161 $_ = 'h' if /^\s*\?/;
162 if (/^(?:q(?:uit)?|bye|exit)$/i) {
173 use vars qw($import_done);
174 CPAN->import(':DEFAULT') unless $import_done++;
175 CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
182 if ($] < 5.00322) { # parsewords had a bug until recently
185 eval { @line = Text::ParseWords::shellwords($_) };
186 warn($@), next SHELLCOMMAND if $@;
187 warn("Text::Parsewords could not parse the line [$_]"),
188 next SHELLCOMMAND unless @line;
190 $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
191 my $command = shift @line;
192 eval { CPAN::Shell->$command(@line) };
194 if ($command =~ /^(make|test|install|force|notest)$/) {
195 CPAN::Shell->failed($CPAN::CurrentCommandId,1);
197 soft_chdir_with_alternatives(\@cwd);
198 $CPAN::Frontend->myprint("\n");
200 $CPAN::CurrentCommandId++;
204 $commandline = ""; # I do want to be able to pass a default to
205 # shell, but on the second command I see no
208 CPAN::Queue->nullify_queue;
209 if ($try_detect_readline) {
210 if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
212 $CPAN::META->has_inst("Term::ReadLine::Perl")
214 delete $INC{"Term/ReadLine.pm"};
216 local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
217 require Term::ReadLine;
218 $CPAN::Frontend->myprint("\n$redef subroutines in ".
219 "Term::ReadLine redefined\n");
225 soft_chdir_with_alternatives(\@cwd);
228 sub soft_chdir_with_alternatives ($) {
230 while (not chdir $cwd->[0]) {
232 $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
233 Trying to chdir to "$cwd->[1]" instead.
237 $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
241 package CPAN::CacheMgr;
243 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
248 use vars qw($Ua $Thesite $Themethod);
249 @CPAN::FTP::ISA = qw(CPAN::Debug);
251 package CPAN::LWP::UserAgent;
253 use vars qw(@ISA $USER $PASSWD $SETUPDONE);
254 # we delay requiring LWP::UserAgent and setting up inheritance until we need it
256 package CPAN::Complete;
258 @CPAN::Complete::ISA = qw(CPAN::Debug);
259 @CPAN::Complete::COMMANDS = sort qw(
260 ! a b d h i m o q r u
279 use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
280 @CPAN::Index::ISA = qw(CPAN::Debug);
283 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
286 package CPAN::InfoObj;
288 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
290 package CPAN::Author;
292 @CPAN::Author::ISA = qw(CPAN::InfoObj);
294 package CPAN::Distribution;
296 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
298 package CPAN::Bundle;
300 @CPAN::Bundle::ISA = qw(CPAN::Module);
302 package CPAN::Module;
304 @CPAN::Module::ISA = qw(CPAN::InfoObj);
306 package CPAN::Exception::RecursiveDependency;
308 use overload '""' => "as_string";
315 for my $dep (@$deps) {
317 last if $seen{$dep}++;
319 bless { deps => \@deps }, $class;
324 "\nRecursive dependency detected:\n " .
325 join("\n => ", @{$self->{deps}}) .
326 ".\nCannot continue.\n";
329 package CPAN::Prompt; use overload '""' => "as_string";
330 our $prompt = "cpan> ";
331 $CPAN::CurrentCommandId ||= 0;
332 sub as_randomly_capitalized_string {
334 substr($prompt,$_,1)=rand()<0.5 ?
335 uc(substr($prompt,$_,1)) :
336 lc(substr($prompt,$_,1)) for 0..3;
343 if ($CPAN::Config->{commandnumber_in_prompt}) {
344 sprintf "cpan[%d]> ", $CPAN::CurrentCommandId;
350 package CPAN::Distrostatus;
351 use overload '""' => "as_string",
354 my($class,$arg) = @_;
357 FAILED => substr($arg,0,2) eq "NO",
358 COMMANDID => $CPAN::CurrentCommandId,
361 sub commandid { shift->{COMMANDID} }
362 sub failed { shift->{FAILED} }
366 $self->{TEXT} = $set;
372 if (0) { # called from rematein during install?
381 use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING);
382 @CPAN::Shell::ISA = qw(CPAN::Debug);
383 $COLOR_REGISTERED ||= 0;
384 $PRINT_ORNAMENTING ||= 0;
386 #-> sub CPAN::Shell::AUTOLOAD ;
388 my($autoload) = $AUTOLOAD;
389 my $class = shift(@_);
390 # warn "autoload[$autoload] class[$class]";
391 $autoload =~ s/.*:://;
392 if ($autoload =~ /^w/) {
393 if ($CPAN::META->has_inst('CPAN::WAIT')) {
394 CPAN::WAIT->$autoload(@_);
396 $CPAN::Frontend->mywarn(qq{
397 Commands starting with "w" require CPAN::WAIT to be installed.
398 Please consider installing CPAN::WAIT to use the fulltext index.
399 For this you just need to type
404 $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload'. }.
413 # One use of the queue is to determine if we should or shouldn't
414 # announce the availability of a new CPAN module
416 # Now we try to use it for dependency tracking. For that to happen
417 # we need to draw a dependency tree and do the leaves first. This can
418 # easily be reached by running CPAN.pm recursively, but we don't want
419 # to waste memory and run into deep recursion. So what we can do is
422 # CPAN::Queue is the package where the queue is maintained. Dependencies
423 # often have high priority and must be brought to the head of the queue,
424 # possibly by jumping the queue if they are already there. My first code
425 # attempt tried to be extremely correct. Whenever a module needed
426 # immediate treatment, I either unshifted it to the front of the queue,
427 # or, if it was already in the queue, I spliced and let it bypass the
428 # others. This became a too correct model that made it impossible to put
429 # an item more than once into the queue. Why would you need that? Well,
430 # you need temporary duplicates as the manager of the queue is a loop
433 # (1) looks at the first item in the queue without shifting it off
435 # (2) cares for the item
437 # (3) removes the item from the queue, *even if its agenda failed and
438 # even if the item isn't the first in the queue anymore* (that way
439 # protecting against never ending queues)
441 # So if an item has prerequisites, the installation fails now, but we
442 # want to retry later. That's easy if we have it twice in the queue.
444 # I also expect insane dependency situations where an item gets more
445 # than two lives in the queue. Simplest example is triggered by 'install
446 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
447 # get in the way. I wanted the queue manager to be a dumb servant, not
448 # one that knows everything.
450 # Who would I tell in this model that the user wants to be asked before
451 # processing? I can't attach that information to the module object,
452 # because not modules are installed but distributions. So I'd have to
453 # tell the distribution object that it should ask the user before
454 # processing. Where would the question be triggered then? Most probably
455 # in CPAN::Distribution::rematein.
456 # Hope that makes sense, my head is a bit off:-) -- AK
463 my $self = bless { qmod => $s }, $class;
468 # CPAN::Queue::first ;
474 # CPAN::Queue::delete_first ;
476 my($class,$what) = @_;
478 for my $i (0..$#All) {
479 if ( $All[$i]->{qmod} eq $what ) {
486 # CPAN::Queue::jumpqueue ;
490 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
491 join(",",map {$_->{qmod}} @All),
494 WHAT: for my $what (reverse @what) {
496 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
497 CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG;
498 if ($All[$i]->{qmod} eq $what){
500 if ($jumped > 100) { # one's OK if e.g. just
501 # processing now; more are OK if
502 # user typed it several times
503 $CPAN::Frontend->mywarn(
504 qq{Object [$what] queued more than 100 times, ignoring}
510 my $obj = bless { qmod => $what }, $class;
513 CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]",
514 join(",",map {$_->{qmod}} @All),
519 # CPAN::Queue::exists ;
521 my($self,$what) = @_;
522 my @all = map { $_->{qmod} } @All;
523 my $exists = grep { $_->{qmod} eq $what } @All;
524 # warn "in exists what[$what] all[@all] exists[$exists]";
528 # CPAN::Queue::delete ;
531 @All = grep { $_->{qmod} ne $mod } @All;
534 # CPAN::Queue::nullify_queue ;
544 $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
546 # from here on only subs.
547 ################################################################################
549 #-> sub CPAN::all_objects ;
551 my($mgr,$class) = @_;
552 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
553 CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
555 values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
557 *all = \&all_objects;
559 # Called by shell, not in batch mode. In batch mode I see no risk in
560 # having many processes updating something as installations are
561 # continually checked at runtime. In shell mode I suspect it is
562 # unintentional to open more than one shell at a time
564 #-> sub CPAN::checklock ;
567 my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
568 if (-f $lockfile && -M _ > 0) {
569 my $fh = FileHandle->new($lockfile) or
570 $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
571 my $otherpid = <$fh>;
572 my $otherhost = <$fh>;
574 if (defined $otherpid && $otherpid) {
577 if (defined $otherhost && $otherhost) {
580 my $thishost = hostname();
581 if (defined $otherhost && defined $thishost &&
582 $otherhost ne '' && $thishost ne '' &&
583 $otherhost ne $thishost) {
584 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
585 "reports other host $otherhost and other ".
586 "process $otherpid.\n".
587 "Cannot proceed.\n"));
589 elsif (defined $otherpid && $otherpid) {
590 return if $$ == $otherpid; # should never happen
591 $CPAN::Frontend->mywarn(
593 There seems to be running another CPAN process (pid $otherpid). Contacting...
595 if (kill 0, $otherpid) {
596 $CPAN::Frontend->mydie(qq{Other job is running.
597 You may want to kill it and delete the lockfile, maybe. On UNIX try:
601 } elsif (-w $lockfile) {
603 ExtUtils::MakeMaker::prompt
604 (qq{Other job not responding. Shall I overwrite }.
605 qq{the lockfile '$lockfile'? (Y/n)},"y");
606 $CPAN::Frontend->myexit("Ok, bye\n")
607 unless $ans =~ /^y/i;
610 qq{Lockfile '$lockfile' not writeable by you. }.
611 qq{Cannot proceed.\n}.
613 qq{ rm '$lockfile'\n}.
614 qq{ and then rerun us.\n}
618 $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
619 "reports other process with ID ".
620 "$otherpid. Cannot proceed.\n"));
623 my $dotcpan = $CPAN::Config->{cpan_home};
624 eval { File::Path::mkpath($dotcpan);};
626 # A special case at least for Jarkko.
631 $symlinkcpan = readlink $dotcpan;
632 die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
633 eval { File::Path::mkpath($symlinkcpan); };
637 $CPAN::Frontend->mywarn(qq{
638 Working directory $symlinkcpan created.
642 unless (-d $dotcpan) {
644 Your configuration suggests "$dotcpan" as your
645 CPAN.pm working directory. I could not create this directory due
646 to this error: $firsterror\n};
648 As "$dotcpan" is a symlink to "$symlinkcpan",
649 I tried to create that, but I failed with this error: $seconderror
652 Please make sure the directory exists and is writable.
654 $CPAN::Frontend->mydie($diemess);
658 unless ($fh = FileHandle->new(">$lockfile")) {
659 if ($! =~ /Permission/) {
660 my $incc = $INC{'CPAN/Config.pm'};
661 my $myincc = File::Spec->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
662 $CPAN::Frontend->myprint(qq{
664 Your configuration suggests that CPAN.pm should use a working
666 $CPAN::Config->{cpan_home}
667 Unfortunately we could not create the lock file
669 due to permission problems.
671 Please make sure that the configuration variable
672 \$CPAN::Config->{cpan_home}
673 points to a directory where you can write a .lock file. You can set
674 this variable in either
681 $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
683 $fh->print($$, "\n");
684 $fh->print(hostname(), "\n");
685 $self->{LOCK} = $lockfile;
689 $CPAN::Frontend->mydie("Got SIGTERM, leaving");
694 $CPAN::Frontend->mydie("Got another SIGINT") if $Signal;
695 print "Caught SIGINT\n";
699 # From: Larry Wall <larry@wall.org>
700 # Subject: Re: deprecating SIGDIE
701 # To: perl5-porters@perl.org
702 # Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
704 # The original intent of __DIE__ was only to allow you to substitute one
705 # kind of death for another on an application-wide basis without respect
706 # to whether you were in an eval or not. As a global backstop, it should
707 # not be used any more lightly (or any more heavily :-) than class
708 # UNIVERSAL. Any attempt to build a general exception model on it should
709 # be politely squashed. Any bug that causes every eval {} to have to be
710 # modified should be not so politely squashed.
712 # Those are my current opinions. It is also my optinion that polite
713 # arguments degenerate to personal arguments far too frequently, and that
714 # when they do, it's because both people wanted it to, or at least didn't
715 # sufficiently want it not to.
719 # global backstop to cleanup if we should really die
720 $SIG{__DIE__} = \&cleanup;
721 $self->debug("Signal handler set.") if $CPAN::DEBUG;
724 #-> sub CPAN::DESTROY ;
726 &cleanup; # need an eval?
729 #-> sub CPAN::anycwd ;
732 $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
737 sub cwd {Cwd::cwd();}
739 #-> sub CPAN::getcwd ;
740 sub getcwd {Cwd::getcwd();}
742 #-> sub CPAN::fastcwd ;
743 sub fastcwd {Cwd::fastcwd();}
745 #-> sub CPAN::backtickcwd ;
746 sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}
748 #-> sub CPAN::find_perl ;
750 my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
751 my $pwd = $CPAN::iCwd = CPAN::anycwd();
752 my $candidate = File::Spec->catfile($pwd,$^X);
753 $perl ||= $candidate if MM->maybe_command($candidate);
756 my ($component,$perl_name);
757 DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
758 PATH_COMPONENT: foreach $component (File::Spec->path(),
759 $Config::Config{'binexp'}) {
760 next unless defined($component) && $component;
761 my($abs) = File::Spec->catfile($component,$perl_name);
762 if (MM->maybe_command($abs)) {
774 #-> sub CPAN::exists ;
776 my($mgr,$class,$id) = @_;
777 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
779 ### Carp::croak "exists called without class argument" unless $class;
781 $id =~ s/:+/::/g if $class eq "CPAN::Module";
782 exists $META->{readonly}{$class}{$id} or
783 exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
786 #-> sub CPAN::delete ;
788 my($mgr,$class,$id) = @_;
789 delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
790 delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
793 #-> sub CPAN::has_usable
794 # has_inst is sometimes too optimistic, we should replace it with this
795 # has_usable whenever a case is given
797 my($self,$mod,$message) = @_;
798 return 1 if $HAS_USABLE->{$mod};
799 my $has_inst = $self->has_inst($mod,$message);
800 return unless $has_inst;
803 LWP => [ # we frequently had "Can't locate object
804 # method "new" via package "LWP::UserAgent" at
805 # (eval 69) line 2006
807 sub {require LWP::UserAgent},
808 sub {require HTTP::Request},
809 sub {require URI::URL},
812 sub {require Net::FTP},
813 sub {require Net::Config},
816 if ($usable->{$mod}) {
817 for my $c (0..$#{$usable->{$mod}}) {
818 my $code = $usable->{$mod}[$c];
819 my $ret = eval { &$code() };
821 warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
826 return $HAS_USABLE->{$mod} = 1;
829 #-> sub CPAN::has_inst
831 my($self,$mod,$message) = @_;
832 Carp::croak("CPAN->has_inst() called without an argument")
834 if (defined $message && $message eq "no"
836 exists $CPAN::META->{dontload_hash}{$mod} # unsafe meta access, ok
838 exists $CPAN::Config->{dontload_hash}{$mod}
840 $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
848 # checking %INC is wrong, because $INC{LWP} may be true
849 # although $INC{"URI/URL.pm"} may have failed. But as
850 # I really want to say "bla loaded OK", I have to somehow
852 ### warn "$file in %INC"; #debug
854 } elsif (eval { require $file }) {
855 # eval is good: if we haven't yet read the database it's
856 # perfect and if we have installed the module in the meantime,
857 # it tries again. The second require is only a NOOP returning
858 # 1 if we had success, otherwise it's retrying
860 $CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
861 if ($mod eq "CPAN::WAIT") {
862 push @CPAN::Shell::ISA, 'CPAN::WAIT';
865 } elsif ($mod eq "Net::FTP") {
866 $CPAN::Frontend->mywarn(qq{
867 Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
869 install Bundle::libnet
871 }) unless $Have_warned->{"Net::FTP"}++;
873 } elsif ($mod eq "Digest::SHA"){
874 $CPAN::Frontend->myprint(qq{
875 CPAN: checksum security checks disabled because Digest::SHA not installed.
876 Please consider installing the Digest::SHA module.
880 } elsif ($mod eq "Module::Signature"){
881 unless ($Have_warned->{"Module::Signature"}++) {
882 # No point in complaining unless the user can
883 # reasonably install and use it.
884 if (eval { require Crypt::OpenPGP; 1 } ||
885 defined $CPAN::Config->{'gpg'}) {
886 $CPAN::Frontend->myprint(qq{
887 CPAN: Module::Signature security checks disabled because Module::Signature
888 not installed. Please consider installing the Module::Signature module.
889 You may also need to be able to connect over the Internet to the public
890 keyservers like pgp.mit.edu (port 11371).
897 delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
902 #-> sub CPAN::instance ;
904 my($mgr,$class,$id) = @_;
907 # unsafe meta access, ok?
908 return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
909 $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
917 #-> sub CPAN::cleanup ;
919 # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
920 local $SIG{__DIE__} = '';
925 while ((undef,undef,undef,$subroutine) = caller(++$i)) {
927 $subroutine eq '(eval)';
929 return if $ineval && !$CPAN::End;
930 return unless defined $META->{LOCK};
931 return unless -f $META->{LOCK};
933 unlink $META->{LOCK};
935 # Carp::cluck("DEBUGGING");
936 $CPAN::Frontend->mywarn("Lockfile removed.\n");
939 #-> sub CPAN::savehist
942 my($histfile,$histsize);
943 unless ($histfile = $CPAN::Config->{'histfile'}){
944 $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
947 $histsize = $CPAN::Config->{'histsize'} || 100;
949 unless ($CPAN::term->can("GetHistory")) {
950 $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
956 my @h = $CPAN::term->GetHistory;
957 splice @h, 0, @h-$histsize if @h>$histsize;
958 my($fh) = FileHandle->new;
959 open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
960 local $\ = local $, = "\n";
966 my($self,$what) = @_;
967 $self->{is_tested}{$what} = 1;
971 my($self,$what) = @_;
972 delete $self->{is_tested}{$what};
977 $self->{is_tested} ||= {};
978 return unless %{$self->{is_tested}};
979 my $env = $ENV{PERL5LIB};
980 $env = $ENV{PERLLIB} unless defined $env;
982 push @env, $env if defined $env and length $env;
983 my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
984 $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
985 $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
988 package CPAN::CacheMgr;
991 #-> sub CPAN::CacheMgr::as_string ;
993 eval { require Data::Dumper };
995 return shift->SUPER::as_string;
997 return Data::Dumper::Dumper(shift);
1001 #-> sub CPAN::CacheMgr::cachesize ;
1006 #-> sub CPAN::CacheMgr::tidyup ;
1009 return unless -d $self->{ID};
1010 while ($self->{DU} > $self->{'MAX'} ) {
1011 my($toremove) = shift @{$self->{FIFO}};
1012 $CPAN::Frontend->myprint(sprintf(
1013 "Deleting from cache".
1014 ": $toremove (%.1f>%.1f MB)\n",
1015 $self->{DU}, $self->{'MAX'})
1017 return if $CPAN::Signal;
1018 $self->force_clean_cache($toremove);
1019 return if $CPAN::Signal;
1023 #-> sub CPAN::CacheMgr::dir ;
1028 #-> sub CPAN::CacheMgr::entries ;
1030 my($self,$dir) = @_;
1031 return unless defined $dir;
1032 $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
1033 $dir ||= $self->{ID};
1034 my($cwd) = CPAN::anycwd();
1035 chdir $dir or Carp::croak("Can't chdir to $dir: $!");
1036 my $dh = DirHandle->new(File::Spec->curdir)
1037 or Carp::croak("Couldn't opendir $dir: $!");
1040 next if $_ eq "." || $_ eq "..";
1042 push @entries, File::Spec->catfile($dir,$_);
1044 push @entries, File::Spec->catdir($dir,$_);
1046 $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
1049 chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
1050 sort { -M $b <=> -M $a} @entries;
1053 #-> sub CPAN::CacheMgr::disk_usage ;
1055 my($self,$dir) = @_;
1056 return if exists $self->{SIZE}{$dir};
1057 return if $CPAN::Signal;
1061 unless (chmod 0755, $dir) {
1062 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
1063 "permission to change the permission; cannot ".
1064 "estimate disk usage of '$dir'\n");
1065 $CPAN::Frontend->mysleep(5);
1070 $CPAN::Frontend->mywarn("Directory '$dir' has gone. Cannot continue.\n");
1071 $CPAN::Frontend->mysleep(2);
1076 $File::Find::prune++ if $CPAN::Signal;
1078 if ($^O eq 'MacOS') {
1080 my $cat = Mac::Files::FSpGetCatInfo($_);
1081 $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
1085 unless (chmod 0755, $_) {
1086 $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
1087 "the permission to change the permission; ".
1088 "can only partially estimate disk usage ".
1101 return if $CPAN::Signal;
1102 $self->{SIZE}{$dir} = $Du/1024/1024;
1103 push @{$self->{FIFO}}, $dir;
1104 $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
1105 $self->{DU} += $Du/1024/1024;
1109 #-> sub CPAN::CacheMgr::force_clean_cache ;
1110 sub force_clean_cache {
1111 my($self,$dir) = @_;
1112 return unless -e $dir;
1113 $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
1115 File::Path::rmtree($dir);
1116 $self->{DU} -= $self->{SIZE}{$dir};
1117 delete $self->{SIZE}{$dir};
1120 #-> sub CPAN::CacheMgr::new ;
1127 ID => $CPAN::Config->{'build_dir'},
1128 MAX => $CPAN::Config->{'build_cache'},
1129 SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
1132 File::Path::mkpath($self->{ID});
1133 my $dh = DirHandle->new($self->{ID});
1134 bless $self, $class;
1137 $debug .= "timing of CacheMgr->new: ".($t2 - $time);
1139 CPAN->debug($debug) if $CPAN::DEBUG;
1143 #-> sub CPAN::CacheMgr::scan_cache ;
1146 return if $self->{SCAN} eq 'never';
1147 $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
1148 unless $self->{SCAN} eq 'atstart';
1149 $CPAN::Frontend->myprint(
1150 sprintf("Scanning cache %s for sizes\n",
1153 for $e ($self->entries($self->{ID})) {
1154 next if $e eq ".." || $e eq ".";
1155 $self->disk_usage($e);
1156 return if $CPAN::Signal;
1161 package CPAN::Shell;
1164 #-> sub CPAN::Shell::h ;
1166 my($class,$about) = @_;
1167 if (defined $about) {
1168 $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
1170 my $filler = " " x (80 - 28 - length($CPAN::VERSION));
1171 $CPAN::Frontend->myprint(qq{
1172 Display Information $filler (ver $CPAN::VERSION)
1173 command argument description
1174 a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules
1175 i WORD or /REGEXP/ about any of the above
1176 r NONE report updatable modules
1177 ls AUTHOR or GLOB about files in the author's directory
1178 (with WORD being a module, bundle or author name or a distribution
1179 name of the form AUTHOR/DISTRIBUTION)
1181 Download, Test, Make, Install...
1182 get download clean make clean
1183 make make (implies get) look open subshell in dist directory
1184 test make test (implies make) readme display these README files
1185 install make install (implies test) perldoc display POD documentation
1188 force COMMAND unconditionally do command
1189 notest COMMAND skip testing
1192 h,? display this menu ! perl-code eval a perl command
1193 o conf [opt] set and query options q quit the cpan shell
1194 reload cpan load CPAN.pm again reload index load newer indices
1195 autobundle Snapshot recent latest CPAN uploads});
1201 #-> sub CPAN::Shell::a ;
1203 my($self,@arg) = @_;
1204 # authors are always UPPERCASE
1206 $_ = uc $_ unless /=/;
1208 $CPAN::Frontend->myprint($self->format_result('Author',@arg));
1211 #-> sub CPAN::Shell::globls ;
1213 my($self,$s,$pragmas) = @_;
1214 # ls is really very different, but we had it once as an ordinary
1215 # command in the Shell (upto rev. 321) and we could not handle
1217 my(@accept,@preexpand);
1218 if ($s =~ /[\*\?\/]/) {
1219 if ($CPAN::META->has_inst("Text::Glob")) {
1220 if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
1221 my $rau = Text::Glob::glob_to_regex(uc $au);
1222 CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
1224 push @preexpand, map { $_->id . "/" . $pathglob }
1225 CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
1227 my $rau = Text::Glob::glob_to_regex(uc $s);
1228 push @preexpand, map { $_->id }
1229 CPAN::Shell->expand_by_method('CPAN::Author',
1234 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
1237 push @preexpand, uc $s;
1240 unless (/^[A-Z0-9\-]+(\/|$)/i) {
1241 $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
1246 my $silent = @accept>1;
1247 my $last_alpha = "";
1249 for my $a (@accept){
1250 my($author,$pathglob);
1251 if ($a =~ m|(.*?)/(.*)|) {
1254 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1256 $a2) or die "No author found for $a2";
1258 $author = CPAN::Shell->expand_by_method('CPAN::Author',
1260 $a) or die "No author found for $a";
1263 my $alpha = substr $author->id, 0, 1;
1265 if ($alpha eq $last_alpha) {
1269 $last_alpha = $alpha;
1271 $CPAN::Frontend->myprint($ad);
1273 for my $pragma (@$pragmas) {
1274 if ($author->can($pragma)) {
1278 push @results, $author->ls($pathglob,$silent); # silent if
1281 for my $pragma (@$pragmas) {
1282 my $meth = "un$pragma";
1283 if ($author->can($meth)) {
1291 #-> sub CPAN::Shell::local_bundles ;
1293 my($self,@which) = @_;
1294 my($incdir,$bdir,$dh);
1295 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
1296 my @bbase = "Bundle";
1297 while (my $bbase = shift @bbase) {
1298 $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
1299 CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
1300 if ($dh = DirHandle->new($bdir)) { # may fail
1302 for $entry ($dh->read) {
1303 next if $entry =~ /^\./;
1304 if (-d File::Spec->catdir($bdir,$entry)){
1305 push @bbase, "$bbase\::$entry";
1307 next unless $entry =~ s/\.pm(?!\n)\Z//;
1308 $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
1316 #-> sub CPAN::Shell::b ;
1318 my($self,@which) = @_;
1319 CPAN->debug("which[@which]") if $CPAN::DEBUG;
1320 $self->local_bundles;
1321 $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
1324 #-> sub CPAN::Shell::d ;
1325 sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
1327 #-> sub CPAN::Shell::m ;
1328 sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
1330 $CPAN::Frontend->myprint($self->format_result('Module',@_));
1333 #-> sub CPAN::Shell::i ;
1337 @args = '/./' unless @args;
1339 for my $type (qw/Bundle Distribution Module/) {
1340 push @result, $self->expand($type,@args);
1342 # Authors are always uppercase.
1343 push @result, $self->expand("Author", map { uc $_ } @args);
1345 my $result = @result == 1 ?
1346 $result[0]->as_string :
1348 "No objects found of any type for argument @args\n" :
1350 (map {$_->as_glimpse} @result),
1351 scalar @result, " items found\n",
1353 $CPAN::Frontend->myprint($result);
1356 #-> sub CPAN::Shell::o ;
1358 # CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf'
1359 # should have been called set and 'o debug' maybe 'set debug'
1361 my($self,$o_type,@o_what) = @_;
1364 CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
1365 if ($o_type eq 'conf') {
1366 shift @o_what if @o_what && $o_what[0] eq 'help';
1367 if (!@o_what) { # print all things, "o conf"
1369 $CPAN::Frontend->myprint("CPAN::Config options");
1370 if (exists $INC{'CPAN/Config.pm'}) {
1371 $CPAN::Frontend->myprint(" from $INC{'CPAN/Config.pm'}");
1373 if (exists $INC{'CPAN/MyConfig.pm'}) {
1374 $CPAN::Frontend->myprint(" and $INC{'CPAN/MyConfig.pm'}");
1376 $CPAN::Frontend->myprint(":\n");
1377 for $k (sort keys %CPAN::HandleConfig::can) {
1378 $v = $CPAN::HandleConfig::can{$k};
1379 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v);
1381 $CPAN::Frontend->myprint("\n");
1382 for $k (sort keys %$CPAN::Config) {
1383 CPAN::HandleConfig->prettyprint($k);
1385 $CPAN::Frontend->myprint("\n");
1386 } elsif (!CPAN::HandleConfig->edit(@o_what)) {
1387 $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
1390 } elsif ($o_type eq 'debug') {
1392 @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
1395 my($what) = shift @o_what;
1396 if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
1397 $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
1400 if ( exists $CPAN::DEBUG{$what} ) {
1401 $CPAN::DEBUG |= $CPAN::DEBUG{$what};
1402 } elsif ($what =~ /^\d/) {
1403 $CPAN::DEBUG = $what;
1404 } elsif (lc $what eq 'all') {
1406 for (values %CPAN::DEBUG) {
1409 $CPAN::DEBUG = $max;
1412 for (keys %CPAN::DEBUG) {
1413 next unless lc($_) eq lc($what);
1414 $CPAN::DEBUG |= $CPAN::DEBUG{$_};
1417 $CPAN::Frontend->myprint("unknown argument [$what]\n")
1422 my $raw = "Valid options for debug are ".
1423 join(", ",sort(keys %CPAN::DEBUG), 'all').
1424 qq{ or a number. Completion works on the options. }.
1425 qq{Case is ignored.};
1427 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
1428 $CPAN::Frontend->myprint("\n\n");
1431 $CPAN::Frontend->myprint("Options set for debugging:\n");
1433 for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
1434 $v = $CPAN::DEBUG{$k};
1435 $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v)
1436 if $v & $CPAN::DEBUG;
1439 $CPAN::Frontend->myprint("Debugging turned off completely.\n");
1442 $CPAN::Frontend->myprint(qq{
1444 conf set or get configuration variables
1445 debug set or get debugging options
1450 sub paintdots_onreload {
1453 if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
1457 # $CPAN::Frontend->myprint(".($subr)");
1458 $CPAN::Frontend->myprint(".");
1465 #-> sub CPAN::Shell::reload ;
1467 my($self,$command,@arg) = @_;
1469 $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
1470 if ($command =~ /cpan/i) {
1472 chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
1474 MFILE: for my $f (qw(CPAN.pm CPAN/HandleConfig.pm CPAN/FirstTime.pm CPAN/Tarzip.pm
1475 CPAN/Debug.pm CPAN/Version.pm)) {
1476 local($SIG{__WARN__}) = paintdots_onreload(\$redef);
1477 $self->reload_this($f) or $failed++;
1479 $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
1480 $failed++ unless $redef;
1482 $CPAN::Frontend->mywarn("\n$failed errors during reload. You better quit ".
1485 } elsif ($command =~ /index/) {
1486 CPAN::Index->force_reload;
1488 $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
1489 index re-reads the index files\n});
1495 return 1 unless $INC{$f};
1496 my $pwd = CPAN::anycwd();
1497 CPAN->debug("reloading the whole '$f' from '$INC{$f}' while pwd='$pwd'")
1500 for my $inc (@INC) {
1501 $read = File::Spec->catfile($inc,split /\//, $f);
1508 $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
1511 my $fh = FileHandle->new($read) or
1512 $CPAN::Frontend->mydie("Could not open $read: $!");
1516 CPAN->debug(sprintf("evaling [%s...]\n",substr($eval,0,64)))
1526 #-> sub CPAN::Shell::_binary_extensions ;
1527 sub _binary_extensions {
1528 my($self) = shift @_;
1529 my(@result,$module,%seen,%need,$headerdone);
1530 for $module ($self->expand('Module','/./')) {
1531 my $file = $module->cpan_file;
1532 next if $file eq "N/A";
1533 next if $file =~ /^Contact Author/;
1534 my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
1535 next if $dist->isa_perl;
1536 next unless $module->xs_file;
1538 $CPAN::Frontend->myprint(".");
1539 push @result, $module;
1541 # print join " | ", @result;
1542 $CPAN::Frontend->myprint("\n");
1546 #-> sub CPAN::Shell::recompile ;
1548 my($self) = shift @_;
1549 my($module,@module,$cpan_file,%dist);
1550 @module = $self->_binary_extensions();
1551 for $module (@module){ # we force now and compile later, so we
1553 $cpan_file = $module->cpan_file;
1554 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1556 $dist{$cpan_file}++;
1558 for $cpan_file (sort keys %dist) {
1559 $CPAN::Frontend->myprint(" CPAN: Recompiling $cpan_file\n\n");
1560 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1562 $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1563 # stop a package from recompiling,
1564 # e.g. IO-1.12 when we have perl5.003_10
1568 #-> sub CPAN::Shell::_u_r_common ;
1570 my($self) = shift @_;
1571 my($what) = shift @_;
1572 CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1573 Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
1574 $what && $what =~ /^[aru]$/;
1576 @args = '/./' unless @args;
1577 my(@result,$module,%seen,%need,$headerdone,
1578 $version_undefs,$version_zeroes);
1579 $version_undefs = $version_zeroes = 0;
1580 my $sprintf = "%s%-25s%s %9s %9s %s\n";
1581 my @expand = $self->expand('Module',@args);
1582 my $expand = scalar @expand;
1583 if (0) { # Looks like noise to me, was very useful for debugging
1584 # for metadata cache
1585 $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand);
1587 MODULE: for $module (@expand) {
1588 my $file = $module->cpan_file;
1589 next MODULE unless defined $file; # ??
1590 $file =~ s|^./../||;
1591 my($latest) = $module->cpan_version;
1592 my($inst_file) = $module->inst_file;
1594 return if $CPAN::Signal;
1597 $have = $module->inst_version;
1598 } elsif ($what eq "r") {
1599 $have = $module->inst_version;
1601 if ($have eq "undef"){
1603 } elsif ($have == 0){
1606 next MODULE unless CPAN::Version->vgt($latest, $have);
1607 # to be pedantic we should probably say:
1608 # && !($have eq "undef" && $latest ne "undef" && $latest gt "");
1609 # to catch the case where CPAN has a version 0 and we have a version undef
1610 } elsif ($what eq "u") {
1616 } elsif ($what eq "r") {
1618 } elsif ($what eq "u") {
1622 return if $CPAN::Signal; # this is sometimes lengthy
1625 push @result, sprintf "%s %s\n", $module->id, $have;
1626 } elsif ($what eq "r") {
1627 push @result, $module->id;
1628 next MODULE if $seen{$file}++;
1629 } elsif ($what eq "u") {
1630 push @result, $module->id;
1631 next MODULE if $seen{$file}++;
1632 next MODULE if $file =~ /^Contact/;
1634 unless ($headerdone++){
1635 $CPAN::Frontend->myprint("\n");
1636 $CPAN::Frontend->myprint(sprintf(
1639 "Package namespace",
1651 $CPAN::META->has_inst("Term::ANSIColor")
1653 $module->description
1655 $color_on = Term::ANSIColor::color("green");
1656 $color_off = Term::ANSIColor::color("reset");
1658 $CPAN::Frontend->myprint(sprintf $sprintf,
1665 $need{$module->id}++;
1669 $CPAN::Frontend->myprint("No modules found for @args\n");
1670 } elsif ($what eq "r") {
1671 $CPAN::Frontend->myprint("All modules are up to date for @args\n");
1675 if ($version_zeroes) {
1676 my $s_has = $version_zeroes > 1 ? "s have" : " has";
1677 $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
1678 qq{a version number of 0\n});
1680 if ($version_undefs) {
1681 my $s_has = $version_undefs > 1 ? "s have" : " has";
1682 $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
1683 qq{parseable version number\n});
1689 #-> sub CPAN::Shell::r ;
1691 shift->_u_r_common("r",@_);
1694 #-> sub CPAN::Shell::u ;
1696 shift->_u_r_common("u",@_);
1699 #-> sub CPAN::Shell::failed ;
1701 my($self,$only_id,$silent) = @_;
1703 DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
1705 for my $nosayer (qw(signature_verify make make_test install)) {
1706 next unless exists $d->{$nosayer};
1707 next unless $d->{$nosayer}->failed;
1711 next DIST unless $failed;
1712 next DIST if $only_id && $only_id != $d->{$failed}->commandid;
1716 # " %-45s: %s %s\n",
1718 $d->{$failed}->commandid,
1721 $d->{$failed}->text,
1724 my $scope = $only_id ? "command" : "session";
1726 my $print = join "",
1727 map { sprintf " %-45s: %s %s\n", @$_[1,2,3] }
1728 sort { $a->[0] <=> $b->[0] } @failed;
1729 $CPAN::Frontend->myprint("Failed during this $scope:\n$print");
1730 } elsif (!$only_id || !$silent) {
1731 $CPAN::Frontend->myprint("Nothing failed in this $scope\n");
1735 # XXX intentionally undocumented because completely bogus, unportable,
1738 #-> sub CPAN::Shell::status ;
1741 require Devel::Size;
1742 my $ps = FileHandle->new;
1743 open $ps, "/proc/$$/status";
1746 next unless /VmSize:\s+(\d+)/;
1750 $CPAN::Frontend->mywarn(sprintf(
1751 "%-27s %6d\n%-27s %6d\n",
1755 Devel::Size::total_size($CPAN::META)/1024,
1757 for my $k (sort keys %$CPAN::META) {
1758 next unless substr($k,0,4) eq "read";
1759 warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
1760 for my $k2 (sort keys %{$CPAN::META->{$k}}) {
1761 warn sprintf " %-25s %6d %6d\n",
1763 Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
1764 scalar keys %{$CPAN::META->{$k}{$k2}};
1769 #-> sub CPAN::Shell::autobundle ;
1772 CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
1773 my(@bundle) = $self->_u_r_common("a",@_);
1774 my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1775 File::Path::mkpath($todir);
1776 unless (-d $todir) {
1777 $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
1780 my($y,$m,$d) = (localtime)[5,4,3];
1784 my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1785 my($to) = File::Spec->catfile($todir,"$me.pm");
1787 $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1788 $to = File::Spec->catfile($todir,"$me.pm");
1790 my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1792 "package Bundle::$me;\n\n",
1793 "\$VERSION = '0.01';\n\n",
1797 "Bundle::$me - Snapshot of installation on ",
1798 $Config::Config{'myhostname'},
1801 "\n\n=head1 SYNOPSIS\n\n",
1802 "perl -MCPAN -e 'install Bundle::$me'\n\n",
1803 "=head1 CONTENTS\n\n",
1804 join("\n", @bundle),
1805 "\n\n=head1 CONFIGURATION\n\n",
1807 "\n\n=head1 AUTHOR\n\n",
1808 "This Bundle has been generated automatically ",
1809 "by the autobundle routine in CPAN.pm.\n",
1812 $CPAN::Frontend->myprint("\nWrote bundle file
1816 #-> sub CPAN::Shell::expandany ;
1819 CPAN->debug("s[$s]") if $CPAN::DEBUG;
1820 if ($s =~ m|/|) { # looks like a file
1821 $s = CPAN::Distribution->normalize($s);
1822 return $CPAN::META->instance('CPAN::Distribution',$s);
1823 # Distributions spring into existence, not expand
1824 } elsif ($s =~ m|^Bundle::|) {
1825 $self->local_bundles; # scanning so late for bundles seems
1826 # both attractive and crumpy: always
1827 # current state but easy to forget
1829 return $self->expand('Bundle',$s);
1831 return $self->expand('Module',$s)
1832 if $CPAN::META->exists('CPAN::Module',$s);
1837 #-> sub CPAN::Shell::expand ;
1840 my($type,@args) = @_;
1841 CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
1842 my $class = "CPAN::$type";
1843 my $methods = ['id'];
1844 for my $meth (qw(name)) {
1845 next if $] < 5.00303; # no "can"
1846 next unless $class->can($meth);
1847 push @$methods, $meth;
1849 $self->expand_by_method($class,$methods,@args);
1852 sub expand_by_method {
1854 my($class,$methods,@args) = @_;
1857 my($regex,$command);
1858 if ($arg =~ m|^/(.*)/$|) {
1860 } elsif ($arg =~ m/=/) {
1864 CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
1866 defined $regex ? $regex : "UNDEFINED",
1867 defined $command ? $command : "UNDEFINED",
1869 if (defined $regex) {
1871 $CPAN::META->all_objects($class)
1874 # BUG, we got an empty object somewhere
1875 require Data::Dumper;
1876 CPAN->debug(sprintf(
1877 "Bug in CPAN: Empty id on obj[%s][%s]",
1879 Data::Dumper::Dumper($obj)
1883 for my $method (@$methods) {
1884 if ($obj->$method() =~ /$regex/i) {
1890 } elsif ($command) {
1891 die "equal sign in command disabled (immature interface), ".
1893 ! \$CPAN::Shell::ADVANCED_QUERY=1
1894 to enable it. But please note, this is HIGHLY EXPERIMENTAL code
1895 that may go away anytime.\n"
1896 unless $ADVANCED_QUERY;
1897 my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
1898 my($matchcrit) = $criterion =~ m/^~(.+)/;
1902 $CPAN::META->all_objects($class)
1904 my $lhs = $self->$method() or next; # () for 5.00503
1906 push @m, $self if $lhs =~ m/$matchcrit/;
1908 push @m, $self if $lhs eq $criterion;
1913 if ( $class eq 'CPAN::Bundle' ) {
1914 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1915 } elsif ($class eq "CPAN::Distribution") {
1916 $xarg = CPAN::Distribution->normalize($arg);
1920 if ($CPAN::META->exists($class,$xarg)) {
1921 $obj = $CPAN::META->instance($class,$xarg);
1922 } elsif ($CPAN::META->exists($class,$arg)) {
1923 $obj = $CPAN::META->instance($class,$arg);
1930 @m = sort {$a->id cmp $b->id} @m;
1931 if ( $CPAN::DEBUG ) {
1932 my $wantarray = wantarray;
1933 my $join_m = join ",", map {$_->id} @m;
1934 $self->debug("wantarray[$wantarray]join_m[$join_m]");
1936 return wantarray ? @m : $m[0];
1939 #-> sub CPAN::Shell::format_result ;
1942 my($type,@args) = @_;
1943 @args = '/./' unless @args;
1944 my(@result) = $self->expand($type,@args);
1945 my $result = @result == 1 ?
1946 $result[0]->as_string :
1948 "No objects of type $type found for argument @args\n" :
1950 (map {$_->as_glimpse} @result),
1951 scalar @result, " items found\n",
1956 #-> sub CPAN::Shell::report_fh ;
1958 my $installation_report_fh;
1959 my $previously_noticed = 0;
1962 return $installation_report_fh if $installation_report_fh;
1963 $installation_report_fh = File::Temp->new(
1964 template => 'cpan_install_XXXX',
1968 unless ( $installation_report_fh ) {
1969 warn("Couldn't open installation report file; " .
1970 "no report file will be generated."
1971 ) unless $previously_noticed++;
1977 # The only reason for this method is currently to have a reliable
1978 # debugging utility that reveals which output is going through which
1979 # channel. No, I don't like the colors ;-)
1981 #-> sub CPAN::Shell::print_ornameted ;
1982 sub print_ornamented {
1983 my($self,$what,$ornament) = @_;
1985 return unless defined $what;
1987 local $| = 1; # Flush immediately
1988 if ( $CPAN::Be_Silent ) {
1989 print {report_fh()} $what;
1993 if ($CPAN::Config->{term_is_latin}){
1996 =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
1998 if ($PRINT_ORNAMENTING) {
1999 unless (defined &color) {
2000 if ($CPAN::META->has_inst("Term::ANSIColor")) {
2001 import Term::ANSIColor "color";
2003 *color = sub { return "" };
2007 for $line (split /\n/, $what) {
2008 $longest = length($line) if length($line) > $longest;
2010 my $sprintf = "%-" . $longest . "s";
2012 $what =~ s/(.*\n?)//m;
2015 my($nl) = chomp $line ? "\n" : "";
2016 # print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
2017 print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
2021 # $what .= "\n"; # newlines unless $PRINT_ORNAMENTING
2027 my($self,$what) = @_;
2029 $self->print_ornamented($what, 'bold blue on_yellow');
2033 my($self,$what) = @_;
2034 $self->myprint($what);
2039 my($self,$what) = @_;
2040 $self->print_ornamented($what, 'bold red on_yellow');
2044 my($self,$what) = @_;
2045 $self->print_ornamented($what, 'bold red on_white');
2046 Carp::confess "died";
2050 my($self,$what) = @_;
2051 $self->print_ornamented($what, 'bold red on_white');
2055 # use this only for unrecoverable errors!
2056 sub unrecoverable_error {
2057 my($self,$what) = @_;
2058 my @lines = split /\n/, $what;
2060 for my $l (@lines) {
2061 $longest = length $l if length $l > $longest;
2063 $longest = 62 if $longest > 62;
2064 for my $l (@lines) {
2070 if (length $l < 66) {
2071 $l = pack "A66 A*", $l, "<==";
2075 unshift @lines, "\n";
2076 $self->mydie(join "", @lines);
2081 my($self, $sleep) = @_;
2086 return if -t STDOUT;
2087 my $odef = select STDERR;
2094 #-> sub CPAN::Shell::rematein ;
2095 # RE-adme||MA-ke||TE-st||IN-stall
2098 my($meth,@some) = @_;
2100 while($meth =~ /^(force|notest)$/) {
2101 push @pragma, $meth;
2102 $meth = shift @some or
2103 $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
2107 CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;
2109 # Here is the place to set "test_count" on all involved parties to
2110 # 0. We then can pass this counter on to the involved
2111 # distributions and those can refuse to test if test_count > X. In
2112 # the first stab at it we could use a 1 for "X".
2114 # But when do I reset the distributions to start with 0 again?
2115 # Jost suggested to have a random or cycling interaction ID that
2116 # we pass through. But the ID is something that is just left lying
2117 # around in addition to the counter, so I'd prefer to set the
2118 # counter to 0 now, and repeat at the end of the loop. But what
2119 # about dependencies? They appear later and are not reset, they
2120 # enter the queue but not its copy. How do they get a sensible
2123 # construct the queue
2125 STHING: foreach $s (@some) {
2128 CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
2130 } elsif ($s =~ m|^/|) { # looks like a regexp
2131 $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
2135 } elsif ($meth eq "ls") {
2136 $self->globls($s,\@pragma);
2139 CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
2140 $obj = CPAN::Shell->expandany($s);
2143 $obj->color_cmd_tmps(0,1);
2144 CPAN::Queue->new($obj->id);
2146 } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
2147 $obj = $CPAN::META->instance('CPAN::Author',uc($s));
2148 if ($meth =~ /^(dump|ls)$/) {
2151 $CPAN::Frontend->myprint(
2153 "Don't be silly, you can't $meth ",
2161 ->myprint(qq{Warning: Cannot $meth $s, }.
2162 qq{don\'t know what it is.
2167 to find objects with matching identifiers.
2173 # queuerunner (please be warned: when I started to change the
2174 # queue to hold objects instead of names, I made one or two
2175 # mistakes and never found which. I reverted back instead)
2176 while ($s = CPAN::Queue->first) {
2179 $obj = $s; # I do not believe, we would survive if this happened
2181 $obj = CPAN::Shell->expandany($s);
2183 for my $pragma (@pragma) {
2186 ($] < 5.00303 || $obj->can($pragma))){
2187 ### compatibility with 5.003
2188 $obj->$pragma($meth); # the pragma "force" in
2189 # "CPAN::Distribution" must know
2190 # what we are intending
2193 if ($]>=5.00303 && $obj->can('called_for')) {
2194 $obj->called_for($s);
2197 qq{pragma[@pragma]meth[$meth]obj[$obj]as_string\[}.
2203 CPAN::Queue->delete($s);
2205 CPAN->debug("failed");
2209 CPAN::Queue->delete_first($s);
2211 for my $obj (@qcopy) {
2212 $obj->color_cmd_tmps(0,0);
2213 delete $obj->{incommandcolor};
2217 #-> sub CPAN::Shell::recent ;
2221 CPAN::Distribution::_display_url( $self, $CPAN::Defaultrecent );
2226 # set up the dispatching methods
2228 for my $command (qw(
2243 *$command = sub { shift->rematein($command, @_); };
2247 package CPAN::LWP::UserAgent;
2251 return if $SETUPDONE;
2252 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2253 require LWP::UserAgent;
2254 @ISA = qw(Exporter LWP::UserAgent);
2257 $CPAN::Frontend->mywarn("LWP::UserAgent not available\n");
2261 sub get_basic_credentials {
2262 my($self, $realm, $uri, $proxy) = @_;
2263 return unless $proxy;
2264 if ($USER && $PASSWD) {
2265 } elsif (defined $CPAN::Config->{proxy_user} &&
2266 defined $CPAN::Config->{proxy_pass}) {
2267 $USER = $CPAN::Config->{proxy_user};
2268 $PASSWD = $CPAN::Config->{proxy_pass};
2270 require ExtUtils::MakeMaker;
2271 ExtUtils::MakeMaker->import(qw(prompt));
2272 $USER = prompt("Proxy authentication needed!
2273 (Note: to permanently configure username and password run
2274 o conf proxy_user your_username
2275 o conf proxy_pass your_password
2277 if ($CPAN::META->has_inst("Term::ReadKey")) {
2278 Term::ReadKey::ReadMode("noecho");
2280 $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n");
2282 $PASSWD = prompt("Password:");
2283 if ($CPAN::META->has_inst("Term::ReadKey")) {
2284 Term::ReadKey::ReadMode("restore");
2286 $CPAN::Frontend->myprint("\n\n");
2288 return($USER,$PASSWD);
2291 # mirror(): Its purpose is to deal with proxy authentication. When we
2292 # call SUPER::mirror, we relly call the mirror method in
2293 # LWP::UserAgent. LWP::UserAgent will then call
2294 # $self->get_basic_credentials or some equivalent and this will be
2295 # $self->dispatched to our own get_basic_credentials method.
2297 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2299 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2300 # although we have gone through our get_basic_credentials, the proxy
2301 # server refuses to connect. This could be a case where the username or
2302 # password has changed in the meantime, so I'm trying once again without
2303 # $USER and $PASSWD to give the get_basic_credentials routine another
2304 # chance to set $USER and $PASSWD.
2306 # mirror(): Its purpose is to deal with proxy authentication. When we
2307 # call SUPER::mirror, we relly call the mirror method in
2308 # LWP::UserAgent. LWP::UserAgent will then call
2309 # $self->get_basic_credentials or some equivalent and this will be
2310 # $self->dispatched to our own get_basic_credentials method.
2312 # Our own get_basic_credentials sets $USER and $PASSWD, two globals.
2314 # 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
2315 # although we have gone through our get_basic_credentials, the proxy
2316 # server refuses to connect. This could be a case where the username or
2317 # password has changed in the meantime, so I'm trying once again without
2318 # $USER and $PASSWD to give the get_basic_credentials routine another
2319 # chance to set $USER and $PASSWD.
2322 my($self,$url,$aslocal) = @_;
2323 my $result = $self->SUPER::mirror($url,$aslocal);
2324 if ($result->code == 407) {
2327 $result = $self->SUPER::mirror($url,$aslocal);
2335 #-> sub CPAN::FTP::ftp_get ;
2337 my($class,$host,$dir,$file,$target) = @_;
2339 qq[Going to fetch file [$file] from dir [$dir]
2340 on host [$host] as local [$target]\n]
2342 my $ftp = Net::FTP->new($host);
2344 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
2347 return 0 unless defined $ftp;
2348 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
2349 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
2350 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
2351 my $msg = $ftp->message;
2352 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg");
2355 unless ( $ftp->cwd($dir) ){
2356 my $msg = $ftp->message;
2357 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg");
2361 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
2362 unless ( $ftp->get($file,$target) ){
2363 my $msg = $ftp->message;
2364 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg");
2367 $ftp->quit; # it's ok if this fails
2371 # If more accuracy is wanted/needed, Chris Leach sent me this patch...
2373 # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
2374 # > --- /tmp/cp Wed Sep 24 13:26:40 1997
2376 # > *** 1562,1567 ****
2377 # > --- 1562,1580 ----
2378 # > return 1 if substr($url,0,4) eq "file";
2379 # > return 1 unless $url =~ m|://([^/]+)|;
2381 # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
2383 # > + $proxy =~ m|://([^/:]+)|;
2385 # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
2386 # > + if ($noproxy) {
2387 # > + if ($host !~ /$noproxy$/) {
2388 # > + $host = $proxy;
2391 # > + $host = $proxy;
2394 # > require Net::Ping;
2395 # > return 1 unless $Net::Ping::VERSION >= 2;
2399 #-> sub CPAN::FTP::localize ;
2401 my($self,$file,$aslocal,$force) = @_;
2403 Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
2404 unless defined $aslocal;
2405 $self->debug("file[$file] aslocal[$aslocal] force[$force]")
2408 if ($^O eq 'MacOS') {
2409 # Comment by AK on 2000-09-03: Uniq short filenames would be
2410 # available in CHECKSUMS file
2411 my($name, $path) = File::Basename::fileparse($aslocal, '');
2412 if (length($name) > 31) {
2423 my $size = 31 - length($suf);
2424 while (length($name) > $size) {
2428 $aslocal = File::Spec->catfile($path, $name);
2432 if (-f $aslocal && -r _ && !($force & 1)){
2436 # empty file from a previous unsuccessful attempt to download it
2438 $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I could not remove.");
2443 rename $aslocal, "$aslocal.bak";
2447 my($aslocal_dir) = File::Basename::dirname($aslocal);
2448 File::Path::mkpath($aslocal_dir);
2449 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
2450 qq{directory "$aslocal_dir".
2451 I\'ll continue, but if you encounter problems, they may be due
2452 to insufficient permissions.\n}) unless -w $aslocal_dir;
2454 # Inheritance is not easier to manage than a few if/else branches
2455 if ($CPAN::META->has_usable('LWP::UserAgent')) {
2457 CPAN::LWP::UserAgent->config;
2458 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
2460 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
2464 $Ua->proxy('ftp', $var)
2465 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
2466 $Ua->proxy('http', $var)
2467 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
2470 # >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
2472 # > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
2473 # > use ones that require basic autorization.
2475 # > Example of when I use it manually in my own stuff:
2477 # > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
2478 # > $req->proxy_authorization_basic("username","password");
2479 # > $res = $ua->request($req);
2483 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
2487 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
2488 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
2491 # Try the list of urls for each single object. We keep a record
2492 # where we did get a file from
2493 my(@reordered,$last);
2494 $CPAN::Config->{urllist} ||= [];
2495 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
2496 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
2497 $CPAN::Config->{urllist} = [];
2499 $last = $#{$CPAN::Config->{urllist}};
2500 if ($force & 2) { # local cpans probably out of date, don't reorder
2501 @reordered = (0..$last);
2505 (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
2507 (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
2511 ($CPAN::Config->{urllist}[$b] eq $Thesite)
2513 ($CPAN::Config->{urllist}[$a] eq $Thesite)
2518 @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
2520 @levels = qw/easy hard hardest/;
2522 @levels = qw/easy/ if $^O eq 'MacOS';
2524 local $ENV{FTP_PASSIVE} = $CPAN::Config->{ftp_passive} if exists $CPAN::Config->{ftp_passive};
2525 for $levelno (0..$#levels) {
2526 my $level = $levels[$levelno];
2527 my $method = "host$level";
2528 my @host_seq = $level eq "easy" ?
2529 @reordered : 0..$last; # reordered has CDROM up front
2530 my @urllist = map { $CPAN::Config->{urllist}[$_] } @host_seq;
2531 for my $u (@urllist) {
2532 $u .= "/" unless substr($u,-1) eq "/";
2534 for my $u (@CPAN::Defaultsites) {
2535 push @urllist, $u unless grep { $_ eq $u } @urllist;
2537 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
2538 my $ret = $self->$method(\@urllist,$file,$aslocal);
2540 $Themethod = $level;
2542 # utime $now, $now, $aslocal; # too bad, if we do that, we
2543 # might alter a local mirror
2544 $self->debug("level[$level]") if $CPAN::DEBUG;
2548 last if $CPAN::Signal; # need to cleanup
2551 unless ($CPAN::Signal) {
2554 qq{Please check, if the URLs I found in your configuration file \(}.
2555 join(", ", @{$CPAN::Config->{urllist}}).
2556 qq{\) are valid. The urllist can be edited.},
2557 qq{E.g. with 'o conf urllist push ftp://myurl/'};
2558 $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
2560 $CPAN::Frontend->myprint("Could not fetch $file\n");
2563 rename "$aslocal.bak", $aslocal;
2564 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
2565 $self->ls($aslocal));
2571 # package CPAN::FTP;
2573 my($self,$host_seq,$file,$aslocal) = @_;
2575 HOSTEASY: for $ro_url (@$host_seq) {
2576 my $url .= "$ro_url$file";
2577 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
2578 if ($url =~ /^file:/) {
2580 if ($CPAN::META->has_inst('URI::URL')) {
2581 my $u = URI::URL->new($url);
2583 } else { # works only on Unix, is poorly constructed, but
2584 # hopefully better than nothing.
2585 # RFC 1738 says fileurl BNF is
2586 # fileurl = "file://" [ host | "localhost" ] "/" fpath
2587 # Thanks to "Mark D. Baushke" <mdb@cisco.com> for
2589 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
2590 $l =~ s|^file:||; # assume they
2593 $l =~ s|^/||s unless -f $l; # e.g. /P:
2594 $self->debug("without URI::URL we try local file $l") if $CPAN::DEBUG;
2596 if ( -f $l && -r _) {
2600 # Maybe mirror has compressed it?
2602 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
2603 CPAN::Tarzip->new("$l.gz")->gunzip($aslocal);
2610 if ($CPAN::META->has_usable('LWP')) {
2611 $CPAN::Frontend->myprint("Fetching with LWP:
2615 CPAN::LWP::UserAgent->config;
2616 eval { $Ua = CPAN::LWP::UserAgent->new; };
2618 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
2621 my $res = $Ua->mirror($url, $aslocal);
2622 if ($res->is_success) {
2625 utime $now, $now, $aslocal; # download time is more
2626 # important than upload time
2628 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2629 my $gzurl = "$url.gz";
2630 $CPAN::Frontend->myprint("Fetching with LWP:
2633 $res = $Ua->mirror($gzurl, "$aslocal.gz");
2634 if ($res->is_success &&
2635 CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)
2641 $CPAN::Frontend->myprint(sprintf(
2642 "LWP failed with code[%s] message[%s]\n",
2646 # Alan Burlison informed me that in firewall environments
2647 # Net::FTP can still succeed where LWP fails. So we do not
2648 # skip Net::FTP anymore when LWP is available.
2651 $CPAN::Frontend->myprint("LWP not available\n");
2653 return if $CPAN::Signal;
2654 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2655 # that's the nice and easy way thanks to Graham
2656 my($host,$dir,$getfile) = ($1,$2,$3);
2657 if ($CPAN::META->has_usable('Net::FTP')) {
2659 $CPAN::Frontend->myprint("Fetching with Net::FTP:
2662 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
2663 "aslocal[$aslocal]") if $CPAN::DEBUG;
2664 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
2668 if ($aslocal !~ /\.gz(?!\n)\Z/) {
2669 my $gz = "$aslocal.gz";
2670 $CPAN::Frontend->myprint("Fetching with Net::FTP
2673 if (CPAN::FTP->ftp_get($host,
2677 CPAN::Tarzip->new($gz)->gunzip($aslocal)
2686 return if $CPAN::Signal;
2690 # package CPAN::FTP;
2692 my($self,$host_seq,$file,$aslocal) = @_;
2694 # Came back if Net::FTP couldn't establish connection (or
2695 # failed otherwise) Maybe they are behind a firewall, but they
2696 # gave us a socksified (or other) ftp program...
2699 my($devnull) = $CPAN::Config->{devnull} || "";
2701 my($aslocal_dir) = File::Basename::dirname($aslocal);
2702 File::Path::mkpath($aslocal_dir);
2703 HOSTHARD: for $ro_url (@$host_seq) {
2704 my $url = "$ro_url$file";
2705 my($proto,$host,$dir,$getfile);
2707 # Courtesy Mark Conty mark_conty@cargill.com change from
2708 # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2710 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
2711 # proto not yet used
2712 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
2714 next HOSTHARD; # who said, we could ftp anything except ftp?
2716 next HOSTHARD if $proto eq "file"; # file URLs would have had
2717 # success above. Likely a bogus URL
2719 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
2721 # Try the most capable first and leave ncftp* for last as it only
2723 for my $f (qw(curl wget lynx ncftpget ncftp)) {
2724 my $funkyftp = $CPAN::Config->{$f};
2725 next unless defined $funkyftp;
2726 next if $funkyftp =~ /^\s*$/;
2728 my($asl_ungz, $asl_gz);
2729 ($asl_ungz = $aslocal) =~ s/\.gz//;
2730 $asl_gz = "$asl_ungz.gz";
2732 my($src_switch) = "";
2734 my($stdout_redir) = " > $asl_ungz";
2736 $src_switch = " -source";
2737 } elsif ($f eq "ncftp"){
2738 $src_switch = " -c";
2739 } elsif ($f eq "wget"){
2740 $src_switch = " -O $asl_ungz";
2742 } elsif ($f eq 'curl'){
2743 $src_switch = ' -L';
2746 if ($f eq "ncftpget"){
2747 $chdir = "cd $aslocal_dir && ";
2750 $CPAN::Frontend->myprint(
2752 Trying with "$funkyftp$src_switch" to get
2756 "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
2757 $self->debug("system[$system]") if $CPAN::DEBUG;
2759 if (($wstatus = system($system)) == 0
2762 -s $asl_ungz # lynx returns 0 when it fails somewhere
2768 } elsif ($asl_ungz ne $aslocal) {
2769 # test gzip integrity
2770 if (CPAN::Tarzip->new($asl_ungz)->gtest) {
2771 # e.g. foo.tar is gzipped --> foo.tar.gz
2772 rename $asl_ungz, $aslocal;
2774 CPAN::Tarzip->new($asl_gz)->gzip($asl_ungz);
2779 } elsif ($url !~ /\.gz(?!\n)\Z/) {
2781 -f $asl_ungz && -s _ == 0;
2782 my $gz = "$aslocal.gz";
2783 my $gzurl = "$url.gz";
2784 $CPAN::Frontend->myprint(
2786 Trying with "$funkyftp$src_switch" to get
2789 my($system) = "$funkyftp$src_switch \"$url.gz\" $devnull > $asl_gz";
2790 $self->debug("system[$system]") if $CPAN::DEBUG;
2792 if (($wstatus = system($system)) == 0
2796 # test gzip integrity
2797 my $ct = CPAN::Tarzip->new($asl_gz);
2799 $ct->gunzip($aslocal);
2801 # somebody uncompressed file for us?
2802 rename $asl_ungz, $aslocal;
2807 unlink $asl_gz if -f $asl_gz;
2810 my $estatus = $wstatus >> 8;
2811 my $size = -f $aslocal ?
2812 ", left\n$aslocal with size ".-s _ :
2813 "\nWarning: expected file [$aslocal] doesn't exist";
2814 $CPAN::Frontend->myprint(qq{
2815 System call "$system"
2816 returned status $estatus (wstat $wstatus)$size
2819 return if $CPAN::Signal;
2820 } # transfer programs
2824 # package CPAN::FTP;
2826 my($self,$host_seq,$file,$aslocal) = @_;
2829 my($aslocal_dir) = File::Basename::dirname($aslocal);
2830 File::Path::mkpath($aslocal_dir);
2831 my $ftpbin = $CPAN::Config->{ftp};
2832 unless (length $ftpbin && MM->maybe_command($ftpbin)) {
2833 $CPAN::Frontend->myprint("No external ftp command available\n\n");
2836 $CPAN::Frontend->myprint(qq{
2837 As a last ressort we now switch to the external ftp command '$ftpbin'
2840 Doing so often leads to problems that are hard to diagnose, even endless
2841 loops may be encountered.
2843 If you're victim of such problems, please consider unsetting the ftp
2844 config variable with
2850 $CPAN::Frontend->mysleep(4);
2851 HOSTHARDEST: for $ro_url (@$host_seq) {
2852 my $url = "$ro_url$file";
2853 $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
2854 unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
2857 my($host,$dir,$getfile) = ($1,$2,$3);
2859 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
2860 $ctime,$blksize,$blocks) = stat($aslocal);
2861 $timestamp = $mtime ||= 0;
2862 my($netrc) = CPAN::FTP::netrc->new;
2863 my($netrcfile) = $netrc->netrc;
2864 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
2865 my $targetfile = File::Basename::basename($aslocal);
2871 map("cd $_", split /\//, $dir), # RFC 1738
2873 "get $getfile $targetfile",
2877 CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
2878 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
2879 CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
2881 $netrc->contains($host))) if $CPAN::DEBUG;
2882 if ($netrc->protected) {
2883 my $dialog = join "", map { " $_\n" } @dialog;
2885 if ($netrc->contains($host)) {
2886 $netrc_explain = "Relying that your .netrc entry for '$host' ".
2887 "manages the login";
2889 $netrc_explain = "Relying that your default .netrc entry ".
2890 "manages the login";
2892 $CPAN::Frontend->myprint(qq{
2893 Trying with external ftp to get
2896 Going to send the dialog
2900 $self->talk_ftp("$ftpbin$verbose $host",
2902 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2903 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2905 if ($mtime > $timestamp) {
2906 $CPAN::Frontend->myprint("GOT $aslocal\n");
2910 $CPAN::Frontend->myprint("Hmm... Still failed!\n");
2912 return if $CPAN::Signal;
2914 $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
2915 qq{correctly protected.\n});
2918 $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
2919 nor does it have a default entry\n");
2922 # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
2923 # then and login manually to host, using e-mail as
2925 $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n});
2929 "user anonymous $Config::Config{'cf_email'}"
2931 my $dialog = join "", map { " $_\n" } @dialog;
2932 $CPAN::Frontend->myprint(qq{
2933 Trying with external ftp to get
2935 Going to send the dialog
2939 $self->talk_ftp("$ftpbin$verbose -n", @dialog);
2940 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
2941 $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
2943 if ($mtime > $timestamp) {
2944 $CPAN::Frontend->myprint("GOT $aslocal\n");
2948 $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
2950 return if $CPAN::Signal;
2951 $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
2956 # package CPAN::FTP;
2958 my($self,$command,@dialog) = @_;
2959 my $fh = FileHandle->new;
2960 $fh->open("|$command") or die "Couldn't open ftp: $!";
2961 foreach (@dialog) { $fh->print("$_\n") }
2962 $fh->close; # Wait for process to complete
2964 my $estatus = $wstatus >> 8;
2965 $CPAN::Frontend->myprint(qq{
2966 Subprocess "|$command"
2967 returned status $estatus (wstat $wstatus)
2971 # find2perl needs modularization, too, all the following is stolen
2975 my($self,$name) = @_;
2976 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
2977 $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
2979 my($perms,%user,%group);
2983 $blocks = int(($blocks + 1) / 2);
2986 $blocks = int(($sizemm + 1023) / 1024);
2989 if (-f _) { $perms = '-'; }
2990 elsif (-d _) { $perms = 'd'; }
2991 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
2992 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
2993 elsif (-p _) { $perms = 'p'; }
2994 elsif (-S _) { $perms = 's'; }
2995 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
2997 my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
2998 my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
2999 my $tmpmode = $mode;
3000 my $tmp = $rwx[$tmpmode & 7];
3002 $tmp = $rwx[$tmpmode & 7] . $tmp;
3004 $tmp = $rwx[$tmpmode & 7] . $tmp;
3005 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
3006 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
3007 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
3010 my $user = $user{$uid} || $uid; # too lazy to implement lookup
3011 my $group = $group{$gid} || $gid;
3013 my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
3015 my($moname) = $moname[$mon];
3016 if (-M _ > 365.25 / 2) {
3017 $timeyear = $year + 1900;
3020 $timeyear = sprintf("%02d:%02d", $hour, $min);
3023 sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
3037 package CPAN::FTP::netrc;
3040 # package CPAN::FTP::netrc;
3043 my $file = File::Spec->catfile($ENV{HOME},".netrc");
3045 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
3046 $atime,$mtime,$ctime,$blksize,$blocks)
3051 my($fh,@machines,$hasdefault);
3053 $fh = FileHandle->new or die "Could not create a filehandle";
3055 if($fh->open($file)){
3056 $protected = ($mode & 077) == 0;
3058 NETRC: while (<$fh>) {
3059 my(@tokens) = split " ", $_;
3060 TOKEN: while (@tokens) {
3061 my($t) = shift @tokens;
3062 if ($t eq "default"){
3066 last TOKEN if $t eq "macdef";
3067 if ($t eq "machine") {
3068 push @machines, shift @tokens;
3073 $file = $hasdefault = $protected = "";
3077 'mach' => [@machines],
3079 'hasdefault' => $hasdefault,
3080 'protected' => $protected,
3084 # CPAN::FTP::netrc::hasdefault;
3085 sub hasdefault { shift->{'hasdefault'} }
3086 sub netrc { shift->{'netrc'} }
3087 sub protected { shift->{'protected'} }
3089 my($self,$mach) = @_;
3090 for ( @{$self->{'mach'}} ) {
3091 return 1 if $_ eq $mach;
3096 package CPAN::Complete;
3100 my($text, $line, $start, $end) = @_;
3101 my(@perlret) = cpl($text, $line, $start);
3102 # find longest common match. Can anybody show me how to peruse
3103 # T::R::Gnu to have this done automatically? Seems expensive.
3104 return () unless @perlret;
3105 my($newtext) = $text;
3106 for (my $i = length($text)+1;;$i++) {
3107 last unless length($perlret[0]) && length($perlret[0]) >= $i;
3108 my $try = substr($perlret[0],0,$i);
3109 my @tries = grep {substr($_,0,$i) eq $try} @perlret;
3110 # warn "try[$try]tries[@tries]";
3111 if (@tries == @perlret) {
3117 ($newtext,@perlret);
3120 #-> sub CPAN::Complete::cpl ;
3122 my($word,$line,$pos) = @_;
3126 CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3128 if ($line =~ s/^(force\s*)//) {
3133 @return = grep /^$word/, @CPAN::Complete::COMMANDS;
3134 } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
3136 } elsif ($line =~ /^(a|ls)\s/) {
3137 @return = cplx('CPAN::Author',uc($word));
3138 } elsif ($line =~ /^b\s/) {
3139 CPAN::Shell->local_bundles;
3140 @return = cplx('CPAN::Bundle',$word);
3141 } elsif ($line =~ /^d\s/) {
3142 @return = cplx('CPAN::Distribution',$word);
3143 } elsif ($line =~ m/^(
3144 [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
3146 if ($word =~ /^Bundle::/) {
3147 CPAN::Shell->local_bundles;
3149 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3150 } elsif ($line =~ /^i\s/) {
3151 @return = cpl_any($word);
3152 } elsif ($line =~ /^reload\s/) {
3153 @return = cpl_reload($word,$line,$pos);
3154 } elsif ($line =~ /^o\s/) {
3155 @return = cpl_option($word,$line,$pos);
3156 } elsif ($line =~ m/^\S+\s/ ) {
3157 # fallback for future commands and what we have forgotten above
3158 @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
3165 #-> sub CPAN::Complete::cplx ;
3167 my($class, $word) = @_;
3168 # I believed for many years that this was sorted, today I
3169 # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I
3170 # make it sorted again. Maybe sort was dropped when GNU-readline
3171 # support came in? The RCS file is difficult to read on that:-(
3172 sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
3175 #-> sub CPAN::Complete::cpl_any ;
3179 cplx('CPAN::Author',$word),
3180 cplx('CPAN::Bundle',$word),
3181 cplx('CPAN::Distribution',$word),
3182 cplx('CPAN::Module',$word),
3186 #-> sub CPAN::Complete::cpl_reload ;
3188 my($word,$line,$pos) = @_;
3190 my(@words) = split " ", $line;
3191 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3192 my(@ok) = qw(cpan index);
3193 return @ok if @words == 1;
3194 return grep /^\Q$word\E/, @ok if @words == 2 && $word;
3197 #-> sub CPAN::Complete::cpl_option ;
3199 my($word,$line,$pos) = @_;
3201 my(@words) = split " ", $line;
3202 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
3203 my(@ok) = qw(conf debug);
3204 return @ok if @words == 1;
3205 return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
3207 } elsif ($words[1] eq 'index') {
3209 } elsif ($words[1] eq 'conf') {
3210 return CPAN::HandleConfig::cpl(@_);
3211 } elsif ($words[1] eq 'debug') {
3212 return sort grep /^\Q$word\E/i,
3213 sort keys %CPAN::DEBUG, 'all';
3217 package CPAN::Index;
3220 #-> sub CPAN::Index::force_reload ;
3223 $CPAN::Index::LAST_TIME = 0;
3227 #-> sub CPAN::Index::reload ;
3229 my($cl,$force) = @_;
3232 # XXX check if a newer one is available. (We currently read it
3233 # from time to time)
3234 for ($CPAN::Config->{index_expire}) {
3235 $_ = 0.001 unless $_ && $_ > 0.001;
3237 unless (1 || $CPAN::Have_warned->{readmetadatacache}++) {
3238 # debug here when CPAN doesn't seem to read the Metadata
3240 Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]");
3242 unless ($CPAN::META->{PROTOCOL}) {
3243 $cl->read_metadata_cache;
3244 $CPAN::META->{PROTOCOL} ||= "1.0";
3246 if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) {
3247 # warn "Setting last_time to 0";
3248 $LAST_TIME = 0; # No warning necessary
3250 return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
3253 # IFF we are developing, it helps to wipe out the memory
3254 # between reloads, otherwise it is not what a user expects.
3255 undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274)
3256 $CPAN::META = CPAN->new;
3260 local $LAST_TIME = $time;
3261 local $CPAN::META->{PROTOCOL} = PROTOCOL;
3263 my $needshort = $^O eq "dos";
3265 $cl->rd_authindex($cl
3267 "authors/01mailrc.txt.gz",
3269 File::Spec->catfile('authors', '01mailrc.gz') :
3270 File::Spec->catfile('authors', '01mailrc.txt.gz'),
3273 $debug = "timing reading 01[".($t2 - $time)."]";
3275 return if $CPAN::Signal; # this is sometimes lengthy
3276 $cl->rd_modpacks($cl
3278 "modules/02packages.details.txt.gz",
3280 File::Spec->catfile('modules', '02packag.gz') :
3281 File::Spec->catfile('modules', '02packages.details.txt.gz'),
3284 $debug .= "02[".($t2 - $time)."]";
3286 return if $CPAN::Signal; # this is sometimes lengthy
3289 "modules/03modlist.data.gz",
3291 File::Spec->catfile('modules', '03mlist.gz') :
3292 File::Spec->catfile('modules', '03modlist.data.gz'),
3294 $cl->write_metadata_cache;
3296 $debug .= "03[".($t2 - $time)."]";
3298 CPAN->debug($debug) if $CPAN::DEBUG;
3301 $CPAN::META->{PROTOCOL} = PROTOCOL;
3304 #-> sub CPAN::Index::reload_x ;
3306 my($cl,$wanted,$localname,$force) = @_;
3307 $force |= 2; # means we're dealing with an index here
3308 CPAN::HandleConfig->load; # we should guarantee loading wherever we rely
3310 $localname ||= $wanted;
3311 my $abs_wanted = File::Spec->catfile($CPAN::Config->{'keep_source_where'},
3315 -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
3318 my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
3319 $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
3320 qq{day$s. I\'ll use that.});
3323 $force |= 1; # means we're quite serious about it.
3325 return CPAN::FTP->localize($wanted,$abs_wanted,$force);
3328 #-> sub CPAN::Index::rd_authindex ;
3330 my($cl, $index_target) = @_;
3332 return unless defined $index_target;
3333 $CPAN::Frontend->myprint("Going to read $index_target\n");
3335 tie *FH, 'CPAN::Tarzip', $index_target;
3338 push @lines, split /\012/ while <FH>;
3340 my($userid,$fullname,$email) =
3341 m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
3342 next unless $userid && $fullname && $email;
3344 # instantiate an author object
3345 my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
3346 $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
3347 return if $CPAN::Signal;
3352 my($self,$dist) = @_;
3353 $dist = $self->{'id'} unless defined $dist;
3354 my($ret) = $dist =~ m|(?:\w/\w\w/)?([^/]+)/|;
3358 #-> sub CPAN::Index::rd_modpacks ;
3360 my($self, $index_target) = @_;
3362 return unless defined $index_target;
3363 $CPAN::Frontend->myprint("Going to read $index_target\n");
3364 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3367 while ($_ = $fh->READLINE) {
3369 my @ls = map {"$_\n"} split /\n/, $_;
3370 unshift @ls, "\n" x length($1) if /^(\n+)/;
3374 my($line_count,$last_updated);
3376 my $shift = shift(@lines);
3377 last if $shift =~ /^\s*$/;
3378 $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
3379 $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
3381 if (not defined $line_count) {
3383 warn qq{Warning: Your $index_target does not contain a Line-Count header.
3384 Please check the validity of the index file by comparing it to more
3385 than one CPAN mirror. I'll continue but problems seem likely to
3390 } elsif ($line_count != scalar @lines) {
3392 warn sprintf qq{Warning: Your %s
3393 contains a Line-Count header of %d but I see %d lines there. Please
3394 check the validity of the index file by comparing it to more than one
3395 CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
3396 $index_target, $line_count, scalar(@lines);
3399 if (not defined $last_updated) {
3401 warn qq{Warning: Your $index_target does not contain a Last-Updated header.
3402 Please check the validity of the index file by comparing it to more
3403 than one CPAN mirror. I'll continue but problems seem likely to
3411 ->myprint(sprintf qq{ Database was generated on %s\n},
3413 $DATE_OF_02 = $last_updated;
3416 if ($CPAN::META->has_inst('HTTP::Date')) {
3418 $age -= HTTP::Date::str2time($last_updated);
3420 $CPAN::Frontend->myprint(" HTTP::Date not available\n");
3421 require Time::Local;
3422 my(@d) = $last_updated =~ / (\d+) (\w+) (\d+) (\d+):(\d+):(\d+) /;
3423 $d[1] = index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec", $d[1])/4;
3424 $age -= $d[1]>=0 ? Time::Local::timegm(@d[5,4,3,0,1,2]) : 0;
3431 qq{Warning: This index file is %d days old.
3432 Please check the host you chose as your CPAN mirror for staleness.
3433 I'll continue but problems seem likely to happen.\a\n},
3436 } elsif ($age < -1) {
3440 qq{Warning: Your system date is %d days behind this index file!
3442 Timestamp index file: %s
3443 Please fix your system time, problems with the make command expected.\n},
3453 # A necessity since we have metadata_cache: delete what isn't
3455 my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
3456 CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
3460 # before 1.56 we split into 3 and discarded the rest. From
3461 # 1.57 we assign remaining text to $comment thus allowing to
3462 # influence isa_perl
3463 my($mod,$version,$dist,$comment) = split " ", $_, 4;
3464 my($bundle,$id,$userid);
3466 if ($mod eq 'CPAN' &&
3468 CPAN::Queue->exists('Bundle::CPAN') ||
3469 CPAN::Queue->exists('CPAN')
3473 if ($version > $CPAN::VERSION){
3474 $CPAN::Frontend->myprint(qq{
3475 There's a new CPAN.pm version (v$version) available!
3476 [Current version is v$CPAN::VERSION]
3477 You might want to try
3478 install Bundle::CPAN
3480 without quitting the current session. It should be a seamless upgrade
3481 while we are running...
3484 $CPAN::Frontend->myprint(qq{\n});
3486 last if $CPAN::Signal;
3487 } elsif ($mod =~ /^Bundle::(.*)/) {
3492 $id = $CPAN::META->instance('CPAN::Bundle',$mod);
3493 # Let's make it a module too, because bundles have so much
3494 # in common with modules.
3496 # Changed in 1.57_63: seems like memory bloat now without
3497 # any value, so commented out
3499 # $CPAN::META->instance('CPAN::Module',$mod);
3503 # instantiate a module object
3504 $id = $CPAN::META->instance('CPAN::Module',$mod);
3508 # Although CPAN prohibits same name with different version the
3509 # indexer may have changed the version for the same distro
3510 # since the last time ("Force Reindexing" feature)
3511 if ($id->cpan_file ne $dist
3513 $id->cpan_version ne $version
3515 $userid = $id->userid || $self->userid($dist);
3517 'CPAN_USERID' => $userid,
3518 'CPAN_VERSION' => $version,
3519 'CPAN_FILE' => $dist,
3523 # instantiate a distribution object
3524 if ($CPAN::META->exists('CPAN::Distribution',$dist)) {
3525 # we do not need CONTAINSMODS unless we do something with
3526 # this dist, so we better produce it on demand.
3528 ## my $obj = $CPAN::META->instance(
3529 ## 'CPAN::Distribution' => $dist
3531 ## $obj->{CONTAINSMODS}{$mod} = undef; # experimental
3533 $CPAN::META->instance(
3534 'CPAN::Distribution' => $dist
3536 'CPAN_USERID' => $userid,
3537 'CPAN_COMMENT' => $comment,
3541 for my $name ($mod,$dist) {
3542 CPAN->debug("exists name[$name]") if $CPAN::DEBUG;
3543 $exists{$name} = undef;
3546 return if $CPAN::Signal;
3550 for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
3551 for my $o ($CPAN::META->all_objects($class)) {
3552 next if exists $exists{$o->{ID}};
3553 $CPAN::META->delete($class,$o->{ID});
3554 CPAN->debug("deleting ID[$o->{ID}] in class[$class]")
3561 #-> sub CPAN::Index::rd_modlist ;
3563 my($cl,$index_target) = @_;
3564 return unless defined $index_target;
3565 $CPAN::Frontend->myprint("Going to read $index_target\n");
3566 my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
3570 while ($_ = $fh->READLINE) {
3572 my @ls = map {"$_\n"} split /\n/, $_;
3573 unshift @ls, "\n" x length($1) if /^(\n+)/;
3577 my $shift = shift(@eval);
3578 if ($shift =~ /^Date:\s+(.*)/){
3579 return if $DATE_OF_03 eq $1;
3582 last if $shift =~ /^\s*$/;
3585 push @eval, q{CPAN::Modulelist->data;};
3587 my($comp) = Safe->new("CPAN::Safe1");
3588 my($eval) = join("", @eval);
3589 my $ret = $comp->reval($eval);
3590 Carp::confess($@) if $@;
3591 return if $CPAN::Signal;
3593 my $obj = $CPAN::META->instance("CPAN::Module",$_);
3594 delete $ret->{$_}{modid}; # not needed here, maybe elsewhere
3595 $obj->set(%{$ret->{$_}});
3596 return if $CPAN::Signal;
3600 #-> sub CPAN::Index::write_metadata_cache ;
3601 sub write_metadata_cache {
3603 return unless $CPAN::Config->{'cache_metadata'};
3604 return unless $CPAN::META->has_usable("Storable");
3606 foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module
3607 CPAN::Distribution)) {
3608 $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
3610 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3611 $cache->{last_time} = $LAST_TIME;
3612 $cache->{DATE_OF_02} = $DATE_OF_02;
3613 $cache->{PROTOCOL} = PROTOCOL;
3614 $CPAN::Frontend->myprint("Going to write $metadata_file\n");
3615 eval { Storable::nstore($cache, $metadata_file) };
3616 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3619 #-> sub CPAN::Index::read_metadata_cache ;
3620 sub read_metadata_cache {
3622 return unless $CPAN::Config->{'cache_metadata'};
3623 return unless $CPAN::META->has_usable("Storable");
3624 my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
3625 return unless -r $metadata_file and -f $metadata_file;
3626 $CPAN::Frontend->myprint("Going to read $metadata_file\n");
3628 eval { $cache = Storable::retrieve($metadata_file) };
3629 $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
3630 if (!$cache || ref $cache ne 'HASH'){
3634 if (exists $cache->{PROTOCOL}) {
3635 if (PROTOCOL > $cache->{PROTOCOL}) {
3636 $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ".
3637 "with protocol v%s, requiring v%s\n",
3644 $CPAN::Frontend->mywarn("Ignoring Metadata cache written ".
3645 "with protocol v1.0\n");
3650 while(my($class,$v) = each %$cache) {
3651 next unless $class =~ /^CPAN::/;
3652 $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok
3653 while (my($id,$ro) = each %$v) {
3654 $CPAN::META->{readwrite}{$class}{$id} ||=
3655 $class->new(ID=>$id, RO=>$ro);
3660 unless ($clcnt) { # sanity check
3661 $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n");
3664 if ($idcnt < 1000) {
3665 $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ".
3666 "in $metadata_file\n");
3669 $CPAN::META->{PROTOCOL} ||=
3670 $cache->{PROTOCOL}; # reading does not up or downgrade, but it
3671 # does initialize to some protocol
3672 $LAST_TIME = $cache->{last_time};
3673 $DATE_OF_02 = $cache->{DATE_OF_02};
3674 $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n")
3675 if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
3679 package CPAN::InfoObj;
3684 exists $self->{RO} and return $self->{RO};
3689 my $ro = $self->ro or return;
3690 return $ro->{CPAN_USERID};
3693 sub id { shift->{ID}; }
3695 #-> sub CPAN::InfoObj::new ;
3697 my $this = bless {}, shift;
3702 # The set method may only be used by code that reads index data or
3703 # otherwise "objective" data from the outside world. All session
3704 # related material may do anything else with instance variables but
3705 # must not touch the hash under the RO attribute. The reason is that
3706 # the RO hash gets written to Metadata file and is thus persistent.
3708 #-> sub CPAN::InfoObj::set ;
3710 my($self,%att) = @_;
3711 my $class = ref $self;
3713 # This must be ||=, not ||, because only if we write an empty
3714 # reference, only then the set method will write into the readonly
3715 # area. But for Distributions that spring into existence, maybe
3716 # because of a typo, we do not like it that they are written into
3717 # the readonly area and made permanent (at least for a while) and
3718 # that is why we do not "allow" other places to call ->set.
3719 unless ($self->id) {
3720 CPAN->debug("Bug? Empty ID, rejecting");
3723 my $ro = $self->{RO} =
3724 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
3726 while (my($k,$v) = each %att) {
3731 #-> sub CPAN::InfoObj::as_glimpse ;
3735 my $class = ref($self);
3736 $class =~ s/^CPAN:://;
3737 push @m, sprintf "%-15s %s\n", $class, $self->{ID};
3741 #-> sub CPAN::InfoObj::as_string ;
3745 my $class = ref($self);
3746 $class =~ s/^CPAN:://;
3747 push @m, $class, " id = $self->{ID}\n";
3749 for (sort keys %$ro) {
3750 # next if m/^(ID|RO)$/;
3752 if ($_ eq "CPAN_USERID") {
3753 $extra .= " (".$self->author;
3754 my $email; # old perls!
3755 if ($email = $CPAN::META->instance("CPAN::Author",
3758 $extra .= " <$email>";
3760 $extra .= " <no email>";
3763 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
3764 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
3767 next unless defined $ro->{$_};
3768 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
3770 for (sort keys %$self) {
3771 next if m/^(ID|RO)$/;
3772 if (ref($self->{$_}) eq "ARRAY") {
3773 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
3774 } elsif (ref($self->{$_}) eq "HASH") {
3778 join(" ",keys %{$self->{$_}}),
3781 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
3787 #-> sub CPAN::InfoObj::author ;
3790 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
3793 #-> sub CPAN::InfoObj::dump ;
3796 require Data::Dumper;
3797 print Data::Dumper::Dumper($self);
3800 package CPAN::Author;
3803 #-> sub CPAN::Author::force
3809 #-> sub CPAN::Author::force
3812 delete $self->{force};
3815 #-> sub CPAN::Author::id
3818 my $id = $self->{ID};
3819 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
3823 #-> sub CPAN::Author::as_glimpse ;
3827 my $class = ref($self);
3828 $class =~ s/^CPAN:://;
3829 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
3837 #-> sub CPAN::Author::fullname ;
3839 shift->ro->{FULLNAME};
3843 #-> sub CPAN::Author::email ;
3844 sub email { shift->ro->{EMAIL}; }
3846 #-> sub CPAN::Author::ls ;
3849 my $glob = shift || "";
3850 my $silent = shift || 0;
3853 # adapted from CPAN::Distribution::verifyCHECKSUM ;
3854 my(@csf); # chksumfile
3855 @csf = $self->id =~ /(.)(.)(.*)/;
3856 $csf[1] = join "", @csf[0,1];
3857 $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
3859 @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
3860 unless (grep {$_->[2] eq $csf[1]} @dl) {
3861 $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
3864 @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
3865 unless (grep {$_->[2] eq $csf[2]} @dl) {
3866 $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
3869 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
3871 my $rglob = Text::Glob::glob_to_regex($glob);
3872 @dl = grep { $_->[2] =~ /$rglob/ } @dl;
3874 $CPAN::Frontend->myprint(join "", map {
3875 sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
3876 } sort { $a->[2] cmp $b->[2] } @dl);
3880 # returns an array of arrays, the latter contain (size,mtime,filename)
3881 #-> sub CPAN::Author::dir_listing ;
3884 my $chksumfile = shift;
3885 my $recursive = shift;
3886 my $may_ftp = shift;
3888 File::Spec->catfile($CPAN::Config->{keep_source_where},
3889 "authors", "id", @$chksumfile);
3893 # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
3894 # hazard. (Without GPG installed they are not that much better,
3896 $fh = FileHandle->new;
3897 if (open($fh, $lc_want)) {
3898 my $line = <$fh>; close $fh;
3899 unlink($lc_want) unless $line =~ /PGP/;
3903 # connect "force" argument with "index_expire".
3904 my $force = $self->{force};
3905 if (my @stat = stat $lc_want) {
3906 $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
3910 $lc_file = CPAN::FTP->localize(
3911 "authors/id/@$chksumfile",
3916 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
3917 $chksumfile->[-1] .= ".gz";
3918 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
3921 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
3922 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
3928 $lc_file = $lc_want;
3929 # we *could* second-guess and if the user has a file: URL,
3930 # then we could look there. But on the other hand, if they do
3931 # have a file: URL, wy did they choose to set
3932 # $CPAN::Config->{show_upload_date} to false?
3935 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
3936 $fh = FileHandle->new;
3938 if (open $fh, $lc_file){
3941 $eval =~ s/\015?\012/\n/g;
3943 my($comp) = Safe->new();
3944 $cksum = $comp->reval($eval);
3946 rename $lc_file, "$lc_file.bad";
3947 Carp::confess($@) if $@;
3949 } elsif ($may_ftp) {
3950 Carp::carp "Could not open $lc_file for reading.";
3952 # Maybe should warn: "You may want to set show_upload_date to a true value"
3956 for $f (sort keys %$cksum) {
3957 if (exists $cksum->{$f}{isdir}) {
3959 my(@dir) = @$chksumfile;
3961 push @dir, $f, "CHECKSUMS";
3963 [$_->[0], $_->[1], "$f/$_->[2]"]
3964 } $self->dir_listing(\@dir,1,$may_ftp);
3966 push @result, [ 0, "-", $f ];
3970 ($cksum->{$f}{"size"}||0),
3971 $cksum->{$f}{"mtime"}||"---",
3979 package CPAN::Distribution;
3985 my $ro = $self->ro or return;
3989 # CPAN::Distribution::undelay
3992 delete $self->{later};
3995 # add the A/AN/ stuff
3996 # CPAN::Distribution::normalize
3999 $s = $self->id unless defined $s;
4003 $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
4005 return $s if $s =~ m:^N/A|^Contact Author: ;
4006 $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
4007 $CPAN::Frontend->mywarn("Strange distribution name [$s]\n");
4008 CPAN->debug("s[$s]") if $CPAN::DEBUG;
4016 return $id unless $id =~ m|^./../|;
4020 # mark as dirty/clean
4021 #-> sub CPAN::Distribution::color_cmd_tmps ;
4022 sub color_cmd_tmps {
4024 my($depth) = shift || 0;
4025 my($color) = shift || 0;
4026 my($ancestors) = shift || [];
4027 # a distribution needs to recurse into its prereq_pms
4029 return if exists $self->{incommandcolor}
4030 && $self->{incommandcolor}==$color;
4032 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
4034 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
4035 my $prereq_pm = $self->prereq_pm;
4036 if (defined $prereq_pm) {
4037 for my $pre (keys %$prereq_pm) {
4038 my $premo = CPAN::Shell->expand("Module",$pre);
4039 $premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
4043 delete $self->{sponsored_mods};
4044 delete $self->{badtestcnt};
4046 $self->{incommandcolor} = $color;
4049 #-> sub CPAN::Distribution::as_string ;
4052 $self->containsmods;
4054 $self->SUPER::as_string(@_);
4057 #-> sub CPAN::Distribution::containsmods ;
4060 return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS};
4061 my $dist_id = $self->{ID};
4062 for my $mod ($CPAN::META->all_objects("CPAN::Module")) {
4063 my $mod_file = $mod->cpan_file or next;
4064 my $mod_id = $mod->{ID} or next;
4065 # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]";
4067 $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id;
4069 keys %{$self->{CONTAINSMODS}};
4072 #-> sub CPAN::Distribution::upload_date ;
4075 return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE};
4076 my(@local_wanted) = split(/\//,$self->id);
4077 my $filename = pop @local_wanted;
4078 push @local_wanted, "CHECKSUMS";
4079 my $author = CPAN::Shell->expand("Author",$self->cpan_userid);
4080 return unless $author;
4081 my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date});
4083 my($dirent) = grep { $_->[2] eq $filename } @dl;
4084 # warn sprintf "dirent[%s]id[%s]", $dirent, $self->id;
4085 return unless $dirent->[1];
4086 return $self->{UPLOAD_DATE} = $dirent->[1];
4089 #-> sub CPAN::Distribution::uptodate ;
4093 foreach $c ($self->containsmods) {
4094 my $obj = CPAN::Shell->expandany($c);
4095 return 0 unless $obj->uptodate;
4100 #-> sub CPAN::Distribution::called_for ;
4103 $self->{CALLED_FOR} = $id if defined $id;
4104 return $self->{CALLED_FOR};
4107 #-> sub CPAN::Distribution::safe_chdir ;
4109 my($self,$todir) = @_;
4110 # we die if we cannot chdir and we are debuggable
4111 Carp::confess("safe_chdir called without todir argument")
4112 unless defined $todir and length $todir;
4114 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4118 unless (-x $todir) {
4119 unless (chmod 0755, $todir) {
4120 my $cwd = CPAN::anycwd();
4121 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
4122 "permission to change the permission; cannot ".
4123 "chdir to '$todir'\n");
4124 $CPAN::Frontend->mysleep(5);
4125 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4126 qq{to todir[$todir]: $!});
4130 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
4133 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
4136 my $cwd = CPAN::anycwd();
4137 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
4138 qq{to todir[$todir] (a chmod has been issued): $!});
4143 #-> sub CPAN::Distribution::get ;
4148 exists $self->{'build_dir'} and push @e,
4149 "Is already unwrapped into directory $self->{'build_dir'}";
4150 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4152 my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible
4155 # Get the file on local disk
4160 File::Spec->catfile(
4161 $CPAN::Config->{keep_source_where},
4164 split(/\//,$self->id)
4167 $self->debug("Doing localize") if $CPAN::DEBUG;
4168 unless ($local_file =
4169 CPAN::FTP->localize("authors/id/$self->{ID}",
4172 if ($CPAN::Index::DATE_OF_02) {
4173 $note = "Note: Current database in memory was generated ".
4174 "on $CPAN::Index::DATE_OF_02\n";
4176 $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
4178 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4179 $self->{localfile} = $local_file;
4180 return if $CPAN::Signal;
4185 if ($CPAN::META->has_inst("Digest::SHA")) {
4186 $self->debug("Digest::SHA is installed, verifying");
4187 $self->verifyCHECKSUM;
4189 $self->debug("Digest::SHA is NOT installed");
4191 return if $CPAN::Signal;
4194 # Create a clean room and go there
4196 $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok
4197 my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok
4198 $self->safe_chdir($builddir);
4199 $self->debug("Removing tmp") if $CPAN::DEBUG;
4200 File::Path::rmtree("tmp");
4201 unless (mkdir "tmp", 0755) {
4202 $CPAN::Frontend->unrecoverable_error(<<EOF);
4203 Couldn't mkdir '$builddir/tmp': $!
4205 Cannot continue: Please find the reason why I cannot make the
4208 and fix the problem, then retry.
4213 $self->safe_chdir($sub_wd);
4216 $self->safe_chdir("tmp");
4221 $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
4222 my $ct = CPAN::Tarzip->new($local_file);
4223 if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i){
4224 $self->{was_uncompressed}++ unless $ct->gtest();
4225 $self->untar_me($ct);
4226 } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) {
4227 $self->unzip_me($ct);
4228 } elsif ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/) {
4229 $self->{was_uncompressed}++ unless $ct->gtest();
4230 $self->debug("calling pm2dir for local_file[$local_file]") if $CPAN::DEBUG;
4231 $self->pm2dir_me($local_file);
4233 $self->{archived} = "NO";
4234 $self->safe_chdir($sub_wd);
4238 # we are still in the tmp directory!
4239 # Let's check if the package has its own directory.
4240 my $dh = DirHandle->new(File::Spec->curdir)
4241 or Carp::croak("Couldn't opendir .: $!");
4242 my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC??
4244 my ($distdir,$packagedir);
4245 if (@readdir == 1 && -d $readdir[0]) {
4246 $distdir = $readdir[0];
4247 $packagedir = File::Spec->catdir($builddir,$distdir);
4248 $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]")
4250 -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ".
4252 File::Path::rmtree($packagedir);
4253 unless (File::Copy::move($distdir,$packagedir)) {
4254 $CPAN::Frontend->unrecoverable_error(<<EOF);
4255 Couldn't move '$distdir' to '$packagedir': $!
4257 Cannot continue: Please find the reason why I cannot move
4258 $builddir/tmp/$distdir
4261 and fix the problem, then retry
4265 $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]",
4272 my $userid = $self->cpan_userid;
4274 CPAN->debug("no userid? self[$self]");
4277 my $pragmatic_dir = $userid . '000';
4278 $pragmatic_dir =~ s/\W_//g;
4279 $pragmatic_dir++ while -d "../$pragmatic_dir";
4280 $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
4281 $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
4282 File::Path::mkpath($packagedir);
4284 for $f (@readdir) { # is already without "." and ".."
4285 my $to = File::Spec->catdir($packagedir,$f);
4286 File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!");
4290 $self->safe_chdir($sub_wd);
4294 $self->{'build_dir'} = $packagedir;
4295 $self->safe_chdir($builddir);
4296 File::Path::rmtree("tmp");
4298 $self->safe_chdir($packagedir);
4299 if ($CPAN::META->has_inst("Module::Signature")) {
4300 if (-f "SIGNATURE") {
4301 $self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
4302 my $rv = Module::Signature::verify();
4303 if ($rv != Module::Signature::SIGNATURE_OK() and
4304 $rv != Module::Signature::SIGNATURE_MISSING()) {
4305 $CPAN::Frontend->myprint(
4306 qq{\nSignature invalid for }.
4307 qq{distribution file. }.
4308 qq{Please investigate.\n\n}.
4310 $CPAN::META->instance(
4317 sprintf(qq{I'd recommend removing %s. Its signature
4318 is invalid. Maybe you have configured your 'urllist' with
4319 a bad URL. Please check this array with 'o conf urllist', and
4320 retry. For more information, try opening a subshell with
4328 $self->{signature_verify} = CPAN::Distrostatus->new("NO");
4329 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap));
4330 $CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep");
4332 $self->{signature_verify} = CPAN::Distrostatus->new("YES");
4335 $CPAN::Frontend->myprint(qq{Package came without SIGNATURE\n\n});
4338 $self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
4340 $self->safe_chdir($builddir);
4341 return if $CPAN::Signal;
4344 my($mpl) = File::Spec->catfile($packagedir,"Makefile.PL");
4345 my($mpl_exists) = -f $mpl;
4346 unless ($mpl_exists) {
4347 # NFS has been reported to have racing problems after the
4348 # renaming of a directory in some environments.
4351 my $mpldh = DirHandle->new($packagedir)
4352 or Carp::croak("Couldn't opendir $packagedir: $!");
4353 $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
4356 my $prefer_installer = "eumm"; # eumm|mb
4357 if (-f File::Spec->catfile($packagedir,"Build.PL")) {
4358 if ($mpl_exists) { # they *can* choose
4359 if ($CPAN::META->has_inst("Module::Build")) {
4360 $prefer_installer = $CPAN::Config->{prefer_installer};
4363 $prefer_installer = "mb";
4366 if (lc($prefer_installer) eq "mb") {
4367 $self->{modulebuild} = 1;
4368 } elsif (! $mpl_exists) {
4369 $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
4373 my($configure) = File::Spec->catfile($packagedir,"Configure");
4374 if (-f $configure) {
4375 # do we have anything to do?
4376 $self->{'configure'} = $configure;
4377 } elsif (-f File::Spec->catfile($packagedir,"Makefile")) {
4378 $CPAN::Frontend->myprint(qq{
4379 Package comes with a Makefile and without a Makefile.PL.
4380 We\'ll try to build it with that Makefile then.
4382 $self->{writemakefile} = "YES";
4385 my $cf = $self->called_for || "unknown";
4390 $cf =~ s|[/\\:]||g; # risk of filesystem damage
4391 $cf = "unknown" unless length($cf);
4392 $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL.
4393 (The test -f "$mpl" returned false.)
4394 Writing one on our own (setting NAME to $cf)\a\n});
4395 $self->{had_no_makefile_pl}++;
4398 # Writing our own Makefile.PL
4400 my $fh = FileHandle->new;
4402 or Carp::croak("Could not open >$mpl: $!");
4404 qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
4405 # because there was no Makefile.PL supplied.
4406 # Autogenerated on: }.scalar localtime().qq{
4408 use ExtUtils::MakeMaker;
4409 WriteMakefile(NAME => q[$cf]);
4419 # CPAN::Distribution::untar_me ;
4422 $self->{archived} = "tar";
4424 $self->{unwrapped} = "YES";
4426 $self->{unwrapped} = "NO";
4430 # CPAN::Distribution::unzip_me ;
4433 $self->{archived} = "zip";
4435 $self->{unwrapped} = "YES";
4437 $self->{unwrapped} = "NO";
4443 my($self,$local_file) = @_;
4444 $self->{archived} = "pm";
4445 my $to = File::Basename::basename($local_file);
4446 if ($to =~ s/\.(gz|Z)(?!\n)\Z//) {
4447 if (CPAN::Tarzip->new($local_file)->gunzip($to)) {
4448 $self->{unwrapped} = "YES";
4450 $self->{unwrapped} = "NO";
4453 File::Copy::cp($local_file,".");
4454 $self->{unwrapped} = "YES";
4458 #-> sub CPAN::Distribution::new ;
4460 my($class,%att) = @_;
4462 # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
4464 my $this = { %att };
4465 return bless $this, $class;
4468 #-> sub CPAN::Distribution::look ;
4472 if ($^O eq 'MacOS') {
4473 $self->Mac::BuildTools::look;
4477 if ( $CPAN::Config->{'shell'} ) {
4478 $CPAN::Frontend->myprint(qq{
4479 Trying to open a subshell in the build directory...
4482 $CPAN::Frontend->myprint(qq{
4483 Your configuration does not define a value for subshells.
4484 Please define it with "o conf shell <your shell>"
4488 my $dist = $self->id;
4490 unless ($dir = $self->dir) {
4493 unless ($dir ||= $self->dir) {
4494 $CPAN::Frontend->mywarn(qq{
4495 Could not determine which directory to use for looking at $dist.
4499 my $pwd = CPAN::anycwd();
4500 $self->safe_chdir($dir);
4501 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4503 local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0;
4504 $ENV{CPAN_SHELL_LEVEL} += 1;
4505 unless (system($CPAN::Config->{'shell'}) == 0) {
4507 $CPAN::Frontend->mywarn("Subprocess shell exit code $code\n");
4510 $self->safe_chdir($pwd);
4513 # CPAN::Distribution::cvs_import ;
4517 my $dir = $self->dir;
4519 my $package = $self->called_for;
4520 my $module = $CPAN::META->instance('CPAN::Module', $package);
4521 my $version = $module->cpan_version;
4523 my $userid = $self->cpan_userid;
4525 my $cvs_dir = (split /\//, $dir)[-1];
4526 $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//;
4528 $CPAN::Config->{cvsroot} || $ENV{CVSROOT};
4530 $CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL};
4531 if ($cvs_site_perl) {
4532 $cvs_dir = "$cvs_site_perl/$cvs_dir";
4534 my $cvs_log = qq{"imported $package $version sources"};
4535 $version =~ s/\./_/g;
4536 my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log,
4537 "$cvs_dir", $userid, "v$version");
4539 my $pwd = CPAN::anycwd();
4540 chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
4542 $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
4544 $CPAN::Frontend->myprint(qq{@cmd\n});
4545 system(@cmd) == 0 or
4546 $CPAN::Frontend->mydie("cvs import failed");
4547 chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
4550 #-> sub CPAN::Distribution::readme ;
4553 my($dist) = $self->id;
4554 my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
4555 $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
4558 File::Spec->catfile(
4559 $CPAN::Config->{keep_source_where},
4562 split(/\//,"$sans.readme"),
4564 $self->debug("Doing localize") if $CPAN::DEBUG;
4565 $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
4567 or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
4569 if ($^O eq 'MacOS') {
4570 Mac::BuildTools::launch_file($local_file);
4574 my $fh_pager = FileHandle->new;
4575 local($SIG{PIPE}) = "IGNORE";
4576 $fh_pager->open("|$CPAN::Config->{'pager'}")
4577 or die "Could not open pager $CPAN::Config->{'pager'}: $!";
4578 my $fh_readme = FileHandle->new;
4579 $fh_readme->open($local_file)
4580 or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
4581 $CPAN::Frontend->myprint(qq{
4584 with pager "$CPAN::Config->{'pager'}"
4587 $fh_pager->print(<$fh_readme>);
4591 #-> sub CPAN::Distribution::verifyCHECKSUM ;
4592 sub verifyCHECKSUM {
4596 $self->{CHECKSUM_STATUS} ||= "";
4597 $self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok";
4598 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4600 my($lc_want,$lc_file,@local,$basename);
4601 @local = split(/\//,$self->id);
4603 push @local, "CHECKSUMS";
4605 File::Spec->catfile($CPAN::Config->{keep_source_where},
4606 "authors", "id", @local);
4611 $self->CHECKSUM_check_file($lc_want)
4613 return $self->{CHECKSUM_STATUS} = "OK";
4615 $lc_file = CPAN::FTP->localize("authors/id/@local",
4618 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
4619 $local[-1] .= ".gz";
4620 $lc_file = CPAN::FTP->localize("authors/id/@local",
4623 $lc_file =~ s/\.gz(?!\n)\Z//;
4624 CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file);
4629 $self->CHECKSUM_check_file($lc_file);
4632 sub SIG_check_file {
4633 my($self,$chk_file) = @_;
4634 my $rv = eval { Module::Signature::_verify($chk_file) };
4636 if ($rv == Module::Signature::SIGNATURE_OK()) {
4637 $CPAN::Frontend->myprint("Signature for $chk_file ok\n");
4638 return $self->{SIG_STATUS} = "OK";
4640 $CPAN::Frontend->myprint(qq{\nSignature invalid for }.
4641 qq{distribution file. }.
4642 qq{Please investigate.\n\n}.
4644 $CPAN::META->instance(
4649 my $wrap = qq{I\'d recommend removing $chk_file. Its signature
4650 is invalid. Maybe you have configured your 'urllist' with
4651 a bad URL. Please check this array with 'o conf urllist', and
4654 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4658 #-> sub CPAN::Distribution::CHECKSUM_check_file ;
4659 sub CHECKSUM_check_file {
4660 my($self,$chk_file) = @_;
4661 my($cksum,$file,$basename);
4663 if ($CPAN::META->has_inst("Module::Signature") and Module::Signature->VERSION >= 0.26) {
4664 $self->debug("Module::Signature is installed, verifying");
4665 $self->SIG_check_file($chk_file);
4667 $self->debug("Module::Signature is NOT installed");
4670 $file = $self->{localfile};
4671 $basename = File::Basename::basename($file);
4672 my $fh = FileHandle->new;
4673 if (open $fh, $chk_file){
4676 $eval =~ s/\015?\012/\n/g;
4678 my($comp) = Safe->new();
4679 $cksum = $comp->reval($eval);
4681 rename $chk_file, "$chk_file.bad";
4682 Carp::confess($@) if $@;
4685 Carp::carp "Could not open $chk_file for reading";
4688 if (exists $cksum->{$basename}{sha256}) {
4689 $self->debug("Found checksum for $basename:" .
4690 "$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG;
4694 my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256});
4696 $fh = CPAN::Tarzip->TIEHANDLE($file);
4699 my $dg = Digest::SHA->new(256);
4702 while ($fh->READ($ref, 4096) > 0){
4705 my $hexdigest = $dg->hexdigest;
4706 $eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'};
4710 $CPAN::Frontend->myprint("Checksum for $file ok\n");
4711 return $self->{CHECKSUM_STATUS} = "OK";
4713 $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }.
4714 qq{distribution file. }.
4715 qq{Please investigate.\n\n}.
4717 $CPAN::META->instance(
4722 my $wrap = qq{I\'d recommend removing $file. Its
4723 checksum is incorrect. Maybe you have configured your 'urllist' with
4724 a bad URL. Please check this array with 'o conf urllist', and
4727 $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
4729 # former versions just returned here but this seems a
4730 # serious threat that deserves a die
4732 # $CPAN::Frontend->myprint("\n\n");
4736 # close $fh if fileno($fh);
4738 $self->{CHECKSUM_STATUS} ||= "";
4739 if ($self->{CHECKSUM_STATUS} eq "NIL") {
4740 $CPAN::Frontend->mywarn(qq{
4741 Warning: No checksum for $basename in $chk_file.
4743 The cause for this may be that the file is very new and the checksum
4744 has not yet been calculated, but it may also be that something is
4745 going awry right now.
4747 my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes");
4748 $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.");
4750 $self->{CHECKSUM_STATUS} = "NIL";
4755 #-> sub CPAN::Distribution::eq_CHECKSUM ;
4757 my($self,$fh,$expect) = @_;
4758 my $dg = Digest::SHA->new(256);
4760 while (read($fh, $data, 4096)){
4763 my $hexdigest = $dg->hexdigest;
4764 # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]";
4765 $hexdigest eq $expect;
4768 #-> sub CPAN::Distribution::force ;
4770 # Both CPAN::Modules and CPAN::Distributions know if "force" is in
4771 # effect by autoinspection, not by inspecting a global variable. One
4772 # of the reason why this was chosen to work that way was the treatment
4773 # of dependencies. They should not automatically inherit the force
4774 # status. But this has the downside that ^C and die() will return to
4775 # the prompt but will not be able to reset the force_update
4776 # attributes. We try to correct for it currently in the read_metadata
4777 # routine, and immediately before we check for a Signal. I hope this
4778 # works out in one of v1.57_53ff
4781 my($self, $method) = @_;
4783 CHECKSUM_STATUS archived build_dir localfile make install unwrapped
4786 delete $self->{$att};
4788 if ($method && $method =~ /make|test|install/) {
4789 $self->{"force_update"}++; # name should probably have been force_install
4794 my($self, $method) = @_;
4795 # warn "XDEBUG: set notest for $self $method";
4796 $self->{"notest"}++; # name should probably have been force_install
4801 # warn "XDEBUG: deleting notest";
4802 delete $self->{'notest'};
4805 #-> sub CPAN::Distribution::unforce ;
4808 delete $self->{'force_update'};
4811 #-> sub CPAN::Distribution::isa_perl ;
4814 my $file = File::Basename::basename($self->id);
4815 if ($file =~ m{ ^ perl
4828 } elsif ($self->cpan_comment
4830 $self->cpan_comment =~ /isa_perl\(.+?\)/){
4836 #-> sub CPAN::Distribution::perl ;
4842 #-> sub CPAN::Distribution::make ;
4845 my $make = $self->{modulebuild} ? "Build" : "make";
4846 $CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id);
4847 # Emergency brake if they said install Pippi and get newest perl
4848 if ($self->isa_perl) {
4850 $self->called_for ne $self->id &&
4851 ! $self->{force_update}
4853 # if we die here, we break bundles
4854 $CPAN::Frontend->mywarn(sprintf qq{
4855 The most recent version "%s" of the module "%s"
4856 comes with the current version of perl (%s).
4857 I\'ll build that only if you ask for something like
4862 $CPAN::META->instance(
4876 !$self->{archived} || $self->{archived} eq "NO" and push @e,
4877 "Is neither a tar nor a zip archive.";
4879 !$self->{unwrapped} || $self->{unwrapped} eq "NO" and push @e,
4880 "Had problems unarchiving. Please build manually";
4882 unless ($self->{force_update}) {
4883 exists $self->{signature_verify} and $self->{signature_verify}->failed
4884 and push @e, "Did not pass the signature test.";
4887 exists $self->{writemakefile} &&
4888 $self->{writemakefile} =~ m/ ^ NO\s* ( .* ) /sx and push @e,
4889 $1 || "Had some problem writing Makefile";
4891 defined $self->{'make'} and push @e,
4892 "Has already been processed within this session";
4894 if (exists $self->{later} and length($self->{later})) {
4895 if ($self->unsat_prereq) {
4896 push @e, $self->{later};
4898 delete $self->{later};
4902 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
4904 $CPAN::Frontend->myprint("\n CPAN.pm: Going to build ".$self->id."\n\n");
4905 my $builddir = $self->dir or
4906 $CPAN::Frontend->mydie("PANIC: Cannot determine build directory");
4907 chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
4908 $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
4910 if ($^O eq 'MacOS') {
4911 Mac::BuildTools::make($self);
4916 if ($self->{'configure'}) {
4917 $system = $self->{'configure'};
4918 } elsif ($self->{modulebuild}) {
4919 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
4920 $system = "$perl Build.PL $CPAN::Config->{mbuildpl_arg}";
4922 my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
4924 # This needs a handler that can be turned on or off:
4925 # $switch = "-MExtUtils::MakeMaker ".
4926 # "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
4928 $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
4930 unless (exists $self->{writemakefile}) {
4931 local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
4934 if ($CPAN::Config->{inactivity_timeout}) {
4936 alarm $CPAN::Config->{inactivity_timeout};
4937 local $SIG{CHLD}; # = sub { wait };
4938 if (defined($pid = fork)) {
4943 # note, this exec isn't necessary if
4944 # inactivity_timeout is 0. On the Mac I'd
4945 # suggest, we set it always to 0.
4949 $CPAN::Frontend->myprint("Cannot fork: $!");
4957 $CPAN::Frontend->myprint($@);
4958 $self->{writemakefile} = "NO $@";
4963 $ret = system($system);
4965 $self->{writemakefile} = "NO '$system' returned status $ret";
4969 if (-f "Makefile" || -f "Build") {
4970 $self->{writemakefile} = "YES";
4971 delete $self->{make_clean}; # if cleaned before, enable next
4973 $self->{writemakefile} =
4974 qq{NO -- Unknown reason.};
4975 # It's probably worth it to record the reason, so let's retry
4977 # my $fh = IO::File->new("$system |"); # STDERR? STDIN?
4978 # $self->{writemakefile} .= <$fh>;
4982 delete $self->{force_update};
4985 if (my @prereq = $self->unsat_prereq){
4986 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
4988 if ($self->{modulebuild}) {
4989 $system = "./Build $CPAN::Config->{mbuild_arg}";
4991 $system = join " ", _make_command(), $CPAN::Config->{make_arg};
4993 if (system($system) == 0) {
4994 $CPAN::Frontend->myprint(" $system -- OK\n");
4995 $self->{'make'} = CPAN::Distrostatus->new("YES");
4997 $self->{writemakefile} ||= "YES";
4998 $self->{'make'} = CPAN::Distrostatus->new("NO");
4999 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5004 return $CPAN::Config->{'make'} || $Config::Config{make} || 'make';
5007 #-> sub CPAN::Distribution::follow_prereqs ;
5008 sub follow_prereqs {
5010 my(@prereq) = grep {$_ ne "perl"} @_;
5011 return unless @prereq;
5013 $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ".
5014 "during [$id] -----\n");
5016 for my $p (@prereq) {
5017 $CPAN::Frontend->myprint(" $p\n");
5020 if ($CPAN::Config->{prerequisites_policy} eq "follow") {
5022 } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
5023 require ExtUtils::MakeMaker;
5024 my $answer = ExtUtils::MakeMaker::prompt(
5025 "Shall I follow them and prepend them to the queue
5026 of modules we are processing right now?", "yes");
5027 $follow = $answer =~ /^\s*y/i;
5031 myprint(" Ignoring dependencies on modules @prereq\n");
5034 # color them as dirty
5035 for my $p (@prereq) {
5036 # warn "calling color_cmd_tmps(0,1)";
5037 CPAN::Shell->expandany($p)->color_cmd_tmps(0,1);
5039 CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself
5040 $self->{later} = "Delayed until after prerequisites";
5041 return 1; # signal success to the queuerunner
5045 #-> sub CPAN::Distribution::unsat_prereq ;
5048 my $prereq_pm = $self->prereq_pm or return;
5050 NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
5051 my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
5052 # we were too demanding:
5053 next if $nmo->uptodate;
5055 # if they have not specified a version, we accept any installed one
5056 if (not defined $need_version or
5057 $need_version eq "0" or
5058 $need_version eq "undef") {
5059 next if defined $nmo->inst_file;
5062 # We only want to install prereqs if either they're not installed
5063 # or if the installed version is too old. We cannot omit this
5064 # check, because if 'force' is in effect, nobody else will check.
5065 if (defined $nmo->inst_file) {
5066 my(@all_requirements) = split /\s*,\s*/, $need_version;
5069 RQ: for my $rq (@all_requirements) {
5070 if ($rq =~ s|>=\s*||) {
5071 } elsif ($rq =~ s|>\s*||) {
5073 if (CPAN::Version->vgt($nmo->inst_version,$rq)){
5077 } elsif ($rq =~ s|!=\s*||) {
5079 if (CPAN::Version->vcmp($nmo->inst_version,$rq)){
5085 } elsif ($rq =~ m|<=?\s*|) {
5087 $CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])");
5091 if (! CPAN::Version->vgt($rq, $nmo->inst_version)){
5094 CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]rq[%s]ok[%d]",
5098 CPAN::Version->readable($rq),
5102 next NEED if $ok == @all_requirements;
5105 if ($self->{sponsored_mods}{$need_module}++){
5106 # We have already sponsored it and for some reason it's still
5107 # not available. So we do nothing. Or what should we do?
5108 # if we push it again, we have a potential infinite loop
5111 push @need, $need_module;
5116 #-> sub CPAN::Distribution::read_yaml ;
5119 return $self->{yaml_content} if exists $self->{yaml_content};
5120 my $build_dir = $self->{build_dir};
5121 my $yaml = File::Spec->catfile($build_dir,"META.yml");
5122 return unless -f $yaml;
5123 if ($CPAN::META->has_inst("YAML")) {
5124 eval { $self->{yaml_content} = YAML::LoadFile($yaml); };
5126 $CPAN::Frontend->mywarn("Error while parsing META.yml: $@");
5130 return $self->{yaml_content};
5133 #-> sub CPAN::Distribution::prereq_pm ;
5136 return $self->{prereq_pm} if
5137 exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected};
5138 return unless $self->{writemakefile} # no need to have succeeded
5139 # but we must have run it
5140 || $self->{modulebuild};
5142 if (my $yaml = $self->read_yaml) {
5143 $req = $yaml->{requires};
5144 undef $req unless ref $req eq "HASH" && %$req;
5146 if ($yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
5147 my $eummv = do { local $^W = 0; $1+0; };
5148 if ($eummv < 6.2501) {
5149 # thanks to Slaven for digging that out: MM before
5150 # that could be wrong because it could reflect a
5157 while (my($k,$v) = each %{$req||{}}) {
5160 } elsif ($k =~ /[A-Za-z]/ &&
5162 $CPAN::META->exists("Module",$v)
5164 $CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ".
5165 "requires hash: $k => $v; I'll take both ".
5166 "key and value as a module name\n");
5173 $req = $areq if $do_replace;
5175 if ($yaml->{build_requires}
5176 && ref $yaml->{build_requires}
5177 && ref $yaml->{build_requires} eq "HASH") {
5178 while (my($k,$v) = each %{$yaml->{build_requires}}) {
5180 # merging of two "requires"-type values--what should we do?
5187 delete $req->{perl};
5191 my $build_dir = $self->{build_dir} or die "Panic: no build_dir?";
5192 my $makefile = File::Spec->catfile($build_dir,"Makefile");
5196 $fh = FileHandle->new("<$makefile\0")) {
5199 last if /MakeMaker post_initialize section/;
5201 \s+PREREQ_PM\s+=>\s+(.+)
5204 # warn "Found prereq expr[$p]";
5206 # Regexp modified by A.Speer to remember actual version of file
5207 # PREREQ_PM hash key wants, then add to
5208 while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){
5209 # In case a prereq is mentioned twice, complain.
5210 if ( defined $req->{$1} ) {
5211 warn "Warning: PREREQ_PM mentions $1 more than once, ".
5212 "last mention wins";
5218 } elsif (-f "Build") {
5219 if ($CPAN::META->has_inst("Module::Build")) {
5220 $req = Module::Build->current->requires();
5224 if (-f "Build.PL" && ! -f "Makefile.PL" && ! exists $req->{"Module::Build"}) {
5225 $CPAN::Frontend->mywarn(" Warning: CPAN.pm discovered Module::Build as ".
5226 "undeclared prerequisite.\n".
5227 " Adding it now as a prerequisite.\n"
5229 $CPAN::Frontend->mysleep(5);
5230 $req->{"Module::Build"} = 0;
5231 delete $self->{writemakefile};
5233 $self->{prereq_pm_detected}++;
5234 return $self->{prereq_pm} = $req;
5237 #-> sub CPAN::Distribution::test ;
5242 delete $self->{force_update};
5245 # warn "XDEBUG: checking for notest: $self->{notest} $self";
5246 if ($self->{notest}) {
5247 $CPAN::Frontend->myprint("Skipping test because of notest pragma\n");
5251 my $make = $self->{modulebuild} ? "Build" : "make";
5252 $CPAN::Frontend->myprint("Running $make test\n");
5253 if (my @prereq = $self->unsat_prereq){
5254 return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
5258 exists $self->{make} or exists $self->{later} or push @e,
5259 "Make had some problems, maybe interrupted? Won't test";
5261 exists $self->{'make'} and
5262 $self->{'make'}->failed and
5263 push @e, "Can't test without successful make";
5265 exists $self->{build_dir} or push @e, "Has no own directory";
5266 $self->{badtestcnt} ||= 0;
5267 $self->{badtestcnt} > 0 and
5268 push @e, "Won't repeat unsuccessful test during this command";
5270 exists $self->{later} and length($self->{later}) and
5271 push @e, $self->{later};
5273 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5275 chdir $self->{'build_dir'} or
5276 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5277 $self->debug("Changed directory to $self->{'build_dir'}")
5280 if ($^O eq 'MacOS') {
5281 Mac::BuildTools::make_test($self);
5285 local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
5287 : ($ENV{PERLLIB} || "");
5289 $CPAN::META->set_perl5lib;
5291 if ($self->{modulebuild}) {
5292 $system = "./Build test";
5294 $system = join " ", _make_command(), "test";
5296 if (system($system) == 0) {
5297 $CPAN::Frontend->myprint(" $system -- OK\n");
5298 $CPAN::META->is_tested($self->{'build_dir'});
5299 $self->{make_test} = CPAN::Distrostatus->new("YES");
5301 $self->{make_test} = CPAN::Distrostatus->new("NO");
5302 $self->{badtestcnt}++;
5303 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5307 #-> sub CPAN::Distribution::clean ;
5310 my $make = $self->{modulebuild} ? "Build" : "make";
5311 $CPAN::Frontend->myprint("Running $make clean\n");
5312 unless (exists $self->{build_dir}) {
5313 $CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n");
5318 exists $self->{make_clean} and $self->{make_clean} eq "YES" and
5319 push @e, "make clean already called once";
5320 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5322 chdir $self->{'build_dir'} or
5323 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5324 $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
5326 if ($^O eq 'MacOS') {
5327 Mac::BuildTools::make_clean($self);
5332 if ($self->{modulebuild}) {
5333 $system = "./Build clean";
5335 $system = join " ", _make_command(), "clean";
5337 if (system($system) == 0) {
5338 $CPAN::Frontend->myprint(" $system -- OK\n");
5342 # Jost Krieger pointed out that this "force" was wrong because
5343 # it has the effect that the next "install" on this distribution
5344 # will untar everything again. Instead we should bring the
5345 # object's state back to where it is after untarring.
5356 $self->{make_clean} = "YES";
5359 # Hmmm, what to do if make clean failed?
5361 $CPAN::Frontend->myprint(qq{ $system -- NOT OK
5363 make clean did not succeed, marking directory as unusable for further work.
5365 $self->force("make"); # so that this directory won't be used again
5370 #-> sub CPAN::Distribution::install ;
5375 delete $self->{force_update};
5378 my $make = $self->{modulebuild} ? "Build" : "make";
5379 $CPAN::Frontend->myprint("Running $make install\n");
5382 exists $self->{build_dir} or push @e, "Has no own directory";
5384 exists $self->{make} or exists $self->{later} or push @e,
5385 "Make had some problems, maybe interrupted? Won't install";
5387 exists $self->{'make'} and
5388 $self->{'make'}->failed and
5389 push @e, "make had returned bad status, install seems impossible";
5391 if (exists $self->{make_test} and
5392 $self->{make_test}->failed){
5393 if ($self->{force_update}) {
5394 $self->{make_test}->text("FAILED but failure ignored because ".
5395 "'force' in effect");
5397 push @e, "make test had returned bad status, ".
5398 "won't install without force"
5401 exists $self->{'install'} and push @e,
5402 $self->{'install'}->text eq "YES" ?
5403 "Already done" : "Already tried without success";
5405 exists $self->{later} and length($self->{later}) and
5406 push @e, $self->{later};
5408 $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e;
5410 chdir $self->{'build_dir'} or
5411 Carp::croak("Couldn't chdir to $self->{'build_dir'}");
5412 $self->debug("Changed directory to $self->{'build_dir'}")
5415 if ($^O eq 'MacOS') {
5416 Mac::BuildTools::make_install($self);
5421 if ($self->{modulebuild}) {
5422 my($mbuild_install_build_command) = $CPAN::Config->{'mbuild_install_build_command'} ||
5425 $mbuild_install_build_command,
5427 $CPAN::Config->{mbuild_install_arg},
5430 my($make_install_make_command) = $CPAN::Config->{'make_install_make_command'} ||
5433 $make_install_make_command,
5435 $CPAN::Config->{make_install_arg},
5439 my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
5440 my($pipe) = FileHandle->new("$system $stderr |");
5443 $CPAN::Frontend->myprint($_);
5448 $CPAN::Frontend->myprint(" $system -- OK\n");
5449 $CPAN::META->is_installed($self->{'build_dir'});
5450 return $self->{'install'} = CPAN::Distrostatus->new("YES");
5452 $self->{'install'} = CPAN::Distrostatus->new("NO");
5453 $CPAN::Frontend->myprint(" $system -- NOT OK\n");
5455 $makeout =~ /permission/s
5458 ! $CPAN::Config->{make_install_make_command}
5459 || $CPAN::Config->{make_install_make_command} eq $CPAN::Config->{make}
5462 $CPAN::Frontend->myprint(
5464 qq{ You may have to su }.
5465 qq{to root to install the package\n}.
5466 qq{ (Or you may want to run something like\n}.
5467 qq{ o conf make_install_make_command 'sudo make'\n}.
5468 qq{ to raise your permissions.}
5472 delete $self->{force_update};
5475 #-> sub CPAN::Distribution::dir ;
5477 shift->{'build_dir'};
5480 #-> sub CPAN::Distribution::perldoc ;
5484 my($dist) = $self->id;
5485 my $package = $self->called_for;
5487 $self->_display_url( $CPAN::Defaultdocs . $package );
5490 #-> sub CPAN::Distribution::_check_binary ;
5492 my ($dist,$shell,$binary) = @_;
5493 my ($pid,$readme,$out);
5495 $CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n})
5498 $pid = open $readme, "which $binary|"
5499 or $CPAN::Frontend->mydie(qq{Could not fork 'which $binary': $!});
5503 close $readme or die "Could not run 'which $binary': $!";
5505 $CPAN::Frontend->myprint(qq{ + $out \n})
5506 if $CPAN::DEBUG && $out;
5511 #-> sub CPAN::Distribution::_display_url ;
5513 my($self,$url) = @_;
5514 my($res,$saved_file,$pid,$readme,$out);
5516 $CPAN::Frontend->myprint(qq{ + _display_url($url)\n})
5519 # should we define it in the config instead?
5520 my $html_converter = "html2text";
5522 my $web_browser = $CPAN::Config->{'lynx'} || undef;
5523 my $web_browser_out = $web_browser
5524 ? CPAN::Distribution->_check_binary($self,$web_browser)
5527 my ($tmpout,$tmperr);
5528 if (not $web_browser_out) {
5529 # web browser not found, let's try text only
5530 my $html_converter_out =
5531 CPAN::Distribution->_check_binary($self,$html_converter);
5533 if ($html_converter_out ) {
5534 # html2text found, run it
5535 $saved_file = CPAN::Distribution->_getsave_url( $self, $url );
5536 $CPAN::Frontend->myprint(qq{ERROR: problems while getting $url, $!\n})
5537 unless defined($saved_file);
5539 $pid = open $readme, "$html_converter $saved_file |"
5540 or $CPAN::Frontend->mydie(qq{
5541 Could not fork '$html_converter $saved_file': $!});
5542 my $fh = File::Temp->new(
5543 template => 'cpan_htmlconvert_XXXX',
5551 or $CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!});
5552 my $tmpin = $fh->filename;
5553 $CPAN::Frontend->myprint(sprintf(qq{
5555 saved output to %s\n},
5560 close $fh; undef $fh;
5562 or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!});
5563 my $fh_pager = FileHandle->new;
5564 local($SIG{PIPE}) = "IGNORE";
5565 $fh_pager->open("|$CPAN::Config->{'pager'}")
5566 or $CPAN::Frontend->mydie(qq{
5567 Could not open pager $CPAN::Config->{'pager'}: $!});
5568 $CPAN::Frontend->myprint(qq{
5571 with pager "$CPAN::Config->{'pager'}"
5574 $fh_pager->print(<$fh>);
5577 # coldn't find the web browser or html converter
5578 $CPAN::Frontend->myprint(qq{
5579 You need to install lynx or $html_converter to use this feature.});
5582 # web browser found, run the action
5583 my $browser = $CPAN::Config->{'lynx'};
5584 $CPAN::Frontend->myprint(qq{system[$browser $url]})
5586 $CPAN::Frontend->myprint(qq{
5589 with browser $browser
5592 system("$browser $url");
5593 if ($saved_file) { 1 while unlink($saved_file) }
5597 #-> sub CPAN::Distribution::_getsave_url ;
5599 my($dist, $shell, $url) = @_;
5601 $CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n})
5604 my $fh = File::Temp->new(
5605 template => "cpan_getsave_url_XXXX",
5609 my $tmpin = $fh->filename;
5610 if ($CPAN::META->has_usable('LWP')) {
5611 $CPAN::Frontend->myprint("Fetching with LWP:
5615 CPAN::LWP::UserAgent->config;
5616 eval { $Ua = CPAN::LWP::UserAgent->new; };
5618 $CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n");
5622 $Ua->proxy('http', $var)
5623 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
5625 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
5628 my $req = HTTP::Request->new(GET => $url);
5629 $req->header('Accept' => 'text/html');
5630 my $res = $Ua->request($req);
5631 if ($res->is_success) {
5632 $CPAN::Frontend->myprint(" + request successful.\n")
5634 print $fh $res->content;
5636 $CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n})
5640 $CPAN::Frontend->myprint(sprintf(
5641 "LWP failed with code[%s], message[%s]\n",
5648 $CPAN::Frontend->myprint("LWP not available\n");
5653 package CPAN::Bundle;
5658 $CPAN::Frontend->myprint($self->as_string);
5663 delete $self->{later};
5664 for my $c ( $self->contains ) {
5665 my $obj = CPAN::Shell->expandany($c) or next;
5670 # mark as dirty/clean
5671 #-> sub CPAN::Bundle::color_cmd_tmps ;
5672 sub color_cmd_tmps {
5674 my($depth) = shift || 0;
5675 my($color) = shift || 0;
5676 my($ancestors) = shift || [];
5677 # a module needs to recurse to its cpan_file, a distribution needs
5678 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
5680 return if exists $self->{incommandcolor}
5681 && $self->{incommandcolor}==$color;
5683 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
5685 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
5687 for my $c ( $self->contains ) {
5688 my $obj = CPAN::Shell->expandany($c) or next;
5689 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
5690 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
5693 delete $self->{badtestcnt};
5695 $self->{incommandcolor} = $color;
5698 #-> sub CPAN::Bundle::as_string ;
5702 # following line must be "=", not "||=" because we have a moving target
5703 $self->{INST_VERSION} = $self->inst_version;
5704 return $self->SUPER::as_string;
5707 #-> sub CPAN::Bundle::contains ;
5710 my($inst_file) = $self->inst_file || "";
5711 my($id) = $self->id;
5712 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
5713 unless ($inst_file) {
5714 # Try to get at it in the cpan directory
5715 $self->debug("no inst_file") if $CPAN::DEBUG;
5717 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
5718 $cpan_file = $self->cpan_file;
5719 if ($cpan_file eq "N/A") {
5720 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
5721 Maybe stale symlink? Maybe removed during session? Giving up.\n");
5723 my $dist = $CPAN::META->instance('CPAN::Distribution',
5726 $self->debug($dist->as_string) if $CPAN::DEBUG;
5727 my($todir) = $CPAN::Config->{'cpan_home'};
5728 my(@me,$from,$to,$me);
5729 @me = split /::/, $self->id;
5731 $me = File::Spec->catfile(@me);
5732 $from = $self->find_bundle_file($dist->{'build_dir'},$me);
5733 $to = File::Spec->catfile($todir,$me);
5734 File::Path::mkpath(File::Basename::dirname($to));
5735 File::Copy::copy($from, $to)
5736 or Carp::confess("Couldn't copy $from to $to: $!");
5740 my $fh = FileHandle->new;
5742 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
5744 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
5746 $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
5747 m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
5748 next unless $in_cont;
5753 push @result, (split " ", $_, 2)[0];
5756 delete $self->{STATUS};
5757 $self->{CONTAINS} = \@result;
5758 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
5760 $CPAN::Frontend->mywarn(qq{
5761 The bundle file "$inst_file" may be a broken
5762 bundlefile. It seems not to contain any bundle definition.
5763 Please check the file and if it is bogus, please delete it.
5764 Sorry for the inconvenience.
5770 #-> sub CPAN::Bundle::find_bundle_file
5771 sub find_bundle_file {
5772 my($self,$where,$what) = @_;
5773 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
5774 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
5775 ### my $bu = File::Spec->catfile($where,$what);
5776 ### return $bu if -f $bu;
5777 my $manifest = File::Spec->catfile($where,"MANIFEST");
5778 unless (-f $manifest) {
5779 require ExtUtils::Manifest;
5780 my $cwd = CPAN::anycwd();
5781 chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!});
5782 ExtUtils::Manifest::mkmanifest();
5783 chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!});
5785 my $fh = FileHandle->new($manifest)
5786 or Carp::croak("Couldn't open $manifest: $!");
5789 if ($^O eq 'MacOS') {
5792 $what2 =~ s/:Bundle://;
5795 $what2 =~ s|Bundle[/\\]||;
5800 my($file) = /(\S+)/;
5801 if ($file =~ m|\Q$what\E$|) {
5803 # return File::Spec->catfile($where,$bu); # bad
5806 # retry if she managed to
5807 # have no Bundle directory
5808 $bu = $file if $file =~ m|\Q$what2\E$|;
5810 $bu =~ tr|/|:| if $^O eq 'MacOS';
5811 return File::Spec->catfile($where, $bu) if $bu;
5812 Carp::croak("Couldn't find a Bundle file in $where");
5815 # needs to work quite differently from Module::inst_file because of
5816 # cpan_home/Bundle/ directory and the possibility that we have
5817 # shadowing effect. As it makes no sense to take the first in @INC for
5818 # Bundles, we parse them all for $VERSION and take the newest.
5820 #-> sub CPAN::Bundle::inst_file ;
5825 @me = split /::/, $self->id;
5828 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
5829 my $bfile = File::Spec->catfile($incdir, @me);
5830 CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG;
5831 next unless -f $bfile;
5832 my $foundv = MM->parse_version($bfile);
5833 if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) {
5834 $self->{INST_FILE} = $bfile;
5835 $self->{INST_VERSION} = $bestv = $foundv;
5841 #-> sub CPAN::Bundle::inst_version ;
5844 $self->inst_file; # finds INST_VERSION as side effect
5845 $self->{INST_VERSION};
5848 #-> sub CPAN::Bundle::rematein ;
5850 my($self,$meth) = @_;
5851 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
5852 my($id) = $self->id;
5853 Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
5854 unless $self->inst_file || $self->cpan_file;
5856 for $s ($self->contains) {
5857 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
5858 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
5859 if ($type eq 'CPAN::Distribution') {
5860 $CPAN::Frontend->mywarn(qq{
5861 The Bundle }.$self->id.qq{ contains
5862 explicitly a file $s.
5866 # possibly noisy action:
5867 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
5868 my $obj = $CPAN::META->instance($type,$s);
5870 if ($obj->isa('CPAN::Bundle')
5872 exists $obj->{install_failed}
5874 ref($obj->{install_failed}) eq "HASH"
5876 for (keys %{$obj->{install_failed}}) {
5877 $self->{install_failed}{$_} = undef; # propagate faiure up
5880 $fail{$s} = 1; # the bundle itself may have succeeded but
5885 $success = $obj->can("uptodate") ? $obj->uptodate : 0;
5886 $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
5888 delete $self->{install_failed}{$s};
5895 # recap with less noise
5896 if ( $meth eq "install" ) {
5899 my $raw = sprintf(qq{Bundle summary:
5900 The following items in bundle %s had installation problems:},
5903 $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
5904 $CPAN::Frontend->myprint("\n");
5907 for $s ($self->contains) {
5909 $paragraph .= "$s ";
5910 $self->{install_failed}{$s} = undef;
5911 $reported{$s} = undef;
5914 my $report_propagated;
5915 for $s (sort keys %{$self->{install_failed}}) {
5916 next if exists $reported{$s};
5917 $paragraph .= "and the following items had problems
5918 during recursive bundle calls: " unless $report_propagated++;
5919 $paragraph .= "$s ";
5921 $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph));
5922 $CPAN::Frontend->myprint("\n");
5924 $self->{'install'} = 'YES';
5929 #sub CPAN::Bundle::xs_file
5931 # If a bundle contains another that contains an xs_file we have
5932 # here, we just don't bother I suppose
5936 #-> sub CPAN::Bundle::force ;
5937 sub force { shift->rematein('force',@_); }
5938 #-> sub CPAN::Bundle::notest ;
5939 sub notest { shift->rematein('notest',@_); }
5940 #-> sub CPAN::Bundle::get ;
5941 sub get { shift->rematein('get',@_); }
5942 #-> sub CPAN::Bundle::make ;
5943 sub make { shift->rematein('make',@_); }
5944 #-> sub CPAN::Bundle::test ;
5947 $self->{badtestcnt} ||= 0;
5948 $self->rematein('test',@_);
5950 #-> sub CPAN::Bundle::install ;
5953 $self->rematein('install',@_);
5955 #-> sub CPAN::Bundle::clean ;
5956 sub clean { shift->rematein('clean',@_); }
5958 #-> sub CPAN::Bundle::uptodate ;
5961 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
5963 foreach $c ($self->contains) {
5964 my $obj = CPAN::Shell->expandany($c);
5965 return 0 unless $obj->uptodate;
5970 #-> sub CPAN::Bundle::readme ;
5973 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
5974 No File found for bundle } . $self->id . qq{\n}), return;
5975 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
5976 $CPAN::META->instance('CPAN::Distribution',$file)->readme;
5979 package CPAN::Module;
5983 # sub CPAN::Module::userid
5988 return $ro->{userid} || $ro->{CPAN_USERID};
5990 # sub CPAN::Module::description
5993 my $ro = $self->ro or return "";
5999 CPAN::Shell->expand("Distribution",$self->cpan_file);
6002 # sub CPAN::Module::undelay
6005 delete $self->{later};
6006 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6011 # mark as dirty/clean
6012 #-> sub CPAN::Module::color_cmd_tmps ;
6013 sub color_cmd_tmps {
6015 my($depth) = shift || 0;
6016 my($color) = shift || 0;
6017 my($ancestors) = shift || [];
6018 # a module needs to recurse to its cpan_file
6020 return if exists $self->{incommandcolor}
6021 && $self->{incommandcolor}==$color;
6022 return if $depth>=1 && $self->uptodate;
6024 $CPAN::Frontend->mydie(CPAN::Exception::RecursiveDependency->new($ancestors));
6026 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
6028 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
6029 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
6032 delete $self->{badtestcnt};
6034 $self->{incommandcolor} = $color;
6037 #-> sub CPAN::Module::as_glimpse ;
6041 my $class = ref($self);
6042 $class =~ s/^CPAN:://;
6046 $CPAN::Shell::COLOR_REGISTERED
6048 $CPAN::META->has_inst("Term::ANSIColor")
6052 $color_on = Term::ANSIColor::color("green");
6053 $color_off = Term::ANSIColor::color("reset");
6055 push @m, sprintf("%-8s %s%-22s%s (%s)\n",
6060 $self->distribution ? $self->distribution->pretty_id : $self->id,
6065 #-> sub CPAN::Module::as_string ;
6069 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
6070 my $class = ref($self);
6071 $class =~ s/^CPAN:://;
6073 push @m, $class, " id = $self->{ID}\n";
6074 my $sprintf = " %-12s %s\n";
6075 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
6076 if $self->description;
6077 my $sprintf2 = " %-12s %s (%s)\n";
6079 $userid = $self->userid;
6082 if ($author = CPAN::Shell->expand('Author',$userid)) {
6085 if ($m = $author->email) {
6092 $author->fullname . $email
6096 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
6097 if $self->cpan_version;
6098 if (my $cpan_file = $self->cpan_file){
6099 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
6100 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
6101 my $upload_date = $dist->upload_date;
6103 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
6107 my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
6108 my(%statd,%stats,%statl,%stati);
6109 @statd{qw,? i c a b R M S,} = qw,unknown idea
6110 pre-alpha alpha beta released mature standard,;
6111 @stats{qw,? m d u n a,} = qw,unknown mailing-list
6112 developer comp.lang.perl.* none abandoned,;
6113 @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
6114 @stati{qw,? f r O h,} = qw,unknown functions
6115 references+ties object-oriented hybrid,;
6116 $statd{' '} = 'unknown';
6117 $stats{' '} = 'unknown';
6118 $statl{' '} = 'unknown';
6119 $stati{' '} = 'unknown';
6128 $statd{$ro->{statd}},
6129 $stats{$ro->{stats}},
6130 $statl{$ro->{statl}},
6131 $stati{$ro->{stati}}
6132 ) if $ro && $ro->{statd};
6133 my $local_file = $self->inst_file;
6134 unless ($self->{MANPAGE}) {
6136 $self->{MANPAGE} = $self->manpage_headline($local_file);
6138 # If we have already untarred it, we should look there
6139 my $dist = $CPAN::META->instance('CPAN::Distribution',
6141 # warn "dist[$dist]";
6142 # mff=manifest file; mfh=manifest handle
6147 (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
6149 $mfh = FileHandle->new($mff)
6151 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
6152 my $lfre = $self->id; # local file RE
6155 my($lfl); # local file file
6157 my(@mflines) = <$mfh>;
6162 while (length($lfre)>5 and !$lfl) {
6163 ($lfl) = grep /$lfre/, @mflines;
6164 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
6167 $lfl =~ s/\s.*//; # remove comments
6168 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
6169 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
6170 # warn "lfl_abs[$lfl_abs]";
6172 $self->{MANPAGE} = $self->manpage_headline($lfl_abs);
6178 for $item (qw/MANPAGE/) {
6179 push @m, sprintf($sprintf, $item, $self->{$item})
6180 if exists $self->{$item};
6182 for $item (qw/CONTAINS/) {
6183 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
6184 if exists $self->{$item} && @{$self->{$item}};
6186 push @m, sprintf($sprintf, 'INST_FILE',
6187 $local_file || "(not installed)");
6188 push @m, sprintf($sprintf, 'INST_VERSION',
6189 $self->inst_version) if $local_file;
6193 sub manpage_headline {
6194 my($self,$local_file) = @_;
6195 my(@local_file) = $local_file;
6196 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
6197 push @local_file, $local_file;
6199 for $locf (@local_file) {
6200 next unless -f $locf;
6201 my $fh = FileHandle->new($locf)
6202 or $Carp::Frontend->mydie("Couldn't open $locf: $!");
6206 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
6207 m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
6224 #-> sub CPAN::Module::cpan_file ;
6225 # Note: also inherited by CPAN::Bundle
6228 CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
6229 unless ($self->ro) {
6230 CPAN::Index->reload;
6233 if ($ro && defined $ro->{CPAN_FILE}){
6234 return $ro->{CPAN_FILE};
6236 my $userid = $self->userid;
6238 if ($CPAN::META->exists("CPAN::Author",$userid)) {
6239 my $author = $CPAN::META->instance("CPAN::Author",
6241 my $fullname = $author->fullname;
6242 my $email = $author->email;
6243 unless (defined $fullname && defined $email) {
6244 return sprintf("Contact Author %s",
6248 return "Contact Author $fullname <$email>";
6250 return "Contact Author $userid (Email address not available)";
6258 #-> sub CPAN::Module::cpan_version ;
6264 # Can happen with modules that are not on CPAN
6267 $ro->{CPAN_VERSION} = 'undef'
6268 unless defined $ro->{CPAN_VERSION};
6269 $ro->{CPAN_VERSION};
6272 #-> sub CPAN::Module::force ;
6275 $self->{'force_update'}++;
6280 # warn "XDEBUG: set notest for Module";
6281 $self->{'notest'}++;
6284 #-> sub CPAN::Module::rematein ;
6286 my($self,$meth) = @_;
6287 $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n",
6290 my $cpan_file = $self->cpan_file;
6291 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){
6292 $CPAN::Frontend->mywarn(sprintf qq{
6293 The module %s isn\'t available on CPAN.
6295 Either the module has not yet been uploaded to CPAN, or it is
6296 temporary unavailable. Please contact the author to find out
6297 more about the status. Try 'i %s'.
6304 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
6305 $pack->called_for($self->id);
6306 $pack->force($meth) if exists $self->{'force_update'};
6307 $pack->notest($meth) if exists $self->{'notest'};
6312 $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
6313 $pack->unnotest if $pack->can("unnotest") && exists $self->{'notest'};
6314 delete $self->{'force_update'};
6315 delete $self->{'notest'};
6321 #-> sub CPAN::Module::perldoc ;
6322 sub perldoc { shift->rematein('perldoc') }
6323 #-> sub CPAN::Module::readme ;
6324 sub readme { shift->rematein('readme') }
6325 #-> sub CPAN::Module::look ;
6326 sub look { shift->rematein('look') }
6327 #-> sub CPAN::Module::cvs_import ;
6328 sub cvs_import { shift->rematein('cvs_import') }
6329 #-> sub CPAN::Module::get ;
6330 sub get { shift->rematein('get',@_) }
6331 #-> sub CPAN::Module::make ;
6332 sub make { shift->rematein('make') }
6333 #-> sub CPAN::Module::test ;
6336 $self->{badtestcnt} ||= 0;
6337 $self->rematein('test',@_);
6339 #-> sub CPAN::Module::uptodate ;
6342 my($latest) = $self->cpan_version;
6344 my($inst_file) = $self->inst_file;
6346 if (defined $inst_file) {
6347 $have = $self->inst_version;
6352 ! CPAN::Version->vgt($latest, $have)
6354 CPAN->debug("returning uptodate. inst_file[$inst_file] ".
6355 "latest[$latest] have[$have]") if $CPAN::DEBUG;
6360 #-> sub CPAN::Module::install ;
6366 not exists $self->{'force_update'}
6368 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
6370 $self->inst_version,
6376 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
6377 $CPAN::Frontend->mywarn(qq{
6378 \n\n\n ***WARNING***
6379 The module $self->{ID} has no active maintainer.\n\n\n
6383 $self->rematein('install') if $doit;
6385 #-> sub CPAN::Module::clean ;
6386 sub clean { shift->rematein('clean') }
6388 #-> sub CPAN::Module::inst_file ;
6392 @packpath = split /::/, $self->{ID};
6393 $packpath[-1] .= ".pm";
6394 foreach $dir (@INC) {
6395 my $pmfile = File::Spec->catfile($dir,@packpath);
6403 #-> sub CPAN::Module::xs_file ;
6407 @packpath = split /::/, $self->{ID};
6408 push @packpath, $packpath[-1];
6409 $packpath[-1] .= "." . $Config::Config{'dlext'};
6410 foreach $dir (@INC) {
6411 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
6419 #-> sub CPAN::Module::inst_version ;
6422 my $parsefile = $self->inst_file or return;
6423 local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
6426 # there was a bug in 5.6.0 that let lots of unini warnings out of
6427 # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove
6428 # the following workaround after 5.6.1 is out.
6429 local($SIG{__WARN__}) = sub { my $w = shift;
6430 return if $w =~ /uninitialized/i;
6434 $have = MM->parse_version($parsefile) || "undef";
6435 $have =~ s/^ //; # since the %vd hack these two lines here are needed
6436 $have =~ s/ $//; # trailing whitespace happens all the time
6438 # My thoughts about why %vd processing should happen here
6440 # Alt1 maintain it as string with leading v:
6441 # read index files do nothing
6442 # compare it use utility for compare
6443 # print it do nothing
6445 # Alt2 maintain it as what it is
6446 # read index files convert
6447 # compare it use utility because there's still a ">" vs "gt" issue
6448 # print it use CPAN::Version for print
6450 # Seems cleaner to hold it in memory as a string starting with a "v"
6452 # If the author of this module made a mistake and wrote a quoted
6453 # "v1.13" instead of v1.13, we simply leave it at that with the
6454 # effect that *we* will treat it like a v-tring while the rest of
6455 # perl won't. Seems sensible when we consider that any action we
6456 # could take now would just add complexity.
6458 $have = CPAN::Version->readable($have);
6460 $have =~ s/\s*//g; # stringify to float around floating point issues
6461 $have; # no stringify needed, \s* above matches always
6473 CPAN - query, download and build perl modules from CPAN sites
6479 perl -MCPAN -e shell;
6487 $mod = "Acme::Meta";
6489 CPAN::Shell->install($mod); # same thing
6490 CPAN::Shell->expandany($mod)->install; # same thing
6491 CPAN::Shell->expand("Module",$mod)->install; # same thing
6492 CPAN::Shell->expand("Module",$mod)
6493 ->distribution->install; # same thing
6497 $distro = "NWCLARK/Acme-Meta-0.01.tar.gz";
6498 install $distro; # same thing
6499 CPAN::Shell->install($distro); # same thing
6500 CPAN::Shell->expandany($distro)->install; # same thing
6501 CPAN::Shell->expand("Module",$distro)->install; # same thing
6505 This module will eventually be replaced by CPANPLUS. CPANPLUS is kind
6506 of a modern rewrite from ground up with greater extensibility and more
6507 features but no full compatibility. If you're new to CPAN.pm, you
6508 probably should investigate if CPANPLUS is the better choice for you.
6509 If you're already used to CPAN.pm you're welcome to continue using it,
6510 if you accept that its development is mostly (though not completely)
6515 The CPAN module is designed to automate the make and install of perl
6516 modules and extensions. It includes some primitive searching
6517 capabilities and knows how to use Net::FTP or LWP (or some external
6518 download clients) to fetch the raw data from the net.
6520 Modules are fetched from one or more of the mirrored CPAN
6521 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
6524 The CPAN module also supports the concept of named and versioned
6525 I<bundles> of modules. Bundles simplify the handling of sets of
6526 related modules. See Bundles below.
6528 The package contains a session manager and a cache manager. There is
6529 no status retained between sessions. The session manager keeps track
6530 of what has been fetched, built and installed in the current
6531 session. The cache manager keeps track of the disk space occupied by
6532 the make processes and deletes excess space according to a simple FIFO
6535 All methods provided are accessible in a programmer style and in an
6536 interactive shell style.
6538 =head2 Interactive Mode
6540 The interactive mode is entered by running
6542 perl -MCPAN -e shell
6544 which puts you into a readline interface. You will have the most fun if
6545 you install Term::ReadKey and Term::ReadLine to enjoy both history and
6548 Once you are on the command line, type 'h' and the rest should be
6551 The function call C<shell> takes two optional arguments, one is the
6552 prompt, the second is the default initial command line (the latter
6553 only works if a real ReadLine interface module is installed).
6555 The most common uses of the interactive modes are
6559 =item Searching for authors, bundles, distribution files and modules
6561 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
6562 for each of the four categories and another, C<i> for any of the
6563 mentioned four. Each of the four entities is implemented as a class
6564 with slightly differing methods for displaying an object.
6566 Arguments you pass to these commands are either strings exactly matching
6567 the identification string of an object or regular expressions that are
6568 then matched case-insensitively against various attributes of the
6569 objects. The parser recognizes a regular expression only if you
6570 enclose it between two slashes.
6572 The principle is that the number of found objects influences how an
6573 item is displayed. If the search finds one item, the result is
6574 displayed with the rather verbose method C<as_string>, but if we find
6575 more than one, we display each object with the terse method
6578 =item make, test, install, clean modules or distributions
6580 These commands take any number of arguments and investigate what is
6581 necessary to perform the action. If the argument is a distribution
6582 file name (recognized by embedded slashes), it is processed. If it is
6583 a module, CPAN determines the distribution file in which this module
6584 is included and processes that, following any dependencies named in
6585 the module's META.yml or Makefile.PL (this behavior is controlled by
6586 the configuration parameter C<prerequisites_policy>.)
6588 Any C<make> or C<test> are run unconditionally. An
6590 install <distribution_file>
6592 also is run unconditionally. But for
6596 CPAN checks if an install is actually needed for it and prints
6597 I<module up to date> in the case that the distribution file containing
6598 the module doesn't need to be updated.
6600 CPAN also keeps track of what it has done within the current session
6601 and doesn't try to build a package a second time regardless if it
6602 succeeded or not. The C<force> pragma may precede another command
6603 (currently: C<make>, C<test>, or C<install>) and executes the
6604 command from scratch and tries to continue in case of some errors.
6608 cpan> install OpenGL
6609 OpenGL is up to date.
6610 cpan> force install OpenGL
6613 OpenGL-0.4/COPYRIGHT
6616 The C<notest> pragma may be set to skip the test part in the build
6621 cpan> notest install Tk
6623 A C<clean> command results in a
6627 being executed within the distribution file's working directory.
6629 =item get, readme, perldoc, look module or distribution
6631 C<get> downloads a distribution file without further action. C<readme>
6632 displays the README file of the associated distribution. C<Look> gets
6633 and untars (if not yet done) the distribution file, changes to the
6634 appropriate directory and opens a subshell process in that directory.
6635 C<perldoc> displays the pod documentation of the module in html or
6640 =item ls globbing_expression
6642 The first form lists all distribution files in and below an author's
6643 CPAN directory as they are stored in the CHECKUMS files distributed on
6644 CPAN. The listing goes recursive into all subdirectories.
6646 The second form allows to limit or expand the output with shell
6647 globbing as in the following examples:
6653 The last example is very slow and outputs extra progress indicators
6654 that break the alignment of the result.
6656 Note that globbing only lists directories explicitly asked for, for
6657 example FOO/* will not list FOO/bar/Acme-Sthg-n.nn.tar.gz. This may be
6658 regarded as a bug and may be changed in future versions.
6662 The C<failed> command reports all distributions that failed on one of
6663 C<make>, C<test> or C<install> for some reason in the currently
6664 running shell session.
6668 Interactive sessions maintain a lockfile, per default C<~/.cpan/.lock>
6669 (but the directory can be configured via the C<cpan_home> config
6670 variable). The shell is a bit picky if you try to start another CPAN
6671 session. It dies immediately if there is a lockfile and the lock seems
6672 to belong to a running process. In case you want to run a second shell
6673 session, it is probably safest to maintain another directory, say
6674 C<~/.cpan-for-X/> and a C<~/.cpan-for-X/CPAN/MyConfig.pm> that
6675 contains the configuration options. Then you can start the second
6678 perl -I ~/.cpan-for-X -MCPAN::MyConfig -MCPAN -e shell
6682 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
6683 in the cpan-shell it is intended that you can press C<^C> anytime and
6684 return to the cpan-shell prompt. A SIGTERM will cause the cpan-shell
6685 to clean up and leave the shell loop. You can emulate the effect of a
6686 SIGTERM by sending two consecutive SIGINTs, which usually means by
6687 pressing C<^C> twice.
6689 CPAN.pm ignores a SIGPIPE. If the user sets inactivity_timeout, a
6690 SIGALRM is used during the run of the C<perl Makefile.PL> or C<perl
6691 Build.PL> subprocess.
6697 The commands that are available in the shell interface are methods in
6698 the package CPAN::Shell. If you enter the shell command, all your
6699 input is split by the Text::ParseWords::shellwords() routine which
6700 acts like most shells do. The first word is being interpreted as the
6701 method to be called and the rest of the words are treated as arguments
6702 to this method. Continuation lines are supported if a line ends with a
6707 C<autobundle> writes a bundle file into the
6708 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
6709 a list of all modules that are both available from CPAN and currently
6710 installed within @INC. The name of the bundle file is based on the
6711 current date and a counter.
6715 recompile() is a very special command in that it takes no argument and
6716 runs the make/test/install cycle with brute force over all installed
6717 dynamically loadable extensions (aka XS modules) with 'force' in
6718 effect. The primary purpose of this command is to finish a network
6719 installation. Imagine, you have a common source tree for two different
6720 architectures. You decide to do a completely independent fresh
6721 installation. You start on one architecture with the help of a Bundle
6722 file produced earlier. CPAN installs the whole Bundle for you, but
6723 when you try to repeat the job on the second architecture, CPAN
6724 responds with a C<"Foo up to date"> message for all modules. So you
6725 invoke CPAN's recompile on the second architecture and you're done.
6727 Another popular use for C<recompile> is to act as a rescue in case your
6728 perl breaks binary compatibility. If one of the modules that CPAN uses
6729 is in turn depending on binary compatibility (so you cannot run CPAN
6730 commands), then you should try the CPAN::Nox module for recovery.
6732 =head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
6734 Although it may be considered internal, the class hierarchy does matter
6735 for both users and programmer. CPAN.pm deals with above mentioned four
6736 classes, and all those classes share a set of methods. A classical
6737 single polymorphism is in effect. A metaclass object registers all
6738 objects of all kinds and indexes them with a string. The strings
6739 referencing objects have a separated namespace (well, not completely
6744 words containing a "/" (slash) Distribution
6745 words starting with Bundle:: Bundle
6746 everything else Module or Author
6748 Modules know their associated Distribution objects. They always refer
6749 to the most recent official release. Developers may mark their releases
6750 as unstable development versions (by inserting an underbar into the
6751 module version number which will also be reflected in the distribution
6752 name when you run 'make dist'), so the really hottest and newest
6753 distribution is not always the default. If a module Foo circulates
6754 on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient
6755 way to install version 1.23 by saying
6759 This would install the complete distribution file (say
6760 BAR/Foo-1.23.tar.gz) with all accompanying material. But if you would
6761 like to install version 1.23_90, you need to know where the
6762 distribution file resides on CPAN relative to the authors/id/
6763 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz;
6764 so you would have to say
6766 install BAR/Foo-1.23_90.tar.gz
6768 The first example will be driven by an object of the class
6769 CPAN::Module, the second by an object of class CPAN::Distribution.
6771 =head2 Programmer's interface
6773 If you do not enter the shell, the available shell commands are both
6774 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
6775 functions in the calling package (C<install(...)>).
6777 There's currently only one class that has a stable interface -
6778 CPAN::Shell. All commands that are available in the CPAN shell are
6779 methods of the class CPAN::Shell. Each of the commands that produce
6780 listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
6781 the IDs of all modules within the list.
6785 =item expand($type,@things)
6787 The IDs of all objects available within a program are strings that can
6788 be expanded to the corresponding real objects with the
6789 C<CPAN::Shell-E<gt>expand("Module",@things)> method. Expand returns a
6790 list of CPAN::Module objects according to the C<@things> arguments
6791 given. In scalar context it only returns the first element of the
6794 =item expandany(@things)
6796 Like expand, but returns objects of the appropriate type, i.e.
6797 CPAN::Bundle objects for bundles, CPAN::Module objects for modules and
6798 CPAN::Distribution objects for distributions. Note: it does not expand
6799 to CPAN::Author objects.
6801 =item Programming Examples
6803 This enables the programmer to do operations that combine
6804 functionalities that are available in the shell.
6806 # install everything that is outdated on my disk:
6807 perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
6809 # install my favorite programs if necessary:
6810 for $mod (qw(Net::FTP Digest::SHA Data::Dumper)){
6811 my $obj = CPAN::Shell->expand('Module',$mod);
6815 # list all modules on my disk that have no VERSION number
6816 for $mod (CPAN::Shell->expand("Module","/./")){
6817 next unless $mod->inst_file;
6818 # MakeMaker convention for undefined $VERSION:
6819 next unless $mod->inst_version eq "undef";
6820 print "No VERSION in ", $mod->id, "\n";
6823 # find out which distribution on CPAN contains a module:
6824 print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
6826 Or if you want to write a cronjob to watch The CPAN, you could list
6827 all modules that need updating. First a quick and dirty way:
6829 perl -e 'use CPAN; CPAN::Shell->r;'
6831 If you don't want to get any output in the case that all modules are
6832 up to date, you can parse the output of above command for the regular
6833 expression //modules are up to date// and decide to mail the output
6834 only if it doesn't match. Ick?
6836 If you prefer to do it more in a programmer style in one single
6837 process, maybe something like this suits you better:
6839 # list all modules on my disk that have newer versions on CPAN
6840 for $mod (CPAN::Shell->expand("Module","/./")){
6841 next unless $mod->inst_file;
6842 next if $mod->uptodate;
6843 printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
6844 $mod->id, $mod->inst_version, $mod->cpan_version;
6847 If that gives you too much output every day, you maybe only want to
6848 watch for three modules. You can write
6850 for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
6852 as the first line instead. Or you can combine some of the above
6855 # watch only for a new mod_perl module
6856 $mod = CPAN::Shell->expand("Module","mod_perl");
6857 exit if $mod->uptodate;
6858 # new mod_perl arrived, let me know all update recommendations
6863 =head2 Methods in the other Classes
6865 The programming interface for the classes CPAN::Module,
6866 CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered
6867 beta and partially even alpha. In the following paragraphs only those
6868 methods are documented that have proven useful over a longer time and
6869 thus are unlikely to change.
6873 =item CPAN::Author::as_glimpse()
6875 Returns a one-line description of the author
6877 =item CPAN::Author::as_string()
6879 Returns a multi-line description of the author
6881 =item CPAN::Author::email()
6883 Returns the author's email address
6885 =item CPAN::Author::fullname()
6887 Returns the author's name
6889 =item CPAN::Author::name()
6891 An alias for fullname
6893 =item CPAN::Bundle::as_glimpse()
6895 Returns a one-line description of the bundle
6897 =item CPAN::Bundle::as_string()
6899 Returns a multi-line description of the bundle
6901 =item CPAN::Bundle::clean()
6903 Recursively runs the C<clean> method on all items contained in the bundle.
6905 =item CPAN::Bundle::contains()
6907 Returns a list of objects' IDs contained in a bundle. The associated
6908 objects may be bundles, modules or distributions.
6910 =item CPAN::Bundle::force($method,@args)
6912 Forces CPAN to perform a task that normally would have failed. Force
6913 takes as arguments a method name to be called and any number of
6914 additional arguments that should be passed to the called method. The
6915 internals of the object get the needed changes so that CPAN.pm does
6916 not refuse to take the action. The C<force> is passed recursively to
6917 all contained objects.
6919 =item CPAN::Bundle::get()
6921 Recursively runs the C<get> method on all items contained in the bundle
6923 =item CPAN::Bundle::inst_file()
6925 Returns the highest installed version of the bundle in either @INC or
6926 C<$CPAN::Config->{cpan_home}>. Note that this is different from
6927 CPAN::Module::inst_file.
6929 =item CPAN::Bundle::inst_version()
6931 Like CPAN::Bundle::inst_file, but returns the $VERSION
6933 =item CPAN::Bundle::uptodate()
6935 Returns 1 if the bundle itself and all its members are uptodate.
6937 =item CPAN::Bundle::install()
6939 Recursively runs the C<install> method on all items contained in the bundle
6941 =item CPAN::Bundle::make()
6943 Recursively runs the C<make> method on all items contained in the bundle
6945 =item CPAN::Bundle::readme()
6947 Recursively runs the C<readme> method on all items contained in the bundle
6949 =item CPAN::Bundle::test()
6951 Recursively runs the C<test> method on all items contained in the bundle
6953 =item CPAN::Distribution::as_glimpse()
6955 Returns a one-line description of the distribution
6957 =item CPAN::Distribution::as_string()
6959 Returns a multi-line description of the distribution
6961 =item CPAN::Distribution::clean()
6963 Changes to the directory where the distribution has been unpacked and
6964 runs C<make clean> there.
6966 =item CPAN::Distribution::containsmods()
6968 Returns a list of IDs of modules contained in a distribution file.
6969 Only works for distributions listed in the 02packages.details.txt.gz
6970 file. This typically means that only the most recent version of a
6971 distribution is covered.
6973 =item CPAN::Distribution::cvs_import()
6975 Changes to the directory where the distribution has been unpacked and
6978 cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version
6982 =item CPAN::Distribution::dir()
6984 Returns the directory into which this distribution has been unpacked.
6986 =item CPAN::Distribution::force($method,@args)
6988 Forces CPAN to perform a task that normally would have failed. Force
6989 takes as arguments a method name to be called and any number of
6990 additional arguments that should be passed to the called method. The
6991 internals of the object get the needed changes so that CPAN.pm does
6992 not refuse to take the action.
6994 =item CPAN::Distribution::get()
6996 Downloads the distribution from CPAN and unpacks it. Does nothing if
6997 the distribution has already been downloaded and unpacked within the
7000 =item CPAN::Distribution::install()
7002 Changes to the directory where the distribution has been unpacked and
7003 runs the external command C<make install> there. If C<make> has not
7004 yet been run, it will be run first. A C<make test> will be issued in
7005 any case and if this fails, the install will be canceled. The
7006 cancellation can be avoided by letting C<force> run the C<install> for
7009 =item CPAN::Distribution::isa_perl()
7011 Returns 1 if this distribution file seems to be a perl distribution.
7012 Normally this is derived from the file name only, but the index from
7013 CPAN can contain a hint to achieve a return value of true for other
7016 =item CPAN::Distribution::look()
7018 Changes to the directory where the distribution has been unpacked and
7019 opens a subshell there. Exiting the subshell returns.
7021 =item CPAN::Distribution::make()
7023 First runs the C<get> method to make sure the distribution is
7024 downloaded and unpacked. Changes to the directory where the
7025 distribution has been unpacked and runs the external commands C<perl
7026 Makefile.PL> or C<perl Build.PL> and C<make> there.
7028 =item CPAN::Distribution::prereq_pm()
7030 Returns the hash reference that has been announced by a distribution
7031 as the C<requires> element of the META.yml or the C<PREREQ_PM> hash in
7032 the C<Makefile.PL>. Note: works only after an attempt has been made to
7033 C<make> the distribution. Returns undef otherwise.
7035 =item CPAN::Distribution::readme()
7037 Downloads the README file associated with a distribution and runs it
7038 through the pager specified in C<$CPAN::Config->{pager}>.
7040 =item CPAN::Distribution::perldoc()
7042 Downloads the pod documentation of the file associated with a
7043 distribution (in html format) and runs it through the external
7044 command lynx specified in C<$CPAN::Config->{lynx}>. If lynx
7045 isn't available, it converts it to plain text with external
7046 command html2text and runs it through the pager specified
7047 in C<$CPAN::Config->{pager}>
7049 =item CPAN::Distribution::test()
7051 Changes to the directory where the distribution has been unpacked and
7052 runs C<make test> there.
7054 =item CPAN::Distribution::uptodate()
7056 Returns 1 if all the modules contained in the distribution are
7057 uptodate. Relies on containsmods.
7059 =item CPAN::Index::force_reload()
7061 Forces a reload of all indices.
7063 =item CPAN::Index::reload()
7065 Reloads all indices if they have not been read for more than
7066 C<$CPAN::Config->{index_expire}> days.
7068 =item CPAN::InfoObj::dump()
7070 CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution
7071 inherit this method. It prints the data structure associated with an
7072 object. Useful for debugging. Note: the data structure is considered
7073 internal and thus subject to change without notice.
7075 =item CPAN::Module::as_glimpse()
7077 Returns a one-line description of the module
7079 =item CPAN::Module::as_string()
7081 Returns a multi-line description of the module
7083 =item CPAN::Module::clean()
7085 Runs a clean on the distribution associated with this module.
7087 =item CPAN::Module::cpan_file()
7089 Returns the filename on CPAN that is associated with the module.
7091 =item CPAN::Module::cpan_version()
7093 Returns the latest version of this module available on CPAN.
7095 =item CPAN::Module::cvs_import()
7097 Runs a cvs_import on the distribution associated with this module.
7099 =item CPAN::Module::description()
7101 Returns a 44 character description of this module. Only available for
7102 modules listed in The Module List (CPAN/modules/00modlist.long.html
7103 or 00modlist.long.txt.gz)
7105 =item CPAN::Module::force($method,@args)
7107 Forces CPAN to perform a task that normally would have failed. Force
7108 takes as arguments a method name to be called and any number of
7109 additional arguments that should be passed to the called method. The
7110 internals of the object get the needed changes so that CPAN.pm does
7111 not refuse to take the action.
7113 =item CPAN::Module::get()
7115 Runs a get on the distribution associated with this module.
7117 =item CPAN::Module::inst_file()
7119 Returns the filename of the module found in @INC. The first file found
7120 is reported just like perl itself stops searching @INC when it finds a
7123 =item CPAN::Module::inst_version()
7125 Returns the version number of the module in readable format.
7127 =item CPAN::Module::install()
7129 Runs an C<install> on the distribution associated with this module.
7131 =item CPAN::Module::look()
7133 Changes to the directory where the distribution associated with this
7134 module has been unpacked and opens a subshell there. Exiting the
7137 =item CPAN::Module::make()
7139 Runs a C<make> on the distribution associated with this module.
7141 =item CPAN::Module::manpage_headline()
7143 If module is installed, peeks into the module's manpage, reads the
7144 headline and returns it. Moreover, if the module has been downloaded
7145 within this session, does the equivalent on the downloaded module even
7146 if it is not installed.
7148 =item CPAN::Module::readme()
7150 Runs a C<readme> on the distribution associated with this module.
7152 =item CPAN::Module::perldoc()
7154 Runs a C<perldoc> on this module.
7156 =item CPAN::Module::test()
7158 Runs a C<test> on the distribution associated with this module.
7160 =item CPAN::Module::uptodate()
7162 Returns 1 if the module is installed and up-to-date.
7164 =item CPAN::Module::userid()
7166 Returns the author's ID of the module.
7170 =head2 Cache Manager
7172 Currently the cache manager only keeps track of the build directory
7173 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
7174 deletes complete directories below C<build_dir> as soon as the size of
7175 all directories there gets bigger than $CPAN::Config->{build_cache}
7176 (in MB). The contents of this cache may be used for later
7177 re-installations that you intend to do manually, but will never be
7178 trusted by CPAN itself. This is due to the fact that the user might
7179 use these directories for building modules on different architectures.
7181 There is another directory ($CPAN::Config->{keep_source_where}) where
7182 the original distribution files are kept. This directory is not
7183 covered by the cache manager and must be controlled by the user. If
7184 you choose to have the same directory as build_dir and as
7185 keep_source_where directory, then your sources will be deleted with
7186 the same fifo mechanism.
7190 A bundle is just a perl module in the namespace Bundle:: that does not
7191 define any functions or methods. It usually only contains documentation.
7193 It starts like a perl module with a package declaration and a $VERSION
7194 variable. After that the pod section looks like any other pod with the
7195 only difference being that I<one special pod section> exists starting with
7200 In this pod section each line obeys the format
7202 Module_Name [Version_String] [- optional text]
7204 The only required part is the first field, the name of a module
7205 (e.g. Foo::Bar, ie. I<not> the name of the distribution file). The rest
7206 of the line is optional. The comment part is delimited by a dash just
7207 as in the man page header.
7209 The distribution of a bundle should follow the same convention as
7210 other distributions.
7212 Bundles are treated specially in the CPAN package. If you say 'install
7213 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
7214 the modules in the CONTENTS section of the pod. You can install your
7215 own Bundles locally by placing a conformant Bundle file somewhere into
7216 your @INC path. The autobundle() command which is available in the
7217 shell interface does that for you by including all currently installed
7218 modules in a snapshot bundle file.
7220 =head2 Prerequisites
7222 If you have a local mirror of CPAN and can access all files with
7223 "file:" URLs, then you only need a perl better than perl5.003 to run
7224 this module. Otherwise Net::FTP is strongly recommended. LWP may be
7225 required for non-UNIX systems or if your nearest CPAN site is
7226 associated with a URL that is not C<ftp:>.
7228 If you have neither Net::FTP nor LWP, there is a fallback mechanism
7229 implemented for an external ftp command or for an external lynx
7232 =head2 Finding packages and VERSION
7234 This module presumes that all packages on CPAN
7240 declare their $VERSION variable in an easy to parse manner. This
7241 prerequisite can hardly be relaxed because it consumes far too much
7242 memory to load all packages into the running program just to determine
7243 the $VERSION variable. Currently all programs that are dealing with
7244 version use something like this
7246 perl -MExtUtils::MakeMaker -le \
7247 'print MM->parse_version(shift)' filename
7249 If you are author of a package and wonder if your $VERSION can be
7250 parsed, please try the above method.
7254 come as compressed or gzipped tarfiles or as zip files and contain a
7255 C<Makefile.PL> or C<Build.PL> (well, we try to handle a bit more, but
7256 without much enthusiasm).
7262 The debugging of this module is a bit complex, because we have
7263 interferences of the software producing the indices on CPAN, of the
7264 mirroring process on CPAN, of packaging, of configuration, of
7265 synchronicity, and of bugs within CPAN.pm.
7267 For code debugging in interactive mode you can try "o debug" which
7268 will list options for debugging the various parts of the code. You
7269 should know that "o debug" has built-in completion support.
7271 For data debugging there is the C<dump> command which takes the same
7272 arguments as make/test/install and outputs the object's Data::Dumper
7275 =head2 Floppy, Zip, Offline Mode
7277 CPAN.pm works nicely without network too. If you maintain machines
7278 that are not networked at all, you should consider working with file:
7279 URLs. Of course, you have to collect your modules somewhere first. So
7280 you might use CPAN.pm to put together all you need on a networked
7281 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
7282 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
7283 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
7284 with this floppy. See also below the paragraph about CD-ROM support.
7286 =head1 CONFIGURATION
7288 When the CPAN module is used for the first time, a configuration
7289 dialog tries to determine a couple of site specific options. The
7290 result of the dialog is stored in a hash reference C< $CPAN::Config >
7291 in a file CPAN/Config.pm.
7293 The default values defined in the CPAN/Config.pm file can be
7294 overridden in a user specific file: CPAN/MyConfig.pm. Such a file is
7295 best placed in $HOME/.cpan/CPAN/MyConfig.pm, because $HOME/.cpan is
7296 added to the search path of the CPAN module before the use() or
7297 require() statements.
7299 The configuration dialog can be started any time later again by
7300 issuing the command C< o conf init > in the CPAN shell.
7302 Currently the following keys in the hash reference $CPAN::Config are
7305 build_cache size of cache for directories to build modules
7306 build_dir locally accessible directory to build modules
7307 cache_metadata use serializer to cache metadata
7308 cpan_home local directory reserved for this package
7309 dontload_hash anonymous hash: modules in the keys will not be
7310 loaded by the CPAN::has_inst() routine
7312 gzip location of external program gzip
7313 histfile file to maintain history between sessions
7314 histsize maximum number of lines to keep in histfile
7315 inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
7316 after this many seconds inactivity. Set to 0 to
7318 index_expire after this many days refetch index files
7319 inhibit_startup_message
7320 if true, does not print the startup message
7321 keep_source_where directory in which to keep the source (if we do)
7322 make location of external make program
7323 make_arg arguments that should always be passed to 'make'
7324 make_install_make_command
7325 the make command for running 'make install', for
7327 make_install_arg same as make_arg for 'make install'
7328 makepl_arg arguments passed to 'perl Makefile.PL'
7329 mbuild_arg arguments passed to './Build'
7330 mbuild_install_arg arguments passed to './Build install'
7331 mbuild_install_build_command
7332 command to use instead of './Build' when we are
7333 in the install stage, for example 'sudo ./Build'
7334 mbuildpl_arg arguments passed to 'perl Build.PL'
7335 pager location of external program more (or any pager)
7336 prefer_installer legal values are MB and EUMM: if a module
7337 comes with both a Makefile.PL and a Build.PL, use
7338 the former (EUMM) or the latter (MB)
7339 prerequisites_policy
7340 what to do if you are missing module prerequisites
7341 ('follow' automatically, 'ask' me, or 'ignore')
7342 proxy_user username for accessing an authenticating proxy
7343 proxy_pass password for accessing an authenticating proxy
7344 scan_cache controls scanning of cache ('atstart' or 'never')
7345 tar location of external program tar
7346 term_is_latin if true internal UTF-8 is translated to ISO-8859-1
7347 (and nonsense for characters outside latin range)
7348 unzip location of external program unzip
7349 urllist arrayref to nearby CPAN sites (or equivalent locations)
7350 wait_list arrayref to a wait server to try (See CPAN::WAIT)
7351 ftp_proxy, } the three usual variables for configuring
7352 http_proxy, } proxy requests. Both as CPAN::Config variables
7353 no_proxy } and as environment variables configurable.
7355 You can set and query each of these options interactively in the cpan
7356 shell with the command set defined within the C<o conf> command:
7360 =item C<o conf E<lt>scalar optionE<gt>>
7362 prints the current value of the I<scalar option>
7364 =item C<o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>>
7366 Sets the value of the I<scalar option> to I<value>
7368 =item C<o conf E<lt>list optionE<gt>>
7370 prints the current value of the I<list option> in MakeMaker's
7373 =item C<o conf E<lt>list optionE<gt> [shift|pop]>
7375 shifts or pops the array in the I<list option> variable
7377 =item C<o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>>
7379 works like the corresponding perl commands.
7383 =head2 Not on config variable getcwd
7385 CPAN.pm changes the current working directory often and needs to
7386 determine its own current working directory. Per default it uses
7387 Cwd::cwd but if this doesn't work on your system for some reason,
7388 alternatives can be configured according to the following table:
7392 fastcwd Cwd::fastcwd
7393 backtickcwd external command cwd
7395 =head2 Note on urllist parameter's format
7397 urllist parameters are URLs according to RFC 1738. We do a little
7398 guessing if your URL is not compliant, but if you have problems with
7399 file URLs, please try the correct format. Either:
7401 file://localhost/whatever/ftp/pub/CPAN/
7405 file:///home/ftp/pub/CPAN/
7407 =head2 urllist parameter has CD-ROM support
7409 The C<urllist> parameter of the configuration table contains a list of
7410 URLs that are to be used for downloading. If the list contains any
7411 C<file> URLs, CPAN always tries to get files from there first. This
7412 feature is disabled for index files. So the recommendation for the
7413 owner of a CD-ROM with CPAN contents is: include your local, possibly
7414 outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
7416 o conf urllist push file://localhost/CDROM/CPAN
7418 CPAN.pm will then fetch the index files from one of the CPAN sites
7419 that come at the beginning of urllist. It will later check for each
7420 module if there is a local copy of the most recent version.
7422 Another peculiarity of urllist is that the site that we could
7423 successfully fetch the last file from automatically gets a preference
7424 token and is tried as the first site for the next request. So if you
7425 add a new site at runtime it may happen that the previously preferred
7426 site will be tried another time. This means that if you want to disallow
7427 a site for the next transfer, it must be explicitly removed from
7432 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
7433 install foreign, unmasked, unsigned code on your machine. We compare
7434 to a checksum that comes from the net just as the distribution file
7435 itself. But we try to make it easy to add security on demand:
7437 =head2 Cryptographically signed modules
7439 Since release 1.77 CPAN.pm has been able to verify cryptographically
7440 signed module distributions using Module::Signature. The CPAN modules
7441 can be signed by their authors, thus giving more security. The simple
7442 unsigned MD5 checksums that were used before by CPAN protect mainly
7443 against accidental file corruption.
7445 You will need to have Module::Signature installed, which in turn
7446 requires that you have at least one of Crypt::OpenPGP module or the
7447 command-line F<gpg> tool installed.
7449 You will also need to be able to connect over the Internet to the public
7450 keyservers, like pgp.mit.edu, and their port 11731 (the HKP protocol).
7454 Most functions in package CPAN are exported per default. The reason
7455 for this is that the primary use is intended for the cpan shell or for
7460 When the CPAN shell enters a subshell via the look command, it sets
7461 the environment CPAN_SHELL_LEVEL to 1 or increments it if it is
7464 =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
7466 Populating a freshly installed perl with my favorite modules is pretty
7467 easy if you maintain a private bundle definition file. To get a useful
7468 blueprint of a bundle definition file, the command autobundle can be used
7469 on the CPAN shell command line. This command writes a bundle definition
7470 file for all modules that are installed for the currently running perl
7471 interpreter. It's recommended to run this command only once and from then
7472 on maintain the file manually under a private name, say
7473 Bundle/my_bundle.pm. With a clever bundle file you can then simply say
7475 cpan> install Bundle::my_bundle
7477 then answer a few questions and then go out for a coffee.
7479 Maintaining a bundle definition file means keeping track of two
7480 things: dependencies and interactivity. CPAN.pm sometimes fails on
7481 calculating dependencies because not all modules define all MakeMaker
7482 attributes correctly, so a bundle definition file should specify
7483 prerequisites as early as possible. On the other hand, it's a bit
7484 annoying that many distributions need some interactive configuring. So
7485 what I try to accomplish in my private bundle file is to have the
7486 packages that need to be configured early in the file and the gentle
7487 ones later, so I can go out after a few minutes and leave CPAN.pm
7490 =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
7492 Thanks to Graham Barr for contributing the following paragraphs about
7493 the interaction between perl, and various firewall configurations. For
7494 further information on firewalls, it is recommended to consult the
7495 documentation that comes with the ncftp program. If you are unable to
7496 go through the firewall with a simple Perl setup, it is very likely
7497 that you can configure ncftp so that it works for your firewall.
7499 =head2 Three basic types of firewalls
7501 Firewalls can be categorized into three basic types.
7507 This is where the firewall machine runs a web server and to access the
7508 outside world you must do it via the web server. If you set environment
7509 variables like http_proxy or ftp_proxy to a values beginning with http://
7510 or in your web browser you have to set proxy information then you know
7511 you are running an http firewall.
7513 To access servers outside these types of firewalls with perl (even for
7514 ftp) you will need to use LWP.
7518 This where the firewall machine runs an ftp server. This kind of
7519 firewall will only let you access ftp servers outside the firewall.
7520 This is usually done by connecting to the firewall with ftp, then
7521 entering a username like "user@outside.host.com"
7523 To access servers outside these type of firewalls with perl you
7524 will need to use Net::FTP.
7526 =item One way visibility
7528 I say one way visibility as these firewalls try to make themselves look
7529 invisible to the users inside the firewall. An FTP data connection is
7530 normally created by sending the remote server your IP address and then
7531 listening for the connection. But the remote server will not be able to
7532 connect to you because of the firewall. So for these types of firewall
7533 FTP connections need to be done in a passive mode.
7535 There are two that I can think off.
7541 If you are using a SOCKS firewall you will need to compile perl and link
7542 it with the SOCKS library, this is what is normally called a 'socksified'
7543 perl. With this executable you will be able to connect to servers outside
7544 the firewall as if it is not there.
7548 This is the firewall implemented in the Linux kernel, it allows you to
7549 hide a complete network behind one IP address. With this firewall no
7550 special compiling is needed as you can access hosts directly.
7552 For accessing ftp servers behind such firewalls you may need to set
7553 the environment variable C<FTP_PASSIVE> to a true value, e.g.
7555 env FTP_PASSIVE=1 perl -MCPAN -eshell
7559 perl -MCPAN -e '$ENV{FTP_PASSIVE} = 1; shell'
7566 =head2 Configuring lynx or ncftp for going through a firewall
7568 If you can go through your firewall with e.g. lynx, presumably with a
7571 /usr/local/bin/lynx -pscott:tiger
7573 then you would configure CPAN.pm with the command
7575 o conf lynx "/usr/local/bin/lynx -pscott:tiger"
7577 That's all. Similarly for ncftp or ftp, you would configure something
7580 o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg"
7582 Your mileage may vary...
7590 I installed a new version of module X but CPAN keeps saying,
7591 I have the old version installed
7593 Most probably you B<do> have the old version installed. This can
7594 happen if a module installs itself into a different directory in the
7595 @INC path than it was previously installed. This is not really a
7596 CPAN.pm problem, you would have the same problem when installing the
7597 module manually. The easiest way to prevent this behaviour is to add
7598 the argument C<UNINST=1> to the C<make install> call, and that is why
7599 many people add this argument permanently by configuring
7601 o conf make_install_arg UNINST=1
7605 So why is UNINST=1 not the default?
7607 Because there are people who have their precise expectations about who
7608 may install where in the @INC path and who uses which @INC array. In
7609 fine tuned environments C<UNINST=1> can cause damage.
7613 I want to clean up my mess, and install a new perl along with
7614 all modules I have. How do I go about it?
7616 Run the autobundle command for your old perl and optionally rename the
7617 resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl
7618 with the Configure option prefix, e.g.
7620 ./Configure -Dprefix=/usr/local/perl-5.6.78.9
7622 Install the bundle file you produced in the first step with something like
7624 cpan> install Bundle::mybundle
7630 When I install bundles or multiple modules with one command
7631 there is too much output to keep track of.
7633 You may want to configure something like
7635 o conf make_arg "| tee -ai /root/.cpan/logs/make.out"
7636 o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out"
7638 so that STDOUT is captured in a file for later inspection.
7643 I am not root, how can I install a module in a personal directory?
7645 First of all, you will want to use your own configuration, not the one
7646 that your root user installed. The following command sequence is a
7649 % mkdir -p $HOME/.cpan/CPAN
7650 % echo '1;' > $HOME/.cpan/CPAN/MyConfig.pm
7652 [...answer all questions...]
7654 You will most probably like something like this:
7656 o conf makepl_arg "LIB=~/myperl/lib \
7657 INSTALLMAN1DIR=~/myperl/man/man1 \
7658 INSTALLMAN3DIR=~/myperl/man/man3"
7660 You can make this setting permanent like all C<o conf> settings with
7663 You will have to add ~/myperl/man to the MANPATH environment variable
7664 and also tell your perl programs to look into ~/myperl/lib, e.g. by
7667 use lib "$ENV{HOME}/myperl/lib";
7669 or setting the PERL5LIB environment variable.
7671 Another thing you should bear in mind is that the UNINST parameter
7672 should never be set if you are not root.
7676 How to get a package, unwrap it, and make a change before building it?
7678 look Sybase::Sybperl
7682 I installed a Bundle and had a couple of fails. When I
7683 retried, everything resolved nicely. Can this be fixed to work
7686 The reason for this is that CPAN does not know the dependencies of all
7687 modules when it starts out. To decide about the additional items to
7688 install, it just uses data found in the generated Makefile. An
7689 undetected missing piece breaks the process. But it may well be that
7690 your Bundle installs some prerequisite later than some depending item
7691 and thus your second try is able to resolve everything. Please note,
7692 CPAN.pm does not know the dependency tree in advance and cannot sort
7693 the queue of things to install in a topologically correct order. It
7694 resolves perfectly well IFF all modules declare the prerequisites
7695 correctly with the PREREQ_PM attribute to MakeMaker. For bundles which
7696 fail and you need to install often, it is recommended to sort the Bundle
7697 definition file manually. It is planned to improve the metadata
7698 situation for dependencies on CPAN in general, but this will still
7703 In our intranet we have many modules for internal use. How
7704 can I integrate these modules with CPAN.pm but without uploading
7705 the modules to CPAN?
7707 Have a look at the CPAN::Site module.
7711 When I run CPAN's shell, I get error msg about line 1 to 4,
7712 setting meta input/output via the /etc/inputrc file.
7714 Some versions of readline are picky about capitalization in the
7715 /etc/inputrc file and specifically RedHat 6.2 comes with a
7716 /etc/inputrc that contains the word C<on> in lowercase. Change the
7717 occurrences of C<on> to C<On> and the bug should disappear.
7721 Some authors have strange characters in their names.
7723 Internally CPAN.pm uses the UTF-8 charset. If your terminal is
7724 expecting ISO-8859-1 charset, a converter can be activated by setting
7725 term_is_latin to a true value in your config file. One way of doing so
7728 cpan> ! $CPAN::Config->{term_is_latin}=1
7730 Extended support for converters will be made available as soon as perl
7731 becomes stable with regard to charset issues.
7735 When an install fails for some reason and then I correct the error
7736 condition and retry, CPAN.pm refuses to install the module, saying
7737 C<Already tried without success>.
7739 Use the force pragma like so
7741 force install Foo::Bar
7743 This does a bit more than really needed because it untars the
7744 distribution again and runs make and test and only then install.
7746 Or, if you find this is too fast and you would prefer to do smaller
7751 first and then continue as always. C<Force get> I<forgets> previous
7758 and then 'make install' directly in the subshell.
7760 Or you leave the CPAN shell and start it again.
7762 For the really curious, by accessing internals directly, you I<could>
7764 ! delete CPAN::Shell->expand("Distribution", \
7765 CPAN::Shell->expand("Module","Foo::Bar") \
7766 ->cpan_file)->{install}
7768 but this is neither guaranteed to work in the future nor is it a
7775 If a Makefile.PL requires special customization of libraries, prompts
7776 the user for special input, etc. then you may find CPAN is not able to
7777 build the distribution. In that case it is recommended to attempt the
7778 traditional method of building a Perl module package from a shell, for
7779 example by using the 'look' command to open a subshell in the
7780 distribution's own directory.
7784 Andreas Koenig C<< <andk@cpan.org> >>
7788 Kawai,Takanori provides a Japanese translation of this manpage at
7789 http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
7793 cpan(1), CPAN::Nox(3pm), CPAN::Version(3pm)
7800 # cperl-indent-level: 4